From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 14 Nov 2001 18:27:17 +0000 (+0000)
Subject: Change naming of peephole optimizer.  Fold all optimization into
X-Git-Tag: 20090517-FFI~2445
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c9f517d4b73d11f61a4b5047f6a91d99b75eb9e8;p=mit-scheme.git

Change naming of peephole optimizer.  Fold all optimization into
GENERATE-EXTERNAL-PROCEDURE.
---

diff --git a/v7/src/star-parser/shared.scm b/v7/src/star-parser/shared.scm
index 91d8aa845..f37b5ef6a 100644
--- a/v7/src/star-parser/shared.scm
+++ b/v7/src/star-parser/shared.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: shared.scm,v 1.17 2001/11/14 18:15:02 cph Exp $
+;;; $Id: shared.scm,v 1.18 2001/11/14 18:27:17 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -46,8 +46,8 @@
 		(maybe-make-let (map (lambda (b)
 				       (list (cdr b) (car b)))
 				     (cdr internal-bindings))
-		  (strip-protection-wrappers
-		   (maybe-peephole-optimize
+		  (maybe-peephole-optimize
+		   (strip-protection-wrappers
 		    (maybe-optimize-pointer-usage
 		     (maybe-optimize-by-substitution
 		      (generator expression)))))))))))))
@@ -66,6 +66,27 @@
   (if debug:disable-peephole-optimizer?
       expression
       (peephole-optimize expression)))
+
+(define (strip-protection-wrappers expression)
+  ;; Remove PROTECT wrappers from EXPRESSION.  Used after substitution
+  ;; optimization is complete.
+  (if (pair? expression)
+      (case (car expression)
+	((LAMBDA)
+	 `(LAMBDA ,(cadr expression)
+	    ,(strip-protection-wrappers (caddr expression))))
+	((LET)
+	 `(LET ,(cadr expression)
+	    ,(map (lambda (binding)
+		    (list (car binding)
+			  (strip-protection-wrappers (cadr binding))))
+		  (caddr expression))
+	    ,(strip-protection-wrappers (cadddr expression))))
+	((PROTECT)
+	 (cadr expression))
+	(else
+	 (map strip-protection-wrappers expression)))
+      expression))
 
 ;;;; Support for preprocessing
 
@@ -595,7 +616,7 @@
 	(or (loop (car tree))
 	    (loop (cdr tree)))
 	(eq? 'PROTECT tree))))
-
+
 (define (count-references identifiers expression)
   ;; For each element of IDENTIFIERS, count the number of references
   ;; in EXPRESSION.  Result is a list of counts.
@@ -631,27 +652,6 @@
 	       (if entry
 		   (set-cdr! entry (+ (cdr entry) 1)))))))
     (map cdr alist)))
-
-(define (strip-protection-wrappers expression)
-  ;; Remove PROTECT wrappers from EXPRESSION.  Used after substitution
-  ;; optimization is complete.
-  (if (pair? expression)
-      (case (car expression)
-	((LAMBDA)
-	 `(LAMBDA ,(cadr expression)
-	    ,(strip-protection-wrappers (caddr expression))))
-	((LET)
-	 `(LET ,(cadr expression)
-	    ,(map (lambda (binding)
-		    (list (car binding)
-			  (strip-protection-wrappers (cadr binding))))
-		  (caddr expression))
-	    ,(strip-protection-wrappers (cadddr expression))))
-	((PROTECT)
-	 (cadr expression))
-	(else
-	 (map strip-protection-wrappers expression)))
-      expression))
 
 ;;;; Pointer optimizer
 
@@ -689,11 +689,11 @@
 			expression)
 	 (let ((operator (car expression))
 	       (operand (cadr expression)))
-	   (let ((parameter (car (cadr operator)))
-		 (body (caddr operator)))
-	     `((LAMBDA (,parameter)
-		 ,(optimize-pointer-usage body parameter))
-	       ,operand))))
+	   (let ((parameter (car (cadr operator))))
+	     (let ((body (optimize-pointer-usage (caddr operator) parameter)))
+	       (if (> (car (count-references (list parameter) body)) 0)
+		   `((LAMBDA (,parameter) ,body) ,operand)
+		   body)))))
 	((syntax-match?
 	  '('BEGIN
 	     ('SET-PARSER-BUFFER-POINTER! EXPRESSION IDENTIFIER)