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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
;;;; Objective-CL, an Objective-C bridge for Common Lisp.
;;;; Copyright (C) 2007 Matthias Andreas Benkard.
;;;;
;;;; This program is free software: you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License as
;;;; published by the Free Software Foundation, either version 3 of the
;;;; License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful, but
;;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program. If not, see
;;;; <http://www.gnu.org/licenses/>.
(in-package #:mulk.objective-cl)
;;;; (@* "Convenience types")
(deftype c-pointer ()
'(satisfies pointerp))
(deftype argument-number ()
`(integer 0 ,call-arguments-limit))
;;;; (@* "Foreign data types")
(defctype char-pointer :pointer)
;;;; (@* "Objective C object wrapper classes")
(defclass c-pointer-wrapper ()
((pointer :type c-pointer
:reader pointer-to
:initarg :pointer
:initform (cffi:null-pointer))))
(defclass selector (c-pointer-wrapper) ()
(:documentation "An Objective C method selector.
## Description:
Method selectors are Objective C's equivalent to what Common Lisp calls
**symbols**. Their use is restricted to retrieving methods by name.
__selector__ objects cannot be created by means of __make-instance__.
Use __find-selector__ instead.
## See also:
__find-selector__"))
(defclass id (c-pointer-wrapper) ()
(:documentation "An instance of an Objective C class.
## Description:
The class __id__ serves as a general-purpose container for all kinds of
Objective C objects that are instances of some Objective C class, that
is, neither primitive C values nor __selector__, __class__ or
__exception__ objects.
__id__ objects cannot be created by means of __make-instance__. Use
a suitable class method instead as you would in Objective C.
## Examples:
(invoke (find-objc-class 'ns-object)
'self)
;=> #<NSObject `NSObject' {16ECF598}>
(invoke (find-objc-class 'ns-string)
:string-with-c-string \"Mulk.\")
;=> #<GSCBufferString `Mulk.' {5B36087}>
(invoke (find-objc-class 'ns-string)
'new)
;=> #<GSCBufferString `' {FFFFFFE}>
## See also:
__invoke__, __invoke-by-name__, __exception__"))
(defclass objc-class (c-pointer-wrapper) ()
(:documentation ""))
(defclass objc-meta-class (c-pointer-wrapper)
((meta-class-for-class :type (or null id objc-class)
:initarg :meta-class-for-class
:reader meta-class-for-class))
(:documentation ""))
(define-condition exception (error)
((pointer :type c-pointer
:accessor pointer-to
:initarg :pointer))
(:report (lambda (condition stream)
(format stream
"The Objective C runtime has issued an exception of ~
type `~A'.~&~
Reason: ~A."
(invoke-by-name
(invoke-by-name condition "name")
"UTF8String")
(invoke-by-name
(invoke-by-name condition "reason")
"UTF8String"))))
(:documentation "The condition type for Objective C exceptions.
## Description:
Whenever an Objective C call made by means of __invoke__ or
__invoke-by-name__ raises an exception, the exception is propagated to
the Lisp side by being encapsulated in an __exception__ object and
signaled.
Note that it is currently impossible to directly extract the original
Objective C exception from an __exception__ object, although it might
arguably be desirable to do so. As __exception__ objects behave just
like __id__ objects in almost all circumstances, this is not much of a
problem, though. If you really do need an __id__ instance rather than
an __exception__, you can simply send it the `self' message.
## Examples:
\(With __install-reader-syntax__ enabled.)
(handler-case
[NSArray selph] ; oops, typo
(exception (e)
e))
;=> #<MULK.OBJECTIVE-CL:EXCEPTION NSInvalidArgumentException {1048D63}>
(class-of *)
;=> #<CONDITION-CLASS EXCEPTION>
(class-of [** self])
;=> #<STANDARD-CLASS ID>
## See also:
__id__"))
(defclass opaque-struct (c-pointer-wrapper)
((name :type (or null string)
:accessor struct-name
:initarg :name)))
(defclass tagged-struct (c-pointer-wrapper)
((name :type (or null string)
:accessor struct-name
:initarg :name)
(children :type list
:accessor struct-children
:initarg :children)))
(defclass opaque-union (c-pointer-wrapper)
((name :type (or null string)
:accessor struct-name
:initarg :name)))
(defclass tagged-union (c-pointer-wrapper)
((name :type (or null string)
:accessor struct-name
:initarg :name)
(children :type list
:accessor struct-children
:initarg :children)))
(defclass tagged-array (c-pointer-wrapper)
((element-type :type symbol
:accessor tagged-array-element-type
:initarg :element-type)))
(defgeneric type-info (thing))
(defmethod type-info ((thing opaque-struct))
(with-slots (name)
thing
(list* 'struct '(opaque) name)))
(defmethod type-info ((thing tagged-struct))
(with-slots (name children)
thing
(list* 'struct '() name (mapcar #'type-info children))))
(defgeneric objcl-eql (obj1 obj2))
(defmethod objcl-eql ((obj1 c-pointer-wrapper) (obj2 c-pointer-wrapper))
(pointer-eq (pointer-to obj1) (pointer-to obj2)))
(defmethod objcl-eql (obj1 obj2)
(eql obj1 obj2))
|
