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

identified that, for some reason, the wrong value is being stored in closures. Now trying to figure out why.

Browse Source
This commit is contained in:
Danny Yoo 2011-05-17 16:48:07 -04:00
parent 185b9f197c
commit 2c34cf5811
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
compiler.rkt
View File

@ -480,7 +480,9 @@
cenv cenv
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PerformStatement (make-CheckToplevelBound! `(,(make-Comment (format "Checking the prefix of length ~s"
(length (Prefix-names (ensure-prefix (list-ref cenv (ToplevelRef-depth exp)))))))
,(make-PerformStatement (make-CheckToplevelBound!
(ToplevelRef-depth exp) (ToplevelRef-depth exp)
(ToplevelRef-pos exp))) (ToplevelRef-pos exp)))
,(make-AssignImmediateStatement ,(make-AssignImmediateStatement
@ -852,7 +854,8 @@
[maybe-install-closure-values : InstructionSequence [maybe-install-closure-values : InstructionSequence
(if (not (empty? (Lam-closure-map exp))) (if (not (empty? (Lam-closure-map exp)))
(make-instruction-sequence (make-instruction-sequence
`(,(make-PerformStatement (make-InstallClosureValues!)))) `(,(make-Comment (format "installing closure for ~s" (Lam-name exp)))
,(make-PerformStatement (make-InstallClosureValues!))))
empty-instruction-sequence)] empty-instruction-sequence)]
[lam-body-code : InstructionSequence [lam-body-code : InstructionSequence
(compile (Lam-body exp) (compile (Lam-body exp)
@ -1623,18 +1626,18 @@
;; we can generate better code. ;; we can generate better code.
(define (extract-static-knowledge exp cenv) (define (extract-static-knowledge exp cenv)
(cond (cond
[(Lam? exp) #;[(Lam? exp)
(make-StaticallyKnownLam (Lam-name exp) (make-StaticallyKnownLam (Lam-name exp)
(Lam-entry-label exp) (Lam-entry-label exp)
(if (Lam-rest? exp) (if (Lam-rest? exp)
(make-ArityAtLeast (Lam-num-parameters exp)) (make-ArityAtLeast (Lam-num-parameters exp))
(Lam-num-parameters exp)))] (Lam-num-parameters exp)))]
[(and (LocalRef? exp) #;[(and (LocalRef? exp)
(not (LocalRef-unbox? exp))) (not (LocalRef-unbox? exp)))
(let ([entry (list-ref cenv (LocalRef-depth exp))]) (let ([entry (list-ref cenv (LocalRef-depth exp))])
entry)] entry)]
[(ToplevelRef? exp) #;[(ToplevelRef? exp)
(let: ([name : (U Symbol False GlobalBucket ModuleVariable) (let: ([name : (U Symbol False GlobalBucket ModuleVariable)
(list-ref (Prefix-names (ensure-prefix (list-ref cenv (ToplevelRef-depth exp)))) (list-ref (Prefix-names (ensure-prefix (list-ref cenv (ToplevelRef-depth exp))))
(ToplevelRef-pos exp))]) (ToplevelRef-pos exp))])
@ -1646,7 +1649,7 @@
[else [else
'?]))] '?]))]
[(Constant? exp) #;[(Constant? exp)
(make-Const (Constant-v exp))] (make-Const (Constant-v exp))]
[else [else
@ -1740,7 +1743,9 @@
(define (compile-let-rec exp cenv target linkage) (define (compile-let-rec exp cenv target linkage)
(let*: ([n : Natural (length (LetRec-procs exp))] (let*: ([n : Natural (length (LetRec-procs exp))]
[extended-cenv : CompileTimeEnvironment [extended-cenv : CompileTimeEnvironment
(append (map (lambda: ([p : Lam]) cenv
;; Temporarily removing the optimization
#;(append (map (lambda: ([p : Lam])
(extract-static-knowledge (extract-static-knowledge
p p
(append (build-list (length (LetRec-procs exp)) (append (build-list (length (LetRec-procs exp))