From d1b78ba4ce1d6da0873be4d16a95397660f578ad Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Mon, 4 Feb 2008 19:18:51 +0100 Subject: Add support for named struct members in typespecs. darcs-hash:8d0b9a343ce487267a739de81fd86aa3b78d103c --- Lisp/type-handling.lisp | 45 ++++++++++++++++++++++++++++++++------------- 1 file changed, 32 insertions(+), 13 deletions(-) (limited to 'Lisp') diff --git a/Lisp/type-handling.lisp b/Lisp/type-handling.lisp index 5b5292b..0d10560 100644 --- a/Lisp/type-handling.lisp +++ b/Lisp/type-handling.lisp @@ -24,6 +24,10 @@ \"rn{_NSRange=II}8\" is parsed into (STRUCT (CONST IN) \"_NSRange\" :INTEGER :INTEGER). +\"(sversion=\"version\"i\"next_free\"^v)\" is parsed into (UNION () +\"sversion\" (:INT ((NAME \"version\"))) (POINTER ((NAME +\"next_free\")) (:VOID ()))) + Returns: (VALUES typespec byte-position string-position)" (let ((init-char (char typestring start)) @@ -37,37 +41,52 @@ Returns: (VALUES typespec byte-position string-position)" (#\o 'out) (#\O 'bycopy) (#\V 'oneway) - (#\R 'byref)))) + (#\R 'byref) + (#\" 'name)))) (and qualifier (incf string-position) - (push qualifier qualifiers)))) + (if (eq qualifier 'name) + (let ((name-end (position #\" + typestring + :start string-position))) + (push (list qualifier + (subseq typestring + string-position + name-end)) + qualifiers) + (setf string-position (1+ name-end)) + qualifier) + (push qualifier qualifiers))))) (values (case init-char ((#\{ #\() (let* ((=-token (position #\= typestring :start start)) - (name-end (or =-token + (closing-delim (position (ecase init-char + (#\{ #\}) + (#\( #\))) + typestring + :start start)) + (name-end (if (and =-token closing-delim) + (min =-token closing-delim) ;; An opaque struct whose contents ;; we don't know. - (position (ecase init-char - (#\{ #\}) - (#\( #\))) - typestring - :start start) - (error "Premature end of file in~ - typespec: ~A." - typestring))) + (or closing-delim + (error "Premature end of file in~ + typespec: ~A." + typestring)))) + (named-p (and =-token (= name-end =-token))) (struct-name (subseq typestring (1+ string-position) name-end))) (list* (ecase init-char (#\{ 'struct) (#\( 'union)) - (if =-token + (if named-p qualifiers (cons 'opaque qualifiers)) struct-name (progn (setq string-position - (if =-token + (if named-p (1+ name-end) ; skip #\= name-end)) (loop until (char= (char typestring string-position) -- cgit v1.2.3