diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis/procedure')
| -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 |
2 files changed, 84 insertions, 84 deletions
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)) |