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