- Separated type coercions from type annotations.

- Enriched type annotatins.
- Improved class->type convertions.
- Improved showing AST.

10 files changed, 95 insertions, 45 deletions

diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj
index 664ba4450..2e431770a 100644
--- a/src/lux/analyser/base.clj
+++ b/src/lux/analyser/base.clj
@@ -22,6 +22,7 @@
    "case"
    "lambda"
    "ann"
+   "coerce"
    "def"
    "declare-macro"
    "var"
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index ca4e0edeb..f19a33acc 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -112,7 +112,7 @@
     (adjust-type* up ?type)
 
     _
-    (assert false (prn-str 'adjust-type* (&type/show-type type)))
+    (fail (str "[Pattern-matching Error] Can't adjust type: " (&type/show-type type)))
     ))
 
 (defn adjust-type [type]
@@ -161,7 +161,7 @@
         (|case value-type*
           (&/$TupleT ?member-types)
           (if (not (.equals ^Object (&/|length ?member-types) (&/|length ?members)))
-            (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]"))
+            (fail (str "[Pattern-matching Error] Pattern-matching mismatch. Require tuple[" (&/|length ?member-types) "]. Given tuple [" (&/|length ?members) "]" " -- " (&/show-ast pattern)))
             (|do [[=tests =kont] (&/fold (fn [kont* vm]
                                            (|let [[v m] vm]
                                              (|do [[=test [=tests =kont]] (analyse-pattern v m kont*)]
@@ -172,7 +172,7 @@
               (return (&/T (&/V $TupleTestAC =tests) =kont))))
 
           _
-          (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*)))))
+          (fail (str "[Pattern-matching Error] Tuples require tuple-types: " (&type/show-type value-type*) " -- " (&/show-ast pattern)))))
       
       (&/$RecordS pairs)
       (|do [[rec-members rec-type] (&&record/order-record pairs)]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index e938fa343..6d7551ac0 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -524,15 +524,18 @@
         _cursor &/cursor
         ]
     (return (&/|list (&&/|meta ==type _cursor
-                               (&/V &&/$ann (&/T =value =type))
+                               (&/V &&/$ann (&/T =value =type ==type))
                                )))))
 
 (defn analyse-coerce [analyse eval! exo-type ?type ?value]
   (|do [=type (&&/analyse-1 analyse &type/Type ?type)
         ==type (eval! =type)
         _ (&type/check exo-type ==type)
+        ;; :let [_ (prn 'analyse-coerce/_0 (&/show-ast ?value) (&type/show-type ==type))]
         =value (&&/analyse-1+ analyse ?value)
+        ;; =value (&&/analyse-1* analyse ?value)
+        ;; :let [_ (prn 'analyse-coerce/_1 (&/show-ast ?value) (&type/show-type ==type))]
         _cursor &/cursor]
     (return (&/|list (&&/|meta ==type _cursor
-                               (&/V &&/$ann (&/T =value =type))
+                               (&/V &&/$coerce (&/T =value =type ==type))
                                )))))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index e9b8896bf..3abb3e363 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -815,7 +815,9 @@
     (str "\"" ?value "\"")
 
     [_ ($TagS ?module ?tag)]
-    (str "#" ?module ";" ?tag)
+    (if (.equals "" ?module)
+      (str "#" ?tag)
+      (str "#" ?module ";" ?tag))
 
     [_ ($SymbolS ?module ?name)]
     (if (.equals "" ?module)
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 3052ead09..e095a3547 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -86,8 +86,11 @@
         (&a/$lambda ?scope ?env ?body)
         (&&lambda/compile-lambda compile-expression ?scope ?env ?body)
 
-        (&a/$ann ?value-ex ?type-ex)
-        (&&lux/compile-ann compile-expression ?value-ex ?type-ex)
+        (&a/$ann ?value-ex ?type-ex ?value-type)
+        (&&lux/compile-ann compile-expression ?value-ex ?type-ex ?value-type)
+
+        (&a/$coerce ?value-ex ?type-ex ?value-type)
+        (&&lux/compile-coerce compile-expression ?value-ex ?type-ex ?value-type)
 
         ;; Characters
         (&a/$jvm-ceq ?x ?y)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 1cefef555..6b05f0c8a 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -353,7 +353,7 @@
 (defn compile-jvm-arraylength [compile ?array]
   (|do [^MethodVisitor *writer* &/get-writer
         _ (compile ?array)
-        :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
+        ;; :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST "[Ljava/lang/Object;")]
         :let [_ (doto *writer*
                   (.visitInsn Opcodes/ARRAYLENGTH)
                   (.visitInsn Opcodes/I2L)
diff --git a/src/lux/compiler/io.clj b/src/lux/compiler/io.clj
index bc6fa854d..fbef27b0f 100644
--- a/src/lux/compiler/io.clj
+++ b/src/lux/compiler/io.clj
@@ -26,4 +26,5 @@
             (init-libs!))
         (if-let [code (get @!libs file-name)]
           (return code)
-          (fail (str "[I/O Error] File doesn't exist: " file-name)))))))
+          (fail (str "[I/O Error] File doesn't exist: " file-name))))
+      )))
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index ef80d89aa..a2dc3fe73 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -138,7 +138,7 @@
 
       "value"
       (|let [?def-type (|case ?body
-                         [[?def-type ?def-cursor] (&a/$ann ?def-value ?type-expr)]
+                         [[?def-type ?def-cursor] (&a/$ann ?def-value ?type-expr ?def-value-type)]
                          ?type-expr
 
                          [[?def-type ?def-cursor] ?def-value]
@@ -215,9 +215,28 @@
           _ (&a-module/define module-name ?name (-> def-class (.getField &/meta-field) (.get nil)) =value-type)]
       (return nil))))
 
