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 eb668a81532a5f13d0b997cba6973821d961046d..0833022ee7dc092ebc0023066911e0accbf8c08b 100644 (file)
--- 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-array-type                                  class
   c-enum-type                                   class
   c-function-arguments                          generic

+  c-function-keywords                           generic

   c-function-type                               class
   c-function-type                               class

+  c-keyword-function-type                       class

   c-pointer-type                                class
   c-struct-type                                 class
   c-tagged-type-kind                            generic
   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-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
   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
   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
 
 c-types-proto.lisp
   argument                                      class

+  argument-default                              function

   argument-name                                 function
   argument-type                                 function
   argumentp                                     function
   argument-name                                 function
   argument-type                                 function
   argumentp                                     function


@@ -602,6 +607,7 @@ cl:t
       c-type
         c-array-type
         c-function-type
       c-type
         c-array-type
         c-function-type

+          c-keyword-function-type

         qualifiable-c-type
           c-pointer-type
           simple-c-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-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-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-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
   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
   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
   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
   aggregating-message t
   basic-direct-method t
   c-function-type t

+  c-keyword-function-type t

   method-codegen t
   module t
   sequencer t
   method-codegen t
   module t
   sequencer t

diff --git a/doc/clang.tex b/doc/clang.tex
index 26d5a4daff7aec37c0c7de99883484a4e41809c2..6f7e218d2abb09478fe0291ebf82c9b0065d4cd3 100644 (file)
--- 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-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}
   \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}
 
   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>.
 
   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>.
 


@@ -632,14 +634,21 @@ function type is the type of the function's return value.
   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.
   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>}
 \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{describe*}
 
 \begin{describe}{gf}


@@ -736,10 +745,72 @@ function type is the type of the function's return value.
   \end{prog}
 \end{describe}
 
   \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>.
 \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}
 \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}
 
   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>}
 \begin{describe}{fun}
     {pprint-c-function-type @<return-type> @<stream>
                             @<print-args> @<print-kernel>}

diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp
index 032e432534a0c5c6826ceaf3129d3e3ef1aabe29..16351a3a4d67679bd9416fc34188fb11121db41e 100644 (file)
--- 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)))
 
                                         (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))
 ;; Class definition.
 
 (export '(c-function-type c-function-arguments))


@@ -438,13 +511,46 @@ (defmethod shared-initialize :after
              nil
              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)
 ;; 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.
 
 
 ;; 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))))
 
        (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)
 ;; 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)
           (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))))
     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))))
 
                                (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
 ;; 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/~:>~^ ~_~}~:>~
                  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-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.
 
 
 (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
 
    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
   `(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)))
                             (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)
                                   ((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))
   (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)
          arguments))
 
 (export 'commentify-function-type)

diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp
index e1a7dcd0e8d55f1740c7bf400e1bbf6397f8326f..6a622b7d71e02e8680dc6edbb3c42f336e804870 100644 (file)
--- 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)
 ;;; `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
   "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.
 
    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
    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))))
 
                                                         '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)
               (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))))))
                                    (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)))))
 
                 (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-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.
 
                 ;;
                 ;; 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))
                   (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
                     (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))
                     (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
                           t

-                          args)))
+                          (or args keysp))))

 
               (postfix-lparen ()
                 ;; Postfix: `(' argument-list `)'
 
               (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)
                 (parse (seq (#\( (make (argument-list)) #\))
                          (postop "()" (state 10)
                            (cons (lambda (type)

+                                   (disallow-keyword-functions type)

                                    (funcall (car state)
                                             (funcall make type)))
                                  (cdr state))))))
                                    (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)
                 (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)))))))
                                    (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 55f2f3105953af203c3294cb0cd99c0e39d09cb7..9fe61267cb4d0b09a61744d4b38a2ada711a5882 100644 (file)
--- a/src/c-types-proto.lisp
+++ b/src/c-types-proto.lisp
@@ -240,13 +240,15 @@ (defun c-name-case (name)
 ;;;--------------------------------------------------------------------------
 ;;; Function arguments.
 
 ;;;--------------------------------------------------------------------------
 ;;; 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)
                                                  &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)
 (define-access-wrapper argument-type argument-%type :read-only t)
 
 (export 'commentify-argument-name)