~ chicken-core (chicken-5) a59bb1354862fb8bdd2240f2492da29b9869052b

commit a59bb1354862fb8bdd2240f2492da29b9869052b
Merge: 304bd8da 933c4dc5
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Sep 21 10:34:40 2010 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Sep 21 10:34:40 2010 -0400

    don't inline if inlined body refers to contractable (thanks to Sven Hartrumpf for reporting bug)

diff --cc optimizer.scm
index 91ed92e1,53948100..0cdf29d9
--- a/optimizer.scm
+++ b/optimizer.scm
@@@ -340,11 -341,19 +341,19 @@@
  				       (for-each (cut put! db <> 'inline-target #t) fids)
  				       (check-signature var args llist)
  				       (debugging 'o "inlining procedure" var)
- 				       (touch)
- 				       (walk
- 					(inline-lambda-bindings
- 					 llist args (first (node-subexpressions lval)) #t db)
- 					fids) )
+ 				       (call/cc
+ 					(lambda (return)
+ 					  (define (cfk cvar)
+ 					    (debugging 
+ 					     'i
+ 					     "not inlining procedure because it refers to contractable"
+ 					     var cvar)
+ 					    (return (walk-generic n class params subs fids)))
+ 					  (let ((n2 (inline-lambda-bindings
 -						     llist args (first (node-subexpressions lval)) #t db
 -						     cfk)))
++						     llist args (first (node-subexpressions lval))
++						     #t db cfk)))
+ 					    (touch)
+ 					    (walk n2 fids)))))
  				      ((test ifid 'has-unused-parameters)
  				       (if (< (length args) argc) ; Expression was already optimized (should this happen?)
  					   (walk-generic n class params subs fids)