- Changing tags so they're actually indices (part 1).

- Fixed a bug regarding type coercion (type-checking was ocurring unnecessarily).
- Fixed another bug regarding Local/Global variables.

9 files changed, 462 insertions, 236 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 0e58f530b..7810c415b 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -17,7 +17,8 @@
                  [host :as &host])
             (lux.analyser [base :as &&]
                           [lux :as &&lux]
-                          [host :as &&host])))
+                          [host :as &&host]
+                          [module :as &&module])))
 
 ;; [Utils]
 (defn ^:private parse-handler [[catch+ finally+] token]
@@ -37,6 +38,14 @@
     _
     (fail (str "[Analyser Error] Wrong syntax for exception handler: " (&/show-ast token)))))
 
+(defn ^:private parse-tag [ast]
+  (|case ast
+    (&/$Meta _ (&/$TagS "" name))
+    (return name)
+    
+    _
+    (fail (str "[Analyser Error] Not a tag: " (&/show-ast ast)))))
+
 (defn ^:private aba7 [analyse eval! compile-module compile-token exo-type token]
   (|case token
     ;; Arrays
@@ -431,6 +440,12 @@
                                 (&/$Nil))))
     (&&lux/analyse-declare-macro analyse compile-token ?name)
 
+    (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_declare-tags"))
+                       (&/$Cons (&/$Meta _ (&/$TupleS tags))
+                                (&/$Nil))))
+    (|do [tags* (&/map% parse-tag tags)]
+      (&&lux/analyse-declare-tags tags*))
+    
     (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_import"))
                        (&/$Cons (&/$Meta _ (&/$TextS ?path))
                                 (&/$Nil))))
@@ -492,7 +507,9 @@
     (&&lux/analyse-record analyse exo-type ?elems)
 
     (&/$TagS ?ident)
-    (&&lux/analyse-variant analyse exo-type ?ident (&/|list))
+    (|do [[module tag-name] (&/normalize ?ident)
+          idx (&&module/tag-index module tag-name)]
+      (&&lux/analyse-variant analyse exo-type idx (&/|list)))
     
     (&/$SymbolS _ "_jvm_null")
     (&&host/analyse-jvm-null analyse exo-type)
