├── LICENSE ├── README.md ├── project.janet ├── src └── init.janet └── test └── pat.janet /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2023 Ian Henry 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # `pat/match` 2 | 3 | A supercharged `match` macro for Janet. Install it with `jpm`: 4 | 5 | ```janet 6 | # project.janet 7 | (declare-project 8 | :dependencies [ 9 | {:url "https://github.com/ianthehenry/pat.git" 10 | :tag "v2.0.1"} 11 | ]) 12 | ``` 13 | 14 | Here's a quick diff between `pat/match` and Janet's built-in `match`: 15 | 16 | - `[x y z]` patterns match exactly, instead of matching prefixes of their input 17 | - `pat/match` supports pattern alternatives with `or` 18 | - `pat/match` supports field punning in dictionary patterns, with `{:foo &}` 19 | - `pat/match` supports pattern aliases and refinements with `and` 20 | - `pat/match` supports optional fields in dictionary patterns, with `{:x (? x)}` 21 | - `pat/match` supports "view patterns" with `map` 22 | - `pat/match` raises an error when no patterns match (unless you specify an explicit default) 23 | - there's a different syntax for attaching conditions to patterns (see "predicate and expression patterns" below) 24 | 25 | # Symbol patterns 26 | 27 | > Symbol patterns are the same as the native `match`, except that `&` is not a valid symbol in `pat/match`, while `@` always is. 28 | 29 | Symbols match any values, and bind that value. 30 | 31 | ```janet 32 | (pat/match 10 33 | x (* 2 x)) 34 | # 20 35 | ``` 36 | 37 | There are two exceptions: 38 | 39 | - `_` is a pattern that matches any value, but creates no binding. 40 | - `&` is not a legal symbol pattern, as it has special meaning in struct and tuple patterns. 41 | 42 | # Literal patterns 43 | 44 | > The same as the native `match`. 45 | 46 | Numbers, strings, keywords, and booleans match values exactly. All quoted values -- including symbols -- match exactly as well. 47 | 48 | ```janet 49 | (pat/match (type [1 2 3]) 50 | :tuple "yep") 51 | 52 | (pat/match operator 53 | '+ "plus" 54 | '- "minus") 55 | ``` 56 | 57 | # Predicate and expression patterns 58 | 59 | > Quite a bit different than the native `match`. 60 | 61 | Use `|` to evaluate arbitrary predicates or expressions. For example: 62 | 63 | ```janet 64 | (def x 5) 65 | (pat/match x 66 | |even? "it's even" 67 | |odd? "it's odd") 68 | # "it's odd" 69 | ``` 70 | 71 | Which is the same as: 72 | 73 | ```janet 74 | (def x 5) 75 | (pat/match x 76 | |(even? $) "it's even" 77 | |(odd? $) "it's odd") 78 | # "it's odd" 79 | ``` 80 | 81 | You can also write arbitrary expressions that don't refer to the value being matched at all: 82 | 83 | ```janet 84 | (def x 5) 85 | (pat/match x 86 | |(< 1 2) :trivial) 87 | # :trivial 88 | ``` 89 | 90 | A mental model for how this works: `short-fn`s of zero arguments are invoked, and if they return a function or cfunction, then their result is invoked again with the value being matched. Otherwise, if they don't return a function or cfunction, their result is interpreted as a normal truthy or falsey value. 91 | 92 | But in practice, `pat/match` will optimize away the `short-fn` allocation in all practical cases where your pattern is a constant expression or predicate. 93 | 94 | # Tuple and array patterns 95 | 96 | > Unlike the native `match`, tuple patterns without a `&` clause must match exactly with their input, instead of a prefix of their input. `pat/match` also supports arbitrary patterns after the `&`, while the native match only supports a symbol. 97 | 98 | ```janet 99 | (def values [1 2]) 100 | (pat/match values 101 | [x y] (+ x y)) 102 | ``` 103 | 104 | ## Matching prefixes 105 | 106 | ```janet 107 | (def values [1 2 3]) 108 | (pat/match values 109 | [x y &] (+ x y)) 110 | ``` 111 | 112 | ```janet 113 | (def values [1 2 3]) 114 | (pat/match values 115 | [car cadr & rest] rest) 116 | # [3] 117 | ``` 118 | 119 | `& rest` patterns match a sliced value of the same type as their input: 120 | 121 | ```janet 122 | (def values @[1 2 3]) 123 | (pat/match values 124 | [car cadr & rest] rest) 125 | # @[3] 126 | ``` 127 | 128 | You can put any pattern after the `&`, not just a symbol. For example, this pattern will only match tuples of length `2`, `3`, or `4`: 129 | 130 | ```janet 131 | (def values [1 2 3]) 132 | (pat/match values 133 | [car cadr & |(<= (length $) 2)] 134 | (+ car cadr)) 135 | ``` 136 | 137 | # Struct and table patterns 138 | 139 | > Basically the same as the native `match`, but supports optional keys and field punning. 140 | 141 | ```janet 142 | (def point {:x 1 :y 2}) 143 | (pat/match point 144 | {:x x :y y} (+ x y)) 145 | ``` 146 | 147 | ## Optional matching 148 | 149 | Because structs and tables cannot contain `nil` values, the following can never match: 150 | 151 | ```janet 152 | (pat/match {:foo nil} 153 | {:foo _} ...) 154 | ``` 155 | 156 | Because `{:foo nil}` is actually `{}`, and the pattern `{:foo _}` needs to match against the key `:foo`, which does not exist. 157 | 158 | You can fix this by making an optional match like this: 159 | 160 | ```janet 161 | (pat/match {:foo nil} 162 | {:foo (? x)} x) 163 | ``` 164 | 165 | This will bind `x` to `nil` if the keyword `:foo` does not exist in the input. 166 | 167 | ## Keyword punning 168 | 169 | Instead of: 170 | 171 | ```janet 172 | (def person {:name "ian"}) 173 | (pat/match person 174 | {:name name} (print name)) 175 | ``` 176 | 177 | You can write: 178 | 179 | ```janet 180 | (pat/match person 181 | {:name &} (print name)) 182 | ``` 183 | 184 | ## Evaluation order 185 | 186 | Note that, due to the way Janet abstract syntax trees work, there is no way to guarantee the order of the match in a struct pattern. This means you cannot refer to variables bound by other keys. That is, don't write code like this: 187 | 188 | ```janet 189 | (pat/match foo 190 | {:a a :b |(> $ a)} ...) 191 | ``` 192 | 193 | Such a construct is allowed using `[]` patterns or `and` patterns, but not `{}` patterns: the order that the keys in a struct appear is not part of the parsed abstract syntax tree that `pat` operates on. This *might* work, sometimes, but it's fragile, and working code could break in a future version of Janet. `pat/match` will not prevent you from doing this, because I don't know how to do so without incurring a runtime cost. 194 | 195 | If you really need to do this, you can use `and` to sequence each step of the match: 196 | 197 | ```janet 198 | (pat/match foo 199 | (and {:a a} {:b |(> $ a)}) ...) 200 | ``` 201 | 202 | Similarly, you cannot write duplicate keys in a struct pattern: 203 | 204 | ```janet 205 | (pat/match foo 206 | {:a a :a 10} ...) 207 | ``` 208 | 209 | Janet erases the first instance of `:a` at parse time, so `pat` can't even warn you if you make this mistake. If you want to match multiple patterns against the same key, use an `(and)` pattern instead: 210 | 211 | ```janet 212 | (pat/match foo 213 | {:a (and a 10)} ...) 214 | ``` 215 | 216 | # Operator patterns 217 | 218 | > Operator patterns replace the native `match`'s equality patterns, like `(@ foo)` and condition patterns, like `(foo (> foo 0))`. 219 | 220 | ## `(and patterns...)` 221 | 222 | You can use `and` to match multiple patterns against a single value. You can use this to alias values, like "`as` patterns" in other languages: 223 | 224 | ```janet 225 | (pat/match [1 2] 226 | (and [x y] p) 227 | (printf "%q = <%q %q>" p x y)) 228 | ``` 229 | 230 | Or to check conditions, like "`when` patterns" in other languages: 231 | 232 | ```janet 233 | (pat/match point 234 | (and [x y] |(< x y)) 235 | (print "ascending order")) 236 | ``` 237 | 238 | ## `(or patterns...)` 239 | 240 | `or` allows you to try multiple patterns and match if any one of them succeeds: 241 | 242 | ```janet 243 | (pat/match (type value) 244 | (or :tuple :array) "indexed") 245 | ``` 246 | 247 | Every subpattern in an `or` pattern must bind exactly the same set of symbols. For example, this is allowed: 248 | 249 | ```janet 250 | (pat/match value 251 | (or [x] x) (* x 2)) 252 | ``` 253 | 254 | But this will fail to compile: 255 | 256 | ```janet 257 | (pat/match value 258 | (or [x] y) (* x 2)) 259 | ``` 260 | 261 | You can use `_` to perform structural matching without binding any new symbols. 262 | 263 | ## `(= value)` 264 | 265 | Check a value for equality: 266 | 267 | ```janet 268 | (def origin [0 0]) 269 | (pat/match point 270 | (= origin) :origin) 271 | ``` 272 | 273 | This is equivalent to: 274 | 275 | ```janet 276 | (pat/match point 277 | |(= origin $) :origin) 278 | ``` 279 | 280 | But a little more convenient to write. 281 | 282 | ## `(unquote value)` 283 | 284 | You can use unquote in order to create first-class patterns. 285 | 286 | `unquote` uses `eval` in order to evaluate the pattern, so it will not work if you want to reference a variable that is defined in a lexical scope (i.e., a variable that is not an environment entry). So this will work: 287 | 288 | ```janet 289 | (def my-pattern ~[x y]) 290 | (pat/match [1 2] 291 | ,my-pattern (+ x y)) 292 | ``` 293 | 294 | But this will not: 295 | 296 | ```janet 297 | (let [my-pattern ~[x y]] 298 | (pat/match [1 2] 299 | ,my-pattern (+ x y))) 300 | ``` 301 | 302 | 303 | Another way to say this is that you cannot create dynamic patterns at runtime. The pattern you're splicing in must be known at compile time. 304 | 305 | ## `(not pat)` 306 | 307 | Invert a pattern: 308 | 309 | ```janet 310 | (def point [0 0 0]) 311 | (pat/match point 312 | (not [_ _]) :not-2d) 313 | ``` 314 | 315 | The pattern inside `not` cannot create any bindings. 316 | 317 | ## `(not= pat)` 318 | 319 | Slightly more efficient shorthand for `(not (= x))`. 320 | 321 | ```janet 322 | (pat/match value 323 | (and x (not= nil)) (print x)) 324 | ``` 325 | 326 | ## `(map f pat)` 327 | 328 | Call `f` with the value being matched, and match the pattern against the result, like "view patterns" in other languages. 329 | 330 | ```janet 331 | (match numbers 332 | (map max-of (and big |prime?)) (print big) 333 | (error "largest number must be prime")) 334 | ``` 335 | 336 | # Changelog 337 | 338 | ## v2.0.1 2024-08-04 339 | 340 | - Macro expansion is more hygienic. In particular it works even in contexts that have shadowed `length` or `=`. 341 | 342 | ## v2.0.0 2024-07-18 343 | 344 | - Breaking change: `unquote` now splices first-class patterns, instead of checking for equality. Previously, the patterns `(= foo)` and `,foo` were identical. Now the latter assumes `foo` evaluates to a pattern. 345 | 346 | ## v1.0.1 2024-05-15 347 | 348 | - Fix a bug where non-optional dictionary patterns wouldn't work. 349 | 350 | ## v1.0.0 2023-08-27 351 | 352 | - Initial release. 353 | -------------------------------------------------------------------------------- /project.janet: -------------------------------------------------------------------------------- 1 | (declare-project 2 | :name "pat" 3 | :description "an improved pattern matching macro" 4 | :version "1.0.0" 5 | :dependencies ["https://github.com/ianthehenry/judge.git"]) 6 | 7 | (declare-source 8 | :prefix "pat" 9 | :source ["src/init.janet"]) 10 | -------------------------------------------------------------------------------- /src/init.janet: -------------------------------------------------------------------------------- 1 | (use judge) 2 | 3 | (def- *subject* (gensym)) 4 | (def- *success* (gensym)) 5 | (def- *result* (gensym)) 6 | 7 | (defmacro- scope :fmt/block [body &opt if-broken invert] 8 | (default invert false) 9 | (def which-if (if invert 'if-not 'if)) 10 | (with-syms [$success $result] 11 | ~(do 12 | (var ,$success true) 13 | (var ,$result nil) 14 | (while true 15 | (set ,$result (do 16 | ,(with-dyns [*success* $success *result* $result] 17 | (macex body)))) 18 | (break)) 19 | (,which-if ,$success 20 | ,$result 21 | ,if-broken)))) 22 | 23 | (defmacro- fail [] 24 | ~(do 25 | (set ,(dyn *success*) false) 26 | (break))) 27 | 28 | # we use this because of the janky way that we detect 29 | # exported vars: by looking for `def` statements in 30 | # the output of a compiled pattern. this allows us 31 | # to define private, local variables without assuming 32 | # that they're exported. 33 | (defmacro- alias [x y] ~(def ,x ,y)) 34 | 35 | (deftest "scope macro" 36 | (test (scope (+ 1 2)) 3) 37 | (test (scope (do (fail) (+ 1 2)) 5) 5) 38 | (test (scope (do (scope (fail) "broke") "ok")) "ok") 39 | (test (scope (do (scope (fail) "inner") (fail) "ok") "outer") "outer")) 40 | 41 | (defn- fallback* [cases final] 42 | (match cases 43 | [first-case & rest] 44 | (with-syms [$result] 45 | ~(let [,$result 46 | (as-macro ,scope 47 | (do ,;first-case) 48 | ,(fallback* rest final) 49 | )])) 50 | [] final)) 51 | 52 | (defmacro- fallback [cases final] 53 | ~(as-macro ,fallback* ,cases ,final)) 54 | 55 | (deftest "fallback" 56 | (test (fallback 57 | [[1] 58 | [2]] 59 | 3) 1) 60 | 61 | (test (fallback 62 | [[1 (fail)] 63 | [2]] 64 | 3) 2) 65 | 66 | (test (fallback 67 | [[1 (fail)] 68 | [2 (fail)]] 69 | 3) 3)) 70 | 71 | (defn- type+ [form] 72 | (let [t (type form)] 73 | (case t 74 | :tuple (case (tuple/type form) 75 | :brackets :tuple-brackets 76 | :parens :tuple-parens) 77 | t))) 78 | 79 | (var- compile-pattern nil) 80 | 81 | (defn- assert-same-syms [list] 82 | (var result nil) 83 | (def canonical (list 0)) 84 | (for i 1 (length list) 85 | (def this (list i)) 86 | (unless (= (this :syms) (canonical :syms)) 87 | (errorf "all branches of an or pattern must bind the same symbols\n%q binds %q, but %q binds %q" 88 | (canonical :pattern) (tuple/slice (keys (canonical :syms))) 89 | (this :pattern) (tuple/slice (keys (this :syms)))))) 90 | (canonical :syms)) 91 | 92 | (defn- definitions [body] 93 | (def symbols-defined @{}) 94 | (each form body 95 | (when (and (> (length form) 2) (= (form 0) 'def)) 96 | (put symbols-defined (form 1) true))) 97 | (table/to-struct symbols-defined)) 98 | 99 | (defn- compile-or [patterns] 100 | (def compiled (seq [pattern :in patterns] 101 | (def body (compile-pattern pattern)) 102 | {:body body 103 | :syms (definitions body) 104 | :pattern pattern})) 105 | (def syms (assert-same-syms compiled)) 106 | (def sym-to-gen (tabseq [sym :keys syms] sym (gensym))) 107 | [;(seq [$sym :in sym-to-gen] ~(var ,$sym nil)) 108 | (fallback* 109 | (seq [{:body body} :in compiled] 110 | [;body 111 | ;(seq [[sym $sym] :pairs sym-to-gen] 112 | ~(set ,$sym ,sym))]) 113 | ~(as-macro ,fail)) 114 | ;(seq [[sym $sym] :pairs sym-to-gen] 115 | ~(def ,sym ,$sym))]) 116 | 117 | (defn- compile-and [patterns] 118 | (mapcat compile-pattern patterns)) 119 | 120 | (defn- compile-not [pattern] 121 | (def body (compile-pattern pattern)) 122 | (unless (empty? (definitions body)) 123 | (error "not patterns cannot create bindings")) 124 | [~(as-macro ,scope 125 | (do ,;body) 126 | (as-macro ,fail) 127 | true)]) 128 | 129 | (defn- check [f x] 130 | (if (or (function? f) (cfunction? f)) 131 | (f x) 132 | f)) 133 | 134 | (defn- check-predicate [f x] 135 | (if (= ((disasm f) :max-arity) 0) 136 | (check (f) x) 137 | (f x))) 138 | 139 | (defn- subject [] 140 | (array/peek (dyn *subject*))) 141 | 142 | (defmacro- with-subject [subject & exprs] 143 | (with-syms [$result] ~(do 144 | (array/push (dyn *subject*) ,subject) 145 | (def ,$result ,;exprs) 146 | (array/pop (dyn *subject*)) 147 | ,$result))) 148 | 149 | (defn- definitely-nullary? [body] 150 | (var result true) 151 | (prewalk (fn [x] 152 | (when (and (symbol? x) (string/has-prefix? "$" x)) 153 | (set result false)) 154 | x) 155 | body) 156 | result) 157 | 158 | (test (definitely-nullary? ~(> $ 1)) false) 159 | (test (definitely-nullary? ~(> x 1)) true) 160 | (test (definitely-nullary? ~(|($ 1) 1)) false) 161 | 162 | (defn- compile-predicate [body] 163 | [(if (definitely-nullary? body) 164 | ~(as-macro ,unless (,check ,body ,(subject)) 165 | (as-macro ,fail)) 166 | ~(as-macro ,unless (,check-predicate (short-fn ,body) ,(subject)) 167 | (as-macro ,fail)))]) 168 | 169 | (defn- compile-equality [& args] 170 | [~(as-macro ,unless (,= ,(subject) ,;args) (as-macro ,fail))]) 171 | 172 | (defn- compile-inequality [& args] 173 | [~(as-macro ,when (,= ,(subject) ,;args) (as-macro ,fail))]) 174 | 175 | (defn- compile-map [f pattern] 176 | (with-syms [$subject] 177 | [~(as-macro ,alias ,$subject (,f ,(subject))) 178 | ;(with-subject $subject 179 | (compile-pattern pattern))])) 180 | 181 | (defn- compile-operator-pattern [pattern] 182 | (when (empty? pattern) 183 | (errorf "illegal pattern %q" pattern)) 184 | (def [instr & args] pattern) 185 | (case instr 186 | 'not (compile-not ;args) 187 | 'and (compile-and args) 188 | 'or (compile-or args) 189 | 'short-fn (compile-predicate ;args) 190 | 'quote (compile-equality pattern) 191 | 'quasiquote (compile-equality pattern) 192 | 'unquote (compile-pattern (eval ;args)) 193 | '= (compile-equality ;args) 194 | 'not= (compile-inequality ;args) 195 | 'map (compile-map ;args) 196 | (errorf "unknown operator %q in pattern %q" instr pattern))) 197 | 198 | (defn- slice [list i] 199 | (if (array? list) 200 | (array/slice list i) 201 | (tuple/slice list i))) 202 | 203 | (defn- compile-indexed-pattern [patterns] 204 | (def rest-index (find-index |(= $ '&) patterns)) 205 | (when rest-index 206 | (assert (<= (length patterns) (+ 2 rest-index)) 207 | "cannot specify multiple patterns after &")) 208 | (def rest-pattern (if rest-index 209 | (get patterns (+ 1 rest-index)))) 210 | (with-syms [$list] 211 | [~(as-macro ,alias ,$list ,(subject)) 212 | ;(with-subject $list 213 | [~(as-macro ,unless (,indexed? ,(subject)) 214 | (as-macro ,fail)) 215 | (if rest-index 216 | ~(as-macro ,unless (,>= (,length ,(subject)) ,rest-index) 217 | (as-macro ,fail)) 218 | ~(as-macro ,unless (,= (,length ,(subject)) ,(length patterns)) 219 | (as-macro ,fail))) 220 | ;(catseq [[i pattern] :pairs patterns :when (or (not rest-index) (< i rest-index))] 221 | (with-subject ~(,$list ,i) 222 | (compile-pattern pattern))) 223 | ;(if (nil? rest-pattern) 224 | [] 225 | (with-subject ~(,slice ,$list ,rest-index) 226 | (compile-pattern rest-pattern))) 227 | ])])) 228 | 229 | (defn- optional-pattern [pattern] 230 | (match pattern ['? p] p)) 231 | 232 | (defn- symbol-of-key [key] 233 | (match (type key) 234 | :keyword (symbol key) 235 | :symbol key 236 | nil)) 237 | 238 | (defn- compile-struct-value-pattern [pattern key] 239 | (def $sym (symbol-of-key key)) 240 | (if (and (= pattern '&) $sym) 241 | [~(def ,$sym ,(subject))] 242 | (compile-pattern pattern))) 243 | 244 | (defn- compile-dictionary-pattern [pattern] 245 | (with-syms [$dict] 246 | [~(as-macro ,alias ,$dict ,(subject)) 247 | ;(catseq [[key pattern] :pairs pattern] 248 | (with-subject ~(,$dict ,key) 249 | (if-let [opt-pattern (optional-pattern pattern)] 250 | (compile-struct-value-pattern opt-pattern key) 251 | [~(as-macro ,unless (has-key? ,$dict ,key) (as-macro ,fail)) 252 | ;(compile-struct-value-pattern pattern key)])))])) 253 | 254 | (defn- compile-symbol-pattern [pattern] 255 | (case pattern 256 | '_ [] 257 | '& (error "cannot bind & as a regular symbol") 258 | [~(def ,pattern ,(subject))])) 259 | 260 | (varfn compile-pattern [pattern] 261 | (case (type+ pattern) 262 | :symbol (compile-symbol-pattern pattern) 263 | :keyword (compile-equality pattern) 264 | :string (compile-equality pattern) 265 | :number (compile-equality pattern) 266 | :nil (compile-equality pattern) 267 | :boolean (compile-equality pattern) 268 | :tuple-parens (compile-operator-pattern pattern) 269 | :tuple-brackets (compile-indexed-pattern pattern) 270 | :struct (compile-dictionary-pattern pattern) 271 | (errorf "unknown pattern %q" pattern))) 272 | 273 | (def- no-default (gensym)) 274 | 275 | (defmacro- match1 [value pattern expr] 276 | (with-dyns [*subject* @[value]] 277 | ~(scope 278 | (do ,;(compile-pattern pattern) ,expr)))) 279 | 280 | (defmacro match [value & cases] 281 | (def [cases default-value] 282 | (if (odd? (length cases)) 283 | [(drop -1 cases) (last cases)] 284 | [cases no-default])) 285 | (with-dyns [*subject* @[value]] 286 | (fallback* 287 | (seq [[pattern expr] :in (partition 2 cases)] 288 | [;(compile-pattern pattern) expr]) 289 | (if (= default-value no-default) 290 | ~(,errorf "%q did not match" ,(subject)) 291 | default-value)))) 292 | 293 | # --------------------------------------------------- 294 | 295 | (deftest "trivial pattern expansions" 296 | (test-macro (match1 foo x x) 297 | (scope 298 | (do 299 | (def x foo) 300 | x))) 301 | (test-macro (match1 foo _ x) 302 | (scope 303 | (do 304 | x)))) 305 | 306 | (deftest "indexed pattern expansion" 307 | (test-macro (match1 foo [x y] (+ x y)) 308 | (scope 309 | (do 310 | (as-macro @alias <1> foo) 311 | (as-macro @unless (@indexed? <1>) 312 | (as-macro @fail)) 313 | (as-macro @unless (@= (@length <1>) 2) 314 | (as-macro @fail)) 315 | (def x (<1> 0)) 316 | (def y (<1> 1)) 317 | (+ x y)))) 318 | 319 | (test-macro (match1 foo [x y &] (+ x y)) 320 | (scope 321 | (do 322 | (as-macro @alias <1> foo) 323 | (as-macro @unless (@indexed? <1>) 324 | (as-macro @fail)) 325 | (as-macro @unless (@>= (@length <1>) 2) 326 | (as-macro @fail)) 327 | (def x (<1> 0)) 328 | (def y (<1> 1)) 329 | (+ x y)))) 330 | 331 | (test-macro (match1 foo [x y & z] (+ x y)) 332 | (scope 333 | (do 334 | (as-macro @alias <1> foo) 335 | (as-macro @unless (@indexed? <1>) 336 | (as-macro @fail)) 337 | (as-macro @unless (@>= (@length <1>) 2) 338 | (as-macro @fail)) 339 | (def x (<1> 0)) 340 | (def y (<1> 1)) 341 | (def z (@slice <1> 2)) 342 | (+ x y))))) 343 | 344 | (deftest "nested indexed patterns" 345 | (test-macro (match1 foo [[x y] z] (+ x y z)) 346 | (scope 347 | (do 348 | (as-macro @alias <1> foo) 349 | (as-macro @unless (@indexed? <1>) 350 | (as-macro @fail)) 351 | (as-macro @unless (@= (@length <1>) 2) 352 | (as-macro @fail)) 353 | (as-macro @alias <2> (<1> 0)) 354 | (as-macro @unless (@indexed? <2>) 355 | (as-macro @fail)) 356 | (as-macro @unless (@= (@length <2>) 2) 357 | (as-macro @fail)) 358 | (def x (<2> 0)) 359 | (def y (<2> 1)) 360 | (def z (<1> 1)) 361 | (+ x y z))))) 362 | 363 | (deftest "multiple patterns" 364 | (test-macro (match foo x x y y) 365 | (let [<1> (as-macro @scope (do (def x foo) x) (let [<2> (as-macro @scope (do (def y foo) y) (@errorf "%q did not match" foo))]))]))) 366 | 367 | (deftest "or expansion" 368 | (test-macro (match1 10 (or []) 20) 369 | (scope 370 | (do 371 | (let [<1> (as-macro @scope (do (as-macro @alias <2> 10) (as-macro @unless (@indexed? <2>) (as-macro @fail)) (as-macro @unless (@= (@length <2>) 0) (as-macro @fail))) (as-macro @fail))]) 372 | 20)))) 373 | 374 | (deftest "dictionary pattern expansion" 375 | (test-macro (match1 foo {:x x} x) 376 | (scope 377 | (do 378 | (as-macro @alias <1> foo) 379 | (as-macro @unless (has-key? <1> :x) 380 | (as-macro @fail)) 381 | (def x (<1> :x)) 382 | x)))) 383 | 384 | (deftest "not expansion" 385 | (test-macro (match1 foo (not nil) :ok) 386 | (scope 387 | (do 388 | (as-macro @scope 389 | (do 390 | (as-macro @unless (@= foo nil) 391 | (as-macro @fail))) 392 | (as-macro @fail) 393 | true) 394 | :ok)))) 395 | 396 | -------------------------------------------------------------------------------- /test/pat.janet: -------------------------------------------------------------------------------- 1 | (use ../src/init) 2 | (use judge) 3 | 4 | (test (seq [[key binding] :pairs (require "../src/init") 5 | :when (and (table? binding) (not (binding :private)))] 6 | key) 7 | @[match]) 8 | 9 | (deftest "trivial patterns" 10 | (test (match 10 x x) 10) 11 | (test (match 10 _ 20) 20)) 12 | 13 | (deftest "nested indexed patterns" 14 | (test (match [[1 2] 3] [[x y] z] (+ x y z)) 6)) 15 | 16 | (deftest "empty indexed patterns" 17 | (test (match 10 [] "list" x x) 10) 18 | (test (match [] [] "list" x x) "list")) 19 | 20 | (deftest "rest patterns" 21 | (test (match [] [&] :ok) :ok) 22 | (test (match [1 2 3] [x &] x) 1) 23 | (test (match [1 2 3] [x y &] (+ x y)) 3) 24 | (test (match [1 2 3] [x y z &] (+ x y z)) 6) 25 | (test-error (match [1 2 3] [x y z w &] (+ x y z w)) "(1 2 3) did not match")) 26 | 27 | (deftest "aliasing rest patterns" 28 | (test (match [1 2 3] [_ & rest] rest) [2 3]) 29 | (test (match [1 2 3] [x & [y z]] (+ x y z)) 6) 30 | (test-error (macex '(match [1 2 3] [x & y z] (+ x y z))) "cannot specify multiple patterns after &")) 31 | 32 | (deftest "tuple patterns match arrays too" 33 | (test (match @[] [] "list" x x) "list")) 34 | 35 | (deftest "multiple patterns" 36 | (test (match 10 x x y y) 10) 37 | (test (match 10 [x] x y y) 10)) 38 | 39 | (deftest "or" 40 | (test (match 10 (or x) x) 10) 41 | (test (match 10 (or [x] x) x) 10) 42 | (test (match [10] (or [x]) x) 10) 43 | (test (match [10] (or [x] x) x) 10) 44 | (test (match [10] (or x [x]) x) [10])) 45 | 46 | (deftest "or fails the match if no branch matches" 47 | (test-error (match 10 (or []) 20) "10 did not match") 48 | (test-error (match 10 (or []) 20) "10 did not match") 49 | (test-error (match 10 (or [_] [_ _]) "ok") "10 did not match")) 50 | 51 | (deftest "nested or" 52 | (test (match 10 (or (or (or x))) x) 10) 53 | (test-error (match 10 (or (or (or [x]))) x) "10 did not match") 54 | (test-error (match 10 (or [_] (or [_ _] [_ _ _])) "yeah") "10 did not match") 55 | (test (match [10] (or [x] x) x) 10)) 56 | 57 | (deftest "expansion raises if different branches of an or pattern bind distinct sets of symbols" 58 | (test-error (macex1 '(match 10 (or x y) x) "10 failed to match") 59 | "all branches of an or pattern must bind the same symbols\nx binds (x), but y binds (y)") 60 | (test-error (macex1 '(match 10 (or x _) x) "10 failed to match") 61 | "all branches of an or pattern must bind the same symbols\nx binds (x), but _ binds ()") 62 | (test-error (macex1 '(match 10 (or [x y] [x y z]) x) "10 failed to match") 63 | "all branches of an or pattern must bind the same symbols\n[x y] binds (x y), but [x y z] binds (x y z)")) 64 | 65 | (deftest "& is an illegal symbol to bind" 66 | (test-error (macex1 '(match 10 & :ok) "10 failed to match") "cannot bind & as a regular symbol")) 67 | 68 | (deftest "pattern that does not match raises unless a default is provided" 69 | (test-error (match 10 [x] x [x y] (+ x y)) "10 did not match") 70 | (test (match 10 [x] x [x y] (+ x y) "default") "default")) 71 | 72 | (deftest "you can raise a custom error in the default" 73 | (test (match [10] [x] x [x y] (+ x y) (error "custom")) 10) 74 | (test-error (match 10 [x] x [x y] (+ x y) (error "custom")) "custom")) 75 | 76 | (deftest "and patterns" 77 | (test (match 2 (and x y) (+ x y)) 4) 78 | (test (match [1 2 3] (and [x y z] list) [(+ x y z) list]) [6 [1 2 3]])) 79 | 80 | (deftest "predicate patterns" 81 | (test (match 2 |(even? $) :even |(odd? $) :odd) :even) 82 | (test (match 3 |(even? $) :even |(odd? $) :odd) :odd)) 83 | 84 | (deftest "implicit predicate patterns" 85 | (test (match 2 |even? :even |odd? :odd) :even) 86 | (test (match 3 |even? :even |odd? :odd) :odd)) 87 | 88 | (deftest "dynamic predicates" 89 | (test (match [odd? 1] [f |f] :ok) :ok) 90 | (test-error (match [even? 1] [f |f] :ok) "( 1) did not match")) 91 | 92 | (deftest "boolean expression patterns" 93 | (test (match 2 |(> 2 1) :ok :wat) :ok) 94 | (test (match 2 |(> 1 2) :wat :ok) :ok)) 95 | 96 | (deftest "predicates can refer to previously bound values" 97 | (test (match [1 2] [x (and |(> $ x) y)] (+ x y)) 3) 98 | (test-error (match [2 1] [x (and |(> $ x) y)] (+ x y)) "(2 1) did not match") 99 | (test (match [1 2] [x (and y |(> y x))] (+ x y)) 3) 100 | (test-error (match [2 1] [x (and y |(> y x))] (+ x y)) "(2 1) did not match")) 101 | 102 | (deftest "duplicate bound variables always overwrite each other" 103 | (test (match [1 2] [x x] x) 2) 104 | (test (match [1 1 2] [x |(= x $) x] x) 2) 105 | (test (match [1 [2] 3] [x [(and x y)] x] [x y]) [3 2])) 106 | 107 | (deftest "equality patterns" 108 | (def x 10) 109 | (test (match 10 (= x) :ok) :ok) 110 | (test (match [10 10] [y (= x y)] y) 10) 111 | (test-error (match [1 2] [x (= 1 x)] x) "(1 2) did not match") 112 | (test-error (match [1 2] [x (= x)] x) "(1 2) did not match") 113 | (test (match [1 1] [x (= 1 x)] x) 1)) 114 | 115 | (deftest "literal patterns" 116 | (test (match 10 10 :ok) :ok) 117 | (test (match :foo :foo :ok) :ok) 118 | (test (match :bar (or :foo :bar) :ok) :ok) 119 | (test (match "foo" "foo" :ok) :ok) 120 | (test (match nil nil :ok) :ok) 121 | (test (match true true :ok) :ok) 122 | (test-error (match true false :ok) "true did not match")) 123 | 124 | (deftest "quoted patterns" 125 | (test (match 'foo 'foo :ok) :ok) 126 | (test (match ['foo] '(foo) :ok) :ok)) 127 | 128 | (deftest "quasiquoted patterns" 129 | (def x 10) 130 | (test (match 'foo ~foo :ok) :ok) 131 | (test (match [10] ~(,x) :ok) :ok)) 132 | 133 | # this must reference an environment entry in order to work 134 | (def pattern '[x y]) 135 | (deftest "unquote patterns" 136 | (test (match [1 2] ,pattern (+ x y)) 3)) 137 | 138 | (deftest "quoted patterns respect tuple bracketedness" 139 | (test-error (match ['foo] '[foo] :ok) "(foo) did not match")) 140 | 141 | (deftest "dictionary patterns" 142 | (test (match {:x 1} {:x x} x) 1) 143 | (test (match {:x 1 :y 2} {:x x :y y} (+ x y)) 3) 144 | (test-error (match {:x 1} {:x x :y y} (+ x y)) "{:x 1} did not match") 145 | (test (match {:x 1} {:x x :y (? y)} [x y]) [1 nil]) 146 | (test (match {:x 1} {:x &} x) 1) 147 | (test (match {:x 1} {:x & :y (? &)} [x y]) [1 nil])) 148 | 149 | (deftest "not" 150 | (test (match 1 (and (not 2) (not 3)) :yes :no) :yes) 151 | (test (match [1] (not []) :yes :no) :yes) 152 | (test (match [] (not [_]) :yes :no) :yes) 153 | (test (match [1] (not [_]) :yes :no) :no) 154 | (test (match [[1]] (not [_]) :yes :no) :no) 155 | (test (match [[1]] [(not [_])] :yes :no) :no) 156 | (test (match [[1]] [(not [_ _])] :yes :no) :yes) 157 | (test-error (macex '(match foo (not x) 0)) "not patterns cannot create bindings") 158 | (test-error (macex '(match foo (not x y) 0)) " called with 2 arguments, expected 1") 159 | (test-error (macex '(match foo (not) 0)) " called with 0 arguments, expected 1")) 160 | 161 | (deftest "not=" 162 | (test (match 1 (not= 2) :yes :no) :yes) 163 | (test (match 2 (not= 2) :yes :no) :no)) 164 | 165 | (deftest "map" 166 | (test (match [1 2 3] (map first 1) :yes :no) :yes) 167 | (test (match [1 2 3] (map first 2) :yes :no) :no) 168 | (test (match [1 2 3] (map max-of |odd?) :yes :no) :yes)) 169 | --------------------------------------------------------------------------------