generalizing the optimization

This commit is contained in:
dyoo 2011-03-31 15:24:06 -04:00
parent 074be88089
commit ad71a72121

View File

@ -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)))])))