src/c-types-proto.lisp, src/c-types-impl.lisp: Qualifier name protocol.

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

diff --git a/src/c-types-proto.lisp b/src/c-types-proto.lisp
index 713496211a154010d3c24c3ecc04d299678c1881..10573217ec4328273838029c6938ac927ae81190 100644 (file)
--- a/src/c-types-proto.lisp
+++ b/src/c-types-proto.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- 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
@@ -57,6 +57,16 @@ (defgeneric qualify-c-type (type qualifiers)
    The qualifiers of the returned type are the union of the requested
    QUALIFIERS and the qualifiers already applied to TYPE."))
 
+(export 'c-qualifier-keyword)
+(defgeneric c-qualifier-keyword (qualifier)
+  (:documentation "Return the C keyword for the QUALIFIER (a Lisp keyword).")
+  (:method ((qualifier symbol)) (string-downcase qualifier)))
+
+(export 'c-type-qualifier-keywords)
+(defun c-type-qualifier-keywords (c-type)
+  "Return the type's qualifiers, as a list of C keyword names."
+  (mapcar #'c-qualifier-keyword (c-type-qualifiers c-type)))
+
 (export 'c-type-subtype)
 (defgeneric c-type-subtype (type)
   (:documentation
@@ -152,13 +162,11 @@ (defgeneric print-c-type (stream type &optional colon atsign)
 (export '(expand-c-type-spec expand-c-type-form))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defgeneric expand-c-type-spec (spec)
-    (:documentation
-     "Expand SPEC into Lisp code to construct a C type.")
+    (:documentation "Expand SPEC into Lisp code to construct a C type.")
     (:method ((spec list))
       (expand-c-type-form (car spec) (cdr spec))))
   (defgeneric expand-c-type-form (head tail)
-    (:documentation
-     "Expand a C type list beginning with HEAD.")
+    (:documentation "Expand a C type list beginning with HEAD.")
     (:method ((name (eql 'lisp)) tail)
       `(progn ,@tail))))
 
@@ -168,12 +176,12 @@ (defmacro c-type (spec)
   (expand-c-type-spec spec))
 
 (export 'define-c-type-syntax)
-(defmacro define-c-type-syntax (name bvl &rest body)
+(defmacro define-c-type-syntax (name bvl &body body)
   "Define a C-type syntax function.
 
    A function defined by BODY and with lambda-list BVL is associated with the
-   NAME.  When `expand-c-type' sees a list (NAME . STUFF), it will call this
-   function with the argument list STUFF."
+   NAME.  When `expand-c-type-spec' sees a list (NAME . STUFF), it will call
+   this function with the argument list STUFF."
   (with-gensyms (head tail)
     (multiple-value-bind (doc decls body) (parse-body body)
       `(eval-when (:compile-toplevel :load-toplevel :execute)
@@ -197,16 +205,18 @@ (defmacro c-type-alias (original &rest aliases)
        ',aliases)))
 
 (export 'defctype)
-(defmacro defctype (names value)
+(defmacro defctype (names value &key export)
   "Define NAMES all to describe the C-type VALUE.
 
    NAMES can be a symbol (treated as a singleton list), or a list of symbols.
-   The VALUE is a C type S-expression, acceptable to `expand-c-type'.  It
-   will be expanded once at run-time."
+   The VALUE is a C type S-expression, acceptable to `expand-c-type-spec'.
+   It will be expanded once at run-time."
   (let* ((names (if (listp names) names (list names)))
         (namevar (gensym "NAME"))
         (typevar (symbolicate 'c-type- (car names))))
     `(progn
+       ,@(and export
+             `((export '(,typevar ,@names))))
        (defparameter ,typevar ,(expand-c-type-spec value))
        (eval-when (:compile-toplevel :load-toplevel :execute)
         ,@(mapcar (lambda (name)
@@ -243,9 +253,9 @@ (defstruct (argument (:constructor make-argument (name type
                                                  &aux (%type type)))
                     (:predicate argumentp))
   "Simple structure representing a function argument."
-  name
-  %type)
-(define-access-wrapper argument-type argument-%type)
+  (name nil :type t :read-only t)
+  (%type nil :type c-type :read-only t))
+(define-access-wrapper argument-type argument-%type :read-only t)
 
 (export 'commentify-argument-name)
 (defgeneric commentify-argument-name (name)