diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/case.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/expression.lux | 28 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/reference.lux | 13 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/structure.lux | 32 |
4 files changed, 46 insertions, 29 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux index 5d4c592aa..4a28ce436 100644 --- a/new-luxc/source/luxc/lang/analysis/case.lux +++ b/new-luxc/source/luxc/lang/analysis/case.lux @@ -239,7 +239,7 @@ (^ [cursor (#;Form (list& [_ (#;Tag tag)] values))]) (&;with-cursor cursor (do macro;Monad<Meta> - [tag (macro;normalize tag) + [tag (macro;canonical tag) [idx group variantT] (macro;resolve-tag tag) _ (&;with-type-env (tc;check inputT variantT))] diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux index 5d38f7626..89fb3b93e 100644 --- a/new-luxc/source/luxc/lang/analysis/expression.lux +++ b/new-luxc/source/luxc/lang/analysis/expression.lux @@ -29,14 +29,14 @@ (def: #export (analyser eval) (-> &;Eval &;Analyser) (: (-> Code (Meta la;Analysis)) - (function analyse [ast] + (function analyse [code] (do macro;Monad<Meta> [expectedT macro;expected-type] - (let [[cursor ast'] ast] + (let [[cursor code'] code] ## The cursor must be set in the compiler for the sake ## of having useful error messages. (&;with-cursor cursor - (case ast' + (case code' (^template [<tag> <analyser>] (<tag> value) (<analyser> value)) @@ -83,16 +83,18 @@ (^ (#;Form (list& func args))) (do macro;Monad<Meta> - [[funcT =func] (commonA;with-unknown-type + [[funcT funcA] (commonA;with-unknown-type (analyse func))] - (case =func + (case funcA [_ (#;Symbol def-name)] (do @ - [[def-type def-anns def-value] (macro;find-def def-name)] - (if (macro;macro? def-anns) + [?macro (&;with-error-tracking + (macro;find-macro def-name))] + (case ?macro + (#;Some macro) (do @ [expansion (function [compiler] - (case (macroL;expand (:! Macro def-value) args compiler) + (case (macroL;expand macro args compiler) (#e;Success [compiler' output]) (#e;Success [compiler' output]) @@ -103,12 +105,14 @@ (analyse single) _ - (&;throw Macro-Expression-Must-Have-Single-Expansion (%code ast)))) - (functionA;analyse-apply analyse funcT =func args))) + (&;throw Macro-Expression-Must-Have-Single-Expansion (%code code)))) + + _ + (functionA;analyse-apply analyse funcT funcA args))) _ - (functionA;analyse-apply analyse funcT =func args))) + (functionA;analyse-apply analyse funcT funcA args))) _ - (&;throw Unrecognized-Syntax (%code ast)) + (&;throw Unrecognized-Syntax (%code code)) ))))))) diff --git a/new-luxc/source/luxc/lang/analysis/reference.lux b/new-luxc/source/luxc/lang/analysis/reference.lux index 25b33881c..7475f269f 100644 --- a/new-luxc/source/luxc/lang/analysis/reference.lux +++ b/new-luxc/source/luxc/lang/analysis/reference.lux @@ -13,9 +13,16 @@ (def: (analyse-definition def-name) (-> Ident (Meta Analysis)) (do macro;Monad<Meta> - [actualT (macro;find-def-type def-name) - _ (&;infer actualT)] - (wrap (code;symbol def-name)))) + [[actualT def-anns _] (&;with-error-tracking + (macro;find-def def-name))] + (case (macro;get-symbol-ann (ident-for #;alias) def-anns) + (#;Some real-def-name) + (analyse-definition real-def-name) + + _ + (do @ + [_ (&;infer actualT)] + (wrap (code;symbol def-name)))))) (def: (analyse-variable var-name) (-> Text (Meta (Maybe Analysis))) 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)))))) |