diff options
Diffstat (limited to 'new-luxc/source/luxc')
| -rw-r--r-- | new-luxc/source/luxc/analyser.lux | 32 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/structure.lux | 33 | ||||
| -rw-r--r-- | new-luxc/source/luxc/eval.lux | 17 |
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)))) |