src/c-types-*.lisp: New type for functions which take keyword arguments.

[sod] / src / c-types-parse.lisp

diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp
index e1a7dcd..6a622b7 100644 (file)
--- a/src/c-types-parse.lisp
+++ b/src/c-types-parse.lisp
@@ -302,7 +302,7 @@
 ;;; `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 @@
    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 @@
                                                         '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 @@
                 (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 @@
                     (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 @@
                 (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 @@
                 (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)))))))