aboutsummaryrefslogtreecommitdiff
path: root/src/lang
diff options
context:
space:
mode:
authorEduardo Julian2014-12-26 14:36:22 -0400
committerEduardo Julian2014-12-26 14:36:22 -0400
commit6eebd55535254e82230ce0ad11f7eb8b7907a9ca (patch)
tree94d41dcbd2ce7e548faf26a6193e46d4727201a4 /src/lang
parentdb3fecf46f602320b48e7ce82ee770a46bba7ba6 (diff)
Added string testing & multi-branching to pattern-matching.
Diffstat (limited to '')
-rw-r--r--src/lang/analyser.clj5
-rw-r--r--src/lang/compiler.clj25
2 files changed, 25 insertions, 5 deletions
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)))