summaryrefslogtreecommitdiff
path: root/Lisp/constant-data.lisp
blob: 575d46e25eb7e2bb64c9c0ce2d3319d78a973b18 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(in-package #:mulk.objective-cl)


;;;; (@* "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       . id)
    (class    . objc-class)
    (sel      . selector)
    (exc      . 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)))


;;;; (@* "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*)))