aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/lang/analyser.clj5
-rw-r--r--src/lang/compiler.clj25
-rw-r--r--test2.lang7
3 files changed, 31 insertions, 6 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)))
diff --git a/test2.lang b/test2.lang
index 55d7a14af..73c6d206e 100644
--- a/test2.lang
+++ b/test2.lang
@@ -30,8 +30,13 @@
(if true
(let xs+ys (#Cons "Pattern" (#Cons "Matching" #Nil))
(case xs+ys
+ (#Cons "Pattern" (#Cons second #Nil))
+ (do (:: (:: System out) (println "Branch #1"))
+ (:: (:: System out) (println second)))
+
(#Cons first (#Cons second #Nil))
- (do (:: (:: System out) (println first))
+ (do (:: (:: System out) (println "Branch #2"))
+ (:: (:: System out) (println first))
(:: (:: System out) (println second)))))
(:: (:: System out) (println "FALSE"))))