diff options
| author | Eduardo Julian | 2015-03-01 18:15:48 -0400 | 
|---|---|---|
| committer | Eduardo Julian | 2015-03-01 18:15:48 -0400 | 
| commit | f5b2f04fec382da0d164f772ed65ae058e66d8e2 (patch) | |
| tree | c88a2d2ab7515c8dfeea7967719eadd2de31f09d /src | |
| parent | 2caf39ea09ae96669466e0e17fd2949347acda7a (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 '')
| -rw-r--r-- | src/lux.clj | 2 | ||||
| -rw-r--r-- | src/lux/analyser.clj | 5 | ||||
| -rw-r--r-- | src/lux/compiler/case.clj | 19 | 
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))) | 
