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)))
;; Finally, do a tail call into f.
(compile-procedure-call '()
(compile-general-procedure-call '()
'(?)
1
'val

44
compile.rkt
View File

@ -6,7 +6,7 @@
racket/list)
(provide (rename-out [-compile compile])
compile-procedure-call
compile-general-procedure-call
append-instruction-sequences
adjust-target-depth)
@ -285,24 +285,38 @@
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f)))
proc-code
(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
[(and (LocalRef? operator) (not (LocalRef-unbox? operator)))
(printf "I statically know the operator is: ~s\n"
(list-ref extended-cenv (LocalRef-depth operator)))
(let: ([static-knowledge : CompileTimeEnvironmentEntry (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
(length (App-operands exp))
n
target
linkage)]
linkage)]))]
[else
(compile-procedure-call cenv
extended-cenv
(length (App-operands exp))
target linkage)])))))
(default)]))
(: juggle-operands ((Listof InstructionSequence) -> InstructionSequence))
;; 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
->
InstructionSequence))
@ -340,7 +354,7 @@
;; n is the number of arguments passed 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.
(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)]
[compiled-branch (make-label 'compiledBranch)]
[after-call (make-label 'afterCall)])