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. --- source/lux.lux | 62 ++++++++++++++--------------------------------- src/lux.clj | 2 ++ src/lux/analyser.clj | 5 +++- src/lux/compiler/case.clj | 19 +++++++-------- 4 files changed, 33 insertions(+), 55 deletions(-) diff --git a/source/lux.lux b/source/lux.lux index 03c2a6054..2882207d6 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -69,60 +69,34 @@ ))) (declare-macro lambda) -## (def' lambda -## (lambda' _ tokens -## (lambda' _ state -## (let' output (case' tokens -## (#Cons [(#Form (#Cons [self (#Cons [arg args'])])) (#Cons [body #Nil])]) -## (#Form (#Cons [(#Ident "lambda'") -## (#Cons [self -## (#Cons [arg -## (#Cons [(case' args' -## #Nil -## body - -## _ -## (#Form (#Cons [(#Ident "lux;lambda") -## (#Cons [(#Form (#Cons [(#Ident "_") args'])) -## (#Cons [body #Nil])])]))) -## #Nil])])])]))) -## [(#Cons [output #Nil]) state]) -## ))) - - -## (def' lambda -## (lambda' _ tokens -## (lambda' _ state -## (let' output (case' tokens -## (#Cons [(#Form (#Cons [self (#Cons [arg args'])])) (#Cons [body #Nil])]) -## (#Form (#Cons [(#Ident "lambda'") -## (#Cons [self -## (#Cons [arg -## (#Cons [(case args' -## #Nil -## body - -## _ -## (#Form (#Cons [(#Ident "lux;lambda") -## (#Cons [(#Form (#Cons [(#Ident "_") args'])) -## (#Cons [body #Nil])])]))) -## #Nil])])])]))) -## [(#Cons output #Nil) state]) -## ))) +(def' def + (lambda (_ tokens state) + (let' output (case' tokens + (#Cons [(#Ident name) (#Cons [body #Nil])]) + (#Form (#Cons [(#Ident "def'") tokens])) + + (#Cons [(#Form (#Cons [(#Ident name) args])) + (#Cons [body #Nil])]) + (#Form (#Cons [(#Ident "def'") + (#Cons [(#Ident name) + (#Cons [(#Form (#Cons [(#Ident "lux;lambda") + (#Cons [(#Form (#Cons [(#Ident name) args])) + (#Cons [body #Nil])])])) + #Nil])])]))) + [(#Cons [output #Nil]) state]))) +(declare-macro def) ## (def' def ## (lambda (_ tokens state) ## (let' output (case' tokens ## (#Cons (#Ident name) (#Cons body #Nil)) -## (#Form (#Cons (#Ident "def'") -## (#Cons (#Ident name) -## (#Cons body #Nil)))) +## (#Form (#Cons (#Ident "def'") tokens)) ## (#Cons (#Form (#Cons (#Ident name) args)) ## (#Cons body #Nil)) ## (#Form (#Cons (#Ident "def'") ## (#Cons (#Ident name) -## (#Cons (#Form (#Cons (#Ident "lux:lambda") +## (#Cons (#Form (#Cons (#Ident "lux;lambda") ## (#Cons (#Form (#Cons (#Ident name) args)) ## (#Cons body #Nil)))) ## #Nil))))) 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 "" "()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