From f5b2f04fec382da0d164f772ed65ae058e66d8e2 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 1 Mar 2015 18:15:48 -0400
Subject: [TODO] - For some reason, when I fail at compilation due to mistaken
 use of tags/variants, I don't get the right error reported. [Fixes] - Solved
 a problem where stack values weren't being properly cleaned-up when
 pattern-matching on variants and branch bodies.

---
 src/lux.clj               |  2 ++
 src/lux/analyser.clj      |  5 ++++-
 src/lux/compiler/case.clj | 19 +++++++++----------
 3 files changed, 15 insertions(+), 11 deletions(-)

(limited to 'src')

diff --git a/src/lux.clj b/src/lux.clj
index ccab7ec3f..53bc115f8 100644
--- a/src/lux.clj
+++ b/src/lux.clj
@@ -27,3 +27,5 @@
   )
 
 
+
+
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index e46d424f2..115d21d6f 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -163,9 +163,12 @@
     (fail (str "[Analyser Error] Unmatched token: " (pr-str token)))))
 
 (defn ^:private analyse-ast [token]
+  ;; (prn 'analyse-ast token)
   (match token
     [::&parser/Form ([[::&parser/Tag ?tag] & ?values] :seq)]
-    (exec [_ (assert! (= 1 (count ?values)) "[Analyser Error] Can only tag 1 value.")
+    (exec [:let [_ (prn 'PRE-ASSERT)]
+           :let [_ (assert (= 1 (count ?values)) "[Analyser Error] Can only tag 1 value.")]
+           :let [_ (prn 'POST-ASSERT)]
            :let [?value (first ?values)]
            =value (&&/analyse-1 analyse-ast ?value)
            =value-type (&&/expr-type =value)]
diff --git a/src/lux/compiler/case.clj b/src/lux/compiler/case.clj
index 593a85d34..b0a8a8ea6 100644
--- a/src/lux/compiler/case.clj
+++ b/src/lux/compiler/case.clj
@@ -149,11 +149,15 @@
         (.visitJumpInsn Opcodes/IFEQ $else)
         (.visitInsn Opcodes/DUP)
         (.visitFieldInsn Opcodes/GETFIELD +variant-class+ "value" +variant-value-sig+)
-        (-> (doto (compile-match ?value $target $value-else)
+        (-> (doto (compile-match ?value $value-then $value-else)
+              (.visitLabel $value-then)
+              (.visitInsn Opcodes/POP)
+              (.visitJumpInsn Opcodes/GOTO $target)
               (.visitLabel $value-else)
               (.visitInsn Opcodes/POP)
               (.visitJumpInsn Opcodes/GOTO $else))
-            (->> (let [$value-else (new Label)]))))
+            (->> (let [$value-then (new Label)
+                       $value-else (new Label)]))))
       )))
 
 (let [ex-class (&host/->class "java.lang.IllegalStateException")]
@@ -176,8 +180,7 @@
         (.visitMethodInsn Opcodes/INVOKESPECIAL ex-class "<init>" "()V")
         (.visitInsn Opcodes/ATHROW))
       (map-m (fn [[?label ?body]]
-               (exec [:let [_ (do (.visitLabel writer ?label)
-                                (.visitInsn writer Opcodes/POP))]
+               (exec [:let [_ (.visitLabel writer ?label)]
                       ret (compile ?body)
                       :let [_ (.visitJumpInsn writer Opcodes/GOTO $end)]]
                  (return ret)))
@@ -191,14 +194,10 @@
                $end (new Label)
                _ (dotimes [offset ?num-registers]
                    (let [idx (+ ?base-register offset)]
-                     (.visitLocalVariable *writer* (str &&/local-prefix idx) (&host/->java-sig [::&type/Any]) nil $start $end idx)))]
+                     (.visitLocalVariable *writer* (str &&/local-prefix idx) (&host/->java-sig [::&type/Any]) nil $start $end idx)))
+               _ (.visitLabel *writer* $start)]
          _ (compile ?variant)
-         :let [_ (doto *writer*
-                   (.visitInsn Opcodes/DUP)
-                   (.visitLabel $start))]
-         ;; :let [_ (prn "PRE Compiled ?branches")]
          :let [[mappings patterns] (process-branches ?base-register ?branches)]
          _ (compile-pattern-matching *writer* compile mappings patterns $end)
-         ;; :let [_ (prn "POST Compiled ?branches")]
          :let [_ (.visitLabel *writer* $end)]]
     (return nil)))
-- 
cgit v1.2.3