@@ -512,7 +529,10 @@
   (|case token
     (&/$Meta meta ?token)
     (fn [state]
-      (|case ((aba1 analyse eval! compile-module compile-token exo-type ?token) state)
+      (|case (try ((aba1 analyse eval! compile-module compile-token exo-type ?token) state)
+               (catch Error e
+                 (prn e)
+                 (assert false (prn-str 'analyse-basic-ast (&/show-ast ?token)))))
         (&/$Right state* output)
         (return* state* output)
 
@@ -540,11 +560,21 @@
         ))))
 
 (defn ^:private analyse-ast [eval! compile-module compile-token exo-type token]
+  ;; (prn 'analyse-ast (&/show-ast token))
   (&/with-cursor (aget token 1 0)
     (&/with-expected-type exo-type
       (|case token
+        (&/$Meta meta (&/$FormS (&/$Cons (&/$Meta _ (&/$IntS idx)) ?values)))
+        (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) exo-type idx ?values)
+
         (&/$Meta meta (&/$FormS (&/$Cons (&/$Meta _ (&/$TagS ?ident)) ?values)))
-        (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) exo-type ?ident ?values)
+        (|do [;; :let [_ (println 'analyse-ast/_0 (&/ident->text ?ident))]
+              [module tag-name] (&/normalize ?ident)
+              ;; :let [_ (println 'analyse-ast/_1 (&/ident->text (&/T module tag-name)))]
+              idx (&&module/tag-index module tag-name)
+              ;; :let [_ (println 'analyse-ast/_2 idx)]
+              ]
+          (&&lux/analyse-variant (partial analyse-ast eval! compile-module compile-token) exo-type idx ?values))
         
         (&/$Meta meta (&/$FormS (&/$Cons ?fn ?args)))
         (fn [state]
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 3484e869d..218fc6dd9 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -28,6 +28,7 @@
   "ann"
   "def"
   "declare-macro"
+  "var"
   "captured"
 
   "jvm-getstatic"
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index 2f35218d8..614b38799 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -24,7 +24,7 @@
     (let [old-mappings (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS))
           =return (body (&/update$ &/$ENVS
                                    (fn [stack]
-                                     (let [bound-unit (&/V &/$Local (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))]
+                                     (let [bound-unit (&/V &&/$var (&/V &/$Local (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER))))]
                                        (&/|cons (&/update$ &/$LOCALS #(->> %
                                                                            (&/update$ &/$COUNTER inc)
                                                                            (&/update$ &/$MAPPINGS (fn [m] (&/|put name (&/T bound-unit type) m))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 45177ce46..ba4a173f0 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -71,7 +71,7 @@
       _
       (fail "[Analyser Error] Can't expand to other than 1 element."))))
 
-(defn analyse-variant [analyse exo-type ident ?values]
+(defn analyse-variant [analyse exo-type idx ?values]
   (|do [exo-type* (|case exo-type
                     (&/$VarT ?id)
                     (&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)]
@@ -83,21 +83,50 @@
                     (&type/actual-type exo-type))]
     (|case exo-type*
       (&/$VariantT ?cases)
-      (|do [?tag (&&/resolved-ident ident)]
-        (if-let [vtype (&/|get ?tag ?cases)]
-          (|do [=value (analyse-variant-body analyse vtype ?values)]
-            (return (&/|list (&/T (&/V &&/$variant (&/T ?tag =value))
-                                  exo-type))))
-          (fail (str "[Analyser Error] There is no case " ?tag " for variant type " (&type/show-type exo-type*)))))
+      (|case (&/|at idx ?cases)
+        (&/$Some vtype)
+        (|do [=value (analyse-variant-body analyse vtype ?values)]
+          (return (&/|list (&/T (&/V &&/$variant (&/T idx =value))
+                                exo-type))))
+
+        (&/$None)
+        (fail (str "[Analyser Error] There is no case " idx " for variant type " (&type/show-type exo-type*))))
 
       (&/$AllT _)
       (&type/with-var
         (fn [$var]
           (|do [exo-type** (&type/apply-type exo-type* $var)]
-            (analyse-variant analyse exo-type** ident ?values))))
+            (analyse-variant analyse exo-type** idx ?values))))
       
       _
       (fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*))))))
+;; (defn analyse-variant [analyse exo-type ident ?values]
+;;   (|do [exo-type* (|case exo-type
+;;                     (&/$VarT ?id)
+;;                     (&/try-all% (&/|list (|do [exo-type* (&type/deref ?id)]
+;;                                            (&type/actual-type exo-type*))
+;;                                          (|do [_ (&type/set-var ?id &type/Type)]
+;;                                            (&type/actual-type &type/Type))))
+
+;;                     _
+;;                     (&type/actual-type exo-type))]
+;;     (|case exo-type*
+;;       (&/$VariantT ?cases)
+;;       (|do [?tag (&&/resolved-ident ident)]
+;;         (if-let [vtype (&/|get ?tag ?cases)]
+;;           (|do [=value (analyse-variant-body analyse vtype ?values)]
+;;             (return (&/|list (&/T (&/V &&/$variant (&/T ?tag =value))
+;;                                   exo-type))))
+;;           (fail (str "[Analyser Error] There is no case " ?tag " for variant type " (&type/show-type exo-type*)))))
+
+;;       (&/$AllT _)
+;;       (&type/with-var
+;;         (fn [$var]
+;;           (|do [exo-type** (&type/apply-type exo-type* $var)]
+;;             (analyse-variant analyse exo-type** ident ?values))))
+      
+;;       _
+;;       (fail (str "[Analyser Error] Can't create a variant if the expected type is " (&type/show-type exo-type*))))))
 
 (defn analyse-record [analyse exo-type ?elems]
   (|do [exo-type* (|case exo-type
@@ -158,7 +187,7 @@
                    (clojure.lang.Util/identical &type/Type exo-type))
             (return nil)
             (&type/check exo-type endo-type))]
-    (return (&/|list (&/T (&/V &/$Global (&/T r-module r-name))
+    (return (&/|list (&/T (&/V &&/$var (&/V &/$Global (&/T r-module r-name)))
                           endo-type)))))
 
 (defn ^:private analyse-local [analyse exo-type name]
@@ -194,7 +223,7 @@
                                       (clojure.lang.Util/identical &type/Type exo-type))
                                (return nil)
                                (&type/check exo-type endo-type))]
-                       (return (&/|list (&/T (&/V &/$Global (&/T r-module r-name))
+                       (return (&/|list (&/T (&/V &&/$var (&/V &/$Global (&/T r-module r-name)))
                                              endo-type))))
                      state)
 
@@ -397,14 +426,39 @@
 
           _
           (do (println 'DEF (str module-name ";" ?name))
-            (|do [_ (compile-token (&/V &&/$def (&/T ?name =value)))]
+            (|do [_ (compile-token (&/V &&/$def (&/T ?name =value)))
+                  :let [_ (println 'DEF/COMPILED (str module-name ";" ?name))]]
               (return (&/|list)))))
         ))))
 
 (defn analyse-declare-macro [analyse compile-token ?name]
-  (|do [module-name &/get-module-name]
-    (|do [_ (compile-token (&/V &&/$declare-macro (&/T module-name ?name)))]
-      (return (&/|list)))))
+  (|do [module-name &/get-module-name
+        _ (compile-token (&/V &&/$declare-macro (&/T module-name ?name)))]
+    (return (&/|list))))
+
+(defn ensure-undeclared-tags [module tags]
+  (|do [;; :let [_ (prn 'ensure-undeclared-tags/_0)]
+        tags-table (&&module/tags-by-module module)
+        ;; :let [_ (prn 'ensure-undeclared-tags/_1)]
+        _ (&/map% (fn [tag]
+                    (if (&/|get tag tags-table)
+                      (fail (str "[Analyser Error] Can't re-declare tag: " (&/ident->text (&/T module tag))))
+                      (return nil)))
+                  tags)
+        ;; :let [_ (prn 'ensure-undeclared-tags/_2)]
+        ]
+    (return nil)))
+
+(defn analyse-declare-tags [tags]
+  (|do [;; :let [_ (prn 'analyse-declare-tags/_0)]
+        module-name &/get-module-name
+        ;; :let [_ (prn 'analyse-declare-tags/_1)]
+        _ (ensure-undeclared-tags module-name tags)
+        ;; :let [_ (prn 'analyse-declare-tags/_2)]
+        _ (&&module/declare-tags module-name tags)
+        ;; :let [_ (prn 'analyse-declare-tags/_3)]
+        ]
+    (return (&/|list))))
 
 (defn analyse-import [analyse compile-module compile-token ?path]
   (|do [module-name &/get-module-name
@@ -440,6 +494,6 @@
   (|do [=type (&&/analyse-1 analyse &type/Type ?type)
         ==type (eval! =type)
         _ (&type/check exo-type ==type)
-        =value (&&/analyse-1 analyse ==type ?value)]
+        =value (analyse-1+ analyse ?value)]
     (return (&/|list (&/T (&/V &&/$ann (&/T =value =type))
                           ==type)))))
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 35ae7e5b7..68554a019 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -18,14 +18,17 @@
 
 ;; [Utils]
 (def ^:private $DEFS 0)
-(def ^:private $ALIASES 1)
-(def ^:private $IMPORTS 2)
+(def ^:private $IMPORTS 1)
+(def ^:private $ALIASES 2)
+(def ^:private $tags 3)
 (def ^:private +init+
   (&/R ;; "lux;defs"
    (&/|table)
+   ;; "lux;imports"
+   (&/|list)
    ;; "lux;module-aliases"
    (&/|table)
-   ;; "lux;imports"
+   ;; "lux;tags"
    (&/|list)
    ))
 
@@ -235,12 +238,50 @@
       (return* state (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ $IMPORTS))))))
 
 (defn create-module [name]
+  "(-> Text (Lux (,)))"
   (fn [state]
     (return* (&/update$ &/$MODULES #(&/|put name +init+ %) state) nil)))
 
 (defn enter-module [name]
+  "(-> Text (Lux (,)))"
   (fn [state]
     (return* (->> state
                   (&/update$ &/$MODULES #(&/|put name +init+ %))
                   (&/set$ &/$ENVS (&/|list (&/env name))))
              nil)))
+
+(defn tags-by-module [module]
+  "(-> Text (Lux (List (, Text (, Int (List Text))))))"
+  (fn [state]
+    (if-let [=module (->> state (&/get$ &/$MODULES) (&/|get module))]
+      (return* state (&/get$ $tags =module))
+      (fail* (str "[Lux Error] Unknown module: " module)))
+    ))
+
+(defn declare-tags [module tag-names]
+  "(-> Text (List Text) (Lux (,)))"
+  (fn [state]
+    (if-let [=module (->> state (&/get$ &/$MODULES) (&/|get module))]
+      (let [tags (&/|map (fn [tag-name] (&/T module tag-name)) tag-names)]
+        (return* (&/update$ &/$MODULES
+                            (fn [=modules]
+                              (&/|update module
+                                         #(&/set$ $tags (&/fold (fn [table idx+tag-name]
+                                                                  (|let [[idx tag-name] idx+tag-name]
+                                                                    (&/|put tag-name (&/T idx tags) table)))
+                                                                (&/get$ $tags %)
+                                                                (&/enumerate tag-names))
+                                                  %)
+                                         =modules))
+                            state)
+                 nil))
+      (fail* (str "[Lux Error] Unknown module: " module)))))
+
+(defn tag-index [module tag-name]
+  "(-> Text Text (Lux Int))"
+  (fn [state]
+    (if-let [=module (->> state (&/get$ &/$MODULES) (&/|get module))]
+      (if-let [^objects idx+tags (&/|get tag-name (&/get$ $tags =module))]
+        (return* state (aget idx+tags 0))
+        (fail* (str "[Lux Error] Unknown tag: " (&/ident->text (&/T module tag-name)))))
+      (fail* (str "[Lux Error] Unknown module: " module)))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index f690ef65f..73b2bb684 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -13,47 +13,53 @@
 
 ;; [Tags]
 (defmacro deftags [prefix & names]
-  `(do ~@(for [name names]
-           `(def ~(symbol (str "$" name)) ~(str prefix name)))))
+  `(do ~@(for [[name idx] (map vector names (range (count names)))]
+           `(def ~(symbol (str "$" name)) ~idx))))
 
 ;; List
-(def $Nil "lux;Nil")
-(def $Cons "lux;Cons")
+(deftags ""
+  "Nil"
+  "Cons")
 
 ;; Maybe
-(def $None "lux;None")
-(def $Some "lux;Some")
+(deftags ""
+  "None"
+  "Some")
 
 ;; Meta
-(def $Meta "lux;Meta")
+(deftags ""
+  "Meta")
 
 ;; Either
-(def $Left "lux;Left")
-(def $Right "lux;Right")
+(deftags ""
+  "Left"
+  "Right")
 
 ;; AST
-(def $BoolS "lux;BoolS")
-(def $IntS "lux;IntS")
-(def $RealS "lux;RealS")
-(def $CharS "lux;CharS")
-(def $TextS "lux;TextS")
-(def $SymbolS "lux;SymbolS")
-(def $TagS "lux;TagS")
-(def $FormS "lux;FormS")
-(def $TupleS "lux;TupleS")
-(def $RecordS "lux;RecordS")
+(deftags ""
+  "BoolS"
+  "IntS"
+  "RealS"
+  "CharS"
+  "TextS"
+  "SymbolS"
+  "TagS"
+  "FormS"
+  "TupleS"
+  "RecordS")
 
 ;; Type
-(def $DataT "lux;DataT")
-(def $TupleT "lux;TupleT")
-(def $VariantT "lux;VariantT")
-(def $RecordT "lux;RecordT")
-(def $LambdaT "lux;LambdaT")
-(def $VarT "lux;VarT")
-(def $ExT "lux;ExT")
-(def $BoundT "lux;BoundT")
-(def $AppT "lux;AppT")
-(def $AllT "lux;AllT")
+(deftags ""
+  "DataT"
+  "TupleT"
+  "VariantT"
+  "RecordT"
+  "LambdaT"
+  "BoundT"
+  "VarT"
+  "ExT"
+  "AllT"
+  "AppT")
 
 ;; [Fields]
 ;; Binding
@@ -100,7 +106,7 @@
 (defn T [& elems]
   (to-array elems))
 
-(defn V [tag value]
+(defn V [^Long tag value]
   (to-array [tag value]))
 
 (defn R [& kvs]
@@ -726,6 +732,7 @@
           output)))))
 
 (defn show-ast [ast]
+  ;; (prn 'show-ast/GOOD (aget ast 0) (aget ast 1 1 0))
   (|case ast
     ($Meta _ ($BoolS ?value))
     (pr-str ?value)
@@ -762,6 +769,10 @@
 
     ($Meta _ ($FormS ?elems))
     (str "(" (->> ?elems (|map show-ast) (|interpose " ") (fold str "")) ")")
+
+    _
+    (assert false (prn-str 'show-ast (aget ast 0) (aget ast 1 1 0)))
+    ;; (assert false (prn-str 'show-ast (aget ast 0) (aget ast 1 1 0)))
     ))
 
 (defn ident->text [ident]
@@ -814,6 +825,7 @@
     false))
 
 (defn ^:private enumerate* [idx xs]
+  "(All [a] (-> Int (List a) (List (, Int a))))"
   (|case xs
     ($Cons x xs*)
     (V $Cons (T (T idx x)
@@ -824,6 +836,7 @@
     ))
 
 (defn enumerate [xs]
+  "(All [a] (-> (List a) (List (, Int a))))"
   (enumerate* 0 xs))
 
 (def modules
@@ -836,3 +849,28 @@
   (if test
     body
     (return nil)))
+
+(defn |at [idx xs]
+  "(All [a] (-> Int (List a) (Maybe a)))"
+  ;; (prn '|at idx (aget idx 0))
+  (|case xs
+    ($Cons x xs*)
+    (cond (< idx 0)
+          (V $None nil)
+
+          (= idx 0)
+          (V $Some x)
+
+          :else ;; > 1
+          (|at (dec idx) xs*))
+
+    ($Nil)
+    (V $None nil)
+    ))
+
+(defn normalize [ident]
+  "(-> Ident (Lux Ident))"
+  (|case ident
+    ["" name] (|do [module get-module-name]
+                (return (T module name)))
+    _ (return ident)))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 490491bd0..7622e3002 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -61,13 +61,13 @@
       (&a/$record ?elems)
       (&&lux/compile-record compile-expression ?type ?elems)
 
-      (&/$Local ?idx)
+      (&a/$var (&/$Local ?idx))
       (&&lux/compile-local compile-expression ?type ?idx)
 
       (&a/$captured ?scope ?captured-id ?source)
       (&&lux/compile-captured compile-expression ?type ?scope ?captured-id ?source)
 
-      (&/$Global ?owner-class ?name)
+      (&a/$var (&/$Global ?owner-class ?name))
       (&&lux/compile-global compile-expression ?type ?owner-class ?name)
 
       (&a/$apply ?fn ?args)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 87327311c..9baefa21c 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -37,11 +37,13 @@
 (do-template [<name> <class> <sig> <caster>]
   (defn <name> [compile *type* value]
     (|do [^MethodVisitor *writer* &/get-writer
-          :let [_ (doto *writer*
-                    (.visitTypeInsn Opcodes/NEW <class>)
-                    (.visitInsn Opcodes/DUP)
-                    (.visitLdcInsn (<caster> value))
-                    (.visitMethodInsn Opcodes/INVOKESPECIAL <class> "<init>" <sig>))]]
+          :let [_ (try (doto *writer*
+                         (.visitTypeInsn Opcodes/NEW <class>)
+                         (.visitInsn Opcodes/DUP)
+                         (.visitLdcInsn (<caster> value))
+                         (.visitMethodInsn Opcodes/INVOKESPECIAL <class> "<init>" <sig>))
+                    (catch Exception e
+                      (assert false (prn-str '<name> (alength value) (aget value 0) (aget value 1)))))]]
       (return nil)))
 
   compile-int  "java/lang/Long"      "(J)V" long
@@ -99,6 +101,7 @@
                   (.visitInsn Opcodes/DUP)
                   (.visitLdcInsn (int 0))
                   (.visitLdcInsn ?tag)
+                  (&&/wrap-long)
                   (.visitInsn Opcodes/AASTORE)
                   (.visitInsn Opcodes/DUP)
                   (.visitLdcInsn (int 1)))]
@@ -148,6 +151,7 @@
                       (.visitInsn Opcodes/DUP) ;; VV
                       (.visitLdcInsn (int 0)) ;; VVI
                       (.visitLdcInsn &/$TypeD) ;; VVIT
+                      (&&/wrap-long)
                       (.visitInsn Opcodes/AASTORE) ;; V
                       (.visitInsn Opcodes/DUP) ;; VV
                       (.visitLdcInsn (int 1)) ;; VVI
@@ -174,6 +178,7 @@
                         (.visitInsn Opcodes/DUP) ;; VV
                         (.visitLdcInsn (int 0)) ;; VVI
                         (.visitLdcInsn &/$ValueD) ;; VVIT
+                        (&&/wrap-long)
                         (.visitInsn Opcodes/AASTORE) ;; V
                         (.visitInsn Opcodes/DUP) ;; VV
                         (.visitLdcInsn (int 1)) ;; VVI
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 0a80d4fbc..553318daf 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -23,39 +23,73 @@
 (def Unit (&/V &/$TupleT (&/|list)))
 (def $Void (&/V &/$VariantT (&/|list)))
 
+(def ^:private empty-env (&/V &/$Some (&/V &/$Nil nil)))
+(defn ^:private Bound$ [name]
+  (&/V &/$BoundT name))
+(defn ^:private Lambda$ [in out]
+  (&/V &/$LambdaT (&/T in out)))
+(defn ^:private App$ [fun arg]
+  (&/V &/$AppT (&/T fun arg)))
+(defn ^:private Tuple$ [members]
+  (&/V &/$TupleT members))
+(defn ^:private Variant$ [members]
+  (&/V &/$VariantT members))
+(defn ^:private Record$ [members]
+  (&/V &/$RecordT members))
+
 (def IO
-  (&/V &/$AllT (&/T (&/V &/$Some (&/V &/$Nil nil)) "IO" "a"
-                       (&/V &/$LambdaT (&/T Unit (&/V &/$BoundT "a"))))))
+  (&/V &/$AllT (&/T empty-env "IO" "a"
+                    (Lambda$ Unit (Bound$ "a")))))
 
 (def List
-  (&/V &/$AllT (&/T (&/V &/$Some (&/V &/$Nil nil)) "lux;List" "a"
-                       (&/V &/$VariantT (&/|list (&/T &/$Nil Unit)
-                                                    (&/T &/$Cons (&/V &/$TupleT (&/|list (&/V &/$BoundT "a")
-                                                                                               (&/V &/$AppT (&/T (&/V &/$BoundT "lux;List")
-                                                                                                                    (&/V &/$BoundT "a")))))))))))
+  (&/V &/$AllT (&/T empty-env "lux;List" "a"
+                    (Variant$ (&/|list
+                               ;; lux;Nil
+                               Unit
+                               ;; lux;Cons
+                               (Tuple$ (&/|list (Bound$ "a")
+                                                (App$ (Bound$ "lux;List")
+                                                      (Bound$ "a"))))
+                               )))))
 
 (def Maybe
-  (&/V &/$AllT (&/T (&/V &/$Some (&/V &/$Nil nil)) "lux;Maybe" "a"
-                       (&/V &/$VariantT (&/|list (&/T &/$None Unit)
-                                                    (&/T &/$Some (&/V &/$BoundT "a")))))))
+  (&/V &/$AllT (&/T empty-env "lux;Maybe" "a"
+                    (Variant$ (&/|list
+                               ;; lux;None
+                               Unit
+                               ;; lux;Some
+                               (Bound$ "a")
+                               )))))
 
 (def Type
-  (let [Type (&/V &/$AppT (&/T (&/V &/$BoundT "Type") (&/V &/$BoundT "_")))
-        TypeEnv (&/V &/$AppT (&/T List (&/V &/$TupleT (&/|list Text Type))))
-        TypePair (&/V &/$TupleT (&/|list Type Type))]
-    (&/V &/$AppT (&/T (&/V &/$AllT (&/T (&/V &/$Some (&/V &/$Nil nil)) "Type" "_"
-                                              (&/V &/$VariantT (&/|list (&/T &/$DataT Text)
-                                                                           (&/T &/$TupleT (&/V &/$AppT (&/T List Type)))
-                                                                           (&/T &/$VariantT TypeEnv)
-                                                                           (&/T &/$RecordT TypeEnv)
-                                                                           (&/T &/$LambdaT TypePair)
-                                                                           (&/T &/$BoundT Text)
-                                                                           (&/T &/$VarT Int)
-                                                                           (&/T &/$AllT (&/V &/$TupleT (&/|list (&/V &/$AppT (&/T Maybe TypeEnv)) Text Text Type)))
-                                                                           (&/T &/$AppT TypePair)
-                                                                           (&/T &/$ExT Int)
-                                                                           ))))
-                         $Void))))
+  (let [Type (App$ (Bound$ "Type") (Bound$ "_"))
+        TypeList (App$ List Type)
+        TypeEnv (App$ List (Tuple$ (&/|list Text Type)))
+        TypePair (Tuple$ (&/|list Type Type))]
+    (App$ (&/V &/$AllT (&/T empty-env "Type" "_"
+                            (Variant$ (&/|list
+                                       ;; DataT
+                                       Text
+                                       ;; TupleT
+                                       (App$ List Type)
+                                       ;; VariantT
+                                       TypeList
+                                       ;; RecordT
+                                       TypeList
+                                       ;; LambdaT
+                                       TypePair
+                                       ;; BoundT
+                                       Text
+                                       ;; VarT
+                                       Int
+                                       ;; ExT
+                                       Int
+                                       ;; AllT
+                                       (Tuple$ (&/|list (App$ Maybe TypeEnv) Text Text Type))
+                                       ;; AppT
+                                       TypePair
+                                       ))))
+          $Void)))
 
 (defn fAll [name arg body]
   (&/V &/$AllT (&/T (&/V &/$None nil) name arg body)))
@@ -63,130 +97,187 @@
 (def Bindings
   (fAll "lux;Bindings" "k"
         (fAll "" "v"
-              (&/V &/$RecordT (&/|list (&/T "lux;counter" Int)
-                                          (&/T "lux;mappings" (&/V &/$AppT (&/T List
-                                                                                   (&/V &/$TupleT (&/|list (&/V &/$BoundT "k")
-                                                                                                              (&/V &/$BoundT "v")))))))))))
+              (Record$ (&/|list
+                        ;; "lux;counter"
+                        Int
+                        ;; "lux;mappings"
+                        (App$ List
+                              (Tuple$ (&/|list (Bound$ "k")
+                                               (Bound$ "v")))))))))
 
 (def Env
-  (let [bindings (&/V &/$AppT (&/T (&/V &/$AppT (&/T Bindings (&/V &/$BoundT "k")))
-                                      (&/V &/$BoundT "v")))]
+  (let [bindings (App$ (App$ Bindings (Bound$ "k"))
+                       (Bound$ "v"))]
     (fAll "lux;Env" "k"
           (fAll "" "v"
-                (&/V &/$RecordT
-                     (&/|list (&/T "lux;name" Text)
-                              (&/T "lux;inner-closures" Int)
-                              (&/T "lux;locals" bindings)
-                              (&/T "lux;closure" bindings)
-                              ))))))
+                (Record$
+                 (&/|list
+                  ;; "lux;name"
+                  Text
+                  ;; "lux;inner-closures"
+                  Int
+                  ;; "lux;locals"
+                  bindings
+                  ;; "lux;closure"
+                  bindings
+                  ))))))
 
 (def Cursor
-  (&/V &/$TupleT (&/|list Text Int Int)))
+  (Tuple$ (&/|list Text Int Int)))
 
 (def Meta
   (fAll &/$Meta "m"
         (fAll "" "v"
-              (&/V &/$VariantT (&/|list (&/T &/$Meta (&/V &/$TupleT (&/|list (&/V &/$BoundT "m")
-                                                                                      (&/V &/$BoundT "v")))))))))
+              (Variant$ (&/|list
+                         ;; &/$Meta
+                         (Tuple$ (&/|list (Bound$ "m")
+                                          (Bound$ "v"))))))))
 
-(def Ident (&/V &/$TupleT (&/|list Text Text)))
+(def Ident (Tuple$ (&/|list Text Text)))
 
 (def AST*
-  (let [AST* (&/V &/$AppT (&/T (&/V &/$BoundT "w")
-                                     (&/V &/$AppT (&/T (&/V &/$BoundT "lux;AST'")
-                                                          (&/V &/$BoundT "w")))))
-        AST*List (&/V &/$AppT (&/T List AST*))]
+  (let [AST* (App$ (Bound$ "w")
+                   (App$ (Bound$ "lux;AST'")
+                         (Bound$ "w")))
+        AST*List (App$ List AST*)]
     (fAll "lux;AST'" "w"
-          (&/V &/$VariantT (&/|list (&/T &/$BoolS Bool)
-                                       (&/T &/$IntS Int)
-                                       (&/T &/$RealS Real)
-                                       (&/T &/$CharS Char)
-                                       (&/T &/$TextS Text)
-                                       (&/T &/$SymbolS Ident)
-                                       (&/T &/$TagS Ident)
-                                       (&/T &/$FormS AST*List)
-                                       (&/T &/$TupleS AST*List)
-                                       (&/T &/$RecordS (&/V &/$AppT (&/T List (&/V &/$TupleT (&/|list AST* AST*))))))
-               ))))
+          (Variant$ (&/|list
+                     ;; &/$BoolS
+                     Bool
+                     ;; &/$IntS
+                     Int
+                     ;; &/$RealS
+                     Real
+                     ;; &/$CharS
+                     Char
+                     ;; &/$TextS
+                     Text
+                     ;; &/$SymbolS
+                     Ident
+                     ;; &/$TagS
+                     Ident
+                     ;; &/$FormS
+                     AST*List
+                     ;; &/$TupleS
+                     AST*List
+                     ;; &/$RecordS
+                     (App$ List (Tuple$ (&/|list AST* AST*))))
+                    ))))
 
 (def AST
-  (let [w (&/V &/$AppT (&/T Meta Cursor))]
-    (&/V &/$AppT (&/T w (&/V &/$AppT (&/T AST* w))))))
+  (let [w (App$ Meta Cursor)]
+    (App$ w (App$ AST* w))))
 
-(def ^:private ASTList (&/V &/$AppT (&/T List AST)))
+(def ^:private ASTList (App$ List AST))
 
 (def Either
   (fAll "lux;Either" "l"
         (fAll "" "r"
-              (&/V &/$VariantT (&/|list (&/T &/$Left (&/V &/$BoundT "l"))
-                                           (&/T &/$Right (&/V &/$BoundT "r")))))))
+              (Variant$ (&/|list (&/T &/$Left (Bound$ "l"))
+                                 (&/T &/$Right (Bound$ "r")))))))
 
 (def StateE
   (fAll "lux;StateE" "s"
         (fAll "" "a"
-              (&/V &/$LambdaT (&/T (&/V &/$BoundT "s")
-                                      (&/V &/$AppT (&/T (&/V &/$AppT (&/T Either Text))
-                                                           (&/V &/$TupleT (&/|list (&/V &/$BoundT "s")
-                                                                                      (&/V &/$BoundT "a"))))))))))
+              (Lambda$ (Bound$ "s")
+                       (App$ (App$ Either Text)
+                             (Tuple$ (&/|list (Bound$ "s")
+                                              (Bound$ "a"))))))))
 
 (def Reader
-  (&/V &/$AppT (&/T List
-                       (&/V &/$AppT (&/T (&/V &/$AppT (&/T Meta Cursor))
-                                            Text)))))
+  (App$ List
+        (App$ (App$ Meta Cursor)
+              Text)))
 
 (def HostState
-  (&/V &/$RecordT
-       (&/|list (&/T "lux;writer" (&/V &/$DataT "org.objectweb.asm.ClassWriter"))
-                (&/T "lux;loader" (&/V &/$DataT "java.lang.ClassLoader"))
-                (&/T "lux;classes" (&/V &/$DataT "clojure.lang.Atom")))))
+  (Record$
+   (&/|list
+    ;; "lux;writer"
+    (&/V &/$DataT "org.objectweb.asm.ClassWriter")
+    ;; "lux;loader"
+    (&/V &/$DataT "java.lang.ClassLoader")
+    ;; "lux;classes"
+    (&/V &/$DataT "clojure.lang.Atom"))))
 
 (def DefData*
   (fAll "lux;DefData'" ""
-        (&/V &/$VariantT (&/|list (&/T "lux;TypeD" Type)
-                                     (&/T "lux;ValueD" (&/V &/$TupleT (&/|list Type Unit)))
-                                     (&/T "lux;MacroD" (&/V &/$BoundT ""))
-                                     (&/T "lux;AliasD" Ident)))))
+        (Variant$ (&/|list
+                   ;; "lux;TypeD"
+                   Type
+                   ;; "lux;ValueD"
+                   (Tuple$ (&/|list Type Unit))
+                   ;; "lux;MacroD"
+                   (Bound$ "")
+                   ;; "lux;AliasD"
+                   Ident
+                   ))))
 
 (def LuxVar
-  (&/V &/$VariantT (&/|list (&/T "lux;Local" Int)
-                               (&/T "lux;Global" Ident))))
+  (Variant$ (&/|list
+             ;; "lux;Local"
+             Int
+             ;; "lux;Global"
+             Ident)))
 
 (def $Module
   (fAll "lux;$Module" "Compiler"
-        (&/V &/$RecordT
-             (&/|list (&/T "lux;module-aliases" (&/V &/$AppT (&/T List (&/V &/$TupleT (&/|list Text Text)))))
-                      (&/T "lux;defs" (&/V &/$AppT (&/T List (&/V &/$TupleT
-                                                                     (&/|list Text
-                                                                              (&/V &/$TupleT (&/|list Bool
-                                                                                                         (&/V &/$AppT (&/T DefData*
-                                                                                                                              (&/V &/$LambdaT (&/T ASTList
-                                                                                                                                                      (&/V &/$AppT (&/T (&/V &/$AppT (&/T StateE (&/V &/$BoundT "Compiler")))
-                                                                                                                                                                           ASTList)))))))))))))
-                      (&/T "lux;imports" (&/V &/$AppT (&/T List Text)))))))
+        (Record$
+         (&/|list
+          ;; "lux;module-aliases"
+          (App$ List (Tuple$ (&/|list Text Text)))
+          ;; "lux;defs"
+          (App$ List
+                (Tuple$
+                 (&/|list Text
+                          (Tuple$ (&/|list Bool
+                                           (App$ DefData*
+                                                 (Lambda$ ASTList
+                                                          (App$ (App$ StateE (Bound$ "Compiler"))
+                                                                ASTList))))))))
+          ;; "lux;imports"
+          (App$ List Text)
+          ;; "lux;tags"
+          ;; (List (, Text (List Ident)))
+          (App$ List
+                (Tuple$ (&/|list Text
+                                 (Tuple$ (&/|list Int
+                                                  (App$ List
+                                                        Ident))))))
+          ))))
 
 (def $Compiler
-  (&/V &/$AppT (&/T (fAll "lux;Compiler" ""
-                             (&/V &/$RecordT
-                                  (&/|list (&/T "lux;source" Reader)
-                                           (&/T "lux;modules" (&/V &/$AppT (&/T List (&/V &/$TupleT
-                                                                                             (&/|list Text
-                                                                                                      (&/V &/$AppT (&/T $Module (&/V &/$AppT (&/T (&/V &/$BoundT "lux;Compiler") (&/V &/$BoundT ""))))))))))
-                                           (&/T "lux;envs" (&/V &/$AppT (&/T List
-                                                                                (&/V &/$AppT (&/T (&/V &/$AppT (&/T Env Text))
-                                                                                                     (&/V &/$TupleT (&/|list LuxVar Type)))))))
-                                           (&/T "lux;types" (&/V &/$AppT (&/T (&/V &/$AppT (&/T Bindings Int)) Type)))
-                                           (&/T "lux;host" HostState)
-                                           (&/T "lux;seed" Int)
-                                           (&/T "lux;eval?" Bool)
-                                           (&/T "lux;expected" Type)
-                                           (&/T "lux;cursor" Cursor)
-                                           )))
-                       $Void)))
+  (App$ (fAll "lux;Compiler" ""
+              (Record$
+               (&/|list
+                ;; "lux;source"
+                Reader
+                ;; "lux;modules"
+                (App$ List (Tuple$
+                            (&/|list Text
+                                     (App$ $Module (App$ (Bound$ "lux;Compiler") (Bound$ ""))))))
+                ;; "lux;envs"
+                (App$ List
+                      (App$ (App$ Env Text)
+                            (Tuple$ (&/|list LuxVar Type))))
+                ;; "lux;types"
+                (App$ (App$ Bindings Int) Type)
+                ;; "lux;host"
+                HostState
+                ;; "lux;seed"
+                Int
+                ;; "lux;eval?"
+                Bool
+                ;; "lux;expected"
+                Type
+                ;; "lux;cursor"
+                Cursor
+                )))
+        $Void))
 
 (def Macro
-  (&/V &/$LambdaT (&/T ASTList
-                          (&/V &/$AppT (&/T (&/V &/$AppT (&/T StateE $Compiler))
-                                               ASTList)))))
+  (Lambda$ ASTList
+           (App$ (App$ StateE $Compiler)
+                 ASTList)))
 
 (defn bound? [id]
   (fn [state]
@@ -297,30 +388,24 @@
     (&/$LambdaT ?arg ?return)
     (|do [=arg (clean* ?tid ?arg)
           =return (clean* ?tid ?return)]
-      (return (&/V &/$LambdaT (&/T =arg =return))))
+      (return (Lambda$ =arg =return)))
 
     (&/$AppT ?lambda ?param)
     (|do [=lambda (clean* ?tid ?lambda)
           =param (clean* ?tid ?param)]
-      (return (&/V &/$AppT (&/T =lambda =param))))
+      (return (App$ =lambda =param)))
 
     (&/$TupleT ?members)
     (|do [=members (&/map% (partial clean* ?tid) ?members)]
-      (return (&/V &/$TupleT =members)))
+      (return (Tuple$ =members)))
     
     (&/$VariantT ?members)