-(defn compile-ann [compile ?value-ex ?type-ex]
+(defn check-cast [type]
+  "(-> Type (Lux (,)))"
+  (|do [^MethodVisitor writer &/get-writer]
+    (let [^String type-class* (&host/->java-sig type)
+          type-class (cond (.startsWith type-class* "[")
+                           type-class*
+                           
+                           (.endsWith type-class* ";")
+                           (.substring type-class* 1 (- (.length type-class*) 1))
+
+                           :else
+                           type-class*)
+          _ (.visitTypeInsn writer Opcodes/CHECKCAST type-class)]
+      (return nil))))
+
+(defn compile-ann [compile ?value-ex ?type-ex ?value-type]
   (compile ?value-ex))
 
+(defn compile-coerce [compile ?value-ex ?type-ex ?value-type]
+  (|do [_ (compile ?value-ex)]
+    (check-cast ?value-type)))
+
 (defn compile-declare-macro [compile module name]
   (|do [_ (&a-module/declare-macro module name)]
     (return nil)))
diff --git a/src/lux/host.clj b/src/lux/host.clj
index c58698bb3..12af574fb 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -67,34 +67,41 @@
     _
     (&/T 0 type)))
 
-(defn ->java-sig [^objects type]
-  "(-> Type Text)"
-  (|case type
-    (&/$DataT ?name params)
-    (cond (= &host-type/array-data-tag ?name) (|let [[level base] (unfold-array type)
-                                                     base-sig (|case base
-                                                                (&/$DataT base-class _)
-                                                                (->class base-class)
-
-                                                                _
-                                                                (->java-sig base))]
-                                                (str (->> (&/|repeat level "[") (&/fold str ""))
-                                                     "L" base-sig ";"))
-          (= &host-type/null-data-tag ?name)  (->type-signature "java.lang.Object")
-          :else                    (->type-signature ?name))
-
-    (&/$LambdaT _ _)
-    (->type-signature function-class)
-
-    (&/$TupleT (&/$Nil))
-    "V"
-
-    (&/$NamedT ?name ?type)
-    (->java-sig ?type)
-
-    _
-    (assert false (str '->java-sig " " (&type/show-type type)))
-    ))
+(let [object-array (str "[" "L" (->class "java.lang.Object") ";")]
+  (defn ->java-sig [^objects type]
+    "(-> Type Text)"
+    (|case type
+      (&/$DataT ?name params)
+      (cond (= &host-type/array-data-tag ?name) (|let [[level base] (unfold-array type)
+                                                       base-sig (|case base
+                                                                  (&/$DataT base-class _)
+                                                                  (->type-signature base-class)
+
+                                                                  _
+                                                                  (->java-sig base))]
+                                                  (str (->> (&/|repeat level "[") (&/fold str ""))
+                                                       base-sig))
+            (= &host-type/null-data-tag ?name)  (->type-signature "java.lang.Object")
+            :else                    (->type-signature ?name))
+
+      (&/$LambdaT _ _)
+      (->type-signature function-class)
+
+      (&/$TupleT (&/$Nil))
+      "V"
+
+      (&/$VariantT _)
+      object-array
+
+      (&/$TupleT _)
+      object-array
+
+      (&/$NamedT ?name ?type)
+      (->java-sig ?type)
+
+      _
+      (assert false (str '->java-sig " " (&type/show-type type)))
+      )))
 
 (do-template [<name> <static?>]
   (defn <name> [class-loader target field]
diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj
index 38acf8162..9d83e0b58 100644
--- a/src/lux/type/host.clj
+++ b/src/lux/type/host.clj
@@ -64,19 +64,33 @@
     (&/fold2 matcher (&/|table) sub-type-params params)))
 
 ;; [Exports]
-(let [class-name-re #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+))"
-      Unit (&/V &/$TupleT (&/|list))]
+(let [class-name-re #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+)|(\[+)([ZBSIJFDC]))"
+      Unit (&/V &/$TupleT (&/|list))
+      jprim->lprim (fn [prim]
+                     (case prim
+                       "Z" "boolean"
+                       "B" "byte"
+                       "S" "short"
+                       "I" "int"
+                       "J" "long"
+                       "F" "float"
+                       "D" "double"
+                       "C" "char"))]
   (defn class->type [^Class class]
     "(-> Class Type)"
-    (if-let [[_ _ arr-brackets arr-base simple-base] (re-find class-name-re (.getName class))]
-      (let [base (or arr-base simple-base)]
+    (if-let [[_ _ arr-obrackets arr-obase simple-base arr-pbrackets arr-pbase] (re-find class-name-re (.getName class))]
+      (let [base (or arr-obase simple-base (jprim->lprim arr-pbase))]
         (if (.equals "void" base)
           Unit
           (reduce (fn [inner _] (&/V &/$DataT (&/T array-data-tag (&/|list inner))))
                   (&/V &/$DataT (&/T base &/Nil$))
-                  (range (count (or arr-brackets "")))))
+                  (range (count (or arr-obrackets arr-pbrackets "")))))
         ))))
 
+;; (-> String (.getMethod "getBytes" (into-array Class [])) .getReturnType)
+;; (-> String (.getMethod "getBytes" (into-array Class [])) ^Class (.getGenericReturnType)
+;;     .getName (->> (re-find #"((\[+)L([\.a-zA-Z0-9]+);|([\.a-zA-Z0-9]+)|(\[+)([ZBSIJFDC]))")))
+
 (defn instance-param [existential matchings refl-type]
   "(-> (List (, Text Type)) (^ java.lang.reflect.Type) (Lux Type))"
   (cond (instance? Class refl-type)