Code reorganisation.

darcs-hash:be8c8af8504b2ce63cde33a893542d3590abd703

7 files changed, 483 insertions, 490 deletions

diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 606c0c4..b22057f 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -163,7 +163,9 @@ an __exception__, you can simply send it the `self' message.
 
 (defun dealloc-obj-data (obj-data)
   (with-foreign-slots ((type data) obj-data obj-data)
-    (foreign-string-free type))
+    (when (and (pointerp type)
+               (not (null-pointer-p type)))
+      (foreign-string-free type)))
   (foreign-free obj-data))
 
 
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 176423c..bf80c30 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -1,26 +1,58 @@
 (in-package #:mulk.objective-cl)
 
 
-(pushnew
-  (merge-pathnames (make-pathname :directory '(:relative "Objective-C"
-                                                         "shared_obj")
-                                  :type ""
-                                  :name "")
-                   (asdf:component-pathname (asdf:find-system
-                                             '#:objective-cl)))
-   cffi:*foreign-library-directories*)
+(dolist (subdir '("shared_obj" "obj"))
+  (pushnew
+   (merge-pathnames (make-pathname :directory (list
+                                               :relative "Objective-C" subdir)
+                                   :type ""
+                                   :name "")
+                    (asdf:component-pathname (asdf:find-system
+                                              '#:objective-cl)))
+   cffi:*foreign-library-directories*))
 
 (define-foreign-library libobjcl
   (:unix (:or "libobjcl.so"
-              "libobjcl.so.0"))
+              "libobjcl.so.0"
+              "libobjcl.dylib"
+              "libobjcl.dylib.0"))
   (t (:default "libobjcl")))
 
 (use-foreign-library libobjcl)
 
 
-(defcfun ("objcl_initialise_runtime" initialise-runtime) :void)
-(setf (documentation #'initialise-runtime 'function)
-      "Initialise the Objective C runtime.
+(defcfun ("objcl_initialise_runtime" %initialise-runtime) :void)
+
+(defcfun ("objcl_shutdown_runtime" %shutdown-runtime) :void)
+
+(defcfun ("objcl_invoke_method"
+          %objcl-invoke-method) obj-data
+  (receiver obj-data)
+  (method-selector obj-data)
+  (argc :int)
+  &rest)
+
+(defcfun ("objcl_find_class" %objcl-find-class) :pointer
+  (class-name :string))
+
+(defcfun ("objcl_class_name" %objcl-class-name) :pointer
+  (class obj-data))
+
+(defcfun ("objcl_find_selector" %objcl-find-selector) :pointer
+  (selector-name :string))
+
+(defcfun ("objcl_selector_name" %objcl-selector-name) :pointer
+  (selector obj-data))
+
+(defcfun ("objcl_get_method_implementation"
+          %objcl-get-method-implementation)
+    :pointer
+  (object obj-data)
+  (selector obj-data))
+
+
+(defun initialise-runtime ()
+  "Initialise the Objective C runtime.
 
 ## Description:
 
@@ -41,12 +73,15 @@ before making any other Objective C calls.
 
 ## See also:
 
-  __shutdown-runtime__")
+  __shutdown-runtime__"
 
+  (when (zerop *runtime-initialisation-level*)
+    (%initialise-runtime))
+  (atomically (incf *runtime-initialisation-level*)))
 
-(defcfun ("objcl_shutdown_runtime" shutdown-runtime) :void)
-(setf (documentation #'shutdown-runtime 'function)
-      "Shut the Objective C runtime down.
+
+(defun shutdown-runtime ()
+  "Shut the Objective C runtime down.
 
 ## Description:
 
@@ -64,33 +99,10 @@ objects or classes, let alone send messages to them.
 
 ## See also:
 
-  __initialise-runtime__")
-
-
-(defcfun ("objcl_invoke_method"
-          %objcl-invoke-method) obj-data
-  (receiver obj-data)
-  (method-selector obj-data)
-  (argc :int)
-  &rest)
-
-(defcfun ("objcl_find_class" %objcl-find-class) :pointer
-  (class-name :string))
-
-(defcfun ("objcl_class_name" %objcl-class-name) :pointer
-  (class obj-data))
-
-(defcfun ("objcl_find_selector" %objcl-find-selector) :pointer
-  (selector-name :string))
-
-(defcfun ("objcl_selector_name" %objcl-selector-name) :pointer
-  (selector obj-data))
+  __initialise-runtime__"
 
-(defcfun ("objcl_get_method_implementation"
-          %objcl-get-method-implementation)
-    :pointer
-  (object obj-data)
-  (selector obj-data))
+  (when (zerop (atomically (decf *runtime-initialisation-level*)))
+    (%shutdown-runtime)))
 
 
 (declaim (ftype (function ((or string symbol) &optional t)
@@ -208,57 +220,6 @@ conventional case for namespace identifiers in Objective C."
     (%objcl-get-method-implementation obj-obj-data sel-obj-data)))
 
 
-(declaim (ftype (function ((or selector string list)) selector)
-                selector))
-(defun selector (designator)
-  "Convert an object into a selector.
-
-## Arguments and Values:
-
-*designator* --- a *selector designator*.
-
-
-## Description:
-
-*selector-designator* must be a valid *selector designator*, that is:
-either a __selector__ object or one of a **symbol**, a **string**, or a
-**list** of **symbol**s representing a __selector__.
-
-If *selector-designator* is a **string** or a **list** of **symbol**s,
-__find-selector__ is called and the value returned, except that if
-__find-selector__ returns __nil__, an **error** is **signal**ed.
-
-If *selector-designator* is a single **symbol**, it is treated as if it
-were a **list** whose **car** is the **symbol** and whose **cdr** is
-__nil__.
-
-If *selector-designator* is a __selector__, it is simply returned.
-
-
-## Examples:
-
-    (selector \"self\")       ;=> #<SELECTOR `self'>
-    (selector '(self))      ;=> #<SELECTOR `self'>
-    (selector 'self)        ;=> #<SELECTOR `self'>
-    (selector *)            ;=> #<SELECTOR `self'>
-
-    (selector 'selph)       ; error
-
-    (selector \"stringWithCString:encoding:\")
-      ;=> #<SELECTOR `stringWithCString:encoding:'>
-
-    (selector '(:string-with-c-string :encoding))
-      ;=> #<SELECTOR `stringWithCString:encoding:'>"
-
-  (etypecase designator
-    (selector designator)
-    (symbol (selector (list designator)))
-    ((or string list)
-     (or (find-selector designator)
-         (error "Could not find the selector designated by ~S."
-                designator)))))
-
-
 (declaim (ftype (function ((or selector string list)) (or null selector))
                 find-selector))
 (defun find-selector (selector-name)
@@ -314,3 +275,274 @@ by which __invoke__ converts its arguments into a *message name*.
     (string (find-selector-by-name selector-name))
     (list   (find-selector-by-name (symbol-list->message-name
                                     selector-name)))))
+
+
+;;; (@* "Low-level Data Conversion")
+(eval-when (:compile-toplevel :load-toplevel)
+  ;; In order to be able to dispatch over pointer types, we need to
+  ;; define an alias of the implementation's own pointer class.  Note
+  ;; that this may be T (in GNU CLISP, for example), so it's a good idea
+  ;; to use CHECK-TYPE in the method body.
+  (unless (find-class 'foreign-pointer nil)
+    (setf (find-class 'foreign-pointer nil)
+          (class-of (make-pointer 0))))
+  (deftype foreign-pointer ()
+    '(satisfies cffi:pointerp)))
+
+
+(declaim (ftype (function ((or selector string list)) selector)
+                selector))
+(defun selector (designator)
+  "Convert an object into a selector.
+
+## Arguments and Values:
+
+*designator* --- a *selector designator*.
+
+
+## Description:
+
+*selector-designator* must be a valid *selector designator*, that is:
+either a __selector__ object or one of a **symbol**, a **string**, or a
+**list** of **symbol**s representing a __selector__.
+
+If *selector-designator* is a **string** or a **list** of **symbol**s,
+__find-selector__ is called and the value returned, except that if
+__find-selector__ returns __nil__, an **error** is **signal**ed.
+
+If *selector-designator* is a single **symbol**, it is treated as if it
+were a **list** whose **car** is the **symbol** and whose **cdr** is
+__nil__.
+
+If *selector-designator* is a __selector__, it is simply returned.
+
+
+## Examples:
+
+    (selector \"self\")       ;=> #<SELECTOR `self'>
+    (selector '(self))      ;=> #<SELECTOR `self'>
+    (selector 'self)        ;=> #<SELECTOR `self'>
+    (selector *)            ;=> #<SELECTOR `self'>
+
+    (selector 'selph)       ; error
+
+    (selector \"stringWithCString:encoding:\")
+      ;=> #<SELECTOR `stringWithCString:encoding:'>
+
+    (selector '(:string-with-c-string :encoding))
+      ;=> #<SELECTOR `stringWithCString:encoding:'>"
+
+  (etypecase designator
+    (selector designator)
+    (symbol (selector (list designator)))
+    ((or string list)
+     (or (find-selector designator)
+         (error "Could not find the selector designated by ~S."
+                designator)))))
+
+
+(declaim (ftype (function (*)
+                          (values foreign-pointer &rest nil))
+                lisp->obj-data))
+(defun lisp->obj-data (value)
+  (let ((obj-data (foreign-alloc 'obj-data))
+        (type-name (lisp-value->type-name value)))
+    (with-foreign-slots ((type data) obj-data obj-data)
+      (setf (foreign-slot-value data
+                                'obj-data-union
+                                (type-name->slot-name type-name))
+            (typecase value
+              (symbol (selector value))
+              ((or id objc-class selector exception)
+               (pointer-to value))
+              (string (foreign-string-alloc value))
+              (otherwise value)))
+      (setf type
+            (foreign-string-alloc (type-name->type-id type-name))))
+    obj-data))
+
+
+(declaim (ftype (function (foreign-pointer)
+                          (values (or number string symbol selector id
+                                      objc-class boolean foreign-pointer)
+                                  &rest nil))
+                obj-data->lisp))
+(defun obj-data->lisp (obj-data)
+  (with-foreign-slots ((type data) obj-data obj-data)
+    (let* ((type-name (type-id->type-name (if (stringp type)
+                                              type
+                                              (foreign-string-to-lisp type))))
+           (lisp-type (type-name->lisp-type type-name))
+           (value     (if (eq 'void type-name)
+                          (values)
+                          (foreign-slot-value data
+                                              'obj-data-union
+                                              (type-name->slot-name type-name)))))
+      (case lisp-type
+        ((id objc-class selector exception)
+         (make-instance lisp-type :pointer value))
+        ((string) (foreign-string-to-lisp value))
+        (otherwise value)))))
+
+
+(declaim (ftype (function (foreign-pointer) (values string &rest nil))
+                foreign-string-to-lisp/dealloc))
+(defun foreign-string-to-lisp/dealloc (foreign-string)
+  "Convert a (possibly freshly allocated) C string into a Lisp string
+and free the C string afterwards."
+
+  (unwind-protect
+       (foreign-string-to-lisp foreign-string)
+    (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)
+                                   (#\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)))
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index 17c7cf3..83b062e 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -175,3 +175,144 @@ Returns: *result* --- the return value of the method invocation.
                              (not (lower-case-p (char method-name (length prefix))))))))))
     (or (method-name-starts-with "alloc")
         (method-name-starts-with "new"))))
+
+
+;;; (@* "High-level Data Conversion")
+(defgeneric ->id (x))
+(defgeneric ->class (x))
+(defgeneric ->integer (x))
+(defgeneric ->selector (x))
+(defgeneric ->exception (x))
+(defgeneric ->character (x))
+(defgeneric ->float (x))
+(defgeneric ->double (x))
+(defgeneric ->bool (x))
+(defgeneric ->string (x))
+(defgeneric ->pointer (x))
+
+
+(defmethod ->id ((x id))
+  x)
+
+(defmethod ->id ((x class))
+  (invoke x 'self))
+
+(defmethod ->id ((x exception))
+  (invoke x 'self))
+
+(defmethod ->id ((x integer))
+  (let ((id (invoke (find-class 'ns-number)
+                    :number-with-long x)))
+    (invoke id 'retain)
+    (invoke id 'autorelease)
+    id))
+
+(defmethod ->id ((x float))
+  (let ((id (invoke (find-class 'ns-number)
+                    :number-with-double x)))
+    (invoke id 'retain)
+    (invoke id 'autorelease)
+    id))
+
+(defmethod ->id ((x string))
+  (let ((id (invoke (find-class 'ns-string)
+                    :string-with-c-string x)))
+    (invoke id 'retain)
+    (invoke id 'autorelease)
+    id))
+
+
+(defmethod ->class ((x id))
+  (invoke x 'class))
+
+(defmethod ->class ((x exception))
+  (invoke x 'class))
+
+(defmethod ->class ((x class))
+  x)
+
+(defmethod ->class ((x string))
+  (find-objc-class x t))
+
+(defmethod ->class ((x symbol))
+  (find-objc-class x t))
+
+
+(defmethod ->integer ((x id))
+  (assert (objc-typep x 'ns-number))
+  (invoke x 'long-value))
+
+(defmethod ->integer ((x number))
+  (truncate x))
+
+(defmethod ->integer ((x null))
+  0)
+
+(defmethod ->integer ((x symbol))
+  (assert (eq 't x))
+  1)
+
+
+(defmethod ->selector ((x selector))
+  x)
+
+(defmethod ->selector ((x symbol))
+  (selector x))
+
+(defmethod ->selector ((x string))
+  (selector x))
+
+(defmethod ->selector ((x cons))
+  (selector x))
+
+
+(defmethod ->exception ((x exception))
+  x)
+
+
+(defmethod ->character ((x character))
+  x)
+
+(defmethod ->character ((x integer))
+  x)
+
+
+(defmethod ->float ((x number))
+  (float x))
+
+
+(defmethod ->double ((x number))
+  (float x))
+
+
+(defmethod ->bool ((x null))
+  x)
+
+(defmethod ->bool ((x symbol))
+  (assert (eq 't x))
+  x)
+
+(defmethod ->bool ((x integer))
+  x)
+
+
+(defmethod ->string ((x string))
+  x)
+
+(defmethod ->string ((x foreign-pointer))
+  (check-type x foreign-pointer)
+  x)
+
+
+(defmethod ->pointer ((x foreign-pointer))
+  (check-type x foreign-pointer)
+  x)
+
+(defmethod ->pointer ((x exception))
+  (pointer-to x))
+
+(defmethod ->pointer ((x c-pointer-wrapper))
+  (pointer-to x))
+
+(defmethod ->pointer ((x number))
+  (pointer-to (->id x)))
diff --git a/Lisp/parameters.lisp b/Lisp/parameters.lisp
index e9e3057..cd8890d 100644
--- a/Lisp/parameters.lisp
+++ b/Lisp/parameters.lisp
@@ -1,8 +1,10 @@
 (in-package #:mulk.objective-cl)
 
 
+(defvar *runtime-initialisation-level* 0)
+
 (defvar *skip-finalization*  nil)
-(defvar *skip-retaining*     nil)
+(defvar *skip-retaining* nil)
 
 (defvar *trace-method-calls* nil
   "Whether to print trace messages of all Objective C method calls.
diff --git a/Lisp/type-conversion.lisp b/Lisp/type-conversion.lisp
deleted file mode 100644
index d9a5431..0000000
--- a/Lisp/type-conversion.lisp
+++ /dev/null
@@ -1,391 +0,0 @@
-(in-package #:mulk.objective-cl)
-
-
-;;; (@* "Low-level Data Conversion")
-(declaim (ftype (function (*)
-                          (values foreign-pointer &rest nil))
-                obj-data->lisp))
-(defun lisp->obj-data (value)
-  (let ((obj-data (foreign-alloc 'obj-data))
-        (type-name (lisp-value->type-name value)))
-    (with-foreign-slots ((type data) obj-data obj-data)
-      (setf (foreign-slot-value data
-                                'obj-data-union
-                                (type-name->slot-name type-name))
-            (typecase value
-              (symbol (selector value))
-              ((or id objc-class selector exception)
-               (pointer-to value))
-              (string (foreign-string-alloc value))
-              (otherwise value)))
-      (setf type
-            (foreign-string-alloc (type-name->type-id type-name))))
-    obj-data))
-
-
-(declaim (ftype (function (foreign-pointer)
-                          (values (or number string symbol selector id
-                                      objc-class boolean foreign-pointer)
-                                  &rest nil))
-                obj-data->lisp))
-(defun obj-data->lisp (obj-data)
-  (with-foreign-slots ((type data) obj-data obj-data)
-    (let* ((type-name (type-id->type-name (foreign-string-to-lisp type)))
-           (lisp-type (type-name->lisp-type type-name))
-           (value     (if (eq 'void type-name)
-                          (values)
-                          (foreign-slot-value data
-                                              'obj-data-union
-                                              (type-name->slot-name type-name)))))
-      (case lisp-type
-        ((id objc-class selector exception)
-         (make-instance lisp-type :pointer value))
-        ((string) (foreign-string-to-lisp value))
-        (otherwise value)))))
-
-
-(defmacro with-foreign-conversion (bindings &body body)
-  `(with-foreign-objects
-       ,(mapcar #'(lambda (name-value-pair)
-                     (destructuring-bind (name value)
-                         name-value-pair
-                       `(,name (lisp->obj-data ,value))))
-                bindings)
-     ,@body))
-
-
-(defmacro with-foreign-objects (bindings &body body)
-  `(let ,(mapcar #'(lambda (name-value-pair)
-                     (destructuring-bind (name value)
-                         name-value-pair
-                       `(,name ,value)))
-                 bindings)
-     (unwind-protect
-          (progn ,@body)
-       ,@(mapcar #'(lambda (name-value-pair)
-                     `(dealloc-obj-data ,(first name-value-pair)))
-                 bindings))))
-
-
-(declaim (ftype (function (foreign-pointer) (values string &rest nil))
-                foreign-string-to-lisp/dealloc))
-(defun foreign-string-to-lisp/dealloc (foreign-string)
-  "Convert a (possibly freshly allocated) C string into a Lisp string
-and free the C string afterwards."
-
-  (unwind-protect
-       (foreign-string-to-lisp foreign-string)
-    (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)
-                                   (#\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)))
-
-
-;;; (@* "High-level Data Conversion")
-(eval-when (:compile-toplevel :load-toplevel)
-  ;; In order to be able to dispatch over pointer types, we need to
-  ;; define an alias of the implementation's own pointer class.  Note
-  ;; that this may be T (in GNU CLISP, for example), so it's a good idea
-  ;; to use CHECK-TYPE in the method body.
-  (unless (find-class 'foreign-pointer nil)
-    (setf (find-class 'foreign-pointer nil)
-          (class-of (make-pointer 0))))
-  (deftype foreign-pointer ()
-    '(satisfies cffi:pointerp)))
-
-
-(defun objc-typep (x class-designator)
-  (objc-eql (invoke x 'class)
-            (etypecase x
-              (class x)
-              (id (invoke x 'class))
-              ((or string symbol) (find-objc-class class-designator t)))))
-
-
-(defgeneric ->id (x))
-(defgeneric ->class (x))
-(defgeneric ->integer (x))
-(defgeneric ->selector (x))
-(defgeneric ->exception (x))
-(defgeneric ->character (x))
-(defgeneric ->float (x))
-(defgeneric ->double (x))
-(defgeneric ->bool (x))
-(defgeneric ->string (x))
-(defgeneric ->pointer (x))
-
-
-(defmethod ->id ((x id))
-  x)
-
-(defmethod ->id ((x class))
-  (invoke x 'self))
-
-(defmethod ->id ((x exception))
-  (invoke x 'self))
-
-(defmethod ->id ((x integer))
-  (let ((id (invoke (find-class 'ns-number)
-                    :number-with-long x)))
-    (invoke id 'retain)
-    (invoke id 'autorelease)
-    id))
-
-(defmethod ->id ((x float))
-  (let ((id (invoke (find-class 'ns-number)
-                    :number-with-double x)))
-    (invoke id 'retain)
-    (invoke id 'autorelease)
-    id))
-
-(defmethod ->id ((x string))
-  (let ((id (invoke (find-class 'ns-string)
-                    :string-with-c-string x)))
-    (invoke id 'retain)
-    (invoke id 'autorelease)
-    id))
-
-
-(defmethod ->class ((x id))
-  (invoke x 'class))
-
-(defmethod ->class ((x exception))
-  (invoke x 'class))
-
-(defmethod ->class ((x class))
-  x)
-
-(defmethod ->class ((x string))
-  (find-objc-class x t))
-
-(defmethod ->class ((x symbol))
-  (find-objc-class x t))
-
-
-(defmethod ->integer ((x id))
-  (assert (objc-typep x 'ns-number))
-  (invoke x 'long-value))
-
-(defmethod ->integer ((x number))
-  (truncate x))
-
-(defmethod ->integer ((x null))
-  0)
-
-(defmethod ->integer ((x symbol))
-  (assert (eq 't x))
-  1)
-
-
-(defmethod ->selector ((x selector))
-  x)
-
-(defmethod ->selector ((x symbol))
-  (selector x))
-
-(defmethod ->selector ((x string))
-  (selector x))
-
-(defmethod ->selector ((x cons))
-  (selector x))
-
-
-(defmethod ->exception ((x exception))
-  x)
-
-
-(defmethod ->character ((x character))
-  x)
-
-(defmethod ->character ((x integer))
-  x)
-
-
-(defmethod ->float ((x number))
-  (float x))
-
-
-(defmethod ->double ((x number))
-  (float x))
-
-
-(defmethod ->bool ((x null))
-  x)
-
-(defmethod ->bool ((x symbol))
-  (assert (eq 't x))
-  x)
-
-(defmethod ->bool ((x integer))
-  x)
-
-
-(defmethod ->string ((x string))
-  x)
-
-(defmethod ->string ((x foreign-pointer))
-  (check-type x foreign-pointer)
-  x)
-
-
-(defmethod ->pointer ((x foreign-pointer))
-  (check-type x foreign-pointer)
-  x)
-
-(defmethod ->pointer ((x exception))
-  (pointer-to x))
-
-(defmethod ->pointer ((x c-pointer-wrapper))
-  (pointer-to x))
-
-(defmethod ->pointer ((x number))
-  (pointer-to (->id x)))
diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp
index 3a8e5da..29efb60 100644
--- a/Lisp/utilities.lisp
+++ b/Lisp/utilities.lisp
@@ -22,6 +22,14 @@
                (invoke y :is-equal x)))))
 
 
+(defun objc-typep (x class-designator)
+  (objc-eql (invoke x 'class)
+            (etypecase x
+              (class x)
+              (id (invoke x 'class))
+              ((or string symbol) (find-objc-class class-designator t)))))
+
+
 (defmethod objc-eql (x y)
   (cl:eql x y))
 
diff --git a/objective-cl.asd b/objective-cl.asd
index 2fb6a25..a0772d0 100644
--- a/objective-cl.asd
+++ b/objective-cl.asd
@@ -11,12 +11,12 @@
                  (:file "data-types"         :depends-on ("defpackage"))
                  (:file "parameters"         :depends-on ("defpackage"))
                  (:file "name-conversion"    :depends-on ("defpackage"))
-                 (:file "type-conversion"    :depends-on ("defpackage"
-                                                          "data-types"))
                  (:file "libobjcl"           :depends-on ("defpackage"
+                                                          "constant-data"
                                                           "data-types"
                                                           "name-conversion"
-                                                          "type-conversion"))
+                                                          "internal-utilities"
+                                                          "parameters"))
                  (:file "utilities"          :depends-on ("defpackage"
                                                           "method-invocation"
                                                           "data-types"))
@@ -29,7 +29,6 @@
                                                           "parameters"))
                  (:file "method-invocation"  :depends-on ("defpackage"
                                                           "name-conversion"
-                                                          "type-conversion"
                                                           "libobjcl"
                                                           "internal-utilities"
                                                           "parameters"))