From e43d353268fc869045f757932d78d6073db9de6e Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Wed, 16 Dec 2015 06:15:06 +0000 Subject: [PATCH] src/c-types-{proto,impl}.lisp: Add `:export' parameter to `defctype'. Similar to `definst' (changed in 418752c), have `defctype' optionally export its type name and variable. Use this to (a) eliminate the enormous explicit export list, and (b) actually export the variable names. Also change `define-simple-c-type' to match. And document these changes. --- doc/SYMBOLS | 31 +++++++++++++++++++-- doc/clang.tex | 22 +++++++++++++-- doc/list-exports.lisp | 14 ++++++++++ src/c-types-impl.lisp | 75 +++++++++++++++++++++----------------------------- src/c-types-proto.lisp | 4 ++- 5 files changed, 96 insertions(+), 50 deletions(-) diff --git a/doc/SYMBOLS b/doc/SYMBOLS index 3243197..8ae77fe 100644 --- a/doc/SYMBOLS +++ b/doc/SYMBOLS @@ -17,6 +17,7 @@ c-types-class-impl.lisp c-types-impl.lisp cl:* variable function c-type cl:array class c-type + bool c-type c-array-dimensions generic c-array-type class c-enum-type class @@ -25,8 +26,34 @@ c-types-impl.lisp c-pointer-type class c-struct-type class c-tagged-type-kind generic + c-type-bool variable + c-type-char variable + c-type-double variable + c-type-double-complex variable + c-type-double-imaginary variable + c-type-float variable + c-type-float-complex variable + c-type-float-imaginary variable + c-type-int variable + c-type-long variable + c-type-long-double variable + c-type-long-double-complex variable + c-type-long-double-imaginary variable + c-type-long-long variable c-type-name generic + c-type-ptrdiff-t variable + c-type-short variable + c-type-signed-char variable + c-type-size-t variable c-type-tag generic + c-type-unsigned variable + c-type-unsigned-char variable + c-type-unsigned-long variable + c-type-unsigned-long-long variable + c-type-unsigned-short variable + c-type-va-list variable + c-type-void variable + c-type-wchar-t variable c-union-type class cl:char function setf c-type parser commentify-argument-names function @@ -855,7 +882,7 @@ expand-c-type-form (eql cl:function) t (eql cl:nil) t (eql cl:union) t - (eql sod::bool) t + (eql bool) t (eql double) t (eql double-complex) t (eql double-imaginary) t @@ -895,7 +922,7 @@ expand-c-type-spec (eql cl:float) (eql cl:schar) (eql cl:string) - (eql sod::bool) + (eql bool) (eql const-string) (eql double) (eql double-complex) diff --git a/doc/clang.tex b/doc/clang.tex index 8a1be72..e8bb1b5 100644 --- a/doc/clang.tex +++ b/doc/clang.tex @@ -120,8 +120,9 @@ type specifier. Type specifiers fit into two syntactic categories. \end{describe} \begin{describe}{mac} - {defctype @{ @ @! (@ @^*) @} @ - @> @} + {defctype \=@{ @ @! (@^+) @} @ \+ \\ + @[[ @|:export| @ @]]^* \- + \nlret @} Defines a new symbolic type specifier @; if a list of @s is given, then all are defined in the same way. The type constructed by using any of the @s is as described by the type specifier @. @@ -129,6 +130,13 @@ type specifier. Type specifiers fit into two syntactic categories. The resulting type object is constructed once, at the time that the macro expansion is evaluated; the same (@|eq|) value is used each time any @ is used in a type specifier. + + A variable named @|c-type-@|, for the first @ only, is defined + and initialized to contain the C type object so constructed. Altering or + binding this name is discouraged. + + If @ is true, then the variable name, and all of the @s, + are exported from the current package. \end{describe} \begin{describe}{mac}{c-type-alias @ @^* @> @} @@ -410,13 +418,21 @@ In Sod, the leaf types are \end{describe} \begin{describe}{mac} - {define-simple-c-type @{ @ @! (@^*) @} @ @> @} + {define-simple-c-type \=@{ @ @! (@^+) @} @ \+ \\ + @[[ @|:export| @ @]] \- + \nlret @} Define type specifiers for a new simple C type. Each symbol @ is defined as a symbolic type specifier for the (unique interned) simple C type whose name is the value of @. Further, each @ is defined to be a type operator: the type specifier @|(@ @^*)| evaluates to the (unique interned) simple C type whose name is @ and which has the @ (which are evaluated). + + Furthermore, a variable @|c-type-@| is defined, for the first @ + only, and initialized with the newly constructed C type object. + + If @ is true, then the @|c-type-@| variable name, and + all of the @s, are exported from the current package. \end{describe} \begin{describe}{cls}{tagged-c-type (qualifiable-c-type) diff --git a/doc/list-exports.lisp b/doc/list-exports.lisp index 7e5ea73..598d1c7 100644 --- a/doc/list-exports.lisp +++ b/doc/list-exports.lisp @@ -39,6 +39,20 @@ (symbolicate 'c- kind '-type) (symbolicate 'make- kind '-type)))) +(defmethod form-list-exports ((head (eql 'sod:defctype)) tail) + (destructuring-bind (names value &key export) tail + (declare (ignore value)) + (let ((names (if (listp names) names (list names)))) + (and export + (list* (symbolicate 'c-type- (car names)) names))))) + +(defmethod form-list-exports ((head (eql 'sod:define-simple-c-type)) tail) + (destructuring-bind (names type &key export) tail + (declare (ignore type)) + (let ((names (if (listp names) names (list names)))) + (and export + (list* (symbolicate 'c-type- (car names)) names))))) + (defmethod form-list-exports ((head (eql 'cl:macrolet)) tail) (mapcan #'form-exports (cdr tail))) diff --git a/src/c-types-impl.lisp b/src/c-types-impl.lisp index cea3057..9257bf2 100644 --- a/src/c-types-impl.lisp +++ b/src/c-types-impl.lisp @@ -130,74 +130,61 @@ `(make-simple-type ,head (list ,@tail)))) (export 'define-simple-c-type) -(defmacro define-simple-c-type (names type) +(defmacro define-simple-c-type (names type &key export) "Define each of NAMES to be a simple type called TYPE." (let ((names (if (listp names) names (list names)))) `(progn (setf (gethash ,type *simple-type-map*) ',(car names)) - (defctype ,names ,type) + (defctype ,names ,type :export ,export) (define-c-type-syntax ,(car names) (&rest quals) `(make-simple-type ,',type (list ,@quals)))))) ;; Built-in C types. -(export '(void - float double long-double - float-complex double-complex long-double-complex - float-imaginary double-imaginary long-double-imaginary - va-list size-t ptrdiff-t wchar-t - char unsigned-char uchar signed-char schar - int signed signed-int sint unsigned unsigned-int uint - short signed-short short-int signed-short-int sshort - unsigned-short unsigned-short-int ushort - long signed-long long-int signed-long-int slong - unsigned-long unsigned-long-int ulong - long-long signed-long-long long-long-int signed-long-long-int - unsigned-long-long unsigned-long-long-int llong sllong ullong)) - -(define-simple-c-type void "void") - -(define-simple-c-type char "char") -(define-simple-c-type (unsigned-char uchar) "unsigned char") -(define-simple-c-type (signed-char schar) "signed char") -(define-simple-c-type wchar-t "wchar-t") - -(define-simple-c-type (int signed signed-int sint) "int") -(define-simple-c-type (unsigned unsigned-int uint) "unsigned") +(define-simple-c-type void "void" :export t) + +(define-simple-c-type char "char" :export t) +(define-simple-c-type (unsigned-char uchar) "unsigned char" :export t) +(define-simple-c-type (signed-char schar) "signed char" :export t) +(define-simple-c-type wchar-t "wchar-t" :export t) + +(define-simple-c-type (int signed signed-int sint) "int" :export t) +(define-simple-c-type (unsigned unsigned-int uint) "unsigned" :export t) (define-simple-c-type (short signed-short short-int signed-short-int sshort) - "short") + "short" :export t) (define-simple-c-type (unsigned-short unsigned-short-int ushort) - "unsigned short") + "unsigned short" :export t) (define-simple-c-type (long signed-long long-int signed-long-int slong) - "long") + "long" :export t) (define-simple-c-type (unsigned-long unsigned-long-int ulong) - "unsigned long") + "unsigned long" :export t) (define-simple-c-type (long-long signed-long-long long-long-int signed-long-long-int llong sllong) - "long long") + "long long" :export t) (define-simple-c-type (unsigned-long-long unsigned-long-long-int ullong) - "unsigned long long") + "unsigned long long" :export t) -(define-simple-c-type float "float") -(define-simple-c-type double "double") -(define-simple-c-type long-double "long double") +(define-simple-c-type float "float" :export t) +(define-simple-c-type double "double" :export t) +(define-simple-c-type long-double "long double" :export t) -(define-simple-c-type bool "_Bool") +(define-simple-c-type bool "_Bool" :export t) -(define-simple-c-type float-complex "float _Complex") -(define-simple-c-type double-complex "double _Complex") -(define-simple-c-type long-double-complex "long double _Complex") +(define-simple-c-type float-complex "float _Complex" :export t) +(define-simple-c-type double-complex "double _Complex" :export t) +(define-simple-c-type long-double-complex "long double _Complex" :export t) -(define-simple-c-type float-imaginary "float _Imaginary") -(define-simple-c-type double-imaginary "double _Imaginary") -(define-simple-c-type long-double-imaginary "long double _Imaginary") +(define-simple-c-type float-imaginary "float _Imaginary" :export t) +(define-simple-c-type double-imaginary "double _Imaginary" :export t) +(define-simple-c-type long-double-imaginary + "long double _Imaginary" :export t) -(define-simple-c-type va-list "va_list") -(define-simple-c-type size-t "size_t") -(define-simple-c-type ptrdiff-t "ptrdiff_t") +(define-simple-c-type va-list "va_list" :export t) +(define-simple-c-type size-t "size_t" :export t) +(define-simple-c-type ptrdiff-t "ptrdiff_t" :export t) ;;;-------------------------------------------------------------------------- ;;; Tagged types (enums, structs and unions). diff --git a/src/c-types-proto.lisp b/src/c-types-proto.lisp index a13be4c..55f2f31 100644 --- a/src/c-types-proto.lisp +++ b/src/c-types-proto.lisp @@ -197,7 +197,7 @@ ',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. @@ -207,6 +207,8 @@ (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) -- 2.11.0