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

tracing bug with boxenv

Browse Source
This commit is contained in:
Danny Yoo 2011-03-23 19:17:56 -04:00
parent 7357c8e850
commit 1e30968481
4 changed files with 67 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
compile.rkt
View File

@ -392,18 +392,11 @@
[(and (not (eq? target 'val))
(eq? linkage 'return))
;; This case happens for set!, which may install the results of an
;; application directly into the environment.
(let ([proc-return (make-label 'procReturn)])
(end-with-linkage linkage
cenv-without-args
(make-instruction-sequence
`(,(make-PushControlFrame proc-return)
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))
,(make-GotoStatement (make-Reg 'val))
,proc-return
,(make-AssignImmediateStatement target (make-Reg 'val))))))]))
;; This case should be impossible: return linkage should only
;; occur when we're in tail position, and we're in tail position
;; only when the target is the val register.
(error 'compile "return linkage, target not val: ~s" target)]))
(: compile-let1 (Let1 Natural Target Linkage -> InstructionSequence))
(define (compile-let1 exp cenv target linkage)

25
parse.rkt
View File

@ -88,17 +88,20 @@
[(set!? exp)
(let ([address (find-variable (set!-name exp) cenv)])
(cond
[(EnvLexicalReference? address)
(make-InstallValue (EnvLexicalReference-depth address)
(parse (set!-value exp) cenv)
#t)]
[(EnvPrefixReference? address)
(make-ToplevelSet (EnvPrefixReference-depth address)
(EnvPrefixReference-pos address)
(definition-variable exp)
(parse (set!-value exp) cenv))]))]
;; Subtle: this needs to be a sequence here to disable tail calls for the
;; extent of the set!-value.
(make-Seq (list (cond
[(EnvLexicalReference? address)
(make-InstallValue (EnvLexicalReference-depth address)
(parse (set!-value exp) cenv)
#t)]
[(EnvPrefixReference? address)
(make-ToplevelSet (EnvPrefixReference-depth address)
(EnvPrefixReference-pos address)
(definition-variable exp)
(parse (set!-value exp) cenv))])
(make-Constant (void)))))]
;; Remember, this needs to be the last case.
[(application? exp)
(let ([cenv-with-scratch-space

9
test-compiler.rkt
View File

@ -667,8 +667,8 @@
(define b '(world))
(define reset!
(lambda ()
(set! a '())
(reset!)))
(set! a '())))
(reset!)
(list a b))
'(() (world)))
@ -688,9 +688,8 @@
(lambda ()
(set! a '())
'ok))
(reset!)
(list a b))
'(()(world)))
(list a b (reset!) a b))
'((hello) (world) ok () (world)))
(test '(begin (define a '(hello))
(define b '(world))

54
test-parse.rkt
View File

@ -317,11 +317,12 @@
(make-Let1 (make-Constant 0)
(make-BoxEnv 0
(make-Lam #f 0
(make-InstallValue
1
(make-App (make-ToplevelRef 1 0)
(list (make-LocalRef 2 #t)))
#t)
(make-Seq (list (make-InstallValue
1
(make-App (make-ToplevelRef 1 0)
(list (make-LocalRef 2 #t)))
#t)
(make-Constant (void))))
'(1 0)))))) ;; x is 0, prefix is 1
@ -336,10 +337,43 @@
(make-InstallValue 0 (make-Constant 0) #t)
(make-InstallValue 1 (make-Constant 1) #t)
(make-Lam #f 0
(make-InstallValue
1
(make-App (make-ToplevelRef 1 0)
(list (make-LocalRef 2 #t)))
#t)
(make-Seq
(list (make-InstallValue
1
(make-App (make-ToplevelRef 1 0)
(list (make-LocalRef 2 #t)))
#t)
(make-Constant (void))))
'(2 0))))
#t)))
(test (parse '(begin (define a '(hello))
(define b '(world))
(define reset!
(lambda ()
(set! a '())
(set! b '())))
(reset!)
(list a b)))
(make-Top
(make-Prefix '(a b list reset!))
(make-Seq
(list
(make-ToplevelSet 0 0 'a (make-Constant '(hello)))
(make-ToplevelSet 0 1 'b (make-Constant '(world)))
(make-ToplevelSet
0
3
'reset!
(make-Lam
'reset!
0
(make-Seq
(list
(make-Seq (list (make-ToplevelSet 0 0 'a (make-Constant '())) (make-Constant (void))))
(make-Seq (list (make-ToplevelSet 0 1 'b (make-Constant '())) (make-Constant (void))))))
'(0)))
(make-App (make-ToplevelRef 0 3) '())
(make-App (make-ToplevelRef 2 2) (list (make-ToplevelRef 2 0) (make-ToplevelRef 2 1)))))))