- Made some optimizations.

- Compiler can now distinguish between JVM and JS host state.
- Now, complex (with subtyping) type-checking can be done only during JVM compilation.

10 files changed, 212 insertions, 217 deletions

diff --git a/luxc/src/lux/analyser.clj b/luxc/src/lux/analyser.clj
index e2aa64590..280085777 100644
--- a/luxc/src/lux/analyser.clj
+++ b/luxc/src/lux/analyser.clj
@@ -57,7 +57,7 @@
             (return (&&/|meta =output-type ?output-cursor ?output-term))))
         ))))
 
-(defn ^:private analyse-ast [optimize eval! compile-module compilers exo-type ?token]
+(defn ^:private analyse-ast [optimize eval! compile-module ^"[Ljava.lang.Object;" compilers exo-type ?token]
   (|let [analyse (partial analyse-ast optimize eval! compile-module compilers)
          [cursor token] ?token
          compile-def (aget compilers 0)
diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj
index af7f0f3f9..aee46a9cc 100644
--- a/luxc/src/lux/analyser/lux.clj
+++ b/luxc/src/lux/analyser/lux.clj
@@ -376,35 +376,33 @@
                                )))))
 
 (defn analyse-apply [analyse cursor exo-type macro-caller =fn ?args]
-  (|do [loader &/loader
-        :let [[[=fn-type =fn-cursor] =fn-form] =fn]]
-    (|case =fn-form
-      (&&/$var (&/$Global ?module ?name))
-      (|do [[real-name [?type ?meta ?value]] (&&module/find-def ?module ?name)]
-        (|case (&&meta/meta-get &&meta/macro?-tag ?meta)
-          (&/$Some _)
-          (|do [macro-expansion (fn [state]
-                                  (|case (macro-caller ?value ?args state)
-                                    (&/$Right state* output)
-                                    (&/$Right (&/T [state* output]))
-
-                                    (&/$Left error)
-                                    ((&/fail-with-loc error) state)))
-                ;; module-name &/get-module-name
-                ;; :let [[r-prefix r-name] real-name
-                ;;       _ (->> (&/|map &/show-ast macro-expansion)
-                ;;              (&/|interpose "\n")
-                ;;              (&/fold str "")
-                ;;              (println 'macro-expansion (&/ident->text real-name) "@" module-name))]
-                ]
-            (&/flat-map% (partial analyse exo-type) macro-expansion))
+  (|case =fn
+    [_ (&&/$var (&/$Global ?module ?name))]
+    (|do [[real-name [?type ?meta ?value]] (&&module/find-def ?module ?name)]
+      (|case (&&meta/meta-get &&meta/macro?-tag ?meta)
+        (&/$Some _)
+        (|do [macro-expansion (fn [state]
+                                (|case (macro-caller ?value ?args state)
+                                  (&/$Right state* output)
+                                  (&/$Right (&/T [state* output]))
+
+                                  (&/$Left error)
+                                  ((&/fail-with-loc error) state)))
+              ;; module-name &/get-module-name
+              ;; :let [[r-prefix r-name] real-name
+              ;;       _ (->> (&/|map &/show-ast macro-expansion)
+              ;;              (&/|interpose "\n")
+              ;;              (&/fold str "")
+              ;;              (println 'macro-expansion (&/ident->text real-name) "@" module-name))]
+              ]
+          (&/flat-map% (partial analyse exo-type) macro-expansion))
 
-          _
-          (do-analyse-apply analyse exo-type =fn ?args)))
-      
-      _
-      (do-analyse-apply analyse exo-type =fn ?args))
-    ))
+        _
+        (do-analyse-apply analyse exo-type =fn ?args)))
+    
+    _
+    (do-analyse-apply analyse exo-type =fn ?args))
+  )
 
 (defn analyse-case [analyse exo-type ?value ?branches]
   (|do [:let [num-branches (&/|length ?branches)]
diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj
index bbb5f3888..df4fb293f 100644
--- a/luxc/src/lux/base.clj
+++ b/luxc/src/lux/base.clj
@@ -137,6 +137,11 @@
   ["compiler-version"
    "compiler-mode"])
 
+;; Hosts
+(defvariant
+  ("Jvm" 1)
+  ("Js" 1))
+
 (deftuple
   ["info"
    "source"
@@ -221,7 +226,6 @@
 
 ;; [Exports]
 (def ^:const value-field "_value")
-(def ^:const eval-field "_eval")
 (def ^:const module-class-name "_")
 (def ^:const +name-separator+ ";")
 
@@ -659,6 +663,18 @@
         (return* state unit-tag)
         (fail* msg)))))
 
+(defn |some [f xs]
+  "(All [a b] (-> (-> a (Maybe b)) (List a) (Maybe b)))"
+  (|case xs
+    ($Nil)
+    $None
+
+    ($Cons x xs*)
+    (|case (f x)
+      ($None) (|some f xs*)
+      output  output)
+    ))
+
 (defn ^:private normalize-char [char]
   (case char
     \* "_ASTER_"
@@ -690,10 +706,6 @@
 (defn normalize-name [ident]
   (reduce str "" (map normalize-char ident)))
 
-(def classes
-  (fn [state]
-    (return* state (->> state (get$ $host) (get$ $classes)))))
-
 (def +init-bindings+
   (T [;; "lux;counter"
       0
@@ -711,9 +723,85 @@
       +init-bindings+]
      ))
 
-(def loader
-  (fn [state]
-    (return* state (->> state (get$ $host) (get$ $loader)))))
+(do-template [<tag> <host> <ask> <change> <with>]
+  (do (def <host>
+        (fn [compiler]
+          (|case (get$ $host compiler)
+            (<tag> host-data)
+            (return* compiler host-data)
+
+            _
+            (fail* "[Error] Wrong host."))))
+
+    (def <ask>
+      (fn [compiler]
+        (|case (get$ $host compiler)
+          (<tag> host-data)
+          (return* compiler true)
+
+          _
+          (return* compiler false))))
+
+    (defn <change> [slot updater]
+      (|do [host <host>]
+        (fn [compiler]
+          (return* (set$ $host (<tag> (update$ slot updater host)) compiler)
+                   (get$ slot host)))))
+
+    (defn <with> [slot updater body]
+      (|do [old-val (<change> slot updater)
+            ?output-val body
+            new-val (<change> slot (fn [_] old-val))]
+        (return ?output-val))))
+
+  $Jvm jvm-host jvm? change-jvm-host-slot with-jvm-host-slot
+  $Js  js-host  js?  change-js-host-slot  with-js-host-slot
+  )
+
+(do-template [<name> <slot>]
+  (def <name>
+    (|do [host jvm-host]
+      (return (get$ <slot> host))))
+
+  loader       $loader
+  classes      $classes
+  get-type-env $type-env
+  )
+
+(def get-writer
+  (|do [host jvm-host]
+    (|case (get$ $writer host)
+      ($Some writer)
+      (return writer)
+
+      _
+      (fail-with-loc "[Error] Writer hasn't been set."))))
+
+(defn with-writer [writer body]
+  (with-jvm-host-slot $writer (fn [_] ($Some writer)) body))
+
+(defn with-type-env [type-env body]
+  "(All [a] (-> TypeEnv (Lux a) (Lux a)))"
+  (with-jvm-host-slot $type-env (partial |++ type-env) body))
+
+(defn push-dummy-name [real-name store-name]
+  (change-jvm-host-slot $dummy-mappings (partial $Cons (T [real-name store-name]))))
+
+(def pop-dummy-name
+  (change-jvm-host-slot $dummy-mappings |tail))
+
+(defn de-alias-class [class-name]
+  (|do [host jvm-host]
+    (return (|case (|some #(|let [[real-name store-name] %]
+                             (if (= real-name class-name)
+                               ($Some store-name)
+                               $None))
+                          (get$ $dummy-mappings host))
+              ($Some store-name)
+              store-name
+
+              _
+              class-name))))
 
 (defn with-no-catches [body]
   "(All [a] (-> (Lux a) (Lux a)))"
@@ -800,16 +888,6 @@
   (fn [state]
     (return* state (->> state (get$ $info) (get$ $compiler-mode)))))
 
-(def get-writer
-  (fn [state]
-    (let [writer* (->> state (get$ $host) (get$ $writer))]
-      (|case writer*
-        ($Some datum)
-        (return* state datum)
-
-        _
-        ((fail-with-loc "[Error] Writer hasn't been set.") state)))))
-
 (def get-top-local-env
   (fn [state]
     (try (let [top (|head (get$ $scopes state))]
@@ -933,18 +1011,6 @@
           _
           output)))))
 
-(defn with-writer [writer body]
-  (fn [state]
-    (let [old-writer (->> state (get$ $host) (get$ $writer))
-          output (body (update$ $host #(set$ $writer ($Some writer) %) state))]
-      (|case output
-        ($Right ?state ?value)
-        (return* (update$ $host #(set$ $writer old-writer %) ?state)
-                 ?value)
-
-        _
-        output))))
-
 (defn with-expected-type [type body]
   "(All [a] (-> Type (Lux a)))"
   (fn [state]
@@ -1333,40 +1399,6 @@
       output
       output)))
 
-(defn |some [f xs]
-  "(All [a b] (-> (-> a (Maybe b)) (List a) (Maybe b)))"
-  (|case xs
-    ($Nil)
-    $None
-
-    ($Cons x xs*)
-    (|case (f x)
-      ($None) (|some f xs*)
-      output  output)
-    ))
-
-(def get-type-env
-  "(Lux TypeEnv)"
-  (fn [state]
-    (return* state (->> state (get$ $host) (get$ $type-env)))))
-
-(defn with-type-env [type-env body]
-  "(All [a] (-> TypeEnv (Lux a) (Lux a)))"
-  (fn [state]
-    (|let [state* (update$ $host #(update$ $type-env (partial |++ type-env) %)
-                           state)]
-      (|case (body state*)
-        ($Right [state** output])
-        ($Right (T [(update$ $host
-                             #(set$ $type-env
-                                    (->> state (get$ $host) (get$ $type-env))
-                                    %)
-                             state**)
-                    output]))
-
-        ($Left msg)
-        ($Left msg)))))
-
 (defn |take [n xs]
   (|case (T [n xs])
     [0 _]             $Nil
@@ -1412,38 +1444,6 @@
       ($Left msg)
       ($Left msg))))
 
-(defn push-dummy-name [real-name store-name]
-  (fn [state]
-    ($Right (T [(update$ $host
-                         #(update$ $dummy-mappings
-                                   (partial $Cons (T [real-name store-name]))
-                                   %)
-                         state)
-                nil]))))
-
-(def pop-dummy-name
-  (fn [state]
-    ($Right (T [(update$ $host
-                         #(update$ $dummy-mappings
-                                   |tail
-                                   %)
-                         state)
-                nil]))))
-
-(defn de-alias-class [class-name]
-  (fn [state]
-    ($Right (T [state
-                (|case (|some #(|let [[real-name store-name] %]
-                                 (if (= real-name class-name)
-                                   ($Some store-name)
-                                   $None))
-                              (->> state (get$ $host) (get$ $dummy-mappings)))
-                  ($Some store-name)
-                  store-name
-
-                  _
-                  class-name)]))))
-
 (defn |eitherL [left right]
   (fn [compiler]
     (|case (run-state left compiler)
diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj
index 77e4221e8..7299b7166 100644
--- a/luxc/src/lux/compiler/cache.clj
+++ b/luxc/src/lux/compiler/cache.clj
@@ -23,7 +23,7 @@
           :when (not (.isDirectory f))]
     (.delete f)))
 
-(defn ^:private module-path [module]
+(defn ^:private ^String module-path [module]
   (str @&&core/!output-dir
        java.io.File/separator
        (.replace ^String (&host/->module-class module) "/" java.io.File/separator)))
diff --git a/luxc/src/lux/compiler/core.clj b/luxc/src/lux/compiler/core.clj
index 6dacb4e54..15f03ea6e 100644
--- a/luxc/src/lux/compiler/core.clj
+++ b/luxc/src/lux/compiler/core.clj
@@ -4,9 +4,7 @@
             [clojure.java.io :as io]
             [clojure.core.match :as M :refer [matchv]]
             clojure.core.match.array
-            (lux [base :as & :refer [|let |do return* return fail*]]
-                 [type :as &type]
-                 [host :as &host])
+            (lux [base :as & :refer [|let |do return* return fail*]])
             (lux.analyser [base :as &a]
                           [module :as &a-module])
             (lux.compiler.cache [type :as &&&type]
diff --git a/luxc/src/lux/compiler/js.clj b/luxc/src/lux/compiler/js.clj
index 18b91f5bc..b43ab5b4d 100644
--- a/luxc/src/lux/compiler/js.clj
+++ b/luxc/src/lux/compiler/js.clj
@@ -137,7 +137,7 @@
                       (if module-exists?
                         (&/fail-with-loc (str "[Compiler Error] Can't re-define a module: " name))
                         (|do [_ (&&cache/delete name)
-                              _ &&/init-buffer
+                              _ (&&/init-buffer)
                               _ (&a-module/create-module name file-hash)
                               _ (&a-module/flag-active-module name)
                               _ (if (= "lux" name)
diff --git a/luxc/src/lux/compiler/js/base.clj b/luxc/src/lux/compiler/js/base.clj
index 50ece15e6..329252798 100644
--- a/luxc/src/lux/compiler/js/base.clj
+++ b/luxc/src/lux/compiler/js/base.clj
@@ -24,49 +24,40 @@
    "buffer"])
 
 (defn js-host []
-  (&/T [;; "interpreter"
-        (.getScriptEngine (new NashornScriptEngineFactory))
-        ;; "buffer"
-        &/$None
-        ]))
+  (&/$Js (&/T [;; "interpreter"
+               (.getScriptEngine (new NashornScriptEngineFactory))
+               ;; "buffer"
+               &/$None
+               ])))
 
 (def ^String module-js-name "module.js")
 
-(def init-buffer
-  (fn [compiler-state]
-    (&/$Right (&/T [(&/update$ &/$host
-                               (fn [host]
-                                 (&/set$ $buffer
-                                         (&/$Some (new StringBuilder))
-                                         host))
-                               compiler-state)
-                    nil]))))
+(defn init-buffer []
+  (&/change-js-host-slot $buffer (fn [_] (&/$Some (new StringBuilder)))))
 
 (def get-buffer
-  (fn [compiler-state]
-    (|case (->> compiler-state (&/get$ &/$host) (&/get$ $buffer))
+  (|do [host &/js-host]
+    (|case (&/get$ $buffer host)
       (&/$Some _buffer)
-      (&/$Right (&/T [compiler-state
-                      _buffer]))
+      (return _buffer)
 
       (&/$None)
-      (&/$Left "[Error] No buffer available."))))
+      (&/fail-with-loc "[Error] No buffer available."))))
 
 (defn run-js! [^String js-code]
-  (fn [compiler-state]
-    (|let [^NashornScriptEngine interpreter (->> compiler-state (&/get$ &/$host) (&/get$ $interpreter))]
-      (try (&/$Right (&/T [compiler-state
-                           (.eval interpreter js-code)]))
-        (catch Exception ex
-          (&/$Left (str ex)))))))
+  (|do [host &/js-host
+        :let [interpreter ^NashornScriptEngine (&/get$ $interpreter host)]]
+    (try (return (.eval interpreter js-code))
+      (catch Exception ex
+        (&/fail-with-loc (str ex))))))
 
 (def ^:private lux-obj-class (Class/forName "[Ljava.lang.Object;"))
 
-(defn ^:private _slice_ [wrap-lux-obj value]
+(defn ^:private _slice_ [wrap-lux-obj ^"[Ljava.lang.Object;" value]
   (reify JSObject
     (isFunction [self] true)
     (call [self this args]
-      (let [slice (java.util.Arrays/copyOfRange value (aget args 0) (alength value))]
+      (let [slice (java.util.Arrays/copyOfRange value ^int (aget args 0) ^int (alength value))]
         (wrap-lux-obj slice)))))
 
 (defn ^:private _toString_ [obj]
@@ -102,7 +93,7 @@
         ;; else
         (assert false (str "encode-char#getMember = " member))))))
 
-(deftype LuxJsObject [obj]
+(deftype LuxJsObject [^"[Ljava.lang.Object;" obj]
   JSObject
   (isFunction [self] false)
   (getSlot [self idx]
@@ -139,7 +130,7 @@
   (.hasMember js-object "C"))
 
 (defn ^:private decode-char [^ScriptObjectMirror js-object]
-  (-> (.getMember js-object "C")
+  (-> ^String (.getMember js-object "C")
       (.charAt 0)))
 
 (defn ^:private parse-int64 [^ScriptObjectMirror js-object]
diff --git a/luxc/src/lux/compiler/js/lux.clj b/luxc/src/lux/compiler/js/lux.clj
index 0f86d8a33..5103b2d2b 100644
--- a/luxc/src/lux/compiler/js/lux.clj
+++ b/luxc/src/lux/compiler/js/lux.clj
@@ -314,8 +314,7 @@
                  ";})(" (->> =env-values (&/|interpose ",") (&/fold str "")) ")"))))
 
 (defn compile-def [compile ?name ?body def-meta]
-  (|do [module-name &/get-module-name
-        class-loader &/loader]
+  (|do [module-name &/get-module-name]
     (|case (&a-meta/meta-get &a-meta/alias-tag def-meta)
       (&/$Some (&/$IdentA [r-module r-name]))
       (if (= 1 (&/|length def-meta))
diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj
index f09224c90..5cc3c1f79 100644
--- a/luxc/src/lux/compiler/jvm.clj
+++ b/luxc/src/lux/compiler/jvm.clj
@@ -140,7 +140,7 @@
                 =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
                          (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
                                  class-name nil "java/lang/Object" nil)
-                         (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/eval-field "Ljava/lang/Object;" nil nil)
+                         (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC) &/value-field "Ljava/lang/Object;" nil nil)
                              (doto (.visitEnd)))
                          (.visitSource file-name nil))]
           _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
@@ -148,7 +148,7 @@
                     :let [_ (.visitCode *writer*)]
                     _ (compile-expression nil expr)
                     :let [_ (doto *writer*
-                              (.visitFieldInsn Opcodes/PUTSTATIC class-name &/eval-field "Ljava/lang/Object;")
+                              (.visitFieldInsn Opcodes/PUTSTATIC class-name &/value-field "Ljava/lang/Object;")
                               (.visitInsn Opcodes/RETURN)
                               (.visitMaxs 0 0)
                               (.visitEnd))]]
@@ -158,7 +158,7 @@
           _ (&&/save-class! (str id) bytecode)
           loader &/loader]
       (-> (.loadClass ^ClassLoader loader (str (&host-generics/->class-name module) "." id))
-          (.getField &/eval-field)
+          (.getField &/value-field)
           (.get nil)
           return))))
 
