src/class-make-{proto,impl}.lisp: Don't always add initializers to classes.

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

diff --git a/src/c-types-parse.lisp b/src/c-types-parse.lisp
index 4a8e1d7..d0b3d41 100644 (file)
--- a/src/c-types-parse.lisp
+++ b/src/c-types-parse.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;

-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.

 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by


@@ -68,17 +68,17 @@
   ;; Despite the fact that it looks pretty trivial, this can't be done with
   ;; `defstruct' for the simple reason that we add more methods to the
   ;; accessor functions later.
   ;; Despite the fact that it looks pretty trivial, this can't be done with
   ;; `defstruct' for the simple reason that we add more methods to the
   ;; accessor functions later.

-  ((label :type keyword :initarg :label :reader ds-label)
+  ((%label :type keyword :initarg :label :reader ds-label)

    (name :type string :initarg :name :reader ds-name)
    (name :type string :initarg :name :reader ds-name)

-   (kind :type (member type sign size qualifier)
+   (kind :type (member %type complexity sign size qualifier %specs)

         :initarg :kind :reader ds-kind)
    (taggedp :type boolean :initarg :taggedp
            :initform nil :reader ds-taggedp))
   (:documentation
    "Represents the important components of a declaration specifier.
 
         :initarg :kind :reader ds-kind)
    (taggedp :type boolean :initarg :taggedp
            :initform nil :reader ds-taggedp))
   (:documentation
    "Represents the important components of a declaration specifier.
 

-    The only interesting instances of this class are in the table
-    `*declspec-map*'."))
+   The only interesting instances of this class are in the table
+   `*declspec-map*'."))

 
 (defmethod shared-initialize :after ((ds declspec) slot-names &key)
   "If no name is provided then derive one from the label.
 
 (defmethod shared-initialize :after ((ds declspec) slot-names &key)
   "If no name is provided then derive one from the label.


@@ -89,72 +89,87 @@
 
 (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)
+    (dolist (item '((%type :char :int :float :double)
+                   (complexity (:complex :compat "_Complex")
+                               (:imaginary :compat "_Imaginary"))

                    ((type :taggedp t) :enum :struct :union)
                    (size :short :long (:long-long :name "long long"))
                    (sign :signed :unsigned)
                    ((type :taggedp t) :enum :struct :union)
                    (size :short :long (:long-long :name "long long"))
                    (sign :signed :unsigned)

-                   (qualifier :const :restrict :volatile)))
+                   (qualifier :const :restrict :volatile
+                              (:atomic :compat "_Atomic"))))

       (destructuring-bind (kind &key (taggedp nil))
          (let ((spec (car item)))
            (if (consp spec) spec (list spec)))
        (dolist (spec (cdr item))
          (destructuring-bind (label
       (destructuring-bind (kind &key (taggedp nil))
          (let ((spec (car item)))
            (if (consp spec) spec (list spec)))
        (dolist (spec (cdr item))
          (destructuring-bind (label

-                              &key
-                              (name (string-downcase label))
-                              (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

-                                    :name name
+                                    :name (or compat name)

                                     :kind kind
                                     :taggedp taggedp)))
              (setf (gethash name map) ds
                                     :kind kind
                                     :taggedp taggedp)))
              (setf (gethash name map) ds

-                   (gethash label map) ds))))))
+                   (gethash label map) ds)
+             (when compat
+               (setf (gethash compat map) ds)))))))

     map)
   "Maps symbolic labels and textual names to `declspec' instances.")
 
     map)
   "Maps symbolic labels and textual names to `declspec' instances.")
 

