- More refactoring.

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)))))