~mdw
/
sod
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
src/c-types-parse.lisp, src/c-types-proto.lisp: Some minor cleanups.
[sod]
/
src
/
c-types-proto.lisp
diff --git
a/src/c-types-proto.lisp
b/src/c-types-proto.lisp
index
9481a99
..
c8aa72e
100644
(file)
--- a/
src/c-types-proto.lisp
+++ b/
src/c-types-proto.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 Sens
i
ble 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
@@
-149,16
+149,14
@@
This function is suitable for use in `format's ~/.../ command."))
This function is suitable for use in `format's ~/.../ command."))
-(export '
expand-c-type-spec
)
+(export '
(expand-c-type-spec expand-c-type-form)
)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defgeneric expand-c-type-spec (spec)
(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)
(: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))))
(:method ((name (eql 'lisp)) tail)
`(progn ,@tail))))
@@
-168,12
+166,12
@@
(expand-c-type-spec spec))
(export 'define-c-type-syntax)
(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
"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)
(with-gensyms (head tail)
(multiple-value-bind (doc decls body) (parse-body body)
`(eval-when (:compile-toplevel :load-toplevel :execute)
@@
-181,7
+179,7
@@
,@doc
(destructuring-bind ,bvl ,tail
,@decls
,@doc
(destructuring-bind ,bvl ,tail
,@decls
-
,@body
))
+
(block ,name ,@body)
))
',name))))
(export 'c-type-alias)
',name))))
(export 'c-type-alias)
@@
-197,16
+195,18
@@
',aliases)))
(export 'defctype)
',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.
"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
(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)
(defparameter ,typevar ,(expand-c-type-spec value))
(eval-when (:compile-toplevel :load-toplevel :execute)
,@(mapcar (lambda (name)
@@
-239,11
+239,13
@@
;;; Function arguments.
(export '(argument argumentp make-argument argument-name argument-type))
;;; Function arguments.
(export '(argument argumentp make-argument argument-name argument-type))
-(defstruct (argument (:constructor make-argument (name type))
+(defstruct (argument (:constructor make-argument (name type
+ &aux (%type type)))
(:predicate argumentp))
"Simple structure representing a function argument."
(:predicate argumentp))
"Simple structure representing a function argument."
- name
- 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)
(export 'commentify-argument-name)
(defgeneric commentify-argument-name (name)
@@
-251,7
+253,7
@@
"Produce a `commentified' version of the argument.
The default behaviour is that temporary argument names are simply omitted
"Produce a `commentified' version of the argument.
The default behaviour is that temporary argument names are simply omitted
- (
NIL
is returned); otherwise, `/*...*/' markers are wrapped around the
+ (
nil
is returned); otherwise, `/*...*/' markers are wrapped around the
printable representation of the argument.")
(:method ((name null)) nil)
(:method ((name t)) (format nil "/*~A*/" name)))
printable representation of the argument.")
(:method ((name null)) nil)
(:method ((name t)) (format nil "/*~A*/" name)))