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

fix begin0 processing and add needed recertification

Browse Source 
svn: r3252
This commit is contained in:
Matthew Flatt 2006-06-06 20:17:39 +00:00
parent 58cc9eaf85
commit acc14ecf29
1 changed files with 55 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/trace/stacktrace.ss
View File

@ -42,10 +42,10 @@
(kernel-syntax-case stx #f
[(define-values (var ...) expr)
(let ([var-list (syntax->list #'(var ...))])
(cond [(= (length var-list) 1) #`(define-values (var ...) #,(expr-iterator #'expr (car var-list)))]
[else #`(define-values (var ...) #,(expr-iterator #'expr #f))]))]
(cond [(= (length var-list) 1) #`(define-values (var ...) #,(expr-iterator #'expr (car var-list) (current-code-inspector)))]
[else #`(define-values (var ...) #,(expr-iterator #'expr #f (current-code-inspector)))]))]
[(define-syntaxes (var ...) expr)
#`(define-syntaxes (var ...) #,(expr-iterator #'expr #f))]
#`(define-syntaxes (var ...) #,(expr-iterator #'expr #f (current-code-inspector)))]
[(begin . top-level-exprs)
#`(begin #,@(map top-level-expr-iterator (syntax->list #'top-level-exprs)))]
[(require . require-specs)
@ -53,13 +53,13 @@
[(require-for-syntax . require-specs)
stx]
[else
(expr-iterator stx #f)]))
(expr-iterator stx #f (current-code-inspector))]))
(define (expr-iterator stx potential-name)
(define (expr-iterator stx potential-name insp)
(let* ([name-guess (or (syntax-property stx 'inferred-name) potential-name)]
[recur-tail (lambda (expr) (expr-iterator expr name-guess))]
[recur-non-tail (lambda (expr) (expr-iterator expr #f))]
[recur-with-name (lambda (expr name) (expr-iterator expr name))]
[recur-tail (lambda (expr) (expr-iterator expr name-guess insp))]
[recur-non-tail (lambda (expr) (expr-iterator expr #f insp))]
[recur-with-name (lambda (expr name) (expr-iterator expr name insp))]
[recur-on-sequence (lambda (exprs)
(let loop ([remaining exprs])
(cond [(null? remaining) null]
@ -113,6 +113,7 @@
stx
;(syntax-object->datum stx)
)]))])
(syntax-recertify
(kernel-syntax-case stx #f
[var-stx
(identifier? (syntax var-stx))
@ -131,7 +132,7 @@
[(begin . bodies)
#`(begin #,@(recur-on-sequence (syntax->list #'bodies)))]
[(begin0 . bodies)
#`(begin #,@(map recur-non-tail #'bodies))]
#`(begin #,@(map recur-non-tail (syntax->list #'bodies)))]
[(let-values . _)
(let-values-abstraction stx)]
[(letrec-values . _)
@ -155,7 +156,10 @@
stx]
[else
(error 'expr-iterator "unknown expr: ~a"
(syntax-object->datum stx))])))
(syntax-object->datum stx))])
stx
insp
#f)))
(define (arglist-flatten arglist)
(let loop ([remaining arglist]