From d7a9e68e8c459a0ef68ca2e553f43a9f8bf31c39 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Tue, 31 Jul 1990 17:21:28 +0000
Subject: [PATCH] Moved parse-lambda-list from macros.lisp to proclaim.lisp.

---
 compiler/macros.lisp   | 72 ------------------------------------------
 compiler/proclaim.lisp | 72 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+), 72 deletions(-)

diff --git a/compiler/macros.lisp b/compiler/macros.lisp
index ac4a565bc..2e3c23c8b 100644
--- a/compiler/macros.lisp
+++ b/compiler/macros.lisp
@@ -233,78 +233,6 @@
 
 (eval-when (#-new-compiler compile load eval)
 
-;;; Parse-Lambda-List  --  Interface
-;;;
-;;;    Break a lambda-list into its component parts.  We return eight values:
-;;;  1] A list of the required args.
-;;;  2] A list of the optional arg specs.
-;;;  3] True if a rest arg was specified.
-;;;  4] The rest arg.
-;;;  5] A boolean indicating whether keywords args are present.
-;;;  6] A list of the keyword arg specs.
-;;;  7] True if &allow-other-keys was specified.
-;;;  8] A list of the &aux specifiers.
-;;;
-;;; The top-level lambda-list syntax is checked for validity, but the arg
-;;; specifiers are just passed through untouched.  If something is wrong, we
-;;; use Compiler-Error, aborting compilation to the last recovery point.
-;;;
-;;; [Eventually this should go into the code sources, since it is used in
-;;; various random places such as the function type parsing.]
-;;;
-(proclaim '(function parse-lambda-list (list)
-		     (values list list boolean t boolean list boolean list)))
-(defun parse-lambda-list (list)
-  (collect ((required)
-	    (optional)
-	    (keys)
-	    (aux))
-    (let ((restp nil)
-	  (rest nil)
-	  (keyp nil)
-	  (allowp nil)
-	  (state :required))
-      (dolist (arg list)
-	(if (and (symbolp arg)
-		 (let ((name (symbol-name arg)))
-		   (and (/= (length name) 0)
-			(char= (char name 0) #\&))))
-	    (case arg
-	      (&optional
-	       (unless (eq state :required)
-		 (compiler-error "Misplaced &optional in lambda-list: ~S." list))
-	       (setq state '&optional))
-	      (&rest
-	       (unless (member state '(:required &optional))
-		 (compiler-error "Misplaced &rest in lambda-list: ~S." list))
-	       (setq state '&rest))
-	      (&key
-	       (unless (member state '(:required &optional :post-rest))
-		 (compiler-error "Misplaced &key in lambda-list: ~S." list))
-	       (setq keyp t)
-	       (setq state '&key))
-	      (&allow-other-keys
-	       (unless (eq state '&key)
-		 (compiler-error "Misplaced &allow-other-keys in lambda-list: ~S." list))
-	       (setq allowp t  state '&allow-other-keys))
-	      (&aux
-	       (when (eq state '&rest)
-		 (compiler-error "Misplaced &aux in lambda-list: ~S." list))
-	       (setq state '&aux))
-	      (t
-	       (compiler-error "Unknown &keyword in lambda-list: ~S." arg)))
-	    (case state
-	      (:required (required arg))
-	      (&optional (optional arg))
-	      (&rest
-	       (setq restp t  rest arg  state :post-rest))
-	      (&key (keys arg))
-	      (&aux (aux arg))
-	      (t
-	       (compiler-error "Found garbage in lambda-list when expecting a keyword: ~S." arg)))))
-    (values (required) (optional) restp rest keyp (keys) allowp (aux)))))
-
-
 ;;; Parse-Deftransform  --  Internal
 ;;;
 ;;;    Given a deftransform style lambda-list, generate code that parses the
diff --git a/compiler/proclaim.lisp b/compiler/proclaim.lisp
index 1a9a3fad6..6b6988615 100644
--- a/compiler/proclaim.lisp
+++ b/compiler/proclaim.lisp
@@ -41,6 +41,78 @@
 				      :brevity 1 :debug 1))
 
 
+;;; Parse-Lambda-List  --  Interface
+;;;
+;;;    Break a lambda-list into its component parts.  We return eight values:
+;;;  1] A list of the required args.
+;;;  2] A list of the optional arg specs.
+;;;  3] True if a rest arg was specified.
+;;;  4] The rest arg.
+;;;  5] A boolean indicating whether keywords args are present.
+;;;  6] A list of the keyword arg specs.
+;;;  7] True if &allow-other-keys was specified.
+;;;  8] A list of the &aux specifiers.
+;;;
+;;; The top-level lambda-list syntax is checked for validity, but the arg
+;;; specifiers are just passed through untouched.  If something is wrong, we
+;;; use Compiler-Error, aborting compilation to the last recovery point.
+;;;
+;;; [Eventually this should go into the code sources, since it is used in
+;;; various random places such as the function type parsing.]
+;;;
+(proclaim '(function parse-lambda-list (list)
+		     (values list list boolean t boolean list boolean list)))
+(defun parse-lambda-list (list)
+  (collect ((required)
+	    (optional)
+	    (keys)
+	    (aux))
+    (let ((restp nil)
+	  (rest nil)
+	  (keyp nil)
+	  (allowp nil)
+	  (state :required))
+      (dolist (arg list)
+	(if (and (symbolp arg)
+		 (let ((name (symbol-name arg)))
+		   (and (/= (length name) 0)
+			(char= (char name 0) #\&))))
+	    (case arg
+	      (&optional
+	       (unless (eq state :required)
+		 (compiler-error "Misplaced &optional in lambda-list: ~S." list))
+	       (setq state '&optional))
+	      (&rest
+	       (unless (member state '(:required &optional))
+		 (compiler-error "Misplaced &rest in lambda-list: ~S." list))
+	       (setq state '&rest))
+	      (&key
+	       (unless (member state '(:required &optional :post-rest))
+		 (compiler-error "Misplaced &key in lambda-list: ~S." list))
+	       (setq keyp t)
+	       (setq state '&key))
+	      (&allow-other-keys
+	       (unless (eq state '&key)
+		 (compiler-error "Misplaced &allow-other-keys in lambda-list: ~S." list))
+	       (setq allowp t  state '&allow-other-keys))
+	      (&aux
+	       (when (eq state '&rest)
+		 (compiler-error "Misplaced &aux in lambda-list: ~S." list))
+	       (setq state '&aux))
+	      (t
+	       (compiler-error "Unknown &keyword in lambda-list: ~S." arg)))
+	    (case state
+	      (:required (required arg))
+	      (&optional (optional arg))
+	      (&rest
+	       (setq restp t  rest arg  state :post-rest))
+	      (&key (keys arg))
+	      (&aux (aux arg))
+	      (t
+	       (compiler-error "Found garbage in lambda-list when expecting a keyword: ~S." arg)))))
+    (values (required) (optional) restp rest keyp (keys) allowp (aux)))))
+
+
 ;;; Check-Function-Name  --  Interface
 ;;;
 ;;;    Check that Name is a valid function name, returning the name if OK, and
-- 
GitLab