- Finished turning tags into indices.

- As an unexpected bonus, the compiler has become 2.5x faster.
- Fixed some minor bugs.
- Tag declarations now include associated types.
- Tag declarations info is now stored twice (one from the perspective of tags, the other from the perspective of types).
- Changed the named of the "types" member of the Compiler type, to "type-vars" to avoid collision with the "types" member of the Module type.

10 files changed, 149 insertions, 89 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 3b6a93005..8c88328f5 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -442,9 +442,10 @@
 
     (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_declare-tags"))
                        (&/$Cons (&/$Meta _ (&/$TupleS tags))
-                                (&/$Nil))))
+                                (&/$Cons (&/$Meta _ (&/$SymbolS "" type-name))
+                                         (&/$Nil)))))
     (|do [tags* (&/map% parse-tag tags)]
-      (&&lux/analyse-declare-tags tags*))
+      (&&lux/analyse-declare-tags tags* type-name))
     
     (&/$FormS (&/$Cons (&/$Meta _ (&/$SymbolS _ "_lux_import"))
                        (&/$Cons (&/$Meta _ (&/$TextS ?path))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 8a79e0494..d241201f4 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -300,8 +300,8 @@
                   macro-expansion #(-> macro (.apply ?args) (.apply %))
                   ;; :let [_ (prn 'MACRO-EXPAND|POST (&/ident->text real-name))]
                   ;; :let [macro-expansion* (&/|map (partial with-cursor form-cursor) macro-expansion)]
-                  ;; :let [_ (when (or (= ":" (aget real-name 1))
-                  ;;                   (= "type" (aget real-name 1))
+                  ;; :let [_ (when (or (= "defsig" (aget real-name 1))
+                  ;;                   ;; (= "type" (aget real-name 1))
                   ;;                   ;; (= &&/$struct r-name)
                   ;;                   )
                   ;;           (->> (&/|map &/show-ast macro-expansion)
@@ -409,7 +409,7 @@
                      (analyse-1+ analyse ?value))
             =value-type (&&/expr-type =value)]
         (|case =value
-          [(&/$Global ?r-module ?r-name) _]
+          [(&&/$var (&/$Global ?r-module ?r-name)) _]
           (|do [_ (&&module/def-alias module-name ?name ?r-module ?r-name =value-type)
                 ;; :let [_ (println 'analyse-def/ALIAS (str module-name ";" ?name) '=> (str ?r-module ";" ?r-name))
                 ;;       _ (println)]
@@ -418,10 +418,10 @@
 
           _
           (do ;; (println 'DEF (str module-name ";" ?name))
-            (|do [_ (compile-token (&/V &&/$def (&/T ?name =value)))
-                  :let [;; _ (println 'DEF/COMPILED (str module-name ";" ?name))
-                        _ (println 'DEF (str module-name ";" ?name))]]
-              (return (&/|list)))))
+              (|do [_ (compile-token (&/V &&/$def (&/T ?name =value)))
+                    :let [;; _ (println 'DEF/COMPILED (str module-name ";" ?name))
+                          _ (println 'DEF (str module-name ";" ?name))]]
+                (return (&/|list)))))
         ))))
 
 (defn analyse-declare-macro [analyse compile-token ?name]
@@ -433,28 +433,13 @@
         ]
     (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)]
-        ]
+(defn analyse-declare-tags [tags type-name]
+  (|do [module-name &/get-module-name
+        ;; :let [_ (prn 'analyse-declare-tags (&/ident->text (&/T module-name type-name)) (&/->seq tags))]
+        [_ def-data] (&&module/find-def module-name type-name)
+        ;; :let [_ (prn 'analyse-declare-tags (&/ident->text (&/T module-name type-name)) (&/->seq tags) (&/adt->text def-data))]
+        def-type (&&module/ensure-type-def def-data)
+        _ (&&module/declare-tags module-name tags def-type)]
     (return (&/|list))))
 
 (defn analyse-import [analyse compile-module compile-token ?path]
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 08ad0b9a5..5190e2dcf 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -8,7 +8,8 @@
 
 (ns lux.analyser.module
   (:refer-clojure :exclude [alias])
-  (:require [clojure.string :as string]
+  (:require (clojure [string :as string]
+                     [template :refer [do-template]])
             clojure.core.match
             clojure.core.match.array
             (lux [base :as & :refer [deftags |let |do return return* fail fail* |case]]
@@ -20,7 +21,8 @@
   "module-aliases"
   "defs"
   "imports"
-  "tags")
+  "tags"
+  "types")
 (def ^:private +init+
   (&/T ;; "lux;module-aliases"
    (&/|table)
@@ -29,7 +31,9 @@
    ;; "lux;imports"
    (&/|list)
    ;; "lux;tags"
-   (&/|list)
+   (&/|table)
+   ;; "lux;types"
+   (&/|table)
    ))
 
 ;; [Exports]
@@ -46,6 +50,7 @@
                nil))))
 
 (defn define [module name def-data type]
+  ;; (prn 'define module name (aget def-data 0) (&type/show-type type))
   (fn [state]
     (|case (&/get$ &/$envs state)
       (&/$Cons ?env (&/$Nil))
@@ -151,6 +156,15 @@
               (fail* (str "[Analyser Error] Definition does not exist: " (str module &/+name-separator+ name)))))
         (fail* (str "[Analyser Error] Module doesn't exist: " module))))))
 
+(defn ensure-type-def [def-data]
+  "(-> DefData (Lux Type))"
+  (|case def-data
+    (&/$TypeD type)
+    (return type)
+
+    _
+    (fail (str "[Analyser Error] Not a type definition: " (&/adt->text def-data)))))
+
 (defn defined? [module name]
   (&/try-all% (&/|list (|do [_ (find-def module name)]
                          (return true))
@@ -250,32 +264,59 @@
                   (&/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)))
-    ))
+(do-template [<name> <tag> <type>]
+  (defn <name> [module]
+    <type>
+    (fn [state]
+      (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
+        (return* state (&/get$ <tag> =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)))))
+  tags-by-module  $tags  "(-> Text (Lux (List (, Text (, Int (List Text) Type)))))"
+  types-by-module $types "(-> Text (Lux (List (, Text (, (List Text) Type)))))"
+  )
+
+(defn ensure-undeclared-tags [module tags]
+  (|do [tags-table (tags-by-module module)
+        _ (&/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)]
+    (return nil)))
+
+(defn ensure-undeclared-type [module name]
+  (|do [types-table (types-by-module module)
+        _ (&/assert! (nil? (&/|get name types-table)) (str "[Analyser Error] Can't re-declare type: " (&/ident->text (&/T module name))))]
+    (return nil)))
+
+(defn declare-tags [module tag-names type]
+  "(-> Text (List Text) Type (Lux (,)))"
+  (|do [;; :let [_ (prn 'declare-tags (&/->seq tag-names) (&/adt->text type))]
+        _ (ensure-undeclared-tags module tag-names)
+        type-name (&type/type-name type)
+        :let [[_module _name] type-name]
+        _ (&/assert! (= module _module)
+                     (str "[Module Error] Can't define tags for a type belonging to a foreign module: " (&/ident->text type-name)))
+        _ (ensure-undeclared-type _module _name)]
+    (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 type) table)))
+                                                                       (&/get$ $tags %)
+                                                                       (&/enumerate tag-names)))
+                                                 (&/update$ $types (partial &/|put _name (&/T tags type))))
+                                           =modules))
+                              state)
+                   nil))
+        (fail* (str "[Lux Error] Unknown module: " module))))))
 
 (defn tag-index [module tag-name]
   "(-> Text Text (Lux Int))"
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 44875d1df..84b09bcac 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -86,7 +86,7 @@
   "cursor"
   "modules"
   "envs"
-  "types"
+  "type-vars"
   "expected"
   "seed"
   "eval?"
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 78b9e72f6..0ae4ce2da 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -80,7 +80,13 @@
       (.visitMethodInsn *writer* Opcodes/INVOKESTATIC (&host/->class char-class) "valueOf" (str "(C)" (&host/->type-signature char-class)))
       
       (&/$DataT _)
-      nil)
+      nil
+
+      (&/$NamedT ?name ?type)
+      (prepare-return! *writer* ?type)
+
+      _
+      (assert false (str 'prepare-return! " " (&type/show-type *type*))))
     *writer*))
 
 ;; [Resources]
diff --git a/src/lux/compiler/type.clj b/src/lux/compiler/type.clj
index a7c5176ad..7e2bc6961 100644
--- a/src/lux/compiler/type.clj
+++ b/src/lux/compiler/type.clj
@@ -84,4 +84,8 @@
 
     (&/$AppT ?fun ?arg)
     (variant$ &/$AppT (tuple$ (&/|list (->analysis ?fun) (->analysis ?arg))))
+
+    (&/$NamedT [?module ?name] ?type)
+    (variant$ &/$NamedT (tuple$ (&/|list (tuple$ (&/|list (text$ ?module) (text$ ?name)))
+                                         (->analysis ?type))))
     ))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 8ffe77b96..dfd4df23d 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -68,6 +68,7 @@
     ))
 
 (defn ->java-sig [^objects type]
+  "(-> Type Text)"
   (|case type
     (&/$DataT ?name)
     (->type-signature ?name)
@@ -77,6 +78,12 @@
 
     (&/$TupleT (&/$Nil))
     "V"
+
+    (&/$NamedT ?name ?type)
+    (->java-sig ?type)
+
+    _
+    (assert false (str '->java-sig " " (&type/show-type type)))
     ))
 
 (do-template [<name> <static?>]
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index a8b2cfc16..eaa22db20 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -76,10 +76,10 @@
       (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$BoolS (Boolean/parseBoolean ?value))))))
 
       ($Int ?value)
