Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

* src/main/clojure/clojure/core/match/array.clj: MATCH-26: fixed. min…

…or formatting. fix regression arround custom vector pattern matching.
  • Loading branch information...
commit efa880320fc235536690ba8af078a59c17f3321d 1 parent a117d59
David Nolen authored October 09, 2011
6  src/main/clojure/clojure/core/match/array.clj
@@ -116,7 +116,6 @@
116 116
            (balance-array node)))))
117 117
     )
118 118
 
119  
-  ;; 90ms
120 119
   (do
121 120
     (defn balance-array [^objects node]
122 121
       (matchv ::objects [node]
@@ -125,7 +124,7 @@
125 124
                 (object-array [:black a x b]) y
126 125
                   (object-array [:black c z d])])))
127 126
 
128  
-    ;; 360ms
  127
+    ;; 90ms
129 128
     (let [^objects node (object-array [:black
130 129
                           (object-array [:red
131 130
                             (object-array [:red nil nil nil]) nil nil]) nil nil])]
@@ -201,7 +200,8 @@
201 200
          [([:black [:red [:red a x b] y c] z d] |
202 201
            [:black [:red a x [:red b y c]] z d] |
203 202
            [:black a x [:red [:red b y c] z d]] |
204  
-           [:black a x [:red b y [:red c z d]]])] (R (B a x b) y (B c z d))))
  203
+           [:black a x [:red b y [:red c z d]]])] (R (B a x b) y (B c z d))
  204
+         :else node))
205 205
 
206 206
     ;; 200ms
207 207
     (let [^objects node (B (R (R nil nil nil) nil nil) nil nil)]
12  src/main/clojure/clojure/core/match/core.clj
@@ -150,28 +150,38 @@
150 150
 
151 151
 (defmethod check-size? :default
152 152
   [_] true)
  153
+
153 154
 (defmethod tag :default
154 155
   [t] (throw (Exception. (str "No tag specified for vector specialization " t))))
155 156
 
156 157
 (defmethod tag ::vector
157 158
   [_] clojure.lang.IPersistentVector)
  159
+
158 160
 (defn with-tag [t ocr]
159 161
   (let [the-tag (tag t)
160 162
         the-tag (if (.isArray ^Class the-tag)
161 163
                   (.getName ^Class the-tag)
162 164
                   the-tag)]
163 165
     (with-meta ocr (assoc (ocr meta) :tag the-tag))))
  166
+
164 167
 (defmethod test-inline ::vector
165  
-  [t ocr] `(vector? ~ocr))
  168
+  [t ocr] (if (= t ::vector)
  169
+           `(vector? ~ocr)
  170
+           `(instance? ~(tag t) ~ocr)))
  171
+
166 172
 (defmethod test-with-size-inline ::vector
167 173
   [t ocr size] `(and ~(test-inline t ocr) (= ~(count-inline t (with-tag t ocr)) ~size)))
  174
+
168 175
 (defmethod count-inline ::vector
169 176
   [_ ocr] `(count ~ocr))
  177
+
170 178
 (defmethod nth-inline ::vector
171 179
   [_ ocr i] `(nth ~ocr ~i))
  180
+
172 181
 (defmethod nth-offset-inline ::vector
173 182
   [t ocr i offset]
174 183
   (nth-inline t ocr i))
  184
+
175 185
 (defmethod subvec-inline ::vector
176 186
   ([_ ocr start] `(subvec ~ocr ~start))
177 187
   ([_ ocr start end] `(subvec ~ocr ~start ~end)))

0 notes on commit efa8803

Please sign in to comment.
Something went wrong with that request. Please try again.