aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/analysis/structure.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis/structure.lux')
-rw-r--r--new-luxc/source/luxc/lang/analysis/structure.lux32
1 files changed, 19 insertions, 13 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
index 2292d93cf..19eebbc46 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -235,7 +235,7 @@
(def: #export (analyse-tagged-sum analyse tag valueC)
(-> &;Analyser Ident Code (Meta la;Analysis))
(do macro;Monad<Meta>
- [tag (macro;normalize tag)
+ [tag (macro;canonical tag)
[idx group variantT] (macro;resolve-tag tag)
expectedT macro;expected-type]
(case expectedT
@@ -261,7 +261,7 @@
(case key
[_ (#;Tag key)]
(do macro;Monad<Meta>
- [key (macro;normalize key)]
+ [key (macro;canonical key)]
(wrap [key val]))
_
@@ -281,7 +281,7 @@
(#;Cons [head-k head-v] _)
(do macro;Monad<Meta>
- [head-k (macro;normalize head-k)
+ [head-k (macro;canonical head-k)
[_ tag-set recordT] (macro;resolve-tag head-k)
#let [size-record (list;size record)
size-ts (list;size tag-set)]
@@ -296,7 +296,7 @@
idx->val (monad;fold @
(function [[key val] idx->val]
(do @
- [key (macro;normalize key)]
+ [key (macro;canonical key)]
(case (dict;get key tag->idx)
#;None
(&;throw Tag-Does-Not-Belong-To-Record
@@ -323,14 +323,20 @@
(-> &;Analyser (List [Code Code]) (Meta la;Analysis))
(do macro;Monad<Meta>
[members (normalize members)
- [membersC recordT] (order members)
- expectedT macro;expected-type]
- (case expectedT
- (#;Var _)
- (do @
- [inferenceT (&inference;record recordT)
- [inferredT membersA] (&inference;general analyse inferenceT membersC)]
- (wrap (la;product membersA)))
+ [membersC recordT] (order members)]
+ (case membersC
+ (^ (list singletonC))
+ (analyse singletonC)
_
- (analyse-product analyse membersC))))
+ (do @
+ [expectedT macro;expected-type]
+ (case expectedT
+ (#;Var _)
+ (do @
+ [inferenceT (&inference;record recordT)
+ [inferredT membersA] (&inference;general analyse inferenceT membersC)]
+ (wrap (la;product membersA)))
+
+ _
+ (analyse-product analyse membersC))))))