diff options
Diffstat (limited to 'src/lang/compiler.clj')
| -rw-r--r-- | src/lang/compiler.clj | 23 |
1 files changed, 23 insertions, 0 deletions
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj index 21ef925b5..f189e8d25 100644 --- a/src/lang/compiler.clj +++ b/src/lang/compiler.clj @@ -81,6 +81,28 @@ =else (apply-m compile-form (wrap ?else))] (return `(if ~=test ~=then ~=else)))) +(defcompiler compile-case-branch + [::&parser/case-branch [::&parser/tagged ?tag [::&parser/tuple ?bindings]] ?expr] + (exec [:let [=bindings (map (comp symbol unwrap-ident) ?bindings) + fn-env (into {} (for [a =bindings] [a nil]))] + =expr (apply-m compile-form (wrap* fn-env ?expr))] + (return [?tag =bindings =expr]))) + +(defcompiler compile-case + [::&parser/case ?variant ?branches] + (exec [=variant (apply-m compile-form (wrap ?variant)) + =branches (map-m #(apply-m compile-case-branch (wrap %)) + ?branches) + :let [g!variant (gensym "variant") + =case `(let [~g!variant ~=variant] + (case (:tag ~g!variant) + ~@(apply concat (for [[tag bindings expr] =branches] + [tag `(let [~(vec bindings) (:data ~g!variant)] + ~expr)])))) + ;; _ (prn '=case =case) + ]] + (return =case))) + (defcompiler compile-def [::&parser/def ?form ?body] (match ?form @@ -117,6 +139,7 @@ compile-tuple compile-tagged compile-if + compile-case compile-def compile-defdata compile-fn-call])) |