From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 15 May 1999 03:15:29 +0000 (+0000)
Subject: Eliminate '#!aux, which parses to the wrong thing (yuk!).
X-Git-Tag: 20090517-FFI~4533
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2bfae7ea41bcc899172c92fde1bf0a613cba2b0e;p=mit-scheme.git

Eliminate '#!aux, which parses to the wrong thing (yuk!).
---

diff --git a/v8/src/compiler/midend/alpha.scm b/v8/src/compiler/midend/alpha.scm
index 62f3c3c8d..a9bdd4780 100644
--- a/v8/src/compiler/midend/alpha.scm
+++ b/v8/src/compiler/midend/alpha.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: alpha.scm,v 1.12 1999/01/02 06:06:43 cph Exp $
+$Id: alpha.scm,v 1.13 1999/05/15 03:15:29 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -60,7 +60,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (alphaconv/rename-lambda-list lambda-list new-names)
   (let loop ((ll lambda-list) (nn new-names) (result '()))
     (cond ((null? ll) (reverse! result))
-	  ((memq (car ll) '(#!AUX #!OPTIONAL #!REST))
+	  ((or (eq? #!optional (car ll))
+	       (eq? #!rest (car ll))
+	       (eq? #!aux (car ll)))
 	   (loop (cdr ll) nn (cons (car ll) result)))
 	  (else
 	   (loop (cdr ll) (cdr nn) (cons (car nn) result))))))
diff --git a/v8/src/compiler/midend/cleanup.scm b/v8/src/compiler/midend/cleanup.scm
index 28d5e74ad..b8c55c6bd 100644
--- a/v8/src/compiler/midend/cleanup.scm
+++ b/v8/src/compiler/midend/cleanup.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: cleanup.scm,v 1.32 1999/01/02 06:06:43 cph Exp $
+$Id: cleanup.scm,v 1.33 1999/05/15 03:15:25 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -49,7 +49,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (define (exit! name) (cleanup/env/exit! env name))
   (let ((lambda-list*
 	 (map (lambda (name)
-		(if (memq name '(#!AUX #!REST #!OPTIONAL))
+		(if (lambda-list-keyword? name)
 		    name
 		    (cleanup/binding/name (cleanup/env/enter! env name))))
 	      lambda-list)))
diff --git a/v8/src/compiler/midend/coerce.scm b/v8/src/compiler/midend/coerce.scm
index fa8ccb69d..2afa62521 100644
--- a/v8/src/compiler/midend/coerce.scm
+++ b/v8/src/compiler/midend/coerce.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: coerce.scm,v 1.7 1999/01/02 06:06:43 cph Exp $
+$Id: coerce.scm,v 1.8 1999/05/15 03:15:22 cph Exp $
 
 Copyright (c) 1995, 1999 Massachusetts Institute of Technology
 
@@ -254,10 +254,11 @@ wins by about 10%.
 	       (bds   '())
 	       (rands (cons cont rands)))
       (cond ((null? ll) bds)
-	    ((eq? (car ll) '#!optional)
+	    ((eq? (car ll) #!optional)
 	     (loop (cdr ll) bds rands))
 	    ((or (null? rands)
-		 (memq (car ll) '(#!aux #!rest)))
+		 (eq? #!rest (car ll))
+		 (eq? #!aux (car ll)))
 	     (map* bds coerce/binding/make (lambda-list->names ll)))
 	    (else
 	     (loop (cdr ll)
diff --git a/v8/src/compiler/midend/dataflow.scm b/v8/src/compiler/midend/dataflow.scm
index deccc3ba1..6ad8b010e 100644
--- a/v8/src/compiler/midend/dataflow.scm
+++ b/v8/src/compiler/midend/dataflow.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dataflow.scm,v 1.21 1999/01/02 06:06:43 cph Exp $
+$Id: dataflow.scm,v 1.22 1999/05/15 03:15:17 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -1904,9 +1904,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
     (cond ((null? lambda-list)
            (if (not (null? args))
                (warn "Too many args" whole-lambda-list whole-args)))
-          ((eq? (car lambda-list) '#!OPTIONAL)
+          ((eq? (car lambda-list) #!optional)
            (optional-loop (cdr lambda-list) formals args))
-          ((eq? (car lambda-list) '#!REST)
+          ((eq? (car lambda-list) #!rest)
            (rest-loop (cdr lambda-list) formals args))
           ((null? args)
            (warn "Too few arguments" whole-lambda-list whole-args))
@@ -1918,7 +1918,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
     (cond ((null? lambda-list)
            (if (not (null? args))
                (warn "Too many args"  whole-lambda-list whole-args)))
-          ((eq? (car lambda-list) '#!REST)
+          ((eq? (car lambda-list) #!rest)
            (rest-loop (cdr lambda-list) formals args))
           ((null? args)
            (do-optional! (car lambda-list) (car formals) #f)
diff --git a/v8/src/compiler/midend/ea2.scm b/v8/src/compiler/midend/ea2.scm
index 583499f2b..c66ee08e4 100644
--- a/v8/src/compiler/midend/ea2.scm
+++ b/v8/src/compiler/midend/ea2.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ea2.scm,v 1.5 1999/01/02 06:06:43 cph Exp $
+$Id: ea2.scm,v 1.6 1999/05/15 03:15:14 cph Exp $
 
 Copyright (c) 1995, 1999 Massachusetts Institute of Technology
 
@@ -444,11 +444,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	   env)
 	  ((or (null? names) (null? types))
 	   (internal-error "Mismatch" names0 types0))
-	  ((eq? (car names) '#!optional)
+	  ((eq? (car names) #!optional)
 	   (loop (cdr names) types #T))
-	  ((eq? (car names) '#!aux)
+	  ((eq? (car names) #!aux)
 	   (loop (cdr names) types #T))
-	  ((eq? (car names) '#!rest)
+	  ((eq? (car names) #!rest)
 	   (extend! (second names) earlyrew/type/*unknown)
 	   env)
 	  (else
diff --git a/v8/src/compiler/midend/expand.scm b/v8/src/compiler/midend/expand.scm
index 80638bdb1..3f6b5ecaf 100644
--- a/v8/src/compiler/midend/expand.scm
+++ b/v8/src/compiler/midend/expand.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: expand.scm,v 1.10 1999/01/02 06:06:43 cph Exp $
+$Id: expand.scm,v 1.11 1999/05/15 03:15:11 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -59,7 +59,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (expand/remember
    (let ((lambda-list (lambda/formals form))
 	 (body        (expand/expr (lambda/body form))))
-     (cond ((memq '#!AUX lambda-list)
+     (cond ((memq #!aux lambda-list)
 	    => (lambda (tail)
 		 (let ((rest  (list-prefix lambda-list tail))
 		       (auxes (cdr tail)))
diff --git a/v8/src/compiler/midend/fakeprim.scm b/v8/src/compiler/midend/fakeprim.scm
index b94d7b615..73fe2b46b 100644
--- a/v8/src/compiler/midend/fakeprim.scm
+++ b/v8/src/compiler/midend/fakeprim.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fakeprim.scm,v 1.31 1999/01/02 06:06:43 cph Exp $
+$Id: fakeprim.scm,v 1.32 1999/05/15 03:14:42 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -129,7 +129,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	 defs)))
     (cond ((null? args)
 	   defs)
-	  ((eq? (car args) '#!REST)
+	  ((eq? (car args) #!rest)
 	   (add-def (cadr args) path #F))
 	  ((eq? (car args) '#F)
 	   (loop (cdr args) `(CDR ,path) defs))
@@ -491,7 +491,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   ;;   NARGS = number of <value> expressions
   ;;   Introduced by applicat.scm.
   (make-operator "#[internal-apply]"))
-(cookie-call %internal-apply cont 'NARGS procedure #!REST values)
+(cookie-call %internal-apply cont 'NARGS procedure #!rest values)
 
 
 (define-operator %internal-apply-unchecked
@@ -502,7 +502,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   ;;   Like %internal-apply, but assumes that the procedure is compiled and
   ;;   of the correct arity.
   (make-operator "#[internal-apply-unchecked]"))
-(cookie-call %internal-apply-unchecked cont 'NARGS procedure #!REST values)
+(cookie-call %internal-apply-unchecked cont 'NARGS procedure #!rest values)
 
 (define-operator %primitive-apply
   ;; (CALL ',%primitive-apply <continuation>
diff --git a/v8/src/compiler/midend/frag.scm b/v8/src/compiler/midend/frag.scm
index 242594a45..664ce98c4 100644
--- a/v8/src/compiler/midend/frag.scm
+++ b/v8/src/compiler/midend/frag.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: frag.scm,v 1.6 1999/01/02 06:06:43 cph Exp $
+$Id: frag.scm,v 1.7 1999/05/15 03:14:50 cph Exp $
 
 Copyright (c) 1995, 1999 Massachusetts Institute of Technology
 
@@ -695,7 +695,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	       (generate (append new-required
 				 (reverse new-args)
 				 rest-list-args
-				 (if rest? (list '#!rest new-rest-arg) '()))
+				 (if rest? (list #!rest new-rest-arg) '()))
 			 (append (if rest?
 				     (list (bind-ph terminal-ph new-rest-arg))
 				     '())
diff --git a/v8/src/compiler/midend/inlate.scm b/v8/src/compiler/midend/inlate.scm
index 6d89f922b..fb80127de 100644
--- a/v8/src/compiler/midend/inlate.scm
+++ b/v8/src/compiler/midend/inlate.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: inlate.scm,v 1.8 1999/01/02 06:06:43 cph Exp $
+$Id: inlate.scm,v 1.9 1999/05/15 03:14:59 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -86,13 +86,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	      (append req
 		      (if (null? opt)
 			  '()
-			  (cons '#!OPTIONAL opt))
+			  (cons #!optional opt))
 		      (if (not rest)
 			  '()
-			  (list '#!REST rest))
+			  (list #!rest rest))
 		      (if (null? aux)
 			  '()
-			  (cons '#!AUX aux))))
+			  (cons #!aux aux))))
 	     (new
 	      `(LAMBDA ,(cons (new-continuation-variable) lambda-list)
 		 ,(let ((body (inlate/scode sbody #F)))
@@ -108,13 +108,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   `(LAMBDA ,(append (cons (new-continuation-variable) req)
 		    (if (null? opt)
 			'()
-			(cons '#!OPTIONAL opt))
+			(cons #!optional opt))
 		    (if (not rest)
 			'()
-			(list '#!REST rest))
+			(list #!rest rest))
 		    (if (null? aux)
 			'()
-			(cons '#!AUX aux)))
+			(cons #!aux aux)))
      ,(let ((body (inlate/scode sbody)))
 	(if (null? decls)
 	    body
diff --git a/v8/src/compiler/midend/kmp.scm b/v8/src/compiler/midend/kmp.scm
index 94a79e38b..cc8f32ebf 100644
--- a/v8/src/compiler/midend/kmp.scm
+++ b/v8/src/compiler/midend/kmp.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: kmp.scm,v 1.2 1999/01/02 06:06:43 cph Exp $
+$Id: kmp.scm,v 1.3 1999/05/15 03:15:06 cph Exp $
 
 Copyright (c) 1995, 1999 Massachusetts Institute of Technology
 
@@ -52,7 +52,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 		     defs)))
 	    (cond ((null? args)
 		   defs)
-		  ((eq? (car args) '#!REST)
+		  ((eq? (car args) #!rest)
 		   (add-def (cadr args) path))
 		  ((eq? (car args) '#F)
 		   (loop (cdr args) `(CDR ,path) defs))
diff --git a/v8/src/compiler/midend/simplify.scm b/v8/src/compiler/midend/simplify.scm
index 1518b9c5f..ed1049fc1 100644
--- a/v8/src/compiler/midend/simplify.scm
+++ b/v8/src/compiler/midend/simplify.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: simplify.scm,v 1.21 1999/01/02 06:06:43 cph Exp $
+$Id: simplify.scm,v 1.22 1999/05/15 03:14:36 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -264,8 +264,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
       (cond ((null? ll)
 	     (internal-error "Missing operand" name form))
 	    ((eq? name (car ll)) index)
-	    ((or (eq? (car ll) '#!OPTIONAL)
-		 (eq? (car ll) '#!REST))
+	    ((or (eq? (car ll) #!optional)
+		 (eq? (car ll) #!rest))
 	     -1)
 	    (else
 	     (loop (cdr ll) (+ index 1)))))))
@@ -443,7 +443,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   ;;  variables in ENV.  Currently it does not update the debugging
   ;;  info, but it should.
   (define (rename name)
-    (if (memq name '(#!aux #!rest #!optional))
+    (if (lambda-list-keyword? name)
 	name
 	(let ((new-name (variable/rename name)))
 	  (dbg-info/remember name `(LOOKUP ,new-name))
diff --git a/v8/src/compiler/midend/synutl.scm b/v8/src/compiler/midend/synutl.scm
index 7efbb5236..e912d4faf 100644
--- a/v8/src/compiler/midend/synutl.scm
+++ b/v8/src/compiler/midend/synutl.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: synutl.scm,v 1.3 1999/01/02 06:06:43 cph Exp $
+$Id: synutl.scm,v 1.4 1999/05/15 03:14:46 cph Exp $
 
 Copyright (c) 1994, 1999 Massachusetts Institute of Technology
 
@@ -38,7 +38,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 		 (values (reverse names)
 			 `(let ((,var* ,expr))
 			    (,@prefix ,@(reverse args)))))
-		((eq? (car ll) '#!rest)
+		((eq? (car ll) #!rest)
 		 (loop '()
 		       (cons (cadr ll) names)
 		       (cons path args)
diff --git a/v8/src/compiler/midend/utils.scm b/v8/src/compiler/midend/utils.scm
index 0b19ffeb7..581f321c5 100644
--- a/v8/src/compiler/midend/utils.scm
+++ b/v8/src/compiler/midend/utils.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: utils.scm,v 1.33 1999/01/02 06:06:43 cph Exp $
+$Id: utils.scm,v 1.34 1999/05/15 03:14:54 cph Exp $
 
 Copyright (c) 1994-1999 Massachusetts Institute of Technology
 
@@ -761,23 +761,29 @@ Example use of FORM/COPY-TRANSFORMING:
 
 ;;;; Lambda-list utilities
 
+(define (lambda-list-keyword? object)
+  (or (eq? #!optional object)
+      (eq? #!rest object)
+      (eq? #!aux object)))
+
 (define (lambda-list->names lambda-list)
-  (delq* '(#!OPTIONAL #!REST #!AUX) lambda-list))
+  (cond ((null? lambda-list)
+	 lambda-list)
+	((lambda-list-keyword? (car lambda-list))
+	 (lambda-list->names (cdr lambda-list)))
+	(else
+	 (cons (car lambda-list) (lambda-list->names (cdr lambda-list))))))
 
 (define (lambda-list/count-names lambda-list)
   (let loop  ((list lambda-list) (count 0))
     (cond ((null? list)  count)
-	  ((memq (car list)  '(#!OPTIONAL #!REST #!AUX))
+	  ((lambda-list-keyword? (car list))
 	   (loop (cdr list) count))
 	  (else
 	   (loop (cdr list) (+ count 1))))))
 
 (define (hairy-lambda-list? lambda-list)
- (there-exists? lambda-list
-   (lambda (token)
-     (or (eq? token '#!OPTIONAL)
-	 (eq? token '#!REST)
-	 (eq? token '#!AUX)))))
+  (there-exists? lambda-list lambda-list-keyword?))
 
 (define (guarantee-simple-lambda-list lambda-list)
   (if (hairy-lambda-list? lambda-list)
@@ -788,10 +794,10 @@ Example use of FORM/COPY-TRANSFORMING:
       (internal-error "Wrong number of arguments" len args)))
 
 (define (lambda-list/applicate form lambda-list args)
-  ;; If LAMBDA-LIST is to be simplified by removing #!OPTIONAL and #!REST
+  ;; If LAMBDA-LIST is to be simplified by removing #!optional and #!rest
   ;; markers, then the ARGS must be processed to ensure the lambda
   ;; bindings are bould to the same values.  Returns a list of
-  ;; expressions. #!AUX is not allowed.  FORM is used only for error
+  ;; expressions. #!aux is not allowed.  FORM is used only for error
   ;; reporting to locate the user's source.
   (define (bad message)
     (user-error message	(form->source-irritant form)))
@@ -802,11 +808,11 @@ Example use of FORM/COPY-TRANSFORMING:
 	   (if (not (null? ops))
 	       (bad "Too many arguments"))
 	   (reverse! ops*))
-	  ((eq? (car ll) '#!OPTIONAL)
+	  ((eq? (car ll) #!optional)
 	   (loop (if (or (null? (cddr ll))
-			 (eq? '#!REST (caddr ll)))
+			 (eq? #!rest (caddr ll)))
 		     (cddr ll)
-		     (cons '#!OPTIONAL (cddr ll)))
+		     (cons #!optional (cddr ll)))
 		 (if (null? ops)
 		     ops
 		     (cdr ops))
@@ -814,7 +820,7 @@ Example use of FORM/COPY-TRANSFORMING:
 			   `(QUOTE ,%unassigned)
 			   (car ops))
 		       ops*)))
-	  ((eq? (car ll) '#!REST)
+	  ((eq? (car ll) #!rest)
 	   ;; This only works before CPS conversion.
 	   ;; By that time, all "lexprs" should have been split.
 	   (reverse!
@@ -836,15 +842,15 @@ Example use of FORM/COPY-TRANSFORMING:
   (let parse ((ll lambda-list))
     (cond ((null? ll)
 	   (values '() '() false '()))
-	  ((eq? (car ll) '#!OPTIONAL)
+	  ((eq? (car ll) #!optional)
 	   (call-with-values
 	    (lambda () (parse (cdr ll)))
 	    (lambda (opt opt* rest aux)
 	      (if (not (null? opt*))
-		  (internal-error "Multiple #!OPTIONAL specifiers"
+		  (internal-error "Multiple #!optional specifiers"
 				  lambda-list))
 	      (values '() opt rest aux))))
-	  ((eq? (car ll) '#!REST)
+	  ((eq? (car ll) #!rest)
 	   (call-with-values
 	    (lambda () (parse (cdr ll)))
 	    (lambda (req opt rest aux)
@@ -852,9 +858,9 @@ Example use of FORM/COPY-TRANSFORMING:
 		      (not (null? (cdr req)))
 		      (not (null? opt))
 		      rest)
-		  (internal-error "Unexpected stuff after #!REST" lambda-list))
+		  (internal-error "Unexpected stuff after #!rest" lambda-list))
 	      (values '() '() (car req) aux))))
-	  ((eq? (car ll) '#!AUX)
+	  ((eq? (car ll) #!aux)
 	   (call-with-values
 	    (lambda () (parse (cdr ll)))
 	    (lambda (req opt rest aux)
@@ -862,7 +868,7 @@ Example use of FORM/COPY-TRANSFORMING:
 		      (not (null? opt))
 		      rest
 		      (not (null? aux)))
-		  (internal-error "Unexpected stuff after #!AUX" lambda-list))
+		  (internal-error "Unexpected stuff after #!aux" lambda-list))
 	      (values '() '() false req))))
 	  (else
 	   (call-with-values
diff --git a/v8/src/compiler/midend/widen.scm b/v8/src/compiler/midend/widen.scm
index e2163e570..0e0c94352 100644
--- a/v8/src/compiler/midend/widen.scm
+++ b/v8/src/compiler/midend/widen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: widen.scm,v 1.10 1999/01/02 06:06:43 cph Exp $
+$Id: widen.scm,v 1.11 1999/05/15 03:14:31 cph Exp $
 
 Copyright (c) 1994, 1999 Massachusetts Institute of Technology
 
@@ -360,7 +360,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	     (nodes value-nodes))
     (cond ((null? nodes)
 	   (continue name-map (reverse new-names)))
-	  ((memq (car names) '(#!REST #!OPTIONAL #!AUX))
+	  ((lambda-list-keyword? (car names))
 	   (loop name-map (cons (car names) new-names) (cdr names) nodes))
 	  ((widen/rewrite? (car nodes))
 	   (let* ((this (car nodes))