- Implemented inference for constructing records.

6 files changed, 139 insertions, 207 deletions

diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 9a57191f5..d17eeea2a 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -499,7 +499,7 @@
       (return (&/|list (&/T (&/V &&/$text ?value) exo-type))))
 
     (&/$TupleS ?elems)
-    (&&lux/analyse-tuple analyse exo-type ?elems)
+    (&&lux/analyse-tuple analyse (&/V &/$Right exo-type) ?elems)
 
     (&/$RecordS ?elems)
     (&&lux/analyse-record analyse exo-type ?elems)
diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 7f7980e76..e27b2e42e 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -130,15 +130,18 @@
   (|let [[_ type] syntax+]
     type))
 
-(defn analyse-1 [analyse exo-type elem]
-  (|do [output (analyse exo-type elem)]
-    (|case output
+(defn cap-1 [action]
+  (|do [result action]
+    (|case result
       (&/$Cons x (&/$Nil))
       (return x)
 
       _
       (fail "[Analyser Error] Can't expand to other than 1 element."))))
 
+(defn analyse-1 [analyse exo-type elem]
+  (cap-1 (analyse exo-type elem)))
+
 (defn analyse-1+ [analyse ?token]
   (&type/with-var
     (fn [$var]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index f2afdb0e9..7226b98e4 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -178,8 +178,8 @@
               (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*))))))
       
       (&/$RecordS pairs)
-      (|do [?members (&&record/order-record pairs)]
-        (analyse-pattern value-type (&/T meta (&/V &/$TupleS ?members)) kont))
+      (|do [[rec-members rec-type] (&&record/order-record pairs)]
+        (analyse-pattern value-type (&/T meta (&/V &/$TupleS rec-members)) kont))
 
       (&/$TagS ?ident)
       (|do [;; :let [_ (println "#00" (&/ident->text ?ident))]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 39eda451f..a6f41c9fd 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -18,35 +18,84 @@
                           [module :as &&module]
                           [record :as &&record])))
 
+;; [Utils]
+(defn ^:private count-univq [type]
+  "(-> Type Int)"
+  (|case type
+    (&/$UnivQ env type*)
+    (inc (count-univq type*))
+
+    _
+    0))
+
+(defn ^:private next-bound-type [type]
+  "(-> Type Type)"
+  (&type/Bound$ (->> (count-univq type) (* 2) (+ 1))))
+
+(defn ^:private embed-inferred-input [input output]
+  "(-> Type Type Type)"
+  (|case output
+    (&/$UnivQ env output*)
+    (&type/Univ$ env (embed-inferred-input input output*))
+
+    _
+    (&type/Lambda$ input output)))
+
 ;; [Exports]
