From 37a9044d8ec523a282c0470d65380ce5cff27084 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 23 Aug 2015 20:27:51 -0400
Subject: - Restructuring how sums & products work [part 3]

---
 src/lux/analyser/case.clj | 11 ++++-------
 src/lux/analyser/lux.clj  | 22 +++++++++++++---------
 src/lux/type.clj          |  4 ++--
 3 files changed, 19 insertions(+), 18 deletions(-)

(limited to 'src')

diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index 212f02665..6bb767d3e 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -120,8 +120,8 @@
     (return ($$ &/P idx (&/|length group) case-type))))
 
 (defn ^:private analyse-pattern [value-type pattern kont]
-  (|let [[_ pattern*] pattern
-         ;; :let [_ (prn 'analyse-pattern (&/adt->text pattern*) (&type/show-type value-type))]
+  (|let [[meta pattern*] pattern
+         ;; _ (prn 'analyse-pattern (&/show-ast pattern) (&type/show-type value-type))
          ]
     (|case pattern*
       (&/$SymbolS "" name)
@@ -130,9 +130,6 @@
             idx &env/next-local-idx]
         (return (&/P (&/S $StoreTestAC idx) =kont)))
 
-      (&/$SymbolS ident)
-      (fail (str "[Pattern-matching Error] Symbols must be unqualified: " (&/ident->text ident)))
-
       (&/$BoolS ?value)
       (|do [_ (&type/check value-type &type/Bool)
             =kont kont]
@@ -176,7 +173,7 @@
                                                                                (fail "[Pattern-matching Error] Pattern-matching mismatch. Tuple has wrong size.")
 
                                                                                _
-                                                                               (analyse-pattern ?right (&/S &/$TupleS ?tail) kont))]
+                                                                               (analyse-pattern ?right (&/P meta (&/S &/$TupleS ?tail)) kont))]
                                                           (return (&/P =right =kont))))]
             (return (&/P (&/S $ProdTestAC (&/P =left =right)) =kont)))
 
@@ -185,7 +182,7 @@
       
       (&/$RecordS pairs)
       (|do [?members (&&record/order-record pairs)]
-        (analyse-pattern value-type (&/S &/$TupleS ?members) kont))
+        (analyse-pattern value-type (&/P meta (&/S &/$TupleS ?members)) kont))
 
       (&/$TagS ?ident)
       (|do [[idx group-count case-type] (resolve-tag ?ident value-type)
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index f7ed07ee4..20e435eb3 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -209,7 +209,11 @@
                                                  (&/|list))
                                             (&/|reverse inner) scopes)]
               ((|do [btype (&&/expr-type =local)
-                     _ (&type/check exo-type btype)]
+                     ;; :let [_ (prn 'analyse-local/_0 name)
+                     ;;       _ (prn 'analyse-local/_1 name (&type/show-type exo-type) (&type/show-type btype))]
+                     _ (&type/check exo-type btype)
+                     ;; :let [_ (prn 'analyse-local/_2 name 'CHECKED)]
+                     ]
                  (return (&/|list =local)))
                (&/$set-envs (&/|++ inner* outer) state))))
         ))))
@@ -273,14 +277,14 @@
                   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 (= "defsig" (aget real-name 1))
-                  ;;                   ;; (= "type" (aget real-name 1))
-                  ;;                   ;; (= &&/$struct r-name)
-                  ;;                   )
-                  ;;           (->> (&/|map &/show-ast macro-expansion)
-                  ;;                (&/|interpose "\n")
-                  ;;                (&/fold str "")
-                  ;;                (prn (&/ident->text real-name))))]
+                  :let [_ (when (or (= "using" (aget real-name 1))
+                                    ;; (= "type" (aget real-name 1))
+                                    ;; (= &&/$struct r-name)
+                                    )
+                            (->> (&/|map &/show-ast macro-expansion)
+                                 (&/|interpose "\n")
+                                 (&/fold str "")
+                                 (prn (&/ident->text real-name))))]
                   ]
               (&/flat-map% (partial analyse exo-type) macro-expansion))
 
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 91bc6e480..37f3a99d4 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -685,7 +685,7 @@
     (apply-type ?type param)
     
     _
-    (fail (str "[Type System] Not a type function:\n" (show-type type-fn) "\n"))))
+    (fail (str "[Type Error] Not a type function:\n" (show-type type-fn) "\n"))))
 
 (defn as-obj [class]
   (case class
@@ -947,7 +947,7 @@
     (apply-lambda ?type param)
 
     _
-    (fail (str "[Type System] Not a function type:\n" (show-type func) "\n"))
+    (fail (str "[Type Error] Not a function type:\n" (show-type func) "\n"))
     ))
 
 (defn actual-type [type]
-- 
cgit v1.2.3