diff options
Diffstat (limited to 'new-luxc/source/luxc/base.lux')
| -rw-r--r-- | new-luxc/source/luxc/base.lux | 36 |
1 files changed, 24 insertions, 12 deletions
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux index bf9368abe..c0108da7e 100644 --- a/new-luxc/source/luxc/base.lux +++ b/new-luxc/source/luxc/base.lux @@ -1,12 +1,13 @@ (;module: lux - (lux (control monad) - (data [text "T/" Eq<Text>] + (lux (control [monad #+ do] + ["ex" exception #+ exception:]) + (data [text "text/" Eq<Text>] text/format [product] ["R" result]) - [macro #+ Monad<Lux>] - (type ["TC" check])) + [macro] + (type ["tc" check])) (luxc (lang ["la" analysis]))) (type: #export Eval @@ -26,7 +27,7 @@ (def: #export (fail message) (All [a] (-> Text (Lux a))) - (do Monad<Lux> + (do macro;Monad<Lux> [[file line col] macro;cursor #let [location (format file "," (|> line nat-to-int %i) @@ -37,9 +38,13 @@ (def: #export (assert message test) (-> Text Bool (Lux Unit)) (if test - (:: Monad<Lux> wrap []) + (:: macro;Monad<Lux> wrap []) (fail message))) +(def: #export (throw exception message) + (All [a] (-> ex;Exception Text (Lux a))) + (fail (exception message))) + (def: #export (with-expected-type expected action) (All [a] (-> Type (Lux a) (Lux a))) (function [compiler] @@ -53,7 +58,7 @@ (#R;Error error)))) (def: #export (within-type-env action) - (All [a] (-> (TC;Check a) (Lux a))) + (All [a] (-> (tc;Check a) (Lux a))) (function [compiler] (case (action (get@ #;type-context compiler)) (#R;Error error) @@ -63,6 +68,13 @@ (#R;Success [(set@ #;type-context context' compiler) output])))) +(def: #export (infer actualT) + (-> Type (Lux Unit)) + (do macro;Monad<Lux> + [expectedT macro;expected-type] + (within-type-env + (tc;check expectedT actualT)))) + (def: #export (pl-get key table) (All [a] (-> Text (List [Text a]) (Maybe a))) (case table @@ -70,7 +82,7 @@ #;None (#;Cons [k' v'] table') - (if (T/= key k') + (if (text/= key k') (#;Some v') (pl-get key table')))) @@ -90,7 +102,7 @@ (list [key val]) (#;Cons [k' v'] table') - (if (T/= key k') + (if (text/= key k') (#;Cons [key val] table') (#;Cons [k' v'] @@ -103,7 +115,7 @@ #;Nil (#;Cons [k' v'] table') - (if (T/= key k') + (if (text/= key k') (#;Cons [k' (f v')] table') (#;Cons [k' v'] (pl-update key f table'))))) @@ -127,7 +139,7 @@ (#R;Success [compiler' output]) (#R;Error error) - (#R;Error (if (T/= "" error) + (#R;Error (if (text/= "" error) (handler []) (format error "\n-----------------------------------------\n" (handler []))))))) @@ -161,7 +173,7 @@ (def: #export (with-cursor cursor action) (All [a] (-> Cursor (Lux a) (Lux a))) - (if (T/= "" (product;left cursor)) + (if (text/= "" (product;left cursor)) action (function [compiler] (let [old-cursor (get@ #;cursor compiler)] |