diff options
Diffstat (limited to 'new-luxc/source/luxc/analyser')
-rw-r--r-- | new-luxc/source/luxc/analyser/structure.lux | 33 |
1 files changed, 31 insertions, 2 deletions
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 "") |