- Heavy refactoring.

1 files changed, 0 insertions, 245 deletions

diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
deleted file mode 100644
index 373c6b12b..000000000
--- a/new-luxc/source/luxc/base.lux
+++ /dev/null
@@ -1,245 +0,0 @@
-(;module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:])
-       (data [maybe]
-             [product]
-             ["e" error]
-             [text "text/" Eq<Text>]
-             text/format
-             (coll [list]))
-       [meta]
-       (meta (type ["tc" check])
-             ["s" syntax #+ syntax:]))
-  (luxc (lang ["la" analysis])))
-
-(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 meta;Monad<Meta>
-    [[file line col] meta;cursor
-     #let [location (format file
-                            "," (|> line nat-to-int %i)
-                            "," (|> col nat-to-int %i))]]
-    (meta;fail (format message "\n\n"
-                       "@ " location))))
-
-(def: #export (throw exception message)
-  (All [a] (-> ex;Exception Text (Meta a)))
-  (fail (exception message)))
-
-(syntax: #export (assert exception message test)
-  (wrap (list (` (if (~ test)
-                   (:: meta;Monad<Meta> (~' wrap) [])
-                   (;;throw (~ exception) (~ message)))))))
-
-(def: #export (with-expected-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 Unit))
-  (do meta;Monad<Meta>
-    [expectedT meta;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
-    #;Nil
-    #;None
-
-    (#;Cons [k' v'] table')
-    (if (text/= key k')
-      (#;Some v')
-      (pl-get key table'))))
-
-(def: #export (pl-contains? key table)
-  (All [a] (-> Text (List [Text a]) Bool))
-  (case (pl-get key table)
-    (#;Some _)
-    true
-
-    #;None
-    false))
-
-(def: #export (pl-put key val table)
-  (All [a] (-> Text a (List [Text a]) (List [Text a])))
-  (case table
-    #;Nil
-    (list [key val])
-
-    (#;Cons [k' v'] table')
-    (if (text/= key k')
-      (#;Cons [key val]
-              table')
-      (#;Cons [k' v']
-              (pl-put key val table')))))
-
-(def: #export (pl-update key f table)
-  (All [a] (-> Text (-> a a) (List [Text a]) (List [Text a])))
-  (case table
-    #;Nil
-    #;Nil
-
-    (#;Cons [k' v'] table')
-    (if (text/= key k')
-      (#;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
-    (^ (char "*")) "_ASTER_"
-    (^ (char "+")) "_PLUS_"
-    (^ (char "-")) "_DASH_"
-    (^ (char "/")) "_SLASH_"
-    (^ (char "\\")) "_BSLASH_"
-    (^ (char "_")) "_UNDERS_"
-    (^ (char "%")) "_PERCENT_"
-    (^ (char "$")) "_DOLLAR_"
-    (^ (char "'")) "_QUOTE_"
-    (^ (char "`")) "_BQUOTE_"
-    (^ (char "@")) "_AT_"
-    (^ (char "^")) "_CARET_"
-    (^ (char "&")) "_AMPERS_"
-    (^ (char "=")) "_EQ_"
-    (^ (char "!")) "_BANG_"
-    (^ (char "?")) "_QM_"
-    (^ (char ":")) "_COLON_"
-    (^ (char ".")) "_PERIOD_"
-    (^ (char ",")) "_COMMA_"
-    (^ (char "<")) "_LT_"
-    (^ (char ">")) "_GT_"
-    (^ (char "~")) "_TILDE_"
-    (^ (char "|")) "_PIPE_"
-    _
-    (text;from-code char)))
-
-(def: underflow Nat (n.dec +0))
-
-(def: #export (normalize-name name)
-  (-> Text Text)
-  (loop [idx (n.dec (text;size name))
-         output ""]
-    (if (n.= underflow idx)
-      output
-      (recur (n.dec idx) (format (|> (text;nth idx name) maybe;assume normalize-char) output)))))