c-array-type class
c-enum-type class
c-function-arguments generic
+ c-function-keywords generic
c-function-type class
+ c-keyword-function-type class
c-pointer-type class
c-struct-type class
c-tagged-type-kind generic
make-c-tagged-type function
make-enum-type function
make-function-type function
+ make-keyword-function-type function
make-pointer-type function
make-simple-type function
make-struct-type function
make-union-type function
+ merge-keyword-lists function
cl:nil constant c-type parser
pointer c-type
pprint-argument-list function
c-types-proto.lisp
argument class
+ argument-default function
argument-name function
argument-type function
argumentp function
c-type
c-array-type
c-function-type
+ c-keyword-function-type
qualifiable-c-type
c-pointer-type
simple-c-type
c-fragment
c-function-arguments
c-function-type
+c-function-keywords
+ c-keyword-function-type
c-tagged-type-kind
c-enum-type
c-struct-type
c-array-type c-array-type
c-class-type c-class-type
c-function-type c-function-type
+ c-keyword-function-type c-keyword-function-type
c-pointer-type c-pointer-type
qualifiable-c-type qualifiable-c-type
simple-c-type simple-c-type
t t t
c-array-type t t
c-function-type t t
+ c-keyword-function-type t t
c-pointer-type t t
simple-c-type t t
tagged-c-type t t
aggregating-message t
basic-direct-method t
c-function-type t
+ c-keyword-function-type t
method-codegen t
module t
sequencer t
@|c-enum-type| \- \\
@|c-pointer-type| \- \\
@|c-array-type| \\
- @|c-function-type|
+ @|c-function-type| \\ \ind
+ @|c-keyword-function-type| \-
\end{tabbing}}
\caption{Classes representing C types}
\label{fig:codegen.c-types.classes}
not return nil.
\end{describe}
-\begin{describe}{fun}{make-argument @<name> @<c-type> @> @<argument>}
+\begin{describe}{fun}
+ {make-argument @<name> @<c-type> \&optional @<default> @> @<argument>}
Construct and a return a new @<argument> object. The argument has type
@<c-type>, which must be a @|c-type| object, and is named @<name>.
suitable for function definitions. If @<name> is not nil, then the
@<name>'s print representation, with @|*print-escape*| nil, is used as the
argument name.
+
+ A @<default> may be supplied. If the argument is used in a
+ keyword-argument list (e.g., in a \descref{c-keyword-function-type}
+ [object]{cls}), and the @<default> value is provided and non-nil, then its
+ (unescaped) printed representation is used to provide a default value if
+ the keyword argument is not supplied by the caller.
\end{describe}
\begin{describe*}
{\dhead{fun}{argument-name @<argument> @> @<name>}
- \dhead{fun}{argument-type @<argument> @> @<c-type>}}
- Accessor functions for @|argument| objects. They return the name (for
- @|argument-name|) or type (for @|argument-type|) from the object, as passed
- to @|make-argument|.
+ \dhead{fun}{argument-type @<argument> @> @<c-type>}
+ \dhead{fun}{argument-default @<argument> @> @<default>}}
+ Accessor functions for @|argument| objects. They return the appropriate
+ component of the object, as set by to @|make-argument|. The @<default> is
+ nil if no default was provided to @|make-argument|.
\end{describe*}
\begin{describe}{gf}
\end{prog}
\end{describe}
+\begin{describe}{cls}
+ {c-keyword-function-type (c-function-type)
+ \&key :subtype :arguments :keywords}
+ Represents `functions' which accept keyword arguments. Of course, actual C
+ functions can't accept keyword arguments directly, but this type is useful
+ for describing messages and methods which deal with keyword arguments.
+
+ An instance denotes the type of C function which accepts the position
+ argument list @<arguments>, and keyword arguments from the @<keywords>
+ list, and returns @<subtype>. Either or both of the @<arguments> and
+ @<keywords> lists may be empty. (It is important to note the distinction
+ between a function which doesn't accept keyword arguments, and one which
+ does but for which no keyword arguments are defined. In particular, the
+ latter function can be changed later to accept a keyword argument without
+ breaking compatibility with old code.) The @<arguments> and @<keywords>
+ lists must \emph{not} contain @|:ellipsis| markers: a function can accept
+ keywords, or a variable-length argument tail, but not both.
+
+ Keyword arguments may (but need not) have a \emph{default value} which is
+ supplied to the function body if the keyword is omitted.
+
+ Keyword functions are never considered to be the same as ordinary
+ functions. Two keyword function types are considered to be the same if
+ their return types are the same, and their positional argument lists consist of
+ arguments with the same type, in the same order: the keyword arguments
+ accepted by the functions is not significant.
+
+ Keyword functions are constructed using an extended version of the @|fun|
+ specifier used for ordinary C function types. The extended syntax is as
+ follows.
+ \begin{prog}
+ (fun \=@<return-type>
+ @{ (@<arg-name> @<arg-type>) @}^* \+ \\
+ @{ \=:keys @{ (@<kw-name> @<kw-type> @[@<kw-default>@]) @}^*
+ @[. @<form>@] @! \+ \\
+ . @<form> @}
+ \end{prog}
+ where either the symbol @|:keys| appears literally in the specifier, or the
+ @<form> evaluates to a list containing the symbol @|:keys|. (If neither of
+ these circumstances obtains, then the specifier constructs an ordinary
+ function type.)
+
+ See the description of \descref{c-function-type}{cls} for how a trailing
+ @<form> is handled.
+
+ The list of @<arg-name>s and @<arg-type>s describes the positional
+ arguments. The list of @<kw-name>s, @<kw-type>s and @<kw-defaults>s
+ describes the keyword arguments.
+\end{describe}
+
\begin{describe}{fun}
{make-function-type @<subtype> @<arguments> @> @<c-function-type>}
Construct and return a new function type, returning @<subtype> and
accepting the @<arguments>.
+
+ If the @<arguments> list contains a @|:keys| marker, then a
+ \descref{c-keyword-function-type}[object]{cls} is returned: those arguments
+ preceding the @|:keys| marker form the positional argument list, and those
+ following the marker form the list of keyword arguments.
+\end{describe}
+
+\begin{describe}{fun}
+ {make-keyword-function-type @<subtype> @<arguments> @<keywords>
+ \nlret @<c-keyword-function-type>}
+ Construct and return a new keyword-function type, returning @<subtype> and
+ accepting the @<arguments> and @<keywords>.
\end{describe}
\begin{describe}{gf}
original list is not modified, but may share structure with the new list.
\end{describe}
+\begin{describe}{fun}{merge-keyword-lists @<lists> @> @<list>}
+ Merge a number of keyword-argument lists together and return the result.
+
+ The @<lists> parameter is a list consisting of a number of @|(@<args>
+ . @<origin>)| pairs: in each pair, @<args> is a list of
+ \descref{argument}{cls} objects, and @<origin> is either nil or an object
+ whose printed representation describes the origin of the corresponding
+ @<args> list, suitable for inclusion in an error message.
+
+ The resulting list contains exactly one argument for each distinct argument
+ name appearing in the input @<lists>; this argument will contain the
+ default value from the earliest occurrence in the input @<lists> of an
+ argument with that name.
+
+ If the same name appears multiple times with different types, an error is
+ signalled quoting the name, conflicting types, and (if non-nil) the origins
+ of the offending argument objects.
+\end{describe}
+
\begin{describe}{fun}
{pprint-c-function-type @<return-type> @<stream>
@<print-args> @<print-kernel>}
(argument-type arg-b)))))
list-a list-b)))
+(defun fix-and-check-keyword-argument-list (list)
+ "Check the keyword argument LIST is valid; if so, fix it up and return it.
+
+ Check that the keyword arguments have distinct names. Fix the list up by
+ sorting it by keyword name."
+
+ (unless (every #'argumentp list)
+ (error "(INTERNAL) not an argument value"))
+
+ (let ((list (sort (copy-list list) #'string< :key #'argument-name)))
+ (do ((list (cdr list) (cdr list))
+ (this (car list) (car list))
+ (prev nil this))
+ ((endp list))
+ (when prev
+ (let ((this-name (argument-name this))
+ (prev-name (argument-name prev)))
+ (when (string= this-name prev-name)
+ (error "Duplicate keyword argument name `~A'." this-name)))))
+ list))
+
+(export 'merge-keyword-lists)
+(defun merge-keyword-lists (lists)
+ "Return the union of keyword argument lists.
+
+ The LISTS parameter consists of pairs (ARGS . WHAT), where ARGS is a list
+ of `argument' objects, and WHAT is either nil or a printable object
+ describing the origin of the corresponding argument list suitable for
+ quoting in an error message.
+
+ The resulting list contains exactly one argument for each distinct
+ argument name appearing in the input lists; this argument will contain the
+ default value corresponding to the name's earliest occurrence in the input
+ LISTS.
+
+ If the same name appears in multiple input lists with different types, an
+ error is signalled; this error will quote the origins of a representative
+ conflicting pair of arguments."
+
+ ;; The easy way through all of this is with a hash table mapping argument
+ ;; names to (ARGUMENT . WHAT) pairs.
+
+ (let ((argmap (make-hash-table :test #'equal)))
+
+ ;; Set up the table. When we find a duplicate, check that the types
+ ;; match.
+ (dolist (item lists)
+ (let ((args (car item))
+ (what (cdr item)))
+ (dolist (arg args)
+ (let* ((name (argument-name arg))
+ (other-item (gethash name argmap)))
+ (if (null other-item)
+ (setf (gethash name argmap) (cons arg what))
+ (let* ((type (argument-type arg))
+ (other (car other-item))
+ (other-type (argument-type other))
+ (other-what (cdr other-item)))
+ (unless (c-type-equal-p type other-type)
+ (error "Type mismatch for keyword argument `~A': ~
+ ~A~@[ (~A)~] doesn't match ~A~@[ (~A)~]."
+ name
+ type what
+ other-type other-what))))))))
+
+ ;; Now it's just a matter of picking the arguments out again.
+ (let ((result nil))
+ (maphash (lambda (name item)
+ (declare (ignore name))
+ (push (car item) result))
+ argmap)
+ (fix-and-check-keyword-argument-list result))))
+
;; Class definition.
(export '(c-function-type c-function-arguments))
nil
arguments))))
+(export '(c-keyword-function-type c-function-keywords))
+(defclass c-keyword-function-type (c-function-type)
+ ((keywords :initarg :keywords :type list
+ :reader c-function-keywords))
+ (:documentation
+ "C function types for `functions' which take keyword arguments."))
+
+(defmethod shared-initialize :after
+ ((type c-keyword-function-type) slot-names &key (keywords nil keysp))
+ (declare (ignore slot-names))
+ (when keysp
+ (setf (slot-value type 'keywords)
+ (fix-and-check-keyword-argument-list keywords))))
+
;; Constructor function.
(export 'make-function-type)
(defun make-function-type (subtype arguments)
- "Return a new function type, returning SUBTYPE and accepting ARGUMENTS."
- (make-instance 'c-function-type :subtype subtype
- :arguments arguments))
+ "Return a new function type, returning SUBTYPE and accepting ARGUMENTS.
+
+ As a helper for dealing with the S-expression syntax for keyword
+ functions, if ARGUMENTS has the form (ARGS ... :keys KEYWORDS ...)' then
+ return a keyword function with arguments (ARGS ...) and keywords (KEYWORDS
+ ...)."
+ (let ((split (member :keys arguments)))
+ (if split
+ (make-instance 'c-keyword-function-type
+ :subtype subtype
+ :arguments (ldiff arguments split)
+ :keywords (cdr split))
+ (make-instance 'c-function-type
+ :subtype subtype
+ :arguments arguments))))
+
+(export 'make-keyword-function-type)
+(defun make-keyword-function-type (subtype arguments keywords)
+ "Return a new keyword-function type, returning SUBTYPE and accepting
+ ARGUMENTS and KEYWORDS."
+ (make-instance 'c-keyword-function-type :subtype subtype
+ :arguments arguments :keywords keywords))
;; Comparison protocol.
(argument-lists-equal-p (c-function-arguments type-a)
(c-function-arguments type-b))))
+(defmethod c-type-equal-p and
+ ((type-a c-keyword-function-type) (type-b c-keyword-function-type))
+ ;; Actually, there's nothing to check here. I'm happy as long as both
+ ;; functions notionally accept keyword arguments.
+ t)
+
;; C syntax output protocol.
(export 'pprint-c-function-type)
(write-string "..." stream))
(argument
(pprint-logical-block (stream nil)
- (pprint-c-type (argument-type arg) stream
- (argument-name arg)))))))
+ (pprint-c-type (argument-type arg) stream (argument-name arg))
+ (let ((default (argument-default arg)))
+ (when default
+ (format stream " = ~2I~_~A" default))))))))
anyp))
(let ((void-arglist (list (make-argument nil c-type-void))))
(pprint-argument-list args stream))
kernel))))
+(defmethod pprint-c-type ((type c-keyword-function-type) stream kernel)
+ (let ((args (c-function-arguments type))
+ (keys (c-function-keywords type)))
+ (pprint-c-function-type (c-type-subtype type) stream
+ (lambda (stream)
+ (when (pprint-argument-list args stream)
+ (format stream ", ~_"))
+ (write-char #\? stream)
+ (pprint-argument-list keys stream))
+ kernel)))
+
;; S-expression notation protocol.
(defmethod print-c-type
FUN ~@_~:I~
~/sod:print-c-type/~:[~; ~]~:*~_~
~<~@{~:<~S ~@_~/sod:print-c-type/~:>~^ ~_~}~:>~
+ ~:[~2*~; ~_~S ~@_~<~@{~:<~S ~@_~/sod:print-c-type/~
+ ~@[ ~@_~S~]~:>~^ ~_~}~:>~]~
~:>"
(c-type-subtype type)
(mapcar (lambda (arg)
(if (eq arg :ellipsis) arg
(list (argument-name arg) (argument-type arg))))
- (c-function-arguments type))))
+ (c-function-arguments type))
+ (typep type 'c-keyword-function-type)
+ :keys
+ (and (typep type 'c-keyword-function-type)
+ (mapcar (lambda (arg)
+ (list (argument-name arg)
+ (argument-type arg)
+ (argument-default arg)))
+ (c-function-keywords type)))))
(export '(fun function () func fn))
(define-c-type-syntax fun (ret &rest args)
"Return the type of functions which returns RET and has arguments ARGS.
- The ARGS are a list of arguments of the form (NAME TYPE). The NAME can be
- NIL to indicate that no name was given.
+ The ARGS are a list of arguments of the form (NAME TYPE [DEFAULT]). The
+ NAME can be NIL to indicate that no name was given.
If an entry isn't a list, it's assumed to be the start of a Lisp
expression to compute the tail of the list; similarly, if the list is
`(make-function-type ,(expand-c-type-spec ret)
,(do ((args args (cdr args))
(list nil
- (cons `(make-argument ,(caar args)
- ,(expand-c-type-spec
- (cadar args)))
- list)))
- ((or (atom args) (atom (car args)))
+ (if (keywordp (car args))
+ (cons (car args) list)
+ (let* ((name (caar args))
+ (type (expand-c-type-spec
+ (cadar args)))
+ (default (and (cddar args)
+ (caddar args)))
+ (arg `(make-argument
+ ,name ,type ,default)))
+ (cons arg list)))))
+ ((or (atom args)
+ (and (atom (car args))
+ (not (keywordp (car args)))))
(cond ((and (null args) (null list)) `nil)
((null args) `(list ,@(nreverse list)))
- ((and (consp args)
- (eq (car args) :ellipsis))
- `(list ,@(nreverse list) :ellipsis))
((null list) `,args)
(t `(list* ,@(nreverse list) ,args)))))))
(c-type-alias fun function () func fn)
(mapcar (lambda (arg)
(if (eq arg :ellipsis) arg
(make-argument (commentify-argument-name (argument-name arg))
- (argument-type arg))))
+ (argument-type arg)
+ (argument-default arg))))
arguments))
(export 'commentify-function-type)
;;; `parse-declarator' will be of this form.
(export 'parse-declarator)
-(defun parse-declarator (scanner base-type &key kernel abstractp)
+(defun parse-declarator (scanner base-type &key kernel abstractp keywordp)
"Parse a C declarator, returning a pair (C-TYPE . NAME).
The SCANNER is a token scanner to read from. The BASE-TYPE is the type
defaults to matching a simple identifier `:id'. This might, e.g., be
(? :id) to parse an `abstract declarator' which has optional names.
+ If KEYWORDP is true, then a keyword argument list is permitted in
+ function declarations.
+
There's an annoying ambiguity in the syntax, if an empty KERNEL is
permitted. In this case, you must ensure that ABSTRACTP is true so that
the appropriate heuristic can be applied. As a convenience, if ABSTRACTP
'qualifier)))))))
(mapcar #'ds-label quals))))
+ (disallow-keyword-functions (type)
+ (when (typep type 'c-keyword-function-type)
+ (error "Functions with keyword arguments are only ~
+ allowed at top-level.")))
+
(star ()
;; Prefix: `*' qualifiers
(parse (seq (#\* (quals (qualifiers)))
(preop "*" (state 9)
(cons (lambda (type)
+ (disallow-keyword-functions type)
(funcall (car state)
(make-pointer-type type quals)))
(cdr state))))))
(parse (seq ((dtor (arg-decl t)))
(make-argument (cdr dtor) (car dtor)))))
+ (kw-argument ()
+ ;; kw-argument ::= type declspec [= c-fragment]
+
+ (parse (seq ((dtor (arg-decl nil))
+ (dflt (? (when (eq (token-type scanner) #\=)
+ (parse-delimited-fragment
+ scanner #\= '(#\, #\))
+ :keep-end t)))))
+ (make-argument (cdr dtor) (car dtor) dflt))))
+
(argument-list ()
;; argument-list ::=
;; [argument [`,' argument]* [`,' argument-tail]]
;; | argument-tail
;;
- ;; argument-tail ::= `...'
+ ;; argument-tail ::= `...' | keyword-tail
+ ;;
+ ;; keyword-tail ::= `?' [kw-argument [`,' kw-argument]*]
+ ;;
+ ;; kw-argument ::= argument [= c-fragment]
;;
;; The possibility of a trailing `,' `...' means that we
;; can't use the standard `list' parser. Note that, unlike
;; `real' C, we allow an ellipsis even if there are no
;; explicit arguments.
- (let ((args nil))
+ (let ((args nil)
+ (keys nil)
+ (keysp nil))
(loop
(when (eq (token-type scanner) :ellipsis)
(push :ellipsis args)
(scanner-step scanner)
(return))
+ (when (and keywordp (eq (token-type scanner) #\?))
+ (setf keysp t)
+ (scanner-step scanner)
+ (multiple-value-bind (arg winp consumedp)
+ (parse (list (:min 0) (kw-argument) #\,))
+ (declare (ignore consumedp))
+ (unless winp
+ (return-from argument-list (values arg nil t)))
+ (setf keys arg)
+ (return)))
(multiple-value-bind (arg winp consumedp)
(argument)
(unless winp
(unless (eq (token-type scanner) #\,)
(return))
(scanner-step scanner))
- (values (let ((rargs (nreverse args)))
- (lambda (ret)
- (make-function-type ret rargs)))
+ (values (let ((rargs (nreverse args))
+ (rkeys (nreverse keys)))
+ (if keysp
+ (lambda (ret)
+ (make-keyword-function-type
+ ret rargs rkeys))
+ (lambda (ret)
+ (make-function-type ret rargs))))
t
- args)))
+ (or args keysp))))
(postfix-lparen ()
;; Postfix: `(' argument-list `)'
(parse (seq (#\( (make (argument-list)) #\))
(postop "()" (state 10)
(cons (lambda (type)
+ (disallow-keyword-functions type)
(funcall (car state)
(funcall make type)))
(cdr state))))))
(parse (seq ((dims (list (:min 1) (dimension))))
(postop "[]" (state 10)
(cons (lambda (type)
+ (disallow-keyword-functions type)
(funcall (car state)
(make-array-type type dims)))
(cdr state)))))))
;;;--------------------------------------------------------------------------
;;; Function arguments.
-(export '(argument argumentp make-argument argument-name argument-type))
-(defstruct (argument (:constructor make-argument (name type
+(export '(argument argumentp make-argument
+ argument-name argument-type argument-default))
+(defstruct (argument (:constructor make-argument (name type &optional default
&aux (%type type)))
(:predicate argumentp))
"Simple structure representing a function argument."
(name nil :type t :read-only t)
- (%type nil :type c-type :read-only t))
+ (%type nil :type c-type :read-only t)
+ (default nil :type t :read-only t))
(define-access-wrapper argument-type argument-%type :read-only t)
(export 'commentify-argument-name)
~mdw / sod / commitdiff