rearranging

This commit is contained in:
Danny Yoo 2011-03-26 19:00:38 -04:00
parent edc6707fc1
commit ed7794f14a
2 changed files with 14 additions and 6 deletions

View File

@ -18,7 +18,8 @@
[entry-point : Symbol] [entry-point : Symbol]
[arity : Natural]) #:transparent) [arity : Natural]) #:transparent)
(define-type CompileTimeEnvironmentEntry (U '? Prefix StaticallyKnownLam)) (define-type CompileTimeEnvironmentEntry
(U '? Prefix StaticallyKnownLam ModuleVariable))
(define-type CompileTimeEnvironment (Listof CompileTimeEnvironmentEntry)) (define-type CompileTimeEnvironment (Listof CompileTimeEnvironmentEntry))
@ -361,14 +362,18 @@
'?) '?)
(App-operands exp)) (App-operands exp))
cenv)]) cenv)])
(let: ([op-knowledge : (U '? StaticallyKnownLam) (let: ([op-knowledge : CompileTimeEnvironmentEntry
(extract-static-knowledge (App-operator exp) (extract-static-knowledge (App-operator exp)
extended-cenv)]) extended-cenv)])
(cond (cond
[(eq? op-knowledge '?) [(eq? op-knowledge '?)
(compile-general-application exp cenv extended-cenv target linkage)] (compile-general-application exp cenv extended-cenv target linkage)]
[(ModuleVariable? op-knowledge)
(compile-general-application exp cenv extended-cenv target linkage)]
[(StaticallyKnownLam? op-knowledge) [(StaticallyKnownLam? op-knowledge)
(compile-statically-known-lam-application op-knowledge exp cenv extended-cenv target linkage)])))) (compile-statically-known-lam-application op-knowledge exp cenv extended-cenv target linkage)]
[(Prefix? op-knowledge)
(error 'impossible)]))))
(: compile-general-application (App CompileTimeEnvironment CompileTimeEnvironment Target Linkage -> InstructionSequence)) (: compile-general-application (App CompileTimeEnvironment CompileTimeEnvironment Target Linkage -> InstructionSequence))
@ -577,8 +582,10 @@
(error 'compile "return linkage, target not val: ~s" target)])) (error 'compile "return linkage, target not val: ~s" target)]))
(: extract-static-knowledge (ExpressionCore CompileTimeEnvironment -> (: extract-static-knowledge (ExpressionCore CompileTimeEnvironment ->
(U StaticallyKnownLam '?))) CompileTimeEnvironmentEntry))
;; Statically determines what we know about exp, given the compile time environment.
(define (extract-static-knowledge exp cenv) (define (extract-static-knowledge exp cenv)
(cond (cond
[(Lam? exp) [(Lam? exp)
@ -599,8 +606,7 @@
(ToplevelRef-pos exp))]) (ToplevelRef-pos exp))])
(cond (cond
[(ModuleVariable? name) [(ModuleVariable? name)
;; fixme name]
'?]
[else [else
'?]))] '?]))]
[else [else

View File

@ -148,6 +148,8 @@
(define-type KernelPrimitiveName (U '+)) (define-type KernelPrimitiveName (U '+))
(define-predicate KernelPrimitiveName? KernelPrimitiveName)
(define-struct: CallKernelPrimitiveProcedure ([operator : KernelPrimitiveName] (define-struct: CallKernelPrimitiveProcedure ([operator : KernelPrimitiveName]
[operands : (Listof OpArg)]) [operands : (Listof OpArg)])