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

moving to another machine

Browse Source
This commit is contained in:
John Clements 2010-12-05 23:40:54 -08:00
parent 6f84a1c143
commit 0d2a4b98db
2 changed files with 47 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/stepper/private/annotate.rkt
View File

@ -522,9 +522,8 @@
[outer-lambda-abstraction
(lambda (annotated-lambda free-varrefs)
(match-let*
([ap-struct-maker
#`(#,annotated-proc #,annotated-lambda #f)]
[closure-info (make-debug-info-app 'all free-varrefs 'none)]
([closure-info (make-debug-info-app 'all free-varrefs 'none)]
;; if we manually disable the storage of
;; names, lambdas get rendered as lambdas.
[closure-name
@ -534,38 +533,41 @@
[(pair? procedure-name-info)
(car procedure-name-info)]
[else #f]))]
[closure-storing-proc
(opt-lambda (closure debug-info [lifted-index #f])
(closure-table-put! closure
(make-closure-record
closure-name
debug-info
#f
lifted-index))
closure)]
;; gnarr! I can't find a test case
;; that depends on the attachment of the inferred name...
[inferred-name-lambda
(if closure-name
(syntax-property
annotated-lambda
'inferred-name
(syntax-e closure-name))
annotated-lambda)]
[captured
[make-ap-struct
(lambda (clo debug-info maybe-index)
(annotated-proc
clo
(make-closure-record
closure-name
debug-info
#f
maybe-index)))]
[ap-struct-maker
(cond [(pair? procedure-name-info)
#`(#%plain-app
#,closure-storing-proc
#,inferred-name-lambda
#,closure-info
#`(#%app
#,make-ap-struct
#,closure-info
#,(cadr procedure-name-info))]
[else
#`(#%plain-app
#,closure-storing-proc
#,inferred-name-lambda
#,closure-info)])])
#`(#%app
#,make-ap-struct
#,closure-info
#f)])]
;; gnarr! I can't find a test case
;; that depends on the attachment of the inferred name...
[inferred-name-struct
(if closure-name
(syntax-property
ap-struct-maker
'inferred-name
(syntax-e closure-name))
ap-struct-maker)])
(normal-bundle free-varrefs captured)))]
(normal-bundle free-varrefs
inferred-name-struct)))]
; @@

20
collects/tests/stepper/through-tests.rkt
View File

@ -214,13 +214,21 @@
-> ,@defs {21}))
;;intermediate/lambda hof
(let ([defs `((define (a x)
(lambda (y) (+ x y)))
(define b (a 9)))])
(let ([a-def `(define (a x)
(lambda (y) (+ x y)))])
(t 'intermediate-lambda-hof m:intermediate-lambda
,@defs (b 5)
:: ,@defs {(b 5)}
-> @defs {'zoofrenzy}))
,a-def (define b (a 9)) (b 5)
:: ,a-def (define b ({a} 9))
-> ,a-def (define b ({(lambda (x) (lambda (y) (+ x y)))} 9))
:: ,a-def (define b {((lambda (x) (lambda (y) (+ x y))) 9)})
-> ,a-def (define b {(lambda (y) (+ 9 y))})
:: ,a-def (define b (lambda (y) (+ 9 y))) ({b} 5)
-> ,a-def (define b (lambda (y) (+ 9 y)))
({(lambda (y) (+ 9 y))} 5)
:: ,a-def (define b (lambda (y) (+ 9 y)))
{((lambda (y) (+ 9 y)) 5)}
-> ,a-def (define b (lambda (y) (+ 9 y))) {(+ 9 5)}
-> ,a-def (define b (lambda (y) (+ 9 y))) {14}))
;;;;;;;;;;;;
;;