pax_global_header00006660000000000000000000000064123733762520014524gustar00rootroot0000000000000052 comment=73ed06179b50f567fa06e44b4d64101023aec104 libcore-match-clojure-0.2.2/000075500000000000000000000000001237337625200156755ustar00rootroot00000000000000libcore-match-clojure-0.2.2/.gitignore000064400000000000000000000000341237337625200176620ustar00rootroot00000000000000*jar /target/ .lein-failureslibcore-match-clojure-0.2.2/CHANGES.md000064400000000000000000000074151237337625200172760ustar00rootroot00000000000000From 0.2.0 to 0.2.1 === Fixes --- * MATCH-91: keyword with dots cause core.match to fail From 0.2.0-rc6 to 0.2.0 === None From 0.2.0-rc5 to 0.2.0-rc6 === Fixes --- * MATCH-86: or patterns do not AOT Changes --- * Requires ClojureScript 0.0-1889 * Cleaned up dependencies (no more core.logic requirement) Enhancements --- * Use identical? when matching strings and numbers in ClojureScript From 0.2.0-rc4 to 0.2.0-rc5 === Fixes --- * MATCH-82: CLJS locals matching did not work correctly * MATCH-83: vector pattern with rest pattern bug * MATCH-84: vector pattern with rest pattern bug From 0.2.0-rc3 to 0.2.0-rc4 === Fixes --- * MATCH-81: fix code-size issue, add match*, matchv* and match-let* which optimize for performance over code-size Changes - Breaking --- * Reorganize ClojureScript support. Runtime support ns is now cljs.core.match and macro support is cljs.core.match.macros. For array specialization you must require clojure.core.match and clojure.core.match.array From 0.2.0-rc2 to 0.2.0-rc3 === Fixes --- * MATCH-80: repeated match literal bug From 0.2.0-rc1 to 0.2.0-rc2 === Fixes --- * Fix no match case, don't reevalute expressions From 0.2.0-beta4 to 0.2.0-rc1 === None From 0.2.0-beta3 to 0.2.0-beta4 === Fixes --- * MATCH-61: emit init expressions only once * MATCH-77: `*recur-present*` compilation inconsistent Enhancements --- * add `match-let` and `matchv` to ClojureScript support * array specialization for vector patterns when type hinted From 0.2.0-beta2 to 0.2.0-beta3 === Fixes --- * MATCH-73: irrelevant bindings at leaf nodes * MATCH-71: non-optimal decision trees for map patterns Enhancements --- * Optimize literal matching, don't backtrack just test ==== From 0.2.0-beta1 to 0.2.0-beta2 ==== Fixes --- * Bring CLJS support closer to CLJ From 0.2.0-alpha12 to 0.2.0-beta1 ==== AOT issues should be addressed across the board. Fixes --- * MATCH-70 map pattern matching behavior is now more logical, specifying a key means it must at least be present even if a wildcard * MATCH-66: cannot match whole value * MATCH-51: fail to match empty vector after guard * MATCH-36: no match now throws an exception if no default provided a la case * MATCH-55: seq pattern with just rest pattern fails * MATCH-56: exception when matching empty vector * MATCH-68: variant of 55 * MATCH-35: seq pattern matching needed to test `seq` From 0.2.0-alpha11 to 0.2.0-alpha12 ==== Fixes --- * MATCH-67: fix ClojureScript support regression From 0.2.0-alpha10 to 0.2.0-alpha11 ==== Fixes --- * MATCH-52: bad map pattern matching behavior From 0.2.0-alpha9 to 0.2.0-alpha10 ==== Breaking Changes --- * :when is now for predicates. Use :guard for the old behavior of :when. Fixes --- * MATCH-62: ClojureScript map-matching should use cljs.core/ILookup, not cljs.core.ILookup * MATCH-60: Matching maps with :only broken in CLJS From 0.2.0-alpha8 to 0.2.0-alpha9 ==== Fixes --- * MATCH-43: fix another subtle pattern ordering issue * MATCH-45: group like patterns together, including vector patterns of different sizes * MATCH-46: fix :or leakage Breaking Changes --- * val-at* -> val-at Enhancements --- From 0.2.0-alpha7 to 0.2.0-alpha8 ==== Fixes --- * map patterns with heterogenous keys work now * MATCH-41: remove sorted-set-by use, this returned a incorrect list of column constructors * MATCH-42: can now match symbols by quoting them From 0.2.0-alpha6 to 0.2.0-alpha7 ==== Enhancements --- * remove match-1, passing single value to match now works From 0.2.0-alpha5 to 0.2.0-alpha6 ==== Fixes ---- * MATCH-34: no more infix or pattern syntax * MATCH-10: support maps with keys of heterogenous types * MATCH-30: throw if same binding name used in row * MATCH-33: fix readme typo Enhancements --- * supported flattened syntax for :when and :as * added Steve Miner's match-let libcore-match-clojure-0.2.2/CONTRIBUTING.md000064400000000000000000000012211237337625200201220ustar00rootroot00000000000000This is a [Clojure contrib] project. Under the Clojure contrib [guidelines], this project cannot accept pull requests. All patches must be submitted via [JIRA]. See [Contributing] and the [FAQ] on the Clojure development [wiki] for more information on how to contribute. [Clojure contrib]: http://dev.clojure.org/display/doc/Clojure+Contrib [Contributing]: http://dev.clojure.org/display/community/Contributing [FAQ]: http://dev.clojure.org/display/community/Contributing+FAQ [JIRA]: http://dev.clojure.org/jira/browse/MATCH [guidelines]: http://dev.clojure.org/display/community/Guidelines+for+Clojure+Contrib+committers [wiki]: http://dev.clojure.org/ libcore-match-clojure-0.2.2/README.md000064400000000000000000000034401237337625200171550ustar00rootroot00000000000000match ==== An optimized pattern match and predicate dispatch library for Clojure. Currently the library only implements pattern matching. It supports Clojure 1.3.0 and later as well as ClojureScript. You can find more detailed information [here](https://github.com/clojure/core.match/wiki/Overview). Releases and dependency information ---- Latest beta: 0.2.1 * [All released versions](http://search.maven.org/#search%7Cgav%7C1%7Cg%3A%22org.clojure%22%20AND%20a%3A%22core.match%22) [Leiningen](http://github.com/technomancy/leiningen/) dependency information: ``` [org.clojure/core.match "0.2.1"] ``` [Maven](http://maven.apache.org) dependency information: ``` org.clojure core.match 0.2.1 ``` Example Usage ---- From Clojure: ```clojure (use '[clojure.core.match :only (match)]) (doseq [n (range 1 101)] (println (match [(mod n 3) (mod n 5)] [0 0] "FizzBuzz" [0 _] "Fizz" [_ 0] "Buzz" :else n))) ``` From ClojureScript: ```clojure (ns foo.bar (:require-macros [cljs.core.match.macros :refer [match]]) (:require [cljs.core.match])) (doseq [n (range 1 101)] (println (match [(mod n 3) (mod n 5)] [0 0] "FizzBuzz" [0 _] "Fizz" [_ 0] "Buzz" :else n))) ``` For more detailed descriptions of usage please refer to the [wiki](http://github.com/clojure/core.match/wiki). Developer information ---- * [Bug Tracker](http://dev.clojure.org/jira/browse/MATCH) * [Continuous Integration](http://build.clojure.org/job/core.match/) * [Compatibility Test Matrix](http://build.clojure.org/job/core.match-test-matrix/) Copyright and license ---- Copyright © 2010-2013 David Nolen, Rich Hickey & contributors. Licensed under the EPL (see the file epl.html). libcore-match-clojure-0.2.2/license.txt000064400000000000000000000007411237337625200200620ustar00rootroot00000000000000 * match * Copyright (c) David Nolen. All rights reserved. * The use and distribution terms for this software are covered by the * Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) * which can be found in the file epl-v10.html at the root of this distribution. * By using this software in any fashion, you are agreeing to be bound by * the terms of this license. * You must not remove this notice, or any other, from this software. libcore-match-clojure-0.2.2/notes.txt000064400000000000000000000317541237337625200176000ustar00rootroot00000000000000Notes ================================================================================ Subsumption -------------------------------------------------------------------------------- If p1 subsumes p2 it needs to be sorted so that it comes later. First Example -------------------------------------------------------------------------------- (match [x y z] [_ false true ] 1 [false true _ ] 2 [_ _ false] 3 [_ _ _ ] 4) Heuristics -------------------------------------------------------------------------------- First Row f(i) = 0 if _ f(i) = 1 otherwise Small default -v(i) where i equal number of wildcard patterns in column i b(i) branching factor - negative number of switch nodes a(i) negation of the sum of the arities l(i) number of children of the emitted switch r(i) q constructor prefix qba q 1) avoid usefulness computations, 2) avoid pattern copies p(j i) is a generalized constructor pattern test Hmm sounds like we don't need to do usefulness checks with qba? Useless clauses -------------------------------------------------------------------------------- Subsumption checks to delete rows, before the subsumption check as well. If we can throw away redundant checks and move forward good. Non-exhaustiveness is not really something we care about that much - I don't think. People either added the default handler or their didn't. Series of examples are excellent at the end of "Warnings for pattern matching", should definitely work against these. Reducing necessity to usefulness. type mylist = Nil | One of int | Cons of int * mylist New Thoughts -------------------------------------------------------------------------------- | x (isa? x A) _ _ | | _ y (isa? y B) _ | | x (isa? x C) y (isa? y C) 0 | x :guards [(isa? x D)] *{0} If there are guards remaining on x that's another pattern matrix, other people might use that guard as well, if it's an isa? or = check we can save space. During compilation we could just use an atomic integer to associate an id with a particular class when *compile-files* Thoughts -------------------------------------------------------------------------------- We're going to have to spend a couple of days just sorting out an optimal data representation. Design -------------------------------------------------------------------------------- Interesting case: [x y] :guard [(odd? x) (even? y)] :one [x 0] :two [0 y] :guard [(odd? y)] :three [_ _] :four As matches are added we'll need to recompute the optimal matrix. We'll need to consider how to make this fast, as well what we can do minimize the work. Step1 -------------------- [x y] :guard [(odd? x) (even? y)] :one {:guards {[0] [(odd? x)] [1] [(even? y)]} :patterns [{:arglist [x y] :guard [(odd? x) (even? y)]}] :start 1 :dag {0 ::no-method 1 {:test (odd? x) :edges {true 2 false 0}} 2 {:test (odd? y) :edges {true 3 fales 0}} 3 :one}} Step2 -------------------- [x 0] :two {:guards {[0] [(odd? x)] [1] [(even? y)]} :patterns [{:arglist [x y] :guard [(odd? x) (even? y)]} {:arglist [x 0]}] :start 1 :dag {0 ::no-method 1 {:test (odd? x) :edges {true 4 false 0}} 2 {:test (odd? y) :edges {true 3 false 0}} 3 :one 4 {:test y :edges {0 5 ::default 2}} 5 :two}} We need something like insert-node, which will shift a node. Step3 -------------------- [0 y] :guard [(odd? y)] :three {:guards {[0] [(odd? x)] [1] [(even? y)] [1] [(odd? y)]} :patterns [{:arglist [x y] :guard [(odd? x) (even? y)]} {:arglist [x 0]} {:arglist [0 y] :guard [(odd? y)]}] :start 6 :dag {0 ::no-method 1 {:test (odd? x) :edges {true 4 false 0}} 2 {:test (odd? y) :edges {true 3 false 0}} 3 :one 4 {:test y :edges {0 5 ::default 2}} 5 :two 6 {:test x :edges {0 7 ::default 1}} 7 :three}} We'll have to rewrite parts of the graph, but that means we'll have to the parts of the graph that return. Step 4 -------------------- [_ _] :four {:guards {[0] [(odd? x)] [1] [(even? y)] [1] [(odd? y)]} :patterns [{:arglist [x y] :guard [(odd? x) (even? y)]} {:arglist [x 0]} {:arglist [0 y] :guard [(odd? y)]} {:arglist [_ _]}] :start 6 :dag {0 :four 1 {:test (odd? x) :edges {true 4 false 0}} 2 {:test (odd? y) :edges {true 3 false 0}} 3 :one 4 {:test y :edges {0 5 ::default 2}} 5 :two 6 {:test x :edges {0 7 ::default 1}} 7 :three}} We still haven't considered the problem of necessity. This really feels like we something *before* the dag, that we can use to generate the dag. | (odd? x) (even? y) | | x 0 | | 0 (odd? y) | | _ _ | Aha. The column representing is actually better! | 0 (odd? y) | | (odd? x) (even? y) | | x 0 | | _ _ | We should put the example from Efficient Predicate Dispatch into this format. When there is an internal access, should just be considered as another column? | 0 _ (odd? y) | | (odd? x) _ (even? y) | | x _ 0 | | (A. y) y _ | | _ _ _ | User defines the following method (defm foo [x] :guard [(even? x)] :two) We now have a new method in the method-table called myns/foo, this method entry will look like the following: {:guards {[0] [(even? x)]} :patterns [{:arglist [x] :guard [(even? x)]}] :start 0 :dag {0 ::no-method 1 {:test even? :edges {true 1 false -1}} 2 :two}} User then defines the following addition to the method (defm foo [0] :one) This will update the method entry in the table it should now look like the following: {:guards {[0] [(even? x)]} :patterns [{:arglist [x] :guard [(even? x)]} {:arglist [0]}] :start 2 :dag {-1 ::no-method 0 {:test (even? x) :edges {true 1 false -1}} 1 :two 2 {:test x :edges {0 3 false 0}} 3 :one}} This works for the simple case, but what if the reordering happens in the middle? (defm foo [4] :three) This isn't a problem as this is just another equality test: {:guards {[0] [(even? x)]} :patterns [[x] [0] [4]] :start 2 :dag {-1 ::no-method 0 {:test (even? x) :edges {true 1 false -1}} 1 :two 2 {:test x :edges {0 3 4 4 false 0}} 3 :one 4 :three}} So this is pretty easy to deal with. Can we think of a situation that would actually cause a reordering that we would want to handle? Can't really think of any cases that involve Clojure. [(A. 0)] [(B. 0)] [(C. 0)] A -> B -> C hierarchy Concrete type matches are not a problem, they're always more specific. [x] :guard (isa x IFoo) [x] :guard (isa x IBar) x is A which implement IFoo and IBar If we know the type of x we can point out the ambiguity. At the bottom the user could add, after :where, :prefers [[IBar IFoo]] I don't suppose this'll be any worse then Ideas -------------------------------------------------------------------------------- In the cases where one branch has many more tests, I guess a cascade of cases still wins out really over if (supers (class 0)) #{java.lang.Number java.io.Serializable java.lang.Object java.lang.Comparable} This is incredibly useful information for dispatching. Issues -------------------------------------------------------------------------------- Getting a specific method. Not sure how important this is, we would want to preserve the destructuring perhaps? Or maybe you get a function that is closed over the arguments that you gave to it? A method signature is its pattern and it's guard Algorithm -------------------------------------------------------------------------------- patterns are two things, a type and a series of bindings. Unlike destructuring in Clojure, we want to differentiate between things we want to treat as sequences and things that are of fixed length. () ; always represents fixed length sequences, ISeq + count [] ; the usual clojure interpretation, ISeq {} ; the usual clojure interpretation, IMap (A. f1 f2 ...) ; field syntax We test the arguments in order, we grab all the tests for the first argument organized by the method they dispatch on. The pattern plus the normalized guard is the unique key (we should probably check for alpha equivalence) for each method. We could also use the strategy outlined by the OCaml paper, using the concept of the necessity. The math is a bit thick in that paper, would need some help? Pattern Matrix -------------------------------------------------------------------------------- In the map there is a (n x m) matrix - but our tests are not just (n x m), some patterns may require more matches since we have guards. Need to read the paper several more times to suss out it's meaning, the mathematics is not very complicated. It's mostly a notation to simplify the description w/o getting into the details of OCaml. P1.1 P1.2 P2.1 P2.2 P3.1 P3.2 Perhaps best if all tests are considered as one particular pattern. Different kinds of tests are given a different priority. P.1.1 = (and (type Foo a) (= (:x a) 0)) P.2.1 = (and (type Bar a) (= (:y a) 1)) P.3.1 = (and (type Foo a) (even? (:x a) 0)) There's recursive stuff going on here. P1.1 and P3.1 kind of represent a sub-decision tree. Heuristinc & Scoring -------------------------------------------------------------------------------- f = score constructors 1 v(i) = score wilcard occurrences as -v(i) Integration with a Type System -------------------------------------------------------------------------------- Hmm, it would be interesting to use the logic engine to store a database of facts as your declaring you're defining your program and emit type warnings. We would even have to interfere with the compiler, we'd simply run a clojure parser on the body and run the type inference. The fact that definitions have to be defined in a specific order really simplifies the type checking problem. Racket -------------------------------------------------------------------------------- Racket supports recursive pattern, this is interesting. Steps towards Datalog yet again? A big benefit of the inability to have circular references in Clojure is completely avoid the infinite loop issue. Classes/Interfaces/Protocols - many possible branches boolean tests - 2 branches [x y] A (> x 1) B (= x :foo) C A What other things would people want to dispatch on that are legitimately multiway? structural matching, whatever the defrecord literal becomes when it comes. (A. 1 2) [{:keys [a b] :as b}] :guard .... The problem here that we have a two steps. for things which we know are types, we can emit case for things which we know are ad-hoc, we can emit condp isa? Use cases -------------------------------------------------------------------------------- We would like to know that the following expressions are equivalent. (= (:foo x) 'a) (= (:foo x) 'b) (= 'c (:foo x)) (= 'd (:foo x)) If we know they are then we can setup a multiway branch again. This simple case can definitely be handled. We could support Racket like things. (? every? even? foo) Predicate Dispatch -------------------------------------------------------------------------------- [{f1x :x f1y :y :as f1} {f2x :x f2y :y :as f2}] :guard [(isa? f1 A) (isa? f1x A) (not (isa? B f1)) (isa? f2x C) (= f1y f2y)] [{f1x :x :as f1} f2] :guard [(isa? f1 B) (isa? f1x B)] [{f1x :x :as f1} f2] :guard [(isa? f1 C) (isa? f2 A) (isa? f1x B)] [f1 f2] :guard [(isa? f1 C) (isa? f2 C)] [f1 _] :guard [(isa? f1 C)] | f1#A f2 | | f1#B f2 | | f1#C f2#A | | f1#C f2#C | | f1#C f2 | NOTE: how to deal with multiple isa? on a subterm? (isa? x B) (isa? x A) column 1 is clear the most important since it tests for type in all cases This is actually much simpler than what is suggested in the Efficient Predicate Dispatch paper, if f1#A is selected we don't need to use those tests anywhere else, we can can remove predicates as we specialize and if there are no other matches, we can just destructure and run the remaining bits? Same for B For C we actually have some legitimate tests Issues ----------------------------------------------------------------------------- One thing that is tough is recovering the method. (get-method foo [0 1]) Should return the method that matches the particular argument list. Need to think about this. libcore-match-clojure-0.2.2/pom.xml000064400000000000000000000040701237337625200172130ustar00rootroot00000000000000 4.0.0 core.match 0.2.2 ${artifactId} Optimized pattern matching and predicate dispatch for Clojure Eclipse Public License 1.0 http://opensource.org/licenses/eclipse-1.0.php repo org.clojure pom.contrib 0.1.2 jira http://dev.clojure.org/jira/browse/MATCH swannodette David Nolen http://dosync.posterous.com Project Lead frenchy64 Ambrose Bonnaire-Sergeant http://twitter.com/ambrosebs org.clojure clojurescript 0.0-2311 provided org.clojure tools.analyzer.jvm 0.1.0-beta12 clojars.org http://clojars.org/repo scm:git:git://github.com/clojure/core.match.git scm:git:git://github.com/clojure/core.match.git http://github.com/clojure/core.match core.match-0.2.2 libcore-match-clojure-0.2.2/project.clj000064400000000000000000000015601237337625200200370ustar00rootroot00000000000000(defproject org.clojure/core.match "0.2.2-SNAPSHOT" :description "Optimized pattern matching and predicate dispatch for Clojure" :jvm-opts ^:replace ["-Xmx512m" "-server"] :test-paths ["src/test/clojure"] :source-paths ["src/main/clojure"] :dependencies [[org.clojure/clojure "1.6.0"] [org.clojure/tools.analyzer.jvm "0.1.0-beta12"] [org.clojure/clojurescript "0.0-2311" :scope "provided"]] :dev-dependencies [[org.clojure/tools.nrepl "0.2.3"]] :plugins [[lein-cljsbuild "1.0.4-SNAPSHOT"]] :cljsbuild {:builds [{:id "test" :source-paths ["src/test/cljs"] :compiler {:output-to "out/test.js" :static-fns true :optimizations :simple}} {:id "test-adv" :source-paths ["src/test/cljs"] :compiler {:output-to "out/test.js" :optimizations :advanced}}]}) libcore-match-clojure-0.2.2/script/000075500000000000000000000000001237337625200172015ustar00rootroot00000000000000libcore-match-clojure-0.2.2/script/test000075500000000000000000000010601237337625200201030ustar00rootroot00000000000000rm -rf out mkdir -p out lein cljsbuild clean lein cljsbuild once test-adv if [ "$V8_HOME" == "" ]; then echo "V8_HOME not set, skipping V8 tests" else echo "Testing with V8" ${V8_HOME}/d8 out/test.js fi if [ "$SPIDERMONKEY_HOME" == "" ]; then echo "SPIDERMONKEY_HOME not set, skipping SpiderMonkey tests" else echo "Testing with SpiderMonkey" ${SPIDERMONKEY_HOME}/js out/test.js fi if [ "$JSC_HOME" == "" ]; then echo "JSC_HOME not set, skipping JavaScriptCore tests" else echo "Testing with JavaScriptCore" ${JSC_HOME}/jsc out/test.js filibcore-match-clojure-0.2.2/src/000075500000000000000000000000001237337625200164645ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/main/000075500000000000000000000000001237337625200174105ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/main/clojure/000075500000000000000000000000001237337625200210535ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/main/clojure/cljs/000075500000000000000000000000001237337625200220065ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/main/clojure/cljs/core/000075500000000000000000000000001237337625200227365ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/main/clojure/cljs/core/match.cljs000064400000000000000000000000621237337625200247050ustar00rootroot00000000000000(ns cljs.core.match) (def backtrack (js/Error.)) libcore-match-clojure-0.2.2/src/main/clojure/cljs/core/match/000075500000000000000000000000001237337625200240325ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/main/clojure/cljs/core/match/macros.clj000064400000000000000000000040431237337625200260110ustar00rootroot00000000000000(ns cljs.core.match.macros (:refer-clojure :exclude [compile]) (:use [clojure.core.match :exclude [match matchv match-let]])) (defmacro asets [a vs] `(do ~@(map (fn [a b c] (concat a (list b c))) (repeat `(aset ~a)) (range (count vs)) vs) ~a)) (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 (:locals &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 (:locals &env) '_) *warned* (atom false) *no-backtrack* true] `~(clj-form vars clauses)))) (defmacro matchv [type vars & clauses] (binding [*clojurescript* true *vector-type* type *line* (-> &form meta :line) *locals* (dissoc (:locals &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 (:locals &env) '_) *warned* (atom false) *no-backtrack* true] `~(clj-form vars clauses))) (defmacro match-let [bindings & body] (let [bindvars# (take-nth 2 bindings)] `(let ~bindings (match [~@bindvars#] ~@body)))) (defmacro match-let* [bindings & body] (let [bindvars# (take-nth 2 bindings)] `(let ~bindings (match* [~@bindvars#] ~@body)))) libcore-match-clojure-0.2.2/src/main/clojure/clojure/000075500000000000000000000000001237337625200225165ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/000075500000000000000000000000001237337625200234465ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match.clj000064400000000000000000001633151237337625200252450ustar00rootroot00000000000000(ns clojure.core.match (:refer-clojure :exclude [compile]) (:use [clojure.core.match.protocols]) (:require [clojure.set :as set] [clojure.tools.analyzer :as ana] [clojure.tools.analyzer.jvm :as ana-jvm] [clojure.tools.analyzer.passes.jvm.annotate-loops :as loops]) (:import [java.io Writer] [clojure.core.match.protocols IExistentialPattern IPseudoPattern])) ;; ============================================================================= ;; # Introduction ;; ;; This namespace contains an implementation of closed pattern ;; matching. It uses an algorithm based on Luc Maranget's paper ;; "Compiling Pattern Matching to Good Decision Trees". ;; ;; There are three main steps to this implementation: ;; ;; 1. *Converting Clojure syntax to a Pattern Matrix*: ;; The function `emit-matrix` does this work. ;; A Pattern Matrix is represented by PatternMatrix. ;; ;; 2. *Compiling the Pattern Matrix to a Directed Acyclic Graph*: ;; The function `compile` does this work. This step ;; is where Maranget's algorithm is implemented. ;; ;; 3. *Converting the DAG to Clojure code*: ;; This is mostly a 1-1 conversion. See function `executable-form`. ;; ;; # Nomenclature ;; ;; * x and y are called _occurrences_ ;; * 1, 2, 3 and 4 are _patterns_ ;; * [1 2] and [3 4] are _pattern rows_ ;; * :a0 and :a1 are _actions_ ;; ;; ============================================ ;; # Debugging tools ;; ;; These debugging aids are most useful in steps 2 and 3 of compilation. ;; ;; TODO allow these to be set dynamically, at macro-expand time. ;; Maybe match macros could take extra metadata? - Ambrose (def ^{:dynamic true :doc "Enable syntax check of match macros"} *syntax-check* (atom true)) (def ^{:dynamic true} *clojurescript* false) (def ^{:dynamic true} *line*) (def ^{:dynamic true} *locals* nil) (def ^{:dynamic true} *warned*) (def ^{:dynamic true :doc "Default vector type. Can be rebound allowing emission of custom inline code for vector patterns, for example type-hinted primitive array operations"} *vector-type* ::vector) (def ^{:dynamic true :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 [] (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) (defn warn [msg] (when (not @*warned*) (binding [*out* *err*] (println "WARNING:" (str *ns* ", line " *line* ":") msg)) (reset! *warned* true))) (defn analyze [form env] (binding [ana/macroexpand-1 ana-jvm/macroexpand-1 ana/create-var ana-jvm/create-var ana/parse ana-jvm/parse ana/var? var?] (ana/analyze form env))) (defn get-loop-locals [] (let [LOOP_LOCALS clojure.lang.Compiler/LOOP_LOCALS] (mapcat (fn [b] (let [name (.sym ^clojure.lang.Compiler$LocalBinding b)] [name name])) (when (bound? LOOP_LOCALS) @LOOP_LOCALS)))) ;; ============================================================================= ;; # Map Pattern Interop (extend-type clojure.lang.ILookup IMatchLookup (val-at [this k not-found] (.valAt this k not-found))) (defn val-at* ([m k] (val-at m k ::not-found)) ([m k not-found] (val-at m k not-found))) (defn val-at-expr [& args] (if *clojurescript* `(get ~@args) ;;If not ClojureScript, defer to val-at* `(if (instance? clojure.lang.ILookup ~(first args)) (get ~@args) (val-at* ~@args)))) ;; ============================================================================= ;; # Vector Pattern Interop ;; ;; Vectors patterns can generate code specialized on type. This is ;; useful for generating optimal code for data like primitive arrays ;; and bytes. Defaults for vector are provided, see ;; clojure.core.match.array and clojure.core.match.bits for ;; experiments involving these types. (defn vector-type [t & r] t) (defmulti check-size? identity) (defmulti tag (fn [t] t)) (defmulti test-inline vector-type) (defmulti test-with-size-inline vector-type) (defmulti test-with-min-size-inline vector-type) (defmulti count-inline vector-type) (defmulti nth-inline vector-type) (defmulti nth-offset-inline vector-type) (defmulti subvec-inline vector-type) (defmulti nthnext-inline vector-type) (defmethod check-size? :default [_] true) (defmethod tag :default [t] (throw (Exception. (str "No tag specified for vector specialization " t)))) (defmethod tag ::vector [_] clojure.lang.IPersistentVector) (defn with-tag [t ocr] (let [the-tag (tag t) the-tag (if (and (class? the-tag) (.isArray ^Class the-tag)) (.getName ^Class the-tag) the-tag)] (vary-meta ocr assoc :tag the-tag))) (defmethod test-inline ::vector [t ocr] (let [the-tag (tag t) c (cond (class? the-tag) the-tag (string? the-tag) (Class/forName the-tag) (symbol? the-tag) (Class/forName (str the-tag)) :else (throw (Error. (str "Unsupported tag type" the-tag))))] (cond (= t ::vector) `(vector? ~ocr) (and (.isArray ^Class c) *clojurescript*) `(cljs.core/array? ~ocr) :else `(instance? ~c ~ocr)))) (defmethod test-with-size-inline ::vector [t ocr size] `(and ~(test-inline t ocr) (== ~(count-inline t (with-tag t ocr)) ~size))) (defmethod test-with-min-size-inline ::vector [t ocr size] `(and ~(test-inline t ocr) (>= ~(count-inline t (with-tag t ocr)) ~size))) (defmethod count-inline ::vector [_ ocr] `(count ~ocr)) (defmethod nth-inline ::vector [_ ocr i] `(nth ~ocr ~i)) (defmethod nth-offset-inline ::vector [t ocr i offset] (nth-inline t ocr i)) (defmethod subvec-inline ::vector ([_ ocr start] `(subvec ~ocr ~start)) ([_ ocr start end] `(subvec ~ocr ~start ~end))) (defmethod nthnext-inline ::vector ([_ ocr n] `(nthnext ~ocr ~n))) ;; ============================================================================= ;; # Extensions ;; Pattern matrices are represented with persistent ;; vectors. Operations on pattern matrices require us to move ;; something from the middle of the vector to the front - thus prepend ;; and drop-nth. swap will swap the 0th element with the nth element. (extend-type clojure.lang.IPersistentVector IVecMod (prepend [this x] (into [x] this)) (drop-nth [this n] (into (subvec this 0 n) (subvec this (clojure.core/inc n) (count this)))) (swap [this n] (let [x (nth this n)] (prepend (drop-nth this n) x)))) ;; ----------------------------------------------------------------------------- ;; constructor? (declare wildcard-pattern?) (defn constructor? [p] (not (wildcard-pattern? p))) ;; ============================================================================= ;; # Pattern Grouping ;; ;; Used to determine the groupable constructors in a column (defmulti groupable? "Determine if two patterns may be grouped together for simultaneous testing." (fn [a b] [(type a) (type b)])) (defmethod groupable? :default [a b] (= a b)) ;; ============================================================================= ;; # Pattern Rows ;; ;; Pattern rows are one line of a matrix. They correspond to one ;; clause in the in the user's original pattern. patterns, action, ;; bindings are accessors. ;; (declare leaf-bind-expr named-wildcard-pattern?) (deftype PatternRow [ps action bindings] Object (equals [_ other] (and (instance? PatternRow other) (= ps (:ps other)) (= action (:action other)) (= bindings (:bindings other)))) IVecMod (drop-nth [_ n] (PatternRow. (drop-nth ps n) action bindings)) (prepend [_ x] (PatternRow. (into [x] ps) action bindings)) (swap [_ n] (PatternRow. (swap ps n) action bindings)) clojure.lang.Associative (assoc [this k v] (PatternRow. (assoc ps k v) action bindings)) clojure.lang.Indexed (nth [_ i] (nth ps i)) (nth [_ i x] (nth ps i x)) clojure.lang.ISeq (first [_] (first ps)) (next [_] (if-let [nps (next ps)] (PatternRow. nps action bindings) (PatternRow. [] action bindings))) (more [_] (if (empty? ps) nil (let [nps (rest ps)] (PatternRow. nps action bindings)))) (seq [this] (seq ps)) (count [_] (count ps)) clojure.lang.ILookup (valAt [this k] (.valAt this k nil)) (valAt [this k not-found] (case k :ps ps :action action :bindings bindings not-found)) clojure.lang.IFn (invoke [_ n] (nth ps n)) clojure.lang.IPersistentCollection (cons [_ x] (PatternRow. (conj ps x) action bindings)) (equiv [this other] (.equals this other))) (defn pattern-row ([ps action] (pattern-row ps action [])) ([ps action bindings] (let [ps (if (vector? ps) ps (into [] ps))] (PatternRow. ps action bindings)))) ;; NOTE: we don't use map destructuring here because PatternRow is ;; both ISeq and ILookup, but in map destructuring seq? is tested ;; first - David (defn update-pattern [prow i p] (pattern-row (assoc (:ps prow) i p) (:action prow) (:bindings prow))) (defn all-wildcards? [prow] (every? wildcard-pattern? (:ps prow))) (defn drop-nth-bind [prow n ocr] (let [ps (:ps prow) p (ps n) action (:action prow) bind-expr (leaf-bind-expr ocr) as (-> p meta :as) bindings (or (:bindings prow) []) bindings (if as (conj bindings [as bind-expr]) bindings) bindings (if (named-wildcard-pattern? p) (conj bindings [(:sym p) bind-expr]) bindings)] (pattern-row (drop-nth ps n) action bindings))) ;; ============================================================================= ;; # Compilation Nodes ;; ----------------------------------------------------------------------------- ;; ## Leaf Node (defrecord LeafNode [value bindings] INodeCompile (n-to-clj [this] (if (not (empty? bindings)) (let [bindings (remove (fn [[sym _]] (= sym '_)) bindings)] `(let [~@(apply concat bindings)] ~value)) value))) ;; TODO precondition on bindings? see above - Ambrose (defn leaf-node ([value] (LeafNode. value [])) ([value bindings] (LeafNode. value bindings))) (defmulti leaf-bind-expr (fn [ocr] (-> ocr meta :occurrence-type))) (defmethod leaf-bind-expr :seq [ocr] (-> ocr meta :bind-expr)) (defmethod leaf-bind-expr ::vector [ocr] (-> ocr meta :bind-expr)) (defmethod leaf-bind-expr :map [ocr] (let [m (meta ocr)] (val-at-expr (:map-sym m) (:key m)))) (defmethod leaf-bind-expr :default [ocr] ocr) ;; ----------------------------------------------------------------------------- ;; ## Fail Node (defrecord FailNode [] INodeCompile (n-to-clj [this] (if *recur-present* `(throw ~(if *clojurescript* `(js/Error. (str "No match found.")) `(Exception. (str "No match found.")))) (backtrack-expr)))) (defn fail-node [] (FailNode.)) ;; ----------------------------------------------------------------------------- ;; ## Bind Node (defrecord BindNode [bindings node] INodeCompile (n-to-clj [this] `(let [~@bindings] ~(n-to-clj node)))) (defn bind-node [bindings node] (BindNode. bindings node)) ;; ----------------------------------------------------------------------------- ;; ## Switch Node (declare to-source) (defn dag-clause-to-clj [occurrence pattern action] (let [test (if (instance? clojure.core.match.protocols.IPatternCompile pattern) (to-source* pattern occurrence) (to-source pattern occurrence))] [test (n-to-clj action)])) (defn catch-error [& body] (let [err-sym (if *clojurescript* 'js/Error 'Exception)] `(catch ~err-sym e# (if (identical? e# ~(backtrack-sym)) (do ~@body) (throw e#))))) (defrecord SwitchNode [occurrence cases default] INodeCompile (n-to-clj [this] (let [clauses (doall (mapcat (partial apply dag-clause-to-clj occurrence) cases)) bind-expr (-> occurrence meta :bind-expr) cond-expr (if *recur-present* (doall (concat `(cond ~@clauses) `(:else ~(n-to-clj default)))) (doall (concat `(cond ~@clauses) `(:else ~(backtrack-expr)))))] (if *recur-present* (if bind-expr `~(doall (concat `(let [~occurrence ~bind-expr]) (list cond-expr))) `~cond-expr) (if bind-expr `(try ~(doall (concat `(let [~occurrence ~bind-expr]) (list cond-expr))) ~(catch-error (n-to-clj default))) `(try ~cond-expr ~(catch-error (n-to-clj default)))))))) (defn switch-node ([occurrence cases default] {:pre [(sequential? cases)]} (SwitchNode. occurrence cases default))) ;; ============================================================================= ;; # Pattern Matrix (defn first-column? [i] (zero? i)) (defn empty-row? [row] (let [ps (:ps row)] (and (not (nil? ps)) (empty? ps)))) (defn score-column [i col] [i (reduce + 0 col)]) (defn width [{rows :rows}] (if (not (empty? rows)) (count (rows 0)) 0)) (defn height [{rows :rows}] (count rows)) (defn dim [pm] [(width pm) (height pm)]) (defn empty-matrix? [pm] (= (dim pm) [0 0])) (defn column [{rows :rows} i] (vec (map #(nth % i) rows))) (defn row [{rows :rows} j] (nth rows j)) (defn rows [{rows :rows}] rows) (defn pattern-at [{rows :rows} i j] ((rows j) i)) (defn action-for-row [{rows :rows} j] (:action (rows j))) (defn occurrences [pm] (:ocrs pm)) ;; Returns bindings usable by leaf-node (defn row-bindings [f ocrs] (concat (:bindings f) (->> (map vector (:ps f) ocrs) (filter (fn [[p ocr]] (named-wildcard-pattern? p))) (map (fn [[p ocr]] [(:sym p) (leaf-bind-expr ocr)]))))) (defn existential-pattern? [x] (instance? IExistentialPattern x)) (defn wildcard-or-existential? [x] (or (wildcard-pattern? x) (existential-pattern? x))) (defn constructors-above? [pm i j] (every? (comp not wildcard-or-existential?) (take j (column pm i)))) ;; based on paper we used to check the following ;; (wildcard-pattern? p) (not (useful? (drop-nth pm i) j)) ;; IMPORTANT NOTE: this calculation is very very slow, ;; we should look at this more closely - David (defn pattern-score [pm i j] (let [p (pattern-at pm i j)] (cond (or (wildcard-pattern? p) (not (constructors-above? pm i j))) 0 (existential-pattern? p) 1 :else 2))) ;; DEAD CODE for now - David ;; (defn useful? [pm j] ;; (some #(useful-p? pm % j) ;; (range (count (row pm j))))) (defn useful-matrix [pm] (->> (for [j (range (height pm)) i (range (width pm))] (pattern-score pm i j)) (partition (width pm)) (map vec) vec)) (defn necessary-column [pm] (->> (apply map vector (useful-matrix pm)) (map-indexed score-column) (reduce (fn [[col score :as curr] [ocol oscore :as cand]] (if (> oscore score) cand curr)) [0 0]) first)) (defn select [pm] (swap pm (necessary-column pm))) (declare default-specialize-matrix) (defn specialize ([matrix] (specialize matrix (ffirst (rows matrix)))) ([matrix p] (if (satisfies? ISpecializeMatrix p) (specialize-matrix p matrix) (default-specialize-matrix p matrix)))) (defn pseudo-pattern? [x] (instance? IPseudoPattern x)) (defn pseudo-patterns [matrix i] (filter pseudo-pattern? (column matrix i))) (defn column-splitter [col] (let [f (first col) [top bottom] (split-with #(groupable? f %) (rest col))] [(cons f top) bottom])) (declare pattern-matrix compile) (defn return-split [S D] (if *recur-present* (if (and (empty-matrix? D) (seq *backtrack-stack*)) [S (peek *backtrack-stack*) *backtrack-stack*] [S D (conj *backtrack-stack* D)]) [S D])) (defn matrix-splitter [matrix] (let [rows (rows matrix) n (count (first (column-splitter (map first rows)))) ocrs (occurrences matrix) S (pattern-matrix (take n rows) ocrs) D (pattern-matrix (drop n rows) ocrs)] (return-split S D))) (defn group-rows [cs rows] (reduce (fn [res row] (let [[c rows] (peek res) c' (first row)] (if (groupable? c c') (conj (pop res) [c (conj rows row)]) (conj res [c' [row]])))) [[(first cs) [(first rows)]]] (rest rows))) (declare literal-pattern?) (defn non-local-literal-pattern? [p] (and (literal-pattern? p) (not (-> p :l meta :local)))) (defn literal-case-matrix-splitter [matrix] (let [ocrs (occurrences matrix) rows (rows matrix) lrows (loop [rows (seq rows) res [] lits #{}] ;; a bit hacky but lit patterns hash differently we ;; store the literal value directly in lits set (if rows (let [[p :as row] (first rows)] (if (and (non-local-literal-pattern? p) (not (contains? lits (:l p)))) (recur (next rows) (conj res row) (if (non-local-literal-pattern? p) (conj lits (:l p)) lits)) res)) res)) S (->> lrows (group-rows (map first lrows)) (map (fn [[c rows]] [c (pattern-matrix rows ocrs)])) vec) D (pattern-matrix (drop (count lrows) rows) ocrs)] (return-split S D))) (defn default-case [matrix] (if-not (empty-matrix? matrix) (compile matrix) (fail-node))) (defn cases [matrix] (if (vector? matrix) ;; grouped literal case (->> matrix (map (fn [[c m]] [c (-> m (specialize c) compile)])) vec) ;; normal case (let [rows (rows matrix) c (ffirst rows)] [[c (-> matrix (specialize c) compile)]]))) (defn expression? [ocr] (contains? (meta ocr) :ocr-expr)) (defn bind-variables [ocrs] (mapcat (fn [ocr] (let [bind-expr (get (meta ocr) :ocr-expr ::not-found)] (if (not= bind-expr ::not-found) [ocr bind-expr] [ocr ocr]))) ocrs)) (defn root-bind-node [matrix] (let [ocrs (occurrences matrix) node (compile matrix)] (if (some expression? ocrs) (bind-node (bind-variables ocrs) node) node))) ;; ----------------------------------------------------------------------------- ;; # Compilation Cases ;; ;; These are analogous to Maranget's Compilation Scheme on page 4, ;; respectively case 1, 2, 2 (also), 3a and 3b. ;; (defn empty-rows-case "Case 1: If there are no pattern rows to match, then matching always fails" [] (fail-node)) (defn first-row-empty-case "Case 2: If the first row is empty then matching always succeeds and yields the first action." [rows ocr] (let [f (first rows) a (:action f) bs (:bindings f)] ;; FIXME: the first row is an infinite list of nil - David (leaf-node a bs))) (defn first-row-wildcards-case "Case 2: If the first row is constituted by wildcards then matching matching always succeeds and yields the first action." [rows ocrs] (let [f (first rows) a (:action f) bs (row-bindings f ocrs)] (leaf-node a bs))) (defn expand-matrix [matrix col] (reduce (fn [matrix p] (specialize matrix p)) matrix (pseudo-patterns matrix col))) (defn split-matrix [matrix] (if (non-local-literal-pattern? (ffirst (rows matrix))) ;; literal testing based on equality can do w/o ;; backtracking for all adjacent literal ctors in a column (literal-case-matrix-splitter matrix) (matrix-splitter matrix))) (defn first-column-chosen-case "Case 3a: The first column is chosen. Compute and return a switch/bind node with a default matrix case" [matrix col ocrs] (let [expanded (expand-matrix matrix col) [S D :as split] (split-matrix expanded)] (if-not *recur-present* (switch-node (ocrs col) (cases S) (default-case D)) (let [new-stack (last split)] (switch-node (ocrs col) (if-not (identical? *backtrack-stack* new-stack) (binding [*backtrack-stack* new-stack] (cases S)) (cases S)) (if (and (seq *backtrack-stack*) (identical? (peek *backtrack-stack*) D)) (binding [*backtrack-stack* (pop *backtrack-stack*)] (default-case D)) (default-case D))))))) (defn other-column-chosen-case "Case 3b: A column other than the first is chosen. Swap column col with the first column and compile the result" [matrix col] (compile (swap matrix col))) ;; Return a column number of a column which contains at least ;; one non-wildcard constructor (defn choose-column [matrix] (necessary-column matrix)) (defn compile [{:keys [rows ocrs] :as pm}] (cond *root* (binding [*root* false] (root-bind-node pm)) (empty? rows) (empty-rows-case) (empty-row? (first rows)) (first-row-empty-case rows (first ocrs)) (all-wildcards? (first rows)) (first-row-wildcards-case rows ocrs) :else (let [col (choose-column pm)] (if (first-column? col) (first-column-chosen-case pm col ocrs) (other-column-chosen-case pm col))))) (defrecord PatternMatrix [rows ocrs] IVecMod (drop-nth [_ i] (let [nrows (vec (map #(drop-nth % i) rows))] (PatternMatrix. nrows ocrs))) ;; Swap column number idx with the first column (swap [_ idx] (let [nrows (vec (map #(swap % idx) rows))] (PatternMatrix. nrows (swap ocrs idx))))) (defn pattern-matrix [rows ocrs] (let [rows (if (vector? rows) rows (into [] rows)) ocrs (if (vector? ocrs) ocrs (into [] ocrs))] (PatternMatrix. rows ocrs))) ;; ============================================================================= ;; ## Default Matrix Specialization ;; NOTE: not sure why we need groupable? here for this to work - David (defn default-specialize-matrix [p matrix] (let [rows (rows matrix) ocrs (occurrences matrix) focr (first ocrs) nrows (->> rows (map #(drop-nth-bind % 0 focr)) vec) nocrs (drop-nth ocrs 0)] (pattern-matrix nrows nocrs))) ;; ============================================================================= ;; # Patterns ;; ;; ----------------------------------------------------------------------------- ;; ## Wildcard Pattern ;; ;; A wildcard pattern accepts any value. ;; ;; In practice, the DAG compilation eliminates any wildcard patterns. (deftype WildcardPattern [sym named _meta] Object (equals [_ other] (and (instance? WildcardPattern other) (if named (= sym (:sym other)) (not (:named other))))) clojure.lang.IObj (withMeta [_ new-meta] (WildcardPattern. sym named new-meta)) (meta [_] _meta) clojure.lang.ILookup (valAt [this k] (.valAt this k nil)) (valAt [this k not-found] (case k :sym sym :named named not-found))) (defn wildcard-pattern ([] (wildcard-pattern '_)) ([sym] {:pre [(symbol? sym)]} (if (= sym '_) (WildcardPattern. (gensym) false nil) (WildcardPattern. sym true nil)))) (defn wildcard-pattern? [x] (instance? WildcardPattern x)) ;; Local bindings in pattern matching are emulated by using named wildcards. ;; See clojure.lang.Symbol dispatch for `emit-pattern` (defn named-wildcard-pattern? [x] (and (instance? WildcardPattern x) (:named x))) (defmethod print-method WildcardPattern [p ^Writer writer] (.write writer (str ""))) ;; ----------------------------------------------------------------------------- ;; ## Literal Pattern ;; ;; A literal pattern is not further split into further patterns in the DAG ;; compilation phase. ;; ;; It "literally" matches a given occurrence. (deftype LiteralPattern [l _meta] Object (toString [_] (if (nil? l) "nil" (pr-str l))) (equals [_ other] (and (instance? LiteralPattern other) (= l (:l other)))) clojure.lang.IObj (meta [_] _meta) (withMeta [_ new-meta] (LiteralPattern. l new-meta)) clojure.lang.ILookup (valAt [this k] (.valAt this k nil)) (valAt [this k not-found] (case k :l l not-found)) IPatternCompile (to-source* [this ocr] (cond (= l ()) `(empty? ~ocr) (and (symbol? l) (not (-> l meta :local))) `(= ~ocr '~l) (and *clojurescript* (or (number? l) (string? l) (true? l) (false? l) (nil? l))) `(identical? ~ocr ~l) (and *clojurescript* (keyword? l)) `(cljs.core/keyword-identical? ~ocr ~l) :else `(= ~ocr ~l)))) (defn literal-pattern [l] (LiteralPattern. l (meta l))) (defn literal-pattern? [x] (instance? LiteralPattern x)) (defmethod print-method LiteralPattern [p ^Writer writer] (.write writer (str ""))) ;; ----------------------------------------------------------------------------- ;; # Seq Pattern ;; ;; A Seq Pattern is intended for matching `seq`s. They are split into ;; multiple patterns, testing each element of the seq in order. (declare seq-pattern? rest-pattern? seq-pattern) (defn specialize-seq-pattern-rest-row [focr row] (let [p (first row) p (if (seq-pattern? p) (:p (first (:s p))) ;; unwrap rest pattern (wildcard-pattern))] (prepend (drop-nth-bind row 0 focr) p))) (defn specialize-seq-pattern-rest-matrix [rows focr] (->> rows (map (partial specialize-seq-pattern-rest-row focr)) vec)) (defn seq-pattern-matrix-rest-ocrs [ocrs focr] ocrs) (defn specialize-seq-pattern-row [focr row] (let [p (first row) [h t] (if (seq-pattern? p) (let [[h & t] (:s p) t (cond (empty? t) (literal-pattern ()) (rest-pattern? (first t)) (:p (first t)) :else (seq-pattern t))] [h t]) [(wildcard-pattern) (wildcard-pattern)])] (reduce prepend (drop-nth-bind row 0 focr) [t h]))) (defn specialize-seq-pattern-matrix [rows focr] (->> rows (map (partial specialize-seq-pattern-row focr)) vec)) (defn seq-pattern-matrix-ocrs [ocrs focr] (let [seq-sym (or (-> focr meta :seq-sym) focr) sym-meta {:occurrence-type :seq :seq-sym focr} hsym (gensym (str (name seq-sym) "_head__")) hsym (with-meta hsym (assoc sym-meta :bind-expr `(first ~focr))) tsym (gensym (str (name seq-sym) "_tail__")) tsym (with-meta tsym (assoc sym-meta :bind-expr `(rest ~focr)))] (into [hsym tsym] (drop-nth ocrs 0)))) (deftype SeqPattern [s _meta] Object (toString [_] (str s)) clojure.lang.IObj (meta [_] _meta) (withMeta [_ new-meta] (SeqPattern. s new-meta)) clojure.lang.ILookup (valAt [this k] (.valAt this k nil)) (valAt [this k not-found] (case k :s s not-found)) IPatternCompile (to-source* [this ocr] (if (and (>= (count s) 1) (not (rest-pattern? (first s)))) `(and (or (seq? ~ocr) (sequential? ~ocr)) (seq ~ocr)) `(or (seq? ~ocr) (sequential? ~ocr)))) ISpecializeMatrix (specialize-matrix [this matrix] (let [rows (rows matrix) ocrs (occurrences matrix) focr (first ocrs)] (if-not (rest-pattern? (first s)) (let [nrows (specialize-seq-pattern-matrix rows focr) nocrs (seq-pattern-matrix-ocrs ocrs focr)] (pattern-matrix nrows nocrs)) (let [nrows (specialize-seq-pattern-rest-matrix rows focr) nocrs (seq-pattern-matrix-rest-ocrs ocrs focr)] (pattern-matrix nrows nocrs)))))) (defn ^SeqPattern seq-pattern [s] {:pre [(sequential? s) (not (empty? s))]} (SeqPattern. s nil)) (defn seq-pattern? [x] (instance? SeqPattern x)) (defmethod print-method SeqPattern [p ^Writer writer] (.write writer (str ""))) ;; ----------------------------------------------------------------------------- ;; # Rest Pattern ;; ;; A rest pattern represents the case of matching [2 3] in [1 & [2 3]] ;; It is an implementation detail of other patterns, like SeqPattern. ;; (defrecord RestPattern [p]) (defn rest-pattern [p] (RestPattern. p)) (defn rest-pattern? [x] (instance? RestPattern x)) (defmethod print-method RestPattern [p ^Writer writer] (.write writer (str ""))) ;; ----------------------------------------------------------------------------- ;; # Map Pattern ;; ;; Map patterns match maps, or any object that satisfies IMatchLookup. ;; (defn specialize-map-key-pattern-matrix [rows] (let [p (:p (ffirst rows))] (->> rows (map #(drop-nth % 0)) (map #(prepend % p)) vec))) (defrecord MapKeyPattern [p] IExistentialPattern IPatternCompile (to-source* [this ocr] `(not= ~ocr ::not-found)) ISpecializeMatrix (specialize-matrix [this matrix] (let [rows (rows matrix) ocrs (occurrences matrix) nrows (specialize-map-key-pattern-matrix rows)] (pattern-matrix nrows ocrs)))) (defn map-key-pattern [p] (MapKeyPattern. p)) (defn map-key-pattern? [x] (instance? MapKeyPattern x)) (defmethod print-method MapKeyPattern [p ^Writer writer] (.write writer (str ""))) (declare map-pattern? guard-pattern) (defn row-keys [row env] (let [p (first row) only (-> p meta :only)] (when (and (not @(:only? env)) (seq only)) (reset! (:only? env) true)) [(set (keys (:m p))) (set only)])) (defn get-all-keys [rows env] (->> rows (remove (comp wildcard-pattern? first)) (map #(row-keys % env)) (reduce concat) (reduce set/union #{}))) (defn wrap-values [m] (->> m (map (fn [[k v]] [k (if (wildcard-pattern? v) (map-key-pattern v) v)])) (into {}))) (defn get-ocr-map [p {:keys [only all-keys wc-map]}] (if (map-pattern? p) (merge (when only (zipmap all-keys (repeat (literal-pattern ::not-found)))) wc-map (wrap-values (:m p))) wc-map)) (defn specialize-map-pattern-row [row {:keys [all-keys only? focr] :as env}] (let [p (first row) only (seq (-> p meta :only)) ocr-map (get-ocr-map p (assoc env :only only)) ps (doall (map ocr-map all-keys)) ps (if @only? (if only (let [a (with-meta (gensym) {:tag 'java.util.Map})] (cons (guard-pattern (wildcard-pattern) (set [(if *clojurescript* `(fn [~a] (= (set (keys ~a)) #{~@only})) `(fn [~a] (= (.keySet ~a) #{~@only})))])) ps)) (cons (wildcard-pattern) ps)) ps)] (reduce prepend (drop-nth-bind row 0 focr) (reverse ps)))) (defn specialize-map-pattern-matrix [rows env] (vec (map #(specialize-map-pattern-row % env) rows))) (defn gen-map-pattern-ocr [ocr k] (gensym (str (name ocr) "_" (.replace (name k) "." "_DOT_") "__"))) (defn map-pattern-matrix-ocr-sym [k env] (let [focr (:focr env) ocr (get-in env [:ocrs-map k])] (with-meta ocr {:occurrence-type :map :key k :map-sym focr :bind-expr (val-at-expr focr k ::not-found)}))) (defn map-pattern-matrix-ocrs [ocrs env] (let [focr (:focr env) mocrs (map #(map-pattern-matrix-ocr-sym % env) (:all-keys env)) mocrs (vec (if @(:only? env) (cons focr mocrs) mocrs))] (into mocrs (drop-nth ocrs 0)))) (deftype MapPattern [m _meta] Object (toString [_] (str m " :only " (or (:only _meta) []))) (equals [_ other] (and (instance? MapPattern other) (= m (:m other)))) clojure.lang.IObj (meta [_] _meta) (withMeta [_ new-meta] (MapPattern. m new-meta)) clojure.lang.ILookup (valAt [this k] (.valAt this k nil)) (valAt [this k not-found] (case k :m m not-found)) IPatternCompile (to-source* [this ocr] (if *clojurescript* `(satisfies? cljs.core/ILookup ~ocr) `(or (instance? clojure.lang.ILookup ~ocr) (satisfies? IMatchLookup ~ocr)))) ISpecializeMatrix (specialize-matrix [this matrix] (let [rows (rows matrix) ocrs (occurrences matrix) focr (first ocrs) env {:focr focr :only? (atom false)} all-keys (get-all-keys rows env) env' (assoc env :all-keys all-keys :wc-map (zipmap all-keys (repeatedly wildcard-pattern)) :ocrs-map (zipmap all-keys (map #(gen-map-pattern-ocr focr %) all-keys))) nrows (specialize-map-pattern-matrix rows env') nocrs (map-pattern-matrix-ocrs ocrs env')] (pattern-matrix nrows nocrs)))) (defn map-pattern ([] (MapPattern. {} nil)) ([m] {:pre [(map? m)]} (MapPattern. m nil))) (defn map-pattern? [x] (instance? MapPattern x)) (defmethod print-method MapPattern [p ^Writer writer] (.write writer (str ""))) ;; ----------------------------------------------------------------------------- ;; Vector Pattern ;; ;; Vector patterns match any Sequential data structure. Note this means that ;; the lazy semantics may mean poorer performance for sequences. (declare vector-pattern?) (defn calc-rest?-and-min-size [rows env] (reduce (fn [[rest? min-size] [p & ps]] (if (vector-pattern? p) [(or rest? (:rest? p)) (min min-size (:size p))] [rest? min-size])) [false (-> env :fp :size)] rows)) (defn specialize-vector-pattern-row [row {:keys [focr min-size]}] (let [p (first row) ps (cond (vector-pattern? p) (split p min-size) :else [(wildcard-pattern) (wildcard-pattern)])] (reduce prepend (drop-nth-bind row 0 focr) (reverse ps)))) (defn specialize-vector-pattern-row-non-rest [row {:keys [focr min-size]}] (let [p (first row) ps (if (vector-pattern? p) (reverse (:v p)) (repeatedly min-size wildcard-pattern))] (reduce prepend (drop-nth-bind row 0 focr) ps))) (defn specialize-vector-pattern-matrix [rows env] (if (:rest? env) (vec (map #(specialize-vector-pattern-row % env) rows)) (vec (map #(specialize-vector-pattern-row-non-rest % env) rows)))) (defn vector-pattern-ocr-sym [{:keys [pat focr tag]} i] (let [ocr (gensym (str (name focr) "_" i "__"))] (with-meta ocr {:occurrence-type tag :vec-sym focr :index i :bind-expr (if-let [offset (:offset pat)] (nth-offset-inline tag (with-tag tag focr) i offset) (nth-inline tag (with-tag tag focr) i))}))) (defn vector-pattern-matrix-ocrs [ocrs {:keys [focr tag min-size rest?] :as env}] (if rest? (let [ocr-meta {:occurrence-type tag :vec-sym focr} vl-ocr (gensym (str (name focr) "_left__")) vl-ocr (with-meta vl-ocr (assoc ocr-meta :bind-expr (subvec-inline tag (with-tag tag focr) 0 min-size ))) vr-ocr (gensym (str (name focr) "_right__")) vr-ocr (with-meta vr-ocr (assoc ocr-meta :bind-expr (subvec-inline tag (with-tag tag focr) min-size)))] (into [vl-ocr vr-ocr] (drop-nth ocrs 0))) (concat (map (partial vector-pattern-ocr-sym env) (range min-size)) (drop-nth ocrs 0)))) (defn array-tag [x] (get '{bytes ::array shorts ::shorts ints ::ints longs ::longs doubles ::doubles objects ::objects} (-> x meta :tag))) ;; v - the patterns ;; t - the type, for optimizing via specialization ;; size - size of the pattern if known ;; rest? - contains a rest pattern (deftype VectorPattern [v t size offset rest? _meta] Object (toString [_] (str v " " t)) (equals [_ other] (and (instance? VectorPattern other) (= [v t size offset rest?] (map #(% other) [:v :t :size :offset :rest?])))) clojure.lang.IObj (meta [_] _meta) (withMeta [_ new-meta] (VectorPattern. v t size offset rest? new-meta)) clojure.lang.ILookup (valAt [this k] (.valAt this k nil)) (valAt [this k not-found] (case k :v v :t t :size size :offset offset :rest? rest? not-found)) IPatternCompile (to-source* [this ocr] (let [t (or (array-tag ocr) t)] (if (check-size? t) (if rest? (test-with-min-size-inline t ocr size) (test-with-size-inline t ocr size)) (test-inline t ocr)))) IContainsRestPattern (contains-rest-pattern? [_] rest?) IVectorPattern (split [this n] (let [lv (subvec v 0 n) rv (subvec v n) pl (VectorPattern. lv t n offset false _meta) pr (if (rest-pattern? (first rv)) (:p (first rv)) (let [rest? (some rest-pattern? rv) rvc (count rv) size (if rest? (dec rvc) rvc)] (VectorPattern. rv t size n rest? _meta)))] [pl pr])) ISpecializeMatrix (specialize-matrix [this matrix] (let [rows (rows matrix) ocrs (occurrences matrix) focr (first ocrs) env {:focr focr :fp (ffirst rows) :pat this} [rest? min-size] (calc-rest?-and-min-size rows env) env' (assoc env :rest? rest? :min-size min-size :tag (or (array-tag focr) (:t this))) nrows (specialize-vector-pattern-matrix rows env') nocrs (vector-pattern-matrix-ocrs ocrs env')] (pattern-matrix nrows nocrs)))) (defn vector-pattern ([] (vector-pattern [] ::vector nil nil)) ([v] (vector-pattern v ::vector nil nil)) ([v t] (vector-pattern v t nil nil)) ([v t offset] (vector-pattern v t offset nil)) ([v t offset rest?] {:pre [(vector? v)]} (let [c (count v) size (if rest? (dec c) c)] (VectorPattern. v t size offset rest? nil)))) (defn vector-pattern? [x] (instance? VectorPattern x)) (defmethod print-method VectorPattern [p ^Writer writer] (.write writer (str ""))) ;; ----------------------------------------------------------------------------- ;; Or Patterns (defn specialize-or-pattern-row [row pat ps] (let [p (first row)] ;; NOTE: hmm why can't we remove this - David (if (and (groupable? pat p) (not (wildcard-pattern? p))) (map (fn [p] (update-pattern row 0 p)) ps) [row]))) (defn specialize-or-pattern-matrix [rows pat ps] (vec (apply concat (map #(specialize-or-pattern-row % pat ps) rows)))) (deftype OrPattern [ps _meta] IPseudoPattern Object (toString [this] (str ps)) (equals [_ other] (and (instance? OrPattern other) (= ps (:ps other)))) clojure.lang.IObj (meta [_] _meta) (withMeta [_ new-meta] (OrPattern. ps new-meta)) clojure.lang.ILookup (valAt [this k] (.valAt this k nil)) (valAt [this k not-found] (case k :ps ps not-found)) ISpecializeMatrix (specialize-matrix [this matrix] (let [rows (rows matrix) ocrs (occurrences matrix) nrows (specialize-or-pattern-matrix rows this ps)] (pattern-matrix nrows ocrs)))) (defn or-pattern [p] {:pre [(vector? p)]} (OrPattern. p nil)) (defn or-pattern? [x] (instance? OrPattern x)) (defmethod print-method OrPattern [p ^Writer writer] (.write writer (str ""))) ;; ----------------------------------------------------------------------------- ;; ## Guard Patterns ;; ;; Guard patterns are used to represent guards on patterns, for example ;; `(1 :guard even?)` ;; (declare guard-pattern?) (defn specialize-guard-pattern-matrix [rows] (->> rows (map (fn [[p :as row]] (if (guard-pattern? p) (update-pattern row 0 (:p p)) row))) vec)) (deftype GuardPattern [p gs _meta] Object (toString [this] (str p " :guard " gs)) (equals [_ other] (and (instance? GuardPattern other) (= p (:p other)) (= gs (:gs other)))) clojure.lang.IObj (meta [_] _meta) (withMeta [_ new-meta] (GuardPattern. p gs new-meta)) clojure.lang.ILookup (valAt [this k] (.valAt this k nil)) (valAt [this k not-found] (case k :p p :gs gs not-found)) IPatternCompile (to-source* [this ocr] `(and ~@(map (fn [expr ocr] (list expr ocr)) gs (repeat ocr)))) ISpecializeMatrix (specialize-matrix [this matrix] (let [rows (rows matrix) ocrs (occurrences matrix) nrows (specialize-guard-pattern-matrix rows)] (pattern-matrix nrows ocrs)))) (defn guard-pattern [p gs] {:pre [(set? gs)]} (GuardPattern. p gs nil)) (defn guard-pattern? [x] (instance? GuardPattern x)) (defmethod print-method GuardPattern [p ^Writer writer] (.write writer (str ""))) ;; ----------------------------------------------------------------------------- ;; ## Predicate Patterns ;; ;; Predicate patterns are used to represent simple guards on patterns, ;; for example ;; `(1 :when even?)` ;; ;; The predicates in predicate patterns should not overlap. That is, ;; no two predicates should return the same answer given the same ;; input. For example, in the unlikely case that there was a function ;; named `four?` and defined as `(defn four? [x] (= 4 x))`, then using ;; `x :when four?` and `y :when even?` in the same match expression ;; will yield an incorrect decision tree. In cases where overlapping ;; predicates are desired, use guard patterns. ;; (def preds (atom {})) (defmacro defpred ([name] (swap! preds assoc name name)) ([name f] (swap! preds assoc name f))) (declare predicate-pattern?) (defn specialize-predicate-pattern-matrix [rows] (->> rows (map (fn [[p :as row]] (if (predicate-pattern? p) (update-pattern row 0 (:p p)) row))) vec)) (deftype PredicatePattern [p gs _meta] Object (toString [this] (str p " :when " gs)) (equals [_ other] (and (instance? PredicatePattern other) (= p (:p other)) (= gs (:gs other)))) clojure.lang.IObj (meta [_] _meta) (withMeta [_ new-meta] (PredicatePattern. p gs new-meta)) clojure.lang.ILookup (valAt [this k] (.valAt this k nil)) (valAt [this k not-found] (case k :p p :gs gs not-found)) IPatternCompile (to-source* [this ocr] `(and ~@(map (fn [expr ocr] (list expr ocr)) gs (repeat ocr)))) ISpecializeMatrix (specialize-matrix [this matrix] (let [rows (rows matrix) ocrs (occurrences matrix) nrows (specialize-predicate-pattern-matrix rows)] (pattern-matrix nrows ocrs)))) (defn predicate-pattern [p gs] {:pre [(set? gs)]} (PredicatePattern. p gs nil)) (defn predicate-pattern? [x] (instance? PredicatePattern x)) (defmethod print-method PredicatePattern [p ^Writer writer] (.write writer (str ""))) ;; ----------------------------------------------------------------------------- ;; Pattern Comparisons (defmethod groupable? [LiteralPattern LiteralPattern] [a b] (= (:l a) (:l b))) (defmethod groupable? [GuardPattern GuardPattern] [a b] (= (:gs a) (:gs b))) (defmethod groupable? [PredicatePattern PredicatePattern] [a b] (= (:gs a) (:gs b))) (defmethod groupable? [MapPattern MapPattern] [a b] (= (-> a meta :only) (-> b meta :only))) (defmethod groupable? [OrPattern OrPattern] [a b] (let [as (:ps a) bs (:ps b)] (and (= (count as) (count bs)) (every? identity (map groupable? as bs))))) (defmethod groupable? [VectorPattern VectorPattern] [a b] (and (= (:rest? a) (:rest? b)) (= (:size a) (:size b)))) ;; ============================================================================= ;; # Interface (defmulti to-source "Returns a Clojure form that, when executed, is truthy if the pattern matches the occurrence. Dispatches on the `type` of the pattern. For instance, a literal pattern might return `(= ~(:pattern pattern) ~ocr)`, using `=` to test for a match." (fn [pattern ocr] (type pattern))) (defmulti emit-pattern "Returns the corresponding pattern for the given syntax. Dispatches on the class of its argument. For example, `[(:or 1 2) 2]` is dispatched as clojure.lang.IPersistentVector" class) ;; ============================================================================ ;; # emit-pattern Methods (defn emit-patterns ([ps t] (emit-patterns ps t [])) ([ps t v] (if (empty? ps) v (let [p (first ps)] (cond (= p '&) (let [p (second ps) rp (if (and (vector? p) (= t :seq)) (seq-pattern (emit-patterns p t)) (emit-pattern p))] (recur (nnext ps) t (conj v (rest-pattern rp)))) :else (recur (next ps) t (conj v (emit-pattern (first ps))))))))) (defmethod emit-pattern clojure.lang.IPersistentVector [pat] (let [ps (emit-patterns pat :vector)] (vector-pattern ps *vector-type* 0 (some rest-pattern? ps)))) (defmethod emit-pattern clojure.lang.IPersistentMap [pat] (map-pattern (->> pat (map (fn [[k v]] [k (emit-pattern v)])) (remove nil?) (into {})))) (defmethod emit-pattern clojure.lang.Symbol [pat] (if (not= (get *locals* pat ::not-found) ::not-found) (literal-pattern (with-meta pat (assoc (meta pat) :local true))) (wildcard-pattern pat))) (defmethod emit-pattern :default [pat] (literal-pattern pat)) (declare emit-pattern-for-syntax or-pattern as-pattern guard-pattern predicate-pattern vector-pattern) (defmethod emit-pattern clojure.lang.ISeq [pat] (if (and (= (count pat) 2) (= (first pat) 'quote) (or (symbol? (second pat)) (keyword? (second pat)))) (literal-pattern (second pat)) (emit-pattern-for-syntax pat))) (defmulti emit-pattern-for-syntax "Handles patterns wrapped in the special list syntax. Dispatches on the first or second keyword in the list. For example, the pattern `(:or 1 ...) is dispatches as :or, and `(1 :as a)` is dispatched by :as." (fn [[f s]] (if (keyword? f) [f :default] [:default s]))) (defmethod emit-pattern-for-syntax [:or :default] [pat] (or-pattern (->> (rest pat) (map emit-pattern) (into [])))) (defmethod emit-pattern-for-syntax [:default :as] [[p _ sym]] (with-meta (emit-pattern p) {:as sym})) (defmethod emit-pattern-for-syntax [:default :when] [[p _ gs]] (let [gs (if (not (vector? gs)) [gs] gs)] (assert (every? symbol? gs) (str "Invalid predicate expression " gs)) (assert (every? #(contains? @preds %) gs) (str "Unknown predicate in " gs)) (predicate-pattern (emit-pattern p) (set gs)))) (defmethod emit-pattern-for-syntax [:default :guard] [[p _ gs]] (let [gs (if (not (vector? gs)) [gs] gs)] (guard-pattern (emit-pattern p) (set gs)))) (defmethod emit-pattern-for-syntax [:default :seq] [pat] (let [p (first pat)] (if (empty? p) (literal-pattern ()) (seq-pattern (emit-patterns p :seq))))) (defmethod emit-pattern-for-syntax [:default ::vector] [[p t offset-key offset]] (let [ps (emit-patterns p :vector)] (vector-pattern ps t offset (some rest-pattern? ps)))) (defmethod emit-pattern-for-syntax [:default :only] [[p _ only]] (with-meta (emit-pattern p) {:only only})) (defmethod emit-pattern-for-syntax :default [[_ s :as l]] (throw (AssertionError. (str "Invalid list syntax " s " in " l ". " "Valid syntax: " (vec (remove #(= % :default) (keys (.getMethodTable ^clojure.lang.MultiFn emit-pattern-for-syntax)))))))) (let [void (Object.) void? #(identical? void %) infix-keyword? #(#{:when :as :guard} %)] ;; void is a unique placeholder for nothing -- we can't use nil ;; because that's a legal symbol in a pattern row (defn regroup-keywords [pattern] (cond (vector? pattern) (first (reduce (fn [[result p q] r] (cond (void? p) [result q r] (and (not (void? r)) (infix-keyword? q)) [(conj result (list (regroup-keywords p) q r)) void void] :else [(conj result (regroup-keywords p)) q r])) [[] void void] (conj pattern void void))) (seq? pattern) (cons (regroup-keywords (first pattern)) (rest pattern)) :else pattern))) (defn group-keywords "Returns a pattern with pattern-keywords (:when and :as) properly grouped. The original pattern may use the 'flattened' syntax. For example, a 'flattened' pattern row like [a b :when even?] is grouped as [a (b :when even?)]." [pattern] (if (vector? pattern) (regroup-keywords pattern) pattern)) (defn to-pattern-row "Take an unprocessed pattern expression and an action expression and return a pattern row of the processed pattern expression plus the action epxression." [pat action] (let [ps (map emit-pattern (group-keywords pat))] (pattern-row ps action))) (defn wildcards-and-duplicates "Returns a vector of two elements: the set of all wildcards and the set of duplicate wildcards. The underbar _ is excluded from both." [patterns] (loop [remaining patterns seen #{} dups #{}] (if-let [patterns (seq remaining)] (let [pat (first patterns) pats (rest patterns)] (cond (or (= pat '_) (= pat '&)) (recur pats seen dups) (symbol? pat) (if (contains? seen pat) (recur pats seen (conj dups pat)) (recur pats (conj seen pat) dups)) (vector? pat) (recur (concat pats pat) seen dups) (map? pat) (recur (concat pats (vals pat)) seen dups) (seq? pat) (cond (= (first pat) 'quote) (recur pats seen dups) (= (first pat) :or) (let [wds (map wildcards-and-duplicates (map list (take-nth 2 pat))) mseen (apply set/union (map first wds))] (recur pats (set/union seen mseen) (apply set/union dups (set/intersection seen mseen) (map second wds)))) (= (second pat) :as) (recur (concat pats (take-nth 2 pat)) seen dups) :else (recur (conj pats (first pat)) seen dups)) :else (recur pats seen dups))) [seen dups]))) (defn find-duplicate-wildcards [pattern] (second (wildcards-and-duplicates pattern))) (defn check-pattern [pat vars nvars rownum] (let [pat (group-keywords pat)] (when (not (vector? pat)) (throw (AssertionError. (str "Pattern row " rownum ": Pattern rows must be wrapped in []." " Try changing " pat " to [" pat "]." (when (list? pat) (str " Note: pattern rows are not patterns." " They cannot be wrapped in a :when guard, for example")))))) (when (not= (count pat) nvars) (throw (AssertionError. (str "Pattern row " rownum ": Pattern row has differing number of patterns. " pat " has " (count pat) " pattern/s, expecting " nvars " for occurrences " vars)))) (when-let [duplicates (seq (find-duplicate-wildcards pat))] (throw (AssertionError. (str "Pattern row " rownum ": Pattern row reuses wildcards in " pat ". The following wildcards are ambiguous: " (apply str (interpose ", " (sort duplicates))) ". There's no guarantee that the matched values will be same." " Rename the occurrences uniquely.")))))) ;; This could be scattered around in other functions to be more efficient ;; Turn off *syntax-check* to disable (defn check-matrix-args [vars clauses] (when (symbol? vars) (throw (AssertionError. (str "Occurrences must be in a vector." " Try changing " vars " to [" vars "]")))) (when (not (vector? vars)) (throw (AssertionError. (str "Occurrences must be in a vector. " vars " is not a vector")))) (let [nvars (count vars) cls (partition 2 clauses)] (doseq [[[pat _] rownum] (map vector (butlast cls) (rest (range)))] (when (= :else pat) (throw (AssertionError. (str "Pattern row " rownum ": :else form only allowed on final pattern row")))) (check-pattern pat vars nvars rownum)) (when-let [[pat _] (last cls)] (when-not (= :else pat) (check-pattern pat vars nvars (count cls))))) (when (odd? (count clauses)) (throw (AssertionError. (str "Uneven number of Pattern Rows. The last form `" (last clauses) "` seems out of place."))))) (defn process-vars "Process the vars for the pattern matrix. If user provides an expression, create a var and annotate via metadata with the original expression." [vars] (letfn [(process-var [var] (if-not (symbol? var) (let [nsym (gensym "ocr-")] (with-meta nsym {:ocr-expr var})) var))] (vec (map process-var vars)))) (defn emit-matrix "Take the list of vars and sequence of unprocessed clauses and return the pattern matrix. The pattern matrix contains the processed pattern rows and the list of vars originally specified. Inserts a last match - :else if provided by the user or a default match that throws." ([vars clauses] (emit-matrix vars clauses true)) ([vars clauses default] (let [cs (partition 2 clauses) vs (process-vars vars) cs (let [[p a] (last cs) last-match (vec (repeat (count vars) '_))] (if (= :else p) (conj (vec (butlast cs)) [last-match a]) ;; TODO: throw an exception if :else line not provided - David (if default (conj (vec cs) [last-match (if *clojurescript* `(throw (js/Error. (str "No matching clause: " ~@(interpose " " vs)))) `(throw (IllegalArgumentException. (str "No matching clause: " ~@(interpose " " vs)))))]) cs)))] (pattern-matrix (vec (map #(apply to-pattern-row %) cs)) (process-vars vs))))) (defn executable-form [node] (n-to-clj node)) ;; TODO: more sophisticated analysis that actually checks that recur is ;; not being used as a local binding when it occurs - David (defn recur-present? [actions] (letfn [(analyze-action [action] (if (and (sequential? action) (some '#{recur} (flatten action))) {:recur-present true} {}))] (some :recur-present (map analyze-action actions)))) (defn clj-form [vars clauses] (when @*syntax-check* (check-matrix-args vars clauses)) (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)))) ;; ============================================================================ ;; # Match macros (defmacro match "Pattern match a row of occurrences. Take a vector of occurrences, vars. Clause question-answer syntax is like `cond`. Questions must be wrapped in a vector, with same arity as vars. Last question can be :else, which expands to a row of wildcards. Optionally may take a single var not wrapped in a vector, questions then need not be wrapped in a vector. Example: (let [x 1 y 2] (match [x y 3] [1 2 3] :answer1 :else :default-answer))" [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 [*line* (-> &form meta :line) *locals* (dissoc &env '_) *warned* (atom false)] `~(clj-form vars clauses)))) (defmacro matchv [type vars & clauses] (binding [*vector-type* type *line* (-> &form meta :line) *locals* (dissoc &env '_) *warned* (atom false)] `~(clj-form vars clauses))) (defmacro match-let [bindings & body] (let [bindvars# (take-nth 2 bindings)] `(let ~bindings (match [~@bindvars#] ~@body)))) libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match/000075500000000000000000000000001237337625200245425ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match/array.clj000064400000000000000000000060351237337625200263560ustar00rootroot00000000000000;; WARNING: this namespace is experimental (ns ^{:skip-wiki true} clojure.core.match.array (:refer-clojure :exclude [compile]) (:use [clojure.core.match :as m])) (set! *warn-on-reflection* true) ;; ============================================================================= ;; Shared (derive ::m/array ::m/vector) (defmethod nth-inline ::m/array [t ocr i] `(aget ~ocr ~i)) (defmethod count-inline ::m/array [t ocr] `(alength ~ocr)) (defmethod subvec-inline ::m/array ([_ ocr start] ocr) ([_ ocr start end] ocr)) ;; ============================================================================= ;; ints (derive ::m/ints ::m/array) (defmethod tag ::m/ints [_] "[I") ;; ============================================================================= ;; objects (derive ::m/objects ::m/array) (defmethod tag ::m/objects [_] "[Ljava.lang.Object;") (comment ;; specialize based on type hints in match (let [x (int-array [1 2 3])] (match [^ints x] [[_ _ 2]] :a0 [[1 1 3]] :a1 [[1 2 3]] :a2 :else :a3)) ;; FIXME (let [x (int-array [1 2 3 4])] (match [^ints x] [[_ _ 2 & _]] :a0 [[1 1 3 & _]] :a1 [[1 2 3 & _]] :a2 :else :a3)) (let [x (int-array [1 2 3])] (match [x] [([_ _ 2] ::m/ints)] :a0 [([1 1 3] ::m/ints)] :a1 [([1 2 3] ::m/ints)] :a2 :else :a3)) ;; ~100ms (let [x (int-array [1 2 3])] (dotimes [_ 5] (time (dotimes [_ 1e7] (match [^ints x] [[_ _ 2]] :a0 [[1 1 3]] :a1 [[1 2 3]] :a2))))) ;; offsets ;; FIXME: needs to account for offset - David (let [x (int-array [1 1 2 3]) o 1] (match [x] [([_ _ 2] ::m/ints :offset o)] :a0 [([1 1 3] ::m/ints :offset o)] :a1 [([1 2 3] ::m/ints :offset o)] :a2)) ;; 80ms (let [x (int-array [1 1 2 3]) o 1] (dotimes [_ 10] (time (dotimes [_ 1e7] (match [x] [([_ _ 2] ::m/ints :offset o)] :a0 [([1 1 3] ::m/ints :offset o)] :a1 [([1 2 3] ::m/ints :offset o)] :a2))))) (do (set! *warn-on-reflection* true) (defmacro asets [a vs] `(do ~@(map (fn [a b c] (concat a (list b c))) (repeat `(aset ~a)) (range (count vs)) vs) ~a)) (defn B [l v r] (let [^objects o (make-array Object 4)] (asets o [:black l v r]))) (defn R [l v r] (let [^objects o (make-array Object 4)] (asets o [:red l v r]))) (defn balance-array [node] (matchv ::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]] [:black a x [:red b y [:red c z d]]])] :balance :else :balanced)) ;; 200ms (let [node (B nil nil (R nil nil (R nil nil nil)))] (dotimes [_ 10] (time (dotimes [_ 1e7] (balance-array node))))) #_(let [node (B nil nil (R nil nil (B nil nil nil)))] (balance-array node)) ) ) libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match/bench.clj000064400000000000000000000021041237337625200263100ustar00rootroot00000000000000(ns ^{:skip-wiki true} clojure.core.match.bench (:use [clojure.core.match :only [match]])) (comment ;; 1.7ghz MBA timings ;; ~200ms (dotimes [_ 5] (time (dotimes [i 1e6] (let [x (zero? (mod i 2)) y (zero? (mod i 3)) z (zero? (mod i 5))] (match [x y z] [_ false true] 1 [false true _ ] 2 [_ _ false] 3 [_ _ true] 4 :else 5))))) ;; ~50ms (let [x {:a 1 :b 1}] (dotimes [_ 5] (time (dotimes [_ 1e6] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil))))) ;; ~500ms (let [n [:black [:red [:red 1 2 3] 3 4] 5 6]] (dotimes [_ 5] (time (dotimes [_ 1e6] (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]] [:black a x [:red b y [:red c z d]]])] :balance :else :valid))))) ) libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match/binary.clj000064400000000000000000000027501237337625200265240ustar00rootroot00000000000000;; WARNING: this namespace is experimental (ns ^{:skip-wiki true} clojure.core.match.binary (:refer-clojure :exclude [compile]) (:use [clojure.core.match :as m])) (derive ::m/binary ::m/vector) (defmethod check-size? ::m/binary [_] false) (defmethod test-inline ::m/binary [_ ocr] `(instance? Long ~ocr)) (defmethod nth-inline ::m/binary [_ ocr i] `(bit-shift-right (bit-and ~ocr (bit-shift-left 1 ~i)) ~i)) (comment (let [x 5] (match [x] [([_ _ 1 1] ::m/binary)] :a0 [([1 0 1 _] ::m/binary)] :a1 :else :a2)) (let [x 5] (dotimes [_ 10] (time (dotimes [_ 1e7] (match [x] [([_ _ 1 1] ::m/binary)] :a0 [([1 0 1 _] ::m/binary)] :a1 :else :a2))))) ) (comment (match [dgram] [([(ip-version 4) ((hlen 4) :when [#(>= % 5) #(<= (* 4 %) drgramsize)]) (srvc-type 8) (totlen 16) (id 16) (flgs 3) (fragoff 13) (ttl 8) (proto 8) (hdrchksum 16) (srcip 32) (destip 32) & restdgram] ::m/binary)]) ) ;; Erlang ;; ;; -define (IP_VERSION, 4). ;; -define (IP_MIN_HDR_LEN, 5). ;; DgramSize = byte_size (Dgram), ;; case Dgram of ;; <> when HLen>=5, 4*HLen= ;; OptsLen = 4* (HLen - ?IP_MIN_HDR_LEN), ;; <> = RestDgram, ;; ... ;; end. libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match/date.clj000064400000000000000000000003201237337625200261440ustar00rootroot00000000000000(ns clojure.core.match.date (:use [clojure.core.match.java :only [bean-match]])) ;; # Date Extension ;; ;; This is an example of how to enable Java Beans for pattern matching. (bean-match java.util.Date) libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match/debug.clj000064400000000000000000000035331237337625200263260ustar00rootroot00000000000000(ns ^{:skip-wiki true} clojure.core.match.debug (:refer-clojure :exclude [compile]) (:use [clojure.core.match.protocols] [clojure.core.match :only [emit-matrix compile occurrences rows action-for-row clj-form]]) (:require [clojure.pprint :as pp])) (defn source-pprint [source] (binding [pp/*print-pprint-dispatch* pp/code-dispatch pp/*print-suppress-namespaces* true] (pp/pprint source))) (defmacro with-recur [form] `(binding [clojure.core.match/*recur-present* true] ~form)) (defmacro build-matrix [vars & clauses] `(emit-matrix '~vars '~clauses false)) (defmacro m-to-matrix [vars & clauses] `(-> (build-matrix ~vars ~@clauses) pprint-matrix)) (defmacro m-to-dag [vars & clauses] (binding [clojure.core.match/*line* (-> &form meta :line) clojure.core.match/*locals* &env clojure.core.match/*warned* (atom false)] `~(-> (emit-matrix vars clauses) compile pp/pprint))) (defmacro m-to-clj [vars & clauses] (binding [clojure.core.match/*line* (-> &form meta :line) clojure.core.match/*locals* &env clojure.core.match/*warned* (atom false)] (try (-> (clj-form vars clauses) source-pprint) (catch AssertionError e `(throw (AssertionError. ~(.getMessage e))))))) (defn pprint-matrix ([pm] (pprint-matrix pm 4)) ([pm col-width] (binding [*out* (pp/get-pretty-writer *out*)] (print "|") (doseq [o (occurrences pm)] (pp/cl-format true "~4D~7,vT" o col-width)) (print "|") (prn) (doseq [[i row] (map-indexed (fn [p i] [p i]) (rows pm))] (print "|") (doseq [p (:ps row)] (pp/cl-format true "~4D~7,vT" (str p) col-width)) (print "|") (print " " (action-for-row pm i)) (prn)) (println)))) libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match/java.clj000064400000000000000000000034331237337625200261600ustar00rootroot00000000000000(ns clojure.core.match.java (:use [clojure.core.match.protocols] [clojure.core.match :only [match]] [clojure.string :only [lower-case]])) (def ^:private method-name-pattern #"^(is|get)([A-Z].*)$") (defn- dash-case [^String s] (let [gsub (fn [s re sub] (.replaceAll (re-matcher re s) sub))] (-> s (gsub #"([A-Z]+)([A-Z][a-z])" "$1-$2") (gsub #"([a-z]+)([A-Z])" "$1-$2") (lower-case)))) (defn- keywordize [^String s] (let [[_ pre n] (re-find (re-matcher method-name-pattern s))] (-> n dash-case (str (if (= pre "is") "?")) keyword))) (defmacro bean-match "Generate an implementation of match.core/IMatchLookup for a Java bean. Accessor method names are mapped to keys like this: isVisible -> :visible? getText -> :text getAbsolutePath -> :absolute-path isFUD -> :fud? getFUDFactor -> :fud-factor " [class] (let [method-names (->> (.getMethods ^Class (resolve class)) ; Methods that have is/get naming, no args and non-void return (filter (fn [^java.lang.reflect.Method m] (and (re-find method-name-pattern (.getName m)) (= 0 (count (.getParameterTypes m))) (not= Void (.getReturnType m))))) ; Grab name as a symbol (map (fn [^java.lang.reflect.Method m] (.getName m)))) this (gensym "this")] `(extend-type ~class IMatchLookup (~'val-at [~this k# not-found#] (case k# ~@(mapcat (fn [n] [(keywordize n) `(. ~this (~(symbol n)))]) method-names) not-found#))))) libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match/protocols.clj000064400000000000000000000015621237337625200272640ustar00rootroot00000000000000(ns clojure.core.match.protocols) ;; ============================================================================= ;; # Protocols (defprotocol ISpecializeMatrix (specialize-matrix [this matrix])) (defprotocol IContainsRestPattern (contains-rest-pattern? [this])) (defprotocol IMatchLookup "Allows arbitrary objects to act like a map-like object when pattern matched. Avoid extending this directly for Java Beans, see `match.java/bean-match`." (val-at [this k not-found])) ;; TODO: consider converting to multimethods to avoid this nonsense - David (defprotocol INodeCompile (n-to-clj [this])) (defprotocol IPatternCompile (to-source* [this ocr])) (defprotocol IVecMod (prepend [this x]) (drop-nth [this n]) (swap [this n])) (defprotocol IVectorPattern (split [this n])) ;; markers (definterface IExistentialPattern) (definterface IPseudoPattern) libcore-match-clojure-0.2.2/src/main/clojure/clojure/core/match/regex.clj000064400000000000000000000017741237337625200263570ustar00rootroot00000000000000(ns clojure.core.match.regex (:use [clojure.core.match :only [emit-pattern to-source groupable?]]) (:import java.util.regex.Pattern)) ;; # Regular Expression Extension ;; ;; This extension adds support for Clojure's regular expression syntax. (defrecord RegexPattern [regex]) (defmethod emit-pattern java.util.regex.Pattern [pat] (RegexPattern. pat)) ;; Regular expressions are matched with `re-matches`. ;; ;; For example, given a pattern `#"olive"` and occurance `q`, a match occurs ;; when this expression is true: ;; ;; `(re-matches #"olive" q)` (defmethod to-source RegexPattern [pat ocr] `(re-matches ~(:regex pat) ~ocr)) ;; `java.util.regex.Pattern` doesn't override `equals`, so we reinvent it here. ;; ;; Two `Pattern`s are equal if they have the same pattern and the same flags. (defmethod groupable? [RegexPattern RegexPattern] [a b] (let [^Pattern ra (:regex a) ^Pattern rb (:regex b)] (and (= (.pattern ra) (.pattern rb)) (= (.flags ra) (.flags rb))))) libcore-match-clojure-0.2.2/src/test/000075500000000000000000000000001237337625200174435ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/cljs/000075500000000000000000000000001237337625200203765ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/cljs/core/000075500000000000000000000000001237337625200213265ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/cljs/core/match/000075500000000000000000000000001237337625200224225ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/cljs/core/match/macro_test.clj000064400000000000000000000002021237337625200252460ustar00rootroot00000000000000(ns cljs.core.match.macro-test) (defmacro test1 [] `(fn [& args#] (cljs.core.match.macros/match [1 2 3] [1 2 3] :match))) libcore-match-clojure-0.2.2/src/test/cljs/core/match/tests.cljs000064400000000000000000000500741237337625200244470ustar00rootroot00000000000000(ns cljs.core.match.tests (:require-macros [clojure.core.match :as m] [clojure.core.match.array] [cljs.core.match.macros :refer [match match* matchv matchv* asets]] [cljs.core.match.macro-test :as mt]) (:require [cljs.core.match])) (defn js-print [& args] (if (js* "typeof console != 'undefined'") (.log js/console (apply str args)) (js/print (apply str args)))) (set! *print-fn* js-print) ;; ============================================================================= ;; Basic matching (assert (= (let [x true y true z true] (match [x y z] [_ false true] 1 [false true _ ] 2 [_ _ false] 3 [_ _ true] 4 :else 5)) 4)) (assert (= ((fn [x y z done] (if (not done) (match [x y z] [_ false true] (recur x y z 1) [false true _ ] (recur x y z 2) [_ _ false] (recur x y z 3) [_ _ true] (recur x y z 4) :else 5) done)) true true true false) 4)) (assert (= (let [x 1 y 2 z 4] (match [x y z] [1 2 b] [:a0 b] [a 2 4] [:a1 a] :else [])) [:a0 4])) ;; ============================================================================= ;; Seq matching (assert (= (let [x [1]] (match [x] [1] 1 [([1] :seq)] 2 :else [])) 2)) (assert (= (let [x [1 2 nil nil nil]] (match [x] [([1] :seq)] :a0 [([1 2] :seq)] :a1 [([1 2 nil nil nil] :seq)] :a2 :else [])) :a2)) (assert (= (let [x '(1 2 4) y nil z nil] (match [x y z] [([1 2 b] :seq) _ _] [:a0 b] [([a 2 4] :seq) _ _] [:a1 a] :else [])) [:a0 4])) (assert (= (let [x '(1 2 3)] (match [x] [([1 z 4] :seq)] z [([_ _ _] :seq)] :a2 :else []) :a2))) ;; ============================================================================= ;; Map matching (assert (= (let [x {:a 1 :b 1}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil)) :a1)) (assert (= (let [x {:a 1 :b 2}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil)) :a0)) (assert (= (let [x {:c 3 :d 9 :e 4}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil)) :a2)) (assert (= (let [x {:c 3 :e 4}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil)) nil)) (assert (= (let [x {:a 1 :b 1}] (match [x] [{:a _ :b 1}] :a0 [{:a 1 :b _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a0)) (assert (= (let [x {:a 1 :b 1 :c 1}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a1)) (assert (= (let [x {:a 1 :b 1}] (match [x] [{:a _ :b 2}] :a0 [{:a _ :b _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a1)) (assert (= (let [x {:a 1}] (match [x] [{:a 1 :b 1}] :a0 [{:a _ :b _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) [])) (assert (= (let [x {:a 1 :b 1}] (match [x] [{:b 1}] :a0 [{:a _ :b _}] :a1 [{:a _ :b _}] :a2 :else [])) :a0)) (assert (= (let [x {:a 1 :b 1}] (match [x] [{}] :a0 [{:a _ :b _}] :a1 [{:a 1 :b 1}] :a2 :else [])) :a0)) (assert (= (let [x {:a 1 :b 1}] (match [x] [{:x nil :y nil}] :a0 [{:a _ :b _}] :a1 [{:a 1 :b 1}] :a2 :else [])) :a1)) (assert (= (let [x {:a 1 :b 2}] (match [x] [({:a _ :b 2} :only [:a :b])] :a0 [{:a 1 :c _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a0)) (assert (= (let [x {:a 1 :b 2 :c 3}] (match [x] [({:a _ :b 2} :only [:a :b])] :a0 [{:a 1 :c _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a1)) (assert (= (let [x {:a 1 :b 2}] (match [x] [{:a a :b b}] [:a0 a b] :else [])) [:a0 1 2])) ;; ============================================================================= ;; Seq pattern edge cases (assert (= (let [x '()] (match [x] [([] :seq)] :a0 [([1 & r] :seq)] [:a1 r] :else [])) :a0)) (assert (= (let [x '(1 2)] (match [x] [([1] :seq)] :a0 [([1 & r] :seq)] [:a1 r] :else [])) [:a1 '(2)])) (assert (= (let [x '(1 2 3 4)] (match [x] [([1] :seq)] :a0 [([_ 2 & ([a & b] :seq)] :seq)] [:a1 a b] :else [])) [:a1 3 '(4)])) ;; ============================================================================= ;; Or patterns (assert (= (let [x 4 y 6 z 9] (match [x y z] [(:or 1 2 3) _ _] :a0 [4 (:or 5 6 7) _] :a1 :else [])) :a1)) (assert (= (let [x '(1 2 3) y nil z nil] (match [x y z] [([1 (:or 3 4) 3] :seq) _ _] :a0 [([1 (:or 2 3) 3] :seq) _ _] :a1 :else [])) :a1)) (assert (= (let [x {:a 3} y nil z nil] (match [x y z] [{:a (:or 1 2)} _ _] :a0 [{:a (:or 3 4)} _ _] :a1 :else [])) :a1)) ;; ============================================================================= ;; Guard patterns ;; ============================================================================= ;; Edge cases (assert (= (let [a 1 b 1] (match [1 2] [a 3] :a1 [1 2] :a2 [2 _] :a5 [_ 3] :a4 :else :a3)) :a2)) (assert (= (let [x :as y :when z 1] (match [x y z] [a ':when 1] :success [:as _ 2] :fail :else :fail)) :success)) (assert (= (let [e '(+ 1 (+ 2 3)) op (first e) op? #(= % op)] (match [e] [([p :guard op? x ([p2 :guard op? y z] :seq)] :seq)] (list p x y z))) '(+ 1 2 3))) (assert (= (let [e '(+ 1 (+ 2 3))] (match [e] [(['+ x (['+ y z] :seq)] :seq)] (list '+ x y z))) '(+ 1 2 3))) (assert (= (let [e 'quote f 10] (match [e f] ['quote quote] quote)) 10)) (assert (= (let [e '(:a (quote 10))] (match [e] [([quote (['quote 10] :seq)] :seq)] quote)) :a)) ;; ============================================================================= ;; As pattern (assert (= (let [v [[1 2]]] (match [v] [([3 1] :seq)] :a0 [([(([1 a] :seq) :as b)] :seq)] [:a1 a b] :else [])) [:a1 2 [1 2]])) ;; ============================================================================= ;; Else cases (assert (= (let [v [1]] (match [v] [2] 1 :else 21)) 21)) (assert (= (let [v [[1 2]]] (match [v] [([1 3] :seq)] 1 :else 21)) 21)) (assert (= (let [v {:a 1}] (match [v] [{:a a}] 1 :else 21)) 1)) (assert (= (let [v 3] (match [v] [(:or 1 2)] :a0 :else :a1)) :a1)) (assert (= (->> (range 1 16) (map (fn [x] (match [(mod x 3) (mod x 5)] [0 0] "FizzBuzz" [0 _] "Fizz" [_ 0] "Buzz" :else (str x))))) '("1" "2" "Fizz" "4" "Buzz" "Fizz" "7" "8" "Fizz" "Buzz" "11" "Fizz" "13" "14" "FizzBuzz"))) ;; ============================================================================= ;; Single expressions (assert (= (let [x 3] (match x 1 :a0 2 :a1 :else :a2)) :a2)) (assert (= (let [x 3] (match (mod x 2) 1 :a0 2 :a1 :else :a2)) :a0)) ;; ============================================================================= ;; Locals matching (assert (= (let [x 2 y 2] (match [x] [0] :a0 [1] :a1 [y] :a2 :else :a3)) :a2)) (assert (= (let [x 2] (match [x] [0] :a0 [1] :a1 [2] :a2 :else :a3)) :a2)) (assert (= (let [a 1] (match [1 2] [1 3] :a0 [a 2] :a1 :else :a2)) :a1)) ;; ============================================================================= ;; More edgecases (assert (= (match [true false] [true false] 1 [false true] 2 :else (throw (js/Error. "Shouldn't be here"))) 1)) (assert (= (let [x [1 2]] (match [x] [(:or [1 2] [3 4] [5 6] [7 8] [9 10])] :a0 :else (throw (js/Error. "Shouldn't be here")))) :a0)) (assert (= (let [_ 1 x 2 y 3] (match [x y] [1 1] :a0 [_ 2] :a1 [2 3] :a2 :else :a3)) :a2)) ;; ============================================================================= ;; Vector patterns (assert (= (let [x [1 2 3]] (match [x] [([_ _ 2] ::clojure.core.match/vector)] :a0 [([1 1 3] ::clojure.core.match/vector)] :a1 [([1 2 3] ::clojure.core.match/vector)] :a2 :else :a3)) :a2)) (assert (= (let [n [:black [:red [:red 1 2 3] 3 4] 5 6]] (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]] [:black a x [:red b y [:red c z d]]])] :balance :else :valid)) :balance)) (assert (= (let [v [1 2 3 4]] (match [v] [([1 1 3 & r] ::clojure.core.match/vector)] :a0 [([1 2 4 & r] ::clojure.core.match/vector)] :a1 [([1 2 3 & r] ::clojure.core.match/vector)] :a2 :else :a3)) :a2)) (assert (= (let [v [1 2 3 4]] (let [v [1 2 3 4]] (match [v] [([1 1 3 & r] ::clojure.core.match/vector)] :a0 [([1 2 & r] ::clojure.core.match/vector)] :a1 :else :a3))) :a1)) (assert (= (let [node 1] (match [node] [[1]] :a0 [a] a :else :a1)) 1)) (assert (= (let [v []] (match [v] [[]] 1 :else 2)) 1)) (assert (= (let [v [1 2]] (match [v] [[]] :a0 [[x & r]] :a1 :else :a2)) :a1)) (assert (= (let [v [[1 2]]] (match [v] [[3 1]] :a0 [[([1 a] :as b)]] [:a1 a b] :else :a2)) [:a1 2 [1 2]])) ;; ============================================================================= ;; Yet more edge cases (assert (= (let [l '(1 2 3)] (match [l] [([a & [b & [c]]] :seq)] :a0 :else :a1)) :a0)) (assert (= (match [[:pow :x 2]] [[:pow arg pow]] 0 [[:mult & args]] 1 :else 2) 0)) (assert (= (match [false] [false] true) true)) (assert (= (match [[:plus 1 2 3]] [[:pow arg pow]] 0 [[:plus & args]] 1 :else 2)) 1) (assert (= (let [x {:a 1 :b 2 :c 10 :d 30}] (match [x] [({:a _ :b _ :c _ :d _} :only [:a :b :c :d])] :a-1 [({:a _ :b 2} :only [:a :b])] :a0 [{:a 1 :c _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a-1)) (assert (and (= (let [m {:a 1}] (match [m] [({:a 1} :only [:a])] :a0 :else :a1)) :a0) (= (let [m {:a 1 :b 2}] (match [m] [({:a 1} :only [:a])] :a0 :else :a1)) :a1))) (assert (= (let [m {:foo 1 "bar" 2}] (match [m] [{:foo 1 "bar" 2}] :a0 :else :a1)) :a0)) ;; ============================================================================= ;; Errors (assert (= (try (match :a :a (throw (js/Error.)) :else :c) (catch js/Error e :d)) :d)) ;; ============================================================================= ;; Match order (assert (= (let [x '(1 2) y 1] (match [x y] [([1] :seq) _] :a0 [_ 1] :a1 [([1 2] :seq) _] :a2 [_ 2] :a3 :else :a4)) :a1)) (assert (= (let [x '(1 2) y 1] (match [x y] [([1] :seq) _] :a0 [([1 2] :seq) _] :a2 [_ 1] :a1 [_ 2] :a3 :else :a4)) :a2)) (assert (= (let [x '(1 2) y 3] (match [x y] [([1] :seq) _] :a0 [_ 1] :a1 [([1 2] :seq) _] :a2 [_ 2] :a3 :else :a4)) :a2)) (assert (= (let [x '(1) y 3] (match [x y] [([1] :seq) _] :a0 [_ 1] :a1 [([1 2] :seq) _] :a2 [_ 2] :a3 :else :a4)) :a0)) (assert (= (let [x '(1 2 3) y 2] (match [x y] [([1] :seq) _] :a0 [_ 1] :a1 [([1 2] :seq) _] :a2 [_ 2] :a3 :else :a4)) :a3)) (assert (= (match [["foo"]] [["foo"]] :a0 [["foo" a]] :a1 [["baz"]] :a2 [["baz" a b]] :a3 :else :a4) :a0)) (assert (= (match [[2]] [[1]] :a0 [1] :a1 [[2]] :a2 [2] :a3 :else :a4) :a2)) (assert (= ((fn [x done] (if done done (match [x] [[1]] (recur x :a0) [1] (recur x :a1) [[2]] (recur x :a2) [2] (recur x :a3) :else :a4))) [2] false) :a2)) (assert (= ((fn [x done] (if done done (match [x] [[1]] (recur x :a0) [1] (recur x :a1) [[2]] (recur x :a2) [2] (recur x :a3) [3] (recur x :a4) [[3]] (recur x :a4) :else :a5))) [3] false) :a4)) (assert (= (match [[2]] [1] :a0 [[1]] :a1 [2] :a2 [[2]] :a3 :else :a4) :a3)) (assert (= (let [xs [:c]] (match xs [:a] :a0 [:b b] :a1 [:c] :a2 :else :a3)) :a2)) (assert (= (let [xs [1 2 3]] (match [xs] [([1 2 4] :seq)] :a0 [[1 2 5]] :a1 [([1 2 6] :seq)] :a2 [[1 2 3]] :a3)) :a3)) ;; ============================================================================= ;; Extending objects to pattern matching (extend-type js/Date ILookup (-lookup [this k] (-lookup this k nil)) (-lookup [this k not-found] (case k :day (.getDay this) :month (.getMonth this) :year (.getFullYear this) not-found))) (assert (= (match [(js/Date. 2010 10 1 12 30)] [{:year 2009 :month a}] a [{:year (:or 2010 2011) :month b}] b :else :wrong) 10)) ;; ============================================================================= ;; Arrays (assert (= (let [x (int-array [1 2 3])] (match [^ints x] [[_ _ 2]] :a0 [[1 1 3]] :a1 [[1 2 3]] :a2 :else :a3)) :a2)) (assert (= (let [x (object-array [:foo :bar :baz])] (match [^objects x] [[_ _ :bar]] :a0 [[:foo :foo :bar]] :a1 [[:foo :bar :baz]] :a2 :else :a3)) :a2)) (defn B [l v r] (let [o (make-array 4)] (asets o [:black l v r]))) (defn R [l v r] (let [o (make-array 4)] (asets o [:red l v r]))) (defn balance-array [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]] [:black a x [:red b y [:red c z d]]])] :balance :else :balanced)) (assert (= (let [node (B nil nil (R nil nil (R nil nil nil)))] (balance-array node)) :balance)) (println "benchmarking") (println "basic Maranget example hand written") (time (loop [i 0 acc 0] (if (== i 1000000) (println acc) (recur (inc i) (+ acc (let [x (zero? (mod i 2)) y (zero? (mod i 3)) z (zero? (mod i 5))] (if (and (identical? y true) (identical? z true)) 1 (if (and (identical? x false) (identical? y true)) 2 (if (identical? z false) 3 (if (identical? z true) 4 5)))))))))) (println "basic Maranget example") (time (dotimes [i 1e6] (let [x (zero? (mod i 2)) y (zero? (mod i 3)) z (zero? (mod i 5))] (match [x y z] [_ false true] 1 [false true _ ] 2 [_ _ false] 3 [_ _ true] 4 :else 5)))) (println "basic Maranget example with match*") (time (loop [i 0 acc 0] (if (== i 1000000) (println acc) (recur (inc i) (+ acc (let [x (zero? (mod i 2)) y (zero? (mod i 3)) z (zero? (mod i 5))] (match* [x y z] [_ false true] 1 [false true _ ] 2 [_ _ false] 3 [_ _ true] 4 :else 5))))))) (println "map matching") (let [x {:a 1 :b 1}] (time (dotimes [_ 1e6] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil)))) (println "balance red black tree encoded as vectors 1e6 iterations") (let [n [:black [:red [:red 1 2 3] 3 4] 5 6]] (time (dotimes [_ 1e6] (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]] [:black a x [:red b y [:red c z d]]])] :balance :else :valid)))) (println "balance red black tree encoded as arrays 1e7 iterations") (let [node (B nil nil (R nil nil (R nil nil nil)))] (time (dotimes [_ 1e7] (balance-array node)))) ;; ============================================================================= ;; Tickets (assert (= (match 3 x x) 3)) (assert (= (match 'my-sym a a) 'my-sym)) (assert (= (let [xqq {:cz 1 :dz 2}] (match [xqq] [{:z a :zz b}] [:a0 a b] [{:cz a :dz b}] [:a2 a b] :else [])) [:a2 1 2])) (assert (= (let [xmm {:bz 2}] (match [xmm] [{:az a}] [:a0 a] [{:bz b}] [:a1 b] :else [])) [:a1 2])) (assert (= (match (vector) ([(re :guard string?)] :seq) 4 [] 6) 6)) (assert (= (match [ [1 2] ] [([& _] :seq)] true) true)) (assert (= (let [x []] (match [x] [[h & t]] [h t] :else :nomatch)) :nomatch)) (assert (= (let [x [1]] (match [x] [[h & t]] [h t] :else :nomatch)) [1 []])) (assert (= (match [[:x]] [[m n & _]] 1 :else nil) nil)) (assert (= (let [l '(1 2 3)] (match [l] [([a & [b & [c d]]] :seq)] :a0 :else :a1)) :a1)) (assert (= (let [x ()] (match [x] [([h & t] :seq)] [h t] [_] :a1)) :a1)) (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")) ;; MATCH-82 (assert (= (let [x 1] (match 2 x 1 _ 2)) 2)) ;; MATCH-83 (assert (= (let [x [1 2]] (match x [0 _ _ _] :a [1 & _] :b _ :c)) :b)) ;; MATCH-84 (assert (= (let [v [3 2 3 4]] (match [v] [[1 1 3]] :a0 [[3 & r]] :a2)) :a2)) ;; Test macros (assert (= ((mt/test1)) :match)) (println "Tests completed without exception.") libcore-match-clojure-0.2.2/src/test/clojure/000075500000000000000000000000001237337625200211065ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/clojure/clojure/000075500000000000000000000000001237337625200225515ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/000075500000000000000000000000001237337625200235015ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/match/000075500000000000000000000000001237337625200245755ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/match/test/000075500000000000000000000000001237337625200255545ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/match/test/core.clj000064400000000000000000000551311237337625200272030ustar00rootroot00000000000000(ns clojure.core.match.test.core (:refer-clojure :exclude [compile]) (:use clojure.core.match.protocols clojure.core.match clojure.core.match.array clojure.core.match.debug clojure.core.match.regex) (:use [clojure.test])) (set! *warn-on-reflection* true) (deftest pattern-match-1 (is (= (let [x true y true z true] (match [x y z] [_ false true] 1 [false true _ ] 2 [_ _ false] 3 [_ _ true] 4 :else 5)) 4))) (deftest pattern-match-recur-1 (is (= ((fn [x y z done] (if (not done) (match [x y z] [_ false true] (recur x y z 1) [false true _ ] (recur x y z 2) [_ _ false] (recur x y z 3) [_ _ true] (recur x y z 4) :else 5) done)) true true true false) 4))) (deftest pattern-match-bind-1 (is (= (let [x 1 y 2 z 4] (match [x y z] [1 2 b] [:a0 b] [a 2 4] [:a1 a] :else [])) [:a0 4]))) (deftest seq-pattern-match-1 (is (= (let [x [1]] (match [x] [1] 1 [([1] :seq)] 2 :else [])) 2))) (deftest seq-pattern-match-2 (is (= (let [x [1 2 nil nil nil]] (match [x] [([1] :seq)] :a0 [([1 2] :seq)] :a1 [([1 2 nil nil nil] :seq)] :a2 :else [])) :a2))) (deftest seq-pattern-match-bind-1 (is (= (let [x '(1 2 4) y nil z nil] (match [x y z] [([1 2 b] :seq) _ _] [:a0 b] [([a 2 4] :seq) _ _] [:a1 a] :else [])) [:a0 4]))) (deftest seq-pattern-match-wildcard-row (is (= (let [x '(1 2 3)] (match [x] [([1 z 4] :seq)] z [([_ _ _] :seq)] :a2 :else []) :a2)))) (deftest map-pattern-match-1 (is (= (let [x {:a 1 :b 1}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil)) :a1)) (is (= (let [x {:a 1 :b 2}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil)) :a0)) (is (= (let [x {:c 3 :d 9 :e 4}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil)) :a2)) (is (= (let [x {:c 3 :e 4}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b 1}] :a1 [{:c 3 :d _ :e 4}] :a2 :else nil)) nil))) (deftest map-pattern-match-2 (is (= (let [x {:a 1 :b 1}] (match [x] [{:a _ :b 1}] :a0 [{:a 1 :b _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a0))) (deftest map-pattern-match-3 (is (= (let [x {:a 1 :b 1 :c 1}] (match [x] [{:a _ :b 2}] :a0 [{:a 1 :b _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a1))) (deftest map-pattern-match-4 (is (= (let [x {:a 1 :b 1}] (match [x] [{:a _ :b 2}] :a0 [{:a _ :b _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a1))) (deftest map-pattern-match-5 (is (= (let [x {:a 1}] (match [x] [{:a 1 :b 1}] :a0 [{:a _ :b _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) []))) (deftest map-pattern-match-6 (is (= (let [x {:a 1 :b 1}] (match [x] [{:b 1}] :a0 [{:a _ :b _}] :a1 [{:a _ :b _}] :a2 :else [])) :a0))) (deftest map-pattern-match-7 (is (= (let [x {:a 1 :b 1}] (match [x] [{}] :a0 [{:a _ :b _}] :a1 [{:a 1 :b 1}] :a2 :else [])) :a0))) (deftest map-pattern-match-8 (is (= (let [x {:a 1 :b 1}] (match [x] [{:x nil :y nil}] :a0 [{:a _ :b _}] :a1 [{:a 1 :b 1}] :a2 :else [])) :a1))) (deftest map-pattern-match-only-1 (is (= (let [x {:a 1 :b 2}] (match [x] [({:a _ :b 2} :only [:a :b])] :a0 [{:a 1 :c _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a0)) (is (= (let [x {:a 1 :b 2 :c 3}] (match [x] [({:a _ :b 2} :only [:a :b])] :a0 [{:a 1 :c _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a1))) (deftest map-pattern-match-bind-1 (is (= (let [x {:a 1 :b 2}] (match [x] [{:a a :b b}] [:a0 a b] :else [])) [:a0 1 2]))) (deftest seq-pattern-match-empty-1 (is (= (let [x '()] (match [x] [([] :seq)] :a0 [([1 & r] :seq)] [:a1 r] :else [])) :a0))) (deftest seq-pattern-match-rest-1 (is (= (let [x '(1 2)] (match [x] [([1] :seq)] :a0 [([1 & r] :seq)] [:a1 r] :else [])) [:a1 '(2)]))) ;; FIXME: stack overflow if vector pattern - David (deftest seq-pattern-match-rest-2 (is (= (let [x '(1 2 3 4)] (match [x] [([1] :seq)] :a0 [([_ 2 & ([a & b] :seq)] :seq)] [:a1 a b] :else [])) [:a1 3 '(4)]))) (deftest or-pattern-match-1 (is (= (let [x 4 y 6 z 9] (match [x y z] [(:or 1 2 3) _ _] :a0 [4 (:or 5 6 7) _] :a1 :else [])) :a1))) (deftest or-pattern-match-seq-1 (is (= (let [x '(1 2 3) y nil z nil] (match [x y z] [([1 (:or 3 4) 3] :seq) _ _] :a0 [([1 (:or 2 3) 3] :seq) _ _] :a1 :else [])) :a1))) (deftest or-pattern-match-map-2 (is (= (let [x {:a 3} y nil z nil] (match [x y z] [{:a (:or 1 2)} _ _] :a0 [{:a (:or 3 4)} _ _] :a1 :else [])) :a1))) (defn div3? [n] (= (mod n 3) 0)) (defpred even?) (defpred odd?) (defpred div3?) (deftest guard-pattern-match-1 (is (= (let [y '(2 3 4 5)] (match [y] [([_ (a :when even?) _ _] :seq)] :a0 [([_ (b :when [odd? div3?]) _ _] :seq)] :a1 :else [])) :a1))) ;; like guard-pattern-match-1 but uses 'flattened' syntax for guard (deftest guard-pattern-match-2 (is (= (let [y '(2 3 4 5)] (match [y] [([_ a :when even? _ _] :seq)] :a0 [([_ b :when [odd? div3?] _ _] :seq)] :a1 :else [])) :a1))) ;; uses 'flattened' syntax for guard (deftest guard-pattern-match-3 (is (= (let [x 2 y 3 z [4 5]] (match [x y z] [a :when even? _ [b c] :as d] (+ (first d) c) [_ b :when [odd? div3?] _] :a1 :else [])) 9))) (deftest guard-pattern-match-4 (is (= (match [1 2] [(a :guard #(odd? %)) (b :when odd?)] :a1 [(a :guard #(odd? %)) _] :a2 [_ (b :when even?)] :a3 :else :a4) :a2))) (deftest guard-pattern-match-5 (is (= (let [oddp odd?] (match [1 2] [a :guard odd? b :when odd?] :a1 [a :guard oddp _] :a2 [_ b :when even?] :a3 :else :a4)) :a2))) (deftest unequal-equal-tests (is (= (match ["foo" "bar"] [#".*" #"baz"] :a1 [#"foo" _] :a2 [_ "bar"] :a3 :else :a4) :a2))) (deftest unequal-equal-tests-2 (is (= (let [a 1 b 1] (match [1 2] [a 3] :a1 [1 2] :a2 [2 _] :a5 [_ 3] :a4 :else :a3)) :a2))) ;; use ':when pattern to match literal :when (as opposed to guard syntax) (deftest literal-when-match-1 (is (= (let [x :as y :when z 1] (match [x y z] [a ':when 1] :success [:as _ 2] :fail :else :fail)) :success))) (deftest same-symbol-using-guards (is (= (let [e '(+ 1 (+ 2 3)) op (first e) op? #(= % op)] (match [e] [([p :guard op? x ([p2 :guard op? y z] :seq)] :seq)] (list p x y z))) '(+ 1 2 3)))) (deftest quoted-symbol (is (= (let [e '(+ 1 (+ 2 3))] (match [e] [(['+ x (['+ y z] :seq)] :seq)] (list '+ x y z))) '(+ 1 2 3)))) (deftest literal-quote (is (= (let [e 'quote f 10] (match [e f] ['quote quote] quote)) 10))) (deftest literal-quote-seq (is (= (let [e '(:a (quote 10))] (match [e] [([quote (['quote 10] :seq)] :seq)] quote)) :a))) (extend-type java.util.Date IMatchLookup (val-at [this k not-found] (case k :year (.getYear this) :month (.getMonth this) :date (.getDate this) :hours (.getHours this) :minutes (.getMinutes this) not-found))) (deftest map-pattern-interop-1 (is (= (let [d (java.util.Date. 2010 10 1 12 30)] (match [d] [{:year 2009 :month a}] [:a0 a] [{:year (:or 2010 2011) :month b}] [:a1 b] :else [])) [:a1 10]))) (deftest map-pattern-ocr-order-1 (is (= (let [v [{:a 1} 2]] (match [v] [[{:a 2} 2]] :a0 [[{:a _} 2]] :a1 :else [])) :a1))) (deftest as-pattern-match-1 (is (= (let [v [[1 2]]] (match [v] [([3 1] :seq)] :a0 [([(([1 a] :seq) :as b)] :seq)] [:a1 a b] :else [])) [:a1 2 [1 2]]))) (deftest else-clause-1 (is (= (let [v [1]] (match [v] [2] 1 :else 21)) 21))) (deftest else-clause-seq-pattern-1 (is (= (let [v [[1 2]]] (match [v] [([1 3] :seq)] 1 :else 21)) 21))) (deftest else-clause-map-pattern-1 (is (= (let [v {:a 1}] (match [v] [{:a a}] 1 :else 21)) 1))) (deftest else-clause-guard-pattern-1 (is (= (let [v 1] (match [v] [(_ :when even?)] 1 :else 21)) 21))) (deftest else-clause-or-pattern-1 (is (= (let [v 3] (match [v] [(:or 1 2)] :a0 :else :a1)) :a1))) (deftest match-expr-1 (is (= (->> (range 1 16) (map (fn [x] (match [(mod x 3) (mod x 5)] [0 0] "FizzBuzz" [0 _] "Fizz" [_ 0] "Buzz" :else (str x))))) '("1" "2" "Fizz" "4" "Buzz" "Fizz" "7" "8" "Fizz" "Buzz" "11" "Fizz" "13" "14" "FizzBuzz")))) (deftest match-single-1 (is (= (let [x 3] (match x 1 :a0 2 :a1 :else :a2)) :a2))) (deftest match-single-2 (is (= (let [x 3] (match (mod x 2) 1 :a0 2 :a1 :else :a2)) :a0))) ;; TODO: this needs to wait for backtracking. GuardPatterns need to be grouped w/ ;; whatever pattern they actually contain - David (comment (deftest match-single-3 (is (= (let [x [1 2]] (match x [2 1] :a0 (_ :when #(= (count %) 2)) :a1 :else :a2)) :a1))) ) (deftest match-local-1 (is (= (let [x 2 y 2] (match [x] [0] :a0 [1] :a1 [y] :a2 :else :a3)) :a2))) (deftest match-local-2 (is (= (let [x 2] (match [x] [0] :a0 [1] :a1 [2] :a2 :else :a3)) :a2))) (deftest match-local-3 (is (= (let [a 1] (match [1 2] [1 3] :a0 [a 2] :a1 :else :a2)) :a1))) (deftest basic-regex (is (= (match ["asdf"] [#"asdf"] 1 :else 2) 1))) (deftest test-false-expr-works-1 (is (= (match [true false] [true false] 1 [false true] 2 :else (throw (Exception. "Shouldn't be here"))) 1))) (deftest test-lazy-source-case-1 (is (= (let [x [1 2]] (match [x] [(:or [1 2] [3 4] [5 6] [7 8] [9 10])] :a0 :else (throw (Exception. "Shouldn't be here")))) :a0))) (deftest test-wildcard-local-1 (is (= (let [_ 1 x 2 y 3] (match [x y] [1 1] :a0 [_ 2] :a1 [2 3] :a2 :else :a3)) :a2))) (deftest vector-pattern-match-1 (is (= (let [x [1 2 3]] (match [x] [([_ _ 2] ::clojure.core.match/vector)] :a0 [([1 1 3] ::clojure.core.match/vector)] :a1 [([1 2 3] ::clojure.core.match/vector)] :a2 :else :a3)) :a2))) (deftest red-black-tree-pattern-1 (is (= (let [n [:black [:red [:red 1 2 3] 3 4] 5 6]] (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]] [:black a x [:red b y [:red c z d]]])] :balance :else :balanced)) :balance)) (is (= (let [n [:black [:red 1 2 [:red 3 4 5]] 6 7]] (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]] [:black a x [:red b y [:red c z d]]])] :balance :else :balanced)) :balance)) (is (= (let [n [:black 1 2 [:red [:red 3 4 5] 6 7]]] (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]] [:black a x [:red b y [:red c z d]]])] :balance :else :balanced)) :balance)) (is (= (let [n [:black 1 2 [:red 3 4 [:red 5 6 7]]]] (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]] [:black a x [:red b y [:red c z d]]])] :balance :else :balanced)) :balance)) (is (= (let [n [:black 1 [:red 2 3 [:red 4 5 6]] 7]] (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]] [:black a x [:red b y [:red c z d]]])] :balance :else :balanced)) :balanced))) (deftest vector-pattern-int-array-1 (is (= (let [x (int-array [1 2 3])] (match [^ints x] [[_ _ 2]] :a0 [[1 1 3]] :a1 [[1 2 3]] :a2 :else :a3)) :a2))) (deftest vector-pattern-object-array-1 (is (= (let [x (object-array [:foo :bar :baz])] (match [^objects x] [[_ _ :bar]] :a0 [[:foo :foo :bar]] :a1 [[:foo :bar :baz]] :a2 :else :a3)) :a2))) (deftest vector-pattern-rest-1 (is (= (let [v [1 2 3 4]] (match [v] [([1 1 3 & r] ::clojure.core.match/vector)] :a0 [([1 2 4 & r] ::clojure.core.match/vector)] :a1 [([1 2 3 & r] ::clojure.core.match/vector)] :a2 :else :a3)) :a2))) (deftest vector-pattern-rest-2 (is (= (let [v [1 2 3 4]] (let [v [1 2 3 4]] (match [v] [([1 1 3 & r] ::clojure.core.match/vector)] :a0 [([1 2 & r] ::clojure.core.match/vector)] :a1 :else :a3))) :a1))) (deftest vector-bind-1 (is (= (let [node 1] (match [node] [[1]] :a0 [a] a :else :a1)) 1))) (deftest empty-vector-1 (is (= (let [v []] (match [v] [[]] 1 :else 2)) 1))) (deftest empty-vector-2 (is (= (let [v [1 2]] (match [v] [[]] :a0 [[x & r]] :a1 :else :a2)) :a1))) (deftest vector-pattern-length-1 (is (= (let [v [[1 2]]] (match [v] [[3 1]] :a0 [[([1 a] :as b)]] [:a1 a b] :else :a2)) [:a1 2 [1 2]]))) (deftest seq-infer-rest-1 (is (= (let [l '(1 2 3)] (match [l] [([a & [b & [c]]] :seq)] :a0 :else :a1)) :a0))) (deftest vector-offset-1 (is (= (match [[:pow :x 2]] [[:pow arg pow]] 0 [[:mult & args]] 1 :else 2) 0))) (deftest match-expr-2 (is (= (match [false] [false] true) true))) (deftest vector-rest-pattern-1 (is (= (match [[:plus 1 2 3]] [[:pow arg pow]] 0 [[:plus & args]] 1 :else 2) 1))) (deftest map-pattern-match-only-2 (is (= (let [x {:a 1 :b 2 :c 10 :d 30}] (match [x] [({:a _ :b _ :c _ :d _} :only [:a :b :c :d])] :a-1 [({:a _ :b 2} :only [:a :b])] :a0 [{:a 1 :c _}] :a1 [{:c 3 :d _ :e 4}] :a2 :else [])) :a-1))) (deftest map-pattern-match-only-3 (is (and (= (let [m {:a 1}] (match [m] [({:a 1} :only [:a])] :a0 :else :a1)) :a0) (= (let [m {:a 1 :b 2}] (match [m] [({:a 1} :only [:a])] :a0 :else :a1)) :a1)))) (deftest map-pattern-heterogenous-keys-1 (is (= (let [m {:foo 1 "bar" 2}] (match [m] [{:foo 1 "bar" 2}] :a0 :else :a1)) :a0))) (deftest exception-1 (is (= (try (match :a :a (throw (Exception.)) :else :c) (catch Exception e :d)) :d))) (deftest match-order-1 (is (= (let [x '(1 2) y 1] (match [x y] [([1] :seq) _] :a0 [_ 1] :a1 [([1 2] :seq) _] :a2 [_ 2] :a3 :else :a4)) :a1)) (is (= (let [x '(1 2) y 1] (match [x y] [([1] :seq) _] :a0 [([1 2] :seq) _] :a2 [_ 1] :a1 [_ 2] :a3 :else :a4)) :a2))) (deftest match-order-2 (is (= (let [x '(1 2) y 3] (match [x y] [([1] :seq) _] :a0 [_ 1] :a1 [([1 2] :seq) _] :a2 [_ 2] :a3 :else :a4)) :a2))) (deftest match-order-3 (is (= (let [x '(1) y 3] (match [x y] [([1] :seq) _] :a0 [_ 1] :a1 [([1 2] :seq) _] :a2 [_ 2] :a3 :else :a4)) :a0))) (deftest match-order-4 (is (= (let [x '(1 2 3) y 2] (match [x y] [([1] :seq) _] :a0 [_ 1] :a1 [([1 2] :seq) _] :a2 [_ 2] :a3 :else :a4)) :a3))) (deftest match-order-5 (is (= (match [["foo"]] [["foo"]] :a0 [["foo" a]] :a1 [["baz"]] :a2 [["baz" a b]] :a3 :else :a4) :a0))) (deftest match-order-6 (is (= (match [[2]] [[1]] :a0 [1] :a1 [[2]] :a2 [2] :a3 :else :a4) :a2))) (deftest match-order-6-recur (is (= ((fn [x done] (if done done (match [x] [[1]] (recur x :a0) [1] (recur x :a1) [[2]] (recur x :a2) [2] (recur x :a3) :else :a4))) [2] false) :a2)) (is (= ((fn [x done] (if done done (match [x] [[1]] (recur x :a0) [1] (recur x :a1) [[2]] (recur x :a2) [2] (recur x :a3) [3] (recur x :a4) [[3]] (recur x :a4) :else :a5))) [3] false) :a4))) (deftest match-order-7 (is (= (match [[2]] [1] :a0 [[1]] :a1 [2] :a2 [[2]] :a3 :else :a4) :a3))) (deftest match-order-8 (is (= (let [xs [:c]] (match xs [:a] :a0 [:b b] :a1 [:c] :a2 :else :a3)) :a2))) (deftest match-order-9 (is (= (let [xs [1 2 3]] (match [xs] [([1 2 4] :seq)] :a0 [[1 2 5]] :a1 [([1 2 6] :seq)] :a2 [[1 2 3]] :a3)) :a3))) ;; ============================================================================= ;; Tickets (deftest match-66 (is (= (match 3 x x) 3)) (is (= (match 'my-sym a a) 'my-sym))) (deftest match-70 (is (= (let [xqq {:cz 1 :dz 2}] (match [xqq] [{:z a :zz b}] [:a0 a b] [{:cz a :dz b}] [:a2 a b] :else [])) [:a2 1 2])) (is (= (let [xmm {:bz 2}] (match [xmm] [{:az a}] [:a0 a] [{:bz b}] [:a1 b] :else [])) [:a1 2]))) (deftest match-51 (is (= (match (vector) ([(re :guard string?)] :seq) 4 [] 6) 6))) (deftest match-55 (is (= (match [ [1 2] ] [([& _] :seq)] true) true))) (deftest match-56 (is (= (let [x []] (match [x] [[h & t]] [h t] :else :nomatch)) :nomatch)) (is (= (let [x [1]] (match [x] [[h & t]] [h t] :else :nomatch)) [1 []]))) (deftest match-68 (is (= (match [[:x]] [[m n & _]] 1 :else nil) nil))) (deftest match-35 (is (= (let [l '(1 2 3)] (match [l] [([a & [b & [c d]]] :seq)] :a0 :else :a1)) :a1)) (is (= (let [x ()] (match [x] [([h & t] :seq)] [h t] [_] :a1)) :a1))) (deftest match-61 (is (= (let [q '(a) y '(b) z '(c)] (match [q (seq y) z] [([_] :seq) _ _] 'a [_ _ _] 'b)) 'a))) (deftest match-80 (is (= (match [:r :d] [:s :d] nil [:r :t] nil [:r :d] :x [:s :t] nil) :x)) (is (= (match [:r :d] [:r :t] nil [:s :d] nil [:r :d] :x [:s :t] nil) :x))) (deftest match-83 (is (= (let [x [1 2]] (match x [0 _ _ _] :a [1 & _] :b _ :c)) :b))) (deftest match-84 (is (= (let [v [3 2 3 4]] (match [v] [[1 1 3]] :a0 [[3 & r]] :a2)) :a2))) (deftest match-92 (is (= (let [m {:a.b 1}] (match [m] [{:a.b _}] :a0)) :a0))) libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/match/test/core/000075500000000000000000000000001237337625200265045ustar00rootroot00000000000000libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/match/test/core/error_msg.clj000064400000000000000000000067431237337625200312070ustar00rootroot00000000000000(ns clojure.core.match.test.core.error-msg (:refer-clojure :exclude [reify == inc compile]) (:use [clojure.core.match] [clojure.core.match.debug]) (:use [clojure.test])) (deftest match-errors-occurrences-symbol (is (thrown-with-msg? AssertionError #"Occurrences must be in a vector. Try changing x to \[x\]" (m-to-clj x [1] :a1)))) (deftest match-errors-occurrences-list (is (thrown-with-msg? AssertionError #"Occurrences must be in a vector. \(x\) is not a vector" (m-to-clj (x) [1] :a1)))) (deftest match-errors-pattern-row1 (is (thrown-with-msg? AssertionError #"Pattern row 1: Pattern rows must be wrapped in \[\]. Try changing 1 to \[1\]" (m-to-clj [x] 1 :a1)))) (deftest match-errors-pattern-row-list1 (is (thrown-with-msg? AssertionError #"Pattern row 1: Pattern rows must be wrapped in \[\]. Try changing \(1\) to \[\(1\)\]. Note: pattern rows are not patterns. They cannot be wrapped in a :when guard, for example" (m-to-clj [x] (1) :a1)))) (deftest match-errors-pattern-row-list2 (is (thrown-with-msg? AssertionError #"Pattern row 2: Pattern rows must be wrapped in \[\]. Try changing \(1\) to \[\(1\)\]. Note: pattern rows are not patterns. They cannot be wrapped in a :when guard, for example" (m-to-clj [x] [2] :a0 (1) :a1)))) (deftest match-errors-uneven-clauses1 (is (thrown-with-msg? AssertionError #"Uneven number of Pattern Rows. The last form `\[1\]` seems out of place." (m-to-clj [x] [1])))) (deftest match-errors-uneven-clauses2 (is (thrown-with-msg? AssertionError #"Uneven number of Pattern Rows. The last form `\[1\]` seems out of place." (m-to-clj [x] [1] :a1 [1])))) (deftest match-list-syntax-error (is (thrown-with-msg? AssertionError #"^Invalid list syntax :what in \(1 :what a\)" (m-to-clj [x] [(1 :what a)] :a1)))) (deftest match-else-clause-error (is (thrown-with-msg? AssertionError #"Pattern row 1: :else form only allowed on final pattern row" (m-to-clj [x] :else 1 [1] 1 :else 1)))) (deftest match-differing-patterns (is (thrown-with-msg? AssertionError #"Pattern row 1: Pattern row has differing number of patterns. \[1 2\] has 2 pattern/s, expecting 1 for occurrences \[x\]" (m-to-clj [x] [1 2] 1 :else 1)))) (deftest match-duplicate-wildcards (is (thrown-with-msg? AssertionError #"Pattern row 1: Pattern row reuses wildcards in \[a a\]. The following wildcards are ambiguous: a. There's no guarantee that the matched values will be same. Rename the occurrences uniquely." (m-to-clj [x y] [a a] a :else 1)))) (deftest match-duplicate-wildcards2 (is (thrown-with-msg? AssertionError #"Pattern row 1: Pattern row reuses wildcards in \[.*\]. The following wildcards are ambiguous: aa, x. There's no guarantee that the matched values will be same. Rename the occurrences uniquely." (m-to-clj [xx yy] [x (: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]] [:black aa x [:red [:black aa y c] z d]] [:black a x [:red b y [:red c z d]]])] a :else 1)))) libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/match/test/date.clj000064400000000000000000000005321237337625200271630ustar00rootroot00000000000000(ns clojure.core.match.test.date (:use clojure.test) (:use [clojure.core.match :only [match]]) (:use clojure.core.match.date)) (deftest date-test1 (is (= (match [(java.util.Date. 2010 10 1 12 30)] [{:year 2009 :month a}] a [{:year (:or 2010 2011) :month b}] b :else :wrong) 10))) libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/match/test/impl.clj000064400000000000000000000116011237337625200272060ustar00rootroot00000000000000(ns clojure.core.match.test.impl (:refer-clojure :exclude [compile]) (:use clojure.core.match.protocols clojure.core.match clojure.core.match.debug clojure.core.match.regex clojure.test) (:require [clojure.pprint :as pp])) (deftest pattern-equality (testing "wildcard patterns" (is (true? (= (wildcard-pattern) (wildcard-pattern)))) (is (true? (= (wildcard-pattern 'a) (wildcard-pattern 'a)))) (is (false? (= (wildcard-pattern 'a) (wildcard-pattern 'b))))) (testing "literal patterns" (is (true? (= (literal-pattern 1) (literal-pattern 1)))) (is (false? (= (literal-pattern 1) (literal-pattern 2))))) (testing "rest patterns" (is (true? (= (rest-pattern 'a) (rest-pattern 'a)))) (is (false? (= (rest-pattern 'a) (rest-pattern 'b))))) (testing "map patterns" (is (true? (= (map-pattern '{:a a}) (map-pattern '{:a a})))) (is (false? (= (map-pattern '{:a a}) (map-pattern '{:a b}))))) (testing "vector patterns" (is (true? (= (vector-pattern '[1 a 2]) (vector-pattern '[1 a 2])))) (is (false? (= (vector-pattern '[1 a 2]) (vector-pattern '[1 a 3]))))) (testing "or patterns" (is (true? (= (or-pattern [(literal-pattern 1) (literal-pattern 2)]) (or-pattern [(literal-pattern 1) (literal-pattern 2)])))) (is (false? (= (or-pattern [(literal-pattern 1) (literal-pattern 2)]) (or-pattern [(literal-pattern 1) (literal-pattern 3)]))))) (testing "guard patterns" (is (true? (= (guard-pattern 'a #{even?}) (guard-pattern 'a #{even?})))) (is (false? (= (guard-pattern 'a #{even?}) (guard-pattern 'a #{odd?}))))) (testing "predicate patterns" (is (true? (= (predicate-pattern 'a #{even?}) (predicate-pattern 'a #{even?})))) (is (false? (= (predicate-pattern 'a #{even?}) (predicate-pattern 'a #{odd?})))))) (deftest pattern-row-equality (is (true? (= (pattern-row [(literal-pattern 1) (literal-pattern 2)] :a0) (pattern-row [(literal-pattern 1) (literal-pattern 2)] :a0)))) (is (false? (= (pattern-row [(literal-pattern 1) (literal-pattern 2)] :a0) (pattern-row [(literal-pattern 1) (literal-pattern 3)] :a0))))) (deftest pattern-matrix-equality (let [m0 (build-matrix [x y z] [_ false true ] (recur x y z 1) [false true _ ] (recur x y z 2) [_ _ false] (recur x y z 3) [_ _ true ] (recur x y z 4) :else 5) m1 (build-matrix [x y z] [_ false true ] (recur x y z 1) [false true _ ] (recur x y z 2) [_ _ false] (recur x y z 3) [_ _ true ] (recur x y z 4) :else 5)] (is (true? (= m0 m1))))) (deftest test-choose-column (testing "for Maranget example, column 1 should be chosen" (let [m0 (build-matrix [x y z] [_ false true ] (recur x y z 1) [false true _ ] (recur x y z 2) [_ _ false] (recur x y z 3) [_ _ true ] (recur x y z 4) :else 5)] (is (= (choose-column m0) 1))))) (deftest test-swap (testing "for Maranget example, show that swap works" (let [m0 (build-matrix [x y z] [_ false true ] (recur x y z 1) [false true _ ] (recur x y z 2) [_ _ false] (recur x y z 3) [_ _ true ] (recur x y z 4) :else 5) m1 (build-matrix [y x z] [false _ true ] (recur x y z 1) [true false _ ] (recur x y z 2) [_ _ false] (recur x y z 3) [_ _ true ] (recur x y z 4) :else 5)] (is (= (swap m0 1) m1))))) (deftest test-matrix-splitter-1 (testing "for Maranget example, show specialized matrix and default matrix are as expected" (let [m1 (build-matrix [y x z] [false _ true ] :a0 [true false _ ] :a1 [_ _ false] :a2 [_ _ true ] :a3 :else 5) S (build-matrix [y x z] [false _ true ] :a0) D (build-matrix [y x z] [true false _ ] :a1 [_ _ false] :a2 [_ _ true ] :a3 :else 5) [S' D'] (matrix-splitter m1)] (is (and (= S S') (= D D')))))) (deftest test-rest-pattern-1 (let [M (build-matrix [x] [([& _] :seq)] true) M' (build-matrix [x] [_] true) M'' (specialize M)] (is (= M' M'')))) (deftest test-local-pattern-1 (let [M (binding [*locals* '{a nil}] (build-matrix [1 2] [1 3] :a0 [a 2] :a1 :else :a2))] (is (= (first (nth (rows M) 1)) (literal-pattern 'a))))) libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/match/test/java.clj000064400000000000000000000012141237337625200271650ustar00rootroot00000000000000(ns clojure.core.match.test.java (:refer-clojure :exclude [reify == inc compile]) (:use [clojure.core.match] [clojure.core.match.java] [clojure.test])) (bean-match java.util.Date) (deftest bean-match-date (is (= 10 (match [(java.util.Date. 2009 10 1 12 30)] [{:year 2009 :month a}] a [{:year (:or 2010 2011) :month b}] b :else :wrong)))) (bean-match java.io.File) (deftest bean-match-file (is (= (.getAbsolutePath (java.io.File. ".")) (match [(java.io.File. ".")] [{:directory? true :absolute-path p}] p :else :wrong)))) libcore-match-clojure-0.2.2/src/test/clojure/clojure/core/match/test/regex.clj000064400000000000000000000004251237337625200273610ustar00rootroot00000000000000(ns clojure.core.match.test.regex (:use [clojure.core.match :only [match]]) (:use clojure.core.match.regex) (:use clojure.test)) (deftest basic-regex (is (= (match ["asdf"] [#"asdf"] 1 :else 2) 1)))