aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/base.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/base.lux')
-rw-r--r--new-luxc/source/luxc/base.lux36
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)]