diff options
Diffstat (limited to 'new-luxc/source/luxc/lang.lux')
-rw-r--r-- | new-luxc/source/luxc/lang.lux | 145 |
1 files changed, 0 insertions, 145 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 |