@@ -228,19 +228,19 @@
 
 (defn jvm-host []
   (let [store (atom {})]
-    (&/T [;; "lux;writer"
-          &/$None
-          ;; "lux;loader"
-          (memory-class-loader store)
-          ;; "lux;classes"
-          store
-          ;; "lux;module-states"
-          (&/|table)
-          ;; lux;type-env
-          (&/|table)
-          ;; lux;dummy-mappings
-          (&/|table)
-          ])))
+    (&/$Jvm (&/T [;; "lux;writer"
+                  &/$None
+                  ;; "lux;loader"
+                  (memory-class-loader store)
+                  ;; "lux;classes"
+                  store
+                  ;; "lux;module-states"
+                  (&/|table)
+                  ;; lux;type-env
+                  (&/|table)
+                  ;; lux;dummy-mappings
+                  (&/|table)
+                  ]))))
 
 (let [!err! *err*]
   (defn compile-program [mode program-module resources-dir source-dirs target-dir]
diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj
index d3805cabc..ad185e284 100644
--- a/luxc/src/lux/type.clj
+++ b/luxc/src/lux/type.clj
@@ -649,7 +649,7 @@
 
 (def ^:private init-fixpoints &/$Nil)
 
-(defn ^:private check* [class-loader fixpoints invariant?? expected actual]
+(defn ^:private check* [fixpoints invariant?? expected actual]
   (if (clojure.lang.Util/identical expected actual)
     (return fixpoints)
     (&/with-attempt
@@ -677,13 +677,13 @@
                 (return fixpoints))
               
               [(&/$Some etype) (&/$None _)]
-              (check* class-loader fixpoints invariant?? etype actual)
+              (check* fixpoints invariant?? etype actual)
 
               [(&/$None _) (&/$Some atype)]
-              (check* class-loader fixpoints invariant?? expected atype)
+              (check* fixpoints invariant?? expected atype)
 
               [(&/$Some etype) (&/$Some atype)]
-              (check* class-loader fixpoints invariant?? etype atype))))
+              (check* fixpoints invariant?? etype atype))))
         
         [(&/$VarT ?id) _]
         (fn [state]
@@ -693,7 +693,7 @@
 
             (&/$Left _)
             ((|do [bound (deref ?id)]
-               (check* class-loader fixpoints invariant?? bound actual))
+               (check* fixpoints invariant?? bound actual))
              state)))
         
         [_ (&/$VarT ?id)]
