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)) [(and (not (eq? target 'val))
(eq? linkage 'return)) (eq? linkage 'return))
;; This case happens for set!, which may install the results of an ;; This case should be impossible: return linkage should only
;; application directly into the environment. ;; occur when we're in tail position, and we're in tail position
(let ([proc-return (make-label 'procReturn)]) ;; only when the target is the val register.
(end-with-linkage linkage (error 'compile "return linkage, target not val: ~s" target)]))
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))))))]))
(: compile-let1 (Let1 Natural Target Linkage -> InstructionSequence)) (: compile-let1 (Let1 Natural Target Linkage -> InstructionSequence))
(define (compile-let1 exp cenv target linkage) (define (compile-let1 exp cenv target linkage)

25
parse.rkt
View File

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

9
test-compiler.rkt
View File

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

54
test-parse.rkt
View File

@ -317,11 +317,12 @@
(make-Let1 (make-Constant 0) (make-Let1 (make-Constant 0)
(make-BoxEnv 0 (make-BoxEnv 0
(make-Lam #f 0 (make-Lam #f 0
(make-InstallValue (make-Seq (list (make-InstallValue
1 1
(make-App (make-ToplevelRef 1 0) (make-App (make-ToplevelRef 1 0)
(list (make-LocalRef 2 #t))) (list (make-LocalRef 2 #t)))
#t) #t)
(make-Constant (void))))
'(1 0)))))) ;; x is 0, prefix is 1 '(1 0)))))) ;; x is 0, prefix is 1
@ -336,10 +337,43 @@
(make-InstallValue 0 (make-Constant 0) #t) (make-InstallValue 0 (make-Constant 0) #t)
(make-InstallValue 1 (make-Constant 1) #t) (make-InstallValue 1 (make-Constant 1) #t)
(make-Lam #f 0 (make-Lam #f 0
(make-InstallValue (make-Seq
1 (list (make-InstallValue
(make-App (make-ToplevelRef 1 0) 1
(list (make-LocalRef 2 #t))) (make-App (make-ToplevelRef 1 0)
#t) (list (make-LocalRef 2 #t)))
#t)
(make-Constant (void))))
'(2 0)))) '(2 0))))
#t))) #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)))))))