(`Integration' in the sense of `open-coding', not in the sense of
integrating multiple return values into the system so that their
implementation is actually correct...)
Short of redesigning great swaths of the system to spread multiple
return values on the stack, it would be nice if the compiler generated
somewhat better code for uses of them that syntactically obviously
don't require extra storage for them, such as
(receive (x y z)
(let ((foo (fnord)))
(values foo (mumble foo) (frotz foo)))
...).
Currently, SF only expands VALUES and CALL-WITH-VALUES, to transform
that into
((let ((foo (fnord)))
(let ((value-0 foo) (value-1 (mumble foo)) (value-2 (frotz foo)))
(lambda (receiver)
(receiver value-0 value-1 value-2))))
(lambda (x y z)
...),
for which LIAR then generates code to allocate two closures on the
heap and to immediately call them. I've attached a patch to SF that
makes it instead transform the above code into
(let ((foo (fnord)))
(let ((value-0 foo) (value-1 (grovel foo)) (value-2 (frotz foo)))
(let ((x value-0) (y value-1) (z value-2))
...))),
for which LIAR naturally generates much better code. I believe the
transformation is very conservative: not only does it preserve the
semantics of the program, as it of course should, but it also
preserves any ambivalence about order of evaluation, while a more
aggressive transformation might commit to an order of evaluation when
the program specified none in particular.
I sha'n't commit this before Chris has sorted out the macro engine and
apparent compiler bugs, though. Comments? Objections?
diff --git a/src/sf/subst.scm b/src/sf/subst.scm
index 6fa6ac5..e0773d7 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,85 @@ you ask for.
(else (error "Unknown operation" operation))))
integration-failure)))
+;;; ((let ((a (foo)) (b (bar)))
+;;; (lambda (receiver)
+;;; ...body...))
+;;; (lambda (x y z) ...))
+;;; =>
+;;; (let ((receiver (lambda (x y z) ...)))
+;;; (let ((a (foo)) (b (bar)))
+;;; ...body...))
+;;;
+;;; We do this transformation 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. If we
+;;; did commit to a particular order of evaluation, we could transform
+;;; not just LETs in operator positions but BEGINs as well, by adding
+;;; a clause in SUBLOOP's COND. However, this is mainly for VALUES
+;;; and CALL-WITH-VALUES, which will produce only LETs in operator
+;;; positions and only LAMBDAs in the respective operand positions.
+;;;
+;;; 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