@@ -704,18 +704,18 @@
 
             (&/$Left _)
             ((|do [bound (deref ?id)]
-               (check* class-loader fixpoints invariant?? expected bound))
+               (check* fixpoints invariant?? expected bound))
              state)))
 
         [(&/$AppT (&/$ExT eid) eA) (&/$AppT (&/$ExT aid) aA)]
         (if (= eid aid)
-          (check* class-loader fixpoints invariant?? eA aA)
+          (check* fixpoints invariant?? eA aA)
           (check-error "" expected actual))
 
         [(&/$AppT (&/$VarT ?id) A1) (&/$AppT F2 A2)]
         (fn [state]
           (|case ((|do [F1 (deref ?id)]
-                    (check* class-loader fixpoints invariant?? (&/$AppT F1 A1) actual))
+                    (check* fixpoints invariant?? (&/$AppT F1 A1) actual))
                   state)
             (&/$Right state* output)
             (return* state* output)
@@ -724,34 +724,34 @@
             (|case F2
               (&/$UnivQ (&/$Cons _) _)
               ((|do [actual* (apply-type F2 A2)]
-                 (check* class-loader fixpoints invariant?? expected actual*))
+                 (check* fixpoints invariant?? expected actual*))
                state)
 
               (&/$ExT _)
-              ((|do [fixpoints* (check* class-loader fixpoints invariant?? (&/$VarT ?id) F2)]
-                 (check* class-loader fixpoints* invariant?? A1 A2))
+              ((|do [fixpoints* (check* fixpoints invariant?? (&/$VarT ?id) F2)]
+                 (check* fixpoints* invariant?? A1 A2))
                state)
 
               _
-              ((|do [fixpoints* (check* class-loader fixpoints invariant?? (&/$VarT ?id) F2)
+              ((|do [fixpoints* (check* fixpoints invariant?? (&/$VarT ?id) F2)
                      e* (apply-type F2 A1)
                      a* (apply-type F2 A2)]
-                 (check* class-loader fixpoints* invariant?? e* a*))
+                 (check* fixpoints* invariant?? e* a*))
                state))))
         
         [(&/$AppT F1 A1) (&/$AppT (&/$VarT ?id) A2)]
         (fn [state]
           (|case ((|do [F2 (deref ?id)]
-                    (check* class-loader fixpoints invariant?? expected (&/$AppT F2 A2)))
+                    (check* fixpoints invariant?? expected (&/$AppT F2 A2)))
                   state)
             (&/$Right state* output)
             (return* state* output)
 
             (&/$Left _)
-            ((|do [fixpoints* (check* class-loader fixpoints invariant?? F1 (&/$VarT ?id))
+            ((|do [fixpoints* (check* fixpoints invariant?? F1 (&/$VarT ?id))
                    e* (apply-type F1 A1)
                    a* (apply-type F1 A2)]
-               (check* class-loader fixpoints* invariant?? e* a*))
+               (check* fixpoints* invariant?? e* a*))
              state)))
         
         [(&/$AppT F A) _]
@@ -773,25 +773,25 @@
 
             (&/$None)
             (|do [expected* (apply-type F A)]
-              (check* class-loader (fp-put fp-pair true fixpoints) invariant?? expected* actual))))
+              (check* (fp-put fp-pair true fixpoints) invariant?? expected* actual))))
 
         [_ (&/$AppT (&/$ExT aid) A)]
         (check-error "" expected actual)
 
         [_ (&/$AppT F A)]
         (|do [actual* (apply-type F A)]
-          (check* class-loader fixpoints invariant?? expected actual*))
+          (check* fixpoints invariant?? expected actual*))
 
         [(&/$UnivQ _) _]
         (|do [$arg existential
               expected* (apply-type expected $arg)]
-          (check* class-loader fixpoints invariant?? expected* actual))
+          (check* fixpoints invariant?? expected* actual))
 
         [_ (&/$UnivQ _)]
         (with-var
           (fn [$arg]
             (|do [actual* (apply-type actual $arg)
-                  =output (check* class-loader fixpoints invariant?? expected actual*)
+                  =output (check* fixpoints invariant?? expected actual*)
                   _ (clean $arg expected)]
               (return =output))))
 
