blob: 29169de04a66f345aa314b74861de72716cf955f (
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
124
125
126
127
128
129
|
(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")
(declaim (ftype (function (*) symbol) lisp-value->type-name))
(defun lisp-value->type-name (value)
(car (rassoc-if #'(lambda (type)
(typep value type))
*objcl-type-map*)))
(declaim (ftype (function (symbol) symbol) type-name->lisp-type))
(defun type-name->lisp-type (type-name)
(cdr (assoc type-name *objcl-type-map*)))
(declaim (ftype (function (symbol) symbol) type-name->slot-name))
(defun type-name->slot-name (type-name)
(cdr (assoc type-name *objcl-data-map*)))
(declaim (ftype (function (symbol) string) type-name->type-id))
(defun type-name->type-id (type-name)
(string (cdr (assoc type-name *objcl-api-type-names*))))
(declaim (ftype (function (string) symbol) type-id->type-name))
(defun type-id->type-name (type-id)
(car (rassoc (char type-id 0) *objcl-api-type-names*)))
(declaim (ftype (function (symbol) symbol) type-name->c-type))
(defun type-name->c-type (type-name)
(cdr (assoc type-name *objcl-c-type-map*)))
|
