- Migrated primitive analysis to stdlib.

3 files changed, 0 insertions, 184 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 (` []))))