@@ -799,24 +799,34 @@
         (with-var
           (fn [$arg]
             (|do [expected* (apply-type expected $arg)
-                  =output (check* class-loader fixpoints invariant?? expected* actual)
+                  =output (check* fixpoints invariant?? expected* actual)
                   _ (clean $arg actual)]
               (return =output))))
 
         [_ (&/$ExQ a!env a!def)]
         (|do [$arg existential
               actual* (apply-type actual $arg)]
-          (check* class-loader fixpoints invariant?? expected actual*))
+          (check* fixpoints invariant?? expected actual*))
 
         [(&/$HostT e!data) (&/$HostT a!data)]
-        (&&host/check-host-types (partial check* class-loader fixpoints true)
-                                 check-error
-                                 fixpoints
-                                 existential
-                                 class-loader
-                                 invariant??
-                                 e!data
-                                 a!data)
+        (|do [? &/jvm?]
+          (if ?
+            (|do [class-loader &/loader]
+              (&&host/check-host-types (partial check* fixpoints true)
+                                       check-error
+                                       fixpoints
+                                       existential
+                                       class-loader
+                                       invariant??
+                                       e!data
+                                       a!data))
+            (|let [[e!name e!params] e!data
+                   [a!name a!params] a!data]
+              (if (and (= e!name a!name)
+                       (= (&/|length e!params) (&/|length a!params)))
+                (|do [_ (&/map2% (partial check* fixpoints true) e!params a!params)]
+                  (return fixpoints))
+                (check-error "" expected actual)))))
 
         [(&/$VoidT) (&/$VoidT)]
         (return fixpoints)
