match: preserve stx loc of original app expr

This commit is contained in:
Bogdan Popa 2020-11-16 21:59:06 +02:00 committed by Sam Tobin-Hochstadt
parent bdef494c8c
commit 88db31f46d

View File

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