~ chicken-core (chicken-5) 505ec20962cab7c54baa86c37a525ce525a4c40c

commit 505ec20962cab7c54baa86c37a525ce525a4c40c
Author:     unknown <felix@.(none)>
AuthorDate: Tue Nov 3 23:53:32 2009 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Mon Nov 23 17:49:55 2009 +0100

    handle non-atomic operator in function call generically by introducing temporary
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/compiler.scm b/compiler.scm
index dd8a629f..4010ad8f 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -1225,20 +1225,12 @@
 
 	  (else
 	   (emit-syntax-trace-info x #f)
-	   (let ((x (mapwalk x e se)))
-	     (if (and (pair? (car x))
-		      (symbol? (caar x))
-		      (memq (or (lookup (caar x) se) (caar x)) '(lambda ##core#lambda)))
-		 (let ((lexp (car x))
-		       (args (cdr x)) )
-		   (##sys#check-syntax 'lambda lexp '(_ lambda-list . #(_ 1)) #f se)
-		   (let ((llist (cadr lexp)))
-		     (if (and (proper-list? llist) (= (llist-length llist) (length args)))
-			 `(let ,(map list llist args) ,@(cddr lexp)) 
-			 (let ((var (gensym 't)))
-			   `(let ((,var ,(car x)))
-			     (,var ,@(cdr x)) ) ) ) ) ) 
-		 x))) ) )
+	   (let ((tmp (gensym)))
+	     (walk
+	      `(##core#let 
+		((,tmp ,(car x)))
+		(,tmp ,@(cdr x)))
+	      e se dest)))))
   
   (define (mapwalk xs e se)
     (map (lambda (x) (walk x e se #f)) xs) )