diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis')
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/case.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/common.lux | 25 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/function.lux | 5 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/inference.lux | 12 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/structure.lux | 18 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/type.lux | 12 |
6 files changed, 33 insertions, 41 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux index f68733d7f..5f8ed344f 100644 --- a/new-luxc/source/luxc/lang/analysis/case.lux +++ b/new-luxc/source/luxc/lang/analysis/case.lux @@ -46,7 +46,7 @@ (#;Var id) (do meta;Monad<Meta> [? (&;with-type-env - (tc;bound? id))] + (tc;concrete? id))] (if ? (do @ [type' (&;with-type-env diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux index 4cbf5aedf..4d16e4ae6 100644 --- a/new-luxc/source/luxc/lang/analysis/common.lux +++ b/new-luxc/source/luxc/lang/analysis/common.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control monad - pipe) + ["ex" exception #+ exception:]) (data text/format [product]) [meta #+ Monad<Meta>] @@ -14,28 +14,25 @@ (All [a] (-> (Meta Analysis) (Meta [Type Analysis]))) (do Monad<Meta> [[var-id var-type] (&;with-type-env - tc;create) + tc;var) analysis (&;with-expected-type var-type action) analysis-type (&;with-type-env - (tc;clean var-id var-type)) - _ (&;with-type-env - (tc;delete var-id))] + (tc;clean var-id var-type))] (wrap [analysis-type analysis]))) (def: #export (with-var body) (All [a] (-> (-> [Nat Type] (Meta a)) (Meta a))) (do Monad<Meta> [[id var] (&;with-type-env - tc;create) - output (body [id var]) - _ (&;with-type-env - (tc;delete id))] - (wrap output))) + tc;var)] + (body [id var]))) + +(exception: #export Variant-Tag-Out-Of-Bounds) (def: #export (variant-out-of-bounds-error type size tag) (All [a] (-> Type Nat Nat (Meta a))) - (&;fail (format "Trying to create variant with tag beyond type's limitations." "\n" - " Tag: " (%i (nat-to-int tag)) "\n" - "Size: " (%i (nat-to-int size)) "\n" - "Type: " (%type type)))) + (&;throw Variant-Tag-Out-Of-Bounds + (format " Tag: " (%n tag) "\n" + "Variant Size: " (%n size) "\n" + "Variant Type: " (%type type)))) diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux index 5a6df4d3e..42a021577 100644 --- a/new-luxc/source/luxc/lang/analysis/function.lux +++ b/new-luxc/source/luxc/lang/analysis/function.lux @@ -108,8 +108,5 @@ (format "\n " (%n idx) " " (%code argC)))) (text;join-with ""))))) (do meta;Monad<Meta> - [expectedT meta;expected-type - [applyT argsA] (&inference;apply-function analyse funcT args) - _ (&;with-type-env - (tc;check expectedT applyT))] + [[applyT argsA] (&inference;apply-function analyse funcT args)] (wrap (la;apply argsA funcA))))) diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux index fea685024..e2866ac87 100644 --- a/new-luxc/source/luxc/lang/analysis/inference.lux +++ b/new-luxc/source/luxc/lang/analysis/inference.lux @@ -99,7 +99,9 @@ (-> &;Analyser Type (List Code) (Meta [Type (List Analysis)])) (case args #;Nil - (:: Monad<Meta> wrap [inferT (list)]) + (do Monad<Meta> + [_ (&;infer inferT)] + (wrap [inferT (list)])) (#;Cons argC args') (case inferT @@ -113,7 +115,7 @@ [[outputT argsA] (apply-function analyse (maybe;assume (type;apply (list varT) inferT)) args)] (do @ [? (&;with-type-env - (tc;bound? var-id)) + (tc;concrete? var-id)) ## Quantify over the type if genericity/parametricity ## is discovered. outputT' (if ? @@ -145,13 +147,13 @@ ## things together more easily. (#;Function inputT outputT) (do Monad<Meta> - [argA (&;with-stacked-errors + [[outputT' args'A] (apply-function analyse outputT args') + argA (&;with-stacked-errors (function [_] (Cannot-Infer-Argument (format "Inferred Type: " (%type inputT) "\n" " Argument: " (%code argC)))) (&;with-expected-type inputT - (analyse argC))) - [outputT' args'A] (apply-function analyse outputT args')] + (analyse argC)))] (wrap [outputT' (list& argA args'A)])) _ diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux index 5cac1a0d3..9308fcfef 100644 --- a/new-luxc/source/luxc/lang/analysis/structure.lux +++ b/new-luxc/source/luxc/lang/analysis/structure.lux @@ -64,9 +64,9 @@ (#;Var id) (do @ - [bound? (&;with-type-env - (tc;bound? id))] - (if bound? + [concrete? (&;with-type-env + (tc;concrete? id))] + (if concrete? (do @ [expectedT' (&;with-type-env (tc;read id))] @@ -171,9 +171,9 @@ (#;Var id) (do @ - [bound? (&;with-type-env - (tc;bound? id))] - (if bound? + [concrete? (&;with-type-env + (tc;concrete? id))] + (if concrete? (do @ [expectedT' (&;with-type-env (tc;read id))] @@ -227,8 +227,6 @@ [#let [case-size (list;size group)] inferenceT (&inference;variant idx case-size variantT) [inferredT valueA+] (&inference;apply-function analyse inferenceT (list valueC)) - _ (&;with-type-env - (tc;check expectedT inferredT)) temp &scope;next-local] (wrap (la;sum idx case-size temp (|> valueA+ list;head maybe;assume)))) @@ -308,9 +306,7 @@ (#;Var _) (do @ [inferenceT (&inference;record recordT) - [inferredT membersA] (&inference;apply-function analyse inferenceT membersC) - _ (&;with-type-env - (tc;check expectedT inferredT))] + [inferredT membersA] (&inference;apply-function analyse inferenceT membersC)] (wrap (la;product membersA))) _ diff --git a/new-luxc/source/luxc/lang/analysis/type.lux b/new-luxc/source/luxc/lang/analysis/type.lux index 74bb712f4..0a8abd76b 100644 --- a/new-luxc/source/luxc/lang/analysis/type.lux +++ b/new-luxc/source/luxc/lang/analysis/type.lux @@ -1,8 +1,8 @@ (;module: lux (lux (control monad) - [meta #+ Monad<Meta>] - (meta (type ["TC" check]))) + [meta] + (meta (type ["tc" check]))) (luxc ["&" base] (lang ["la" analysis #+ Analysis]))) @@ -11,21 +11,21 @@ ## computing Lux type values. (def: #export (analyse-check analyse eval type value) (-> &;Analyser &;Eval Code Code (Meta Analysis)) - (do Monad<Meta> + (do meta;Monad<Meta> [actualT (eval Type type) #let [actualT (:! Type actualT)] expectedT meta;expected-type _ (&;with-type-env - (TC;check expectedT actualT))] + (tc;check expectedT actualT))] (&;with-expected-type actualT (analyse value)))) (def: #export (analyse-coerce analyse eval type value) (-> &;Analyser &;Eval Code Code (Meta Analysis)) - (do Monad<Meta> + (do meta;Monad<Meta> [actualT (eval Type type) expectedT meta;expected-type _ (&;with-type-env - (TC;check expectedT (:! Type actualT)))] + (tc;check expectedT (:! Type actualT)))] (&;with-expected-type Top (analyse value)))) |