From 2b699e8f4abc96ae57206250cf1e6e558089e2f7 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Thu, 4 Oct 2007 16:15:25 +0200
Subject: Move PARSE-TYPE into a new module, as it doesn't really belong to the
 Objective-C layer abstraction.

darcs-hash:6bd566547259dd8bef79dbb6afb71b22413485ec
---
 Lisp/libobjcl.lisp | 152 -----------------------------------------------------
 1 file changed, 152 deletions(-)

(limited to 'Lisp/libobjcl.lisp')

diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 92a3f16..eeb6d0d 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -497,158 +497,6 @@ If *selector-designator* is a __selector__, it is simply returned.
          (error (make-condition 'no-such-selector :designator designator))))))
 
 
-(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)
-                                   (#\R 'byref))))
-                  (and qualifier
-                       (incf string-position)
-                       (push qualifier qualifiers))))
-    (values (case init-char
-              ((#\{ #\()
-               (let* ((=-token (position #\= typestring :start start))
-                      (name-end (or =-token
-                                    ;; 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)))
-                      (struct-name (subseq typestring
-                                           (1+ string-position)
-                                           name-end)))
-                 (list* (ecase init-char
-                          (#\{ 'struct)
-                          (#\( 'union))
-                        (if =-token
-                            qualifiers
-                            (cons 'opaque qualifiers))
-                        struct-name
-                        (progn
-                          (setq string-position
-                                (if =-token
-                                    (1+ name-end) ; skip #\=
-                                    name-end))
-                          (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)))
-
-
 ;;;; (@* "Helper functions")
 (defun sizeof (typespec)
   (%objcl-sizeof-type typespec))
-- 
cgit v1.2.3