aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux144
1 files changed, 72 insertions, 72 deletions
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))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-16 13:22:34 +0000