Refactor directory and source file layout.

darcs-hash:0eb031a60f3b86a678869960867410811ca5325c

1 files changed, 123 insertions, 0 deletions

diff --git a/Lisp/constant-data.lisp b/Lisp/constant-data.lisp
new file mode 100644
index 0000000..3d424f5
--- /dev/null
+++ b/Lisp/constant-data.lisp
@@ -0,0 +1,123 @@
+(in-package #:mulk.objective-cl)
+
+
+;;;; (@* "Constant accessors")
+(defun lisp-value->type-name (value)
+  (car (rassoc-if #'(lambda (type)
+                      (typep value type))
+                  *objcl-type-map*)))
+
+(defun type-name->lisp-type (type-name)
+  (cdr (assoc type-name *objcl-type-map*)))
+
+(defun type-name->slot-name (type-name)
+  (cdr (assoc type-name *objcl-data-map*)))
+
+(defun type-name->type-id (type-name)
+  (string (cdr (assoc type-name *objcl-api-type-names*))))
+
+(defun type-id->type-name (type-id)
+  (car (rassoc (char type-id 0) *objcl-api-type-names*)))
+
+(defun type-name->c-type (type-name)
+  (cdr (assoc type-name *objcl-c-type-map*)))
+
+
+;;;; (@* "The constant data")
+;;; Copied from objc-api.h
+;;; Probably ought to be generated by C code at initialisation time.
+(defparameter *objcl-api-type-names*
+  '((id       . #\@)
+    (class    . #\#)
+    (exc      . #\E)
+    (sel      . #\:)
+    (chr      . #\c)
+    (uchr     . #\C)
+    (sht      . #\s)
+    (usht     . #\S)
+    (int      . #\i)
+    (uint     . #\I)
+    (lng      . #\l)
+    (ulng     . #\L)
+    (lng-lng  . #\q)
+    (ulng-lng . #\Q)
+    (flt      . #\f)
+    (dbl      . #\d)
+    (bfld     . #\b)
+    (bool     . #\B)
+    (void     . #\v)
+    (undef    . #\?)
+    (ptr      . #\^)
+    (charptr  . #\*)
+    (atom     . #\%)
+    (ary-b    . #\[)
+    (ary-e    . #\])
+    (union-b  . #\()
+    (union-e  . #\))
+    (struct-b . #\{)
+    (struct-e . #\})
+    (vector   . #\!)
+    (complex  . #\j)))
+
+
+(defparameter *objcl-data-map*
+  '((id       . id-val)
+    (class    . class-val)
+    (exc      . exc-val)
+    (sel      . sel-val)
+    (chr      . char-val)
+    (uchr     . char-val)
+    (sht      . short-val)
+    (usht     . short-val)
+    (int      . int-val)
+    (uint     . int-val)
+    (lng      . long-val)
+    (ulng     . long-val)
+    (lng-lng  . long-long-val)
+    (ulng-lng . long-long-val)
+    (flt      . float-val)
+    (dbl      . double-val)
+    (bool     . bool-val)
+    (ptr      . ptr-val)
+    (charptr  . charptr-val)))
+
+
+(defparameter *objcl-type-map*
+  '((id       . objc-id)
+    (class    . objc-class)
+    (sel      . objc-selector)
+    (exc      . objc-exception)
+    (chr      . character)
+    (int      . integer)
+    (uint     . integer)
+    (lng      . integer)
+    (ulng     . integer)
+    (sht      . integer)
+    (usht     . integer)
+    (lng-lng  . integer)
+    (ulng-lng . integer)
+    (flt      . single-float)
+    (dbl      . double-float)
+    (bool     . boolean)
+    (ptr      . c-pointer)
+    (charptr  . string)))
+
+(defparameter *objcl-c-type-map*
+  '((id       . :pointer)
+    (class    . :pointer)
+    (sel      . :pointer)
+    (exc      . :pointer)
+    (chr      . :char)
+    (int      . :int)
+    (uint     . :unsigned-int)
+    (lng      . :long)
+    (ulng     . :unsigned-long)
+    (sht      . :short)
+    (usht     . :unsigned-short)
+    (lng-lng  . :long-long)
+    (ulng-lng . :unsigned-long-long)
+    (flt      . :float)
+    (dbl      . :double)
+    (bool     . :boolean)
+    (ptr      . :pointer)
+    (charptr  . :pointer)))