diff options
Diffstat (limited to 'new-luxc/source/luxc/analyser')
| -rw-r--r-- | new-luxc/source/luxc/analyser/case.lux | 58 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/case/coverage.lux | 40 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/common.lux | 16 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/function.lux | 18 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/inference.lux | 34 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/primitive.lux | 16 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/procedure.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/procedure/common.lux | 20 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/procedure/host.jvm.lux | 212 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/reference.lux | 24 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/structure.lux | 64 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/type.lux | 16 |
12 files changed, 260 insertions, 260 deletions
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux index 4b327fb6d..b65b9ff94 100644 --- a/new-luxc/source/luxc/analyser/case.lux +++ b/new-luxc/source/luxc/analyser/case.lux @@ -5,15 +5,15 @@ (data [bool] [number] [product] - ["R" result] + ["e" error] [maybe] [text] text/format (coll [list "list/" Fold<List> Monoid<List> Functor<List>])) - [macro] - (macro [code]) - [type] - (type ["tc" check])) + [meta] + (meta [code] + [type] + (type ["tc" check]))) (../.. ["&" base] (lang ["la" analysis]) ["&;" scope]) @@ -34,10 +34,10 @@ ## This function makes it easier for "case" analysis to properly ## type-check the input with respect to the patterns. (def: (simplify-case-type type) - (-> Type (Lux Type)) + (-> Type (Meta Type)) (case type (#;Var id) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [? (&;with-type-env (tc;bound? id))] (if ? @@ -51,13 +51,13 @@ (simplify-case-type unnamedT) (^or (#;UnivQ _) (#;ExQ _)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [[ex-id exT] (&;with-type-env tc;existential)] (simplify-case-type (maybe;assume (type;apply (list exT) type)))) _ - (:: macro;Monad<Lux> wrap type))) + (:: meta;Monad<Meta> wrap type))) ## This function handles several concerns at once, but it must be that ## way because those concerns are interleaved when doing @@ -76,11 +76,11 @@ ## That is why the body must be analysed in the context of the ## pattern, and not separately. (def: (analyse-pattern num-tags inputT pattern next) - (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a]))) + (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la;Pattern a]))) (case pattern [cursor (#;Symbol ["" name])] (&;with-cursor cursor - (do macro;Monad<Lux> + (do meta;Monad<Meta> [outputA (&scope;with-local [name inputT] next) idx &scope;next-local] @@ -93,7 +93,7 @@ (^template [<type> <code-tag> <pattern-tag>] [cursor (<code-tag> test)] (&;with-cursor cursor - (do macro;Monad<Lux> + (do meta;Monad<Meta> [_ (&;with-type-env (tc;check inputT <type>)) outputA next] @@ -107,7 +107,7 @@ (^ [cursor (#;Tuple (list))]) (&;with-cursor cursor - (do macro;Monad<Lux> + (do meta;Monad<Meta> [_ (&;with-type-env (tc;check inputT Unit)) outputA next] @@ -118,7 +118,7 @@ [cursor (#;Tuple sub-patterns)] (&;with-cursor cursor - (do macro;Monad<Lux> + (do meta;Monad<Meta> [inputT' (simplify-case-type inputT)] (case inputT' (#;Product _) @@ -139,11 +139,11 @@ )] (do @ [[memberP+ thenA] (list/fold (: (All [a] - (-> [Type Code] (Lux [(List la;Pattern) a]) - (Lux [(List la;Pattern) a]))) + (-> [Type Code] (Meta [(List la;Pattern) a]) + (Meta [(List la;Pattern) a]))) (function [[memberT memberC] then] (do @ - [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Lux a) (Lux [la;Pattern a]))) + [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la;Pattern a]))) analyse-pattern) #;None memberT memberC then)] (wrap [(list& memberP memberP+) thenA])))) @@ -158,7 +158,7 @@ ))) [cursor (#;Record record)] - (do macro;Monad<Lux> + (do meta;Monad<Meta> [record (&structure;normalize record) [members recordT] (&structure;order record) _ (&;with-type-env @@ -171,7 +171,7 @@ (^ [cursor (#;Form (list& [_ (#;Nat idx)] values))]) (&;with-cursor cursor - (do macro;Monad<Lux> + (do meta;Monad<Meta> [inputT' (simplify-case-type inputT)] (case inputT' (#;Sum _) @@ -183,14 +183,14 @@ (n.< num-cases idx)) (if (and (n.> num-cases size-sum) (n.= (n.dec num-cases) idx)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [[testP nextA] (analyse-pattern #;None (type;variant (list;drop (n.dec num-cases) flat-sum)) (` [(~@ values)]) next)] (wrap [(#la;VariantP idx num-cases testP) nextA])) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)] (wrap [(#la;VariantP idx num-cases testP) nextA]))) @@ -203,9 +203,9 @@ (^ [cursor (#;Form (list& [_ (#;Tag tag)] values))]) (&;with-cursor cursor - (do macro;Monad<Lux> - [tag (macro;normalize tag) - [idx group variantT] (macro;resolve-tag tag) + (do meta;Monad<Meta> + [tag (meta;normalize tag) + [idx group variantT] (meta;resolve-tag tag) _ (&;with-type-env (tc;check inputT variantT))] (analyse-pattern (#;Some (list;size group)) inputT (` ((~ (code;nat idx)) (~@ values))) next))) @@ -215,13 +215,13 @@ )) (def: #export (analyse-case analyse input branches) - (-> &;Analyser Code (List [Code Code]) (Lux la;Analysis)) + (-> &;Analyser Code (List [Code Code]) (Meta la;Analysis)) (case branches #;Nil (&;fail "Cannot have empty branches in pattern-matching expression.") (#;Cons [patternH bodyH] branchesT) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [[inputT inputA] (&common;with-unknown-type (analyse input)) outputH (analyse-pattern #;None inputT patternH (analyse bodyH)) @@ -229,15 +229,15 @@ (function [[patternT bodyT]] (analyse-pattern #;None inputT patternT (analyse bodyT))) branchesT) - _ (case (monad;fold R;Monad<Result> + _ (case (monad;fold e;Monad<Error> &&coverage;merge (|> outputH product;left &&coverage;determine) (list/map (|>. product;left &&coverage;determine) outputT)) - (#R;Success coverage) + (#e;Success coverage) (if (&&coverage;exhaustive? coverage) (wrap []) (&;fail "Pattern-matching is not exhaustive.")) - (#R;Error error) + (#e;Error error) (&;fail error))] (wrap (#la;Case inputA (#;Cons outputH outputT)))))) diff --git a/new-luxc/source/luxc/analyser/case/coverage.lux b/new-luxc/source/luxc/analyser/case/coverage.lux index 94aa06e9b..cb066a2bf 100644 --- a/new-luxc/source/luxc/analyser/case/coverage.lux +++ b/new-luxc/source/luxc/analyser/case/coverage.lux @@ -4,7 +4,7 @@ eq) (data [bool "B/" Eq<Bool>] [number] - ["R" result "R/" Monad<Result>] + ["e" error "error/" Monad<Error>] (coll [list "L/" Fold<List>] ["D" dict]))) (luxc (lang ["la" analysis]))) @@ -97,8 +97,8 @@ ## Because of that, the presence of redundant patterns is assumed to ## be a bug, likely due to programmer carelessness. (def: redundant-pattern - (R;Result Coverage) - (R;fail "Redundant pattern.")) + (e;Error Coverage) + (e;fail "Redundant pattern.")) (def: (flatten-alt coverage) (-> Coverage (List Coverage)) @@ -144,7 +144,7 @@ ## pattern-matching expression is exhaustive and whether it contains ## redundant patterns. (def: #export (merge addition so-far) - (-> Coverage Coverage (R;Result Coverage)) + (-> Coverage Coverage (e;Error Coverage)) (case [addition so-far] ## The addition cannot possibly improve the coverage. [_ #Exhaustive] @@ -152,25 +152,25 @@ ## The addition completes the coverage. [#Exhaustive _] - (R/wrap #Exhaustive) + (error/wrap #Exhaustive) [#Partial #Partial] - (R/wrap #Partial) + (error/wrap #Partial) ## 2 boolean coverages are exhaustive if they compliment one another. (^multi [(#Bool sideA) (#Bool sideSF)] (xor sideA sideSF)) - (R/wrap #Exhaustive) + (error/wrap #Exhaustive) [(#Variant allA casesA) (#Variant allSF casesSF)] (cond (not (n.= allSF allA)) - (R;fail "Variants do not match.") + (e;fail "Variants do not match.") (:: (D;Eq<Dict> Eq<Coverage>) = casesSF casesA) redundant-pattern ## else - (do R;Monad<Result> + (do e;Monad<Error> [casesM (monad;fold @ (function [[tagA coverageA] casesSF'] (case (D;get tagA casesSF') @@ -196,11 +196,11 @@ ## The 2 sequences cannot possibly be merged. [false false] - (R/wrap (#Alt so-far addition)) + (error/wrap (#Alt so-far addition)) ## Same prefix [true false] - (do R;Monad<Result> + (do e;Monad<Error> [rightM (merge rightA rightSF)] (if (exhaustive? rightM) ## If all that follows is exhaustive, then it can be safely dropped @@ -211,7 +211,7 @@ ## Same suffix [false true] - (do R;Monad<Result> + (do e;Monad<Error> [leftM (merge leftA leftSF)] (wrap (#Seq leftM rightA)))) @@ -223,7 +223,7 @@ ## The right part is not necessary, since it can always match the left. (^multi [single (#Seq left right)] (C/= left single)) - (R/wrap single) + (error/wrap single) ## When merging a new coverage against one based on Alt, it may be ## that one of the many coverages in the Alt is complementary to @@ -235,10 +235,10 @@ ## This process must be repeated until no further productive ## merges can be done. [_ (#Alt leftS rightS)] - (do R;Monad<Result> + (do e;Monad<Error> [#let [fuse-once (: (-> Coverage (List Coverage) - (R;Result [(Maybe Coverage) - (List Coverage)])) + (e;Error [(Maybe Coverage) + (List Coverage)])) (function [coverage possibilities] (loop [alts possibilities] (case alts @@ -247,7 +247,7 @@ (#;Cons alt alts') (case (merge coverage alt) - (#R;Success altM) + (#e;Success altM) (case altM (#Alt _) (do @ @@ -257,8 +257,8 @@ _ (wrap [(#;Some altM) alts'])) - (#R;Error error) - (R;fail error)) + (#e;Error error) + (e;fail error)) ))))] [success possibilities] (fuse-once addition (flatten-alt so-far))] (loop [success success @@ -284,4 +284,4 @@ ## The addition cannot possibly improve the coverage. redundant-pattern ## There are now 2 alternative paths. - (R/wrap (#Alt so-far addition))))) + (error/wrap (#Alt so-far addition))))) diff --git a/new-luxc/source/luxc/analyser/common.lux b/new-luxc/source/luxc/analyser/common.lux index b9142713c..4cbf5aedf 100644 --- a/new-luxc/source/luxc/analyser/common.lux +++ b/new-luxc/source/luxc/analyser/common.lux @@ -4,15 +4,15 @@ pipe) (data text/format [product]) - [macro #+ Monad<Lux>] - [type] - (type ["tc" check])) + [meta #+ Monad<Meta>] + (meta [type] + (type ["tc" check]))) (luxc ["&" base] (lang analysis))) (def: #export (with-unknown-type action) - (All [a] (-> (Lux Analysis) (Lux [Type Analysis]))) - (do Monad<Lux> + (All [a] (-> (Meta Analysis) (Meta [Type Analysis]))) + (do Monad<Meta> [[var-id var-type] (&;with-type-env tc;create) analysis (&;with-expected-type var-type @@ -24,8 +24,8 @@ (wrap [analysis-type analysis]))) (def: #export (with-var body) - (All [a] (-> (-> [Nat Type] (Lux a)) (Lux a))) - (do Monad<Lux> + (All [a] (-> (-> [Nat Type] (Meta a)) (Meta a))) + (do Monad<Meta> [[id var] (&;with-type-env tc;create) output (body [id var]) @@ -34,7 +34,7 @@ (wrap output))) (def: #export (variant-out-of-bounds-error type size tag) - (All [a] (-> Type Nat Nat (Lux a))) + (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" diff --git a/new-luxc/source/luxc/analyser/function.lux b/new-luxc/source/luxc/analyser/function.lux index f9fde0eab..424a3188f 100644 --- a/new-luxc/source/luxc/analyser/function.lux +++ b/new-luxc/source/luxc/analyser/function.lux @@ -5,9 +5,9 @@ [text] text/format (coll [list "list/" Fold<List> Monoid<List> Monad<List>])) - [macro #+ Monad<Lux>] - [type] - (type ["tc" check])) + [meta #+ Monad<Meta>] + (meta [type] + (type ["tc" check]))) (luxc ["&" base] (lang ["la" analysis #+ Analysis]) ["&;" scope] @@ -16,9 +16,9 @@ ## [Analysers] (def: #export (analyse-function analyse func-name arg-name body) - (-> &;Analyser Text Text Code (Lux Analysis)) - (do Monad<Lux> - [functionT macro;expected-type] + (-> &;Analyser Text Text Code (Meta Analysis)) + (do Monad<Meta> + [functionT meta;expected-type] (loop [expected functionT] (&;with-stacked-errors (function [_] (format "Functions require function types: " (type;to-text expected))) @@ -90,12 +90,12 @@ ))))) (def: #export (analyse-apply analyse funcT funcA args) - (-> &;Analyser Type Analysis (List Code) (Lux Analysis)) + (-> &;Analyser Type Analysis (List Code) (Meta Analysis)) (&;with-stacked-errors (function [_] (format "Cannot apply function " (%type funcT) " to args: " (|> args (list/map %code) (text;join-with " ")))) - (do Monad<Lux> - [expected macro;expected-type + (do Monad<Meta> + [expected meta;expected-type [applyT argsA] (&inference;apply-function analyse funcT args) _ (&;with-type-env (tc;check expected applyT))] diff --git a/new-luxc/source/luxc/analyser/inference.lux b/new-luxc/source/luxc/analyser/inference.lux index 9b2411249..edb90e73d 100644 --- a/new-luxc/source/luxc/analyser/inference.lux +++ b/new-luxc/source/luxc/analyser/inference.lux @@ -4,9 +4,9 @@ (data [maybe] text/format (coll [list "L/" Functor<List>])) - [macro #+ Monad<Lux>] - [type] - (type ["tc" check])) + [meta #+ Monad<Meta>] + (meta [type] + (type ["tc" check]))) (luxc ["&" base] (lang ["la" analysis #+ Analysis]) (analyser ["&;" common]))) @@ -61,10 +61,10 @@ ## But, so long as the type being used for the inference can be trated ## as a function type, this method of inference should work. (def: #export (apply-function analyse funcT args) - (-> &;Analyser Type (List Code) (Lux [Type (List Analysis)])) + (-> &;Analyser Type (List Code) (Meta [Type (List Analysis)])) (case args #;Nil - (:: Monad<Lux> wrap [funcT (list)]) + (:: Monad<Meta> wrap [funcT (list)]) (#;Cons arg args') (case funcT @@ -74,7 +74,7 @@ (#;UnivQ _) (&common;with-var (function [[var-id varT]] - (do Monad<Lux> + (do Monad<Meta> [[outputT argsA] (apply-function analyse (maybe;assume (type;apply (list varT) funcT)) args)] (do @ [? (&;with-type-env @@ -88,7 +88,7 @@ (wrap [outputT' argsA]))))) (#;ExQ _) - (do Monad<Lux> + (do Monad<Meta> [[ex-id exT] (&;with-type-env tc;existential)] (apply-function analyse (maybe;assume (type;apply (list exT) funcT)) args)) @@ -101,7 +101,7 @@ ## avoided in Lux code, since the inference algorithm can piece ## things together more easily. (#;Function inputT outputT) - (do Monad<Lux> + (do Monad<Meta> [[outputT' args'A] (apply-function analyse outputT args') argA (&;with-stacked-errors (function [_] (format "Expected type: " (%type inputT) "\n" @@ -116,39 +116,39 @@ ## Turns a record type into the kind of function type suitable for inference. (def: #export (record-inference-type type) - (-> Type (Lux Type)) + (-> Type (Meta Type)) (case type (#;Named name unnamedT) - (do Monad<Lux> + (do Monad<Meta> [unnamedT+ (record-inference-type unnamedT)] (wrap (#;Named name unnamedT+))) (^template [<tag>] (<tag> env bodyT) - (do Monad<Lux> + (do Monad<Meta> [bodyT+ (record-inference-type bodyT)] (wrap (<tag> env bodyT+)))) ([#;UnivQ] [#;ExQ]) (#;Product _) - (:: Monad<Lux> wrap (type;function (type;flatten-tuple type) type)) + (:: Monad<Meta> wrap (type;function (type;flatten-tuple type) type)) _ (&;fail (format "Not a record type: " (%type type))))) ## Turns a variant type into the kind of function type suitable for inference. (def: #export (variant-inference-type tag expected-size type) - (-> Nat Nat Type (Lux Type)) + (-> Nat Nat Type (Meta Type)) (case type (#;Named name unnamedT) - (do Monad<Lux> + (do Monad<Meta> [unnamedT+ (variant-inference-type tag expected-size unnamedT)] (wrap (#;Named name unnamedT+))) (^template [<tag>] (<tag> env bodyT) - (do Monad<Lux> + (do Monad<Meta> [bodyT+ (variant-inference-type tag expected-size bodyT)] (wrap (<tag> env bodyT+)))) ([#;UnivQ] @@ -163,7 +163,7 @@ (n.< boundary tag))) (case (list;nth tag cases) (#;Some caseT) - (:: Monad<Lux> wrap (type;function (list caseT) type)) + (:: Monad<Meta> wrap (type;function (list caseT) type)) #;None (&common;variant-out-of-bounds-error type expected-size tag)) @@ -175,7 +175,7 @@ (n.= boundary tag) (let [caseT (type;variant (list;drop boundary cases))] - (:: Monad<Lux> wrap (type;function (list caseT) type))) + (:: Monad<Meta> wrap (type;function (list caseT) type))) ## else (&common;variant-out-of-bounds-error type expected-size tag))) diff --git a/new-luxc/source/luxc/analyser/primitive.lux b/new-luxc/source/luxc/analyser/primitive.lux index 127e5896c..0023e43e0 100644 --- a/new-luxc/source/luxc/analyser/primitive.lux +++ b/new-luxc/source/luxc/analyser/primitive.lux @@ -1,17 +1,17 @@ (;module: lux (lux (control monad) - [macro #+ Monad<Lux>] - (type ["TC" check])) + [meta #+ Monad<Meta>] + (meta (type ["TC" check]))) (luxc ["&" base] (lang ["la" analysis #+ Analysis]))) ## [Analysers] (do-template [<name> <type> <tag>] [(def: #export (<name> value) - (-> <type> (Lux Analysis)) - (do Monad<Lux> - [expected macro;expected-type + (-> <type> (Meta Analysis)) + (do Monad<Meta> + [expected meta;expected-type _ (&;with-type-env (TC;check expected <type>))] (wrap (<tag> value))))] @@ -25,9 +25,9 @@ ) (def: #export analyse-unit - (Lux Analysis) - (do Monad<Lux> - [expected macro;expected-type + (Meta Analysis) + (do Monad<Meta> + [expected meta;expected-type _ (&;with-type-env (TC;check expected Unit))] (wrap #la;Unit))) diff --git a/new-luxc/source/luxc/analyser/procedure.lux b/new-luxc/source/luxc/analyser/procedure.lux index 23fbae198..53ad8276c 100644 --- a/new-luxc/source/luxc/analyser/procedure.lux +++ b/new-luxc/source/luxc/analyser/procedure.lux @@ -16,7 +16,7 @@ (dict;merge ./host;procedures))) (def: #export (analyse-procedure analyse proc-name proc-args) - (-> &;Analyser Text (List Code) (Lux la;Analysis)) + (-> &;Analyser Text (List Code) (Meta la;Analysis)) (<| (maybe;default (&;fail (format "Unknown procedure: " (%t proc-name)))) (do maybe;Monad<Maybe> [proc (dict;get proc-name procedures)] diff --git a/new-luxc/source/luxc/analyser/procedure/common.lux b/new-luxc/source/luxc/analyser/procedure/common.lux index a0f739f3b..04aa35e05 100644 --- a/new-luxc/source/luxc/analyser/procedure/common.lux +++ b/new-luxc/source/luxc/analyser/procedure/common.lux @@ -5,10 +5,10 @@ (data [text] text/format (coll [list "list/" Functor<List>] - [array #+ Array] + [array] [dict #+ Dict])) - [macro #+ Monad<Lux>] - (type ["tc" check]) + [meta #+ Monad<Meta>] + (meta (type ["tc" check])) [io]) (luxc ["&" base] (lang ["la" analysis]) @@ -16,7 +16,7 @@ ## [Utils] (type: #export Proc - (-> &;Analyser (List Code) (Lux la;Analysis))) + (-> &;Analyser (List Code) (Meta la;Analysis))) (type: #export Bundle (Dict Text Proc)) @@ -45,13 +45,13 @@ (function [analyse args] (let [num-actual (list;size args)] (if (n.= num-expected num-actual) - (do Monad<Lux> + (do Monad<Meta> [argsA (monad;map @ (function [[argT argC]] (&;with-expected-type argT (analyse argC))) (list;zip2 input-types args)) - expected macro;expected-type + expected meta;expected-type _ (&;with-type-env (tc;check expected output-type))] (wrap (#la;Procedure proc argsA))) @@ -92,12 +92,12 @@ (function [[var-id varT]] (case args (^ (list opC)) - (do Monad<Lux> + (do Monad<Meta> [opA (&;with-expected-type (type (io;IO varT)) (analyse opC)) outputT (&;with-type-env (tc;clean var-id (type (Either Text varT)))) - expected macro;expected-type + expected meta;expected-type _ (&;with-type-env (tc;check expected outputT))] (wrap (#la;Procedure proc (list opA)))) @@ -285,12 +285,12 @@ (function [[var-id varT]] (case args (^ (list initC)) - (do Monad<Lux> + (do Monad<Meta> [initA (&;with-expected-type varT (analyse initC)) outputT (&;with-type-env (tc;clean var-id (type (A;Atom varT)))) - expected macro;expected-type + expected meta;expected-type _ (&;with-type-env (tc;check expected outputT))] (wrap (#la;Procedure proc (list initA)))) diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux index ca4eb762f..ff4f0f3d6 100644 --- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux @@ -4,7 +4,7 @@ ["p" parser] ["ex" exception #+ exception:]) (concurrency ["A" atom]) - (data ["R" result] + (data ["e" error] [maybe] [product] [bool "bool/" Eq<Bool>] @@ -12,12 +12,12 @@ (text format ["l" lexer]) (coll [list "list/" Fold<List> Functor<List> Monoid<List>] - [array #+ Array] + [array] [dict #+ Dict])) - [macro "lux/" Monad<Lux>] - (macro ["s" syntax]) - [type] - (type ["tc" check]) + [meta "meta/" Monad<Meta>] + (meta ["s" syntax] + [type] + (type ["tc" check])) [host]) (luxc ["&" base] ["&;" host] @@ -152,7 +152,7 @@ (function [[var-id varT]] (case args (^ (list arrayC)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [arrayA (&;with-expected-type (type (Array varT)) (analyse arrayC)) _ (&;infer Nat)] @@ -170,11 +170,11 @@ (function [analyse args] (case args (^ (list lengthC)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [lengthA (&;with-expected-type Nat (analyse lengthC)) - expectedT macro;expected-type - [level elem-class] (: (Lux [Nat Text]) + expectedT meta;expected-type + [level elem-class] (: (Meta [Nat Text]) (loop [analysisT expectedT level +0] (case analysisT @@ -206,10 +206,10 @@ (format "Non-object type: " (%type type))) (def: (check-jvm objectT) - (-> Type (Lux Text)) + (-> Type (Meta Text)) (case objectT (#;Host name _) - (lux/wrap name) + (meta/wrap name) (#;Named name unnamed) (check-jvm unnamed) @@ -232,16 +232,16 @@ (&;fail (not-object objectT)))) (def: (check-object objectT) - (-> Type (Lux Text)) - (do macro;Monad<Lux> + (-> Type (Meta Text)) + (do meta;Monad<Meta> [name (check-jvm objectT)] (if (dict;contains? name boxes) (&;fail (format "Primitives are not objects: " name)) - (:: macro;Monad<Lux> wrap name)))) + (:: meta;Monad<Meta> wrap name)))) (def: (box-array-element-type elemT) - (-> Type (Lux [Type Text])) - (do macro;Monad<Lux> + (-> Type (Meta [Type Text])) + (do meta;Monad<Meta> [] (case elemT (#;Host name #;Nil) @@ -253,7 +253,7 @@ (#;Host name _) (if (dict;contains? name boxes) (&;fail (format "Primitives cannot be parameterized: " name)) - (:: macro;Monad<Lux> wrap [elemT name])) + (:: meta;Monad<Meta> wrap [elemT name])) _ (&;fail (format "Invalid type for array element: " (%type elemT)))))) @@ -265,7 +265,7 @@ (function [[var-id varT]] (case args (^ (list arrayC idxC)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [arrayA (&;with-expected-type (type (Array varT)) (analyse arrayC)) elemT (&;with-type-env @@ -286,7 +286,7 @@ (function [[var-id varT]] (case args (^ (list arrayC idxC valueC)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [arrayA (&;with-expected-type (type (Array varT)) (analyse arrayC)) elemT (&;with-type-env @@ -317,8 +317,8 @@ (function [analyse args] (case args (^ (list)) - (do macro;Monad<Lux> - [expectedT macro;expected-type + (do meta;Monad<Meta> + [expectedT meta;expected-type _ (check-object expectedT)] (wrap (#la;Procedure proc (list)))) @@ -332,7 +332,7 @@ (function [[var-id varT]] (case args (^ (list objectC)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [objectA (&;with-expected-type varT (analyse objectC)) objectT (&;with-type-env @@ -351,7 +351,7 @@ (function [[var-id varT]] (case args (^ (list monitorC exprC)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [monitorA (&;with-expected-type varT (analyse monitorC)) monitorT (&;with-type-env @@ -426,19 +426,19 @@ (getDeclaredMethods [] (Array Method))) (def: (load-class name) - (-> Text (Lux (Class Object))) - (do macro;Monad<Lux> + (-> Text (Meta (Class Object))) + (do meta;Monad<Meta> [class-loader &host;class-loader] (case (Class.forName [name false class-loader]) - (#R;Success [class]) + (#e;Success [class]) (wrap class) - (#R;Error error) + (#e;Error error) (&;fail (format "Unknown class: " name))))) (def: (sub-class? super sub) - (-> Text Text (Lux Bool)) - (do macro;Monad<Lux> + (-> Text Text (Meta Bool)) + (do meta;Monad<Meta> [super (load-class super) sub (load-class sub)] (wrap (Class.isAssignableFrom [sub] super)))) @@ -452,14 +452,14 @@ (function [[var-id varT]] (case args (^ (list exceptionC)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [exceptionA (&;with-expected-type varT (analyse exceptionC)) exceptionT (&;with-type-env (tc;read var-id)) exception-class (check-object exceptionT) ? (sub-class? "java.lang.Throwable" exception-class) - _ (: (Lux Unit) + _ (: (Meta Unit) (if ? (wrap []) (&;throw Not-Throwable exception-class))) @@ -476,7 +476,7 @@ (^ (list classC)) (case classC [_ (#;Text class)] - (do macro;Monad<Lux> + (do meta;Monad<Meta> [_ (load-class class) _ (&;infer (#;Host "java.lang.Class" (list (#;Host class (list)))))] (wrap (#la;Procedure proc (list (#la;Text class))))) @@ -498,7 +498,7 @@ (^ (list classC objectC)) (case classC [_ (#;Text class)] - (do macro;Monad<Lux> + (do meta;Monad<Meta> [objectA (&;with-expected-type varT (analyse objectC)) objectT (&;with-type-env @@ -542,9 +542,9 @@ (java.lang.reflect.Type.getTypeName [])) (def: (java-type-to-class type) - (-> java.lang.reflect.Type (Lux Text)) + (-> java.lang.reflect.Type (Meta Text)) (cond (host;instance? Class type) - (lux/wrap (Class.getName [] (:! Class type))) + (meta/wrap (Class.getName [] (:! Class type))) (host;instance? ParameterizedType type) (java-type-to-class (ParameterizedType.getRawType [] (:! ParameterizedType type))) @@ -560,55 +560,55 @@ (def: fresh-mappings Mappings (dict;new text;Hash<Text>)) (def: (java-type-to-lux-type mappings java-type) - (-> Mappings java.lang.reflect.Type (Lux Type)) + (-> Mappings java.lang.reflect.Type (Meta Type)) (cond (host;instance? TypeVariable java-type) (let [var-name (TypeVariable.getName [] (:! TypeVariable java-type))] (case (dict;get var-name mappings) (#;Some var-type) - (lux/wrap var-type) + (meta/wrap var-type) #;None (&;throw Unknown-Type-Var var-name))) (host;instance? WildcardType java-type) (let [java-type (:! WildcardType java-type)] - (case [(array;get +0 (WildcardType.getUpperBounds [] java-type)) - (array;get +0 (WildcardType.getLowerBounds [] java-type))] + (case [(array;read +0 (WildcardType.getUpperBounds [] java-type)) + (array;read +0 (WildcardType.getLowerBounds [] java-type))] (^or [(#;Some bound) _] [_ (#;Some bound)]) (java-type-to-lux-type mappings bound) _ - (lux/wrap Top))) + (meta/wrap Top))) (host;instance? Class java-type) (let [java-type (:! (Class Object) java-type) class-name (Class.getName [] java-type)] - (lux/wrap (case (array;size (Class.getTypeParameters [] java-type)) - +0 - (#;Host class-name (list)) - - arity - (|> (list;n.range +0 (n.dec arity)) - list;reverse - (list/map (|>. (n.* +2) n.inc #;Bound)) - (#;Host class-name) - (type;univ-q arity))))) + (meta/wrap (case (array;size (Class.getTypeParameters [] java-type)) + +0 + (#;Host class-name (list)) + + arity + (|> (list;n.range +0 (n.dec arity)) + list;reverse + (list/map (|>. (n.* +2) n.inc #;Bound)) + (#;Host class-name) + (type;univ-q arity))))) (host;instance? ParameterizedType java-type) (let [java-type (:! ParameterizedType java-type) raw (ParameterizedType.getRawType [] java-type)] (if (host;instance? Class raw) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [paramsT (|> java-type (ParameterizedType.getActualTypeArguments []) array;to-list (monad;map @ (java-type-to-lux-type mappings)))] - (lux/wrap (#;Host (Class.getName [] (:! (Class Object) raw)) - paramsT))) + (meta/wrap (#;Host (Class.getName [] (:! (Class Object) raw)) + paramsT))) (&;throw JVM-Type-Is-Not-Class (type-descriptor raw)))) (host;instance? GenericArrayType java-type) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [innerT (|> (:! GenericArrayType java-type) (GenericArrayType.getGenericComponentType []) (java-type-to-lux-type mappings))] @@ -628,8 +628,8 @@ #Out from)) (def: (cast direction to from) - (-> Direction Type Type (Lux [Text Type])) - (do macro;Monad<Lux> + (-> Direction Type Type (Meta [Text Type])) + (do meta;Monad<Meta> [to-name (check-jvm to) from-name (check-jvm from)] (cond (dict;contains? to-name boxes) @@ -677,23 +677,23 @@ (&;fail (format "No valid path between " (%type from) "and " (%type to) "."))))))) (def: (find-field class-name field-name) - (-> Text Text (Lux [(Class Object) Field])) - (do macro;Monad<Lux> + (-> Text Text (Meta [(Class Object) Field])) + (do meta;Monad<Meta> [class (load-class class-name)] (case (Class.getDeclaredField [field-name] class) - (#R;Success field) + (#e;Success field) (let [owner (Field.getDeclaringClass [] field)] (if (is owner class) (wrap [class field]) (&;fail (format "Field '" field-name "' does not belong to class '" class-name "'.\n" "Belongs to '" (Class.getName [] owner) "'.")))) - (#R;Error _) + (#e;Error _) (&;fail (format "Unknown field '" field-name "' for class '" class-name "'."))))) (def: (static-field class-name field-name) - (-> Text Text (Lux [Type Bool])) - (do macro;Monad<Lux> + (-> Text Text (Meta [Type Bool])) + (do meta;Monad<Meta> [[class fieldJ] (find-field class-name field-name) #let [modifiers (Field.getModifiers [] fieldJ)]] (if (Modifier.isStatic [modifiers]) @@ -706,8 +706,8 @@ (exception: #export Non-Object-Type) (def: (virtual-field class-name field-name objectT) - (-> Text Text Type (Lux [Type Bool])) - (do macro;Monad<Lux> + (-> Text Text Type (Meta [Type Bool])) + (do meta;Monad<Meta> [[class fieldJ] (find-field class-name field-name) #let [modifiers (Field.getModifiers [] fieldJ)]] (if (not (Modifier.isStatic [modifiers])) @@ -717,7 +717,7 @@ (Class.getTypeParameters []) array;to-list (list/map (TypeVariable.getName [])))] - mappings (: (Lux Mappings) + mappings (: (Meta Mappings) (case objectT (#;Host _class-name _class-params) (do @ @@ -735,9 +735,9 @@ (&;fail (format "Field '" field-name "' of class '" class-name "' is static."))))) (def: (analyse-object class analyse sourceC) - (-> Text &;Analyser Code (Lux [Type la;Analysis])) + (-> Text &;Analyser Code (Meta [Type la;Analysis])) (<| &common;with-var (function [[var-id varT]]) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [target-class (load-class class) targetT (java-type-to-lux-type fresh-mappings (:! java.lang.reflect.Type @@ -752,9 +752,9 @@ (wrap [castT sourceA])))) (def: (analyse-input analyse targetT sourceC) - (-> &;Analyser Type Code (Lux [Type Text la;Analysis])) + (-> &;Analyser Type Code (Meta [Type Text la;Analysis])) (<| &common;with-var (function [[var-id varT]]) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [sourceA (&;with-expected-type varT (analyse sourceC)) sourceT (&;with-type-env @@ -769,9 +769,9 @@ (^ (list classC fieldC)) (case [classC fieldC] [[_ (#;Text class)] [_ (#;Text field)]] - (do macro;Monad<Lux> + (do meta;Monad<Meta> [[fieldT final?] (static-field class field) - expectedT macro;expected-type + expectedT meta;expected-type [unboxed castT] (cast #Out expectedT fieldT) _ (&;with-type-env (tc;check expectedT castT))] @@ -790,7 +790,7 @@ (^ (list classC fieldC valueC)) (case [classC fieldC] [[_ (#;Text class)] [_ (#;Text field)]] - (do macro;Monad<Lux> + (do meta;Monad<Meta> [[fieldT final?] (static-field class field) _ (&;assert (Final-Field (format class "#" field)) (not final?)) @@ -813,10 +813,10 @@ (^ (list classC fieldC objectC)) (case [classC fieldC] [[_ (#;Text class)] [_ (#;Text field)]] - (do macro;Monad<Lux> + (do meta;Monad<Meta> [[objectT objectA] (analyse-object class analyse objectC) [fieldT final?] (virtual-field class field objectT) - expectedT macro;expected-type + expectedT meta;expected-type [unboxed castT] (cast #Out expectedT fieldT) _ (&;with-type-env (tc;check expectedT castT))] @@ -835,7 +835,7 @@ (^ (list classC fieldC valueC objectC)) (case [classC fieldC] [[_ (#;Text class)] [_ (#;Text field)]] - (do macro;Monad<Lux> + (do meta;Monad<Meta> [[objectT objectA] (analyse-object class analyse objectC) [fieldT final?] (virtual-field class field objectT) _ (&;assert (Final-Field (format class "#" field)) @@ -853,16 +853,16 @@ (&;fail (@;wrong-arity proc +4 (list;size args)))))) (def: (java-type-to-parameter type) - (-> java.lang.reflect.Type (Lux Text)) + (-> java.lang.reflect.Type (Meta Text)) (cond (host;instance? Class type) - (lux/wrap (Class.getName [] (:! Class type))) + (meta/wrap (Class.getName [] (:! Class type))) (host;instance? ParameterizedType type) (java-type-to-parameter (ParameterizedType.getRawType [] (:! ParameterizedType type))) (or (host;instance? TypeVariable type) (host;instance? WildcardType type)) - (lux/wrap "java.lang.Object") + (meta/wrap "java.lang.Object") ## else (&;throw Cannot-Convert-To-Parameter (type-descriptor type)))) @@ -875,8 +875,8 @@ #Interface) (def: (check-method class method-name method-type arg-classes method) - (-> (Class Object) Text Method-Type (List Text) Method (Lux Bool)) - (do macro;Monad<Lux> + (-> (Class Object) Text Method-Type (List Text) Method (Meta Bool)) + (do meta;Monad<Meta> [parameters (|> (Method.getGenericParameterTypes [] method) array;to-list (monad;map @ java-type-to-parameter)) @@ -904,8 +904,8 @@ (list;zip2 arg-classes parameters)))))) (def: (check-constructor class arg-classes constructor) - (-> (Class Object) (List Text) (Constructor Object) (Lux Bool)) - (do macro;Monad<Lux> + (-> (Class Object) (List Text) (Constructor Object) (Meta Bool)) + (do meta;Monad<Meta> [parameters (|> (Constructor.getGenericParameterTypes [] constructor) array;to-list (monad;map @ java-type-to-parameter))] @@ -922,7 +922,7 @@ (|>. (n.* +2) n.inc #;Bound)) (def: (method-to-type method-type method) - (-> Method-Type Method (Lux [Type (List Type)])) + (-> Method-Type Method (Meta [Type (List Type)])) (let [owner (Method.getDeclaringClass [] method) owner-name (Class.getName [] owner) owner-tvars (case method-type @@ -948,7 +948,7 @@ list;reverse (list;zip2 all-tvars) (dict;from-list text;Hash<Text>))))] - (do macro;Monad<Lux> + (do meta;Monad<Meta> [inputsT (|> (Method.getGenericParameterTypes [] method) array;to-list (monad;map @ (java-type-to-lux-type fresh-mappings))) @@ -971,8 +971,8 @@ (exception: #export Too-Many-Candidate-Methods) (def: (methods class-name method-name method-type arg-classes) - (-> Text Text Method-Type (List Text) (Lux [Type (List Type)])) - (do macro;Monad<Lux> + (-> Text Text Method-Type (List Text) (Meta [Type (List Type)])) + (do meta;Monad<Meta> [class (load-class class-name) candidates (|> class (Class.getDeclaredMethods []) @@ -992,7 +992,7 @@ (&;throw Too-Many-Candidate-Methods (format class-name "#" method-name))))) (def: (constructor-to-type constructor) - (-> (Constructor Object) (Lux [Type (List Type)])) + (-> (Constructor Object) (Meta [Type (List Type)])) (let [owner (Constructor.getDeclaringClass [] constructor) owner-name (Class.getName [] owner) owner-tvars (|> (Class.getTypeParameters [] owner) @@ -1013,7 +1013,7 @@ list;reverse (list;zip2 all-tvars) (dict;from-list text;Hash<Text>))))] - (do macro;Monad<Lux> + (do meta;Monad<Meta> [inputsT (|> (Constructor.getGenericParameterTypes [] constructor) array;to-list (monad;map @ (java-type-to-lux-type fresh-mappings))) @@ -1030,8 +1030,8 @@ (exception: #export Too-Many-Candidate-Constructors) (def: (constructor-methods class-name arg-classes) - (-> Text (List Text) (Lux [Type (List Type)])) - (do macro;Monad<Lux> + (-> Text (List Text) (Meta [Type (List Type)])) + (do meta;Monad<Meta> [class (load-class class-name) candidates (|> class (Class.getConstructors []) @@ -1053,10 +1053,10 @@ (def: (invoke//static proc) (-> Text @;Proc) (function [analyse args] - (case (: (R;Result [(List Code) [Text Text (List [Text Code]) Unit]]) + (case (: (e;Error [(List Code) [Text Text (List [Text Code]) Unit]]) (p;run args ($_ p;seq s;text s;text (p;some (s;tuple (p;seq s;text s;any))) s;end!))) - (#R;Success [_ [class method argsTC _]]) - (do macro;Monad<Lux> + (#e;Success [_ [class method argsTC _]]) + (do meta;Monad<Meta> [[methodT exceptionsT] (methods class method #Static (list/map product;left argsTC)) [outputT argsA] (&inference;apply-function analyse methodT (list/map product;right argsTC)) _ (&;infer outputT)] @@ -1068,10 +1068,10 @@ (def: (invoke//virtual proc) (-> Text @;Proc) (function [analyse args] - (case (: (R;Result [(List Code) [Text Text Code (List [Text Code]) Unit]]) + (case (: (e;Error [(List Code) [Text Text Code (List [Text Code]) Unit]]) (p;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any))) s;end!))) - (#R;Success [_ [class method objectC argsTC _]]) - (do macro;Monad<Lux> + (#e;Success [_ [class method objectC argsTC _]]) + (do meta;Monad<Meta> [[methodT exceptionsT] (methods class method #Virtual (list/map product;left argsTC)) [outputT argsA] (&inference;apply-function analyse methodT (list& objectC (list/map product;right argsTC))) _ (&;infer outputT)] @@ -1083,10 +1083,10 @@ (def: (invoke//special proc) (-> Text @;Proc) (function [analyse args] - (case (: (R;Result [(List Code) [Text Text Code (List [Text Code]) Unit]]) + (case (: (e;Error [(List Code) [Text Text Code (List [Text Code]) Unit]]) (p;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any))) s;end!))) - (#R;Success [_ [class method objectC argsTC _]]) - (do macro;Monad<Lux> + (#e;Success [_ [class method objectC argsTC _]]) + (do meta;Monad<Meta> [[methodT exceptionsT] (methods class method #Special (list/map product;left argsTC)) [outputT argsA] (&inference;apply-function analyse methodT (list& objectC (list/map product;right argsTC))) _ (&;infer outputT)] @@ -1100,10 +1100,10 @@ (def: (invoke//interface proc) (-> Text @;Proc) (function [analyse args] - (case (: (R;Result [(List Code) [Text Text Code (List [Text Code]) Unit]]) + (case (: (e;Error [(List Code) [Text Text Code (List [Text Code]) Unit]]) (p;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any))) s;end!))) - (#R;Success [_ [class-name method objectC argsTC _]]) - (do macro;Monad<Lux> + (#e;Success [_ [class-name method objectC argsTC _]]) + (do meta;Monad<Meta> [class (load-class class-name) _ (&;assert (Not-Interface class-name) (Modifier.isInterface [(Class.getModifiers [] class)])) @@ -1118,10 +1118,10 @@ (def: (invoke//constructor proc) (-> Text @;Proc) (function [analyse args] - (case (: (R;Result [(List Code) [Text (List [Text Code]) Unit]]) + (case (: (e;Error [(List Code) [Text (List [Text Code]) Unit]]) (p;run args ($_ p;seq s;text (p;some (s;tuple (p;seq s;text s;any))) s;end!))) - (#R;Success [_ [class argsTC _]]) - (do macro;Monad<Lux> + (#e;Success [_ [class argsTC _]]) + (do meta;Monad<Meta> [[methodT exceptionsT] (constructor-methods class (list/map product;left argsTC)) [outputT argsA] (&inference;apply-function analyse methodT (list/map product;right argsTC)) _ (&;infer outputT)] diff --git a/new-luxc/source/luxc/analyser/reference.lux b/new-luxc/source/luxc/analyser/reference.lux index 9b051bb79..9756a1b9c 100644 --- a/new-luxc/source/luxc/analyser/reference.lux +++ b/new-luxc/source/luxc/analyser/reference.lux @@ -1,30 +1,30 @@ (;module: lux (lux (control monad) - [macro #+ Monad<Lux>] - (type ["TC" check])) + [meta #+ Monad<Meta>] + (meta (type ["TC" check]))) (luxc ["&" base] (lang ["la" analysis #+ Analysis]) ["&;" scope])) ## [Analysers] (def: (analyse-definition def-name) - (-> Ident (Lux Analysis)) - (do Monad<Lux> - [actual (macro;find-def-type def-name) - expected macro;expected-type + (-> Ident (Meta Analysis)) + (do Monad<Meta> + [actual (meta;find-def-type def-name) + expected meta;expected-type _ (&;with-type-env (TC;check expected actual))] (wrap (#la;Definition def-name)))) (def: (analyse-variable var-name) - (-> Text (Lux (Maybe Analysis))) - (do Monad<Lux> + (-> Text (Meta (Maybe Analysis))) + (do Monad<Meta> [?var (&scope;find var-name)] (case ?var (#;Some [actual ref]) (do @ - [expected macro;expected-type + [expected meta;expected-type _ (&;with-type-env (TC;check expected actual))] (wrap (#;Some (#la;Variable ref)))) @@ -33,10 +33,10 @@ (wrap #;None)))) (def: #export (analyse-reference reference) - (-> Ident (Lux Analysis)) + (-> Ident (Meta Analysis)) (case reference ["" simple-name] - (do Monad<Lux> + (do Monad<Meta> [?var (analyse-variable simple-name)] (case ?var (#;Some analysis) @@ -44,7 +44,7 @@ #;None (do @ - [this-module macro;current-module-name] + [this-module meta;current-module-name] (analyse-definition [this-module simple-name])))) _ diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux index a6424b466..3bcc04d7e 100644 --- a/new-luxc/source/luxc/analyser/structure.lux +++ b/new-luxc/source/luxc/analyser/structure.lux @@ -12,10 +12,10 @@ [dict #+ Dict]) [text] text/format) - [macro] - (macro [code]) - [type] - (type ["tc" check])) + [meta] + (meta [code] + [type] + (type ["tc" check]))) (luxc ["&" base] (lang ["la" analysis]) ["&;" module] @@ -35,9 +35,9 @@ (format "Not a quantified type: " (%type type))) (def: #export (analyse-sum analyse tag valueC) - (-> &;Analyser Nat Code (Lux la;Analysis)) - (do macro;Monad<Lux> - [expected macro;expected-type] + (-> &;Analyser Nat Code (Meta la;Analysis)) + (do meta;Monad<Meta> + [expected meta;expected-type] (&;with-stacked-errors (function [_] (not-variant expected)) (case expected @@ -100,9 +100,9 @@ (&;fail ""))))) (def: (analyse-typed-product analyse members) - (-> &;Analyser (List Code) (Lux la;Analysis)) - (do macro;Monad<Lux> - [expected macro;expected-type] + (-> &;Analyser (List Code) (Meta la;Analysis)) + (do meta;Monad<Meta> + [expected meta;expected-type] (loop [expected expected members members] (case [expected members] @@ -140,7 +140,7 @@ ## and what was analysed. [tailT tailC] (do @ - [g!tail (macro;gensym "tail")] + [g!tail (meta;gensym "tail")] (&;with-expected-type tailT (analyse (` ((~' _lux_case) [(~@ tailC)] (~ g!tail) @@ -148,9 +148,9 @@ )))) (def: #export (analyse-product analyse membersC) - (-> &;Analyser (List Code) (Lux la;Analysis)) - (do macro;Monad<Lux> - [expected macro;expected-type] + (-> &;Analyser (List Code) (Meta la;Analysis)) + (do meta;Monad<Meta> + [expected meta;expected-type] (&;with-stacked-errors (function [_] (format "Invalid type for tuple: " (%type expected))) (case expected @@ -207,14 +207,14 @@ )))) (def: #export (analyse-tagged-sum analyse tag value) - (-> &;Analyser Ident Code (Lux la;Analysis)) - (do macro;Monad<Lux> - [tag (macro;normalize tag) - [idx group variantT] (macro;resolve-tag tag) + (-> &;Analyser Ident Code (Meta la;Analysis)) + (do meta;Monad<Meta> + [tag (meta;normalize tag) + [idx group variantT] (meta;resolve-tag tag) #let [case-size (list;size group)] inferenceT (&inference;variant-inference-type idx case-size variantT) [inferredT valueA+] (&inference;apply-function analyse inferenceT (list value)) - expectedT macro;expected-type + expectedT meta;expected-type _ (&;with-type-env (tc;check expectedT inferredT)) temp &scope;next-local] @@ -225,13 +225,13 @@ ## Normalization just means that all the tags get resolved to their ## canonical form (with their corresponding module identified). (def: #export (normalize record) - (-> (List [Code Code]) (Lux (List [Ident Code]))) - (monad;map macro;Monad<Lux> + (-> (List [Code Code]) (Meta (List [Ident Code]))) + (monad;map meta;Monad<Meta> (function [[key val]] (case key [_ (#;Tag key)] - (do macro;Monad<Lux> - [key (macro;normalize key)] + (do meta;Monad<Meta> + [key (meta;normalize key)] (wrap [key val])) _ @@ -242,16 +242,16 @@ ## re-implementing the same functionality for records makes no sense. ## Records, thus, get transformed into tuples by ordering the elements. (def: #export (order record) - (-> (List [Ident Code]) (Lux [(List Code) Type])) + (-> (List [Ident Code]) (Meta [(List Code) Type])) (case record ## empty-record = empty-tuple = unit = [] #;Nil - (:: macro;Monad<Lux> wrap [(list) Unit]) + (:: meta;Monad<Meta> wrap [(list) Unit]) (#;Cons [head-k head-v] _) - (do macro;Monad<Lux> - [head-k (macro;normalize head-k) - [_ tag-set recordT] (macro;resolve-tag head-k) + (do meta;Monad<Meta> + [head-k (meta;normalize head-k) + [_ tag-set recordT] (meta;resolve-tag head-k) #let [size-record (list;size record) size-ts (list;size tag-set)] _ (if (n.= size-ts size-record) @@ -265,7 +265,7 @@ idx->val (monad;fold @ (function [[key val] idx->val] (do @ - [key (macro;normalize key)] + [key (meta;normalize key)] (case (dict;get key tag->idx) #;None (&;fail (format "Tag " (%code (code;tag key)) @@ -284,11 +284,11 @@ )) (def: #export (analyse-record analyse members) - (-> &;Analyser (List [Code Code]) (Lux la;Analysis)) - (do macro;Monad<Lux> + (-> &;Analyser (List [Code Code]) (Meta la;Analysis)) + (do meta;Monad<Meta> [members (normalize members) [members recordT] (order members) - expectedT macro;expected-type + expectedT meta;expected-type inferenceT (&inference;record-inference-type recordT) [inferredT membersA] (&inference;apply-function analyse inferenceT members) _ (&;with-type-env diff --git a/new-luxc/source/luxc/analyser/type.lux b/new-luxc/source/luxc/analyser/type.lux index b69790a59..d0b038d93 100644 --- a/new-luxc/source/luxc/analyser/type.lux +++ b/new-luxc/source/luxc/analyser/type.lux @@ -1,8 +1,8 @@ (;module: lux (lux (control monad) - [macro #+ Monad<Lux>] - (type ["TC" check])) + [meta #+ Monad<Meta>] + (meta (type ["TC" check]))) (luxc ["&" base] (lang ["la" analysis #+ Analysis]))) @@ -10,21 +10,21 @@ ## means of evaluating Lux expressions at compile-time for the sake of ## computing Lux type values. (def: #export (analyse-check analyse eval type value) - (-> &;Analyser &;Eval Code Code (Lux Analysis)) - (do Monad<Lux> + (-> &;Analyser &;Eval Code Code (Meta Analysis)) + (do Monad<Meta> [actual (eval Type type) #let [actual (:! Type actual)] - expected macro;expected-type + expected meta;expected-type _ (&;with-type-env (TC;check expected actual))] (&;with-expected-type actual (analyse value)))) (def: #export (analyse-coerce analyse eval type value) - (-> &;Analyser &;Eval Code Code (Lux Analysis)) - (do Monad<Lux> + (-> &;Analyser &;Eval Code Code (Meta Analysis)) + (do Monad<Meta> [actual (eval Type type) - expected macro;expected-type + expected meta;expected-type _ (&;with-type-env (TC;check expected (:! Type actual)))] (&;with-expected-type Top |