From 530a14bfe7714f94babdb34c237b88321408a685 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 13 Nov 2017 23:45:12 -0400
Subject: - More refactoring.
---
.../luxc/lang/analysis/procedure/host.jvm.lux | 49 ++++++++--------------
1 file changed, 17 insertions(+), 32 deletions(-)
(limited to 'new-luxc/source/luxc/lang/analysis/procedure/host.jvm.lux')
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
[_ (&;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
- [[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
[_ (&;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
- [[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
- [[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
[#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
[#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
[#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
[#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)))))
--
cgit v1.2.3