From: Mark Wooding Date: Sun, 10 Jan 2016 13:51:04 +0000 (+0000) Subject: src/c-types-*.lisp: New type for functions which take keyword arguments. X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/commitdiff_plain/ced609b8c5cc865f25cf5cce91a3d7dc9c85bdee?hp=f450a3f29645da8e88213d865b9796567a381b9e src/c-types-*.lisp: New type for functions which take keyword arguments. This commit introduces a new `c-keyword-function-type', including printing and parsing the things, and some utilities for working with keyword argument lists (most notably merging them while providing useful diagnostics about type mismatches). This involves enhancing the `argument' type to include an optional default value. The surface syntax uses a `?' to separate the preceding mandatory positional arguments from the following optional keyword arguments. I'm not completely thrilled by this choice, but I can't see many better options. The corresponding use of a `:keys' marker in the S-expression syntax is also somewhat ugly (especially the way that `make-function- type' acts on it), but better choices seemed thin on the ground. An earlier experiment introduced a `keyword-argument' subclass, rather than enhancing the existing `argument' structure, but it made many things (e.g., commentifying argument lists) unnecessarily painful for little benefit -- especially when I realised that it's important to distinguish an ordinary function from one which notionally accepts keyword arguments but doesn't actually define any (yet). --- diff --git a/doc/SYMBOLS b/doc/SYMBOLS index eb668a8..0833022 100644 --- a/doc/SYMBOLS +++ b/doc/SYMBOLS @@ -22,7 +22,9 @@ c-types-impl.lisp 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 @@ -85,10 +87,12 @@ c-types-impl.lisp 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 @@ -144,6 +148,7 @@ c-types-parse.lisp c-types-proto.lisp argument class + argument-default function argument-name function argument-type function argumentp function @@ -602,6 +607,7 @@ cl:t c-type c-array-type c-function-type + c-keyword-function-type qualifiable-c-type c-pointer-type simple-c-type @@ -704,6 +710,8 @@ c-fragment-text 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 @@ -717,6 +725,7 @@ c-type-equal-p 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 @@ -1208,6 +1217,7 @@ pprint-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 @@ -1278,6 +1288,7 @@ cl:shared-initialize aggregating-message t basic-direct-method t c-function-type t + c-keyword-function-type t method-codegen t module t sequencer t diff --git a/doc/clang.tex b/doc/clang.tex index 26d5a4d..6f7e218 100644 --- a/doc/clang.tex +++ b/doc/clang.tex @@ -48,7 +48,8 @@ The class hierarchy is shown in~\xref{fig:codegen.c-types.classes}. @|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} @@ -623,7 +624,8 @@ function type is the type of the function's return value. not return nil. \end{describe} -\begin{describe}{fun}{make-argument @ @ @> @} +\begin{describe}{fun} + {make-argument @ @ \&optional @ @> @} Construct and a return a new @ object. The argument has type @, which must be a @|c-type| object, and is named @. @@ -632,14 +634,21 @@ function type is the type of the function's return value. suitable for function definitions. If @ is not nil, then the @'s print representation, with @|*print-escape*| nil, is used as the argument name. + + A @ 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 @ 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 @ @> @} - \dhead{fun}{argument-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 @ @> @} + \dhead{fun}{argument-default @ @> @}} + Accessor functions for @|argument| objects. They return the appropriate + component of the object, as set by to @|make-argument|. The @ is + nil if no default was provided to @|make-argument|. \end{describe*} \begin{describe}{gf} @@ -736,10 +745,72 @@ function type is the type of the function's return value. \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 @, and keyword arguments from the @ + list, and returns @. Either or both of the @ and + @ 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 @ and @ + 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 \=@ + @{ (@ @) @}^* \+ \\ + @{ \=:keys @{ (@ @ @[@@]) @}^* + @[. @
@] @! \+ \\ + . @ @} + \end{prog} + where either the symbol @|:keys| appears literally in the specifier, or the + @ 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 + @ is handled. + + The list of @s and @s describes the positional + arguments. The list of @s, @s and @s + describes the keyword arguments. +\end{describe} + \begin{describe}{fun} {make-function-type @ @ @> @} Construct and return a new function type, returning @ and accepting the @. + + If the @ 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 @ @ @ + \nlret @} + Construct and return a new keyword-function type, returning @ and + accepting the @ and @. \end{describe} \begin{describe}{gf} @@ -763,6 +834,25 @@ function type is the type of the function's return value. original list is not modified, but may share structure with the new list. \end{describe} +\begin{describe}{fun}{merge-keyword-lists @ @> @} + Merge a number of keyword-argument lists together and return the result. + + The @ parameter is a list consisting of a number of @|(@ + . @)| pairs: in each pair, @ is a list of + \descref{argument}{cls} objects, and @ is either nil or an object + whose printed representation describes the origin of the corresponding + @ list, suitable for inclusion in an error message. + + The resulting list contains exactly one argument for each distinct argument + name appearing in the input @; this argument will contain the + default value from the earliest occurrence in the input @ 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 @ @ @ @} diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp index 032e432..16351a3 100644 --- a/src/c-types-impl.lisp +++ b/src/c-types-impl.lisp @@ -416,6 +416,79 @@ (defun argument-lists-equal-p (list-a list-b) (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)) @@ -438,13 +511,46 @@ (defmethod shared-initialize :after 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. @@ -454,6 +560,12 @@ (defmethod c-type-equal-p and (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) @@ -496,8 +608,10 @@ (defun pprint-argument-list (args stream) (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)))) @@ -508,6 +622,17 @@ (defmethod pprint-c-type ((type c-function-type) stream kernel) (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 @@ -517,19 +642,29 @@ (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 @@ -547,16 +682,21 @@ (define-c-type-syntax fun (ret &rest args) `(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) @@ -572,7 +712,8 @@ (defun commentify-argument-names (arguments) (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) diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp index e1a7dcd..6a622b7 100644 --- a/src/c-types-parse.lisp +++ b/src/c-types-parse.lisp @@ -302,7 +302,7 @@ (defun parse-c-type (scanner) ;;; `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 @@ -315,6 +315,9 @@ (defun parse-declarator (scanner base-type &key kernel abstractp) 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 @@ -348,12 +351,18 @@ (defun parse-declarator (scanner base-type &key kernel 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)))))) @@ -405,24 +414,50 @@ (defun parse-declarator (scanner base-type &key kernel abstractp) (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 @@ -433,11 +468,16 @@ (defun parse-declarator (scanner base-type &key kernel abstractp) (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 `)' @@ -445,6 +485,7 @@ (defun parse-declarator (scanner base-type &key kernel abstractp) (parse (seq (#\( (make (argument-list)) #\)) (postop "()" (state 10) (cons (lambda (type) + (disallow-keyword-functions type) (funcall (car state) (funcall make type))) (cdr state)))))) @@ -462,6 +503,7 @@ (defun parse-declarator (scanner base-type &key kernel abstractp) (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))))))) diff --git a/src/c-types-proto.lisp b/src/c-types-proto.lisp index 55f2f31..9fe6126 100644 --- a/src/c-types-proto.lisp +++ b/src/c-types-proto.lisp @@ -240,13 +240,15 @@ (defun c-name-case (name) ;;;-------------------------------------------------------------------------- ;;; 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)