suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Handle set! transformers in match expanders.

Browse Source 
- use prop:set!-transformer
 - extract set!-transformers where necessary
 Closes PR 10481
This commit is contained in:
Sam Tobin-Hochstadt 2010-05-20 13:11:59 -05:00
parent 230f1a59c6
commit 188f080c79
3 changed files with 36 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/racket/match/parse-helper.rkt
View File

@ -136,7 +136,10 @@
(define (match-expander-transform parse/cert cert expander stx accessor
error-msg)
(let* ([expander (syntax-local-value (cert expander))]
[transformer (accessor expander)])
[transformer (accessor expander)]
[transformer (if (set!-transformer? transformer)
(set!-transformer-procedure transformer)
transformer)])
(unless transformer (raise-syntax-error #f error-msg expander))
(let* ([introducer (make-syntax-introducer)]
[certifier (match-expander-certifier expander)]

15
collects/racket/match/patterns.rkt
View File

@ -208,6 +208,19 @@
identifier?))])))
(define-struct match-expander (match-xform legacy-xform macro-xform certifier)
#:property prop:procedure (struct-field-index macro-xform))
#| #:property prop:procedure (lambda (me stx)
(define xf (match-expander-macro-xform me))
(define xf* (if (set!-transformer? xf)
(set!-transformer-procedure xf)
xf))
(xf* stx))|#
#:property prop:set!-transformer (lambda (me stx)
(define xf (match-expander-macro-xform me))
(if (set!-transformer? xf)
((set!-transformer-procedure xf) stx)
(syntax-case stx (set!)
[(set! . _)
(raise-syntax-error #f "cannot mutate syntax identifier" stx)]
[_ (xf stx)]))))
(provide (struct-out match-expander))

18
collects/tests/match/examples.rkt
View File

@ -653,5 +653,23 @@
(list a))))
#t]
[_ #f]))
(comp '(2 7)
(let ()
(define-match-expander foo
(syntax-rules () [(_) 1])
(syntax-id-rules (set!)
[(set! _ v) v]
[(_) 2]))
(list (foo)
(set! foo 7))))
(comp 0
(let ()
(define-match-expander foo
(syntax-id-rules () [_ 10]))
(match 10
[(foo) 0]
[_ 1])))
))