-    (|do [=members (&/map% (fn [[k v]]
-                             (|do [=v (clean* ?tid v)]
-                               (return (&/T k =v))))
-                           ?members)]
-      (return (&/V &/$VariantT =members)))
+    (|do [=members (&/map% (partial clean* ?tid) ?members)]
+      (return (Variant$ =members)))
 
     (&/$RecordT ?members)
-    (|do [=members (&/map% (fn [[k v]]
-                             (|do [=v (clean* ?tid v)]
-                               (return (&/T k =v))))
-                           ?members)]
-      (return (&/V &/$RecordT =members)))
+    (|do [=members (&/map% (partial clean* ?tid) ?members)]
+      (return (Record$ =members)))
 
     (&/$AllT ?env ?name ?arg ?body)
     (|do [=env (|case ?env
@@ -380,23 +465,14 @@
     (if (&/|empty? cases)
       "(|)"
       (str "(| " (->> cases
-                      (&/|map (fn [kv]
-                                (|case kv
-                                  [k (&/$TupleT (&/$Nil))]
-                                  (str "#" k)
-
-                                  [k v]
-                                  (str "(#" k " " (show-type v) ")"))))
+                      (&/|map show-type)
                       (&/|interpose " ")
                       (&/fold str "")) ")"))
     
 
     (&/$RecordT fields)
     (str "(& " (->> fields
-                    (&/|map (fn [kv]
-                              (|case kv
-                                [k v]
-                                (str "#" k " " (show-type v)))))
+                    (&/|map show-type)
                     (&/|interpose " ")
                     (&/fold str "")) ")")
 
@@ -429,7 +505,9 @@
                             [args body*]))]
         (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")"))
       ?name)
