aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r--new-luxc/source/luxc/analyser.lux32
-rw-r--r--new-luxc/source/luxc/analyser/structure.lux33
-rw-r--r--new-luxc/source/luxc/eval.lux17
3 files changed, 64 insertions, 18 deletions
diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux
index 3272057f2..f17ec8496 100644
--- a/new-luxc/source/luxc/analyser.lux
+++ b/new-luxc/source/luxc/analyser.lux
@@ -76,16 +76,12 @@
body)))
(&&function;analyse-function analyse func-name arg-name body)
- (^ (#;Form (list [_ (#;Symbol ["" "_lux_check"])]
- type
- value)))
- (&&type;analyse-check analyse eval type value)
-
- (^ (#;Form (list [_ (#;Symbol ["" "_lux_coerce"])]
- type
- value)))
- (&&type;analyse-coerce analyse eval type value)
-
+ (^template [<proc> <analyser>]
+ (^ (#;Form (list [_ (#;Symbol ["" <proc>])] type value)))
+ (<analyser> analyse eval type value))
+ (["_lux_check" &&type;analyse-check]
+ ["_lux_coerce" &&type;analyse-coerce])
+
(^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
(&&procedure;analyse-procedure analyse proc-name proc-args)
@@ -96,13 +92,17 @@
[paired (to-branches branches)]
(&&case;analyse-case analyse input paired))
- (^ (#;Form (list [_ (#;Nat tag)]
- value)))
- (&&structure;analyse-sum analyse tag value)
+ (^template [<tag> <analyser>]
+ (^ (#;Form (list& [_ (<tag> tag)]
+ values)))
+ (case values
+ (#;Cons value #;Nil)
+ (<analyser> analyse tag value)
- (^ (#;Form (list [_ (#;Tag tag)]
- value)))
- (&&structure;analyse-tagged-sum analyse tag value)
+ _
+ (<analyser> analyse tag (` [(~@ values)]))))
+ ([#;Nat &&structure;analyse-sum]
+ [#;Tag &&structure;analyse-tagged-sum])
(^ (#;Form (list& func args)))
(do Monad<Lux>
diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux
index e13d1d88a..9a42db0fa 100644
--- a/new-luxc/source/luxc/analyser/structure.lux
+++ b/new-luxc/source/luxc/analyser/structure.lux
@@ -24,12 +24,23 @@
(analyser ["&;" common]
["&;" inference])))
+(type: Type-Error
+ (-> Type Text))
+
+(def: (not-variant type)
+ Type-Error
+ (format "Invalid type for variant: " (%type type)))
+
+(def: (not-quantified type)
+ Type-Error
+ (format "Not a quantified type: " (%type type)))
+
(def: #export (analyse-sum analyse tag valueC)
(-> &;Analyser Nat Code (Lux la;Analysis))
(do Monad<Lux>
[expected macro;expected-type]
(&;with-stacked-errors
- (function [_] (format "Invalid type for variant: " (%type expected)))
+ (function [_] (not-variant expected))
(case expected
(#;Sum _)
(let [flat (type;flatten-variant expected)
@@ -62,7 +73,7 @@
## Cannot do inference when the tag is numeric.
## This is because there is no way of knowing how many
## cases the inferred sum type would have.
- (&;fail (format "Invalid type for variant: " (%type expected)))))
+ (&;fail (not-variant expected))))
(#;UnivQ _)
(do @
@@ -76,6 +87,15 @@
(function [[var-id var]]
(&;with-expected-type (assume (type;apply (list var) expected))
(analyse-sum analyse tag valueC))))
+
+ (#;Apply inputT funT)
+ (case (type;apply (list inputT) funT)
+ #;None
+ (&;fail (not-quantified funT))
+
+ (#;Some outputT)
+ (&;with-expected-type outputT
+ (analyse-sum analyse tag valueC)))
_
(&;fail "")))))
@@ -173,6 +193,15 @@
(function [[var-id var]]
(&;with-expected-type (assume (type;apply (list var) expected))
(analyse-product analyse membersC))))
+
+ (#;Apply inputT funT)
+ (case (type;apply (list inputT) funT)
+ #;None
+ (&;fail (not-quantified funT))
+
+ (#;Some outputT)
+ (&;with-expected-type outputT
+ (analyse-product analyse membersC)))
_
(&;fail "")
diff --git a/new-luxc/source/luxc/eval.lux b/new-luxc/source/luxc/eval.lux
new file mode 100644
index 000000000..266becee6
--- /dev/null
+++ b/new-luxc/source/luxc/eval.lux
@@ -0,0 +1,17 @@
+(;module:
+ lux
+ (lux (control [monad #+ do])
+ [macro])
+ [../base]
+ (.. [analyser]
+ [synthesizer]
+ (generator [expr]
+ [eval])))
+
+(def: #export (eval type exprC)
+ ../base;Eval
+ (do macro;Monad<Lux>
+ [exprA (../base;with-expected-type type
+ (analyser;analyser eval exprC))
+ #let [exprS (synthesizer;synthesize exprA)]]
+ (eval;eval (expr;generate exprS))))