diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-12 12:25:45 +0100 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2008-02-12 12:25:45 +0100 |
commit | 7a417274fbc5913ccc288f06842345ff494363df (patch) | |
tree | 36953a5480113a7d2b736ca9e6f4788f2022516b /Lisp/type-handling.lisp | |
parent | 5fb8580c2175923860dfae7ce9d7029453ca3fa3 (diff) |
Add function PRINT-TYPESPEC.
darcs-hash:8b64d370e2168812dfd3dea46c02fdffb8461252
Diffstat (limited to 'Lisp/type-handling.lisp')
-rw-r--r-- | Lisp/type-handling.lisp | 54 |
1 files changed, 53 insertions, 1 deletions
diff --git a/Lisp/type-handling.lisp b/Lisp/type-handling.lisp index 58adc7e..e4d15e1 100644 --- a/Lisp/type-handling.lisp +++ b/Lisp/type-handling.lisp @@ -220,4 +220,56 @@ Returns: (VALUES typespec byte-position string-position)" (setq string-position new-string-pos) byte-position) #-(or) nil - string-position)))
\ No newline at end of file + string-position))) + + +(defun print-typespec-to-string (typespec) + (with-output-to-string (out) + (print-typespec typespec out))) + + +(defun print-typespec (typespec &optional (stream *standard-output*)) + "Convert a TYPESPEC into a typestring and write the result to a STREAM." + (destructuring-bind (type-name modifiers &rest rest) + typespec + (dolist (modifier modifiers) + (format stream "~A" (ecase modifier + (const #\r) + (in #\n) + (inout #\N) + (out #\o) + (bycopy #\O) + (oneway #\V) + (byref #\R) + (opaque "")))) + (case type-name + ((struct union) (destructuring-bind (name . children) rest + (format stream "~C~A" + (ecase type-name + (struct #\{) + (union #\()) + name) + (unless (member 'opaque modifiers) + (format stream "=") + (dolist (child children) + (print-typespec child stream))) + (format stream "~C" (ecase type-name + (struct #\}) + (union #\)))))) + ((bit-field) (if (eq +runtime-type+ :gnu) + (destructuring-bind (alignment length . children) rest + (format stream "b~D" alignment) + (dolist (child children) + (print-typespec child stream)) + (format stream "~D" length)) + (destructuring-bind (alignment length . children) rest + (declare (ignore alignment children)) + (format stream "b~D" length)))) + ((array) (destructuring-bind (length . children) rest + (format stream "[~D" length) + (dolist (child children) + (print-typespec child stream)) + (format stream "]"))) + (t (format stream "~A" (typespec-name->type-id type-name)) + (dolist (child rest) + (print-typespec child stream)))))) |