Skip to content
Snippets Groups Projects
Commit d7a9e68e authored by wlott's avatar wlott
Browse files

Moved parse-lambda-list from macros.lisp to proclaim.lisp.

parent b20e4fde
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment