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

fixed bug with lexical scoping.

Browse Source
This commit is contained in:
Danny Yoo 2011-03-08 17:27:43 -05:00
parent d54def0126
commit d1af35f0f5
4 changed files with 37 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
compile.rkt
View File

@ -120,7 +120,8 @@
(: lexical-environment-pop-depth (CompileTimeEnvironment Linkage -> Natural)) (: lexical-environment-pop-depth (CompileTimeEnvironment Linkage -> Natural))
;; Computes how much of the environment we need to pop. ;; Computes how much of the environment we need to pop.
(define (lexical-environment-pop-depth cenv linkage) (define (lexical-environment-pop-depth cenv linkage)
(cond (length cenv)
#;(cond
[(empty? cenv) [(empty? cenv)
0] 0]
[else [else
@ -128,14 +129,12 @@
(cond (cond
[(Prefix? entry) [(Prefix? entry)
(+ 1 (lexical-environment-pop-depth (rest cenv) linkage))] (+ 1 (lexical-environment-pop-depth (rest cenv) linkage))]
[(FunctionExtension? entry) [(symbol? entry)
(length (FunctionExtension-names entry))] (cond
[(LocalExtension? entry) (+ 1 (lexical-environment-pop-depth (rest cenv) linkage)))]
(+ (length (LocalExtension-names entry)) [(eq? entry #f)
(lexical-environment-pop-depth (rest cenv) linkage))] (+ 1 (lexical-environment-pop-depth (rest cenv) linkage))]))]))
[(TemporaryExtension? entry)
(+ (TemporaryExtension-n entry)
(lexical-environment-pop-depth (rest cenv) linkage))]))]))
@ -274,9 +273,9 @@
(define (compile-lambda-body exp cenv lexical-references proc-entry) (define (compile-lambda-body exp cenv lexical-references proc-entry)
(let*: ([formals : (Listof Symbol) (Lam-parameters exp)] (let*: ([formals : (Listof Symbol) (Lam-parameters exp)]
[extended-cenv : CompileTimeEnvironment [extended-cenv : CompileTimeEnvironment
(extend-lexical-environment (extend-lexical-environment/names
'() '()
(make-FunctionExtension formals))] formals)]
[extended-cenv : CompileTimeEnvironment [extended-cenv : CompileTimeEnvironment
(lexical-references->compile-time-environment (lexical-references->compile-time-environment
lexical-references cenv extended-cenv)]) lexical-references cenv extended-cenv)])

36
lexical-env.rkt
View File

@ -6,6 +6,7 @@
"sets.rkt") "sets.rkt")
(provide find-variable (provide find-variable
extend-lexical-environment extend-lexical-environment
extend-lexical-environment/names
extend-lexical-environment/placeholders extend-lexical-environment/placeholders
collect-lexical-references collect-lexical-references
lexical-references->compile-time-environment) lexical-references->compile-time-environment)
@ -35,25 +36,16 @@
[else [else
(loop (rest cenv) (add1 depth))])] (loop (rest cenv) (add1 depth))])]
[(FunctionExtension? elt) [(symbol? elt)
(let: ([index : (U #f Natural) (list-index name (FunctionExtension-names elt))]) (cond
(cond [(eq? elt name)
[(boolean? index) (make-LocalAddress depth)]
(loop (rest cenv) (+ depth (length (FunctionExtension-names elt))))] [else
[else (loop (rest cenv) (add1 depth))])]
(make-LocalAddress (+ depth index))]))]
[(LocalExtension? elt) [(eq? elt #f)
(let: ([index : (U #f Natural) (list-index name (LocalExtension-names elt))]) (loop (rest cenv) (add1 depth))]))])))
(cond
[(boolean? index)
(loop (rest cenv) (+ depth (length (LocalExtension-names elt))))]
[else
(make-LocalAddress (+ depth index))]))]
[(TemporaryExtension? elt)
(loop (rest cenv)
(+ depth (TemporaryExtension-n elt)))]))])))
(: list-index (All (A) A (Listof A) -> (U #f Natural))) (: list-index (All (A) A (Listof A) -> (U #f Natural)))
(define (list-index x l) (define (list-index x l)
@ -75,12 +67,18 @@
(cons extension cenv)) (cons extension cenv))
(: extend-lexical-environment/names (CompileTimeEnvironment (Listof Symbol) -> CompileTimeEnvironment))
(define (extend-lexical-environment/names cenv names)
(append names cenv))
(: extend-lexical-environment/placeholders (: extend-lexical-environment/placeholders
(CompileTimeEnvironment Natural -> CompileTimeEnvironment)) (CompileTimeEnvironment Natural -> CompileTimeEnvironment))
;; Add placeholders to the lexical environment (This represents what happens during procedure application.) ;; Add placeholders to the lexical environment (This represents what happens during procedure application.)
(define (extend-lexical-environment/placeholders cenv n) (define (extend-lexical-environment/placeholders cenv n)
(cons (make-TemporaryExtension n) (append (build-list n (lambda: ([i : Natural]) #f))
cenv)) cenv))

14
lexical-structs.rkt
View File

@ -11,20 +11,22 @@
(define-struct: Prefix ([names : (Listof Symbol)]) (define-struct: Prefix ([names : (Listof Symbol)])
#:transparent) #:transparent)
(define-struct: FunctionExtension ([names : (Listof Symbol)]) #;(define-struct: FunctionExtension ([names : (Listof Symbol)])
#:transparent) #:transparent)
(define-struct: LocalExtension ([names : (Listof Symbol)]) #;(define-struct: LocalExtension ([names : (Listof Symbol)])
#:transparent) #:transparent)
(define-struct: TemporaryExtension ([n : Natural]) #;(define-struct: TemporaryExtension ([n : Natural])
#:transparent) #:transparent)
(define-type CompileTimeEnvironmentEntry (U Prefix ;; a prefix (define-type CompileTimeEnvironmentEntry (U Prefix ;; a prefix
FunctionExtension Symbol
LocalExtension False
TemporaryExtension)) #;FunctionExtension
#;LocalExtension
#;TemporaryExtension))
;; A compile-time environment is a (listof (listof symbol)). ;; A compile-time environment is a (listof (listof symbol)).

4
test-compiler.rkt
View File

@ -282,8 +282,8 @@
(* x acc)) (* x acc))
1 1
'(1 2 3 4 5 6 7 8 9 10))) '(1 2 3 4 5 6 7 8 9 10)))
(* 1 2 3 4 5 6 7 8 9 10) (* 1 2 3 4 5 6 7 8 9 10))
#:debug? #t)