Permalink
Browse files

Fix inlining of for-each and map so that their recursion uses proper …

…tail calls even when (declare (not proper-tail-calls)) is in effect in the caller
  • Loading branch information...
1 parent 85716a2 commit b54ede2ba249f6e4f4ae7b0bfccf4bab38db29a4 @feeley feeley committed Oct 20, 2011
Showing with 23 additions and 18 deletions.
  1. +6 −3 gsc/_ptree1.scm
  2. +4 −4 gsc/_ptree2.scm
  3. +13 −11 gsc/_t-c-2.scm
View
@@ -1,8 +1,8 @@
;;;============================================================================
-;;; File: "_ptree1.scm", Time-stamp: <2010-06-10 15:31:40 feeley>
+;;; File: "_ptree1.scm"
-;;; Copyright (c) 1994-2009 by Marc Feeley, All Rights Reserved.
+;;; Copyright (c) 1994-2011 by Marc Feeley, All Rights Reserved.
(include "fixnum.scm")
@@ -485,7 +485,7 @@
(define (inline-primitive? name env) ; true iff name can be inlined
(declaration-value inline-primitives-sym name #t env))
-(define (add-not-inline-primitive? env)
+(define (add-not-inline-primitives env)
(env-declare env (list inline-primitives-sym #f)))
(define (inlining-limit env) ; returns the inlining limit
@@ -543,6 +543,9 @@
(define (proper-tail-calls? env) ; true iff proper tail calls should be generated
(declaration-value proper-tail-calls-sym #f #t env))
+(define (add-proper-tail-calls env)
+ (env-declare env (list proper-tail-calls-sym #t)))
+
(define (optimize-dead-local-variables? env) ; true iff dead local variables should be optimized
(declaration-value optimize-dead-local-variables-sym #f #t env))
View
@@ -1,8 +1,8 @@
;;;============================================================================
-;;; File: "_ptree2.scm", Time-stamp: <2011-05-19 09:42:02 feeley>
+;;; File: "_ptree2.scm"
-;;; Copyright (c) 1994-2009 by Marc Feeley, All Rights Reserved.
+;;; Copyright (c) 1994-2011 by Marc Feeley, All Rights Reserved.
(include "fixnum.scm")
@@ -214,7 +214,7 @@
(lambda (vars)
(new-call
source
- (add-not-inline-primitive? env)
+ (add-not-inline-primitives env)
(new-ref (node-source oper)
(node-env oper)
var)
@@ -311,7 +311,7 @@
(lambda (vars)
(new-call
source
- (add-not-inline-primitive? env)
+ (add-not-inline-primitives env)
(new-cst source env
spec)
(gen-var-refs source env vars)))
View
@@ -1,8 +1,8 @@
;;;============================================================================
-;;; File: "_t-c-2.scm", Time-stamp: <2010-06-10 15:28:28 feeley>
+;;; File: "_t-c-2.scm"
-;;; Copyright (c) 1994-2010 by Marc Feeley, All Rights Reserved.
+;;; Copyright (c) 1994-2011 by Marc Feeley, All Rights Reserved.
(include "fixnum.scm")
@@ -5223,6 +5223,8 @@
(node-source ptree))
(env
(node-env ptree))
+ (env2
+ (add-proper-tail-calls env))
(vars
(gen-temp-vars source args))
(f-var
@@ -5251,15 +5253,15 @@
(gen-temp-vars source lst-vars))
(x-var
(new-temp-variable source 'x)))
- (new-call source env
+ (new-call source env2
(new-prc source env
#f
#f
(list loop2-var)
'()
#f
#f
- (new-call source env
+ (new-call source env2
(new-ref source env
loop2-var)
(map (lambda (var)
@@ -5279,7 +5281,7 @@
(if (safe? env) ;; in case lists are truncated by other threads
lst2-vars
(list (car lst2-vars))))
- (new-call source env
+ (new-call source env2
(new-prc source env
#f
#f
@@ -5288,7 +5290,7 @@
#f
#f
(let ((rec-call
- (new-call source env
+ (new-call source env2
(new-ref source env
loop2-var)
(map (lambda (var)
@@ -6359,7 +6361,7 @@
(gen-call-prim-vars source env **fixnum?-sym vars)
(new-disj source env
(gen-call-prim-vars source env **flonum?-sym vars)
- (gen-call-prim-vars source (add-not-inline-primitive? env)
+ (gen-call-prim-vars source (add-not-inline-primitives env)
**real?-sym
vars))))
fail)))
@@ -6381,7 +6383,7 @@
(new-tst source env
(gen-call-prim-vars source env **flonum?-sym vars)
(gen-call-prim-vars source env **flfinite?-sym vars)
- (gen-call-prim-vars source (add-not-inline-primitive? env)
+ (gen-call-prim-vars source (add-not-inline-primitives env)
**rational?-sym
vars))))
fail)))
@@ -6400,7 +6402,7 @@
(lambda ()
(new-disj source env
(gen-call-prim-vars source env **fixnum?-sym vars)
- (gen-call-prim-vars source (add-not-inline-primitive? env)
+ (gen-call-prim-vars source (add-not-inline-primitives env)
**integer?-sym
vars)))
fail)))
@@ -6423,7 +6425,7 @@
(gen-call-prim source env
**not-sym
(list (gen-call-prim-vars source env **flonum?-sym vars)))
- (gen-call-prim-vars source (add-not-inline-primitive? env)
+ (gen-call-prim-vars source (add-not-inline-primitives env)
fallback
vars))))
fail)))
@@ -6446,7 +6448,7 @@
(list (gen-call-prim-vars source env **fixnum?-sym vars)))
(new-disj source env
(gen-call-prim-vars source env **flonum?-sym vars)
- (gen-call-prim-vars source (add-not-inline-primitive? env)
+ (gen-call-prim-vars source (add-not-inline-primitives env)
fallback
vars))))
fail)))

0 comments on commit b54ede2

Please sign in to comment.