aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorEduardo Julian2015-03-01 18:15:48 -0400
committerEduardo Julian2015-03-01 18:15:48 -0400
commitf5b2f04fec382da0d164f772ed65ae058e66d8e2 (patch)
treec88a2d2ab7515c8dfeea7967719eadd2de31f09d /src
parent2caf39ea09ae96669466e0e17fd2949347acda7a (diff)
[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.
Diffstat (limited to 'src')
-rw-r--r--src/lux.clj2
-rw-r--r--src/lux/analyser.clj5
-rw-r--r--src/lux/compiler/case.clj19
3 files changed, 15 insertions, 11 deletions
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)))