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/example/test1.lang   |  7 +++++++
 src/lang/compiler.clj    | 23 +++++++++++++++++++++++
 src/lang/interpreter.clj | 21 ++++++++++++++-------
 src/lang/parser.clj      | 12 ++++++++++++
 4 files changed, 56 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/example/test1.lang b/src/example/test1.lang
index da3d3fa87..43f3111fa 100644
--- a/src/example/test1.lang
+++ b/src/example/test1.lang
@@ -7,3 +7,10 @@
     (#Cons [val (repeat (-' n 1) val)])))
 
 (repeat 5 5)
+
+(def (fold f init inputs)
+  (case inputs
+    (#Nil [])            init
+    (#Cons [head tail]) (fold f (f init head) tail)))
+
+(fold * 1 (repeat 5 5))
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]))
diff --git a/src/lang/interpreter.clj b/src/lang/interpreter.clj
index 19fe71106..ba370ac2e 100644
--- a/src/lang/interpreter.clj
+++ b/src/lang/interpreter.clj
@@ -63,7 +63,8 @@
              ;; (prn "output#" output#)
              output#)
            _#
-           (fail* (str "Unknown syntax: " (pr-str ~'*token*))))))))
+           (do ;; (println "Unknown syntax: " (pr-str ~'*token*))
+             (fail* (str "Unknown syntax: " (pr-str ~'*token*)))))))))
 
 (defeval eval-ident
   [::&parser/ident ?ident]
@@ -103,8 +104,11 @@
   [::&parser/fn-call ?fn ?args]
   (exec [state &util/get-state
          =fn (apply-m eval-form (wrap-in state ?fn))
-         =args (map-m (fn [arg] (apply-m eval-form (wrap arg)))
-                      ?args)]
+         ;; :let [_ (prn '=fn ?fn =fn)]
+         =args (map-m (fn [arg] (apply-m eval-form (wrap-in state arg)))
+                      ?args)
+         ;; :let [_ (prn '=args =args)]
+         ]
     (fn-call =fn =args)))
 
 (def eval-form
@@ -133,13 +137,14 @@
 (comment
   (let [source-code (slurp "src/example/test1.lang")
         tokens (&lexer/lex source-code)
-        _ (prn 'tokens tokens)
+        ;; _ (prn 'tokens tokens)
         syntax (&parser/parse tokens)
-        _ (prn 'syntax syntax)]
+        ;; _ (prn 'syntax syntax)
+        ]
     (eval (update-in +state+ [:forms] concat syntax)))
 
   
-
+  
   
 
   ;; (clojure.core/fn [base exp] (fold * 1 (repeat exp base)))
@@ -163,5 +168,7 @@
   ;; (def (** base exp)
   ;;   (fold * 1 (repeat exp base)))
 
-  
+  ;; Syntax for single-line comments ##
+  ;; Syntax for multi-line comments #( YOLO )#
+  ;; Syntax for chars: #"a"
   )
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index 985a17861..53f60941d 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -57,6 +57,17 @@
          =else (apply-m parse-form (list ?else))]
     (return [::if =test =then =else])))
 
+(defparser ^:private parse-case
+  [::&lexer/list ([[::&lexer/ident "case"] ?variant & cases] :seq)]
+  (exec [=variant (apply-m parse-form (list ?variant))
+         =branches (do (assert (even? (count cases)))
+                     (map-m (fn [[destruct expr]]
+                              (exec [=destruct (apply-m parse-form (list destruct))
+                                     =expr (apply-m parse-form (list expr))]
+                                (return [::case-branch =destruct =expr])))
+                            (partition 2 cases)))]
+    (return [::case =variant =branches])))
+
 (defparser ^:private parse-tagged
   [::&lexer/list ([[::&lexer/tag ?tag] ?data] :seq)]
   (exec [=data (apply-m parse-form (list ?data))]
@@ -76,6 +87,7 @@
               parse-def
               parse-defdata
               parse-if
+              parse-case
               parse-tagged
               parse-fn-call]))
 
-- 
cgit v1.2.3