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

match: preserve stx loc of original app expr

Browse Source
This commit is contained in:
Bogdan Popa 2020-11-16 21:59:06 +02:00 committed by Sam Tobin-Hochstadt
parent bdef494c8c
commit 88db31f46d
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
racket/collects/racket/match/compiler.rkt
View File

@ -289,12 +289,14 @@
(error 'compile-one "App block with multiple rows: ~a" block)) (error 'compile-one "App block with multiple rows: ~a" block))
(let* ([row (car block)] (let* ([row (car block)]
[pats (Row-pats row)] [pats (Row-pats row)]
[app-pats (App-ps first)]) [app-pats (App-ps first)]
[app-expr (App-expr first)])
(with-syntax ([(t ...) (generate-temporaries app-pats)]) (with-syntax ([(t ...) (generate-temporaries app-pats)])
#`(let-values ([(t ...) #`(let-values ([(t ...)
#,(if (procedure? (App-expr first)) #,(if (procedure? app-expr)
((App-expr first) x) (app-expr x)
#`(#,(App-expr first) #,x))]) (quasisyntax/loc app-expr
(#,app-expr #,x)))])
#,(compile* (append (syntax->list #'(t ...)) xs) #,(compile* (append (syntax->list #'(t ...)) xs)
(list (make-Row (append app-pats (cdr pats)) (list (make-Row (append app-pats (cdr pats))
(Row-rhs row) (Row-rhs row)