diff options
author | Eduardo Julian | 2017-11-22 20:37:41 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-22 20:37:41 -0400 |
commit | 0e3830be97930a01c38d8bca09a1ac9d5bf55465 (patch) | |
tree | 3078996542de6d53baa43388d0bca96e2b517aa9 /new-luxc/source/luxc/lang/analysis/inference.lux | |
parent | e37e3713e080606930a5f8442f03dabc4c26a7f9 (diff) |
- Fixed some bugs.
- Some refactoring.
- Added some alternative snippets of code that new-luxc can handle better.
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis/inference.lux')
-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))))) |