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

correcting bug with my implementation of lexical scope

Browse Source
This commit is contained in:
Danny Yoo 2011-03-14 18:06:14 -04:00
parent 5bddb64554
commit e5ca5364b6
9 changed files with 54 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
assemble.rkt
View File

@ -387,12 +387,14 @@ EOF
)]
[(ExtendEnvironment/Prefix!? op)
(let: ([names : (Listof Symbol) (ExtendEnvironment/Prefix!-names op)])
(let: ([names : (Listof (U Symbol False)) (ExtendEnvironment/Prefix!-names op)])
(format "MACHINE.env.push([~a]);"
(string-join (map (lambda: ([n : Symbol])
(format "MACHINE.params.currentNamespace[~s] || Primitives[~s]"
(symbol->string n)
(symbol->string n)))
(string-join (map (lambda: ([n : (U Symbol False)])
(if (symbol? n)
(format "MACHINE.params.currentNamespace[~s] || Primitives[~s]"
(symbol->string n)
(symbol->string n))
"false"))
names)
",")))]

9
compile.rkt
View File

@ -70,7 +70,7 @@
(: compile-top (Top CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-top top cenv target linkage)
(let*: ([cenv : CompileTimeEnvironment (extend-lexical-environment cenv (Top-prefix top))]
[names : (Listof Symbol) (Prefix-names (Top-prefix top))])
[names : (Listof (U Symbol False)) (Prefix-names (Top-prefix top))])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-PerformStatement (make-ExtendEnvironment/Prefix! names))))
@ -258,6 +258,7 @@
lexical-references)))))
(compile-lambda-body exp cenv
lexical-references
free-vars
proc-entry)
after-lambda)))
@ -268,11 +269,12 @@
(: compile-lambda-body (Lam CompileTimeEnvironment
(Listof EnvReference)
(Listof Symbol)
Linkage
->
InstructionSequence))
;; Compiles the body of the lambda in the appropriate environment.
(define (compile-lambda-body exp cenv lexical-references proc-entry)
(define (compile-lambda-body exp cenv lexical-references free-variables proc-entry)
(let*: ([formals : (Listof Symbol) (Lam-parameters exp)]
[extended-cenv : CompileTimeEnvironment
(extend-lexical-environment/names
@ -280,7 +282,8 @@
formals)]
[extended-cenv : CompileTimeEnvironment
(lexical-references->compile-time-environment
lexical-references cenv extended-cenv)])
lexical-references cenv extended-cenv
free-variables)])
(append-instruction-sequences
(make-instruction-sequence
`(,proc-entry

2
find-toplevel-variables.rkt
View File

@ -15,7 +15,7 @@
(cond
[(Top? exp)
(list-difference (loop (Top-code exp))
(Prefix-names (Top-prefix exp)))]
(filter symbol? (Prefix-names (Top-prefix exp))))]
[(Constant? exp)
empty]

2
il-structs.rkt
View File

@ -191,7 +191,7 @@
;; Extends the environment with a prefix that holds
;; lookups to the namespace.
(define-struct: ExtendEnvironment/Prefix! ([names : (Listof Symbol)])
(define-struct: ExtendEnvironment/Prefix! ([names : (Listof (U Symbol False))])
#:transparent)
;; Adjusts the environment by pushing the values in the

32
lexical-env.rkt
View File

@ -10,14 +10,15 @@
extend-lexical-environment/boxed-names
extend-lexical-environment/placeholders
collect-lexical-references
lexical-references->compile-time-environment)
lexical-references->compile-time-environment
place-prefix-mask)
;; find-variable: symbol compile-time-environment -> lexical-address
;; Find where the variable should be located.
(: find-variable (Symbol CompileTimeEnvironment -> LexicalAddress))
(define (find-variable name cenv)
(: find-pos (Symbol (Listof Symbol) -> Natural))
(: find-pos (Symbol (Listof (U Symbol False)) -> Natural))
(define (find-pos sym los)
(cond
[(eq? sym (car los))
@ -125,9 +126,10 @@
(: lexical-references->compile-time-environment ((Listof EnvReference) CompileTimeEnvironment CompileTimeEnvironment
(Listof Symbol)
-> CompileTimeEnvironment))
;; Creates a lexical environment containing the closure's bindings.
(define (lexical-references->compile-time-environment refs cenv new-cenv)
(define (lexical-references->compile-time-environment refs cenv new-cenv symbols-to-keep)
(let: loop : CompileTimeEnvironment ([refs : (Listof EnvReference) (reverse refs)]
[new-cenv : CompileTimeEnvironment new-cenv])
(cond
@ -142,5 +144,27 @@
new-cenv))]
[(EnvWholePrefixReference? a-ref)
(loop (rest refs)
(cons (list-ref cenv (EnvWholePrefixReference-depth a-ref))
(cons (place-prefix-mask
(ensure-Prefix (list-ref cenv (EnvWholePrefixReference-depth a-ref)))
symbols-to-keep)
new-cenv))]))])))
(: ensure-Prefix (Any -> Prefix))
(define (ensure-Prefix x)
(if (Prefix? x)
x
(error 'ensure-Prefix "~s" x)))
(: place-prefix-mask (Prefix (Listof Symbol) -> Prefix))
;; Masks elements of the prefix off.
(define (place-prefix-mask a-prefix symbols-to-keep)
(make-Prefix
(map (lambda: ([n : (U Symbol False)])
(cond [(symbol? n)
(if (member n symbols-to-keep)
n
#f)]
[else n]))
(Prefix-names a-prefix))))

5
lexical-structs.rkt
View File

@ -7,8 +7,9 @@
;; Lexical environments
;; A toplevel prefix contains a list of toplevel variables.
(define-struct: Prefix ([names : (Listof Symbol)])
;; A toplevel prefix contains a list of toplevel variables. Some of the
;; names may be masked out by #f.
(define-struct: Prefix ([names : (Listof (U Symbol False))])
#:transparent)

5
simulator.rkt
View File

@ -197,7 +197,10 @@
[(ExtendEnvironment/Prefix!? op)
(env-push! m
(make-toplevel (map lookup-primitive
(make-toplevel (map (lambda: ([id/false : (U Symbol False)])
(if (symbol? id/false)
(lookup-primitive id/false)
#f))
(ExtendEnvironment/Prefix!-names op))))]
[(InstallClosureValues!? op)

5
test-all.rkt
View File

@ -4,5 +4,6 @@
"test-simulator.rkt"
"test-compiler.rkt"
"test-assemble.rkt"
#;"test-browser-evaluate.rkt"
#;"test-package.rkt")
"test-browser-evaluate.rkt"
"test-package.rkt"
#;"test-conform.rkt")

2
test-browser-evaluate.rkt
View File

@ -144,5 +144,5 @@
(test (read (open-input-file "tests/conform/program0.sch"))
#;(test (read (open-input-file "tests/conform/program0.sch"))
(port->string (open-input-file "tests/conform/expected0.txt")))