STYLE: Explain how to indent lambda-lists.

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

diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp
index 94e8687..9c33672 100644 (file)
--- a/src/c-types-parse.lisp
+++ b/src/c-types-parse.lisp
@@ -89,8 +89,7 @@
 
 (defparameter *declspec-map*
   (let ((map (make-hash-table :test #'equal)))
 
 (defparameter *declspec-map*
   (let ((map (make-hash-table :test #'equal)))

-    (dolist (item '((type :void :char :int :float :double
-                         (:bool :compat "_Bool"))
+    (dolist (item '((type :char :int :float :double)

                    (complexity (:complex :compat "_Complex")
                                (:imaginary :compat "_Imaginary"))
                    ((type :taggedp t) :enum :struct :union)
                    (complexity (:complex :compat "_Complex")
                                (:imaginary :compat "_Imaginary"))
                    ((type :taggedp t) :enum :struct :union)


@@ -103,10 +102,8 @@
            (if (consp spec) spec (list spec)))
        (dolist (spec (cdr item))
          (destructuring-bind (label
            (if (consp spec) spec (list spec)))
        (dolist (spec (cdr item))
          (destructuring-bind (label

-                              &key
-                              (name (string-downcase label))
-                              compat
-                              (taggedp taggedp))
+                              &key (name (string-downcase label))
+                                   compat (taggedp taggedp))

              (if (consp spec) spec (list spec))
            (let ((ds (make-instance 'declspec
                                     :label label
              (if (consp spec) spec (list spec))
            (let ((ds (make-instance 'declspec
                                     :label label


@@ -258,9 +255,10 @@
   ;; Turns out to be easier to do this by hand.
   (let ((ds (and (eq (token-type scanner) :id)
                 (let ((kw (token-value scanner)))
   ;; Turns out to be easier to do this by hand.
   (let ((ds (and (eq (token-type scanner) :id)
                 (let ((kw (token-value scanner)))

-                  (or (and (boundp '*module-type-map*)
+                  (or (gethash kw *declspec-map*)
+                      (and (boundp '*module-type-map*)

                            (gethash kw *module-type-map*))
                            (gethash kw *module-type-map*))

-                      (gethash kw *declspec-map*))))))
+                      (find-simple-c-type kw))))))

     (cond ((or (not ds) (and predicate (not (funcall predicate ds))))
           (values (list indicator) nil nil))
          ((and (typep ds 'declspec) (ds-taggedp ds))
     (cond ((or (not ds) (and predicate (not (funcall predicate ds))))
           (values (list indicator) nil nil))
          ((and (typep ds 'declspec) (ds-taggedp ds))


@@ -288,6 +286,21 @@
                       #\))
                   (make-atomic-type (car subtype)))))))
 
                       #\))
                   (make-atomic-type (car subtype)))))))
 

+(define-pluggable-parser complex-declspec alignas (scanner)
+  ;; `alignas' `(' fragment `)'
+  ;; `_Alignas' `(' fragment `)'
+  (with-parser-context (token-scanner-context :scanner scanner)
+    (parse (peek (seq ((nil (or "alignas" "_Alignas"))
+                      (nil (lisp (values #\(
+                                         (eq (token-type scanner) #\()
+                                         nil)))
+                      (nil (commit))
+                      (frag (parse-delimited-fragment scanner #\( #\))))
+                  (make-instance 'storespec
+                                 :spec (make-instance
+                                        'alignas-storage-specifier
+                                        :alignment frag)))))))
+

 (defun scan-and-merge-declspec (scanner specs)
   "Scan a declaration specifier and merge it with SPECS.
 
 (defun scan-and-merge-declspec (scanner specs)
   "Scan a declaration specifier and merge it with SPECS.
 


@@ -335,7 +348,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


@@ -348,10 +361,23 @@
    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
    is true then `(? :id)' is used as the default KERNEL."
    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
    is true then `(? :id)' is used as the default KERNEL."

+
+  ;; This is a bit confusing.  This is a strangely-shaped operator grammer,
+  ;; which wouldn't be so bad, but the `values' being operated on are pairs
+  ;; of the form (FUNC . NAME).  The NAME is whatever the KERNEL parser
+  ;; produces as its result, and will be passed out unchanged.  The FUNC is a
+  ;; type-constructor function which will be eventually be applied to the
+  ;; input BASE-TYPE, but we can't calculate the actual result as we go along
+  ;; because of the rather annoying inside-out nature of the declarator
+  ;; syntax.
+

   (with-parser-context (token-scanner-context :scanner scanner)
     (let ((kernel-parser (cond (kernel kernel)
                               (abstractp (parser () (? :id)))
   (with-parser-context (token-scanner-context :scanner scanner)
     (let ((kernel-parser (cond (kernel kernel)
                               (abstractp (parser () (? :id)))


@@ -371,12 +397,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))))))


@@ -416,26 +448,64 @@
                 (parse (seq ((name (funcall kernel-parser)))
                          (cons #'identity name))))
 
                 (parse (seq ((name (funcall kernel-parser)))
                          (cons #'identity name))))
 

+              (arg-decl (abstractp)
+                (parse (seq ((base-type (parse-c-type scanner))
+                             (dtor (parse-declarator scanner base-type
+                                                     :abstractp abstractp)))
+                         dtor)))
+
+              (argument ()
+                ;; argument ::= type abstract-declspec
+
+                (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-list ::=
+                ;;     [argument [`,' argument]* [`,' 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)
                     (multiple-value-bind (arg winp consumedp)

-                        (parse (seq ((base-type (parse-c-type scanner))
-                                     (dtor (parse-declarator scanner
-                                                             base-type
-                                                             :abstractp t)))
-                                 (make-argument (cdr dtor) (car dtor))))
+                        (argument)

                       (unless winp
                         (if (or consumedp args)
                             (return-from argument-list (values arg nil t))
                       (unless winp
                         (if (or consumedp args)
                             (return-from argument-list (values arg nil t))


@@ -444,16 +514,26 @@
                     (unless (eq (token-type scanner) #\,)
                       (return))
                     (scanner-step scanner))
                     (unless (eq (token-type scanner) #\,)
                       (return))
                     (scanner-step scanner))

-                  (values (nreverse args) t args)))
+                  (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
+                          (or args keysp))))

 
               (postfix-lparen ()
                 ;; Postfix: `(' argument-list `)'
 
 
               (postfix-lparen ()
                 ;; Postfix: `(' argument-list `)'
 

-                (parse (seq (#\( (args (argument-list)) #\))
+                (parse (seq (#\( (make (argument-list)) #\))

                          (postop "()" (state 10)
                            (cons (lambda (type)
                          (postop "()" (state 10)
                            (cons (lambda (type)

+                                   (disallow-keyword-functions type)

                                    (funcall (car state)
                                    (funcall (car state)

-                                            (make-function-type type args)))
+                                            (funcall make type)))

                                  (cdr state))))))
 
               (dimension ()
                                  (cdr state))))))
 
               (dimension ()


@@ -469,6 +549,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)))))))