From eb424eeb33d8fc9bb7ad2acda0c58fcb037717d3 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 14 Jul 2015 22:47:10 -0400
Subject: - 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.

---
 src/lux/analyser/case.clj |  2 +-
 src/lux/type.clj          | 97 +++++++++++++++++++++++++++++++++++++++++------
 2 files changed, 87 insertions(+), 12 deletions(-)

(limited to 'src')

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)
-- 
cgit v1.2.3