From df3e4ba2df6462812174e69ea5c334a7edbbd5c7 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 16 Aug 2015 15:37:46 -0400
Subject: Introduced named types (#NamedT Ident Type).

---
 source/lux.lux            | 429 +++++++++++++++++++++++++---------------------
 src/lux/analyser.clj      |   2 +-
 src/lux/analyser/case.clj |   7 +-
 src/lux/analyser/lux.clj  |  14 +-
 src/lux/base.clj          |  25 +--
 src/lux/type.clj          | 389 ++++++++++++++++++++++-------------------
 6 files changed, 474 insertions(+), 392 deletions(-)

diff --git a/source/lux.lux b/source/lux.lux
index 4c4b02f8a..b6d71e893 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -10,59 +10,69 @@
 (_jvm_interface "Function" []
   ("apply" ["java.lang.Object"] "java.lang.Object" ["public" "abstract"]))
 
-(_lux_declare-tags [#DataT #VariantT #TupleT #LambdaT #BoundT #VarT #ExT #AllT #AppT])
+(_lux_declare-tags [#DataT #VariantT #TupleT #LambdaT #BoundT #VarT #ExT #AllT #AppT #NamedT])
 (_lux_declare-tags [#None #Some])
 (_lux_declare-tags [#Nil #Cons])
 
 ## Basic types
-(_lux_def Bool (#DataT "java.lang.Boolean"))
+(_lux_def Bool (#NamedT ["lux" "Bool"]
+                        (#DataT "java.lang.Boolean")))
 (_lux_export Bool)
 
-(_lux_def Int (#DataT "java.lang.Long"))
+(_lux_def Int (#NamedT ["lux" "Int"]
+                       (#DataT "java.lang.Long")))
 (_lux_export Int)
 
-(_lux_def Real (#DataT "java.lang.Double"))
+(_lux_def Real (#NamedT ["lux" "Real"]
+                        (#DataT "java.lang.Double")))
 (_lux_export Real)
 
-(_lux_def Char (#DataT "java.lang.Character"))
+(_lux_def Char (#NamedT ["lux" "Char"]
+                        (#DataT "java.lang.Character")))
 (_lux_export Char)
 
-(_lux_def Text (#DataT "java.lang.String"))
+(_lux_def Text (#NamedT ["lux" "Text"]
+                        (#DataT "java.lang.String")))
 (_lux_export Text)
 
-(_lux_def Unit (#TupleT #Nil))
+(_lux_def Unit (#NamedT ["lux" "Unit"]
+                        (#TupleT #Nil)))
 (_lux_export Unit)
 
-(_lux_def Void (#VariantT #Nil))
+(_lux_def Void (#NamedT ["lux" "Void"]
+                        (#VariantT #Nil)))
 (_lux_export Void)
 
-(_lux_def Ident (#TupleT (#Cons Text (#Cons Text #Nil))))
+(_lux_def Ident (#NamedT ["lux" "Ident"]
+                         (#TupleT (#Cons Text (#Cons Text #Nil)))))
 (_lux_export Ident)
 
 ## (deftype (List a)
 ##   (| #Nil
 ##      (#Cons a (List a))))
 (_lux_def List
-  (#AllT (#Some #Nil) "lux;List" "a"
-         (#VariantT (#Cons ## "lux;Nil"
-                     (#TupleT #Nil)
-                     (#Cons ## "lux;Cons"
-                      (#TupleT (#Cons (#BoundT "a")
-                                      (#Cons (#AppT (#BoundT "lux;List") (#BoundT "a"))
-                                             #Nil)))
-                      #Nil)))))
+  (#NamedT ["lux" "List"]
+           (#AllT (#Some #Nil) "lux;List" "a"
+                  (#VariantT (#Cons ## "lux;Nil"
+                              (#TupleT #Nil)
+                              (#Cons ## "lux;Cons"
+                               (#TupleT (#Cons (#BoundT "a")
+                                               (#Cons (#AppT (#BoundT "lux;List") (#BoundT "a"))
+                                                      #Nil)))
+                               #Nil))))))
 (_lux_export List)
 
 ## (deftype (Maybe a)
 ##   (| #None
 ##      (#Some a)))
 (_lux_def Maybe
-  (#AllT (#Some #Nil) "lux;Maybe" "a"
-         (#VariantT (#Cons ## "lux;None"
-                     (#TupleT #Nil)
-                     (#Cons ## "lux;Some"
-                      (#BoundT "a")
-                      #Nil)))))
+  (#NamedT ["lux" "Maybe"]
+           (#AllT (#Some #Nil) "lux;Maybe" "a"
+                  (#VariantT (#Cons ## "lux;None"
+                              (#TupleT #Nil)
+                              (#Cons ## "lux;Some"
+                               (#BoundT "a")
+                               #Nil))))))
 (_lux_export Maybe)
 
 ## (deftype #rec Type
@@ -73,51 +83,57 @@
 ##      (#BoundT Text)
 ##      (#VarT Int)
 ##      (#AllT (Maybe (List (, Text Type))) Text Text Type)
-##      (#AppT Type Type)))
+##      (#AppT Type Type)
+##      (#NamedT Ident Type)
+## ))
 (_lux_def Type
-  (_lux_case (#AppT (#BoundT "Type") (#BoundT "_"))
-    Type
-    (_lux_case (#AppT List (#TupleT (#Cons Text (#Cons Type #Nil))))
-      TypeEnv
-      (_lux_case (#AppT List Type)
-        TypeList
-        (#AppT (#AllT (#Some #Nil) "Type" "_"
-                      (#VariantT (#Cons ## "lux;DataT"
-                                  Text
-                                  (#Cons ## "lux;VariantT"
-                                   TypeList
-                                   (#Cons ## "lux;TupleT"
-                                    TypeList
-                                    (#Cons ## "lux;LambdaT"
-                                     (#TupleT (#Cons Type (#Cons Type #Nil)))
-                                     (#Cons ## "lux;BoundT"
-                                      Text
-                                      (#Cons ## "lux;VarT"
-                                       Int
-                                       (#Cons ## "lux;ExT"
-                                        Int
-                                        (#Cons ## "lux;AllT"
-                                         (#TupleT (#Cons (#AppT Maybe TypeEnv) (#Cons Text (#Cons Text (#Cons Type #Nil)))))
-                                         (#Cons ## "lux;AppT"
-                                          (#TupleT (#Cons Type (#Cons Type #Nil)))
-                                          #Nil)))))))))))
-               Void)))))
+  (#NamedT ["lux" "Type"]
+           (_lux_case (#AppT (#BoundT "Type") (#BoundT "_"))
+             Type
+             (_lux_case (#AppT List (#TupleT (#Cons Text (#Cons Type #Nil))))
+               TypeEnv
+               (_lux_case (#AppT List Type)
+                 TypeList
+                 (#AppT (#AllT (#Some #Nil) "Type" "_"
+                               (#VariantT (#Cons ## "lux;DataT"
+                                           Text
+                                           (#Cons ## "lux;VariantT"
+                                            TypeList
+                                            (#Cons ## "lux;TupleT"
+                                             TypeList
+                                             (#Cons ## "lux;LambdaT"
+                                              (#TupleT (#Cons Type (#Cons Type #Nil)))
+                                              (#Cons ## "lux;BoundT"
+                                               Text
+                                               (#Cons ## "lux;VarT"
+                                                Int
+                                                (#Cons ## "lux;ExT"
+                                                 Int
+                                                 (#Cons ## "lux;AllT"
+                                                  (#TupleT (#Cons (#AppT Maybe TypeEnv) (#Cons Text (#Cons Text (#Cons Type #Nil)))))
+                                                  (#Cons ## "lux;AppT"
+                                                   (#TupleT (#Cons Type (#Cons Type #Nil)))
+                                                   (#Cons ## "lux;NamedT"
+                                                    (#TupleT (#Cons Ident (#Cons Type #Nil)))
+                                                    #Nil))))))))))))
+                        Void))))))
 (_lux_export Type)
 
 ## (deftype (Bindings k v)
 ##   (& #counter Int
 ##      #mappings (List (, k v))))
 (_lux_def Bindings
-  (#AllT [(#Some #Nil) "lux;Bindings" "k"
-          (#AllT [#None "" "v"
-                  (#TupleT (#Cons ## "lux;counter"
-                            Int
-                            (#Cons ## "lux;mappings"
-                             (#AppT [List
-                                     (#TupleT (#Cons [(#BoundT "k")
-                                                      (#Cons [(#BoundT "v")
-                                                              #Nil])]))])
-                             #Nil)))])]))
+  (#NamedT ["lux" "Bindings"]
+           (#AllT [(#Some #Nil) "lux;Bindings" "k"
+                   (#AllT [#None "" "v"
+                           (#TupleT (#Cons ## "lux;counter"
+                                     Int
+                                     (#Cons ## "lux;mappings"
+                                      (#AppT [List
+                                              (#TupleT (#Cons [(#BoundT "k")
+                                                               (#Cons [(#BoundT "v")
+                                                                       #Nil])]))])
+                                      #Nil)))])])))
 (_lux_export Bindings)
 (_lux_declare-tags [#counter #mappings])
 
@@ -127,38 +143,41 @@
 ##      #locals  (Bindings k v)
 ##      #closure (Bindings k v)))
 (_lux_def Env
-  (#AllT (#Some #Nil) "lux;Env" "k"
-         (#AllT #None "" "v"
-                (#TupleT (#Cons ## "lux;name"
-                          Text
-                          (#Cons ## "lux;inner-closures"
-                           Int
-                           (#Cons ## "lux;locals"
-                            (#AppT (#AppT Bindings (#BoundT "k"))
-                                   (#BoundT "v"))
-                            (#Cons ## "lux;closure"
-                             (#AppT (#AppT Bindings (#BoundT "k"))
-                                    (#BoundT "v"))
-                             #Nil))))))))
+  (#NamedT ["lux" "Env"]
+           (#AllT (#Some #Nil) "lux;Env" "k"
+                  (#AllT #None "" "v"
+                         (#TupleT (#Cons ## "lux;name"
+                                   Text
+                                   (#Cons ## "lux;inner-closures"
+                                    Int
+                                    (#Cons ## "lux;locals"
+                                     (#AppT (#AppT Bindings (#BoundT "k"))
+                                            (#BoundT "v"))
+                                     (#Cons ## "lux;closure"
+                                      (#AppT (#AppT Bindings (#BoundT "k"))
+                                             (#BoundT "v"))
+                                      #Nil)))))))))
 (_lux_export Env)
 (_lux_declare-tags [#name #inner-closures #locals #closure])
 
 ## (deftype Cursor
 ##   (, Text Int Int))
 (_lux_def Cursor
-  (#TupleT (#Cons Text (#Cons Int (#Cons Int #Nil)))))
+  (#NamedT ["lux" "Cursor"]
+           (#TupleT (#Cons Text (#Cons Int (#Cons Int #Nil))))))
 (_lux_export Cursor)
 
 ## (deftype (Meta m v)
 ##   (| (#Meta m v)))
 (_lux_def Meta
-  (#AllT (#Some #Nil) "lux;Meta" "m"
-         (#AllT #None "" "v"
-                (#VariantT (#Cons ## "lux;Meta"
-                            (#TupleT (#Cons (#BoundT "m")
-                                            (#Cons (#BoundT "v")
-                                                   #Nil)))
-                            #Nil)))))
+  (#NamedT ["lux" "Meta"]
+           (#AllT (#Some #Nil) "lux;Meta" "m"
+                  (#AllT #None "" "v"
+                         (#VariantT (#Cons ## "lux;Meta"
+                                     (#TupleT (#Cons (#BoundT "m")
+                                                     (#Cons (#BoundT "v")
+                                                            #Nil)))
+                                     #Nil))))))
 (_lux_export Meta)
 (_lux_declare-tags [#Meta])
 
@@ -174,45 +193,47 @@
 ##      (#TupleS (List (w (AST' w))))
 ##      (#RecordS (List (, (w (AST' w)) (w (AST' w)))))))
 (_lux_def AST'
-  (_lux_case (#AppT (#BoundT "w")
-                    (#AppT (#BoundT "lux;AST'")
-                           (#BoundT "w")))
-    AST
-    (_lux_case (#AppT [List AST])
-      ASTList
-      (#AllT (#Some #Nil) "lux;AST'" "w"
-             (#VariantT (#Cons ## "lux;BoolS"
-                         Bool
-                         (#Cons ## "lux;IntS"
-                          Int
-                          (#Cons ## "lux;RealS"
-                           Real
-                           (#Cons ## "lux;CharS"
-                            Char
-                            (#Cons ## "lux;TextS"
-                             Text
-                             (#Cons ## "lux;SymbolS"
-                              Ident
-                              (#Cons ## "lux;TagS"
-                               Ident
-                               (#Cons ## "lux;FormS"
-                                ASTList
-                                (#Cons ## "lux;TupleS"
-                                 ASTList
-                                 (#Cons ## "lux;RecordS"
-                                  (#AppT List (#TupleT (#Cons AST (#Cons AST #Nil))))
-                                  #Nil)
-                                 )))))))))
-                        )))))
+  (#NamedT ["lux" "AST'"]
+           (_lux_case (#AppT (#BoundT "w")
+                             (#AppT (#BoundT "lux;AST'")
+                                    (#BoundT "w")))
+             AST
+             (_lux_case (#AppT [List AST])
+               ASTList
+               (#AllT (#Some #Nil) "lux;AST'" "w"
+                      (#VariantT (#Cons ## "lux;BoolS"
+                                  Bool
+                                  (#Cons ## "lux;IntS"
+                                   Int
+                                   (#Cons ## "lux;RealS"
+                                    Real
+                                    (#Cons ## "lux;CharS"
+                                     Char
+                                     (#Cons ## "lux;TextS"
+                                      Text
+                                      (#Cons ## "lux;SymbolS"
+                                       Ident
+                                       (#Cons ## "lux;TagS"
+                                        Ident
+                                        (#Cons ## "lux;FormS"
+                                         ASTList
+                                         (#Cons ## "lux;TupleS"
+                                          ASTList
+                                          (#Cons ## "lux;RecordS"
+                                           (#AppT List (#TupleT (#Cons AST (#Cons AST #Nil))))
+                                           #Nil)
+                                          )))))))))
+                                 ))))))
 (_lux_export AST')
 (_lux_declare-tags [#BoolS #IntS #RealS #CharS #TextS #SymbolS #TagS #FormS #TupleS #RecordS])
 
 ## (deftype AST
 ##   (Meta Cursor (AST' (Meta Cursor))))
 (_lux_def AST
-  (_lux_case (#AppT Meta Cursor)
-    w
-    (#AppT w (#AppT AST' w))))
+  (#NamedT ["lux" "AST"]
+           (_lux_case (#AppT Meta Cursor)
+             w
+             (#AppT w (#AppT AST' w)))))
 (_lux_export AST)
 
 (_lux_def ASTList (#AppT List AST))
@@ -221,13 +242,14 @@
 ##   (| (#Left l)
 ##      (#Right r)))
 (_lux_def Either
-  (#AllT (#Some #Nil) "lux;Either" "l"
-         (#AllT #None "" "r"
-                (#VariantT (#Cons ## "lux;Left"
-                            (#BoundT "l")
-                            (#Cons ## "lux;Right"
-                             (#BoundT "r")
-                             #Nil))))))
+  (#NamedT ["lux" "Either"]
+           (#AllT (#Some #Nil) "lux;Either" "l"
+                  (#AllT #None "" "r"
+                         (#VariantT (#Cons ## "lux;Left"
+                                     (#BoundT "l")
+                                     (#Cons ## "lux;Right"
+                                      (#BoundT "r")
+                                      #Nil)))))))
 (_lux_export Either)
 (_lux_declare-tags [#Left #Right])
 
@@ -245,9 +267,10 @@
 ## (deftype Source
 ##   (List (Meta Cursor Text)))
 (_lux_def Source
-  (#AppT [List
-          (#AppT [(#AppT [Meta Cursor])
-                  Text])]))
+  (#NamedT ["lux" "Source"]
+           (#AppT [List
+                   (#AppT [(#AppT [Meta Cursor])
+                           Text])])))
 (_lux_export Source)
 
 ## (deftype Host
@@ -255,13 +278,14 @@
 ##      #loader    (^ java.net.URLClassLoader)
 ##      #classes   (^ clojure.lang.Atom)))
 (_lux_def Host
-  (#TupleT (#Cons [## "lux;writer"
-                   (#DataT "org.objectweb.asm.ClassWriter")
-                   (#Cons [## "lux;loader"
-                           (#DataT "java.lang.ClassLoader")
-                           (#Cons [## "lux;classes"
-                                   (#DataT "clojure.lang.Atom")
-                                   #Nil])])])))
+  (#NamedT ["lux" "Host"]
+           (#TupleT (#Cons [## "lux;writer"
+                            (#DataT "org.objectweb.asm.ClassWriter")
+                            (#Cons [## "lux;loader"
+                                    (#DataT "java.lang.ClassLoader")
+                                    (#Cons [## "lux;classes"
+                                            (#DataT "clojure.lang.Atom")
+                                            #Nil])])]))))
 (_lux_declare-tags [#writer #loader #classes])
 
 ## (deftype (DefData' m)
@@ -289,11 +313,12 @@
 ##   (| (#Local Int)
 ##      (#Global Ident)))
 (_lux_def LuxVar
-  (#VariantT (#Cons [## "lux;Local"
-                     Int
-                     (#Cons [## "lux;Global"
-                             Ident
-                             #Nil])])))
+  (#NamedT ["lux" "LuxVar"]
+           (#VariantT (#Cons [## "lux;Local"
+                              Int
+                              (#Cons [## "lux;Global"
+                                      Ident
+                                      #Nil])]))))
 (_lux_export LuxVar)
 (_lux_declare-tags [#Local #Global])
 
@@ -339,39 +364,41 @@
 ##      #host         Host
 ## ))
 (_lux_def Compiler
-  (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" ""
-                  (#TupleT (#Cons [## "lux;source"
-                                   Source
-                                   (#Cons [## "lux;cursor"
-                                           Cursor
-                                           (#Cons [## "lux;modules"
-                                                   (#AppT [List (#TupleT (#Cons [Text
-                                                                                 (#Cons [(#AppT [Module (#AppT [(#BoundT "lux;Compiler") (#BoundT "")])])
-                                                                                         #Nil])]))])
-                                                   (#Cons [## "lux;envs"
-                                                           (#AppT [List (#AppT [(#AppT [Env Text])
-                                                                                (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])
-                                                           (#Cons [## "lux;types"
-                                                                   (#AppT [(#AppT [Bindings Int]) Type])
-                                                                   (#Cons [## "lux;expected"
-                                                                           Type
-                                                                           (#Cons [## "lux;seed"
-                                                                                   Int
-                                                                                   (#Cons [## "lux;eval?"
-                                                                                           Bool
-                                                                                           (#Cons [## "lux;host"
-                                                                                                   Host
-                                                                                                   #Nil])])])])])])])])]))])
-          Void]))
+  (#NamedT ["lux" "Compiler"]
+           (#AppT [(#AllT [(#Some #Nil) "lux;Compiler" ""
+                           (#TupleT (#Cons [## "lux;source"
+                                            Source
+                                            (#Cons [## "lux;cursor"
+                                                    Cursor
+                                                    (#Cons [## "lux;modules"
+                                                            (#AppT [List (#TupleT (#Cons [Text
+                                                                                          (#Cons [(#AppT [Module (#AppT [(#BoundT "lux;Compiler") (#BoundT "")])])
+                                                                                                  #Nil])]))])
+                                                            (#Cons [## "lux;envs"
+                                                                    (#AppT [List (#AppT [(#AppT [Env Text])
+                                                                                         (#TupleT (#Cons [LuxVar (#Cons [Type #Nil])]))])])
+                                                                    (#Cons [## "lux;types"
+                                                                            (#AppT [(#AppT [Bindings Int]) Type])
+                                                                            (#Cons [## "lux;expected"
+                                                                                    Type
+                                                                                    (#Cons [## "lux;seed"
+                                                                                            Int
+                                                                                            (#Cons [## "lux;eval?"
+                                                                                                    Bool
+                                                                                                    (#Cons [## "lux;host"
+                                                                                                            Host
+                                                                                                            #Nil])])])])])])])])]))])
+                   Void])))
 (_lux_export Compiler)
 (_lux_declare-tags [#source #cursor #modules #envs #types #expected #seed #eval? #host])
 
 ## (deftype Macro
 ##   (-> (List AST) (StateE Compiler (List AST))))
 (_lux_def Macro
-  (#LambdaT ASTList
-            (#AppT (#AppT StateE Compiler)
-                   ASTList)))
+  (#NamedT ["lux" "Macro"]
+           (#LambdaT ASTList
+                     (#AppT (#AppT StateE Compiler)
+                            ASTList))))
 (_lux_export Macro)
 
 ## Base functions & macros
@@ -477,35 +504,35 @@
   (_lux_: Macro
           (_lux_lambda _ tokens
             (_lux_case tokens
-              (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])])
-              (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"]))
-                                                     (#Cons [(_meta (#SymbolS ["" ""]))
-                                                             (#Cons [arg
-                                                                     (#Cons [(_lux_case args'
-                                                                               #Nil
-                                                                               body
-
-                                                                               _
-                                                                               (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
-                                                                                                      (#Cons [(_meta (#TupleS args'))
-                                                                                                              (#Cons [body #Nil])])]))))
-                                                                             #Nil])])])])))
-                              #Nil]))
-
-              (#Cons [(#Meta [_ (#SymbolS self)]) (#Cons [(#Meta [_ (#TupleS (#Cons [arg args']))]) (#Cons [body #Nil])])])
-              (return (#Cons [(_meta (#FormS (#Cons [(_meta (#SymbolS ["" "_lux_lambda"]))
-                                                     (#Cons [(_meta (#SymbolS self))
-                                                             (#Cons [arg
-                                                                     (#Cons [(_lux_case args'
-                                                                               #Nil
-                                                                               body
-
-                                                                               _
-                                                                               (_meta (#FormS (#Cons [(_meta (#SymbolS ["lux" "lambda''"]))
-                                                                                                      (#Cons [(_meta (#TupleS args'))
-                                                                                                              (#Cons [body #Nil])])]))))
-                                                                             #Nil])])])])))
-                              #Nil]))
+              (#Cons (#Meta _ (#TupleS (#Cons arg args'))) (#Cons body #Nil))
+              (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
+                                                   (#Cons (_meta (#SymbolS "" ""))
+                                                          (#Cons arg
+                                                                 (#Cons (_lux_case args'
+                                                                          #Nil
+                                                                          body
+
+                                                                          _
+                                                                          (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''"))
+                                                                                                (#Cons (_meta (#TupleS args'))
+                                                                                                       (#Cons body #Nil))))))
+                                                                        #Nil))))))
+                             #Nil))
+
+              (#Cons (#Meta _ (#SymbolS self)) (#Cons (#Meta _ (#TupleS (#Cons arg args'))) (#Cons body #Nil)))
+              (return (#Cons (_meta (#FormS (#Cons (_meta (#SymbolS "" "_lux_lambda"))
+                                                   (#Cons (_meta (#SymbolS self))
+                                                          (#Cons arg
+                                                                 (#Cons (_lux_case args'
+                                                                          #Nil
+                                                                          body
+
+                                                                          _
+                                                                          (_meta (#FormS (#Cons (_meta (#SymbolS "lux" "lambda''"))
+                                                                                                (#Cons (_meta (#TupleS args'))
+                                                                                                       (#Cons body #Nil))))))
+                                                                        #Nil))))))
+                             #Nil))
               
               _
               (fail "Wrong syntax for lambda")))))
@@ -2136,6 +2163,9 @@
 
     (#AllT ?env ?name ?arg ?body)
     ($ text:++ "(All " ?name " [" ?arg "] " (type:show ?body) ")")
+
+    (#NamedT name type)
+    (ident->text name)
     ))
 
 (def (beta-reduce env type)
@@ -2169,6 +2199,9 @@
       _
       type)
     
+    (#NamedT name type)
+    (beta-reduce env type)
+
     _
     type
     ))
@@ -2188,6 +2221,9 @@
     (do Maybe/Monad
       [type-fn* (apply-type F A)]
       (apply-type type-fn* param))
+
+    (#NamedT name type)
+    (apply-type type param)
     
     _
     #None))
@@ -2204,6 +2240,8 @@
     (#AllT _ _ _ body)
     (resolve-struct-type body)
 
+    (#NamedT name type)
+    (resolve-struct-type type)
     _
     #None))
 
@@ -3046,7 +3084,10 @@
       (` (#AllT (~ env') (~ (text$ name)) (~ (text$ arg)) (~ (type->syntax type)))))
     
     (#AppT fun arg)
-    (` (#AppT (~ (type->syntax fun)) (~ (type->syntax arg))))))
+    (` (#AppT (~ (type->syntax fun)) (~ (type->syntax arg))))
+
+    (#NamedT [module name] type)
+    (` (#NamedT [(~ (text$ module)) (~ (text$ name))] (~ (type->syntax type))))))
 
 (defmacro #export (loop tokens)
   (case tokens
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 7810c415b..3b6a93005 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -532,7 +532,7 @@
       (|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)))))
+                 (assert false (prn-str 'analyse-basic-ast (&/show-ast token)))))
         (&/$Right state* output)
         (return* state* output)
 
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 395ae6976..483002adc 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -113,6 +113,9 @@
                                      (fail "##9##")))]
       (adjust-type* up type*))
 
+    (&/$NamedT ?name ?type)
+    (adjust-type* up ?type)
+
     _
     (assert false (prn 'adjust-type* (&type/show-type type)))
     ))
@@ -202,7 +205,7 @@
           (fail "[Pattern-matching Error] Record requires record-type.")))
 
       (&/$TagS ?ident)
-      (|do [;; :let [_ (println "#00")]
+      (|do [;; :let [_ (println "#00" (&/ident->text ?ident))]
             [=module =name] (&&/resolved-ident ?ident)
             ;; :let [_ (println "#01")]
             value-type* (adjust-type value-type)
@@ -219,7 +222,7 @@
 
       (&/$FormS (&/$Cons (&/$Meta _ (&/$TagS ?ident))
                          ?values))
-      (|do [;; :let [_ (println "#10" ?ident)]
+      (|do [;; :let [_ (println "#10" (&/ident->text ?ident))]
             [=module =name] (&&/resolved-ident ?ident)
             ;; :let [_ (println "#11")]
             value-type* (adjust-type value-type)
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 79b804088..8a79e0494 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -401,6 +401,7 @@
   ;; (when (= "PList/Dict" ?name)
   ;;   (prn 'DEF ?name (&/show-ast ?value)))
   (|do [module-name &/get-module-name
+        ;; :let [_ (println 'DEF/PRE (str module-name ";" ?name))]
         ? (&&module/defined? module-name ?name)]
     (if ?
       (fail (str "[Analyser Error] Can't redefine " (str module-name ";" ?name)))
@@ -416,15 +417,20 @@
             (return (&/|list)))
 
           _
-          (do (println 'DEF (str module-name ";" ?name))
+          (do ;; (println 'DEF (str module-name ";" ?name))
             (|do [_ (compile-token (&/V &&/$def (&/T ?name =value)))
-                  :let [_ (println 'DEF/COMPILED (str module-name ";" ?name))]]
+                  :let [;; _ (println 'DEF/COMPILED (str module-name ";" ?name))
+                        _ (println 'DEF (str module-name ";" ?name))]]
               (return (&/|list)))))
         ))))
 
 (defn analyse-declare-macro [analyse compile-token ?name]
-  (|do [module-name &/get-module-name
-        _ (compile-token (&/V &&/$declare-macro (&/T module-name ?name)))]
+  (|do [;; :let [_ (prn 'analyse-declare-macro ?name "0")]
+        module-name &/get-module-name
+        ;; :let [_ (prn 'analyse-declare-macro ?name "1")]
+        _ (compile-token (&/V &&/$declare-macro (&/T module-name ?name)))
+        ;; :let [_ (prn 'analyse-declare-macro ?name "2")]
+        ]
     (return (&/|list))))
 
 (defn ensure-undeclared-tags [module tags]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index e39f76409..44875d1df 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -58,7 +58,8 @@
   "VarT"
   "ExT"
   "AllT"
-  "AppT")
+  "AppT"
+  "NamedT")
 
 ;; [Fields]
 ;; Binding
@@ -229,7 +230,7 @@
 (defn |head [xs]
   (|case xs
     ($Nil)
-    (assert false)
+    (assert false (prn-str '|head))
 
     ($Cons x _)
     x))
@@ -237,7 +238,7 @@
 (defn |tail [xs]
   (|case xs
     ($Nil)
-    (assert false)
+    (assert false (prn-str '|tail))
 
     ($Cons _ xs*)
     xs*))
@@ -787,9 +788,8 @@
     ($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)))
+    _
+    (assert false (prn-str 'show-ast (adt->text ast)))
     ))
 
 (defn ident->text [ident]
@@ -898,19 +898,6 @@
     (and (= xmodule ymodule)
          (= xname yname))))
 
-;; (defn |list-put [idx val xs]
-;;   (|case [idx xs]
-;;     [_ ($Nil)]
-;;     (V $None nil)
-    
-;;     [0 ($Cons x xs*)]
-;;     (V $Some (V $Cons (T val xs*)))
-    
-;;     [_ ($Cons x xs*)]
-;;     (|case (|list-put idx val xs*)
-;;       ($None)      (V $None nil)
-;;       ($Some xs**) (V $Some (V $Cons (T x xs**))))))
-
 (defn |list-put [idx val xs]
   (|case xs
     ($Nil)
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 2516fbc1d..e78b5616a 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -26,14 +26,6 @@
     _
     false))
 
-(def Bool (&/V &/$DataT "java.lang.Boolean"))
-(def Int (&/V &/$DataT "java.lang.Long"))
-(def Real (&/V &/$DataT "java.lang.Double"))
-(def Char (&/V &/$DataT "java.lang.Character"))
-(def Text (&/V &/$DataT "java.lang.String"))
-(def Unit (&/V &/$TupleT (&/|list)))
-(def $Void (&/V &/$VariantT (&/|list)))
-
 (def ^:private empty-env (&/V &/$Some (&/V &/$Nil nil)))
 (def ^:private no-env (&/V &/$None nil))
 (defn Data$ [name]
@@ -46,154 +38,174 @@
   (&/V &/$LambdaT (&/T in out)))
 (defn App$ [fun arg]
   (&/V &/$AppT (&/T fun arg)))
-
 (defn Tuple$ [members]
   ;; (assert (|list? members))
   (&/V &/$TupleT members))
-
 (defn Variant$ [members]
   ;; (assert (|list? members))
   (&/V &/$VariantT members))
-
 (defn All$ [env name arg body]
   (&/V &/$AllT (&/T env name arg body)))
+(defn Named$ [name type]
+  (&/V &/$NamedT (&/T name type)))
+
+
+(def Bool (Named$ (&/T "lux" "Bool") (&/V &/$DataT "java.lang.Boolean")))
+(def Int (Named$ (&/T "lux" "Int") (&/V &/$DataT "java.lang.Long")))
+(def Real (Named$ (&/T "lux" "Real") (&/V &/$DataT "java.lang.Double")))
+(def Char (Named$ (&/T "lux" "Char") (&/V &/$DataT "java.lang.Character")))
+(def Text (Named$ (&/T "lux" "Text") (&/V &/$DataT "java.lang.String")))
+(def Unit (Named$ (&/T "lux" "Unit") (&/V &/$TupleT (&/|list))))
+(def $Void (Named$ (&/T "lux" "Void") (&/V &/$VariantT (&/|list))))
+(def Ident (Named$ (&/T "lux" "Ident") (Tuple$ (&/|list Text Text))))
 
 (def IO
-  (All$ empty-env "IO" "a"
-        (Lambda$ Unit (Bound$ "a"))))
+  (Named$ (&/T "lux/data" "IO")
+          (All$ empty-env "IO" "a"
+                (Lambda$ Unit (Bound$ "a")))))
 
 (def List
-  (All$ empty-env "lux;List" "a"
-        (Variant$ (&/|list
-                   ;; lux;Nil
-                   Unit
-                   ;; lux;Cons
-                   (Tuple$ (&/|list (Bound$ "a")
-                                    (App$ (Bound$ "lux;List")
-                                          (Bound$ "a"))))
-                   ))))
+  (Named$ (&/T "lux" "List")
+          (All$ empty-env "lux;List" "a"
+                (Variant$ (&/|list
+                           ;; lux;Nil
+                           Unit
+                           ;; lux;Cons
+                           (Tuple$ (&/|list (Bound$ "a")
+                                            (App$ (Bound$ "lux;List")
+                                                  (Bound$ "a"))))
+                           )))))
 
 (def Maybe
-  (All$ empty-env "lux;Maybe" "a"
-        (Variant$ (&/|list
-                   ;; lux;None
-                   Unit
-                   ;; lux;Some
-                   (Bound$ "a")
-                   ))))
+  (Named$ (&/T "lux" "Maybe")
+          (All$ empty-env "lux;Maybe" "a"
+                (Variant$ (&/|list
+                           ;; lux;None
+                           Unit
+                           ;; lux;Some
+                           (Bound$ "a")
+                           )))))
 
 (def Type
-  (let [Type (App$ (Bound$ "Type") (Bound$ "_"))
-        TypeList (App$ List Type)
-        TypeEnv (App$ List (Tuple$ (&/|list Text Type)))
-        TypePair (Tuple$ (&/|list Type Type))]
-    (App$ (All$ empty-env "Type" "_"
-                (Variant$ (&/|list
-                           ;; DataT
-                           Text
-                           ;; VariantT
-                           TypeList
-                           ;; TupleT
-                           TypeList
-                           ;; LambdaT
-                           TypePair
-                           ;; BoundT
-                           Text
-                           ;; VarT
-                           Int
-                           ;; ExT
-                           Int
-                           ;; AllT
-                           (Tuple$ (&/|list (App$ Maybe TypeEnv) Text Text Type))
-                           ;; AppT
-                           TypePair
-                           )))
-          $Void)))
+  (Named$ (&/T "lux" "Type")
+          (let [Type (App$ (Bound$ "Type") (Bound$ "_"))
+                TypeList (App$ List Type)
+                TypeEnv (App$ List (Tuple$ (&/|list Text Type)))
+                TypePair (Tuple$ (&/|list Type Type))]
+            (App$ (All$ empty-env "Type" "_"
+                        (Variant$ (&/|list
+                                   ;; DataT
+                                   Text
+                                   ;; VariantT
+                                   TypeList
+                                   ;; TupleT
+                                   TypeList
+                                   ;; LambdaT
+                                   TypePair
+                                   ;; BoundT
+                                   Text
+                                   ;; VarT
+                                   Int
+                                   ;; ExT
+                                   Int
+                                   ;; AllT
+                                   (Tuple$ (&/|list (App$ Maybe TypeEnv) Text Text Type))
+                                   ;; AppT
+                                   TypePair
+                                   ;; NamedT
+                                   (Tuple$ (&/|list Ident Type))
+                                   )))
+                  $Void))))
 
 (def Bindings
-  (All$ empty-env "lux;Bindings" "k"
-        (All$ no-env "" "v"
-              (Tuple$ (&/|list
-                       ;; "lux;counter"
-                       Int
-                       ;; "lux;mappings"
-                       (App$ List
-                             (Tuple$ (&/|list (Bound$ "k")
-                                              (Bound$ "v")))))))))
+  (Named$ (&/T "lux" "Bindings")
+          (All$ empty-env "lux;Bindings" "k"
+                (All$ no-env "" "v"
+                      (Tuple$ (&/|list
+                               ;; "lux;counter"
+                               Int
+                               ;; "lux;mappings"
+                               (App$ List
+                                     (Tuple$ (&/|list (Bound$ "k")
+                                                      (Bound$ "v"))))))))))
 
 (def Env
-  (let [bindings (App$ (App$ Bindings (Bound$ "k"))
-                       (Bound$ "v"))]
-    (All$ empty-env "lux;Env" "k"
-          (All$ no-env "" "v"
-                (Tuple$
-                 (&/|list
-                  ;; "lux;name"
-                  Text
-                  ;; "lux;inner-closures"
-                  Int
-                  ;; "lux;locals"
-                  bindings
-                  ;; "lux;closure"
-                  bindings
-                  ))))))
+  (Named$ (&/T "lux" "Env")
+          (let [bindings (App$ (App$ Bindings (Bound$ "k"))
+                               (Bound$ "v"))]
+            (All$ empty-env "lux;Env" "k"
+                  (All$ no-env "" "v"
+                        (Tuple$
+                         (&/|list
+                          ;; "lux;name"
+                          Text
+                          ;; "lux;inner-closures"
+                          Int
+                          ;; "lux;locals"
+                          bindings
+                          ;; "lux;closure"
+                          bindings
+                          )))))))
 
 (def Cursor
-  (Tuple$ (&/|list Text Int Int)))
+  (Named$ (&/T "lux" "Cursor")
+          (Tuple$ (&/|list Text Int Int))))
 
 (def Meta
-  (All$ empty-env "lux;Meta" "m"
-        (All$ no-env "" "v"
-              (Variant$ (&/|list
-                         ;; &/$Meta
-                         (Tuple$ (&/|list (Bound$ "m")
-                                          (Bound$ "v"))))))))
-
-(def Ident (Tuple$ (&/|list Text Text)))
+  (Named$ (&/T "lux" "Meta")
+          (All$ empty-env "lux;Meta" "m"
+                (All$ no-env "" "v"
+                      (Variant$ (&/|list
+                                 ;; &/$Meta
+                                 (Tuple$ (&/|list (Bound$ "m")
+                                                  (Bound$ "v")))))))))
 
 (def AST*
-  (let [AST* (App$ (Bound$ "w")
-                   (App$ (Bound$ "lux;AST'")
-                         (Bound$ "w")))
-        AST*List (App$ List AST*)]
-    (All$ empty-env "lux;AST'" "w"
-          (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*))))
-                    ))))
+  (Named$ (&/T "lux" "AST'")
+          (let [AST* (App$ (Bound$ "w")
+                           (App$ (Bound$ "lux;AST'")
+                                 (Bound$ "w")))
+                AST*List (App$ List AST*)]
+            (All$ empty-env "lux;AST'" "w"
+                  (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 (App$ Meta Cursor)]
-    (App$ w (App$ AST* w))))
+  (Named$ (&/T "lux" "AST")
+          (let [w (App$ Meta Cursor)]
+            (App$ w (App$ AST* w)))))
 
 (def ^:private ASTList (App$ List AST))
 
 (def Either
-  (All$ empty-env "lux;Either" "l"
-        (All$ no-env "" "r"
-              (Variant$ (&/|list
-                         ;; &/$Left
-                         (Bound$ "l")
-                         ;; &/$Right
-                         (Bound$ "r"))))))
+  (Named$ (&/T "lux" "Either")
+          (All$ empty-env "lux;Either" "l"
+                (All$ no-env "" "r"
+                      (Variant$ (&/|list
+                                 ;; &/$Left
+                                 (Bound$ "l")
+                                 ;; &/$Right
+                                 (Bound$ "r")))))))
 
 (def StateE
   (All$ empty-env "lux;StateE" "s"
@@ -204,19 +216,21 @@
                                               (Bound$ "a"))))))))
 
 (def Source
-  (App$ List
-        (App$ (App$ Meta Cursor)
-              Text)))
+  (Named$ (&/T "lux" "Source")
+          (App$ List
+                (App$ (App$ Meta Cursor)
+                      Text))))
 
 (def Host
-  (Tuple$
-   (&/|list
-    ;; "lux;writer"
-    (Data$ "org.objectweb.asm.ClassWriter")
-    ;; "lux;loader"
-    (Data$ "java.lang.ClassLoader")
-    ;; "lux;classes"
-    (Data$ "clojure.lang.Atom"))))
+  (Named$ (&/T "lux" "Host")
+          (Tuple$
+           (&/|list
+            ;; "lux;writer"
+            (Data$ "org.objectweb.asm.ClassWriter")
+            ;; "lux;loader"
+            (Data$ "java.lang.ClassLoader")
+            ;; "lux;classes"
+            (Data$ "clojure.lang.Atom")))))
 
 (def DefData*
   (All$ empty-env "lux;DefData'" ""
@@ -232,11 +246,12 @@
                    ))))
 
 (def LuxVar
-  (Variant$ (&/|list
-             ;; "lux;Local"
-             Int
-             ;; "lux;Global"
-             Ident)))
+  (Named$ (&/T "lux" "LuxVar")
+          (Variant$ (&/|list
+                     ;; "lux;Local"
+                     Int
+                     ;; "lux;Global"
+                     Ident))))
 
 (def $Module
   (All$ empty-env "lux;$Module" "Compiler"
@@ -264,37 +279,39 @@
           ))))
 
 (def $Compiler
-  (App$ (All$ empty-env "lux;Compiler" ""
-              (Tuple$
-               (&/|list
-                ;; "lux;source"
-                Source
-                ;; "lux;cursor"
-                Cursor
-                ;; "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;expected"
-                Type
-                ;; "lux;seed"
-                Int
-                ;; "lux;eval?"
-                Bool
-                ;; "lux;host"
-                Host
-                )))
-        $Void))
+  (Named$ (&/T "lux" "Compiler")
+          (App$ (All$ empty-env "lux;Compiler" ""
+                      (Tuple$
+                       (&/|list
+                        ;; "lux;source"
+                        Source
+                        ;; "lux;cursor"
+                        Cursor
+                        ;; "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;expected"
+                        Type
+                        ;; "lux;seed"
+                        Int
+                        ;; "lux;eval?"
+                        Bool
+                        ;; "lux;host"
+                        Host
+                        )))
+                $Void)))
 
 (def Macro
-  (Lambda$ ASTList
-           (App$ (App$ StateE $Compiler)
-                 ASTList)))
+  (Named$ (&/T "lux" "Macro")
+          (Lambda$ ASTList
+                   (App$ (App$ StateE $Compiler)
+                         ASTList))))
 
 (defn bound? [id]
   (fn [state]
@@ -512,8 +529,11 @@
         (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")"))
       ?name)
 
+    (&/$NamedT ?name ?type)
+    (&/ident->text ?name)
+
     _
-    (assert false (prn-str 'show-type (aget type 0)))))
+    (assert false (prn-str 'show-type (&/adt->text type)))))
 
 (defn type= [x y]
   (or (clojure.lang.Util/identical x y)
@@ -566,6 +586,12 @@
                           (type= xbody ybody)
                           )
 
+                     [(&/$NamedT ?xname ?xtype) _]
+                     (type= ?xtype y)
+
+                     [_ (&/$NamedT ?yname ?ytype)]
+                     (type= x ?ytype)
+                     
                      [_ _]
                      false
                      )]
@@ -640,9 +666,12 @@
     (&/$AppT F A)
     (|do [type-fn* (apply-type F A)]
       (apply-type type-fn* param))
+
+    (&/$NamedT ?name ?type)
+    (apply-type ?type param)
     
     _
-    (fail (str "[Type System] Not type function:\n" (show-type type-fn) "\n"))))
+    (fail (str "[Type System] Not a type function:\n" (show-type type-fn) "\n"))))
 
 (defn as-obj [class]
   (case class
@@ -805,7 +834,7 @@
                                                           (show-type a)))))
                                          (&/|interpose "\n\n")
                                          (&/fold str "")))
-                (assert false))]
+                (assert false (prn-str 'check* '[(&/$AppT F A) _] (&/|length fixpoints) (show-type expected) (show-type actual))))]
         (|case (fp-get fp-pair fixpoints)
           (&/$Some ?)
           (if ?
@@ -870,6 +899,12 @@
         (return (&/T fixpoints nil))
         (fail (check-error expected actual)))
 
+      [(&/$NamedT ?ename ?etype) _]
+      (check* class-loader fixpoints ?etype actual)
+
+      [_ (&/$NamedT ?aname ?atype)]
+      (check* class-loader fixpoints expected ?atype)
+
       [_ _]
       (fail (check-error expected actual))
       )))
@@ -892,11 +927,15 @@
               =return (apply-lambda func* param)]
           (clean $var =return))))
 
+    (&/$NamedT ?name ?type)
+    (apply-lambda ?type param)
+
     _
     (fail (str "[Type System] Not a function type:\n" (show-type func) "\n"))
     ))
 
 (defn actual-type [type]
+  "(-> Type (Lux Type))"
   (|case type
     (&/$AppT ?all ?param)
     (|do [type* (apply-type ?all ?param)]
@@ -904,6 +943,9 @@
 
     (&/$VarT ?id)
     (deref ?id)
+
+    (&/$NamedT ?name ?type)
+    (actual-type ?type)
     
     _
     (return type)
@@ -911,6 +953,9 @@
 
 (defn variant-case [tag type]
   (|case type
+    (&/$NamedT ?name ?type)
+    (variant-case tag ?type)
+    
     (&/$VariantT ?cases)
     (|case (&/|at tag ?cases)
       (&/$Some case-type)
-- 
cgit v1.2.3