-(defn analyse-tuple [analyse exo-type ?elems]
-  (|do [unknown? (&type/unknown? exo-type)]
-    (if unknown?
-      (|do [=elems (&/map% #(|do [=analysis (&&/analyse-1+ analyse %)]
-                              (return =analysis))
-                           ?elems)
-            _ (&type/check exo-type (&/V &/$TupleT (&/|map &&/expr-type* =elems)))]
-        (return (&/|list (&/T (&/V &&/$tuple =elems)
-                              exo-type))))
-      (|do [exo-type* (&type/actual-type exo-type)]
-        (|case exo-type*
-          (&/$TupleT ?members)
-          (|do [=elems (&/map2% (fn [elem-t elem]
-                                  (&&/analyse-1 analyse elem-t elem))
-                                ?members ?elems)]
-            (return (&/|list (&/T (&/V &&/$tuple =elems)
-                                  exo-type))))
-
-          (&/$UnivQ _)
-          (&type/with-var
-            (fn [$var]
-              (|do [exo-type** (&type/apply-type exo-type* $var)]
-                (analyse-tuple analyse exo-type** ?elems))))
+(defn analyse-tuple [analyse ?exo-type ?elems]
+  (|case ?exo-type
+    (&/$Left exo-type)
+    (|do [;; :let [_ (println 'analyse-tuple/$Left (&type/show-type exo-type))]
+          exo-type* (&type/actual-type exo-type)]
+      (|case exo-type*
+        (&/$UnivQ _)
+        (&type/with-var
+          (fn [$var]
+            (|do [exo-type** (&type/apply-type exo-type* $var)
+                  [tuple-analysis tuple-type] (&&/cap-1 (analyse-tuple analyse (&/V &/$Left exo-type**) ?elems))
+                  =var (&type/resolve-type $var)
+                  inferred-type (|case =var
+                                  (&/$VarT iid)
+                                  (|do [:let [=var* (next-bound-type tuple-type)]
+                                        _ (&type/set-var iid =var*)
+                                        tuple-type* (&type/clean $var tuple-type)]
+                                    (return (&type/Univ$ (&/|list) tuple-type*)))
+
+                                  _
+                                  (&type/clean $var tuple-type))]
+              (return (&/|list (&/T tuple-analysis inferred-type))))))
 
-          _
-          (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*) " " (&type/show-type exo-type) " " "[" (->> ?elems (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")) "]"))
-          ;; (assert false (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*) " " (&type/show-type exo-type) " " "[" (->> ?elems (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")) "]"))
-          )))))
+        _
+        (analyse-tuple analyse (&/V &/$Right exo-type*) ?elems)))
+
+    (&/$Right exo-type)
+    (|do [unknown? (&type/unknown? exo-type)]
+      (if unknown?
+        (|do [=elems (&/map% #(|do [=analysis (&&/analyse-1+ analyse %)]
+                                (return =analysis))
+                             ?elems)
+              _ (&type/check exo-type (&/V &/$TupleT (&/|map &&/expr-type* =elems)))]
+          (return (&/|list (&/T (&/V &&/$tuple =elems)
+                                exo-type))))
+        (|do [exo-type* (&type/actual-type exo-type)]
+          (|case exo-type*
+            (&/$TupleT ?members)
+            (|do [=elems (&/map2% (fn [elem-t elem]
+                                    (&&/analyse-1 analyse elem-t elem))
+                                  ?members ?elems)]
+              (return (&/|list (&/T (&/V &&/$tuple =elems)
+                                    exo-type))))
+
+            (&/$UnivQ _)
+            (|do [$var &type/existential
+                  exo-type** (&type/apply-type exo-type* $var)
+                  [tuple-analysis tuple-type] (&&/cap-1 (analyse-tuple analyse (&/V &/$Right exo-type**) ?elems))]
+              (return (&/|list (&/T tuple-analysis exo-type))))
+
+            _
+            (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*) " " (&type/show-type exo-type) " " "[" (->> ?elems (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")) "]"))
+            ;; (assert false (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type exo-type*) " " (&type/show-type exo-type) " " "[" (->> ?elems (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")) "]"))
+            ))))))
 
 (defn with-attempt [m-value on-error]
   (fn [state]
@@ -61,13 +110,13 @@
   (|do [output (with-attempt
                  (|case ?values
                    (&/$Nil)
-                   (analyse-tuple analyse exo-type (&/|list))
+                   (analyse-tuple analyse (&/V &/$Right exo-type) (&/|list))
 
                    (&/$Cons ?value (&/$Nil))
                    (analyse exo-type ?value)
 
                    _
-                   (analyse-tuple analyse exo-type ?values))
+                   (analyse-tuple analyse (&/V &/$Right exo-type) ?values))
                  (fn [err]
                    (fail (str err "\n"
                               'analyse-variant-body " " (&type/show-type exo-type)
@@ -121,8 +170,19 @@
       (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 [members (&&record/order-record ?elems)]
-    (analyse-tuple analyse exo-type members)))
+  (|do [[rec-members rec-type] (&&record/order-record ?elems)]
+    (|case exo-type
+      (&/$VarT id)
+      (|do [? (&type/bound? id)]
+        (if ?
+          (analyse-tuple analyse (&/V &/$Right exo-type) rec-members)
+          (|do [[tuple-analysis tuple-type] (&&/cap-1 (analyse-tuple analyse (&/V &/$Left rec-type) rec-members))
+                _ (&type/check exo-type tuple-type)]
+            (return (&/|list (&/T tuple-analysis exo-type))))))
+
+      _
+      (analyse-tuple analyse (&/V &/$Right exo-type) rec-members)
+      )))
 
 (defn ^:private analyse-global [analyse exo-type module name]
   (|do [[[r-module r-name] $def] (&&module/find-def module name)
@@ -301,24 +361,6 @@
     (return (&/|list (&/T (&/V &&/$case (&/T =value =match))
                           exo-type)))))
 
-(defn ^:private count-univq [type]
-  "(-> Type Int)"
-  (|case type
-    (&/$UnivQ env type*)
-    (inc (count-univq type*))
-
-    _
-    0))
-
-(defn ^:private embed-inferred-input [input output]
-  "(-> Type Type Type)"
-  (|case output
-    (&/$UnivQ env output*)
-    (&type/Univ$ env (embed-inferred-input input output*))
-
-    _
-    (&type/Lambda$ input output)))
-
 (defn analyse-lambda* [analyse exo-type ?self ?arg ?body]
   (|case exo-type
     (&/$VarT id)
@@ -336,7 +378,7 @@
                       =output (&type/resolve-type $output)
                       inferred-type (|case =input
                                       (&/$VarT iid)
-                                      (|do [:let [=input* (&type/Bound$ (->> (count-univq =output) (* 2) (+ 1)))]
+                                      (|do [:let [=input* (next-bound-type =output)]
                                             _ (&type/set-var iid =input*)
                                             =output* (&type/clean $input =output)
                                             =output** (&type/clean $output =output*)]
@@ -424,7 +466,9 @@
           (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))]]
+                          [def-analysis def-type] =value
+                          _ (println 'DEF (str module-name ";" ?name) ;; (&type/show-type def-type)
+                                     )]]
                 (return (&/|list)))))
         ))))
 
diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj
index 8c27fc08d..aaed26a7a 100644
--- a/src/lux/analyser/module.clj
+++ b/src/lux/analyser/module.clj
@@ -343,20 +343,17 @@
                    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 "[Module Error] Unknown tag: " (&/ident->text (&/T module tag-name)))))
-      (fail* (str "[Module Error] Unknown module: " module)))))
-
-(defn tag-group [module tag-name]
-  "(-> Text Text (Lux (List Ident)))"
-  (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 1))
-        (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T module tag-name)))))
-      (fail* (str "[Module Error] Unknown module: " module)))))
+(do-template [<name> <idx> <doc>]
+  (defn <name> [module tag-name]
+    <doc>
+    (fn [state]
+      (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
+        (if-let [^objects idx+tags+type (&/|get tag-name (&/get$ $tags =module))]
+          (return* state (aget idx+tags+type <idx>))
+          (fail* (str "[Module Error] Unknown tag: " (&/ident->text (&/T module tag-name)))))
+        (fail* (str "[Module Error] Unknown module: " module)))))
+
+  tag-index 0 "(-> Text Text (Lux Int))"
+  tag-group 1 "(-> Text Text (Lux (List Ident)))"
+  tag-type  2 "(-> Text Text (Lux Type))"
+  )
diff --git a/src/lux/analyser/record.clj b/src/lux/analyser/record.clj
index 8b70bbcb4..0f860888b 100644
--- a/src/lux/analyser/record.clj
+++ b/src/lux/analyser/record.clj
@@ -6,139 +6,26 @@
 (ns lux.analyser.record
   (:require clojure.core.match
             clojure.core.match.array
-            (lux [base :as & :refer [deftags |let |do return fail |case]])
+            (lux [base :as & :refer [deftags |let |do return fail |case]]
+                 [type :as &type])
             (lux.analyser [base :as &&]
                           [module :as &&module])))
 
