rearranging
This commit is contained in:
parent
edc6707fc1
commit
ed7794f14a
18
compile.rkt
18
compile.rkt
|
@ -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
|
||||||
|
|
|
@ -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)])
|
||||||
|
|
Loading…
Reference in New Issue
Block a user