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

add orig-stx parameter

Browse Source 
svn: r9056
This commit is contained in:
Sam Tobin-Hochstadt 2008-03-22 01:40:13 +00:00
parent 3552f7f73b
commit c914aab4ea
2 changed files with 3 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/scheme/match/gen-match.ss
View File

@ -9,6 +9,7 @@
;; this parses the clauses using parse/cert, then compiles them ;; this parses the clauses using parse/cert, then compiles them
;; go : syntax syntax syntax certifier -> syntax ;; go : syntax syntax syntax certifier -> syntax
(define (go parse/cert stx exprs clauses cert) (define (go parse/cert stx exprs clauses cert)
(parameterize ([orig-stx stx])
(syntax-case clauses () (syntax-case clauses ()
[([pats . rhs] ...) [([pats . rhs] ...)
(let ([len (length (syntax->list exprs))]) (let ([len (length (syntax->list exprs))])
@ -42,4 +43,4 @@
(let ([xs exprs] (let ([xs exprs]
...) ...)
(let ([fail (lambda () #,(syntax/loc stx (match:error orig-expr)))]) (let ([fail (lambda () #,(syntax/loc stx (match:error orig-expr)))])
body))))))])) body))))))])))

1
collects/scheme/match/patterns.ss
View File

@ -19,6 +19,7 @@
(current-continuation-marks) (current-continuation-marks)
val))) val)))
(define orig-stx (make-parameter #f))
(define-struct Pat () #:transparent) (define-struct Pat () #:transparent)
;; v is an identifier ;; v is an identifier