-;; [Tags]
-(deftags ""
-  "bool"
-  "int"
-  "real"
-  "char"
-  "text"
-  "variant"
-  "tuple"
-  "apply"
-  "case"
-  "lambda"
-  "ann"
-  "def"
-  "declare-macro"
-  "var"
-  "captured"
-
-  "jvm-getstatic"
-  "jvm-getfield"
-  "jvm-putstatic"
-  "jvm-putfield"
-  "jvm-invokestatic"
-  "jvm-instanceof"
-  "jvm-invokevirtual"
-  "jvm-invokeinterface"
-  "jvm-invokespecial"
-  "jvm-null?"
-  "jvm-null"
-  "jvm-new"
-  "jvm-new-array"
-  "jvm-aastore"
-  "jvm-aaload"
-  "jvm-class"
-  "jvm-interface"
-  "jvm-try"
-  "jvm-throw"
-  "jvm-monitorenter"
-  "jvm-monitorexit"
-  "jvm-program"
-
-  "jvm-iadd"
-  "jvm-isub"
-  "jvm-imul"
-  "jvm-idiv"
-  "jvm-irem"
-  "jvm-ieq"
-  "jvm-ilt"
-  "jvm-igt"
-
-  "jvm-ceq"
-  "jvm-clt"
-  "jvm-cgt"
-
-  "jvm-ladd"
-  "jvm-lsub"
-  "jvm-lmul"
-  "jvm-ldiv"
-  "jvm-lrem"
-  "jvm-leq"
-  "jvm-llt"
-  "jvm-lgt"
-
-  "jvm-fadd"
-  "jvm-fsub"
-  "jvm-fmul"
-  "jvm-fdiv"
-  "jvm-frem"
-  "jvm-feq"
-  "jvm-flt"
-  "jvm-fgt"
-
-  "jvm-dadd"
-  "jvm-dsub"
-  "jvm-dmul"
-  "jvm-ddiv"
-  "jvm-drem"
-  "jvm-deq"
-  "jvm-dlt"
-  "jvm-dgt"
-
-  "jvm-d2f"
-  "jvm-d2i"
-  "jvm-d2l"
-
-  "jvm-f2d"
-  "jvm-f2i"
-  "jvm-f2l"
-
-  "jvm-i2b"
-  "jvm-i2c"
-  "jvm-i2d"
-  "jvm-i2f"
-  "jvm-i2l"
-  "jvm-i2s"
-
-  "jvm-l2d"
-  "jvm-l2f"
-  "jvm-l2i"
-
-  "jvm-iand"
-  "jvm-ior"
-  "jvm-ixor"
-  "jvm-ishl"
-  "jvm-ishr"
-  "jvm-iushr"
-
-  "jvm-land"
-  "jvm-lor"
-  "jvm-lxor"
-  "jvm-lshl"
-  "jvm-lshr"
-  "jvm-lushr"
-  
-  )
-
 ;; [Exports]
 (defn order-record [pairs]
   "(-> (List (, Syntax Syntax)) (Lux (List Syntax)))"
-  (|do [tag-group (|case pairs
-                    (&/$Nil)
-                    (return (&/|list))
-                    
-                    (&/$Cons [[_ (&/$TagS tag1)] _] _)
-                    (|do [[module name] (&&/resolved-ident tag1)]
-                      (&&module/tag-group module name))
-
-                    _
-                    (fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags."))
+  (|do [[tag-group tag-type] (|case pairs
+                               (&/$Nil)
+                               (return (&/T (&/|list) &type/Unit))
+                               
+                               (&/$Cons [[_ (&/$TagS tag1)] _] _)
+                               (|do [[module name] (&&/resolved-ident tag1)
+                                     tags (&&module/tag-group module name)
+                                     type (&&module/tag-type module name)]
+                                 (return (&/T tags type)))
+
+                               _
+                               (fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags."))
         =pairs (&/map% (fn [kv]
                          (|case kv
                            [[_ (&/$TagS k)] v]
@@ -147,9 +34,10 @@
 
                            _
                            (fail "[Analyser Error] Wrong syntax for records. Odd elements must be tags.")))
-                       pairs)]
-    (&/map% (fn [tag]
-              (if-let [member (&/|get tag =pairs)]
-                (return member)
-                (fail (str "[Analyser Error] Unknown tag: " tag))))
-            (&/|map &/ident->text tag-group))))
+                       pairs)
+        =members (&/map% (fn [tag]
+                           (if-let [member (&/|get tag =pairs)]
+                             (return member)
+                             (fail (str "[Analyser Error] Unknown tag: " tag))))
+                         (&/|map &/ident->text tag-group))]
+    (return (&/T =members tag-type))))