1 ! Copyright (C) 2006, 2008 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types alien.strings arrays assocs
4 combinators compiler hashtables kernel libc math namespaces
5 parser sequences words cocoa.messages cocoa.runtime
6 compiler.units io.encodings.ascii generalizations
10 : init-method ( method -- sel imp types )
12 [ sel_registerName ] [ execute ] [ ascii string>alien ]
15 : add-methods ( methods class -- )
17 [ init-method class_addMethod drop ] with each ;
19 : add-protocols ( protocols class -- )
20 swap [ objc-protocol class_addProtocol drop ] with each ;
22 : (define-objc-class) ( protocols superclass name imeth -- )
24 [ objc-class ] dip 0 objc_allocateClassPair
25 [ add-methods ] [ add-protocols ] [ objc_registerClassPair ]
28 : encode-types ( return types -- encoding )
30 alien>objc-types get at "0" append
33 : prepare-method ( ret types quot -- type imp )
34 >r [ encode-types ] 2keep r> [
35 "cdecl" swap 4array % \ alien-callback ,
36 ] [ ] make define-temp ;
38 : prepare-methods ( methods -- methods )
40 [ first4 prepare-method 3array ] map
41 ] with-compilation-unit ;
44 [ ascii alien>string ] bi@ = ;
46 : (verify-method-type) ( class sel types -- )
47 [ class_getInstanceMethod method_getTypeEncoding ]
49 [ "Objective-C method types cannot be changed once defined" throw ]
51 : verify-method-type ( class sel imp types -- class sel imp types )
52 4 ndup nip (verify-method-type) ;
54 : (redefine-objc-method) ( class method -- )
55 init-method ! verify-method-type
57 [ class_getInstanceMethod ] dip method_setImplementation drop ;
59 : redefine-objc-methods ( imeth name -- )
61 objc_getClass swap [ (redefine-objc-method) ] with each
70 : define-objc-class ( imeth hash -- )
73 +name+ get "cocoa.classes" create drop
74 +name+ get 2dup redefine-objc-methods swap [
75 +protocols+ get , +superclass+ get , +name+ get , ,
76 \ (define-objc-class) ,
77 ] [ ] make import-objc-class
81 parse-definition unclip
82 >hashtable define-objc-class ; parsing