~ chicken-core (chicken-5) d6c35912072687ed6149c2cc7c248e18059d1a74

commit d6c35912072687ed6149c2cc7c248e18059d1a74
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Fri Mar 18 20:27:09 2016 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Fri Mar 18 20:27:09 2016 +0100

    Don't shortcut pure calls in the optimiser
    
    When we notice a node represents a call to a pure (side effect-free)
    procedure, we attempt to drop the call completely, if the result is
    unused.  However, if the result _is_ used, we shouldn't just give up.
    In fact, if the callee is of type explicit-rest, we *must* finish the
    optimisation by tweaking the caller.
    
    This fixes a bug reported by Joerg Wittenberger which got triggered
    rather easily when adding profiler instrumentation to procedures,
    because those always use rest args.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/optimizer.scm b/optimizer.scm
index 9eb4247d..4c97bd9e 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -348,28 +348,27 @@
 			     llist args (first (node-subexpressions lval)) #f db
 			     void)
 			    fids gae) ) )
-			((variable-mark var '##compiler#pure)
-			 ;; callee is side-effect free
-			 (or (and-let* ((k (car args))
-					((eq? '##core#variable (node-class k)))
-					(kvar (first (node-parameters k)))
-					(lval (and (not (test kvar 'unknown)) 
-						   (test kvar 'value))) 
-					((eq? '##core#lambda (node-class lval)))
-					(llist (third (node-parameters lval)))
-					((or (test (car llist) 'unused)
-					     (and (not (test (car llist) 'references))
-						  (not (test (car llist) 'assigned)))))
-					((not (any (cut expression-has-side-effects? <> db)
-						   (cdr args) ))))
-			       (debugging 
-				'o
-				"removed call to pure procedure with unused result"
-				info)
-			       (make-node
-				'##core#call (list #t)
-				(list k (make-node '##core#undefined '() '())) ) ) 
-			     (walk-generic n class params subs fids gae #f)) )
+			((and-let* (((variable-mark var '##compiler#pure))
+				    ((eq? '##core#variable (node-class (car args))))
+				    (kvar (first (node-parameters (car args))))
+				    (lval (and (not (test kvar 'unknown))
+					       (test kvar 'value)))
+				    ((eq? '##core#lambda (node-class lval)))
+				    (llist (third (node-parameters lval)))
+				    ((or (test (car llist) 'unused)
+					 (and (not (test (car llist) 'references))
+					      (not (test (car llist) 'assigned))))))
+			   ;; callee is side-effect free
+			   (not (any (cut expression-has-side-effects? <> db)
+				     (cdr args))))
+			 (debugging
+			  'o
+			  "removed call to pure procedure with unused result"
+			  info)
+			 (make-node
+			  '##core#call (list #t)
+			  (list (car args)
+				(make-node '##core#undefined '() '()))))
 			((and lval
 			      (eq? '##core#lambda (node-class lval)))
 			 ;; callee is a lambda
diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm
index 124dc9aa..ad67351a 100644
--- a/tests/compiler-tests.scm
+++ b/tests/compiler-tests.scm
@@ -395,3 +395,20 @@
 (assert (= 12.0 (s4v-sum "float" f64vector '#f64(1.5 2.5 3.5 4.5))))
 (assert (= 12.0 (s4v-sum "float" nonnull-f32vector '#f32(1.5 2.5 3.5 4.5))))
 (assert (= 12.0 (s4v-sum "float" nonnull-f64vector '#f64(1.5 2.5 3.5 4.5))))
+
+
+;; Reported by Jörg Wittenberger: in some cases, -profile would
+;; generate calls to procedures.  This was due to calls to pure
+;; procedures not getting replaced with explicitly consed rest
+;; list when the procedures themselves were hidden.
+(module explicitly-consed-rest-args-bug (do-it also-do-it)
+ (import scheme chicken)
+
+ (: get-value (* * #!rest * --> *))
+ (define (get-value x y . rest)
+   (apply x y rest))
+ (define (do-it arg)
+   (get-value arg 2))
+ (define (also-do-it arg)
+   (get-value arg 3))
+)