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

lambda looks like it's generating appropriate il. Working on application now.

Browse Source
This commit is contained in:
Danny Yoo 2011-03-01 15:45:03 -05:00
parent 049eee32c4
commit bbde3cdeaa
4 changed files with 79 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
compile.rkt
View File

@ -94,7 +94,6 @@
`(,(make-AssignPrimOpStatement target
'lexical-address-lookup
(list (make-Const (LocalAddress-depth lexical-pos))
(make-Const (LocalAddress-pos lexical-pos))
(make-Reg 'env))))))]
[(PrefixAddress? lexical-pos)
(end-with-linkage linkage
@ -190,12 +189,6 @@
`(,(make-AssignPrimOpStatement target
'make-compiled-procedure
(list* (make-Label proc-entry)
;; TODO: rather than capture the whole
;; environment, we need to instead
;; capture the free variables.
;; But that requires that we box
;; up all set!-ed variables, in order
;; to preserve semantics of set!
(make-Reg 'env)
lexical-references)))))
(compile-lambda-body exp cenv
@ -214,20 +207,23 @@
Linkage
->
InstructionSequence))
;; Compiles the body of the lambda.
;; Compiles the body of the lambda in the appropriate environment.
(define (compile-lambda-body exp cenv lexical-references proc-entry)
(let*: ([formals : (Listof Symbol) (Lam-parameters exp)]
[extended-cenv : CompileTimeEnvironment (extend-lexical-environment cenv formals)]
[extended-cenv : CompileTimeEnvironment extended-cenv])
(append-instruction-sequences
(make-instruction-sequence
`(,proc-entry
;; FIXME: not right: we need to install the closure values here,
;; instead of replacing the environment altogether.
,(make-AssignPrimOpStatement 'env
'compiled-procedure-env
(list (make-Reg 'proc)))))
(compile (Lam-body exp) extended-cenv 'val 'return))))
(let*: ([formals : (Listof Symbol) (Lam-parameters exp)]
[extended-cenv : CompileTimeEnvironment
(extend-lexical-environment '() formals)]
[extended-cenv : CompileTimeEnvironment
(begin
(lexical-references->compile-time-environment lexical-references cenv extended-cenv))])
(append-instruction-sequences
(make-instruction-sequence
`(,proc-entry
;; FIXME: not right: we need to install the closure values here,
;; instead of replacing the environment altogether.
,(make-AssignPrimOpStatement 'env
'compiled-procedure-env
(list (make-Reg 'proc)))))
(compile (Lam-body exp) extended-cenv 'val 'return))))

50
il-structs.rkt
View File

@ -5,14 +5,41 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Registers of the machine:
(define-type StackRegisterSymbol (U 'control 'env))
(define-type RegisterSymbol (U StackRegisterSymbol 'val 'proc))
(define-type AtomicRegisterSymbol (U 'val 'proc))
(define-type RegisterSymbol (U StackRegisterSymbol AtomicRegisterSymbol))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; An operation can refer to the following:
(define-type OpArg (U Const ;; an constant
Label ;; an label
Reg ;; an register
EnvLexicalReference
EnvWholePrefixReference))
(define-struct: Label ([name : Symbol])
#:transparent)
(define-struct: Reg ([name : RegisterSymbol])
#:transparent)
(define-struct: Const ([const : Any])
#:transparent)
(define-struct: EnvLexicalReference ([depth : Natural])
#:transparent)
(define-struct: EnvWholePrefixReference ([depth : Natural])
#:transparent)
;; instruction sequences
(define-type UnlabeledStatement (U
AssignImmediateStatement
@ -38,25 +65,6 @@
#:transparent)
(define-struct: Label ([name : Symbol])
#:transparent)
(define-struct: Reg ([name : RegisterSymbol])
#:transparent)
(define-struct: Const ([const : Any])
#:transparent)
(define-struct: EnvLexicalReference ([depth : Natural]
[pos : Natural])
#:transparent)
(define-struct: EnvWholePrefixReference ([depth : Natural])
#:transparent)
;; An operation can refer to a Const, a Register, the top of the Control stack,
;; or a reference within the lexical environment.
(define-type OpArg (U Const Label Reg EnvLexicalReference EnvWholePrefixReference))
(define-struct: PopEnv ([n : Natural]) #:transparent)
(define-struct: PopControl () #:transparent)

58
lexical-env.rkt
View File

@ -31,10 +31,12 @@
(make-PrefixAddress depth (find-pos name (Prefix-names (first cenv))) name)]
[else
(loop (rest cenv) (add1 depth))])]
[(member name (first cenv))
(make-LocalAddress depth (find-pos name (first cenv)))]
[else
(loop (rest cenv) (add1 depth))])))
[(symbol? (first cenv))
(cond
[(eq? name (first cenv))
(make-LocalAddress depth)]
[else
(loop (rest cenv) (add1 depth))])])))
@ -44,21 +46,14 @@
(cond [(Prefix? names)
(cons names cenv)]
[(list? names)
(cons names cenv)]))
(append names cenv)]))
(: lexical-environment-pop-depth (CompileTimeEnvironment -> Natural))
;; Computes how many environments we need to pop till we clear the procedure arguments.
(define (lexical-environment-pop-depth cenv)
(cond [(empty? cenv)
(error 'lexical-environment-pop-depth "Empty environment")]
[(Prefix? (first cenv))
1]
[(list? (first cenv))
1]))
(length cenv))
@ -80,8 +75,7 @@
(cond
[(LocalAddress? addr)
(set-insert! lexical-references
(make-EnvLexicalReference (LocalAddress-depth addr)
(LocalAddress-pos addr)))
(make-EnvLexicalReference (LocalAddress-depth addr)))
(loop (rest addresses))]
[(PrefixAddress? addr)
(set-insert! prefix-references
@ -89,17 +83,25 @@
(loop (rest addresses))]))]))))
(: lexical-references->compile-time-environment ((Listof (U EnvLexicalReference EnvWholePrefixReference))
CompileTimeEnvironment
-> CompileTimeEnvironment))
(define (lexical-references->compile-time-environment refs cenv)
cenv
#;(cond
[(empty? refs)
cenv]
[else
(let ([a-ref (first refs)])
(cond
[(EnvLexicalReference? a-ref)
...]))]))
(define-type EnvReference (U EnvLexicalReference EnvWholePrefixReference))
(: lexical-references->compile-time-environment ((Listof EnvReference) CompileTimeEnvironment CompileTimeEnvironment
-> CompileTimeEnvironment))
;; Creates a lexical environment containing the closure's bindings.
(define (lexical-references->compile-time-environment refs cenv new-cenv)
(let: loop : CompileTimeEnvironment ([refs : (Listof EnvReference) (reverse refs)]
[new-cenv : CompileTimeEnvironment new-cenv])
(cond
[(empty? refs)
new-cenv]
[else
(let: ([a-ref : EnvReference (first refs)])
(cond
[(EnvLexicalReference? a-ref)
(loop (rest refs)
(cons (list-ref cenv (EnvLexicalReference-depth a-ref))
new-cenv))]
[(EnvWholePrefixReference? a-ref)
(loop (rest refs)
(cons (list-ref cenv (EnvWholePrefixReference-depth a-ref))
new-cenv))]))])))

10
lexical-structs.rkt
View File

@ -12,16 +12,14 @@
;; A compile-time environment is a (listof (listof symbol)).
;; A lexical address is either a 2-tuple (depth pos), or 'not-found.
(define-type CompileTimeEnvironment (Listof (U (Listof Symbol)
(define-type CompileTimeEnvironment (Listof (U Symbol
Prefix)))
(define-type LexicalAddress (U LocalAddress PrefixAddress))
(define-struct: LocalAddress ([depth : Natural]
[pos : Natural])
;; These need to be treated transparently for equality checking.
;; A lexical address is a reference to an value in the environment stack.
(define-type LexicalAddress (U LocalAddress PrefixAddress))
(define-struct: LocalAddress ([depth : Natural])
#:transparent)
(define-struct: PrefixAddress ([depth : Natural]
[pos : Natural]
[name : Symbol])
;; These need to be treated transparently for equality checking.
#:transparent)