Permalink
Browse files

Groveler: fix priting of symbol names and docstrings

  • Loading branch information...
1 parent 2ea082b commit 7fc04ee606cf8cc5f43e7f05196a7b5c26cd187c @sionescu sionescu committed Jan 3, 2011
Showing with 35 additions and 32 deletions.
  1. +35 −32 grovel/grovel.lisp
View
@@ -36,6 +36,10 @@
(loop for s in strings
collect (string-trim '(#\Space #\Tab) s)))
+(defun string* (s)
+ "Coerce S to a string, making sure that it returns an extended string"
+ (map 'string #'identity (string s)))
+
;;;# Error Conditions
;;; This warning is signalled when cffi-grovel can't find some macro.
@@ -323,32 +327,35 @@ int main(int argc, char**argv) {
;;; This form also has some "read time" effects. See GENERATE-C-FILE.
(define-grovel-syntax in-package (name)
- (c-format out "(cl:in-package ~S)~%~%" (string name)))
+ (c-format out "(cl:in-package ~S)~%~%" (string* name)))
(define-grovel-syntax ctype (lisp-name c-name)
(c-section-header out "ctype" lisp-name)
(format out " CFFI_DEFCTYPE(~S, ~A);~%"
- (string lisp-name) c-name))
+ (string* lisp-name) c-name))
+
+(defun docstring-to-c (docstring)
+ (if docstring (format nil "~S" docstring) "NULL"))
(define-grovel-syntax constant ((lisp-name &rest c-names) &key documentation optional)
(c-section-header out "constant" lisp-name)
(loop :for i :from 0
:for c-name :in c-names :do
(format out "~A defined(~A)~%" (if (zerop i) "#if" "#elif") c-name)
- (format out " CFFI_DEFCONSTANT(~S, ~A, ~S);~%"
- (string lisp-name) c-name
- (or documentation 'null)))
+ (format out " CFFI_DEFCONSTANT(~S, ~A, ~A);~%"
+ (string* lisp-name) c-name
+ (docstring-to-c documentation)))
(unless optional
(format out "#else~% cffi_signal_missing_definition(output, ~S);~%"
- (string lisp-name)))
+ (string* lisp-name)))
(format out "#endif~%"))
(define-grovel-syntax cunion (union-lisp-name union-c-name &rest slots)
(let ((documentation (when (stringp (car slots)) (pop slots))))
(c-section-header out "cunion" union-lisp-name)
- (format out " CFFI_DEFCUNION_START(~S, ~A, ~S);~%"
- (string union-lisp-name) union-c-name
- (or documentation 'null))
+ (format out " CFFI_DEFCUNION_START(~S, ~A, ~A);~%"
+ (string* union-lisp-name) union-c-name
+ (docstring-to-c documentation))
(dolist (slot slots)
(destructuring-bind (slot-lisp-name slot-c-name &key type (count 1))
slot
@@ -363,7 +370,7 @@ int main(int argc, char**argv) {
(prin1-to-string slot-lisp-name) (prin1-to-string type) count)))))
(format out " CFFI_DEFCUNION_END;~%")
(format out " CFFI_DEFTYPESIZE(~S, ~A);~%"
- (string union-lisp-name) union-c-name)))
+ (string* union-lisp-name) union-c-name)))
(defun make-from-pointer-function-name (type-name)
(symbolicate '#:make- type-name '#:-from-pointer))
@@ -427,9 +434,9 @@ int main(int argc, char**argv) {
(define-grovel-syntax cstruct (struct-lisp-name struct-c-name &rest slots)
(let ((documentation (when (stringp (car slots)) (pop slots))))
(c-section-header out "cstruct" struct-lisp-name)
- (format out " CFFI_DEFCSTRUCT_START(~S, ~A, ~S);~%"
- (string struct-lisp-name) struct-c-name
- (or documentation 'null))
+ (format out " CFFI_DEFCSTRUCT_START(~S, ~A, ~A);~%"
+ (string* struct-lisp-name) struct-c-name
+ (docstring-to-c documentation))
(dolist (slot slots)
(destructuring-bind (slot-lisp-name slot-c-name &key type (count 1))
slot
@@ -444,7 +451,7 @@ int main(int argc, char**argv) {
(prin1-to-string slot-lisp-name) (prin1-to-string type) count)))))
(format out " CFFI_DEFCSTRUCT_END;~%")
(format out " CFFI_DEFTYPESIZE(~S, ~A);~%"
- (string struct-lisp-name) struct-c-name)))
+ (string* struct-lisp-name) struct-c-name)))
(defun foreign-name-to-symbol (s)
(intern (substitute #\- #\_ (string-upcase s))))
@@ -462,16 +469,16 @@ int main(int argc, char**argv) {
(destructuring-bind (name &key (base-type :int) define-constants)
(ensure-list name)
(c-section-header out "cenum" name)
- (format out " CFFI_DEFCENUM_START(~S, ~S, ~S);~%"
- (string name) (prin1-to-string base-type)
- (or documentation 'null))
+ (format out " CFFI_DEFCENUM_START(~S, ~S, ~A);~%"
+ (string* name) (prin1-to-string base-type)
+ (docstring-to-c documentation))
(dolist (enum enum-list)
(destructuring-bind (lisp-name c-name &key documentation)
enum
(check-type lisp-name keyword)
- (format out " CFFI_DEFCENUM_MEMBER(~S, ~A, ~S);~%"
+ (format out " CFFI_DEFCENUM_MEMBER(~S, ~A, ~A);~%"
(prin1-to-string lisp-name) c-name
- (or documentation 'null))))
+ (docstring-to-c documentation))))
(format out " CFFI_DEFCENUM_END;~%")
(when define-constants
(define-constants-from-enum out enum-list)))))
@@ -481,20 +488,20 @@ int main(int argc, char**argv) {
(destructuring-bind (name &key (base-type :int) define-constants)
(ensure-list name)
(c-section-header out "constantenum" name)
- (format out " CFFI_DEFCENUM_START(~S, ~S, ~S);~%"
- (string name) (prin1-to-string base-type)
- (or documentation 'null))
+ (format out " CFFI_DEFCENUM_START(~S, ~S, ~A);~%"
+ (string* name) (prin1-to-string base-type)
+ (docstring-to-c documentation))
(dolist (enum enum-list)
(destructuring-bind (lisp-name c-name &key documentation optional)
enum
(check-type lisp-name keyword)
(when optional
- (format out "#if defined(~S)\n" c-name))
- (format out " CFFI_DEFCENUM_MEMBER(~S, ~A, ~S);~%"
+ (format out "#if defined(~A)~%" c-name))
+ (format out " CFFI_DEFCENUM_MEMBER(~S, ~A, ~A);~%"
(prin1-to-string lisp-name) c-name
- (or documentation 'null))
+ (docstring-to-c documentation))
(when optional
- (format out "#endif\n"))))
+ (format out "#endif~%"))))
(format out " CFFI_DEFCENUM_END;~%")
(when define-constants
(define-constants-from-enum out enum-list)))))
@@ -641,10 +648,6 @@ int main(int argc, char**argv) {
(second typespec)
typespec))
-(defun symbol* (s)
- (check-type s (and symbol (not null)))
- s)
-
(define-wrapper-syntax defwrapper (name-and-options rettype &rest args)
(multiple-value-bind (lisp-name foreign-name options)
(cffi::parse-name-and-options name-and-options)
@@ -662,7 +665,7 @@ int main(int argc, char**argv) {
(push `(cffi:defcfun (,foreign-name-wrap ,lisp-name ,@options)
,(cffi-type rettype)
,@(mapcar (lambda (arg)
- (list (symbol* (first arg))
+ (list (cffi::lisp-name (first arg) nil)
(cffi-type (second arg))))
args))
*lisp-forms*))))
@@ -684,7 +687,7 @@ int main(int argc, char**argv) {
(push `(cffi:defcfun (,foreign-name-wrap ,lisp-name ,@options)
,(cffi-type rettype)
,@(mapcar (lambda (arg)
- (list (symbol* (first arg))
+ (list (cffi::lisp-name (first arg) nil)
(cffi-type (second arg))))
args))
*lisp-forms*))))

0 comments on commit 7fc04ee

Please sign in to comment.