generalizing the optimization
This commit is contained in:
parent
074be88089
commit
ad71a72121
80
compile.rkt
80
compile.rkt
|
@ -446,7 +446,58 @@
|
|||
(KernelPrimitiveName App CompileTimeEnvironment Target Linkage -> InstructionSequence))
|
||||
;; This is a special case of application, where the operator is statically
|
||||
;; known to be in the set of hardcoded primitives.
|
||||
;;
|
||||
;; There's a special case optimization we can perform: we can avoid touching
|
||||
;; the stack for constant arguments; rather than allocate (length (App-operands exp))
|
||||
;; stack slots, we can do less than that.
|
||||
;;
|
||||
;; We have to be sensitive to mutation.
|
||||
(define (compile-kernel-primitive-application kernel-op exp cenv target linkage)
|
||||
(cond
|
||||
;; If all the arguments are primitive enough (all constants, localrefs, or toplevelrefs),
|
||||
;; then application requires no stack space at all, and application is especially simple.
|
||||
[(andmap (lambda (op)
|
||||
;; TODO: as long as the operand contains no applications?
|
||||
(or (Constant? op)
|
||||
(ToplevelRef? op)
|
||||
(LocalRef? op)))
|
||||
(App-operands exp))
|
||||
(let* ([n (length (App-operands exp))]
|
||||
|
||||
[operand-knowledge
|
||||
(map (lambda: ([arg : Expression])
|
||||
(extract-static-knowledge
|
||||
arg
|
||||
(extend-compile-time-environment/scratch-space
|
||||
cenv n)))
|
||||
(App-operands exp))]
|
||||
|
||||
[typechecks?
|
||||
(map (lambda: ([dom : OperandDomain]
|
||||
[known : CompileTimeEnvironmentEntry])
|
||||
(not (redundant-check? dom known)))
|
||||
(kernel-primitive-expected-operand-types kernel-op n)
|
||||
operand-knowledge)]
|
||||
|
||||
[expected-operand-types
|
||||
(kernel-primitive-expected-operand-types kernel-op n)]
|
||||
[operand-poss
|
||||
(simple-operands->opargs (map (lambda: ([op : Expression])
|
||||
(adjust-expression-depth op n n))
|
||||
(App-operands exp)))])
|
||||
(end-with-linkage
|
||||
linkage cenv
|
||||
(make-instruction-sequence
|
||||
`(,(make-AssignPrimOpStatement
|
||||
target
|
||||
(make-CallKernelPrimitiveProcedure
|
||||
kernel-op
|
||||
operand-poss
|
||||
expected-operand-types
|
||||
typechecks?))))))]
|
||||
|
||||
[else
|
||||
;; Otherwise, we can split the operands into two categories: constants, and the rest.
|
||||
(let*-values ([(n)
|
||||
(length (App-operands exp))]
|
||||
|
||||
|
@ -454,7 +505,8 @@
|
|||
(kernel-primitive-expected-operand-types kernel-op n)]
|
||||
|
||||
[(constant-operands rest-operands)
|
||||
(split-operands-by-constant-or-stack-references (App-operands exp))]
|
||||
(split-operands-by-constant-or-stack-references
|
||||
(App-operands exp))]
|
||||
|
||||
;; here, we rewrite the stack references so they assume no scratch space
|
||||
;; used by the constant operands.
|
||||
|
@ -505,7 +557,7 @@
|
|||
0))))]
|
||||
|
||||
[(constant-operand-poss)
|
||||
(constant-operands->opargs constant-operands)]
|
||||
(simple-operands->opargs constant-operands)]
|
||||
|
||||
[(rest-operand-poss)
|
||||
(build-list (length rest-operands)
|
||||
|
@ -518,9 +570,6 @@
|
|||
(compile operand extended-cenv target next-linkage))
|
||||
rest-operands
|
||||
rest-operand-poss))])
|
||||
;; There's a special case optimization we can perform: we can avoid touching
|
||||
;; the stack for constant arguments; rather than allocate (length (App-operands exp))
|
||||
;; stack slots, we can do less than that.
|
||||
|
||||
(end-with-linkage
|
||||
linkage cenv
|
||||
|
@ -529,13 +578,13 @@
|
|||
rest-operand-code
|
||||
(make-instruction-sequence
|
||||
`(,(make-AssignPrimOpStatement
|
||||
target
|
||||
(adjust-target-depth target (length rest-operands))
|
||||
(make-CallKernelPrimitiveProcedure
|
||||
kernel-op
|
||||
(append constant-operand-poss rest-operand-poss)
|
||||
expected-operand-types
|
||||
typechecks?))))
|
||||
stack-popping-code))))
|
||||
stack-popping-code)))]))
|
||||
|
||||
|
||||
|
||||
|
@ -549,11 +598,9 @@
|
|||
(error 'ensure-simple-expression)))
|
||||
|
||||
|
||||
(: constant-operands->opargs ((Listof (U Constant LocalRef ToplevelRef))
|
||||
->
|
||||
(Listof OpArg)))
|
||||
(: simple-operands->opargs ((Listof Expression) -> (Listof OpArg)))
|
||||
;; Produces a list of OpArgs if all the operands are particularly simple, and false therwise.
|
||||
(define (constant-operands->opargs rands)
|
||||
(define (simple-operands->opargs rands)
|
||||
(map (lambda: ([e : Expression])
|
||||
(cond
|
||||
[(Constant? e)
|
||||
|
@ -594,7 +641,8 @@
|
|||
|
||||
|
||||
(: split-operands-by-constant-or-stack-references
|
||||
((Listof Expression) -> (values (Listof (U Constant LocalRef ToplevelRef))
|
||||
((Listof Expression) ->
|
||||
(values (Listof (U Constant LocalRef ToplevelRef))
|
||||
(Listof Expression))))
|
||||
;; Splits off the list of operations into two: a prefix of constant
|
||||
;; or simple expressions, and the remainder.
|
||||
|
@ -607,8 +655,12 @@
|
|||
(values (reverse constants) empty)]
|
||||
[else (let ([e (first rands)])
|
||||
(if (or (Constant? e)
|
||||
(LocalRef? e)
|
||||
(ToplevelRef? e))
|
||||
(and (LocalRef? e) (not (LocalRef-unbox? e)))
|
||||
#;(and (ToplevelRef? e)
|
||||
(let ([prefix (ensure-prefix
|
||||
(list-ref cenv (ToplevelRef-depth e)))])
|
||||
(ModuleVariable?
|
||||
(list-ref prefix (ToplevelRef-pos e))))))
|
||||
(loop (rest rands) (cons e constants))
|
||||
(values (reverse constants) rands)))])))
|
||||
|
||||
|
|
Loading…
Reference in New Issue
Block a user