- Migrated primitive analysis to stdlib.

4 files changed, 0 insertions, 245 deletions

diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux
index bba58f421..1060eeb8e 100644
--- a/new-luxc/source/luxc/lang.lux
+++ b/new-luxc/source/luxc/lang.lux
@@ -16,72 +16,6 @@
 (type: #export Eval
   (-> Type Code (Meta Top)))
 
-(type: #export Analyser
-  (-> Code (Meta la.Analysis)))
-
-(def: #export version Text "0.6.0")
-
-(def: #export (fail message)
-  (All [a] (-> Text (Meta a)))
-  (do macro.Monad<Meta>
-    [[file line col] macro.cursor
-     #let [location (format file
-                            "," (|> line nat-to-int %i)
-                            "," (|> col nat-to-int %i))]]
-    (macro.fail (format message "\n\n"
-                        "@ " location))))
-
-(def: #export (throw exception message)
-  (All [e a] (-> (ex.Exception e) e (Meta a)))
-  (fail (ex.construct exception message)))
-
-(syntax: #export (assert exception message test)
-  (wrap (list (` (if (~ test)
-                   (:: macro.Monad<Meta> (~' wrap) [])
-                   (..throw (~ exception) (~ message)))))))
-
-(def: #export (with-type expected action)
-  (All [a] (-> Type (Meta a) (Meta a)))
-  (function (_ compiler)
-    (case (action (set@ #.expected (#.Some expected) compiler))
-      (#e.Success [compiler' output])
-      (let [old-expected (get@ #.expected compiler)]
-        (#e.Success [(set@ #.expected old-expected compiler')
-                     output]))
-
-      (#e.Error error)
-      (#e.Error error))))
-
-(def: #export (with-type-env action)
-  (All [a] (-> (tc.Check a) (Meta a)))
-  (function (_ compiler)
-    (case (action (get@ #.type-context compiler))
-      (#e.Error error)
-      ((fail error) compiler)
-
-      (#e.Success [context' output])
-      (#e.Success [(set@ #.type-context context' compiler)
-                   output]))))
-
-(def: #export (with-fresh-type-env action)
-  (All [a] (-> (Meta a) (Meta a)))
-  (function (_ compiler)
-    (let [old (get@ #.type-context compiler)]
-      (case (action (set@ #.type-context tc.fresh-context compiler))
-        (#e.Success [compiler' output])
-        (#e.Success [(set@ #.type-context old compiler')
-                     output])
-
-        output
-        output))))
-
-(def: #export (infer actualT)
-  (-> Type (Meta Top))
-  (do macro.Monad<Meta>
-    [expectedT macro.expected-type]
-    (with-type-env
-      (tc.check expectedT actualT))))
-
 (def: #export (pl-get key table)
   (All [a] (-> Text (List [Text a]) (Maybe a)))
   (case table
@@ -126,85 +60,6 @@
       (#.Cons [k' (f v')] table')
       (#.Cons [k' v'] (pl-update key f table')))))
 
-(def: #export (with-source-code source action)
-  (All [a] (-> Source (Meta a) (Meta a)))
-  (function (_ compiler)
-    (let [old-source (get@ #.source compiler)]
-      (case (action (set@ #.source source compiler))
-        (#e.Error error)
-        (#e.Error error)
-
-        (#e.Success [compiler' output])
-        (#e.Success [(set@ #.source old-source compiler')
-                     output])))))
-
-(def: #export (with-stacked-errors handler action)
-  (All [a] (-> (-> [] Text) (Meta a) (Meta a)))
-  (function (_ compiler)
-    (case (action compiler)
-      (#e.Success [compiler' output])
-      (#e.Success [compiler' output])
-
-      (#e.Error error)
-      (#e.Error (if (text/= "" error)
-                  (handler [])
-                  (format (handler []) "\n\n-----------------------------------------\n\n" error))))))
-
-(def: fresh-bindings
-  (All [k v] (Bindings k v))
-  {#.counter +0
-   #.mappings (list)})
-
-(def: fresh-scope
-  Scope
-  {#.name     (list)
-   #.inner    +0
-   #.locals   fresh-bindings
-   #.captured fresh-bindings})
-
-(def: #export (with-scope action)
-  (All [a] (-> (Meta a) (Meta [Scope a])))
-  (function (_ compiler)
-    (case (action (update@ #.scopes (|>> (#.Cons fresh-scope)) compiler))
-      (#e.Success [compiler' output])
-      (case (get@ #.scopes compiler')
-        #.Nil
-        (#e.Error "Impossible error: Drained scopes!")
-
-        (#.Cons head tail)
-        (#e.Success [(set@ #.scopes tail compiler')
-                     [head output]]))
-
-      (#e.Error error)
-      (#e.Error error))))
-
-(def: #export (with-current-module name action)
-  (All [a] (-> Text (Meta a) (Meta a)))
-  (function (_ compiler)
-    (case (action (set@ #.current-module (#.Some name) compiler))
-      (#e.Success [compiler' output])
-      (#e.Success [(set@ #.current-module
-                         (get@ #.current-module compiler)
-                         compiler')
-                   output])
-
-      (#e.Error error)
-      (#e.Error error))))
-
-(def: #export (with-cursor cursor action)
-  (All [a] (-> Cursor (Meta a) (Meta a)))
-  (if (text/= "" (product.left cursor))
-    action
-    (function (_ compiler)
-      (let [old-cursor (get@ #.cursor compiler)]
-        (case (action (set@ #.cursor cursor compiler))
-          (#e.Success [compiler' output])
-          (#e.Success [(set@ #.cursor old-cursor compiler')
-                       output])
-
-          (#e.Error error)
-          (#e.Error error))))))
-
 (def: (normalize-char char)
   (-> Nat Text)
   (case char
diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux
index c4ff4bfde..072616cfa 100644
--- a/new-luxc/source/luxc/lang/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/common.lux
@@ -10,15 +10,6 @@
   (luxc ["&" lang]
         (lang analysis)))
 
-(def: #export (with-unknown-type action)
-  (All [a] (-> (Meta a) (Meta [Type a])))
-  (do macro.Monad<Meta>
-    [[_ varT] (&.with-type-env tc.var)
-     analysis (&.with-type varT
-                action)
-     knownT (&.with-type-env (tc.clean varT))]
-    (wrap [knownT analysis])))
-
 (exception: #export (Variant-Tag-Out-Of-Bounds {message Text})
   message)
 
diff --git a/new-luxc/source/luxc/lang/analysis/primitive.lux b/new-luxc/source/luxc/lang/analysis/primitive.lux
deleted file mode 100644
index ff7908669..000000000
--- a/new-luxc/source/luxc/lang/analysis/primitive.lux
+++ /dev/null
@@ -1,30 +0,0 @@
-(.module:
-  lux
-  (lux (control monad)
-       [macro]
-       (macro [code])
-       (lang (type ["tc" check])))
-  (luxc ["&" lang]
-        (lang ["la" analysis #+ Analysis])))
-
-## [Analysers]
-(do-template [<name> <type> <tag>]
-  [(def: #export (<name> value)
-     (-> <type> (Meta Analysis))
-     (do macro.Monad<Meta>
-       [_ (&.infer <type>)]
-       (wrap (<tag> value))))]
-
-  [analyse-bool Bool code.bool]
-  [analyse-nat  Nat  code.nat]
-  [analyse-int  Int  code.int]
-  [analyse-deg  Deg  code.deg]
-  [analyse-frac Frac code.frac]
-  [analyse-text Text code.text]
-  )
-
-(def: #export analyse-unit
-  (Meta Analysis)
-  (do macro.Monad<Meta>
-    [_ (&.infer Top)]
-    (wrap (` []))))
diff --git a/new-luxc/test/test/luxc/lang/analysis/primitive.lux b/new-luxc/test/test/luxc/lang/analysis/primitive.lux
deleted file mode 100644
index aa3e30aab..000000000
--- a/new-luxc/test/test/luxc/lang/analysis/primitive.lux
+++ /dev/null
@@ -1,61 +0,0 @@
-(.module:
-  lux
-  (lux [io]
-       (control [monad #+ do]
-                pipe)
-       (data (text format)
-             ["e" error])
-       ["r" math/random]
-       [macro]
-       (macro [code])
-       (lang [type "type/" Eq<Type>])
-       test)
-  (luxc ["&" lang]
-        (lang ["&." module]
-              ["~" analysis]
-              (analysis [".A" expression]
-                        ["@" primitive]
-                        ["@." common])))
-  (// common)
-  (test/luxc common))
-
-(context: "Primitives"
-  (<| (times +100)
-      (do @
-        [%bool% r.bool
-         %nat% r.nat
-         %int% r.int
-         %deg% r.deg
-         %frac% r.frac
-         %text% (r.text +5)]
-        (`` ($_ seq
-                (test "Can analyse unit."
-                      (|> (@common.with-unknown-type
-                            @.analyse-unit)
-                          (macro.run (io.run init-jvm))
-                          (case> (^ (#e.Success [_type (^code [])]))
-                                 (type/= Top _type)
-
-                                 _
-                                 false))
-                      )
-                (~~ (do-template [<desc> <type> <tag> <value> <analyser>]
-                      [(test (format "Can analyse " <desc> ".")
-                             (|> (@common.with-unknown-type
-                                   (<analyser> <value>))
-                                 (macro.run (io.run init-jvm))
-                                 (case> (#e.Success [_type [_ (<tag> value)]])
-                                        (and (type/= <type> _type)
-                                             (is? <value> value))
-
-                                        _
-                                        false))
-                             )]
-
-                      ["bool" Bool #.Bool %bool% @.analyse-bool]
-                      ["nat"  Nat  #.Nat  %nat%  @.analyse-nat]
-                      ["int"  Int  #.Int  %int%  @.analyse-int]
-                      ["deg"  Deg  #.Deg  %deg%  @.analyse-deg]
-                      ["frac" Frac #.Frac %frac% @.analyse-frac]
-                      ["text" Text #.Text %text% @.analyse-text]
-                      )))))))