fixed bug with lexical scoping.
This commit is contained in:
parent
d54def0126
commit
d1af35f0f5
21
compile.rkt
21
compile.rkt
|
@ -120,7 +120,8 @@
|
|||
(: lexical-environment-pop-depth (CompileTimeEnvironment Linkage -> Natural))
|
||||
;; Computes how much of the environment we need to pop.
|
||||
(define (lexical-environment-pop-depth cenv linkage)
|
||||
(cond
|
||||
(length cenv)
|
||||
#;(cond
|
||||
[(empty? cenv)
|
||||
0]
|
||||
[else
|
||||
|
@ -128,14 +129,12 @@
|
|||
(cond
|
||||
[(Prefix? entry)
|
||||
(+ 1 (lexical-environment-pop-depth (rest cenv) linkage))]
|
||||
[(FunctionExtension? entry)
|
||||
(length (FunctionExtension-names entry))]
|
||||
[(LocalExtension? entry)
|
||||
(+ (length (LocalExtension-names entry))
|
||||
(lexical-environment-pop-depth (rest cenv) linkage))]
|
||||
[(TemporaryExtension? entry)
|
||||
(+ (TemporaryExtension-n entry)
|
||||
(lexical-environment-pop-depth (rest cenv) linkage))]))]))
|
||||
[(symbol? entry)
|
||||
(cond
|
||||
(+ 1 (lexical-environment-pop-depth (rest cenv) linkage)))]
|
||||
[(eq? entry #f)
|
||||
(+ 1 (lexical-environment-pop-depth (rest cenv) linkage))]))]))
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -274,9 +273,9 @@
|
|||
(define (compile-lambda-body exp cenv lexical-references proc-entry)
|
||||
(let*: ([formals : (Listof Symbol) (Lam-parameters exp)]
|
||||
[extended-cenv : CompileTimeEnvironment
|
||||
(extend-lexical-environment
|
||||
(extend-lexical-environment/names
|
||||
'()
|
||||
(make-FunctionExtension formals))]
|
||||
formals)]
|
||||
[extended-cenv : CompileTimeEnvironment
|
||||
(lexical-references->compile-time-environment
|
||||
lexical-references cenv extended-cenv)])
|
||||
|
|
|
@ -6,6 +6,7 @@
|
|||
"sets.rkt")
|
||||
(provide find-variable
|
||||
extend-lexical-environment
|
||||
extend-lexical-environment/names
|
||||
extend-lexical-environment/placeholders
|
||||
collect-lexical-references
|
||||
lexical-references->compile-time-environment)
|
||||
|
@ -35,25 +36,16 @@
|
|||
[else
|
||||
(loop (rest cenv) (add1 depth))])]
|
||||
|
||||
[(FunctionExtension? elt)
|
||||
(let: ([index : (U #f Natural) (list-index name (FunctionExtension-names elt))])
|
||||
(cond
|
||||
[(boolean? index)
|
||||
(loop (rest cenv) (+ depth (length (FunctionExtension-names elt))))]
|
||||
[else
|
||||
(make-LocalAddress (+ depth index))]))]
|
||||
[(symbol? elt)
|
||||
(cond
|
||||
[(eq? elt name)
|
||||
(make-LocalAddress depth)]
|
||||
[else
|
||||
(loop (rest cenv) (add1 depth))])]
|
||||
|
||||
[(LocalExtension? elt)
|
||||
(let: ([index : (U #f Natural) (list-index name (LocalExtension-names elt))])
|
||||
(cond
|
||||
[(boolean? index)
|
||||
(loop (rest cenv) (+ depth (length (LocalExtension-names elt))))]
|
||||
[else
|
||||
(make-LocalAddress (+ depth index))]))]
|
||||
[(eq? elt #f)
|
||||
(loop (rest cenv) (add1 depth))]))])))
|
||||
|
||||
[(TemporaryExtension? elt)
|
||||
(loop (rest cenv)
|
||||
(+ depth (TemporaryExtension-n elt)))]))])))
|
||||
|
||||
(: list-index (All (A) A (Listof A) -> (U #f Natural)))
|
||||
(define (list-index x l)
|
||||
|
@ -75,12 +67,18 @@
|
|||
(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
|
||||
(CompileTimeEnvironment Natural -> CompileTimeEnvironment))
|
||||
;; Add placeholders to the lexical environment (This represents what happens during procedure application.)
|
||||
(define (extend-lexical-environment/placeholders cenv n)
|
||||
(cons (make-TemporaryExtension n)
|
||||
cenv))
|
||||
(append (build-list n (lambda: ([i : Natural]) #f))
|
||||
cenv))
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -11,20 +11,22 @@
|
|||
(define-struct: Prefix ([names : (Listof Symbol)])
|
||||
#:transparent)
|
||||
|
||||
(define-struct: FunctionExtension ([names : (Listof Symbol)])
|
||||
#;(define-struct: FunctionExtension ([names : (Listof Symbol)])
|
||||
#:transparent)
|
||||
|
||||
(define-struct: LocalExtension ([names : (Listof Symbol)])
|
||||
#;(define-struct: LocalExtension ([names : (Listof Symbol)])
|
||||
#:transparent)
|
||||
|
||||
(define-struct: TemporaryExtension ([n : Natural])
|
||||
#;(define-struct: TemporaryExtension ([n : Natural])
|
||||
#:transparent)
|
||||
|
||||
|
||||
(define-type CompileTimeEnvironmentEntry (U Prefix ;; a prefix
|
||||
FunctionExtension
|
||||
LocalExtension
|
||||
TemporaryExtension))
|
||||
Symbol
|
||||
False
|
||||
#;FunctionExtension
|
||||
#;LocalExtension
|
||||
#;TemporaryExtension))
|
||||
|
||||
|
||||
;; A compile-time environment is a (listof (listof symbol)).
|
||||
|
|
|
@ -282,8 +282,8 @@
|
|||
(* x acc))
|
||||
1
|
||||
'(1 2 3 4 5 6 7 8 9 10)))
|
||||
(* 1 2 3 4 5 6 7 8 9 10)
|
||||
#:debug? #t)
|
||||
(* 1 2 3 4 5 6 7 8 9 10))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user