-    ))
+
+    _
+    (assert false (prn-str 'show-type (aget type 0)))))
 
 (defn type= [x y]
   (or (clojure.lang.Util/identical x y)
@@ -438,24 +516,17 @@
                      (.equals ^Object xname yname)
 
                      [(&/$TupleT xelems) (&/$TupleT yelems)]
-                     (&/fold2 (fn [old x y]
-                                (and old (type= x y)))
+                     (&/fold2 (fn [old x y] (and old (type= x y)))
                               true
                               xelems yelems)
 
                      [(&/$VariantT xcases) (&/$VariantT ycases)]
-                     (&/fold2 (fn [old xcase ycase]
-                                (|let [[xname xtype] xcase
-                                       [yname ytype] ycase]
-                                  (and old (.equals ^Object xname yname) (type= xtype ytype))))
+                     (&/fold2 (fn [old x y] (and old (type= x y)))
                               true
                               xcases ycases)
 
                      [(&/$RecordT xslots) (&/$RecordT yslots)]
-                     (&/fold2 (fn [old xslot yslot]
-                                (|let [[xname xtype] xslot
-                                       [yname ytype] yslot]
-                                  (and old (.equals ^Object xname yname) (type= xtype ytype))))
+                     (&/fold2 (fn [old x y] (and old (type= x y)))
                               true
                               xslots yslots)
 
@@ -522,23 +593,17 @@
 
 (defn beta-reduce [env type]
   (|case type
-    (&/$VariantT ?cases)
-    (&/V &/$VariantT (&/|map (fn [kv]
-                                  (|let [[k v] kv]
-                                    (&/T k (beta-reduce env v))))
-                                ?cases))
+    (&/$VariantT ?members)
+    (Variant$ (&/|map (partial beta-reduce env) ?members))
 
-    (&/$RecordT ?fields)
-    (&/V &/$RecordT (&/|map (fn [kv]
-                                 (|let [[k v] kv]
-                                   (&/T k (beta-reduce env v))))
-                               ?fields))
+    (&/$RecordT ?members)
+    (Record$ (&/|map (partial beta-reduce env) ?members))
 
     (&/$TupleT ?members)
-    (&/V &/$TupleT (&/|map (partial beta-reduce env) ?members))
+    (Tuple$ (&/|map (partial beta-reduce env) ?members))
 
     (&/$AppT ?type-fn ?type-arg)
-    (&/V &/$AppT (&/T (beta-reduce env ?type-fn) (beta-reduce env ?type-arg)))
+    (App$ (beta-reduce env ?type-fn) (beta-reduce env ?type-arg))
 
     (&/$AllT ?local-env ?local-name ?local-arg ?local-def)
     (|case ?local-env
@@ -549,7 +614,7 @@
       type)
 
     (&/$LambdaT ?input ?output)
-    (&/V &/$LambdaT (&/T (beta-reduce env ?input) (beta-reduce env ?output)))
+    (Lambda$ (beta-reduce env ?input) (beta-reduce env ?output))
 
     (&/$BoundT ?name)
     (if-let [bound (&/|get ?name env)]
@@ -660,13 +725,13 @@
         (|case ((|do [F1 (deref ?eid)]
                   (fn [state]
                     (|case [((|do [F2 (deref ?aid)]
-                               (check* class-loader fixpoints (&/V &/$AppT (&/T F1 A1)) (&/V &/$AppT (&/T F2 A2))))
+                               (check* class-loader fixpoints (App$ F1 A1) (App$ F2 A2)))
                              state)]
                       (&/$Right state* output)
                       (return* state* output)
 
                       (&/$Left _)
-                      ((check* class-loader fixpoints (&/V &/$AppT (&/T F1 A1)) actual)
+                      ((check* class-loader fixpoints (App$ F1 A1) actual)
                        state))))
                 state)
           (&/$Right state* output)
@@ -674,7 +739,7 @@
 
           (&/$Left _)
           (|case ((|do [F2 (deref ?aid)]
-                    (check* class-loader fixpoints expected (&/V &/$AppT (&/T F2 A2))))
+                    (check* class-loader fixpoints expected (App$ F2 A2)))
                   state)
             (&/$Right state* output)
             (return* state* output)
@@ -691,7 +756,7 @@
       [(&/$AppT (&/$VarT ?id) A1) (&/$AppT F2 A2)]
       (fn [state]
         (|case ((|do [F1 (deref ?id)]
-                  (check* class-loader fixpoints (&/V &/$AppT (&/T F1 A1)) actual))
+                  (check* class-loader fixpoints (App$ F1 A1) actual))
                 state)
           (&/$Right state* output)
           (return* state* output)
@@ -713,7 +778,7 @@
       [(&/$AppT F1 A1) (&/$AppT (&/$VarT ?id) A2)]
       (fn [state]
         (|case ((|do [F2 (deref ?id)]
-                  (check* class-loader fixpoints expected (&/V &/$AppT (&/T F2 A2))))
+                  (check* class-loader fixpoints expected (App$ F2 A2)))
                 state)
           (&/$Right state* output)
           (return* state* output)
@@ -795,25 +860,17 @@
         (return (&/T fixpoints* nil)))
       
       [(&/$VariantT e!cases) (&/$VariantT a!cases)]
-      (|do [fixpoints* (&/fold2% (fn [fp e!case a!case]
-                                   (|let [[e!name e!type] e!case
-                                          [a!name a!type] a!case]
-                                     (if (.equals ^Object e!name a!name)
-                                       (|do [[fp* _] (check* class-loader fp e!type a!type)]
-                                         (return fp*))
-                                       (fail (check-error expected actual)))))
+      (|do [fixpoints* (&/fold2% (fn [fp e a]
+                                   (|do [[fp* _] (check* class-loader fp e a)]
+                                     (return fp*)))
                                  fixpoints
                                  e!cases a!cases)]
         (return (&/T fixpoints* nil)))
 
       [(&/$RecordT e!slots) (&/$RecordT a!slots)]
-      (|do [fixpoints* (&/fold2% (fn [fp e!slot a!slot]
-                                   (|let [[e!name e!type] e!slot
-                                          [a!name a!type] a!slot]
-                                     (if (.equals ^Object e!name a!name)
-                                       (|do [[fp* _] (check* class-loader fp e!type a!type)]
-                                         (return fp*))
-                                       (fail (check-error expected actual)))))
+      (|do [fixpoints* (&/fold2% (fn [fp e a]
+                                   (|do [[fp* _] (check* class-loader fp e a)]
+                                     (return fp*)))
                                  fixpoints
                                  e!slots a!slots)]
         (return (&/T fixpoints* nil)))