+(defclass storespec ()
+  ((spec :initarg :spec :reader ds-spec))
+  (:documentation "Carrier for a storage specifier."))
+
+(defmethod ds-label ((spec storespec)) spec)
+(defmethod ds-kind ((spec storespec)) '%specs)
+
+(defmethod ds-label ((ty c-type)) :c-type)
+(defmethod ds-name ((ty c-type)) (princ-to-string ty))
+(defmethod ds-kind ((ty c-type)) '%type)
+

 ;; A collection of declaration specifiers, and how to merge them together.
 
 (defclass declspecs ()
   ;; This could have been done with `defstruct' just as well, but a
   ;; `defclass' can be tweaked interactively, which is a win at the moment.
 ;; A collection of declaration specifiers, and how to merge them together.
 
 (defclass declspecs ()
   ;; This could have been done with `defstruct' just as well, but a
   ;; `defclass' can be tweaked interactively, which is a win at the moment.

-  ((type :initform nil :initarg :type :reader ds-type)
+  ((%type :initform nil :initarg :type :reader ds-type)
+   (complexity :initform nil :initarg :complexity :reader ds-complexity)

    (sign :initform nil :initarg :sign :reader ds-sign)
    (size :initform nil :initarg :size :reader ds-size)
    (sign :initform nil :initarg :sign :reader ds-sign)
    (size :initform nil :initarg :size :reader ds-size)

+   (%specs :initform nil :initarg :specs :reader ds-specs)

    (qualifier :initform nil :initarg :qualifiers :reader ds-qualifiers))
    (qualifier :initform nil :initarg :qualifiers :reader ds-qualifiers))

-  (:documentation
-   "Represents a collection of declaration specifiers.
-
-    This is used during type parsing to represent the type under
-    construction.  Instances are immutable: we build new ones rather than
-    modifying existing ones.  This leads to a certain amount of churn, but
-    we'll just have to live with that.
+  (:documentation "Represents a collection of declaration specifiers.

 
 

-    (Why are instances immutable?  Because it's much easier to merge a new
-    specifier into an existing collection and then check that the resulting
-    thing is valid, rather than having to deal with all of the possible
-    special cases of what the new thing might be.  And if the merged
-    collection isn't good, I must roll back to the previous version.  So I
-    don't get to take advantage of a mutable structure.)"))
+   This is used during type parsing to represent the type under construction.
+   Instances are immutable: we build new ones rather than modifying existing
+   ones.  This leads to a certain amount of churn, but we'll just have to
+   live with that.

 
 

-(defmethod ds-label ((ty c-type)) :c-type)
-(defmethod ds-name ((ty c-type)) (princ-to-string ty))
-(defmethod ds-kind ((ty c-type)) 'type)
+   (Why are instances immutable?  Because it's much easier to merge a new
+   specifier into an existing collection and then check that the resulting
+   thing is valid, rather than having to deal with all of the possible
+   special cases of what the new thing might be.  And if the merged
+   collection isn't good, I must roll back to the previous version.  So I
+   don't get to take advantage of a mutable structure.)"))

 
 (defparameter *good-declspecs*
 
 (defparameter *good-declspecs*

-  '(((:int) (:signed :unsigned) (:short :long :long-long))
-    ((:char) (:signed :unsigned) ())
-    ((:double) () (:long))
-    (t () ()))
+  '(((:int) (:signed :unsigned) (:short :long :long-long) ())
+    ((:char) (:signed :unsigned) () ())
+    ((:double) () (:long) (:complex :imaginary))
+    (t () () ()))

   "List of good collections of declaration specifiers.
 
   "List of good collections of declaration specifiers.
 

-   Each item is a list of the form (TYPES SIGNS SIZES).  Each of TYPES, SIGNS
-   and SIZES is either a list of acceptable specifiers of the appropriate
-   kind, or T, which matches any specifier.")
+   Each item is a list of the form (TYPES SIGNS SIZES COMPLEXITIES).  Each of
+   TYPES, SIGNS, SIZES, and COMPLEXITIES, is either a list of acceptable
+   specifiers of the appropriate kind, or T, which matches any specifier.")

 
 (defun good-declspecs-p (specs)
   "Are SPECS a good collection of declaration specifiers?"
 
 (defun good-declspecs-p (specs)
   "Are SPECS a good collection of declaration specifiers?"

-  (let ((speclist (list (ds-type specs) (ds-sign specs) (ds-size specs))))
+  (let ((speclist (list (ds-type specs)
+                       (ds-sign specs)
+                       (ds-size specs)
+                       (ds-complexity specs))))

     (some (lambda (it)
            (every (lambda (spec pat)
                     (or (eq pat t) (null spec)
     (some (lambda (it)
            (every (lambda (spec pat)
                     (or (eq pat t) (null spec)


@@ -177,6 +192,7 @@
                      ((and (eq (ds-label old) :long) (eq ds old))
                       (values t (gethash :long-long *declspec-map*)))
                      (t (values nil nil))))
                      ((and (eq (ds-label old) :long) (eq ds old))
                       (values t (gethash :long-long *declspec-map*)))
                      (t (values nil nil))))

+         (specs (values t (adjoin (ds-spec ds) old)))

          (t (values (not old) ds)))
       (if ok
          (let ((copy (copy-instance specs)))
          (t (values (not old) ds)))
       (if ok
          (let ((copy (copy-instance specs)))


@@ -186,36 +202,46 @@
 
 (defun declspecs-type (specs)
   "Convert `declspecs' SPECS into a standalone C type object."
 
 (defun declspecs-type (specs)
   "Convert `declspecs' SPECS into a standalone C type object."

-  (let ((type (ds-type specs))
-       (size (ds-size specs))
-       (sign (ds-sign specs))
-       (quals (mapcar #'ds-label (ds-qualifiers specs))))
-    (cond ((typep type 'c-type)
-          (qualify-c-type type quals))
-         ((or type size sign)
-          (when (and sign (eq (ds-label sign) :signed)
-                     (eq (ds-label type) :int))
-            (setf sign nil))
-          (cond ((and (or (null type) (eq (ds-label type) :int))
-                      (or size sign))
-                 (setf type nil))
-                ((null type)
-                 (setf type (gethash :int *declspec-map*))))
-          (make-simple-type (format nil "~{~@[~A~^ ~]~}"
-                                    (mapcar #'ds-name
-                                            (remove nil
-                                                    (list sign size type))))
-                            quals))
-         (t
-          nil))))
+  (let* ((base-type (ds-type specs))
+        (size (ds-size specs))
+        (sign (ds-sign specs))
+        (cplx (ds-complexity specs))
+        (quals (mapcar #'ds-label (ds-qualifiers specs)))
+        (specs (ds-specs specs))
+        (type (cond ((typep base-type 'c-type)
+                     (qualify-c-type base-type quals))
+                    ((or base-type size sign cplx)
+                     (when (and sign (eq (ds-label sign) :signed)
+                                (eq (ds-label base-type) :int))
+                       (setf sign nil))
+                     (cond ((and (or (null base-type)
+                                     (eq (ds-label base-type) :int))
+                                 (or size sign))
+                            (setf base-type nil))
+                           ((null base-type)
+                            (setf base-type (gethash :int *declspec-map*))))
+                     (let* ((things (list sign cplx size base-type))
+                            (stripped (remove nil things))
+                            (names (mapcar #'ds-name stripped)))
+                       (make-simple-type (format nil "~{~A~^ ~}" names)
+                                         quals)))
+                    (t
+                     nil))))
+    (cond ((null type) nil)
+         ((null specs) type)
+         (t (make-storage-specifiers-type type specs)))))

 
 ;; Parsing declaration specifiers.
 
 (define-indicator :declspec "<declaration-specifier>")
 
 
 ;; Parsing declaration specifiers.
 
 (define-indicator :declspec "<declaration-specifier>")
 

-(defun scan-declspec
+(defun scan-simple-declspec

     (scanner &key (predicate (constantly t)) (indicator :declspec))
     (scanner &key (predicate (constantly t)) (indicator :declspec))

-  "Scan a `declspec' from SCANNER.
+  "Scan a simple `declspec' from SCANNER.
+
+   Simple declspecs are the ones defined in the `*declspec-map*' or
+   `*module-type-map*'.  This covers the remaining possibilities if the
+   `complex-declspec' pluggable parser didn't find anything to match.

 
    If PREDICATE is provided then only succeed if (funcall PREDICATE DECLSPEC)
    is true, where DECLSPEC is the raw declaration specifier or C-type object,
 
    If PREDICATE is provided then only succeed if (funcall PREDICATE DECLSPEC)
    is true, where DECLSPEC is the raw declaration specifier or C-type object,


@@ -229,11 +255,13 @@
   ;; 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 (gethash kw *module-type-map*)
-                      (gethash kw *declspec-map*))))))
+                  (or (gethash kw *declspec-map*)
+                      (and (boundp '*module-type-map*)
+                           (gethash kw *module-type-map*))
+                      (find-simple-c-type kw))))))

     (cond ((or (not ds) (and predicate (not (funcall predicate ds))))
           (values (list indicator) nil nil))
     (cond ((or (not ds) (and predicate (not (funcall predicate ds))))
           (values (list indicator) nil nil))

-         ((ds-taggedp ds)
+         ((and (typep ds 'declspec) (ds-taggedp ds))

           (scanner-step scanner)
           (if (eq (token-type scanner) :id)
               (let ((ty (make-c-tagged-type (ds-label ds)
           (scanner-step scanner)
           (if (eq (token-type scanner) :id)
               (let ((ty (make-c-tagged-type (ds-label ds)


@@ -245,6 +273,34 @@
           (scanner-step scanner)
           (values ds t t)))))
 
           (scanner-step scanner)
           (values ds t t)))))
 

+(define-pluggable-parser complex-declspec atomic-typepsec (scanner)
+  ;; `atomic' `(' type-name `)'
+  ;; `_Atomic' `(' type-name `)'
+  (with-parser-context (token-scanner-context :scanner scanner)
+    (parse (peek (seq ((nil (or "atomic" "_Atomic"))
+                      #\(
+                      (decls (parse-c-type scanner))
+                      (subtype (parse-declarator scanner decls
+                                                 :kernel (parse-empty)
+                                                 :abstractp t))
+                      #\))
+                  (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.
 


@@ -254,7 +310,9 @@
    SPECS."
 
   (with-parser-context (token-scanner-context :scanner scanner)
    SPECS."
 
   (with-parser-context (token-scanner-context :scanner scanner)

-    (if-parse (:consumedp consumedp) (scan-declspec scanner)
+    (if-parse (:consumedp consumedp)
+             (or (plug complex-declspec scanner)
+                 (scan-simple-declspec scanner))

       (aif (combine-declspec specs it)
           (values it t consumedp)
           (values (list :declspec) nil consumedp)))))
       (aif (combine-declspec specs it)
           (values it t consumedp)
           (values (list :declspec) nil consumedp)))))


@@ -290,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


@@ -303,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)))


@@ -317,7 +388,7 @@
 
                 (parse
                   (seq ((quals (list ()
 
                 (parse
                   (seq ((quals (list ()

-                                 (scan-declspec
+                                 (scan-simple-declspec

                                   scanner
                                   :indicator :qualifier
                                   :predicate (lambda (ds)
                                   scanner
                                   :indicator :qualifier
                                   :predicate (lambda (ds)


@@ -326,23 +397,34 @@
                                                         '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))))))
 

-              (next-declspec-p ()
-                ;; Ansert whether the next token is a valid declaration
-                ;; specifier, without consuming it.
-                (and (eq (token-type scanner) :id)
-                     (let ((id (token-value scanner)))
-                       (or (gethash id *module-type-map*)
-                           (gethash id *declspec-map*)))))
+              (predict-argument-list-p ()
+                ;; See `prefix-lparen'.  Predict an argument list rather
+                ;; than a nested declarator if (a) abstract declarators are
+                ;; permitted and (b) the next token is a declaration
+                ;; specifier or ellipsis.
+                (let ((type (token-type scanner))
+                      (value (token-value scanner)))
+                  (and abstractp
+                       (or (eq type :ellipsis)
+                           (and (eq type :id)
+                                (or (gethash value *module-type-map*)
+                                    (gethash value *declspec-map*)))))))

 
               (prefix-lparen ()
                 ;; Prefix: `('
 
               (prefix-lparen ()
                 ;; Prefix: `('


@@ -357,7 +439,7 @@
                 ;; specifier, then we have a postfix argument list.
                 (parse
                   (peek (seq (#\(
                 ;; specifier, then we have a postfix argument list.
                 (parse
                   (peek (seq (#\(

-                              (nil (if (and abstractp (next-declspec-p))
+                              (nil (if (predict-argument-list-p)

                                        (values nil nil nil)
                                        (values t t nil))))
                           (lparen #\))))))
                                        (values nil nil nil)
                                        (values t t nil))))
                           (lparen #\))))))


@@ -366,25 +448,92 @@
                 (parse (seq ((name (funcall kernel-parser)))
                          (cons #'identity name))))
 
                 (parse (seq ((name (funcall kernel-parser)))
                          (cons #'identity name))))
 

-              (argument-list ()
-                ;; [ argument [ `,' argument ]* ]
+              (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)))))

 
 

-                (parse (list (:min 0)
-                         (seq ((base-type (parse-c-type scanner))
-                               (dtor (parse-declarator scanner
-                                                       base-type
-                                                       :abstractp 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 ::= `...' | 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)
+                      (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
+                        (if (or consumedp args)
+                            (return-from argument-list (values arg nil t))
+                            (return)))
+                      (push arg args))
+                    (unless (eq (token-type scanner) #\,)
+                      (return))
+                    (scanner-step scanner))
+                  (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 ()


@@ -400,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)))))))


@@ -421,6 +571,9 @@
                              (or (postfix-lparen)
                                  (lbracket)
                                  (when nestedp (seq (#\)) (rparen #\))))))))
                              (or (postfix-lparen)
                                  (lbracket)
                                  (when nestedp (seq (#\)) (rparen #\))))))))

-                (cons (funcall (car value) base-type) (cdr value))))))))
+                (cons (wrap-c-type (lambda (type)
+                                     (funcall (car value) type))
+                                   base-type)
+                      (cdr value))))))))

 
 ;;;----- That's all, folks --------------------------------------------------
 
 ;;;----- That's all, folks --------------------------------------------------