Date: Sun, 20 Sep 2009 12:57:43 -0700
From: Chris Hanson <c...@chris-hanson.org>
I think it would be useful to amend the comments in the patch to show
the additional arguments. Without those arguments, there's no
justification for the conservative treatment.
What are the additional arguments here? I've attached an amended
patch with more comments; does this explain it better?
Alternatively, you could restrict the optimization to one without
addtional arguments, and be less conservative.
I think there are few programs that more aggressive transformations
would improve beyond what the conservative transformation improves,
and exceedingly few that any middle ground between the two
transformations I implemented would improve beyond the the
conservative transformation.
By the way, I don't know anything about how LIAR exploits programs'
ambivalence about order of evaluation. Maybe the more aggressive
transformation improves the code better than LIAR would anyway, in
which case I'd be happy to commit that instead.
diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index a2dc122..33deff8 100644
--- a/src/sf/subst.scm
+++ b/src/sf/subst.scm
@@ -453,15 +453,23 @@ you ask for.
(combination/optimizing-make
expression
block
- (if (procedure? operator)
- (integrate/procedure-operator operations environment
- block operator operands)
- (let ((operator
- (integrate/expression operations environment operator)))
- (if (procedure? operator)
+ (let* ((integrate-procedure
+ (lambda (operator)
(integrate/procedure-operator operations environment
- block operator operands)
- operator)))
+ block operator operands)))
+ (operator
+ (if (procedure? operator)
+ (integrate-procedure operator)
+ (let ((operator
+ (integrate/expression operations
+ environment
+ operator)))
+ (if (procedure? operator)
+ (integrate-procedure operator)
+ operator)))))
+ (cond ((integrate/combination-operator operator operands)
+ => integrate-procedure)
+ (else operator)))
operands))))
(define (integrate/procedure-operator operations environment
@@ -490,6 +498,112 @@ you ask for.
(else (error "Unknown operation" operation))))
integration-failure)))
+;;; Transform
+;;;
+;;; ((let ((a (foo)) (b (bar)))
+;;; (lambda (receiver)
+;;; ...body...))
+;;; (lambda (x y z)
+;;; ...))
+;;;
+;;; =>
+;;;
+;;; (let ((receiver (lambda (x y z) ...)))
+;;; (let ((a (foo)) (b (bar)))
+;;; ...))
+;;;
+;;; We do this transformation conservatively, only if the operands of
+;;; the original combination have no side effects, so that this
+;;; transformation does not have the consequence of committing to a
+;;; particular order of evaluation when the original program didn't
+;;; request one. (LIAR may exploit a program's ambivalence about order
+;;; of evaluation to generate better code.) For instance, a more
+;;; aggresive approach might transform
+;;;
+;;; ((let ((a (foo)) (b (bar)))
+;;; (lambda (x y)
+;;; ...body...))
+;;; (mumble)
+;;; (frotz))
+;;;
+;;; =>
+;;;
+;;; (let ((x (mumble)) (y (frotz)))
+;;; (let ((a (foo)) (b (bar)))
+;;; ...body...))
+;;;
+;;; The input program required that (foo) and (bar) be evaluated in
+;;; some sequence without (mumble) or (frotz) intervening, and
+;;; otherwise requested no particular order of evaluation. The output
+;;; of the more aggressive transformation evaluates both (mumble) and
+;;; (frotz) in some sequence before evaluating (foo) and (bar) in some
+;;; sequence.
+;;;
+;;; The more aggressive transformation could also be extended to handle
+;;; sequences in operator positions. However, this transformation
+;;; exists mainly for VALUES and CALL-WITH-VALUES, which generate only
+;;; cases that the more conservative version handles.
+;;;
+;;; INTEGRATE/COMBINATION-OPERATOR takes any expression (usually from
+;;; an operator position), and, if it is a combination of the above
+;;; form, returns a procedure expression that is equivalent to it if
+;;; used in an operator position; or if it is not a combination of the
+;;; above form, returns #F.
+
+(define (integrate/combination-operator operator operands)
+ (and (combination? operator)
+ (for-all? operands non-side-effecting?)
+ (let loop ((operator operator) (encloser (lambda (body) body)))
+ (let ((operator* (combination/operator operator)))
+ (cond ((if (procedure? operator*)
+ operator*
+ (integrate/combination-operator
+ operator*
+ (combination/operands operator)))
+ => (lambda (operator*)
+ (let subloop
+ ((body (procedure/body operator*))
+ (encloser
+ (lambda (body*)
+ (encloser
+ (combination-with-operator
+ operator
+ (procedure-with-body operator* body*))))))
+ (cond ((combination? body) (loop body encloser))
+ ((procedure? body)
+ (procedure-with-body
+ body
+ (encloser (procedure/body body))))
+ ((declaration? body)
+ (subloop (declaration/expression body)
+ (lambda (body*)
+ (encloser
+ (declaration/make
+ (declaration/scode body)
+ (declaration/declarations body)
+ body*)))))
+ (else #f)))))
+ (else #f))))))
+
+(define (combination-with-operator combination operator)
+ (combination/make (combination/scode combination)
+ (combination/block combination)
+ operator
+ (combination/operands combination)))
+
+(define (procedure-with-body procedure body)
+ (procedure/make (procedure/scode procedure)
+ (procedure/block procedure)
+ (procedure/name procedure)
+ (procedure/required procedure)
+ (procedure/optional procedure)
+ (procedure/rest procedure)
+ body))
+
+(define (non-side-effecting? expression)
+ (or (reference? expression)
+ (non-side-effecting-in-sequence? expression)))
+
(define-method/integrate 'DECLARATION
(lambda (operations environment declaration)
(let ((declarations (declaration/declarations declaration))
diff --git a/src/sf/usiexp.scm b/src/sf/usiexp.scm
index 5d50463..d596073 100644
--- a/src/sf/usiexp.scm
+++ b/src/sf/usiexp.scm
@@ -351,7 +351,7 @@ USA.
(make-combination expr block (ucode-primitive cons)
(list (car rest)
(list-expansion-loop #f block (cdr rest))))))
-
+
(define (values-expansion expr operands if-expanded if-not-expanded block)
if-not-expanded
(if-expanded
@@ -373,12 +373,18 @@ USA.
(let ((variable (variable/make&bind! block 'RECEIVER)))
(procedure/make
#f block lambda-tag:unnamed (list variable) '() #f
- (combination/make #f
- block
- (reference/make #f block variable)
- (map (lambda (variable)
- (reference/make #f block variable))
- variables))))))
+ (declaration/make
+ #f
+ ;; The receiver is used only once, and all its operand
+ ;; expressions are effect-free, so integrating here is
+ ;; safe.
+ (declarations/parse block '((INTEGRATE-OPERATOR RECEIVER)))
+ (combination/make #f
+ block
+ (reference/make #f block variable)
+ (map (lambda (variable)
+ (reference/make #f block variable))
+ variables)))))))
operands)))))
(define (call-with-values-expansion expr operands
_______________________________________________
MIT-Scheme-devel mailing list
MIT-Scheme-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/mit-scheme-devel
