Skip to content
Snippets Groups Projects
Commit a5cc10f2 authored by pmai's avatar pmai
Browse files

Patches by Gerd Moellmann to improve checking of GF lambda lists for

well-formedness, as described in ANSI Section 3.4.2 Generic Function
Lambda Lists.  See also bug generic-function-lambda-list-checking-too-lax
in entomotomy.
parent 62c1a79b
No related branches found
No related tags found
No related merge requests found
......@@ -26,7 +26,7 @@
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.32 2002/09/07 13:16:47 pmai Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.33 2002/10/09 14:19:11 pmai Exp $")
(in-package :pcl)
......@@ -168,7 +168,62 @@ work during bootstrapping.
;; seems to do the job just as well.
(proclaim-defgeneric function-specifier lambda-list))
;;;
;;; ANSI 3.4.2, Generic Function Lambda Lists
;;;
(defun parse-generic-function-lambda-list (lambda-list)
;; This is like kernel:parse-lambda-list, but returns an additional
;; value AUXP which is true if LAMBDA-LIST contains any &aux keyword.
(multiple-value-bind (required optional restp rest keyp keys
allow-other-keys-p aux morep
more-context more-count)
(kernel:parse-lambda-list lambda-list)
(values required optional restp rest keyp keys allow-other-keys-p
(or aux (member '&aux lambda-list :test #'eq)) aux
morep more-context more-count)))
(defun check-generic-function-lambda-list (function-specifier lambda-list)
(multiple-value-bind (required optional restp rest keyp keys
allow-other-keys-p auxp aux morep
more-context more-count)
(parse-generic-function-lambda-list lambda-list)
(declare (ignore restp rest keyp aux allow-other-keys-p more-context
more-count))
(labels ((lambda-list-error (format-control &rest format-arguments)
(simple-program-error "Generic function ~A:~%~?"
function-specifier
format-control format-arguments))
(check-required-parameter (parameter)
(unless (symbolp parameter)
(lambda-list-error
"Invalid generic function parameter name ~A"
parameter)))
(check-key-or-optional-parameter (parameter)
(unless (or (symbolp parameter)
(and (consp parameter)
(symbolp (car parameter))))
(lambda-list-error
"Invalid generic function parameter name: ~A"
parameter))
(when (and (consp parameter)
(not (null (cdr parameter))))
(lambda-list-error
"Optional and key parameters of generic functions~%~
may not have default values or supplied-p ~
parameters: ~A" parameter))))
(when morep
(lambda-list-error
"&MORE not allowed in generic function lambda lists"))
(when auxp
(lambda-list-error
"&AUX not allowed in generic function lambda lists"))
(mapc #'check-required-parameter required)
(mapc #'check-key-or-optional-parameter optional)
(mapc #'check-key-or-optional-parameter keys))))
(defmacro defgeneric (function-specifier lambda-list &body options)
(check-generic-function-lambda-list function-specifier lambda-list)
(expand-defgeneric function-specifier lambda-list options))
(defun expand-defgeneric (function-specifier lambda-list options)
......
......@@ -2,7 +2,7 @@
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.10 2002/06/05 23:00:11 pmai Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.11 2002/10/09 14:19:11 pmai Exp $")
;;;
(in-package :pcl)
......@@ -710,10 +710,10 @@
;;; optional arguments
(defgeneric get-method (generic-function qualifiers specializers &optional (errorp t)))
(defgeneric get-method (generic-function qualifiers specializers &optional errorp))
; (standard-generic-function t t)
(defgeneric find-method (generic-function qualifiers specializers &optional (errorp t)))
(defgeneric find-method (generic-function qualifiers specializers &optional errorp))
; (standard-generic-function t t)
(defgeneric remove-named-method (generic-function-name argument-specifiers &optional extra))
......
......@@ -4,7 +4,7 @@
;;; the Public domain, and is provided 'as is'.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/gray-streams.lisp,v 1.7 2002/08/27 19:01:39 pmai Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/gray-streams.lisp,v 1.8 2002/10/09 14:19:11 pmai Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -240,7 +240,7 @@
(defmethod stream-start-line-p ((stream fundamental-character-output-stream))
(eql (stream-line-column stream) 0))
(defgeneric stream-write-string (stream string &optional (start 0) end)
(defgeneric stream-write-string (stream string &optional start end)
(:documentation
"This is used by WRITE-STRING. It writes the string to the stream,
optionally delimited by start and end, which default to 0 and NIL.
......
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