- Added a ' (quote) macro that works like ` (backquote), without unquote or unquote splice working and not automatic prefixing of unprefixed symbols/tags.

- Added (slightly) better type-error messages.

3 files changed, 137 insertions, 50 deletions

diff --git a/input/lux.lux b/input/lux.lux
index de407bafe..2bad33439 100644
--- a/input/lux.lux
+++ b/input/lux.lux
@@ -791,48 +791,52 @@
     _
     (fail "Wrong syntax for $")))
 
-(def'' (splice untemplate tag elems)
-  (->' (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
-  (_lux_case (any? spliced? elems)
+(def'' (splice replace? untemplate tag elems)
+  (->' Bool (->' Syntax Syntax) Syntax ($' List Syntax) Syntax)
+  (_lux_case replace?
     true
-    (let [elems' (map (lambda [elem]
-                        (_lux_case elem
-                          (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))])
-                          spliced
-
-                          _
-                          (form$ (list (symbol$ ["" "_lux_:"])
-                                       (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "Syntax"])))))
-                                       (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list (untemplate elem)
-                                                                                        (tag$ ["lux" "Nil"])))))))))
-                      elems)]
-      (wrap-meta (form$ (list tag
-                              (form$ (list& (symbol$ ["lux" "$"])
-                                            (symbol$ ["lux" "list:++"])
-                                            elems'))))))
-
+    (_lux_case (any? spliced? elems)
+      true
+      (let [elems' (map (lambda [elem]
+                          (_lux_case elem
+                            (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~@"])]) (#Cons [spliced #Nil])]))])
+                            spliced
+
+                            _
+                            (form$ (list (symbol$ ["" "_lux_:"])
+                                         (form$ (list (tag$ ["lux" "AppT"]) (tuple$ (list (symbol$ ["lux" "List"]) (symbol$ ["lux" "Syntax"])))))
+                                         (form$ (list (tag$ ["lux" "Cons"]) (tuple$ (list (untemplate elem)
+                                                                                          (tag$ ["lux" "Nil"])))))))))
+                        elems)]
+        (wrap-meta (form$ (list tag
+                                (form$ (list& (symbol$ ["lux" "$"])
+                                              (symbol$ ["lux" "list:++"])
+                                              elems'))))))
+
+      false
+      (wrap-meta (form$ (list tag (untemplate-list (map untemplate elems))))))
     false
     (wrap-meta (form$ (list tag (untemplate-list (map untemplate elems)))))))
 
-(def'' (untemplate subst token)
-  (->' Text Syntax Syntax)
-  (_lux_case token
-    (#Meta [_ (#BoolS value)])
+(def'' (untemplate replace? subst token)
+  (->' Bool Text Syntax Syntax)
+  (_lux_case (_lux_: (#TupleT (list Bool Syntax)) [replace? token])
+    [_ (#Meta [_ (#BoolS value)])]
     (wrap-meta (form$ (list (tag$ ["lux" "BoolS"]) (_meta (#BoolS value)))))
 
-    (#Meta [_ (#IntS value)])
+    [_ (#Meta [_ (#IntS value)])]
     (wrap-meta (form$ (list (tag$ ["lux" "IntS"]) (_meta (#IntS value)))))
 
-    (#Meta [_ (#RealS value)])
+    [_ (#Meta [_ (#RealS value)])]
     (wrap-meta (form$ (list (tag$ ["lux" "RealS"]) (_meta (#RealS value)))))
 
-    (#Meta [_ (#CharS value)])
+    [_ (#Meta [_ (#CharS value)])]
     (wrap-meta (form$ (list (tag$ ["lux" "CharS"]) (_meta (#CharS value)))))
 
-    (#Meta [_ (#TextS value)])
+    [_ (#Meta [_ (#TextS value)])]
     (wrap-meta (form$ (list (tag$ ["lux" "TextS"]) (_meta (#TextS value)))))
 
-    (#Meta [_ (#TagS [module name])])
+    [_ (#Meta [_ (#TagS [module name])])]
     (let [module' (_lux_case module
                     ""
                     subst
@@ -841,7 +845,7 @@
                     module)]
       (wrap-meta (form$ (list (tag$ ["lux" "TagS"]) (tuple$ (list (text$ module') (text$ name)))))))
 
-    (#Meta [_ (#SymbolS [module name])])
+    [_ (#Meta [_ (#SymbolS [module name])])]
     (let [module' (_lux_case module
                     ""
                     subst
@@ -850,32 +854,40 @@
                     module)]
       (wrap-meta (form$ (list (tag$ ["lux" "SymbolS"]) (tuple$ (list (text$ module') (text$ name)))))))
 
-    (#Meta [_ (#TupleS elems)])
-    (splice (untemplate subst) (tag$ ["lux" "TupleS"]) elems)
+    [_ (#Meta [_ (#TupleS elems)])]
+    (splice (untemplate replace? subst) (tag$ ["lux" "TupleS"]) elems)
 
-    (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])
+    [true (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])]
     unquoted
 
-    (#Meta [_ (#FormS elems)])
-    (splice (untemplate subst) (tag$ ["lux" "FormS"]) elems)
+    [_ (#Meta [_ (#FormS elems)])]
+    (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)
 
-    (#Meta [_ (#RecordS fields)])
+    [_ (#Meta [_ (#RecordS fields)])]
     (wrap-meta (form$ (list (tag$ ["lux" "RecordS"])
                             (untemplate-list (map (_lux_: (->' (#TupleT (list Syntax Syntax)) Syntax)
                                                           (lambda [kv]
                                                             (let [[k v] kv]
-                                                              (tuple$ (list (untemplate subst k) (untemplate subst v))))))
+                                                              (tuple$ (list (untemplate replace? subst k) (untemplate replace? subst v))))))
                                                   fields)))))
     ))
 
 (defmacro (`' tokens)
   (_lux_case tokens
     (#Cons [template #Nil])
-    (return (list (untemplate "" template)))
+    (return (list (untemplate true "" template)))
 
     _
     (fail "Wrong syntax for `'")))
 
+(defmacro (' tokens)
+  (_lux_case tokens
+    (#Cons [template #Nil])
+    (return (list (untemplate false "" template)))
+
+    _
+    (fail "Wrong syntax for '")))
+
 (defmacro #export (|> tokens)
   (_lux_case tokens
     (#Cons [init apps])
@@ -1648,7 +1660,7 @@
     [module-name get-module-name]
     (case tokens
       (\ (list template))
-      (;return (list (untemplate module-name template)))
+      (;return (list (untemplate true module-name template)))
 
       _
       (fail "Wrong syntax for `"))))
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 6efe7fd5f..6dfa234bd 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -77,7 +77,7 @@
             (return (&/T (&/V "TupleTestAC" =tests) =kont))))
 
         [_]
-        (fail "[Analyser Error] Tuples require tuple-type."))
+        (fail (str "[Analyser Error] Tuples require tuple-types: " (&type/show-type value-type))))
 
       [["lux;RecordS" ?slots]]
       (|do [value-type* (resolve-type value-type)]
diff --git a/src/lux/type.clj b/src/lux/type.clj
index e7d6353e8..c3a27ce2b 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -338,6 +338,15 @@
     [_]
     (fail (str "[Type Error] Not type-var: " (show-type tvar)))))
 
+(defn ^:private unravel-app [fun-type]
+  (matchv ::M/objects [fun-type]
+    [["lux;AppT" [?left ?right]]]
+    (|let [[?fun-type ?args] (unravel-app ?left)]
+      (&/T ?fun-type (&/|++ ?args (&/|list ?right))))
+
+    [_]
+    (&/T fun-type (&/|list))))
+
 (defn show-type [^objects type]
   (matchv ::M/objects [type]
     [["lux;DataT" name]]
@@ -384,23 +393,89 @@
     [["lux;ExT" ?id]]
     (str "⟨" ?id "⟩")
 
-    [["lux;AppT" [?lambda ?param]]]
-    (str "(" (show-type ?lambda) " " (show-type ?param) ")")
+    [["lux;AppT" [_ _]]]
+    (|let [[?call-fun ?call-args] (unravel-app type)]
+      (str "(" (show-type ?call-fun) " " (->> ?call-args (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")"))
     
     [["lux;AllT" [?env ?name ?arg ?body]]]
-    (let [[args body] (loop [args (list ?arg)
-                             body* ?body]
-                        (matchv ::M/objects [body*]
-                          [["lux;AllT" [?env* ?name* ?arg* ?body*]]]
-                          (recur (cons ?arg* args) ?body*)
-
-                          [_]
-                          [args body*]))]
-      (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")"))
+    (if (= "" ?name)
+      (let [[args body] (loop [args (list ?arg)
+                               body* ?body]
+                          (matchv ::M/objects [body*]
+                            [["lux;AllT" [?env* ?name* ?arg* ?body*]]]
+                            (recur (cons ?arg* args) ?body*)
+
+                            [_]
+                            [args body*]))]
+        (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")"))
+      ?name)
 
     [_]
     (assert false (prn-str 'show-type (aget type 0) (class (aget type 1))))
     ))
+;; (defn show-type [^objects type]
+;;   (matchv ::M/objects [type]
+;;     [["lux;DataT" name]]
+;;     (str "(^ " name ")")
+    
+;;     [["lux;TupleT" elems]]
+;;     (if (&/|empty? elems)
+;;       "(,)"
+;;       (str "(, " (->> elems (&/|map show-type) (&/|interpose " ") (&/fold str "")) ")"))
+
+;;     [["lux;VariantT" cases]]
+;;     (if (&/|empty? cases)
+;;       "(|)"
+;;       (str "(| " (->> cases
+;;                       (&/|map (fn [kv]
+;;                                 (matchv ::M/objects [kv]
+;;                                   [[k ["lux;TupleT" ["lux;Nil" _]]]]
+;;                                   (str "#" k)
+
+;;                                   [[k v]]
+;;                                   (str "(#" k " " (show-type v) ")"))))
+;;                       (&/|interpose " ")
+;;                       (&/fold str "")) ")"))
+    
+
+;;     [["lux;RecordT" fields]]
+;;     (str "(& " (->> fields
+;;                     (&/|map (fn [kv]
+;;                               (matchv ::M/objects [kv]
+;;                                 [[k v]]
+;;                                 (str "#" k " " (show-type v)))))
+;;                     (&/|interpose " ")
+;;                     (&/fold str "")) ")")
+
+;;     [["lux;LambdaT" [input output]]]
+;;     (str "(-> " (show-type input) " " (show-type output) ")")
+
+;;     [["lux;VarT" id]]
+;;     (str "⌈" id "⌋")
+
+;;     [["lux;BoundT" name]]
+;;     name
+
+;;     [["lux;ExT" ?id]]
+;;     (str "⟨" ?id "⟩")
+
+;;     [["lux;AppT" [?lambda ?param]]]
+;;     (str "(" (show-type ?lambda) " " (show-type ?param) ")")
+    
+;;     [["lux;AllT" [?env ?name ?arg ?body]]]
+;;     (let [[args body] (loop [args (list ?arg)
+;;                              body* ?body]
+;;                         (matchv ::M/objects [body*]
+;;                           [["lux;AllT" [?env* ?name* ?arg* ?body*]]]
+;;                           (recur (cons ?arg* args) ?body*)
+
+;;                           [_]
+;;                           [args body*]))]
+;;       (str "(All " ?name " [" (->> args reverse (interpose " ") (reduce str "")) "] " (show-type body) ")"))
+
+;;     [_]
+;;     (assert false (prn-str 'show-type (aget type 0) (class (aget type 1))))
+;;     ))
 
 (defn type= [x y]
   (or (clojure.lang.Util/identical x y)