~ chicken-core (chicken-5) 28810cd12cfe27dee5765af2d9960665626392c1

commit 28810cd12cfe27dee5765af2d9960665626392c1
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Aug 23 11:17:16 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Aug 23 11:17:16 2011 +0200

    slight simplification in handling of ##compiler#pure mark

diff --git a/optimizer.scm b/optimizer.scm
index 48b3a86e..e0f4214f 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -315,30 +315,28 @@
 			     llist args (first (node-subexpressions lval)) #f db
 			     void)
 			    fids gae) ) )
-			((variable-mark var '##compiler#pure) =>
-			 (lambda (pb)
-			   (or (and-let* ((k (car args))
-					  ((or (eq? #t pb) 
-					       (let ((im (variable-mark var '##compiler#intrinsic)))
-						 (or (eq? im 'internal) (eq? im pb)))))
-					  ((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) ))))
-				 (let ((info (and (pair? (cdr params)) (second params))))
-				   (debugging 
-				    'o
-				    "removed call to pure procedure with unused result"
-				    (or (source-info->string info) var)))
-				 (make-node
-				  '##core#call (list #t)
-				  (list k (make-node '##core#undefined '() '())) ) ) 
-			       (walk-generic n class params subs fids gae #f)) ) )
+			((variable-mark var '##compiler#pure)
+			 (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) ))))
+			       (let ((info (and (pair? (cdr params)) (second params))))
+				 (debugging 
+				  'o
+				  "removed call to pure procedure with unused result"
+				  (or (source-info->string info) var)))
+			       (make-node
+				'##core#call (list #t)
+				(list k (make-node '##core#undefined '() '())) ) ) 
+			     (walk-generic n class params subs fids gae #f)) )
 			((and lval
 			      (eq? '##core#lambda (node-class lval)))
 			 (let* ([lparams (node-parameters lval)]