blob: 7d973b76036344c02d98c559b521afa93107066c (
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
|
(in-package #:mulk.objective-cl)
;;;; (@* "Allocation Parameters")
(defconstant +pessimistic-allocation-type+
(loop with max-c-type = :char
for c-type in '(:pointer :int :long :float :double
#-cffi-features:no-long-long :long-long
#-cffi-features:no-long-long :unsigned-long-long
:unsigned-char :unsigned-int :unsigned-long
:short :unsigned-short)
when (> (cffi:foreign-type-size c-type)
(cffi:foreign-type-size max-c-type))
do (progn (setq max-c-type c-type))
finally (return max-c-type)))
(defconstant +pessimistic-allocation-size+
(cffi:foreign-type-size +pessimistic-allocation-type+))
;;;; (@* "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-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) string) type-name->type-id))
(defun type-name->type-id (type-name)
(string (cdr (assoc type-name *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*)))
|
