diff options
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.lux | 49 |
1 files changed, 17 insertions, 32 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 fa10a7a1c..39ca0eb43 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux @@ -24,7 +24,7 @@ ["&;" host] (lang ["la" analysis] (analysis ["&;" common] - ["&;" inference]))) + [";A" inference]))) ["@" ../common] ) @@ -367,11 +367,8 @@ (^ (list objectC)) (do meta;Monad<Meta> [_ (&;infer Bool) - [var-id varT] (&;with-type-env tc;var) - objectA (&;with-expected-type varT - (analyse objectC)) - objectT (&;with-type-env - (tc;read var-id)) + [objectT objectA] (&common;with-unknown-type + (analyse objectC)) _ (check-object objectT)] (wrap (la;procedure proc (list objectA)))) @@ -384,11 +381,8 @@ (case args (^ (list monitorC exprC)) (do meta;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var) - monitorA (&;with-expected-type varT - (analyse monitorC)) - monitorT (&;with-type-env - (tc;read var-id)) + [[monitorT monitorA] (&common;with-unknown-type + (analyse monitorC)) _ (check-object monitorT) exprA (analyse exprC)] (wrap (la;procedure proc (list monitorA exprA)))) @@ -483,11 +477,8 @@ (^ (list exceptionC)) (do meta;Monad<Meta> [_ (&;infer Bottom) - [var-id varT] (&;with-type-env tc;var) - exceptionA (&;with-expected-type varT - (analyse exceptionC)) - exceptionT (&;with-type-env - (tc;read var-id)) + [exceptionT exceptionA] (&common;with-unknown-type + (analyse exceptionC)) exception-class (check-object exceptionT) ? (sub-class? "java.lang.Throwable" exception-class) _ (: (Meta Unit) @@ -793,15 +784,12 @@ (def: (analyse-object class analyse sourceC) (-> Text &;Analyser Code (Meta [Type la;Analysis])) (do meta;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var) - target-class (load-class class) + [target-class (load-class class) targetT (java-type-to-lux-type fresh-mappings (:! java.lang.reflect.Type target-class)) - sourceA (&;with-expected-type varT - (analyse sourceC)) - sourceT (&;with-type-env - (tc;read var-id)) + [sourceT sourceA] (&common;with-unknown-type + (analyse sourceC)) [unboxed castT] (cast #Out targetT sourceT) _ (&;assert Cannot-Cast (cannot-cast targetT sourceT) (not (dict;contains? unboxed boxes)))] @@ -810,11 +798,8 @@ (def: (analyse-input analyse targetT sourceC) (-> &;Analyser Type Code (Meta [Type Text la;Analysis])) (do meta;Monad<Meta> - [[var-id varT] (&;with-type-env tc;var) - sourceA (&;with-expected-type varT - (analyse sourceC)) - sourceT (&;with-type-env - (tc;read var-id)) + [[sourceT sourceA] (&common;with-unknown-type + (analyse sourceC)) [unboxed castT] (cast #In targetT sourceT)] (wrap [castT unboxed sourceA]))) @@ -1134,7 +1119,7 @@ (do meta;Monad<Meta> [#let [argsT (list/map product;left argsTC)] [methodT exceptionsT] (methods class method #Static argsT) - [outputT argsA] (&inference;apply-function (sub-type-analyser analyse) methodT (list/map product;right argsTC)) + [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list/map product;right argsTC)) [unboxed castT] (infer-out outputT)] (wrap (la;procedure proc (list& (code;text class) (code;text method) (code;text unboxed) (decorate-inputs argsT argsA))))) @@ -1151,7 +1136,7 @@ (do meta;Monad<Meta> [#let [argsT (list/map product;left argsTC)] [methodT exceptionsT] (methods class method #Virtual argsT) - [outputT allA] (&inference;apply-function (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) + [outputT allA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) #let [[objectA argsA] (case allA (#;Cons objectA argsA) [objectA argsA] @@ -1174,7 +1159,7 @@ (do meta;Monad<Meta> [#let [argsT (list/map product;left argsTC)] [methodT exceptionsT] (methods class method #Special argsT) - [outputT argsA] (&inference;apply-function (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) + [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) [unboxed castT] (infer-out outputT)] (wrap (la;procedure proc (list& (code;text class) (code;text method) (code;text unboxed) (decorate-inputs argsT argsA))))) @@ -1194,7 +1179,7 @@ _ (&;assert Non-Interface class-name (Modifier.isInterface [(Class.getModifiers [] class)])) [methodT exceptionsT] (methods class-name method #Interface argsT) - [outputT argsA] (&inference;apply-function (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) + [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list& objectC (list/map product;right argsTC))) [unboxed castT] (infer-out outputT)] (wrap (la;procedure proc (list& (code;text class-name) (code;text method) (code;text unboxed) @@ -1212,7 +1197,7 @@ (do meta;Monad<Meta> [#let [argsT (list/map product;left argsTC)] [methodT exceptionsT] (constructor-methods class argsT) - [outputT argsA] (&inference;apply-function (sub-type-analyser analyse) methodT (list/map product;right argsTC)) + [outputT argsA] (inferenceA;general (sub-type-analyser analyse) methodT (list/map product;right argsTC)) [unboxed castT] (infer-out outputT)] (wrap (la;procedure proc (list& (code;text class) (decorate-inputs argsT argsA))))) |