From 1a2b6841604558266f2cbf5bcf1373ea257183c9 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 27 Nov 2014 02:03:19 -0400
Subject: + Added some very basic pattern-matching with destructuring.

---
 src/lang/compiler.clj | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

(limited to 'src/lang/compiler.clj')

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]))
-- 
cgit v1.2.3