diff options
Diffstat (limited to 'Lisp/type-conversion.lisp')
-rw-r--r-- | Lisp/type-conversion.lisp | 132 |
1 files changed, 132 insertions, 0 deletions
diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp index 858538b..05bb08e 100644 --- a/Lisp/type-conversion.lisp +++ b/Lisp/type-conversion.lisp @@ -78,6 +78,138 @@ and free the C string afterwards." (foreign-string-free foreign-string))) +(defun parse-typespec (typestring &optional (start 0)) + "Parse a typestring like \"@0:4{_NSRange=II}8\" into something like (ID ()). + +\"rn{_NSRange=II}8\" is parsed into (STRUCT (CONST IN) +\"_NSRange\" :INTEGER :INTEGER). + +Returns: (VALUES typespec byte-position string-position)" + + (let ((init-char (char typestring start)) + (string-position start) + (qualifiers (list))) + (loop do (setq init-char (char typestring string-position)) + while (let ((qualifier (case init-char + (#\r 'const) + (#\n 'in) + (#\N 'inout) + (#\o 'out) + (#\O 'bycopy) + (#\V 'oneway)))) + (and qualifier + (incf string-position) + (push qualifier qualifiers)))) + (values (case init-char + ((#\{ #\() + (let ((name-end (position #\= typestring :start start))) + (list* (ecase init-char + (#\{ 'struct) + (#\( 'union)) + qualifiers + (subseq typestring (1+ start) name-end) + (progn + (setq string-position (1+ name-end)) ; skip #\= + (loop until (char= (char typestring string-position) + (ecase init-char + (#\{ #\}) + (#\( #\)))) + collect (multiple-value-bind (typespec + byte-position + new-string-pos) + (parse-typespec + typestring + string-position) + (declare (ignore byte-position)) + (setq string-position new-string-pos) + typespec) + ;; Skip end marker (right brace/paren). + finally (incf string-position)))))) + (#\^ (list 'pointer + qualifiers + (multiple-value-bind (typespec byte-pos new-str-pos) + (parse-typespec typestring (1+ string-position)) + (declare (ignore byte-pos)) + (prog1 typespec + (setq string-position new-str-pos))))) + (#\[ (list 'array + qualifiers + (multiple-value-bind (count new-str-pos) + (parse-integer typestring + :start (1+ string-position) + :junk-allowed t) + (prog1 count + (setq string-position new-str-pos))) + (multiple-value-bind (typespec byte-pos new-str-pos) + (parse-typespec typestring string-position) + (declare (ignore byte-pos)) + ;; Skip end marker (right bracket). + (prog1 typespec + (setq string-position (1+ new-str-pos)))))) + (#\j + (list 'complex + qualifiers + (multiple-value-bind (typespec byte-pos new-str-pos) + (parse-typespec typestring (1+ string-position)) + (declare (ignore byte-pos)) + (prog1 typespec + (setq string-position new-str-pos))))) + (#\b + (let (bit-field-starting-pos + bit-field-typespec + bit-field-length + byte-position) + (multiple-value-setq (bit-field-starting-pos string-position) + (parse-integer typestring + :start (1+ string-position) + :junk-allowed t)) + (multiple-value-setq (bit-field-typespec + byte-position + string-position) + (parse-typespec typestring string-position)) + (multiple-value-setq (bit-field-length string-position) + (parse-integer typestring + :start string-position + :junk-allowed t)) + (list 'bit-field + qualifiers + bit-field-starting-pos + bit-field-length + bit-field-typespec))) + (otherwise + (prog1 (list (case init-char + (#\B :boolean) + (#\c :char) + (#\C :unsigned-char) + (#\s :short) + (#\S :unsigned-short) + (#\i :int) + (#\I :unsigned-int) + (#\l :long) + (#\L :unsigned-long) + (#\q :long-long) + (#\Q :unsigned-long-long) + (#\f :float) + (#\d :double) + (#\v :void) + (#\@ 'id) + (#\# 'objc-class) + (#\: 'selector) + (#\* :string) + (#\? :unknown)) + qualifiers) + (incf string-position)))) + #+(or) ; too greedy (=> bit-fields can't see their length!) + (multiple-value-bind (byte-position new-string-pos) + (parse-integer typestring + :start string-position + :junk-allowed t) + (setq string-position new-string-pos) + byte-position) + #-(or) nil + string-position))) + + ;;; (@* "High-level Data Conversion") (eval-when (:compile-toplevel :load-toplevel) ;; In order to be able to dispatch over pointer types, we need to |