diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/inference.lux | 38 |
1 files changed, 27 insertions, 11 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux index c6f0323f7..e89ab2e1e 100644 --- a/new-luxc/source/luxc/lang/analysis/inference.lux +++ b/new-luxc/source/luxc/lang/analysis/inference.lux @@ -132,9 +132,9 @@ )) ## Turns a record type into the kind of function type suitable for inference. -(def: #export (record type) +(def: #export (record inferT) (-> Type (Meta Type)) - (case type + (case inferT (#;Named name unnamedT) (record unnamedT) @@ -146,17 +146,25 @@ ([#;UnivQ] [#;ExQ]) + (#;Apply inputT funcT) + (case (type;apply (list inputT) funcT) + (#;Some outputT) + (record outputT) + + #;None + (&;throw Invalid-Type-Application (%type inferT))) + (#;Product _) - (macro/wrap (type;function (type;flatten-tuple type) type)) + (macro/wrap (type;function (type;flatten-tuple inferT) inferT)) _ - (&;throw Not-A-Record-Type (%type type)))) + (&;throw Not-A-Record-Type (%type inferT)))) ## Turns a variant type into the kind of function type suitable for inference. -(def: #export (variant tag expected-size type) +(def: #export (variant tag expected-size inferT) (-> Nat Nat Type (Meta Type)) (loop [depth +0 - currentT type] + currentT inferT] (case currentT (#;Named name unnamedT) (do macro;Monad<Meta> @@ -182,12 +190,12 @@ (#;Some caseT) (macro/wrap (if (n.= +0 depth) (type;function (list caseT) currentT) - (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)] + (let [replace! (replace-bound (|> depth n.dec (n.* +2)) inferT)] (type;function (list (replace! caseT)) (replace! currentT))))) #;None - (&common;variant-out-of-bounds-error type expected-size tag)) + (&common;variant-out-of-bounds-error inferT expected-size tag)) (n.< expected-size actual-size) (&;throw Smaller-Variant-Than-Expected @@ -198,12 +206,20 @@ (let [caseT (type;variant (list;drop boundary cases))] (macro/wrap (if (n.= +0 depth) (type;function (list caseT) currentT) - (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)] + (let [replace! (replace-bound (|> depth n.dec (n.* +2)) inferT)] (type;function (list (replace! caseT)) (replace! currentT)))))) ## else - (&common;variant-out-of-bounds-error type expected-size tag))) + (&common;variant-out-of-bounds-error inferT expected-size tag))) + + (#;Apply inputT funcT) + (case (type;apply (list inputT) funcT) + (#;Some outputT) + (variant tag expected-size outputT) + + #;None + (&;throw Invalid-Type-Application (%type inferT))) _ - (&;throw Not-A-Variant-Type (%type type))))) + (&;throw Not-A-Variant-Type (%type inferT))))) |