diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis')
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/case.lux | 38 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/case/coverage.lux | 14 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/common.lux | 4 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/expression.lux | 12 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/function.lux | 10 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/inference.lux | 40 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/primitive.lux | 8 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure/common.lux | 24 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux | 144 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/reference.lux | 14 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/structure.lux | 46 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/analysis/type.lux | 6 |
12 files changed, 180 insertions, 180 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux index 69a975b52..5d4c592aa 100644 --- a/new-luxc/source/luxc/lang/analysis/case.lux +++ b/new-luxc/source/luxc/lang/analysis/case.lux @@ -11,8 +11,8 @@ [text] text/format (coll [list "list/" Fold<List> Monoid<List> Functor<List>])) - [meta] - (meta [code]) + [macro] + (macro [code]) (lang [type] (type ["tc" check]))) (luxc ["&" lang] @@ -46,7 +46,7 @@ (-> Type (Meta Type)) (case caseT (#;Var id) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [?caseT' (&;with-type-env (tc;read id))] (case ?caseT' @@ -60,7 +60,7 @@ (simplify-case-type unnamedT) (^or (#;UnivQ _) (#;ExQ _)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[ex-id exT] (&;with-type-env tc;existential)] (simplify-case-type (maybe;assume (type;apply (list exT) caseT)))) @@ -68,7 +68,7 @@ (#;Apply inputT funcT) (case funcT (#;Var funcT-id) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [funcT' (&;with-type-env (do tc;Monad<Check> [?funct' (tc;read funcT-id)] @@ -83,13 +83,13 @@ _ (case (type;apply (list inputT) funcT) (#;Some outputT) - (:: meta;Monad<Meta> wrap outputT) + (:: macro;Monad<Meta> wrap outputT) #;None (&;throw Cannot-Simplify-Type-For-Pattern-Matching (%type caseT)))) _ - (:: meta;Monad<Meta> wrap caseT))) + (:: macro;Monad<Meta> wrap caseT))) ## This function handles several concerns at once, but it must be that ## way because those concerns are interleaved when doing @@ -112,7 +112,7 @@ (case pattern [cursor (#;Symbol ["" name])] (&;with-cursor cursor - (do meta;Monad<Meta> + (do macro;Monad<Meta> [outputA (&scope;with-local [name inputT] next) idx &scope;next-local] @@ -125,7 +125,7 @@ (^template [<type> <code-tag>] [cursor (<code-tag> test)] (&;with-cursor cursor - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;with-type-env (tc;check inputT <type>)) outputA next] @@ -139,7 +139,7 @@ (^ [cursor (#;Tuple (list))]) (&;with-cursor cursor - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;with-type-env (tc;check inputT Unit)) outputA next] @@ -150,7 +150,7 @@ [cursor (#;Tuple sub-patterns)] (&;with-cursor cursor - (do meta;Monad<Meta> + (do macro;Monad<Meta> [inputT' (simplify-case-type inputT)] (case inputT' (#;Product _) @@ -191,7 +191,7 @@ ))) [cursor (#;Record record)] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [record (structureA;normalize record) [members recordT] (structureA;order record) _ (&;with-type-env @@ -204,7 +204,7 @@ (^ [cursor (#;Form (list& [_ (#;Nat idx)] values))]) (&;with-cursor cursor - (do meta;Monad<Meta> + (do macro;Monad<Meta> [inputT' (simplify-case-type inputT)] (case inputT' (#;Sum _) @@ -216,14 +216,14 @@ (n.< num-cases idx)) (if (and (n.> num-cases size-sum) (n.= (n.dec num-cases) idx)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[testP nextA] (analyse-pattern #;None (type;variant (list;drop (n.dec num-cases) flat-sum)) (` [(~@ values)]) next)] (wrap [(` ("lux case variant" (~ (code;nat idx)) (~ (code;nat num-cases)) (~ testP))) nextA])) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)] (wrap [(` ("lux case variant" (~ (code;nat idx)) (~ (code;nat num-cases)) (~ testP))) nextA]))) @@ -238,9 +238,9 @@ (^ [cursor (#;Form (list& [_ (#;Tag tag)] values))]) (&;with-cursor cursor - (do meta;Monad<Meta> - [tag (meta;normalize tag) - [idx group variantT] (meta;resolve-tag tag) + (do macro;Monad<Meta> + [tag (macro;normalize tag) + [idx group variantT] (macro;resolve-tag tag) _ (&;with-type-env (tc;check inputT variantT))] (analyse-pattern (#;Some (list;size group)) inputT (` ((~ (code;nat idx)) (~@ values))) next))) @@ -256,7 +256,7 @@ (&;throw Cannot-Have-Empty-Branches "") (#;Cons [patternH bodyH] branchesT) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[inputT inputA] (commonA;with-unknown-type (analyse inputC)) outputH (analyse-pattern #;None inputT patternH (analyse bodyH)) diff --git a/new-luxc/source/luxc/lang/analysis/case/coverage.lux b/new-luxc/source/luxc/lang/analysis/case/coverage.lux index c41cfb2a4..283e21d02 100644 --- a/new-luxc/source/luxc/lang/analysis/case/coverage.lux +++ b/new-luxc/source/luxc/lang/analysis/case/coverage.lux @@ -9,7 +9,7 @@ text/format (coll [list "list/" Fold<List>] [dict #+ Dict])) - [meta "meta/" Monad<Meta>]) + [macro "macro/" Monad<Meta>]) (luxc ["&" lang] (lang ["la" analysis]))) @@ -52,7 +52,7 @@ ## Unit [] amounts to exhaustive coverage because there is only one ## possible value, so matching against it covers all cases. (^or (^code ("lux case bind" (~ _))) (^code ("lux case tuple" []))) - (meta/wrap #Exhaustive) + (macro/wrap #Exhaustive) (^code ("lux case tuple" [(~ singleton)])) (determine singleton) @@ -61,13 +61,13 @@ ## are too many possibilities as far as values go. (^or [_ (#;Nat _)] [_ (#;Int _)] [_ (#;Deg _)] [_ (#;Frac _)] [_ (#;Text _)]) - (meta/wrap #Partial) + (macro/wrap #Partial) ## Bools are the exception, since there is only "true" and ## "false", which means it is possible for boolean ## pattern-matching to become exhaustive if complementary parts meet. [_ (#;Bool value)] - (meta/wrap (#Bool value)) + (macro/wrap (#Bool value)) ## Tuple patterns can be exhaustive if there is exhaustiveness for all of ## their sub-patterns. @@ -75,10 +75,10 @@ (loop [subs subs] (case subs #;Nil - (meta/wrap #Exhaustive) + (macro/wrap #Exhaustive) (#;Cons sub subs') - (do meta;Monad<Meta> + (do macro;Monad<Meta> [pre (determine sub) post (recur subs')] (if (exhaustive? post) @@ -88,7 +88,7 @@ ## Variant patterns can be shown to be exhaustive if all the possible ## cases are handled exhaustively. (^code ("lux case variant" (~ [_ (#;Nat tag-id)]) (~ [_ (#;Nat num-tags)]) (~ sub))) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [=sub (determine sub)] (wrap (#Variant num-tags (|> (dict;new number;Hash<Nat>) diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux index b67e8e268..c1a2a4f5b 100644 --- a/new-luxc/source/luxc/lang/analysis/common.lux +++ b/new-luxc/source/luxc/lang/analysis/common.lux @@ -4,7 +4,7 @@ ["ex" exception #+ exception:]) (data text/format [product]) - [meta] + [macro] (lang [type] (type ["tc" check]))) (luxc ["&" lang] @@ -12,7 +12,7 @@ (def: #export (with-unknown-type action) (All [a] (-> (Meta a) (Meta [Type a]))) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[_ varT] (&;with-type-env tc;var) analysis (&;with-type varT action) diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux index 98addd197..5157848ec 100644 --- a/new-luxc/source/luxc/lang/analysis/expression.lux +++ b/new-luxc/source/luxc/lang/analysis/expression.lux @@ -5,7 +5,7 @@ (data ["e" error] [product] text/format) - [meta] + [macro] (lang [type] (type ["tc" check])) [host]) @@ -30,8 +30,8 @@ (-> &;Eval &;Analyser) (: (-> Code (Meta la;Analysis)) (function analyse [ast] - (do meta;Monad<Meta> - [expectedT meta;expected-type] + (do macro;Monad<Meta> + [expectedT macro;expected-type] (let [[cursor ast'] ast] ## The cursor must be set in the compiler for the sake ## of having useful error messages. @@ -82,14 +82,14 @@ (structureA;analyse-tagged-sum analyse tag (' [])) (^ (#;Form (list& func args))) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[funcT =func] (commonA;with-unknown-type (analyse func))] (case =func [_ (#;Symbol def-name)] (do @ - [[def-type def-anns def-value] (meta;find-def def-name)] - (if (meta;macro? def-anns) + [[def-type def-anns def-value] (macro;find-def def-name)] + (if (macro;macro? def-anns) (do @ [expansion (function [compiler] (case (macroH;expand (:! Macro def-value) args compiler) diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux index 7f2787e6f..a2aa95c08 100644 --- a/new-luxc/source/luxc/lang/analysis/function.lux +++ b/new-luxc/source/luxc/lang/analysis/function.lux @@ -6,8 +6,8 @@ [text] text/format (coll [list "list/" Fold<List> Monoid<List> Monad<List>])) - [meta] - (meta [code]) + [macro] + (macro [code]) (lang [type] (type ["tc" check]))) (luxc ["&" lang] @@ -23,8 +23,8 @@ ## [Analysers] (def: #export (analyse-function analyse func-name arg-name body) (-> &;Analyser Text Text Code (Meta Analysis)) - (do meta;Monad<Meta> - [functionT meta;expected-type] + (do macro;Monad<Meta> + [functionT macro;expected-type] (loop [expectedT functionT] (&;with-stacked-errors (function [_] (Invalid-Function-Type (%type expectedT))) @@ -94,6 +94,6 @@ (list/map (function [[idx argC]] (format "\n " (%n idx) " " (%code argC)))) (text;join-with ""))))) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[applyT argsA] (&inference;general analyse funcT args)] (wrap (la;apply argsA funcA))))) diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux index 910d5093a..c6f0323f7 100644 --- a/new-luxc/source/luxc/lang/analysis/inference.lux +++ b/new-luxc/source/luxc/lang/analysis/inference.lux @@ -6,7 +6,7 @@ [text] text/format (coll [list "list/" Functor<List>])) - [meta "meta/" Monad<Meta>] + [macro "macro/" Monad<Meta>] (lang [type] (type ["tc" check]))) (luxc ["&" lang] @@ -71,7 +71,7 @@ (-> &;Analyser Type (List Code) (Meta [Type (List Analysis)])) (case args #;Nil - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer inferT)] (wrap [inferT (list)])) @@ -81,12 +81,12 @@ (general analyse unnamedT args) (#;UnivQ _) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] (general analyse (maybe;assume (type;apply (list varT) inferT)) args)) (#;ExQ _) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[ex-id exT] (&;with-type-env tc;existential)] (general analyse (maybe;assume (type;apply (list exT) inferT)) args)) @@ -107,7 +107,7 @@ ## avoided in Lux code, since the inference algorithm can piece ## things together more easily. (#;Function inputT outputT) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[outputT' args'A] (general analyse outputT args') argA (&;with-stacked-errors (function [_] (Cannot-Infer-Argument @@ -118,7 +118,7 @@ (wrap [outputT' (list& argA args'A)])) (#;Var infer-id) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [?inferT' (&;with-type-env (tc;read infer-id))] (case ?inferT' (#;Some inferT') @@ -140,14 +140,14 @@ (^template [<tag>] (<tag> env bodyT) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [bodyT+ (record bodyT)] (wrap (<tag> env bodyT+)))) ([#;UnivQ] [#;ExQ]) (#;Product _) - (meta/wrap (type;function (type;flatten-tuple type) type)) + (macro/wrap (type;function (type;flatten-tuple type) type)) _ (&;throw Not-A-Record-Type (%type type)))) @@ -159,13 +159,13 @@ currentT type] (case currentT (#;Named name unnamedT) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [unnamedT+ (recur depth unnamedT)] (wrap unnamedT+)) (^template [<tag>] (<tag> env bodyT) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [bodyT+ (recur (n.inc depth) bodyT)] (wrap (<tag> env bodyT+)))) ([#;UnivQ] @@ -180,11 +180,11 @@ (n.< boundary tag))) (case (list;nth tag cases) (#;Some caseT) - (meta/wrap (if (n.= +0 depth) - (type;function (list caseT) currentT) - (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)] - (type;function (list (replace! caseT)) - (replace! currentT))))) + (macro/wrap (if (n.= +0 depth) + (type;function (list caseT) currentT) + (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)] + (type;function (list (replace! caseT)) + (replace! currentT))))) #;None (&common;variant-out-of-bounds-error type expected-size tag)) @@ -196,11 +196,11 @@ (n.= boundary tag) (let [caseT (type;variant (list;drop boundary cases))] - (meta/wrap (if (n.= +0 depth) - (type;function (list caseT) currentT) - (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)] - (type;function (list (replace! caseT)) - (replace! currentT)))))) + (macro/wrap (if (n.= +0 depth) + (type;function (list caseT) currentT) + (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)] + (type;function (list (replace! caseT)) + (replace! currentT)))))) ## else (&common;variant-out-of-bounds-error type expected-size tag))) diff --git a/new-luxc/source/luxc/lang/analysis/primitive.lux b/new-luxc/source/luxc/lang/analysis/primitive.lux index 2a0fbfbe5..9124ca271 100644 --- a/new-luxc/source/luxc/lang/analysis/primitive.lux +++ b/new-luxc/source/luxc/lang/analysis/primitive.lux @@ -1,8 +1,8 @@ (;module: lux (lux (control monad) - [meta] - (meta [code]) + [macro] + (macro [code]) (lang (type ["tc" check]))) (luxc ["&" lang] (lang ["la" analysis #+ Analysis]))) @@ -11,7 +11,7 @@ (do-template [<name> <type> <tag>] [(def: #export (<name> value) (-> <type> (Meta Analysis)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer <type>)] (wrap (<tag> value))))] @@ -25,6 +25,6 @@ (def: #export analyse-unit (Meta Analysis) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer Unit)] (wrap (` [])))) diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux index a394c554c..747e9f61d 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux @@ -8,8 +8,8 @@ (coll [list "list/" Functor<List>] [array] [dict #+ Dict])) - [meta] - (meta [code]) + [macro] + (macro [code]) (lang (type ["tc" check])) [io]) (luxc ["&" lang] @@ -52,7 +52,7 @@ (function [analyse eval args] (let [num-actual (list;size args)] (if (n.= num-expected num-actual) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer outputT) argsA (monad;map @ (function [[argT argC]] @@ -83,7 +83,7 @@ (def: (lux-is proc) (-> Text Proc) (function [analyse eval args] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] ((binary varT varT Bool proc) analyse eval args)))) @@ -95,7 +95,7 @@ (function [analyse eval args] (case args (^ (list opC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var) _ (&;infer (type (Either Text varT))) opA (&;with-type (type (io;IO varT)) @@ -146,7 +146,7 @@ (function [analyse eval args] (case args (^ (list valueC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer (type Type)) valueA (&;with-type Type (analyse valueC))] @@ -278,7 +278,7 @@ (def: (array-get proc) (-> Text Proc) (function [analyse eval args] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] ((binary Nat (type (Array varT)) varT proc) analyse eval args)))) @@ -286,7 +286,7 @@ (def: (array-put proc) (-> Text Proc) (function [analyse eval args] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] ((trinary Nat varT (type (Array varT)) (type (Array varT)) proc) analyse eval args)))) @@ -294,7 +294,7 @@ (def: (array-remove proc) (-> Text Proc) (function [analyse eval args] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] ((binary Nat (type (Array varT)) (type (Array varT)) proc) analyse eval args)))) @@ -339,7 +339,7 @@ (function [analyse eval args] (case args (^ (list initC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var) _ (&;infer (type (Atom varT))) initA (&;with-type varT @@ -352,7 +352,7 @@ (def: (atom-read proc) (-> Text Proc) (function [analyse eval args] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] ((unary (type (Atom varT)) varT proc) analyse eval args)))) @@ -360,7 +360,7 @@ (def: (atom-compare-and-swap proc) (-> Text Proc) (function [analyse eval args] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var)] ((trinary varT varT (type (Atom varT)) Bool proc) analyse eval args)))) diff --git a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux index 827f3213d..fad31eca0 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux @@ -14,9 +14,9 @@ (coll [list "list/" Fold<List> Functor<List> Monoid<List>] [array] [dict #+ Dict])) - [meta "meta/" Monad<Meta>] - (meta [code] - ["s" syntax]) + [macro "macro/" Monad<Meta>] + (macro [code] + ["s" syntax]) (lang [type] (type ["tc" check])) [host]) @@ -194,7 +194,7 @@ (function [analyse eval args] (case args (^ (list arrayC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer Nat) [var-id varT] (&;with-type-env tc;var) arrayA (&;with-type (type (Array varT)) @@ -209,10 +209,10 @@ (function [analyse eval args] (case args (^ (list lengthC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [lengthA (&;with-type Nat (analyse lengthC)) - expectedT meta;expected-type + expectedT macro;expected-type [level elem-class] (: (Meta [Nat Text]) (loop [analysisT expectedT level +0] @@ -245,13 +245,13 @@ (-> Type (Meta Text)) (case objectT (#;Primitive name _) - (meta/wrap name) + (macro/wrap name) (#;Named name unnamed) (check-jvm unnamed) (#;Var id) - (meta/wrap "java.lang.Object") + (macro/wrap "java.lang.Object") (^template [<tag>] (<tag> env unquantified) @@ -272,11 +272,11 @@ (def: (check-object objectT) (-> Type (Meta Text)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [name (check-jvm objectT)] (if (dict;contains? name boxes) (&;throw Primitives-Are-Not-Objects name) - (meta/wrap name)))) + (macro/wrap name)))) (def: (box-array-element-type elemT) (-> Type (Meta [Type Text])) @@ -284,13 +284,13 @@ (#;Primitive name #;Nil) (let [boxed-name (|> (dict;get name boxes) (maybe;default name))] - (meta/wrap [(#;Primitive boxed-name #;Nil) - boxed-name])) + (macro/wrap [(#;Primitive boxed-name #;Nil) + boxed-name])) (#;Primitive name _) (if (dict;contains? name boxes) (&;throw Primitives-Cannot-Have-Type-Parameters name) - (meta/wrap [elemT name])) + (macro/wrap [elemT name])) _ (&;throw Invalid-Type-For-Array-Element (%type elemT)))) @@ -300,7 +300,7 @@ (function [analyse eval args] (case args (^ (list arrayC idxC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var) _ (&;infer varT) arrayA (&;with-type (type (Array varT)) @@ -320,7 +320,7 @@ (function [analyse eval args] (case args (^ (list arrayC idxC valueC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[var-id varT] (&;with-type-env tc;var) _ (&;infer (type (Array varT))) arrayA (&;with-type (type (Array varT)) @@ -352,8 +352,8 @@ (function [analyse eval args] (case args (^ (list)) - (do meta;Monad<Meta> - [expectedT meta;expected-type + (do macro;Monad<Meta> + [expectedT macro;expected-type _ (check-object expectedT)] (wrap (la;procedure proc (list)))) @@ -365,7 +365,7 @@ (function [analyse eval args] (case args (^ (list objectC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer Bool) [objectT objectA] (&common;with-unknown-type (analyse objectC)) @@ -380,7 +380,7 @@ (function [analyse eval args] (case args (^ (list monitorC exprC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[monitorT monitorA] (&common;with-unknown-type (analyse monitorC)) _ (check-object monitorT) @@ -454,7 +454,7 @@ (def: (load-class name) (-> Text (Meta (Class Object))) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [class-loader &host;class-loader] (case (Class.forName [name false class-loader]) (#e;Success [class]) @@ -465,7 +465,7 @@ (def: (sub-class? super sub) (-> Text Text (Meta Bool)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [super (load-class super) sub (load-class sub)] (wrap (Class.isAssignableFrom [sub] super)))) @@ -475,7 +475,7 @@ (function [analyse eval args] (case args (^ (list exceptionC)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer Bottom) [exceptionT exceptionA] (&common;with-unknown-type (analyse exceptionC)) @@ -497,7 +497,7 @@ (^ (list classC)) (case classC [_ (#;Text class)] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer (#;Primitive "java.lang.Class" (list (#;Primitive class (list))))) _ (load-class class)] (wrap (la;procedure proc (list (code;text class))))) @@ -515,7 +515,7 @@ (^ (list classC objectC)) (case classC [_ (#;Text class)] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer Bool) [objectT objectA] (&common;with-unknown-type (analyse objectC)) @@ -550,7 +550,7 @@ (def: (java-type-to-class type) (-> java.lang.reflect.Type (Meta Text)) (cond (host;instance? Class type) - (meta/wrap (Class.getName [] (:! Class type))) + (macro/wrap (Class.getName [] (:! Class type))) (host;instance? ParameterizedType type) (java-type-to-class (ParameterizedType.getRawType [] (:! ParameterizedType type))) @@ -569,7 +569,7 @@ (let [var-name (TypeVariable.getName [] (:! TypeVariable java-type))] (case (dict;get var-name mappings) (#;Some var-type) - (meta/wrap var-type) + (macro/wrap var-type) #;None (&;throw Unknown-Type-Var var-name))) @@ -582,37 +582,37 @@ (java-type-to-lux-type mappings bound) _ - (meta/wrap Top))) + (macro/wrap Top))) (host;instance? Class java-type) (let [java-type (:! (Class Object) java-type) class-name (Class.getName [] java-type)] - (meta/wrap (case (array;size (Class.getTypeParameters [] java-type)) - +0 - (#;Primitive class-name (list)) - - arity - (|> (list;n.range +0 (n.dec arity)) - list;reverse - (list/map (|>. (n.* +2) n.inc #;Bound)) - (#;Primitive class-name) - (type;univ-q arity))))) + (macro/wrap (case (array;size (Class.getTypeParameters [] java-type)) + +0 + (#;Primitive class-name (list)) + + arity + (|> (list;n.range +0 (n.dec arity)) + list;reverse + (list/map (|>. (n.* +2) n.inc #;Bound)) + (#;Primitive 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 meta;Monad<Meta> + (do macro;Monad<Meta> [paramsT (|> java-type (ParameterizedType.getActualTypeArguments []) array;to-list (monad;map @ (java-type-to-lux-type mappings)))] - (meta/wrap (#;Primitive (Class.getName [] (:! (Class Object) raw)) - paramsT))) + (macro/wrap (#;Primitive (Class.getName [] (:! (Class Object) raw)) + paramsT))) (&;throw JVM-Type-Is-Not-Class (type-descriptor raw)))) (host;instance? GenericArrayType java-type) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [innerT (|> (:! GenericArrayType java-type) (GenericArrayType.getGenericComponentType []) (java-type-to-lux-type mappings))] @@ -652,9 +652,9 @@ " Type: " (%type type))) ## else - (meta/wrap (|> params - (list;zip2 (list/map (TypeVariable.getName []) class-params)) - (dict;from-list text;Hash<Text>))) + (macro/wrap (|> params + (list;zip2 (list/map (TypeVariable.getName []) class-params)) + (dict;from-list text;Hash<Text>))) )) _ @@ -662,7 +662,7 @@ (def: (cast direction to from) (-> Direction Type Type (Meta [Text Type])) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [to-name (check-jvm to) from-name (check-jvm from)] (cond (dict;contains? to-name boxes) @@ -712,8 +712,8 @@ (def: (infer-out outputT) (-> Type (Meta [Text Type])) - (do meta;Monad<Meta> - [expectedT meta;expected-type + (do macro;Monad<Meta> + [expectedT macro;expected-type [unboxed castT] (cast #Out expectedT outputT) _ (&;with-type-env (tc;check expectedT castT))] @@ -721,7 +721,7 @@ (def: (find-field class-name field-name) (-> Text Text (Meta [(Class Object) Field])) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [class (load-class class-name)] (case (Class.getDeclaredField [field-name] class) (#e;Success field) @@ -738,7 +738,7 @@ (def: (static-field class-name field-name) (-> Text Text (Meta [Type Bool])) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[class fieldJ] (find-field class-name field-name) #let [modifiers (Field.getModifiers [] fieldJ)]] (if (Modifier.isStatic [modifiers]) @@ -750,7 +750,7 @@ (def: (virtual-field class-name field-name objectT) (-> Text Text Type (Meta [Type Bool])) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[class fieldJ] (find-field class-name field-name) #let [modifiers (Field.getModifiers [] fieldJ)]] (if (not (Modifier.isStatic [modifiers])) @@ -783,7 +783,7 @@ (def: (analyse-object class analyse sourceC) (-> Text &;Analyser Code (Meta [Type la;Analysis])) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [target-class (load-class class) targetT (java-type-to-lux-type fresh-mappings (:! java.lang.reflect.Type @@ -797,7 +797,7 @@ (def: (analyse-input analyse targetT sourceC) (-> &;Analyser Type Code (Meta [Type Text la;Analysis])) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[sourceT sourceA] (&common;with-unknown-type (analyse sourceC)) [unboxed castT] (cast #In targetT sourceT)] @@ -810,7 +810,7 @@ (^ (list classC fieldC)) (case [classC fieldC] [[_ (#;Text class)] [_ (#;Text field)]] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[fieldT final?] (static-field class field) [unboxed castT] (infer-out fieldT)] (wrap (la;procedure proc (list (code;text class) (code;text field) @@ -829,7 +829,7 @@ (^ (list classC fieldC valueC)) (case [classC fieldC] [[_ (#;Text class)] [_ (#;Text field)]] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [_ (&;infer Unit) [fieldT final?] (static-field class field) _ (&;assert Cannot-Set-Final-Field (format class "#" field) @@ -853,7 +853,7 @@ (^ (list classC fieldC objectC)) (case [classC fieldC] [[_ (#;Text class)] [_ (#;Text field)]] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[objectT objectA] (analyse-object class analyse objectC) [fieldT final?] (virtual-field class field objectT) [unboxed castT] (infer-out fieldT)] @@ -873,7 +873,7 @@ (^ (list classC fieldC valueC objectC)) (case [classC fieldC] [[_ (#;Text class)] [_ (#;Text field)]] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[objectT objectA] (analyse-object class analyse objectC) _ (&;infer objectT) [fieldT final?] (virtual-field class field objectT) @@ -891,17 +891,17 @@ (def: (java-type-to-parameter type) (-> java.lang.reflect.Type (Meta Text)) (cond (host;instance? Class type) - (meta/wrap (Class.getName [] (:! Class type))) + (macro/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)) - (meta/wrap "java.lang.Object") + (macro/wrap "java.lang.Object") (host;instance? GenericArrayType type) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [componentP (java-type-to-parameter (GenericArrayType.getGenericComponentType [] (:! GenericArrayType type)))] (wrap (format componentP "[]"))) @@ -917,7 +917,7 @@ (def: (check-method class method-name method-type arg-classes method) (-> (Class Object) Text Method-Type (List Text) Method (Meta Bool)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [parameters (|> (Method.getGenericParameterTypes [] method) array;to-list (monad;map @ java-type-to-parameter)) @@ -946,7 +946,7 @@ (def: (check-constructor class arg-classes constructor) (-> (Class Object) (List Text) (Constructor Object) (Meta Bool)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [parameters (|> (Constructor.getGenericParameterTypes [] constructor) array;to-list (monad;map @ java-type-to-parameter))] @@ -997,7 +997,7 @@ list;reverse (list;zip2 all-tvars) (dict;from-list text;Hash<Text>))))] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [inputsT (|> (Method.getGenericParameterTypes [] method) array;to-list (monad;map @ (java-type-to-lux-type mappings))) @@ -1018,7 +1018,7 @@ (def: (methods class-name method-name method-type arg-classes) (-> Text Text Method-Type (List Text) (Meta [Type (List Type)])) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [class (load-class class-name) candidates (|> class (Class.getDeclaredMethods []) @@ -1059,7 +1059,7 @@ list;reverse (list;zip2 all-tvars) (dict;from-list text;Hash<Text>))))] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [inputsT (|> (Constructor.getGenericParameterTypes [] constructor) array;to-list (monad;map @ (java-type-to-lux-type mappings))) @@ -1074,7 +1074,7 @@ (def: (constructor-methods class-name arg-classes) (-> Text (List Text) (Meta [Type (List Type)])) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [class (load-class class-name) candidates (|> class (Class.getConstructors []) @@ -1103,10 +1103,10 @@ (def: (sub-type-analyser analyse) (-> &;Analyser &;Analyser) (function [argC] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [[argT argA] (&common;with-unknown-type (analyse argC)) - expectedT meta;expected-type + expectedT macro;expected-type [unboxed castT] (cast #In expectedT argT)] (wrap argA)))) @@ -1116,7 +1116,7 @@ (case (: (e;Error [Text Text (List [Text Code])]) (s;run args ($_ p;seq s;text s;text (p;some (s;tuple (p;seq s;text s;any)))))) (#e;Success [class method argsTC]) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [#let [argsT (list/map product;left argsTC)] [methodT exceptionsT] (methods class method #Static argsT) [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list/map product;right argsTC)) @@ -1133,7 +1133,7 @@ (case (: (e;Error [Text Text Code (List [Text Code])]) (s;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any)))))) (#e;Success [class method objectC argsTC]) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [#let [argsT (list/map product;left argsTC)] [methodT exceptionsT] (methods class method #Virtual argsT) [outputT allA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) @@ -1156,7 +1156,7 @@ (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!))) (#e;Success [_ [class method objectC argsTC _]]) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [#let [argsT (list/map product;left argsTC)] [methodT exceptionsT] (methods class method #Special argsT) [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) @@ -1173,7 +1173,7 @@ (case (: (e;Error [Text Text Code (List [Text Code])]) (s;run args ($_ p;seq s;text s;text s;any (p;some (s;tuple (p;seq s;text s;any)))))) (#e;Success [class-name method objectC argsTC]) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [#let [argsT (list/map product;left argsTC)] class (load-class class-name) _ (&;assert Non-Interface class-name @@ -1194,7 +1194,7 @@ (case (: (e;Error [Text (List [Text Code])]) (s;run args ($_ p;seq s;text (p;some (s;tuple (p;seq s;text s;any)))))) (#e;Success [class argsTC]) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [#let [argsT (list/map product;left argsTC)] [methodT exceptionsT] (constructor-methods class argsT) [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list/map product;right argsTC)) diff --git a/new-luxc/source/luxc/lang/analysis/reference.lux b/new-luxc/source/luxc/lang/analysis/reference.lux index c3ff3456b..25b33881c 100644 --- a/new-luxc/source/luxc/lang/analysis/reference.lux +++ b/new-luxc/source/luxc/lang/analysis/reference.lux @@ -1,8 +1,8 @@ (;module: lux (lux (control monad) - [meta] - (meta [code]) + [macro] + (macro [code]) (lang (type ["tc" check]))) (luxc ["&" lang] (lang ["&;" scope] @@ -12,14 +12,14 @@ ## [Analysers] (def: (analyse-definition def-name) (-> Ident (Meta Analysis)) - (do meta;Monad<Meta> - [actualT (meta;find-def-type def-name) + (do macro;Monad<Meta> + [actualT (macro;find-def-type def-name) _ (&;infer actualT)] (wrap (code;symbol def-name)))) (def: (analyse-variable var-name) (-> Text (Meta (Maybe Analysis))) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [?var (&scope;find var-name)] (case ?var (#;Some [actualT ref]) @@ -34,7 +34,7 @@ (-> Ident (Meta Analysis)) (case reference ["" simple-name] - (do meta;Monad<Meta> + (do macro;Monad<Meta> [?var (analyse-variable simple-name)] (case ?var (#;Some varA) @@ -42,7 +42,7 @@ #;None (do @ - [this-module meta;current-module-name] + [this-module macro;current-module-name] (analyse-definition [this-module simple-name])))) _ diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux index 70744ba5b..2292d93cf 100644 --- a/new-luxc/source/luxc/lang/analysis/structure.lux +++ b/new-luxc/source/luxc/lang/analysis/structure.lux @@ -9,8 +9,8 @@ (coll [list "list/" Functor<List>] [dict #+ Dict]) text/format) - [meta] - (meta [code]) + [macro] + (macro [code]) (lang [type] (type ["tc" check]))) (luxc ["&" lang] @@ -32,8 +32,8 @@ (def: #export (analyse-sum analyse tag valueC) (-> &;Analyser Nat Code (Meta la;Analysis)) - (do meta;Monad<Meta> - [expectedT meta;expected-type] + (do macro;Monad<Meta> + [expectedT macro;expected-type] (&;with-stacked-errors (function [_] (Not-Variant-Type (format " Type: " (%type expectedT) "\n" "Value: " (%code valueC) "\n" @@ -115,8 +115,8 @@ (def: (analyse-typed-product analyse membersC+) (-> &;Analyser (List Code) (Meta la;Analysis)) - (do meta;Monad<Meta> - [expectedT meta;expected-type] + (do macro;Monad<Meta> + [expectedT macro;expected-type] (loop [expectedT expectedT membersC+ membersC+] (case [expectedT membersC+] @@ -154,7 +154,7 @@ ## and what was analysed. [tailT tailC] (do @ - [g!tail (meta;gensym "tail")] + [g!tail (macro;gensym "tail")] (&;with-type tailT (analyse (` ("lux case" [(~@ tailC)] (~ g!tail) @@ -163,8 +163,8 @@ (def: #export (analyse-product analyse membersC) (-> &;Analyser (List Code) (Meta la;Analysis)) - (do meta;Monad<Meta> - [expectedT meta;expected-type] + (do macro;Monad<Meta> + [expectedT macro;expected-type] (&;with-stacked-errors (function [_] (Not-Tuple-Type (format " Type: " (%type expectedT) "\n" "Value: " (%code (` [(~@ membersC)]))))) @@ -234,10 +234,10 @@ (def: #export (analyse-tagged-sum analyse tag valueC) (-> &;Analyser Ident Code (Meta la;Analysis)) - (do meta;Monad<Meta> - [tag (meta;normalize tag) - [idx group variantT] (meta;resolve-tag tag) - expectedT meta;expected-type] + (do macro;Monad<Meta> + [tag (macro;normalize tag) + [idx group variantT] (macro;resolve-tag tag) + expectedT macro;expected-type] (case expectedT (#;Var _) (do @ @@ -256,12 +256,12 @@ ## canonical form (with their corresponding module identified). (def: #export (normalize record) (-> (List [Code Code]) (Meta (List [Ident Code]))) - (monad;map meta;Monad<Meta> + (monad;map macro;Monad<Meta> (function [[key val]] (case key [_ (#;Tag key)] - (do meta;Monad<Meta> - [key (meta;normalize key)] + (do macro;Monad<Meta> + [key (macro;normalize key)] (wrap [key val])) _ @@ -277,12 +277,12 @@ (case record ## empty-record = empty-tuple = unit = [] #;Nil - (:: meta;Monad<Meta> wrap [(list) Unit]) + (:: macro;Monad<Meta> wrap [(list) Unit]) (#;Cons [head-k head-v] _) - (do meta;Monad<Meta> - [head-k (meta;normalize head-k) - [_ tag-set recordT] (meta;resolve-tag head-k) + (do macro;Monad<Meta> + [head-k (macro;normalize head-k) + [_ tag-set recordT] (macro;resolve-tag head-k) #let [size-record (list;size record) size-ts (list;size tag-set)] _ (if (n.= size-ts size-record) @@ -296,7 +296,7 @@ idx->val (monad;fold @ (function [[key val] idx->val] (do @ - [key (meta;normalize key)] + [key (macro;normalize key)] (case (dict;get key tag->idx) #;None (&;throw Tag-Does-Not-Belong-To-Record @@ -321,10 +321,10 @@ (def: #export (analyse-record analyse members) (-> &;Analyser (List [Code Code]) (Meta la;Analysis)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [members (normalize members) [membersC recordT] (order members) - expectedT meta;expected-type] + expectedT macro;expected-type] (case expectedT (#;Var _) (do @ diff --git a/new-luxc/source/luxc/lang/analysis/type.lux b/new-luxc/source/luxc/lang/analysis/type.lux index c91fdab38..f85608e19 100644 --- a/new-luxc/source/luxc/lang/analysis/type.lux +++ b/new-luxc/source/luxc/lang/analysis/type.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control monad) - [meta] + [macro] (lang (type ["tc" check]))) (luxc ["&" lang] (lang ["la" analysis #+ Analysis]))) @@ -11,7 +11,7 @@ ## computing Lux type values. (def: #export (analyse-check analyse eval type value) (-> &;Analyser &;Eval Code Code (Meta Analysis)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [actualT (eval Type type) #let [actualT (:! Type actualT)] _ (&;infer actualT)] @@ -20,7 +20,7 @@ (def: #export (analyse-coerce analyse eval type value) (-> &;Analyser &;Eval Code Code (Meta Analysis)) - (do meta;Monad<Meta> + (do macro;Monad<Meta> [actualT (eval Type type) _ (&;infer (:! Type actualT))] (&;with-type Top |