diff options
| author | Eduardo Julian | 2014-12-26 14:36:22 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2014-12-26 14:36:22 -0400 |
| commit | 6eebd55535254e82230ce0ad11f7eb8b7907a9ca (patch) | |
| tree | 94d41dcbd2ce7e548faf26a6193e46d4727201a4 | |
| parent | db3fecf46f602320b48e7ce82ee770a46bba7ba6 (diff) | |
Added string testing & multi-branching to pattern-matching.
| -rw-r--r-- | src/lang/analyser.clj | 5 | ||||
| -rw-r--r-- | src/lang/compiler.clj | 25 | ||||
| -rw-r--r-- | test2.lang | 7 |
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")))) |