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

fix `#lang errortrace'

Browse Source 
Since `#lang errortrace' annotates the result of `local-expand',
 it needs to handle `letrec-syntaxes+values', as well as allowing
 `#%expression' in more places.

 This change relies on a change to `kernel-syntax-case'. This
 isn't a new bug, and it's ok to not include it in 5.1.2
 (especially since the `kernel-syntax-case' change should not be
 merged).
This commit is contained in:
Matthew Flatt 2011-07-15 19:41:31 -06:00
parent 0f61d62ea1
commit 072003f2f4
1 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/errortrace/stacktrace.rkt
View File

@ -168,6 +168,8 @@
(insert-at-tail* se sexpr phase)] (insert-at-tail* se sexpr phase)]
[(letrec-values bindings . body) [(letrec-values bindings . body)
(insert-at-tail* se sexpr phase)] (insert-at-tail* se sexpr phase)]
[(letrec-syntaxes+values sbindings bindings . body)
(insert-at-tail* se sexpr phase)]
[(begin . _) [(begin . _)
(insert-at-tail* se sexpr phase)] (insert-at-tail* se sexpr phase)]
@ -406,7 +408,6 @@
(rebuild mb (map cons bodys bodyl)))))))))])] (rebuild mb (map cons bodys bodyl)))))))))])]
[(#%expression e) [(#%expression e)
top?
(rearm expr #`(#%expression #,(annotate (syntax e) phase)))] (rearm expr #`(#%expression #,(annotate (syntax e) phase)))]
;; No way to wrap ;; No way to wrap
@ -468,6 +469,16 @@
fm] fm]
[_ [_
(with-mark expr fm)]))] (with-mark expr fm)]))]
;; This case is needed for `#lang errortrace ...', which uses
;; `local-expand' on the module body.
[(letrec-syntaxes+values sbindings ([vars rhs] ...) . body)
(let ([fm (rearm
expr
(annotate-let disarmed-expr phase
(syntax (vars ...))
(syntax (rhs ...))
(syntax body)))])
(with-mark expr fm))]
;; Wrap RHS ;; Wrap RHS
[(set! var rhs) [(set! var rhs)