From 6eebd55535254e82230ce0ad11f7eb8b7907a9ca Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 26 Dec 2014 14:36:22 -0400
Subject: Added string testing & multi-branching to pattern-matching.

---
 src/lang/analyser.clj |  5 +++++
 src/lang/compiler.clj | 25 ++++++++++++++++++++-----
 2 files changed, 25 insertions(+), 5 deletions(-)

(limited to 'src/lang')

diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index 64bdbac9b..72ea43e69 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -452,6 +452,11 @@
                                                                                                                             (assoc locals-map ?name ?local)
                                                                                                                             (conj =members (:form ?local))])
 
+                                                                                                                   [::&parser/string ?text]
+                                                                                                                   (return [?inner-num
+                                                                                                                            locals-map
+                                                                                                                            (conj =members [::match-text ?text])])
+
                                                                                                                    [::&parser/variant ?subtag ?submembers]
                                                                                                                    (let [num-submembers (count ?submembers)]
                                                                                                                      (with-anon-locals num-submembers
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index f26d111a4..c6c75558e 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -315,17 +315,32 @@
                         (let [tuple-class (str "test2/Tuple" (count ?members))
                               mk-sub-fold (fn mk-sub-fold [cleanup-level default-label tuple-class]
                                             (fn sub-fold [?tfield member]
-                                              (let [next-label (new Label)]
+                                              (let [next-label (new Label)
+                                                    cleanup-label (new Label)]
                                                 (match member
                                                   [::&analyser/local 0 ?idx]
                                                   (doto *writer*
                                                     (.visitInsn Opcodes/DUP)
                                                     (.visitFieldInsn Opcodes/GETFIELD tuple-class (str "_" ?tfield) (->type-signature "java.lang.Object"))
-                                                    (.visitVarInsn Opcodes/ASTORE ?idx))
+                                                    (.visitVarInsn Opcodes/ASTORE ?idx)
+                                                    (.visitLabel next-label))
+
+                                                  [::&analyser/match-text ?text]
+                                                  (doto *writer*
+                                                    (.visitInsn Opcodes/DUP)
+                                                    (.visitFieldInsn Opcodes/GETFIELD tuple-class (str "_" ?tfield) (->type-signature "java.lang.Object"))
+                                                    (.visitLdcInsn ?text)
+                                                    (.visitMethodInsn Opcodes/INVOKEVIRTUAL oclass "equals" equals-sig)
+                                                    (.visitJumpInsn Opcodes/IFEQ cleanup-label)
+                                                    (.visitJumpInsn Opcodes/GOTO next-label)
+                                                    (.visitLabel cleanup-label)
+                                                    (-> (doto (.visitInsn Opcodes/POP))
+                                                        (->> (dotimes [_ cleanup-level])))
+                                                    (.visitJumpInsn Opcodes/GOTO default-label)
+                                                    (.visitLabel next-label))
 
                                                   [::&analyser/subcase ?subtag ?submembers]
-                                                  (let [tuple-class* (str "test2/Tuple" (count ?submembers))
-                                                        cleanup-label (new Label)]
+                                                  (let [tuple-class* (str "test2/Tuple" (count ?submembers))]
                                                     (doto *writer*
                                                       (.visitInsn Opcodes/DUP)
                                                       (.visitFieldInsn Opcodes/GETFIELD tuple-class (str "_" ?tfield) (->type-signature "java.lang.Object"))
@@ -352,7 +367,7 @@
                             (.visitVarInsn Opcodes/ALOAD ?base-idx)
                             (.visitFieldInsn Opcodes/GETFIELD variant-class* "value" (->type-signature "java.lang.Object"))
                             (.visitTypeInsn Opcodes/CHECKCAST tuple-class))
-                          (dorun (map (mk-sub-fold 1 default-label tuple-class)
+                          (dorun (map (mk-sub-fold 1 else-label tuple-class)
                                       (range (count ?members))
                                       ?members))
                           (.visitInsn *writer* Opcodes/POP)))
-- 
cgit v1.2.3