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

need to do a little more work.

Browse Source
This commit is contained in:
Danny Yoo 2011-03-23 21:57:07 -04:00
parent 15a03bba7c
commit f6aceb9d52
2 changed files with 64 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bootstrapped-primitives.rkt
View File

@ -46,7 +46,7 @@
,(make-PopEnvironment 2 0))) ,(make-PopEnvironment 2 0)))
;; Finally, do a tail call into f. ;; Finally, do a tail call into f.
(compile-procedure-call '() (compile-general-procedure-call '()
'(?) '(?)
1 1
'val 'val

44
compile.rkt
View File

@ -6,7 +6,7 @@
racket/list) racket/list)
(provide (rename-out [-compile compile]) (provide (rename-out [-compile compile])
compile-procedure-call compile-general-procedure-call
append-instruction-sequences append-instruction-sequences
adjust-target-depth) adjust-target-depth)
@ -285,24 +285,38 @@
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f))) (make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f)))
proc-code proc-code
(juggle-operands operand-codes) (juggle-operands operand-codes)
(compile-procedure-call (App-operator exp) cenv extended-cenv (length (App-operands exp))
target linkage))))
(let: ([operator : ExpressionCore (App-operator exp)])
(: compile-procedure-call
(ExpressionCore CompileTimeEnvironment CompileTimeEnvironment Natural Target Linkage -> InstructionSequence))
(define (compile-procedure-call operator cenv-before-args extended-cenv n target linkage)
(define (default)
(compile-general-procedure-call cenv-before-args
extended-cenv
n
target linkage))
(cond (cond
[(and (LocalRef? operator) (not (LocalRef-unbox? operator))) [(and (LocalRef? operator) (not (LocalRef-unbox? operator)))
(printf "I statically know the operator is: ~s\n" (let: ([static-knowledge : CompileTimeEnvironmentEntry (list-ref extended-cenv (LocalRef-depth operator))])
(list-ref extended-cenv (LocalRef-depth operator))) (cond
[(eq? static-knowledge 'prefix)
(default)]
[(eq? static-knowledge '?)
(default)]
[(StaticallyKnownLam? static-knowledge)
(unless (= n (StaticallyKnownLam-arity static-knowledge))
(error 'arity-mismatch "Expected ~s, received ~s" (StaticallyKnownLam-arity static-knowledge)
n))
;; FIXME: do the arity check here...
#;(printf "I'm here!\n")
(compile-procedure-call/statically-known-lam extended-cenv (compile-procedure-call/statically-known-lam extended-cenv
(length (App-operands exp)) n
target target
linkage)] linkage)]))]
[else [else
(compile-procedure-call cenv (default)]))
extended-cenv
(length (App-operands exp))
target linkage)])))))
(: juggle-operands ((Listof InstructionSequence) -> InstructionSequence)) (: juggle-operands ((Listof InstructionSequence) -> InstructionSequence))
;; Installs the operators. At the end of this, ;; Installs the operators. At the end of this,
@ -332,7 +346,7 @@
(: compile-procedure-call (CompileTimeEnvironment CompileTimeEnvironment (: compile-general-procedure-call (CompileTimeEnvironment CompileTimeEnvironment
Natural Target Linkage Natural Target Linkage
-> ->
InstructionSequence)) InstructionSequence))
@ -340,7 +354,7 @@
;; n is the number of arguments passed in. ;; n is the number of arguments passed in.
;; cenv is the compile-time enviroment before arguments have been shifted in. ;; cenv is the compile-time enviroment before arguments have been shifted in.
;; extended-cenv is the compile-time environment after arguments have been shifted in. ;; extended-cenv is the compile-time environment after arguments have been shifted in.
(define (compile-procedure-call cenv extended-cenv n target linkage) (define (compile-general-procedure-call cenv extended-cenv n target linkage)
(let ([primitive-branch (make-label 'primitiveBranch)] (let ([primitive-branch (make-label 'primitiveBranch)]
[compiled-branch (make-label 'compiledBranch)] [compiled-branch (make-label 'compiledBranch)]
[after-call (make-label 'afterCall)]) [after-call (make-label 'afterCall)])