@@ -825,16 +835,16 @@
         (return fixpoints)
 
         [(&/$LambdaT eI eO) (&/$LambdaT aI aO)]
-        (|do [fixpoints* (check* class-loader fixpoints invariant?? aI eI)]
-          (check* class-loader fixpoints* invariant?? eO aO))
+        (|do [fixpoints* (check* fixpoints invariant?? aI eI)]
+          (check* fixpoints* invariant?? eO aO))
 
         [(&/$ProdT eL eR) (&/$ProdT aL aR)]
-        (|do [fixpoints* (check* class-loader fixpoints invariant?? eL aL)]
-          (check* class-loader fixpoints* invariant?? eR aR))
+        (|do [fixpoints* (check* fixpoints invariant?? eL aL)]
+          (check* fixpoints* invariant?? eR aR))
 
         [(&/$SumT eL eR) (&/$SumT aL aR)]
-        (|do [fixpoints* (check* class-loader fixpoints invariant?? eL aL)]
-          (check* class-loader fixpoints* invariant?? eR aR))
+        (|do [fixpoints* (check* fixpoints invariant?? eL aL)]
+          (check* fixpoints* invariant?? eR aR))
 
         [(&/$ExT e!id) (&/$ExT a!id)]
         (if (= e!id a!id)
@@ -842,10 +852,10 @@
           (check-error "" expected actual))
 
         [(&/$NamedT _ ?etype) _]
-        (check* class-loader fixpoints invariant?? ?etype actual)
+        (check* fixpoints invariant?? ?etype actual)
 
         [_ (&/$NamedT _ ?atype)]
-        (check* class-loader fixpoints invariant?? expected ?atype)
+        (check* fixpoints invariant?? expected ?atype)
 
         [_ _]
         (&/fail ""))
@@ -853,8 +863,7 @@
         (check-error err expected actual)))))
 
 (defn check [expected actual]
-  (|do [class-loader &/loader
-        _ (check* class-loader init-fixpoints false expected actual)]
+  (|do [_ (check* init-fixpoints false expected actual)]
     (return nil)))
 
 (defn actual-type [type]