Changeset 5888 in project
 Timestamp:
 09/03/07 18:15:26 (12 years ago)
 Location:
 matchable
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

matchable/matchabletest.scm
r4622 r5888 214 214 '((a b) (1 2) (c . 3) (d . 4) (e . 5))) 215 215 216 (testequal "Riastradh quasiquote" 217 (match '(1 2 3) (`(1 ,b ,c) (list b c))) 218 '(2 3)) 219 216 220 (testend "match") 217 221 
matchable/matchable.scm
r4622 r5888 16 16 ;; hit. 17 17 18 ;; 2007/09/04  fixing quasiquote patterns 19 ;; 2007/07/21  allowing ellipse patterns in nonfinal list positions 20 ;; 2007/04/10  fixing potential hygiene issue in matchcheckellipse 21 ;; (thanks to Taylor Campbell) 22 ;; 2007/04/08  clean up, commenting 23 ;; 2006/12/24  bugfixes 24 ;; 2006/12/01  nonlinear patterns, shared variables in OR, get!/set! 25 18 26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 19 27 … … 21 29 ;; thus always results in a compiletime error. 22 30 23 (definesyntax *matchsyntaxerror31 (definesyntax matchsyntaxerror 24 32 (syntaxrules () 25 33 ((_) 26 ( syntaxerror 'match "invalid *matchsyntaxerror usage"))))34 (matchsyntaxerror "invalid matchsyntaxerror usage")))) 27 35 28 36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; … … 35 43 (syntaxrules () 36 44 ((match) 37 ( *matchsyntaxerror "missing match expression"))45 (matchsyntaxerror "missing match expression")) 38 46 ((match atom) 39 ( *matchsyntaxerror "missing match clause"))47 (matchsyntaxerror "missing match clause")) 40 48 ((match (app ...) (pat . body) ...) 41 49 (let ((v (app ...))) … … 157 165 ((matchtwo v x g s (sk ...) fk (id ...)) 158 166 (letsyntax 159 (( sym?167 ((newsym? 160 168 (syntaxrules (id ...) 161 ((sym? id sk2 fk2) fk2) ... 162 ((sym? x sk2 fk2) sk2) 163 ((sym? y sk2 fk2) fk2)))) 164 (sym? abracadabra ; thanks Oleg 169 ((newsym? x sk2 fk2) sk2) 170 ((newsym? y sk2 fk2) fk2)))) 171 (newsym? abracadabra ; thanks Oleg 165 172 (let ((x v)) (sk ... (id ... x))) 166 173 (if (equal? v x) (sk ... (id ...)) fk)))) … … 183 190 ((_ v (quasiquote p) g s sk fk i . depth) 184 191 (matchquasiquote v p g s sk fk i #f . depth)) 185 ((_ v (unquote p) g s sk fk i 192 ((_ v (unquote p) g s sk fk i x . depth) 186 193 (matchquasiquote v p g s sk fk i . depth)) 187 194 ((_ v (unquotesplicing p) g s sk fk i x . depth) … … 192 199 (matchquasiquote 193 200 w p g s 194 (matchquasiquote x q g s sk fk i .depth)201 (matchquasiquotestep x q g s sk fk depth) 195 202 fk i . depth)) 196 203 fk)) … … 202 209 ((_ v x g s sk fk i . depth) 203 210 (matchone v 'x g s sk fk i)))) 211 212 (definesyntax matchquasiquotestep 213 (syntaxrules () 214 ((matchquasiquotestep x q g s sk fk depth i) 215 (matchquasiquote x q g s sk fk i . depth)) 216 )) 204 217 205 218 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; … … 291 304 (matchcheckellipse 292 305 x 293 ( *matchsyntaxerror306 (matchsyntaxerror 294 307 "multiple ellipse patterns not allowed at same level") 295 308 (matchverifynoellipses y sk))) … … 398 411 ((matchextractvars (= proc p) k i v) 399 412 (matchextractvars p k i v)) 400 ((matchextractvars (quote x) (k ...) i v) (k ... v)) 401 ((matchextractvars (quasiquote x) (k ...) i v) (k ... v)) 413 ((matchextractvars (quote x) (k ...) i v) 414 (k ... v)) 415 ((matchextractvars (quasiquote x) k i v) 416 (matchextractquasiquotevars x k i v (#t))) 402 417 ((matchextractvars (and . p) k i v) 403 418 (matchextractvars p k i v)) … … 405 420 (matchextractvars p k i v)) 406 421 ((matchextractvars (not . p) k i v) 407 (matchextractvars p k i v))408 ((matchextractvars (p) k i v)409 422 (matchextractvars p k i v)) 410 423 ;; A nonkeyword pair, expand the CAR with a continuation to … … 425 438 ((matchextractvars p (k ...) (i ...) v) 426 439 (letsyntax 427 (( sym?440 ((newsym? 428 441 (syntaxrules (i ...) 429 ((sym? i sk fk) fk) ... 430 ((sym? p sk fk) sk) 431 ((sym? x sk fk) fk)))) 432 (sym? abracadabra (k ... ((p pls) . v)) (k ... v)))) 442 ((newsym? p sk fk) sk) 443 ((newsym? x sk fk) fk)))) 444 (newsym? randomsymtomatch 445 (k ... ((p pls) . v)) 446 (k ... v)))) 433 447 )) 434 448 … … 439 453 (syntaxrules () 440 454 ((_ p k i v ((v2 v2ls) ...)) 441 (matchextractvars p k (v2 ... . i) ((v2 v2ls) ... . v))))) 455 (matchextractvars p k (v2 ... . i) ((v2 v2ls) ... . v))) 456 )) 457 458 (definesyntax matchextractquasiquotevars 459 (syntaxrules (quasiquote unquote unquotesplicing) 460 ((matchextractquasiquotevars (quasiquote x) k i v d) 461 (matchextractquasiquotevars x k i v (#t . d))) 462 ((matchextractquasiquotevars (unquotesplicing x) k i v d) 463 (matchextractquasiquotevars (unquote x) k i v d)) 464 ((matchextractquasiquotevars (unquote x) k i v (#t)) 465 (matchextractvars x k i v)) 466 ((matchextractquasiquotevars (unquote x) k i v (#t . d)) 467 (matchextractquasiquotevars x k i v d)) 468 ((matchextractquasiquotevars (x . y) k i v (#t . d)) 469 (matchextractquasiquotevars 470 x 471 (matchextractquasiquotevarsstep y k i v d) i ())) 472 ((matchextractquasiquotevars #(x ...) k i v (#t . d)) 473 (matchextractquasiquotevars (x ...) k i v d)) 474 ((matchextractquasiquotevars x (k ...) i v (#t . d)) 475 (k ... v)) 476 )) 477 478 (definesyntax matchextractquasiquotevarsstep 479 (syntaxrules () 480 ((_ x k i v d ((v2 v2ls) ...)) 481 (matchextractquasiquotevars x k (v2 ... . i) ((v2 v2ls) ... . v) d)) 482 )) 483 442 484 443 485 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; … … 496 538 ((_ ((pat expr) . rest) . body) 497 539 (match expr (pat (matchlet* rest . body)))))) 540 498 541 499 542 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
matchable/matchable.setup
r4622 r5888 1 1 (installextension 'matchable 2 2 '("matchable.scm") 3 '((version 2. 0)3 '((version 2.1) 4 4 (syntax)))
Note: See TracChangeset
for help on using the changeset viewer.