Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

add match*, matchv*, match-let* optimizing variants. update tests

  • Loading branch information...
commit f19bfef48ed13f396fd0140cc1a90b2218f26579 1 parent 54e367b
David Nolen swannodette authored
33 src/main/clojure/cljs/core/match/macros.clj
View
@@ -20,8 +20,23 @@
(binding [*clojurescript* true
*line* (-> &form meta :line)
*locals* (dissoc &env '_)
+ *warned* (atom false)]
+ `~(clj-form vars clauses))))
+
+(defmacro match*
+ [vars & clauses]
+ (let [[vars clauses]
+ (if (vector? vars)
+ [vars clauses]
+ [(vector vars)
+ (mapcat (fn [[c a]]
+ [(if (not= c :else) (vector c) c) a])
+ (partition 2 clauses))])]
+ (binding [*clojurescript* true
+ *line* (-> &form meta :line)
+ *locals* (dissoc &env '_)
*warned* (atom false)
- *recur-present* true]
+ *no-backtrack* true]
`~(clj-form vars clauses))))
(defmacro matchv [type vars & clauses]
@@ -29,8 +44,16 @@
*vector-type* type
*line* (-> &form meta :line)
*locals* (dissoc &env '_)
+ *warned* (atom false)]
+ `~(clj-form vars clauses)))
+
+(defmacro matchv* [type vars & clauses]
+ (binding [*clojurescript* true
+ *vector-type* type
+ *line* (-> &form meta :line)
+ *locals* (dissoc &env '_)
*warned* (atom false)
- *recur-present* true]
+ *no-backtrack* true]
`~(clj-form vars clauses)))
(defmacro match-let [bindings & body]
@@ -39,3 +62,9 @@
(match [~@bindvars#]
~@body))))
+(defmacro match-let* [bindings & body]
+ (let [bindvars# (take-nth 2 bindings)]
+ `(let ~bindings
+ (match* [~@bindvars#]
+ ~@body))))
+
26 src/main/clojure/clojure/core/match.clj
View
@@ -63,11 +63,22 @@
:doc "In the presence of recur we cannot apply code size optimizations"}
*recur-present* false)
+(def ^{:dynamic true
+ :doc "Flag to optimize performance over code size."}
+ *no-backtrack* false)
+
(def ^{:doc "Pre-allocated exception used for backtracing"}
backtrack (Exception. "Could not find match."))
(defn backtrack-expr []
- `(throw clojure.core.match/backtrack))
+ (if *clojurescript*
+ `(throw cljs.core.match/backtrack)
+ `(throw clojure.core.match/backtrack)))
+
+(defn backtrack-sym []
+ (if *clojurescript*
+ 'cljs.core.match/backtrack
+ 'clojure.core.match/backtrack))
(def ^{:dynamic true} *backtrack-stack* ())
(def ^{:dynamic true} *root* true)
@@ -408,7 +419,7 @@
(defn catch-error [& body]
(let [err-sym (if *clojurescript* 'js/Error 'Exception)]
`(catch ~err-sym e#
- (if (identical? e# clojure.core.match/backtrack)
+ (if (identical? e# ~(backtrack-sym))
(do
~@body)
(throw e#)))))
@@ -1924,8 +1935,15 @@ col with the first column and compile the result"
(defn clj-form [vars clauses]
(when @*syntax-check* (check-matrix-args vars clauses))
- (let [actions (map second (partition 2 clauses))]
- (binding [*recur-present* (or *recur-present* (recur-present? actions))]
+ (let [actions (map second (partition 2 clauses))
+ recur-present? (recur-present? actions)]
+ ;; TODO: this is naive, recur-present? need ignore
+ ;; recur internal to an action - David
+ (assert (not (and *no-backtrack* recur-present?))
+ "Recur form present yet *no-backtrack* set to true")
+ (binding [*recur-present* (or *recur-present*
+ recur-present?
+ *no-backtrack*)]
(-> (emit-matrix vars clauses)
compile
executable-form))))
25 src/test/cljs/core/match/tests.cljs
View
@@ -2,7 +2,7 @@
(:require-macros
[clojure.core.match :as m]
[clojure.core.match.array]
- [cljs.core.match.macros :refer [match matchv asets]])
+ [cljs.core.match.macros :refer [match match* matchv matchv* asets]])
(:require [cljs.core.match]))
(defn js-print [& args]
@@ -765,7 +765,7 @@
(asets o [:red l v r])))
(defn balance-array [node]
- (matchv ::m/objects [node]
+ (matchv* ::m/objects [node]
[(:or [:black [:red [:red a x b] y c] z d]
[:black [:red a x [:red b y c]] z d]
[:black a x [:red [:red b y c] z d]]
@@ -809,7 +809,7 @@
(let [n [:black [:red [:red 1 2 3] 3 4] 5 6]]
(time
(dotimes [_ 1e6]
- (match [n]
+ (match* [n]
[(:or [:black [:red [:red a x b] y c] z d]
[:black [:red a x [:red b y c]] z d]
[:black a x [:red [:red b y c] z d]]
@@ -890,3 +890,22 @@
:a1))
(println "Tests completed without exception.")
+
+(defn get-meaning
+ [paragraph line blank mode theme annotation]
+ (match
+ [paragraph line (> blank 0) mode theme annotation ]
+ [_ _ true _ _ _ ] "monaco-enter"
+ [_ _ _ _ true _ ] "monaco-theme"
+ [_ _ _ _ false true ] "monaco-annotation"
+ [_ _ false :theme _ false ] "monaco-note"
+ [0 0 false _ false false ] "monaco-outcome"
+ [0 _ false _ false false ] "monaco-perex"
+ [1 _ false _ false false ] "monaco-next-action"
+ [2 _ false _ false false ] "monaco-following-action"
+ [_ _ false nil false false ] "monaco-supplemental"
+ :else "monaco-generic"))
+
+(assert
+ (= (get-meaning 2 nil false nil false false)
+ "monaco-following-action"))
Please sign in to comment.
Something went wrong with that request. Please try again.