-      (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$IntS (Integer/parseInt ?value))))))
+      (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$IntS (Long/parseLong ?value))))))
 
       ($Real ?value)
-      (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$RealS (Float/parseFloat ?value))))))
+      (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$RealS (Double/parseDouble ?value))))))
 
       ($Char ^String ?value)
       (return (&/|list (&/V &/$Meta (&/T meta (&/V &/$CharS (.charAt ?value 0))))))
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index e0195658f..e3f95b5f9 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -26,7 +26,7 @@
       (fail* "[Reader Error] EOF")
 
       (&/$Cons [[file-name line-num column-num] line]
-       more)
+               more)
       (|case (body file-name line-num column-num line)
         ($No msg)
         (fail* msg)
@@ -87,7 +87,7 @@
           (if (= column-num* (.length line))
             (&/V $Done (&/T (&/T file-name line-num column-num) match))
             (&/V $Yes (&/T (&/T (&/T file-name line-num column-num) match)
-                            (&/T (&/T file-name line-num column-num*) line)))))
+                           (&/T (&/T file-name line-num column-num*) line)))))
         (&/V $No (str "[Reader Error] Pattern failed: " regex))))))
 
 (defn read-regex2 [regex]
@@ -100,7 +100,7 @@
           (if (= column-num* (.length line))
             (&/V $Done (&/T (&/T file-name line-num column-num) (&/T tok1 tok2)))
             (&/V $Yes (&/T (&/T (&/T file-name line-num column-num) (&/T tok1 tok2))
-                            (&/T (&/T file-name line-num column-num*) line)))))
+                           (&/T (&/T file-name line-num column-num*) line)))))
         (&/V $No (str "[Reader Error] Pattern failed: " regex))))))
 
 (defn read-regex+ [regex]
@@ -113,7 +113,7 @@
           (&/V &/$Left "[Reader Error] EOF")
 
           (&/$Cons [[file-name line-num column-num] ^String line]
-           reader**)
+                   reader**)
           (if-let [^String match (do ;; (prn 'read-regex+ regex line)
                                      (re-find1! regex column-num line))]
             (let [match-length (.length match)
@@ -121,8 +121,8 @@
               (if (= column-num* (.length line))
                 (recur (str prefix match "\n") reader**)
                 (&/V &/$Right (&/T (&/|cons (&/T (&/T file-name line-num column-num*) line)
-                                               reader**)
-                                      (&/T (&/T file-name line-num column-num) (str prefix match))))))
+                                            reader**)
+                                   (&/T (&/T file-name line-num column-num) (str prefix match))))))
             (&/V &/$Left (str "[Reader Error] Pattern failed: " regex))))))))
 
 (defn read-text [^String text]
@@ -135,7 +135,7 @@
           (if (= column-num* (.length line))
             (&/V $Done (&/T (&/T file-name line-num column-num) text))
             (&/V $Yes (&/T (&/T (&/T file-name line-num column-num) text)
-                            (&/T (&/T file-name line-num column-num*) line)))))
+                           (&/T (&/T file-name line-num column-num*) line)))))
         (&/V $No (str "[Reader Error] Text failed: " text))))))
 
 (def ^:private ^String +source-dir+ "input/")
