diff options
Diffstat (limited to 'new-luxc/source/luxc/base.lux')
-rw-r--r-- | new-luxc/source/luxc/base.lux | 101 |
1 files changed, 48 insertions, 53 deletions
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux index fe57cc1dd..4c6202db1 100644 --- a/new-luxc/source/luxc/base.lux +++ b/new-luxc/source/luxc/base.lux @@ -5,73 +5,68 @@ (data [text "text/" Eq<Text>] text/format [product] - ["R" result]) - [macro] - (type ["tc" check])) + ["e" error]) + [meta] + (meta (type ["tc" check]))) (luxc (lang ["la" analysis]))) (type: #export Eval - (-> Type Code (Lux Top))) + (-> Type Code (Meta Top))) (type: #export Analyser - (-> Code (Lux la;Analysis))) + (-> Code (Meta la;Analysis))) (type: #export Path Text) -(type: #export Mode - #Build - #Eval - #REPL) - -(def: #export compiler-version Text "0.6.0") +(def: #export version Text "0.6.0") (def: #export (fail message) - (All [a] (-> Text (Lux a))) - (do macro;Monad<Lux> - [[file line col] macro;cursor + (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))]] - (macro;fail (format "@ " location - "\n" message)))) + (meta;fail (format "@ " location + "\n" message)))) (def: #export (assert message test) - (-> Text Bool (Lux Unit)) + (-> Text Bool (Meta Unit)) (if test - (:: macro;Monad<Lux> wrap []) + (:: meta;Monad<Meta> wrap []) (fail message))) (def: #export (throw exception message) - (All [a] (-> ex;Exception Text (Lux a))) + (All [a] (-> ex;Exception Text (Meta a))) (fail (exception message))) (def: #export (with-expected-type expected action) - (All [a] (-> Type (Lux a) (Lux a))) + (All [a] (-> Type (Meta a) (Meta a))) (function [compiler] (case (action (set@ #;expected (#;Some expected) compiler)) - (#R;Success [compiler' output]) + (#e;Success [compiler' output]) (let [old-expected (get@ #;expected compiler)] - (#R;Success [(set@ #;expected old-expected compiler') + (#e;Success [(set@ #;expected old-expected compiler') output])) - (#R;Error error) - (#R;Error error)))) + (#e;Error error) + (#e;Error error)))) (def: #export (with-type-env action) - (All [a] (-> (tc;Check a) (Lux a))) + (All [a] (-> (tc;Check a) (Meta a))) (function [compiler] (case (action (get@ #;type-context compiler)) - (#R;Error error) - (#R;Error error) + (#e;Error error) + (#e;Error error) - (#R;Success [context' output]) - (#R;Success [(set@ #;type-context context' compiler) + (#e;Success [context' output]) + (#e;Success [(set@ #;type-context context' compiler) output])))) (def: #export (infer actualT) - (-> Type (Lux Unit)) - (do macro;Monad<Lux> - [expectedT macro;expected-type] + (-> Type (Meta Unit)) + (do meta;Monad<Meta> + [expectedT meta;expected-type] (with-type-env (tc;check expectedT actualT)))) @@ -120,26 +115,26 @@ (#;Cons [k' v'] (pl-update key f table'))))) (def: #export (with-source-code source action) - (All [a] (-> [Cursor Text] (Lux a) (Lux a))) + (All [a] (-> [Cursor Text] (Meta a) (Meta a))) (function [compiler] (let [old-source (get@ #;source compiler)] (case (action (set@ #;source source compiler)) - (#R;Error error) - (#R;Error error) + (#e;Error error) + (#e;Error error) - (#R;Success [compiler' output]) - (#R;Success [(set@ #;source old-source compiler') + (#e;Success [compiler' output]) + (#e;Success [(set@ #;source old-source compiler') output]))))) (def: #export (with-stacked-errors handler action) - (All [a] (-> (-> [] Text) (Lux a) (Lux a))) + (All [a] (-> (-> [] Text) (Meta a) (Meta a))) (function [compiler] (case (action compiler) - (#R;Success [compiler' output]) - (#R;Success [compiler' output]) + (#e;Success [compiler' output]) + (#e;Success [compiler' output]) - (#R;Error error) - (#R;Error (if (text/= "" error) + (#e;Error error) + (#e;Error (if (text/= "" error) (handler []) (format error "\n-----------------------------------------\n" (handler []))))))) @@ -156,31 +151,31 @@ #;captured fresh-bindings}) (def: #export (with-scope action) - (All [a] (-> (Lux a) (Lux [Scope a]))) + (All [a] (-> (Meta a) (Meta [Scope a]))) (function [compiler] (case (action (update@ #;scopes (|>. (#;Cons fresh-scope)) compiler)) - (#R;Success [compiler' output]) + (#e;Success [compiler' output]) (case (get@ #;scopes compiler') #;Nil - (#R;Error "Impossible error: Drained scopes!") + (#e;Error "Impossible error: Drained scopes!") (#;Cons head tail) - (#R;Success [(set@ #;scopes tail compiler') + (#e;Success [(set@ #;scopes tail compiler') [head output]])) - (#R;Error error) - (#R;Error error)))) + (#e;Error error) + (#e;Error error)))) (def: #export (with-cursor cursor action) - (All [a] (-> Cursor (Lux a) (Lux a))) + (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)) - (#R;Success [compiler' output]) - (#R;Success [(set@ #;cursor old-cursor compiler') + (#e;Success [compiler' output]) + (#e;Success [(set@ #;cursor old-cursor compiler') output]) - (#R;Error error) - (#R;Error error)))))) + (#e;Error error) + (#e;Error error)))))) |