diff options
Diffstat (limited to 'new-luxc/source')
38 files changed, 595 insertions, 603 deletions
diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux index ba6003440..97312b805 100644 --- a/new-luxc/source/luxc/analyser.lux +++ b/new-luxc/source/luxc/analyser.lux @@ -1,11 +1,11 @@ (;module: lux (lux (control monad) - (data ["R" result] + (data ["e" error] text/format) - [macro] - [type] - (type ["tc" check])) + [meta] + (meta [type] + (type ["tc" check]))) (luxc ["&" base] (lang ["la" analysis]) ["&;" module]) @@ -19,13 +19,13 @@ ["&&;" procedure])) (def: (to-branches raw) - (-> (List Code) (Lux (List [Code Code]))) + (-> (List Code) (Meta (List [Code Code]))) (case raw (^ (list)) - (:: macro;Monad<Lux> wrap (list)) + (:: meta;Monad<Meta> wrap (list)) (^ (list& patternH bodyH inputT)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [outputT (to-branches inputT)] (wrap (list& [patternH bodyH] outputT))) @@ -34,7 +34,7 @@ (def: #export (analyser eval) (-> &;Eval &;Analyser) - (: (-> Code (Lux la;Analysis)) + (: (-> Code (Meta la;Analysis)) (function analyse [ast] (let [[cursor ast'] ast] ## The cursor must be set in the compiler for the sake @@ -85,7 +85,7 @@ (^ (#;Form (list& [_ (#;Symbol ["" "_lux_case"])] input branches))) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [paired (to-branches branches)] (&&case;analyse-case analyse input paired)) @@ -102,23 +102,23 @@ [#;Tag &&structure;analyse-tagged-sum]) (^ (#;Form (list& func args))) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [[funcT =func] (&&common;with-unknown-type (analyse func))] (case =func (#la;Definition def-name) (do @ - [[def-type def-anns def-value] (macro;find-def def-name)] - (if (macro;macro? def-anns) + [[def-type def-anns def-value] (meta;find-def def-name)] + (if (meta;macro? def-anns) (do @ [## macro-expansion (function [compiler] ## (case (macro-caller def-value args compiler) - ## (#R;Success [compiler' output]) - ## (#R;Success [compiler' output]) + ## (#e;Success [compiler' output]) + ## (#e;Success [compiler' output]) - ## (#R;Error error) + ## (#e;Error error) ## ((&;fail error) compiler))) - macro-expansion (: (Lux (List Code)) + macro-expansion (: (Meta (List Code)) (undefined))] (case macro-expansion (^ (list single-expansion)) 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 diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux index fe57cc1dd..4c6202db1 100644 --- a/new-luxc/source/luxc/base.lux +++ b/new-luxc/source/luxc/base.lux @@ -5,73 +5,68 @@ (data [text "text/" Eq<Text>] text/format [product] - ["R" result]) - [macro] - (type ["tc" check])) + ["e" error]) + [meta] + (meta (type ["tc" check]))) (luxc (lang ["la" analysis]))) (type: #export Eval - (-> Type Code (Lux Top))) + (-> Type Code (Meta Top))) (type: #export Analyser - (-> Code (Lux la;Analysis))) + (-> Code (Meta la;Analysis))) (type: #export Path Text) -(type: #export Mode - #Build - #Eval - #REPL) - -(def: #export compiler-version Text "0.6.0") +(def: #export version Text "0.6.0") (def: #export (fail message) - (All [a] (-> Text (Lux a))) - (do macro;Monad<Lux> - [[file line col] macro;cursor + (All [a] (-> Text (Meta a))) + (do meta;Monad<Meta> + [[file line col] meta;cursor #let [location (format file "," (|> line nat-to-int %i) "," (|> col nat-to-int %i))]] - (macro;fail (format "@ " location - "\n" message)))) + (meta;fail (format "@ " location + "\n" message)))) (def: #export (assert message test) - (-> Text Bool (Lux Unit)) + (-> Text Bool (Meta Unit)) (if test - (:: macro;Monad<Lux> wrap []) + (:: meta;Monad<Meta> wrap []) (fail message))) (def: #export (throw exception message) - (All [a] (-> ex;Exception Text (Lux a))) + (All [a] (-> ex;Exception Text (Meta a))) (fail (exception message))) (def: #export (with-expected-type expected action) - (All [a] (-> Type (Lux a) (Lux a))) + (All [a] (-> Type (Meta a) (Meta a))) (function [compiler] (case (action (set@ #;expected (#;Some expected) compiler)) - (#R;Success [compiler' output]) + (#e;Success [compiler' output]) (let [old-expected (get@ #;expected compiler)] - (#R;Success [(set@ #;expected old-expected compiler') + (#e;Success [(set@ #;expected old-expected compiler') output])) - (#R;Error error) - (#R;Error error)))) + (#e;Error error) + (#e;Error error)))) (def: #export (with-type-env action) - (All [a] (-> (tc;Check a) (Lux a))) + (All [a] (-> (tc;Check a) (Meta a))) (function [compiler] (case (action (get@ #;type-context compiler)) - (#R;Error error) - (#R;Error error) + (#e;Error error) + (#e;Error error) - (#R;Success [context' output]) - (#R;Success [(set@ #;type-context context' compiler) + (#e;Success [context' output]) + (#e;Success [(set@ #;type-context context' compiler) output])))) (def: #export (infer actualT) - (-> Type (Lux Unit)) - (do macro;Monad<Lux> - [expectedT macro;expected-type] + (-> Type (Meta Unit)) + (do meta;Monad<Meta> + [expectedT meta;expected-type] (with-type-env (tc;check expectedT actualT)))) @@ -120,26 +115,26 @@ (#;Cons [k' v'] (pl-update key f table'))))) (def: #export (with-source-code source action) - (All [a] (-> [Cursor Text] (Lux a) (Lux a))) + (All [a] (-> [Cursor Text] (Meta a) (Meta a))) (function [compiler] (let [old-source (get@ #;source compiler)] (case (action (set@ #;source source compiler)) - (#R;Error error) - (#R;Error error) + (#e;Error error) + (#e;Error error) - (#R;Success [compiler' output]) - (#R;Success [(set@ #;source old-source compiler') + (#e;Success [compiler' output]) + (#e;Success [(set@ #;source old-source compiler') output]))))) (def: #export (with-stacked-errors handler action) - (All [a] (-> (-> [] Text) (Lux a) (Lux a))) + (All [a] (-> (-> [] Text) (Meta a) (Meta a))) (function [compiler] (case (action compiler) - (#R;Success [compiler' output]) - (#R;Success [compiler' output]) + (#e;Success [compiler' output]) + (#e;Success [compiler' output]) - (#R;Error error) - (#R;Error (if (text/= "" error) + (#e;Error error) + (#e;Error (if (text/= "" error) (handler []) (format error "\n-----------------------------------------\n" (handler []))))))) @@ -156,31 +151,31 @@ #;captured fresh-bindings}) (def: #export (with-scope action) - (All [a] (-> (Lux a) (Lux [Scope a]))) + (All [a] (-> (Meta a) (Meta [Scope a]))) (function [compiler] (case (action (update@ #;scopes (|>. (#;Cons fresh-scope)) compiler)) - (#R;Success [compiler' output]) + (#e;Success [compiler' output]) (case (get@ #;scopes compiler') #;Nil - (#R;Error "Impossible error: Drained scopes!") + (#e;Error "Impossible error: Drained scopes!") (#;Cons head tail) - (#R;Success [(set@ #;scopes tail compiler') + (#e;Success [(set@ #;scopes tail compiler') [head output]])) - (#R;Error error) - (#R;Error error)))) + (#e;Error error) + (#e;Error error)))) (def: #export (with-cursor cursor action) - (All [a] (-> Cursor (Lux a) (Lux a))) + (All [a] (-> Cursor (Meta a) (Meta a))) (if (text/= "" (product;left cursor)) action (function [compiler] (let [old-cursor (get@ #;cursor compiler)] (case (action (set@ #;cursor cursor compiler)) - (#R;Success [compiler' output]) - (#R;Success [(set@ #;cursor old-cursor compiler') + (#e;Success [compiler' output]) + (#e;Success [(set@ #;cursor old-cursor compiler') output]) - (#R;Error error) - (#R;Error error)))))) + (#e;Error error) + (#e;Error error)))))) diff --git a/new-luxc/source/luxc/eval.lux b/new-luxc/source/luxc/eval.lux index 9d6ee05e7..59c31abc7 100644 --- a/new-luxc/source/luxc/eval.lux +++ b/new-luxc/source/luxc/eval.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control [monad #+ do]) - [macro]) + [meta]) [../base] (.. [analyser] [synthesizer] @@ -10,7 +10,7 @@ (def: #export (eval type exprC) ../base;Eval - (do macro;Monad<Lux> + (do meta;Monad<Meta> [exprA (../base;with-expected-type type (analyser;analyser eval exprC)) #let [exprS (synthesizer;synthesize exprA)] diff --git a/new-luxc/source/luxc/generator.lux b/new-luxc/source/luxc/generator.lux index 00a50fbed..107b2f3f9 100644 --- a/new-luxc/source/luxc/generator.lux +++ b/new-luxc/source/luxc/generator.lux @@ -3,12 +3,12 @@ (lux (control monad) (concurrency ["A" atom] ["P" promise]) - (data ["R" result] + (data ["e" error] [text "T/" Hash<Text>] text/format (coll ["D" dict] - [array #+ Array])) - [macro #+ Monad<Lux>] + [array])) + [meta #+ Monad<Meta>] [host] [io]) (luxc ["&" base] @@ -22,7 +22,7 @@ )) (def: (compile ast) - (-> Code (Lux Unit)) + (-> Code (Meta Unit)) (case ast (^ [_ (#;Form (list [_ (#;Symbol ["" "_lux_def"])] [_ (#;Symbol ["" def-name])] @@ -39,16 +39,16 @@ (&;fail (format "Unrecognized statement: " (%code ast))))) (def: (exhaust action) - (All [a] (-> (Lux a) (Lux Unit))) - (do Monad<Lux> + (All [a] (-> (Meta a) (Meta Unit))) + (do Monad<Meta> [result action] (exhaust action))) (def: (ensure-new-module! file-hash module-name) - (-> Nat Text (Lux Unit)) - (do Monad<Lux> - [module-exists? (macro;module-exists? module-name) - _ (: (Lux Unit) + (-> Nat Text (Meta Unit)) + (do Monad<Meta> + [module-exists? (meta;module-exists? module-name) + _ (: (Meta Unit) (if module-exists? (&;fail (format "Cannot re-define a module: " module-name)) (wrap []))) @@ -58,8 +58,8 @@ (def: prelude Text "lux") (def: (with-active-compilation [module-name file-name source-code] action) - (All [a] (-> [Text Text Text] (Lux a) (Lux a))) - (do Monad<Lux> + (All [a] (-> [Text Text Text] (Meta a) (Meta a))) + (do Monad<Meta> [_ (ensure-new-module! (T/hash source-code) module-name) #let [init-cursor [file-name +0 +0]] output (&;with-source-code [init-cursor source-code] @@ -68,23 +68,23 @@ (wrap output))) (def: parse - (Lux Code) + (Meta Code) (function [compiler] (case (&parser;parse (get@ #;source compiler)) - (#R;Error error) - (#R;Error error) + (#e;Error error) + (#e;Error error) - (#R;Success [source' output]) - (#R;Success [(set@ #;source source' compiler) + (#e;Success [source' output]) + (#e;Success [(set@ #;source source' compiler) output])))) (def: (compile-module source-dirs module-name compiler) - (-> (List &;Path) Text Compiler (P;Promise (R;Result Compiler))) + (-> (List &;Path) Text Compiler (P;Promise (e;Error Compiler))) (do P;Monad<Promise> [?input (&io;read-module source-dirs module-name)] (case ?input - (#R;Success [file-name file-content]) - (let [compilation (do Monad<Lux> + (#e;Success [file-name file-content]) + (let [compilation (do Monad<Meta> [_ (with-active-compilation [module-name file-name file-content] @@ -95,18 +95,18 @@ (wrap []) ## (&module;generate-descriptor module-name) )] - (case (macro;run' compiler compilation) - (#R;Success [compiler module-descriptor]) + (case (meta;run' compiler compilation) + (#e;Success [compiler module-descriptor]) (do @ [## _ (&io;write-module module-name module-descriptor) ] - (wrap (#R;Success compiler))) + (wrap (#e;Success compiler))) - (#R;Error error) - (wrap (#R;Error error)))) + (#e;Error error) + (wrap (#e;Error error)))) - (#R;Error error) - (wrap (#R;Error error))))) + (#e;Error error) + (wrap (#e;Error error))))) (host;import org.objectweb.asm.MethodVisitor) @@ -118,15 +118,15 @@ #;var-counter +0 #;var-bindings (list)}) -(def: #export init-compiler-info - Compiler-Info - {#;compiler-name "Lux/JVM" - #;compiler-version &;compiler-version - #;compiler-mode #;Build}) +(def: #export init-info + Info + {#;target "JVM" + #;version &;version + #;mode #;Build}) (def: #export (init-compiler host) (-> &&common;Host Compiler) - {#;info init-compiler-info + {#;info init-info #;source [init-cursor ""] #;cursor init-cursor #;modules (list) @@ -138,14 +138,14 @@ #;host (:! Void host)}) (def: (or-crash! action) - (All [a] (-> (P;Promise (R;Result a)) (P;Promise a))) + (All [a] (-> (P;Promise (e;Error a)) (P;Promise a))) (do P;Monad<Promise> [?output action] (case ?output - (#R;Error error) + (#e;Error error) (error! error) - (#R;Success output) + (#e;Success output) (wrap output)))) (def: #export (compile-program program target sources) diff --git a/new-luxc/source/luxc/generator/case.jvm.lux b/new-luxc/source/luxc/generator/case.jvm.lux index 88b3dd5d3..53912f5d0 100644 --- a/new-luxc/source/luxc/generator/case.jvm.lux +++ b/new-luxc/source/luxc/generator/case.jvm.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control [monad #+ do]) - [macro "lux/" Monad<Lux>]) + [meta "meta/" Monad<Meta>]) (luxc (lang ["ls" synthesis]) (generator [expr] (host ["$" jvm] @@ -50,60 +50,60 @@ false))) (def: (generate-pattern' stack-depth @else @end path) - (-> Nat $;Label $;Label ls;Path (Lux $;Inst)) + (-> Nat $;Label $;Label ls;Path (Meta $;Inst)) (case path (#ls;ExecP bodyS) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [bodyI (expr;generate bodyS)] (wrap (|>. (pop-altI stack-depth) bodyI ($i;GOTO @end)))) #ls;UnitP - (lux/wrap popI) + (meta/wrap popI) (#ls;BindP register) - (lux/wrap (|>. peekI - ($i;ASTORE register) - popI)) + (meta/wrap (|>. peekI + ($i;ASTORE register) + popI)) (#ls;BoolP value) - (lux/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)] - (|>. peekI - ($i;unwrap #$;Boolean) - (jumpI @else)))) + (meta/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)] + (|>. peekI + ($i;unwrap #$;Boolean) + (jumpI @else)))) (^template [<tag> <prep>] (<tag> value) - (lux/wrap (|>. peekI - ($i;unwrap #$;Long) - ($i;long (|> value <prep>)) - $i;LCMP - ($i;IFNE @else)))) + (meta/wrap (|>. peekI + ($i;unwrap #$;Long) + ($i;long (|> value <prep>)) + $i;LCMP + ($i;IFNE @else)))) ([#ls;NatP (:! Int)] [#ls;IntP (: Int)] [#ls;DegP (:! Int)]) (#ls;FracP value) - (lux/wrap (|>. peekI - ($i;unwrap #$;Double) - ($i;double value) - $i;DCMPL - ($i;IFNE @else))) + (meta/wrap (|>. peekI + ($i;unwrap #$;Double) + ($i;double value) + $i;DCMPL + ($i;IFNE @else))) (#ls;TextP value) - (lux/wrap (|>. peekI - ($i;string value) - ($i;INVOKEVIRTUAL "java.lang.Object" - "equals" - ($t;method (list $Object) - (#;Some $t;boolean) - (list)) - false) - ($i;IFEQ @else))) + (meta/wrap (|>. peekI + ($i;string value) + ($i;INVOKEVIRTUAL "java.lang.Object" + "equals" + ($t;method (list $Object) + (#;Some $t;boolean) + (list)) + false) + ($i;IFEQ @else))) (#ls;TupleP idx subP) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [subI (generate-pattern' stack-depth @else @end subP) #let [[idx tail?] (case idx (#;Left idx) @@ -134,7 +134,7 @@ subI)))) (#ls;VariantP idx subP) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [subI (generate-pattern' stack-depth @else @end subP) #let [[idx last?] (case idx (#;Left idx) @@ -167,14 +167,14 @@ subI)))) (#ls;SeqP leftP rightP) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [leftI (generate-pattern' stack-depth @else @end leftP) rightI (generate-pattern' stack-depth @else @end rightP)] (wrap (|>. leftI rightI))) (#ls;AltP leftP rightP) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [@alt-else $i;make-label leftI (generate-pattern' (n.inc stack-depth) @alt-else @end leftP) rightI (generate-pattern' stack-depth @else @end rightP)] @@ -186,8 +186,8 @@ )) (def: (generate-pattern path @end) - (-> ls;Path $;Label (Lux $;Inst)) - (do macro;Monad<Lux> + (-> ls;Path $;Label (Meta $;Inst)) + (do meta;Monad<Meta> [@else $i;make-label pathI (generate-pattern' +1 @else @end path)] (wrap (|>. pathI @@ -201,8 +201,8 @@ ($i;GOTO @end))))) (def: #export (generate valueS path) - (-> ls;Synthesis ls;Path (Lux $;Inst)) - (do macro;Monad<Lux> + (-> ls;Synthesis ls;Path (Meta $;Inst)) + (do meta;Monad<Meta> [@end $i;make-label valueI (expr;generate valueS) pathI (generate-pattern path @end)] diff --git a/new-luxc/source/luxc/generator/common.jvm.lux b/new-luxc/source/luxc/generator/common.jvm.lux index 054d11098..150e68e4f 100644 --- a/new-luxc/source/luxc/generator/common.jvm.lux +++ b/new-luxc/source/luxc/generator/common.jvm.lux @@ -3,7 +3,7 @@ (lux (control ["ex" exception #+ exception:]) [io] (concurrency ["A" atom]) - (data ["R" result] + (data ["e" error] (coll ["d" dict])) [host]) (luxc (generator (host ["$" jvm] @@ -35,27 +35,27 @@ (exception: No-Function-Being-Compiled) (def: #export (store-class name byte-code) - (-> Text Bytecode (Lux Unit)) + (-> Text Bytecode (Meta Unit)) (;function [compiler] (let [store (|> (get@ #;host compiler) (:! Host) (get@ #store))] (if (d;contains? name (|> store A;get io;run)) (ex;throw Class-Already-Stored name) - (#R;Success [compiler (io;run (A;update (d;put name byte-code) store))]) + (#e;Success [compiler (io;run (A;update (d;put name byte-code) store))]) )))) (def: #export (load-class name) - (-> Text (Lux (Class Object))) + (-> Text (Meta (Class Object))) (;function [compiler] (let [host (:! Host (get@ #;host compiler)) store (|> host (get@ #store) A;get io;run)] (if (d;contains? name store) - (#R;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))]) + (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))]) (ex;throw Unknown-Class name))))) (def: #export (with-function class expr) - (All [a] (-> Text (Lux a) (Lux a))) + (All [a] (-> Text (Meta a) (Meta a))) (;function [compiler] (let [host (:! Host (get@ #;host compiler)) old-function-class (get@ #function-class host)] @@ -64,19 +64,19 @@ (#;Some class) host)) compiler)) - (#R;Success [compiler' output]) - (#R;Success [(update@ #;host + (#e;Success [compiler' output]) + (#e;Success [(update@ #;host (|>. (:! Host) (set@ #function-class old-function-class) (:! Void)) compiler') output]) - (#R;Error error) - (#R;Error error))))) + (#e;Error error) + (#e;Error error))))) (def: #export function - (Lux Text) + (Meta Text) (;function [compiler] (let [host (:! Host (get@ #;host compiler))] (case (get@ #function-class host) @@ -84,6 +84,6 @@ (ex;throw No-Function-Being-Compiled "") (#;Some function-class) - (#R;Success [compiler function-class]))))) + (#e;Success [compiler function-class]))))) (def: #export bytecode-version Int Opcodes.V1_6) diff --git a/new-luxc/source/luxc/generator/eval.jvm.lux b/new-luxc/source/luxc/generator/eval.jvm.lux index 4f02dcffb..20c02af4c 100644 --- a/new-luxc/source/luxc/generator/eval.jvm.lux +++ b/new-luxc/source/luxc/generator/eval.jvm.lux @@ -1,9 +1,9 @@ (;module: lux (lux (control monad) - (data ["R" result] + (data ["R" error] text/format) - [macro #+ Monad<Lux> "Lux/" Monad<Lux>] + [meta #+ Monad<Meta> "Meta/" Monad<Meta>] [host #+ do-to]) (luxc ["&" base] (lang ["la" analysis] @@ -60,9 +60,9 @@ (def: $Object $;Type ($t;class "java.lang.Object" (list))) (def: #export (eval valueI) - (-> $;Inst (Lux Top)) - (do Monad<Lux> - [class-name (:: @ map %code (macro;gensym "eval")) + (-> $;Inst (Meta Top)) + (do Monad<Meta> + [class-name (:: @ map %code (meta;gensym "eval")) #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS) (ClassWriter.visit [&common;bytecode-version (i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_SUPER) diff --git a/new-luxc/source/luxc/generator/expr.jvm.lux b/new-luxc/source/luxc/generator/expr.jvm.lux index 6b6c68fde..c7fdcf2af 100644 --- a/new-luxc/source/luxc/generator/expr.jvm.lux +++ b/new-luxc/source/luxc/generator/expr.jvm.lux @@ -2,7 +2,7 @@ lux (lux (control monad) (data text/format) - [macro #+ Monad<Lux> "Lux/" Monad<Lux>]) + [meta #+ Monad<Meta> "Meta/" Monad<Meta>]) (luxc ["&" base] (lang ["ls" synthesis]) ["&;" analyser] @@ -18,7 +18,7 @@ (host ["$" jvm])))) (def: #export (generate synthesis) - (-> ls;Synthesis (Lux $;Inst)) + (-> ls;Synthesis (Meta $;Inst)) (case synthesis #ls;Unit &primitive;generate-unit @@ -54,11 +54,11 @@ (&procedure;generate-procedure generate name args) _ - (macro;fail "Unrecognized synthesis."))) + (meta;fail "Unrecognized synthesis."))) ## (def: #export (eval type code) -## (-> Type Code (Lux Top)) -## (do Monad<Lux> +## (-> Type Code (Meta Top)) +## (do Monad<Meta> ## [analysis (&;with-expected-type leftT ## (&analyser;analyser eval code)) ## #let [synthesis (&synthesizer;synthesize analysis)] @@ -70,8 +70,8 @@ ## (&analyser;analyser eval)) ## (def: #export (generate input) -## (-> Code (Lux Unit)) -## (do Monad<Lux> +## (-> Code (Meta Unit)) +## (do Monad<Meta> ## [analysis (analyse input) ## #let [synthesis (&synthesizer;synthesize analysis)]] ## (generate-synthesis synthesis))) diff --git a/new-luxc/source/luxc/generator/function.jvm.lux b/new-luxc/source/luxc/generator/function.jvm.lux index e3582e183..97d3a7c91 100644 --- a/new-luxc/source/luxc/generator/function.jvm.lux +++ b/new-luxc/source/luxc/generator/function.jvm.lux @@ -3,7 +3,7 @@ (lux (control [monad #+ do]) (data text/format (coll [list "list/" Functor<List> Monoid<List>])) - [macro]) + [meta]) (luxc ["&" base] (lang ["la" analysis] ["ls" synthesis]) @@ -268,10 +268,10 @@ )))) (def: #export (with-function generate class env arity body) - (-> (-> ls;Synthesis (Lux $;Inst)) + (-> (-> ls;Synthesis (Meta $;Inst)) Text (List ls;Variable) ls;Arity ls;Synthesis - (Lux [$;Def $;Inst])) - (do macro;Monad<Lux> + (Meta [$;Def $;Inst])) + (do meta;Monad<Meta> [@begin $i;make-label bodyI (&common;with-function class (generate body)) #let [env-size (list;size env) @@ -297,11 +297,11 @@ (wrap [functionD instanceI]))) (def: #export (generate-function generate env arity body) - (-> (-> ls;Synthesis (Lux $;Inst)) + (-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Variable) ls;Arity ls;Synthesis - (Lux $;Inst)) - (do macro;Monad<Lux> - [function-class (:: @ map %code (macro;gensym "function")) + (Meta $;Inst)) + (do meta;Monad<Meta> + [function-class (:: @ map %code (meta;gensym "function")) [functionD instanceI] (with-function generate function-class env arity body) _ (&common;store-class function-class ($d;class #$;V1.6 #$;Public $;finalC @@ -318,10 +318,10 @@ (list& pre (segment size post))))) (def: #export (generate-call generate functionS argsS) - (-> (-> ls;Synthesis (Lux $;Inst)) + (-> (-> ls;Synthesis (Meta $;Inst)) ls;Synthesis (List ls;Synthesis) - (Lux $;Inst)) - (do macro;Monad<Lux> + (Meta $;Inst)) + (do meta;Monad<Meta> [functionI (generate functionS) argsI (monad;map @ generate argsS) #let [applyI (|> (segment &runtime;num-apply-variants argsI) diff --git a/new-luxc/source/luxc/generator/host/jvm.lux b/new-luxc/source/luxc/generator/host/jvm.lux index 4fb3fa77d..c985efc9a 100644 --- a/new-luxc/source/luxc/generator/host/jvm.lux +++ b/new-luxc/source/luxc/generator/host/jvm.lux @@ -3,9 +3,9 @@ (lux (control monad ["p" parser]) (data (coll [list "list/" Functor<List>])) - [macro] - (macro [code] - ["s" syntax #+ syntax:]) + [meta] + (meta [code] + ["s" syntax #+ syntax:]) [host])) ## [Host] diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux index 7dd78ceb3..1d50ba9f6 100644 --- a/new-luxc/source/luxc/generator/host/jvm/def.lux +++ b/new-luxc/source/luxc/generator/host/jvm/def.lux @@ -60,7 +60,7 @@ ## [Defs] (def: (string-array values) - (-> (List Text) (a;Array Text)) + (-> (List Text) (Array Text)) (let [output (host;array String (list;size values))] (exec (list/map (function [[idx value]] (host;array-write idx value output)) @@ -68,7 +68,7 @@ output))) (def: exceptions-array - (-> $;Method (a;Array Text)) + (-> $;Method (Array Text)) (|>. (get@ #$;exceptions) (list/map (|>. #$;Generic $t;descriptor)) string-array)) diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux index d5df6a9f7..1951076c3 100644 --- a/new-luxc/source/luxc/generator/host/jvm/inst.lux +++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux @@ -3,12 +3,12 @@ (lux (control monad ["p" parser]) (data [maybe] - ["R" result] + ["e" error] text/format (coll [list "L/" Functor<List>])) [host #+ do-to] - [macro] - (macro [code] + [meta] + (meta [code] ["s" syntax #+ syntax:])) ["$" ..] (.. ["$t" type])) @@ -115,9 +115,9 @@ ## [Insts] (def: #export make-label - (Lux Label) + (Meta Label) (function [compiler] - (#R;Success [compiler (Label.new [])]))) + (#e;Success [compiler (Label.new [])]))) (def: #export (with-label action) (-> (-> Label $;Inst) $;Inst) diff --git a/new-luxc/source/luxc/generator/primitive.jvm.lux b/new-luxc/source/luxc/generator/primitive.jvm.lux index a63aa8596..fc6ffae1f 100644 --- a/new-luxc/source/luxc/generator/primitive.jvm.lux +++ b/new-luxc/source/luxc/generator/primitive.jvm.lux @@ -2,7 +2,7 @@ lux (lux (control monad) (data text/format) - [macro #+ Monad<Lux> "Lux/" Monad<Lux>]) + [meta #+ Monad<Meta> "Meta/" Monad<Meta>]) (luxc ["&" base] (lang ["la" analysis] ["ls" synthesis]) @@ -15,19 +15,19 @@ [../runtime]) (def: #export generate-unit - (Lux $;Inst) - (Lux/wrap ($i;string ../runtime;unit))) + (Meta $;Inst) + (Meta/wrap ($i;string ../runtime;unit))) (def: #export (generate-bool value) - (-> Bool (Lux $;Inst)) - (Lux/wrap ($i;GETSTATIC "java.lang.Boolean" - (if value "TRUE" "FALSE") - ($t;class "java.lang.Boolean" (list))))) + (-> Bool (Meta $;Inst)) + (Meta/wrap ($i;GETSTATIC "java.lang.Boolean" + (if value "TRUE" "FALSE") + ($t;class "java.lang.Boolean" (list))))) (do-template [<name> <type> <load> <wrap>] [(def: #export (<name> value) - (-> <type> (Lux $;Inst)) - (Lux/wrap (|>. (<load> value) <wrap>)))] + (-> <type> (Meta $;Inst)) + (Meta/wrap (|>. (<load> value) <wrap>)))] [generate-nat Nat (|>. (:! Int) $i;long) ($i;wrap #$;Long)] [generate-int Int $i;long ($i;wrap #$;Long)] diff --git a/new-luxc/source/luxc/generator/procedure.jvm.lux b/new-luxc/source/luxc/generator/procedure.jvm.lux index c564a668a..cc10e45aa 100644 --- a/new-luxc/source/luxc/generator/procedure.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure.jvm.lux @@ -1,4 +1,3 @@ - (;module: lux (lux (control [monad #+ do]) @@ -17,8 +16,8 @@ (dict;merge ./host;procedures))) (def: #export (generate-procedure generate name args) - (-> (-> ls;Synthesis (Lux $;Inst)) Text (List ls;Synthesis) - (Lux $;Inst)) + (-> (-> ls;Synthesis (Meta $;Inst)) Text (List ls;Synthesis) + (Meta $;Inst)) (<| (maybe;default (&;fail (format "Unknown procedure: " (%t name)))) (do maybe;Monad<Maybe> [proc (dict;get name procedures)] diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux index e3a46a9ea..48a820663 100644 --- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux @@ -5,9 +5,9 @@ text/format (coll [list "list/" Functor<List>] [dict #+ Dict])) - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax:]) + [meta #+ with-gensyms] + (meta [code] + ["s" syntax #+ syntax:]) [host]) (luxc ["&" base] (lang ["la" analysis] @@ -35,10 +35,10 @@ ## [Types] (type: #export Generator - (-> ls;Synthesis (Lux $;Inst))) + (-> ls;Synthesis (Meta $;Inst))) (type: #export Proc - (-> Generator (List ls;Synthesis) (Lux $;Inst))) + (-> Generator (List ls;Synthesis) (Meta $;Inst))) (type: #export Bundle (Dict Text Proc)) @@ -79,7 +79,7 @@ (syntax: (arity: [name s;local-symbol] [arity s;nat]) (with-gensyms [g!proc g!name g!generate g!inputs] (do @ - [g!input+ (monad;seq @ (list;repeat arity (macro;gensym "input")))] + [g!input+ (monad;seq @ (list;repeat arity (meta;gensym "input")))] (wrap (list (` (def: #export ((~ (code;local-symbol name)) (~ g!proc)) (-> (-> (;;Vector (~ (code;nat arity)) $;Inst) $;Inst) (-> Text ;;Proc)) @@ -87,7 +87,7 @@ (function [(~ g!generate) (~ g!inputs)] (case (~ g!inputs) (^ (list (~@ g!input+))) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [(~@ (|> g!input+ (list/map (function [g!input] (list g!input (` ((~ g!generate) (~ g!input)))))) @@ -95,7 +95,7 @@ ((~' wrap) ((~ g!proc) [(~@ g!input+)]))) (~' _) - (macro;fail (wrong-arity (~ g!name) +1 (list;size (~ g!inputs)))))))))))))) + (meta;fail (wrong-arity (~ g!name) +1 (list;size (~ g!inputs)))))))))))))) (arity: nullary +0) (arity: unary +1) diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux index d99694554..f754422c3 100644 --- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux @@ -5,9 +5,9 @@ text/format (coll [list "list/" Functor<List>] [dict #+ Dict])) - [macro #+ with-gensyms] - (macro [code] - ["s" syntax #+ syntax:]) + [meta #+ with-gensyms] + (meta [code] + ["s" syntax #+ syntax:]) [host]) (luxc ["&" base] (lang ["la" analysis] @@ -273,7 +273,7 @@ (-> Text @;Proc) (case inputs (^ (list (#ls;Nat level) (#ls;Text class) lengthS)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [lengthI (generate lengthS) #let [arrayJT ($t;array level (case class "boolean" $t;boolean @@ -297,7 +297,7 @@ (-> Text @;Proc) (case inputs (^ (list (#ls;Text class) idxS arrayS)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [arrayI (generate arrayS) idxI (generate idxS) #let [loadI (case class @@ -323,7 +323,7 @@ (-> Text @;Proc) (case inputs (^ (list (#ls;Text class) idxS valueS arrayS)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [arrayI (generate arrayS) idxI (generate idxS) valueI (generate valueS) @@ -392,7 +392,7 @@ (-> Text @;Proc) (case inputs (^ (list (#ls;Text class))) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [] (wrap (|>. ($i;string class) ($i;INVOKESTATIC "java.lang.Class" "forName" @@ -408,7 +408,7 @@ (-> Text @;Proc) (case inputs (^ (list (#ls;Text class) objectS)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [objectI (generate objectS)] (wrap (|>. objectI ($i;INSTANCEOF class) @@ -445,7 +445,7 @@ (-> Text @;Proc) (case inputs (^ (list (#ls;Text class) (#ls;Text field) (#ls;Text unboxed))) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [] (case (dict;get unboxed primitives) (#;Some primitive) @@ -472,7 +472,7 @@ (-> Text @;Proc) (case inputs (^ (list (#ls;Text class) (#ls;Text field) (#ls;Text unboxed) valueS)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [valueI (generate valueS)] (case (dict;get unboxed primitives) (#;Some primitive) @@ -504,7 +504,7 @@ (-> Text @;Proc) (case inputs (^ (list (#ls;Text class) (#ls;Text field) (#ls;Text unboxed) objectS)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [objectI (generate objectS)] (case (dict;get unboxed primitives) (#;Some primitive) @@ -535,7 +535,7 @@ (-> Text @;Proc) (case inputs (^ (list (#ls;Text class) (#ls;Text field) (#ls;Text unboxed) valueS objectS)) - (do macro;Monad<Lux> + (do meta;Monad<Meta> [valueI (generate valueS) objectI (generate objectS)] (case (dict;get unboxed primitives) diff --git a/new-luxc/source/luxc/generator/reference.jvm.lux b/new-luxc/source/luxc/generator/reference.jvm.lux index 28c936036..063994bac 100644 --- a/new-luxc/source/luxc/generator/reference.jvm.lux +++ b/new-luxc/source/luxc/generator/reference.jvm.lux @@ -2,7 +2,7 @@ lux (lux (control [monad #+ do]) (data text/format) - [macro "lux/" Monad<Lux>]) + [meta "meta/" Monad<Meta>]) (luxc (lang ["ls" synthesis]) (generator [";G" common] [";G" function] @@ -13,8 +13,8 @@ (def: $Object $;Type ($t;class "java.lang.Object" (list))) (def: #export (generate-captured variable) - (-> ls;Variable (Lux $;Inst)) - (do macro;Monad<Lux> + (-> ls;Variable (Meta $;Inst)) + (do meta;Monad<Meta> [function-class commonG;function] (wrap (|>. ($i;ALOAD +0) ($i;GETFIELD function-class @@ -22,5 +22,5 @@ $Object))))) (def: #export (generate-variable variable) - (-> ls;Variable (Lux $;Inst)) - (lux/wrap ($i;ALOAD (int-to-nat variable)))) + (-> ls;Variable (Meta $;Inst)) + (meta/wrap ($i;ALOAD (int-to-nat variable)))) diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux index 4c8784364..32e792638 100644 --- a/new-luxc/source/luxc/generator/runtime.jvm.lux +++ b/new-luxc/source/luxc/generator/runtime.jvm.lux @@ -1,11 +1,11 @@ (;module: lux (lux (control monad) - (data ["R" result] + (data ["R" error] text/format (coll [list "L/" Functor<List>])) [math] - [macro #+ Monad<Lux> "Lux/" Monad<Lux>] + [meta #+ Monad<Meta> "Meta/" Monad<Meta>] [host #+ do-to]) (luxc ["&" base] (lang ["la" analysis] @@ -448,8 +448,8 @@ ))) (def: generate-runtime - (Lux &common;Bytecode) - (do Monad<Lux> + (Meta &common;Bytecode) + (do Monad<Meta> [_ (wrap []) #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC runtime-class (list) ["java.lang.Object" (list)] (list) (|>. adt-methods @@ -469,8 +469,8 @@ ($t;method (list;repeat arity $Object) (#;Some $Object) (list))) (def: generate-function - (Lux &common;Bytecode) - (do Monad<Lux> + (Meta &common;Bytecode) + (do Monad<Meta> [_ (wrap []) #let [applyI (|> (list;n.range +2 num-apply-variants) (L/map (function [arity] @@ -504,8 +504,8 @@ (wrap bytecode))) (def: #export generate - (Lux Unit) - (do Monad<Lux> + (Meta Unit) + (do Monad<Meta> [_ generate-runtime _ generate-function] (wrap []))) diff --git a/new-luxc/source/luxc/generator/statement.jvm.lux b/new-luxc/source/luxc/generator/statement.jvm.lux index b091a2f37..ed66f3ecb 100644 --- a/new-luxc/source/luxc/generator/statement.jvm.lux +++ b/new-luxc/source/luxc/generator/statement.jvm.lux @@ -4,22 +4,22 @@ [io #- run] (data [text "T/" Eq<Text>] text/format) - [macro #+ Monad<Lux>]) + [meta #+ Monad<Meta>]) (luxc ["&" base] ["&;" module] ["&;" scope] (compiler ["&;" expr]))) (def: #export (compile-def def-name def-value def-meta) - (-> Text Code Code (Lux Unit)) - (do Monad<Lux> + (-> Text Code Code (Meta Unit)) + (do Monad<Meta> [=def-value (&expr;compile def-value) =def-meta (&expr;compile def-meta)] (undefined))) (def: #export (compile-program prog-args prog-body) - (-> Text Code (Lux Unit)) - (do Monad<Lux> + (-> Text Code (Meta Unit)) + (do Monad<Meta> [=prog-body (&scope;with-local [prog-args (type (List Text))] (&expr;compile prog-body))] (undefined))) diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux index 6aca0dca1..cee5800cd 100644 --- a/new-luxc/source/luxc/generator/structure.jvm.lux +++ b/new-luxc/source/luxc/generator/structure.jvm.lux @@ -1,10 +1,9 @@ - (;module: lux (lux (control [monad #+ do]) (data text/format (coll [list])) - [macro #+ Monad<Lux> "Lux/" Monad<Lux>] + [meta #+ Monad<Meta> "Meta/" Monad<Meta>] [host #+ do-to]) (luxc ["&" base] (lang ["la" analysis] @@ -21,8 +20,8 @@ (def: $Object $;Type ($t;class "java.lang.Object" (list))) (def: #export (generate-tuple generate members) - (-> (-> ls;Synthesis (Lux $;Inst)) (List ls;Synthesis) (Lux $;Inst)) - (do Monad<Lux> + (-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis) (Meta $;Inst)) + (do Monad<Meta> [#let [size (list;size members)] _ (&;assert "Cannot generate tuples with less than 2 elements." (n.>= +2 size)) @@ -47,8 +46,8 @@ $i;NULL)) (def: #export (generate-variant generate tag tail? member) - (-> (-> ls;Synthesis (Lux $;Inst)) Nat Bool ls;Synthesis (Lux $;Inst)) - (do Monad<Lux> + (-> (-> ls;Synthesis (Meta $;Inst)) Nat Bool ls;Synthesis (Meta $;Inst)) + (do Monad<Meta> [memberI (generate member)] (wrap (|>. ($i;int (nat-to-int tag)) (flagI tail?) diff --git a/new-luxc/source/luxc/host.jvm.lux b/new-luxc/source/luxc/host.jvm.lux index 55c899143..6c8eaa350 100644 --- a/new-luxc/source/luxc/host.jvm.lux +++ b/new-luxc/source/luxc/host.jvm.lux @@ -2,12 +2,12 @@ lux (lux (control [monad #+ do]) (concurrency ["A" atom]) - (data ["R" result] + (data ["e" error] [text] text/format (coll ["d" dict] - [array #+ Array])) - [macro #+ Monad<Lux>] + [array])) + [meta #+ Monad<Meta>] [host #+ do-to object] [io]) (luxc ["&" base] @@ -40,15 +40,15 @@ (host;array-write +2 (:! (Class Object) Integer.TYPE)) (host;array-write +3 (:! (Class Object) Integer.TYPE)))] (host;class-for java.lang.ClassLoader)) - (#R;Success method) + (#e;Success method) (do-to method (AccessibleObject.setAccessible [true])) - (#R;Error error) + (#e;Error error) (error! error))) (def: (define-class class-name byte-code loader) - (-> Text &&common;Bytecode ClassLoader (R;Result Object)) + (-> Text &&common;Bytecode ClassLoader (e;Error Object)) (Method.invoke [loader (array;from-list (list (:! Object class-name) (:! Object byte-code) @@ -68,10 +68,10 @@ (case (fetch-byte-code class-name store) (#;Some bytecode) (case (define-class class-name bytecode (:! ClassLoader _jvm_this)) - (#R;Success class) + (#e;Success class) (:!! class) - (#R;Error error) + (#e;Error error) (error! (format "Class definiton error: " class-name "\n" error))) @@ -87,9 +87,9 @@ #&&common;function-class #;None}))) (def: #export class-loader - (Lux ClassLoader) + (Meta ClassLoader) (function [compiler] - (#R;Success [compiler + (#e;Success [compiler (|> compiler (get@ #;host) (:! &&common;Host) diff --git a/new-luxc/source/luxc/io.jvm.lux b/new-luxc/source/luxc/io.jvm.lux index e8f403d6d..9ca8aebf3 100644 --- a/new-luxc/source/luxc/io.jvm.lux +++ b/new-luxc/source/luxc/io.jvm.lux @@ -3,10 +3,10 @@ (lux (control monad) [io #- run] (concurrency ["P" promise]) - (data ["R" result] + (data ["e" error] [text "T/" Eq<Text>] text/format) - [macro] + [meta] [host]) (luxc ["&" base])) @@ -45,26 +45,26 @@ (recur source-dirs')))))) (def: (read-source-code lux-file) - (-> File (P;Promise (R;Result Text))) + (-> File (P;Promise (e;Error Text))) (P;future (let [reader (|> lux-file FileReader.new BufferedReader.new)] (loop [total ""] (do Monad<IO> [?line (BufferedReader.readLine [] reader)] (case ?line - (#R;Error error) - (wrap (#R;Error error)) + (#e;Error error) + (wrap (#e;Error error)) - (#R;Success #;None) - (wrap (#R;Success total)) + (#e;Success #;None) + (wrap (#e;Success total)) - (#R;Success (#;Some line)) + (#e;Success (#;Some line)) (if (T/= "" total) (recur line) (recur (format total "\n" line))))))))) (def: #export (read-module source-dirs module-name) - (-> (List &;Path) Text (P;Promise (R;Result [&;Path Text]))) + (-> (List &;Path) Text (P;Promise (e;Error [&;Path Text]))) (let [host-path (format module-name host-extension ".lux") lux-path (format module-name ".lux")] (with-expansions @@ -76,18 +76,18 @@ (do @ [?code (read-source-code file)] (case ?code - (#R;Error error) - (wrap (#R;Error error)) + (#e;Error error) + (wrap (#e;Error error)) - (#R;Success code) - (wrap (#R;Success [<path> code])))) + (#e;Success code) + (wrap (#e;Success [<path> code])))) #;None)] [host-path] [lux-path])] (<| <tries> - (wrap (#R;Error (format "Module cannot be found: " module-name))))))) + (wrap (#e;Error (format "Module cannot be found: " module-name))))))) (def: #export (write-module module-name module-descriptor) (-> Text Text (P;Promise Unit)) diff --git a/new-luxc/source/luxc/module.lux b/new-luxc/source/luxc/module.lux index 240b60f97..39d3679e6 100644 --- a/new-luxc/source/luxc/module.lux +++ b/new-luxc/source/luxc/module.lux @@ -3,9 +3,9 @@ (lux (control [monad #+ do]) (data [text "T/" Eq<Text>] text/format - ["R" result] + ["e" error] (coll [list "L/" Fold<List> Functor<List>])) - [macro #+ Monad<Lux>]) + [meta #+ Monad<Meta>]) (luxc ["&" base] ["&;" scope])) @@ -22,13 +22,13 @@ (def: #export (define (^@ full-name [module-name def-name]) definition) - (-> Ident Def (Lux Unit)) + (-> Ident Def (Meta Unit)) (function [compiler] (case (&;pl-get module-name (get@ #;modules compiler)) (#;Some module) (case (&;pl-get def-name (get@ #;defs module)) #;None - (#R;Success [(update@ #;modules + (#e;Success [(update@ #;modules (&;pl-put module-name (update@ #;defs (: (-> (List [Text Def]) (List [Text Def])) @@ -38,31 +38,31 @@ []]) (#;Some already-existing) - (#R;Error (format "Cannot re-define definiton: " (%ident full-name)))) + (#e;Error (format "Cannot re-define definiton: " (%ident full-name)))) #;None - (#R;Error (format "Cannot define in unknown module: " module-name))))) + (#e;Error (format "Cannot define in unknown module: " module-name))))) (def: #export (create hash name) - (-> Nat Text (Lux Module)) + (-> Nat Text (Meta Module)) (function [compiler] (let [module (new-module hash)] - (#R;Success [(update@ #;modules + (#e;Success [(update@ #;modules (&;pl-put name module) compiler) module])))) (def: #export (with-module hash name action) - (All [a] (-> Nat Text (Lux a) (Lux [Module a]))) - (do Monad<Lux> + (All [a] (-> Nat Text (Meta a) (Meta [Module a]))) + (do Monad<Meta> [_ (create hash name) output (&scope;with-scope name action) - module (macro;find-module name)] + module (meta;find-module name)] (wrap [module output]))) (do-template [<flagger> <asker> <tag>] [(def: #export (<flagger> module-name) - (-> Text (Lux Unit)) + (-> Text (Meta Unit)) (function [compiler] (case (|> compiler (get@ #;modules) (&;pl-get module-name)) (#;Some module) @@ -70,26 +70,26 @@ #;Active true _ false)] (if active? - (#R;Success [(update@ #;modules + (#e;Success [(update@ #;modules (&;pl-put module-name (set@ #;module-state <tag> module)) compiler) []]) - (#R;Error "Can only change the state of a currently-active module."))) + (#e;Error "Can only change the state of a currently-active module."))) #;None - (#R;Error (format "Module does not exist: " module-name))))) + (#e;Error (format "Module does not exist: " module-name))))) (def: #export (<asker> module-name) - (-> Text (Lux Bool)) + (-> Text (Meta Bool)) (function [compiler] (case (|> compiler (get@ #;modules) (&;pl-get module-name)) (#;Some module) - (#R;Success [compiler + (#e;Success [compiler (case (get@ #;module-state module) <tag> true _ false)]) #;None - (#R;Error (format "Module does not exist: " module-name))) + (#e;Error (format "Module does not exist: " module-name))) ))] [flag-active! active? #;Active] @@ -99,14 +99,14 @@ (do-template [<name> <tag> <type>] [(def: (<name> module-name) - (-> Text (Lux <type>)) + (-> Text (Meta <type>)) (function [compiler] (case (|> compiler (get@ #;modules) (&;pl-get module-name)) (#;Some module) - (#R;Success [compiler (get@ <tag> module)]) + (#e;Success [compiler (get@ <tag> module)]) #;None - (macro;run compiler (&;fail (format "Unknown module: " module-name)))) + (meta;run compiler (&;fail (format "Unknown module: " module-name)))) ))] [tags-by-module #;tags (List [Text [Nat (List Ident) Bool Type]])] @@ -115,8 +115,8 @@ ) (def: (ensure-undeclared-tags module-name tags) - (-> Text (List Text) (Lux Unit)) - (do Monad<Lux> + (-> Text (List Text) (Meta Unit)) + (do Monad<Meta> [bindings (tags-by-module module-name) _ (monad;map @ (function [tag] @@ -130,9 +130,9 @@ (wrap []))) (def: #export (declare-tags tags exported? type) - (-> (List Text) Bool Type (Lux Unit)) - (do Monad<Lux> - [current-module macro;current-module-name + (-> (List Text) Bool Type (Meta Unit)) + (do Monad<Meta> + [current-module meta;current-module-name [type-module type-name] (case type (#;Named type-ident _) (wrap type-ident) @@ -140,13 +140,13 @@ _ (&;fail (format "Cannot define tags for an unnamed type: " (%type type)))) _ (ensure-undeclared-tags current-module tags) - _ (macro;assert (format "Cannot define tags for a type belonging to a foreign module: " (%type type)) - (T/= current-module type-module))] + _ (meta;assert (format "Cannot define tags for a type belonging to a foreign module: " (%type type)) + (T/= current-module type-module))] (function [compiler] (case (|> compiler (get@ #;modules) (&;pl-get current-module)) (#;Some module) (let [namespaced-tags (L/map (|>. [current-module]) tags)] - (#R;Success [(update@ #;modules + (#e;Success [(update@ #;modules (&;pl-update current-module (|>. (update@ #;tags (function [tag-bindings] (L/fold (function [[idx tag] table] @@ -157,4 +157,4 @@ compiler) []])) #;None - (macro;run compiler (&;fail (format "Unknown module: " current-module))))))) + (meta;run compiler (&;fail (format "Unknown module: " current-module))))))) diff --git a/new-luxc/source/luxc/module/descriptor/type.lux b/new-luxc/source/luxc/module/descriptor/type.lux index bcf44e5a2..6c5501e54 100644 --- a/new-luxc/source/luxc/module/descriptor/type.lux +++ b/new-luxc/source/luxc/module/descriptor/type.lux @@ -6,9 +6,9 @@ (text format ["l" lexer "l/" Monad<Lexer>]) [number] - ["R" result] + ["e" error] (coll [list "L/" Functor<List>])) - [type "Type/" Eq<Type>]) + (meta [type "type/" Eq<Type>])) ["&" ../common]) (do-template [<name> <code>] @@ -33,7 +33,7 @@ (def: (encode-type type) (-> Type Text) (if (or (is Type type) - (Type/= Type type)) + (type/= Type type)) type-signal (case type (#;Host name params) @@ -135,7 +135,7 @@ ))))) (def: (decode-type input) - (-> Text (R;Result Type)) + (-> Text (e;Error Type)) (|> type-decoder (l;before l;end) (l;run input))) diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux index 7eb4dcb16..b58038e7d 100644 --- a/new-luxc/source/luxc/parser.lux +++ b/new-luxc/source/luxc/parser.lux @@ -30,14 +30,13 @@ ["p" parser "p/" Monad<Parser>]) (data [bool] [text] - ["R" result] + ["e" error] [number] [product] [maybe] (text ["l" lexer] format) - (coll [list "L/" Functor<List> Fold<List>] - ["V" vector])))) + (coll [sequence #+ Sequence])))) (def: white-space Text "\t\v \r\f") (def: new-line Text "\n") @@ -285,10 +284,10 @@ (l;one-of ".") rich-digits^ (p;default "" - ($_ l;seq - (l;one-of "eE") - (p;default "" (l;one-of "+-")) - rich-digits^)))] + ($_ l;seq + (l;one-of "eE") + (p;default "" (l;one-of "+-")) + rich-digits^)))] (case (:: number;Codec<Text,Frac> decode chunk) (#;Left error) (p;fail error) @@ -429,14 +428,14 @@ (l;Lexer [Cursor Code])) (do p;Monad<Parser> [_ (l;this <open>) - [where' elems] (loop [elems (: (V;Vector Code) - V;empty) + [where' elems] (loop [elems (: (Sequence Code) + sequence;empty) where where] (p;either (do @ [## Must update the cursor as I ## go along, to keep things accurate. [where' elem] (ast where)] - (recur (V;add elem elems) + (recur (sequence;add elem elems) where')) (do @ [## Must take into account any @@ -445,7 +444,7 @@ where' (left-padding^ where) _ (l;this <close>)] (wrap [(update@ #;column n.inc where') - (V;to-list elems)]))))] + (sequence;to-list elems)]))))] (wrap [where' [where (<tag> elems)]])))] @@ -468,19 +467,19 @@ (l;Lexer [Cursor Code])) (do p;Monad<Parser> [_ (l;this "{") - [where' elems] (loop [elems (: (V;Vector [Code Code]) - V;empty) + [where' elems] (loop [elems (: (Sequence [Code Code]) + sequence;empty) where where] (p;either (do @ [[where' key] (ast where) [where' val] (ast where')] - (recur (V;add [key val] elems) + (recur (sequence;add [key val] elems) where')) (do @ [where' (left-padding^ where) _ (l;this "}")] (wrap [(update@ #;column n.inc where') - (V;to-list elems)]))))] + (sequence;to-list elems)]))))] (wrap [where' [where (#;Record elems)]]))) @@ -601,10 +600,10 @@ ))) (def: #export (parse [where code]) - (-> [Cursor Text] (R;Result [[Cursor Text] Code])) + (-> [Cursor Text] (e;Error [[Cursor Text] Code])) (case (p;run [+0 code] (ast where)) - (#R;Error error) - (#R;Error error) + (#e;Error error) + (#e;Error error) - (#R;Success [[_ remaining] [where' output]]) - (#R;Success [[where' remaining] output]))) + (#e;Success [[_ remaining] [where' output]]) + (#e;Success [[where' remaining] output]))) diff --git a/new-luxc/source/luxc/scope.lux b/new-luxc/source/luxc/scope.lux index 1dc5b932d..bd9a3233f 100644 --- a/new-luxc/source/luxc/scope.lux +++ b/new-luxc/source/luxc/scope.lux @@ -5,9 +5,9 @@ text/format [maybe "maybe/" Monad<Maybe>] [product] - ["R" result] + ["e" error] (coll [list "list/" Fold<List> Monoid<List>])) - [macro]) + [meta]) (luxc ["&" base])) (type: Locals (Bindings Text [Type Nat])) @@ -47,7 +47,7 @@ (get-captured name scope))) (def: #export (find name) - (-> Text (Lux (Maybe [Type Ref]))) + (-> Text (Meta (Maybe [Type Ref]))) (function [compiler] (let [[inner outer] (|> compiler (get@ #;scopes) @@ -76,7 +76,7 @@ )))) (def: #export (with-local [name type] action) - (All [a] (-> [Text Type] (Lux a) (Lux a))) + (All [a] (-> [Text Type] (Meta a) (Meta a))) (function [compiler] (case (get@ #;scopes compiler) (#;Cons head tail) @@ -87,24 +87,24 @@ (|>. (update@ #;counter n.inc) (update@ #;mappings (&;pl-put name [type new-var-id])))) head)] - (case (macro;run' (set@ #;scopes (#;Cons new-head tail) compiler) - action) - (#R;Success [compiler' output]) + (case (meta;run' (set@ #;scopes (#;Cons new-head tail) compiler) + action) + (#e;Success [compiler' output]) (case (get@ #;scopes compiler') (#;Cons head' tail') (let [scopes' (#;Cons (set@ #;locals (get@ #;locals head) head') tail')] - (#R;Success [(set@ #;scopes scopes' compiler') + (#e;Success [(set@ #;scopes scopes' compiler') output])) _ (error! "Invalid scope alteration.")) - (#R;Error error) - (#R;Error error))) + (#e;Error error) + (#e;Error error))) _ - (#R;Error "Cannot create local binding without a scope.")) + (#e;Error "Cannot create local binding without a scope.")) )) (do-template [<name> <val-type>] @@ -125,7 +125,7 @@ #;captured init-captured}) (def: #export (with-scope name action) - (All [a] (-> Text (Lux a) (Lux a))) + (All [a] (-> Text (Meta a) (Meta a))) (function [compiler] (let [parent-name (case (get@ #;scopes compiler) #;Nil @@ -136,11 +136,11 @@ (case (action (update@ #;scopes (|>. (#;Cons (scope parent-name name))) compiler)) - (#R;Error error) - (#R;Error error) + (#e;Error error) + (#e;Error error) - (#R;Success [compiler' output]) - (#R;Success [(update@ #;scopes + (#e;Success [compiler' output]) + (#e;Success [(update@ #;scopes (|>. list;tail (maybe;default (list))) compiler') output]) @@ -148,11 +148,11 @@ )) (def: #export next-local - (Lux Nat) + (Meta Nat) (function [compiler] (case (get@ #;scopes compiler) #;Nil - (#R;Error "Cannot get next reference when there is no scope.") + (#e;Error "Cannot get next reference when there is no scope.") (#;Cons top _) - (#R;Success [compiler (get@ [#;locals #;counter] top)])))) + (#e;Success [compiler (get@ [#;locals #;counter] top)])))) |