diff --git a/src/lux/type.clj b/src/lux/type.clj
index e78b5616a..9f3adb036 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -235,10 +235,10 @@
 (def DefData*
   (All$ empty-env "lux;DefData'" ""
         (Variant$ (&/|list
-                   ;; "lux;TypeD"
-                   Type
                    ;; "lux;ValueD"
                    (Tuple$ (&/|list Type Unit))
+                   ;; "lux;TypeD"
+                   Type
                    ;; "lux;MacroD"
                    (Bound$ "")
                    ;; "lux;AliasD"
@@ -270,12 +270,18 @@
           ;; "lux;imports"
           (App$ List Text)
           ;; "lux;tags"
-          ;; (List (, Text (List Ident)))
+          ;; (List (, Text (, Int (List Ident) Type)))
           (App$ List
                 (Tuple$ (&/|list Text
                                  (Tuple$ (&/|list Int
-                                                  (App$ List
-                                                        Ident))))))
+                                                  (App$ List Ident)
+                                                  Type)))))
+          ;; "lux;types"
+          ;; (List (, Text (, (List Ident) Type)))
+          (App$ List
+                (Tuple$ (&/|list Text
+                                 (Tuple$ (&/|list (App$ List Ident)
+                                                  Type)))))
           ))))
 
 (def $Compiler
@@ -315,7 +321,7 @@
 
 (defn bound? [id]
   (fn [state]
-    (if-let [type (->> state (&/get$ &/$types) (&/get$ &/$mappings) (&/|get id))]
+    (if-let [type (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
       (|case type
         (&/$Some type*)
         (return* state true)
@@ -326,7 +332,7 @@
 
 (defn deref [id]
   (fn [state]
-    (if-let [type* (->> state (&/get$ &/$types) (&/get$ &/$mappings) (&/|get id))]
+    (if-let [type* (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
       (|case type*
         (&/$Some type)
         (return* state type)
@@ -337,26 +343,26 @@
 
 (defn set-var [id type]
   (fn [state]
-    (if-let [tvar (->> state (&/get$ &/$types) (&/get$ &/$mappings) (&/|get id))]
+    (if-let [tvar (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) (&/|get id))]
       (|case tvar
         (&/$Some bound)
         (fail* (str "[Type Error] Can't rebind type var: " id " | Current type: " (show-type bound)))
         
         (&/$None)
-        (return* (&/update$ &/$types (fn [ts] (&/update$ &/$mappings #(&/|put id (&/V &/$Some type) %)
-                                                        ts))
+        (return* (&/update$ &/$type-vars (fn [ts] (&/update$ &/$mappings #(&/|put id (&/V &/$Some type) %)
+                                                            ts))
                             state)
                  nil))
-      (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$types) (&/get$ &/$mappings) &/|length))))))
+      (fail* (str "[Type Error] <set-var> Unknown type-var: " id " | " (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings) &/|length))))))
 
 ;; [Exports]
 ;; Type vars
 (def ^:private create-var
   (fn [state]
-    (let [id (->> state (&/get$ &/$types) (&/get$ &/$counter))]
-      (return* (&/update$ &/$types #(->> %
-                                         (&/update$ &/$counter inc)
-                                         (&/update$ &/$mappings (fn [ms] (&/|put id (&/V &/$None nil) ms))))
+    (let [id (->> state (&/get$ &/$type-vars) (&/get$ &/$counter))]
+      (return* (&/update$ &/$type-vars #(->> %
+                                             (&/update$ &/$counter inc)
+                                             (&/update$ &/$mappings (fn [ms] (&/|put id (&/V &/$None nil) ms))))
                           state)
                id))))
 
@@ -391,11 +397,11 @@
                                          (|do [?type** (clean* id ?type*)]
                                            (return (&/T ?id (&/V &/$Some ?type**)))))
                                        ))))
-                               (->> state (&/get$ &/$types) (&/get$ &/$mappings)))]
+                               (->> state (&/get$ &/$type-vars) (&/get$ &/$mappings)))]
          (fn [state]
-           (return* (&/update$ &/$types #(->> %
-                                              (&/update$ &/$counter dec)
-                                              (&/set$ &/$mappings (&/|remove id mappings*)))
+           (return* (&/update$ &/$type-vars #(->> %
+                                                  (&/update$ &/$counter dec)
+                                                  (&/set$ &/$mappings (&/|remove id mappings*)))
                                state)
                     nil)))
        state))))
@@ -966,3 +972,13 @@
 
     _
     (fail (str "[Type Error] Type is not a variant: " (show-type type)))))
+
+(defn type-name [type]
+  "(-> Type (Lux Ident))"
+  (|case type
+    (&/$NamedT name _)
+    (return name)
+    
+    _
+    (fail (str "[Type Error] Type is not named: " (show-type type)))
+    ))