From e7bf0c009de73957c86361038e33ea198480f6a3 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Sun, 7 Sep 2008 18:55:00 -0700
Subject: [PATCH 1/7] fix typo
---
basis/core-foundation/core-foundation.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/core-foundation/core-foundation.factor b/basis/core-foundation/core-foundation.factor
index 5c3ccf6c80..e51b19645a 100644
--- a/basis/core-foundation/core-foundation.factor
+++ b/basis/core-foundation/core-foundation.factor
@@ -137,7 +137,7 @@ M: f <CFNumber>
dup <CFBundle> [
CFBundleLoadExecutable drop
] [
- "Cannot load bundled named " prepend throw
+ "Cannot load bundle named " prepend throw
] ?if ;
TUPLE: CFRelease-destructor alien disposed ;
From 3c42ef1da6da1aa66c12142da643740f166c4b5a Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 8 Sep 2008 07:28:02 -0700
Subject: [PATCH 2/7] first crack at objc2 runtime. need to update type
encoding parsing and fix bug in CLASS: compilation
---
basis/cocoa/messages/messages.factor | 36 ++++----
basis/cocoa/runtime/runtime.factor | 72 +++++++---------
basis/cocoa/subclassing/subclassing.factor | 98 +++++++---------------
basis/ui/cocoa/views/views.factor | 1 -
4 files changed, 77 insertions(+), 130 deletions(-)
diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index ea7280b5a6..964bec3f5c 100755
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -4,7 +4,8 @@ USING: accessors alien alien.c-types alien.strings
arrays assocs combinators compiler kernel
math namespaces parser prettyprint prettyprint.sections
quotations sequences strings words cocoa.runtime io macros
-memoize debugger io.encodings.ascii effects compiler.generator ;
+memoize debugger io.encodings.ascii effects compiler.generator
+libc libc.private ;
IN: cocoa.messages
: make-sender ( method function -- quot )
@@ -36,7 +37,7 @@ super-message-senders global [ H{ } assoc-like ] change-at
: <super> ( receiver -- super )
"objc-super" <c-object> [
- >r dup objc-object-isa objc-class-super-class r>
+ >r dup object_getClass class_getSuperclass r>
set-objc-super-class
] keep
[ set-objc-super-receiver ] keep ;
@@ -101,10 +102,12 @@ MACRO: (send) ( selector super? -- quot )
: objc-meta-class ( string -- class )
\ objc_getMetaClass (objc-class) ;
+USE: prettyprint
+: (.) ( foo bar -- foo )
+ . dup . ;
+
: method-arg-type ( method i -- type )
- f <void*> 0 <int> over
- >r method_getArgumentInfo drop
- r> *void* ascii alien>string ;
+ method_copyArgumentType [ ascii alien>string ] keep (free) ;
SYMBOL: objc>alien-types
@@ -164,29 +167,20 @@ H{
[ method-arg-type parse-objc-type ] with map ;
: method-return-type ( method -- ctype )
- #! Undocumented hack! Apple does not support this feature!
- objc-method-types parse-objc-type ;
+ method_copyReturnType [ ascii alien>string ] keep (free) ;
: register-objc-method ( method -- )
dup method-return-type over method-arg-types 2array
dup cache-stubs
- swap objc-method-name sel_getName
+ swap method_getName sel_getName
objc-methods get set-at ;
-: method-list@ ( ptr -- ptr )
- "objc-method-list" heap-size swap <displaced-alien> ;
-
-: (register-objc-methods) ( objc-class iterator -- )
- 2dup class_nextMethodList [
- dup objc-method-list-count swap method-list@ [
- objc-method-nth register-objc-method
- ] curry each (register-objc-methods)
- ] [
- 2drop
- ] if* ;
+: (register-objc-methods) ( methods count -- methods )
+ over [ void*-nth register-objc-method ] curry each ;
: register-objc-methods ( class -- )
- f <void*> (register-objc-methods) ;
+ 0 <uint> [ class_copyMethodList ] keep *uint
+ (register-objc-methods) (free) ;
: class-exists? ( string -- class ) objc_getClass >boolean ;
@@ -209,4 +203,4 @@ H{
] curry try ;
: root-class ( class -- root )
- dup objc-class-super-class [ root-class ] [ ] ?if ;
+ dup class_getSuperclass [ root-class ] [ ] ?if ;
diff --git a/basis/cocoa/runtime/runtime.factor b/basis/cocoa/runtime/runtime.factor
index 7bfc31bc44..a553745919 100644
--- a/basis/cocoa/runtime/runtime.factor
+++ b/basis/cocoa/runtime/runtime.factor
@@ -13,9 +13,13 @@ FUNCTION: bool sel_isMapped ( SEL aSelector ) ;
FUNCTION: SEL sel_registerName ( char* str ) ;
+TYPEDEF: void* Class
+TYPEDEF: void* Method
+TYPEDEF: void* Protocol
+
C-STRUCT: objc-super
{ "id" "receiver" }
- { "void*" "class" } ;
+ { "Class" "class" } ;
: CLS_CLASS HEX: 1 ;
: CLS_META HEX: 2 ;
@@ -27,61 +31,47 @@ C-STRUCT: objc-super
: CLS_NEED_BIND HEX: 80 ;
: CLS_METHOD_ARRAY HEX: 100 ;
-C-STRUCT: objc-class
- { "void*" "isa" }
- { "void*" "super-class" }
- { "char*" "name" }
- { "long" "version" }
- { "long" "info" }
- { "long" "instance-size" }
- { "void*" "ivars" }
- { "void*" "methodLists" }
- { "void*" "cache" }
- { "void*" "protocols" } ;
-
-C-STRUCT: objc-object
- { "objc-class*" "isa" } ;
-
FUNCTION: int objc_getClassList ( void* buffer, int bufferLen ) ;
-FUNCTION: objc-class* objc_getClass ( char* class ) ;
+FUNCTION: Class objc_getClass ( char* class ) ;
-FUNCTION: objc-class* objc_getMetaClass ( char* class ) ;
+FUNCTION: Class objc_getMetaClass ( char* class ) ;
-FUNCTION: objc-class* objc_getProtocol ( char* class ) ;
+FUNCTION: Protocol objc_getProtocol ( char* class ) ;
-FUNCTION: void objc_addClass ( objc-class* class ) ;
+FUNCTION: Class objc_allocateClassPair ( Class superclass, char* name, size_t extraBytes ) ;
+FUNCTION: Class objc_registerClassPair ( Class cls ) ;
-FUNCTION: id class_createInstance ( objc-class* class, uint additionalByteCount ) ;
+FUNCTION: id class_createInstance ( Class class, uint additionalByteCount ) ;
-FUNCTION: id class_createInstanceFromZone ( objc-class* class, uint additionalByteCount, void* zone ) ;
+FUNCTION: id class_createInstanceFromZone ( Class class, uint additionalByteCount, void* zone ) ;
-C-STRUCT: objc-method
- { "SEL" "name" }
- { "char*" "types" }
- { "void*" "imp" } ;
+FUNCTION: Method class_getInstanceMethod ( Class class, SEL selector ) ;
-FUNCTION: objc-method* class_getInstanceMethod ( objc-class* class, SEL selector ) ;
+FUNCTION: Method class_getClassMethod ( Class class, SEL selector ) ;
-FUNCTION: objc-method* class_getClassMethod ( objc-class* class, SEL selector ) ;
+FUNCTION: Method* class_copyMethodList ( Class class, uint* outCount ) ;
-C-STRUCT: objc-method-list
- { "void*" "obsolete" }
- { "int" "count" } ;
+FUNCTION: Class class_getSuperclass ( Class cls ) ;
-FUNCTION: objc-method-list* class_nextMethodList ( objc-class* class, void** iterator ) ;
+FUNCTION: char class_addMethod ( Class class, SEL name, void* imp, void* types ) ;
-FUNCTION: void class_addMethods ( objc-class* class, objc-method-list* methodList ) ;
+FUNCTION: char class_addProtocol ( Class class, Protocol protocol ) ;
-FUNCTION: void class_removeMethods ( objc-class* class, objc-method-list* methodList ) ;
+FUNCTION: uint method_getNumberOfArguments ( Method method ) ;
-FUNCTION: uint method_getNumberOfArguments ( objc-method* method ) ;
+FUNCTION: uint method_getSizeOfArguments ( Method method ) ;
-FUNCTION: uint method_getSizeOfArguments ( objc-method* method ) ;
+FUNCTION: uint method_getArgumentInfo ( Method method, int argIndex, char** type, int* offset ) ;
-FUNCTION: uint method_getArgumentInfo ( objc-method* method, int argIndex, char** type, int* offset ) ;
+FUNCTION: void* method_copyReturnType ( Method method ) ;
-C-STRUCT: objc-protocol-list
- { "void*" "next" }
- { "int" "count" }
- { "objc-class*" "class" } ;
+FUNCTION: void* method_copyArgumentType ( Method method, uint index ) ;
+
+FUNCTION: void* method_getTypeEncoding ( Method method ) ;
+
+FUNCTION: SEL method_getName ( Method method ) ;
+
+FUNCTION: void* method_setImplementation ( Method method, void* imp ) ;
+
+FUNCTION: Class object_getClass ( id object ) ;
diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor
index 6b3e1d330e..dcd6ae4ad3 100755
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@ -3,78 +3,27 @@
USING: alien alien.c-types alien.strings arrays assocs
combinators compiler hashtables kernel libc math namespaces
parser sequences words cocoa.messages cocoa.runtime
-compiler.units io.encodings.ascii ;
+compiler.units io.encodings.ascii generalizations
+continuations ;
IN: cocoa.subclassing
-: init-method ( method alien -- )
- >r first3 r>
- [ >r execute r> set-objc-method-imp ] keep
- [ >r ascii malloc-string r> set-objc-method-types ] keep
- >r sel_registerName r> set-objc-method-name ;
+: init-method ( method -- sel imp types )
+ first3 swap
+ [ sel_registerName ] [ execute ] [ ascii string>alien ]
+ tri* ;
-: <empty-method-list> ( n -- alien )
- "objc-method-list" heap-size
- "objc-method" heap-size pick * + 1 calloc
- [ set-objc-method-list-count ] keep ;
+: add-methods ( methods class -- )
+ swap
+ [ init-method class_addMethod drop ] with each ;
-: <method-list> ( methods -- alien )
- dup length dup <empty-method-list> -rot
- [ pick method-list@ objc-method-nth init-method ] 2each ;
-
-: define-objc-methods ( class methods -- )
- <method-list> class_addMethods ;
-
-: <objc-class> ( name info -- class )
- "objc-class" malloc-object
- [ set-objc-class-info ] keep
- [ >r ascii malloc-string r> set-objc-class-name ] keep ;
-
-: <protocol-list> ( name -- protocol-list )
- "objc-protocol-list" malloc-object
- 1 over set-objc-protocol-list-count
- swap objc-protocol over set-objc-protocol-list-class ;
-
-! The Objective C object model is a bit funny.
-! Every class has a metaclass.
-
-! The superclass of the metaclass of X is the metaclass of the
-! superclass of X.
-
-! The metaclass of the metaclass of X is the metaclass of the
-! root class of X.
-: meta-meta-class ( class -- class ) root-class objc-class-isa ;
-
-: copy-instance-size ( class -- )
- dup objc-class-super-class objc-class-instance-size
- swap set-objc-class-instance-size ;
-
-: <meta-class> ( superclass name -- class )
- CLS_META <objc-class>
- [ >r dup objc-class-isa r> set-objc-class-super-class ] keep
- [ >r meta-meta-class r> set-objc-class-isa ] keep
- dup copy-instance-size ;
-
-: set-protocols ( protocols class -- )
- swap {
- { [ dup empty? ] [ 2drop ] }
- { [ dup length 1 = ] [
- first <protocol-list>
- swap set-objc-class-protocols
- ] }
- } cond ;
-
-: <new-class> ( protocols metaclass superclass name -- class )
- CLS_CLASS <objc-class>
- [ set-objc-class-super-class ] keep
- [ set-objc-class-isa ] keep
- [ set-protocols ] keep
- dup copy-instance-size ;
+: add-protocols ( protocols class -- )
+ swap [ objc-protocol class_addProtocol drop ] with each ;
: (define-objc-class) ( protocols superclass name imeth -- )
- >r
- >r objc-class r>
- [ <meta-class> ] 2keep <new-class> dup objc_addClass
- r> <method-list> class_addMethods ;
+ -rot
+ [ objc-class ] dip 0 objc_allocateClassPair
+ [ add-methods ] [ add-protocols ] [ objc_registerClassPair ]
+ tri ;
: encode-types ( return types -- encoding )
swap prefix [
@@ -91,9 +40,24 @@ IN: cocoa.subclassing
[ first4 prepare-method 3array ] map
] with-compilation-unit ;
+: types= ( a b -- ? )
+ [ ascii alien>string ] bi@ = ;
+
+: (verify-method-type) ( class sel types -- )
+ [ class_getInstanceMethod method_getTypeEncoding ]
+ dip types=
+ [ "Objective-C method types cannot be changed once defined" throw ]
+ unless ;
+: verify-method-type ( class sel imp types -- class sel imp types )
+ 4 ndup nip (verify-method-type) ;
+
+: (redefine-objc-method) ( class method -- )
+ init-method verify-method-type drop
+ [ class_getInstanceMethod ] dip method_setImplementation drop ;
+
: redefine-objc-methods ( imeth name -- )
dup class-exists? [
- objc_getClass swap define-objc-methods
+ objc_getClass swap [ (redefine-objc-method) ] with map
] [
2drop
] if ;
diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor
index 1dcb62bcd9..45ab8ac0ce 100755
--- a/basis/ui/cocoa/views/views.factor
+++ b/basis/ui/cocoa/views/views.factor
@@ -127,7 +127,6 @@ CLASS: {
{ +protocols+ { "NSTextInput" } }
}
-! Rendering
! Rendering
{ "drawRect:" "void" { "id" "SEL" "id" "NSRect" }
[ 3drop window relayout-1 ]
From 395879893418dba5a4e292c440a694491f14a786 Mon Sep 17 00:00:00 2001
From: "U-VICTORIA\\Administrator" <Administrator@victoria.(none)>
Date: Mon, 8 Sep 2008 17:38:00 -0700
Subject: [PATCH 3/7] i are good at the facterz. let me show u
---
basis/cocoa/messages/messages.factor | 10 +++++++---
basis/cocoa/subclassing/subclassing.factor | 2 +-
2 files changed, 8 insertions(+), 4 deletions(-)
diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index 964bec3f5c..413cab3b6d 100755
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -107,7 +107,9 @@ USE: prettyprint
. dup . ;
: method-arg-type ( method i -- type )
- method_copyArgumentType [ ascii alien>string ] keep (free) ;
+ method_copyArgumentType
+ [ ascii alien>string parse-objc-type ] keep
+ (free) ;
SYMBOL: objc>alien-types
@@ -164,10 +166,12 @@ H{
: method-arg-types ( method -- args )
dup method_getNumberOfArguments
- [ method-arg-type parse-objc-type ] with map ;
+ [ method-arg-type ] with map ;
: method-return-type ( method -- ctype )
- method_copyReturnType [ ascii alien>string ] keep (free) ;
+ method_copyReturnType
+ [ ascii alien>string parse-objc-type ] keep
+ (free) ;
: register-objc-method ( method -- )
dup method-return-type over method-arg-types 2array
diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor
index dcd6ae4ad3..45071f1cec 100755
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@ -57,7 +57,7 @@ IN: cocoa.subclassing
: redefine-objc-methods ( imeth name -- )
dup class-exists? [
- objc_getClass swap [ (redefine-objc-method) ] with map
+ objc_getClass swap [ (redefine-objc-method) ] with each
] [
2drop
] if ;
From 593f25fde4c14b5186f31d520d046b59cb62e04e Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 8 Sep 2008 22:09:05 -0700
Subject: [PATCH 4/7] clean up. disable method type verification for debugging
---
basis/cocoa/messages/messages.factor | 14 +++++---------
basis/cocoa/subclassing/subclassing.factor | 17 +++++++++--------
2 files changed, 14 insertions(+), 17 deletions(-)
diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index 413cab3b6d..ceb3a0021c 100755
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -102,15 +102,6 @@ MACRO: (send) ( selector super? -- quot )
: objc-meta-class ( string -- class )
\ objc_getMetaClass (objc-class) ;
-USE: prettyprint
-: (.) ( foo bar -- foo )
- . dup . ;
-
-: method-arg-type ( method i -- type )
- method_copyArgumentType
- [ ascii alien>string parse-objc-type ] keep
- (free) ;
-
SYMBOL: objc>alien-types
H{
@@ -164,6 +155,11 @@ H{
: parse-objc-type ( string -- ctype ) 0 swap (parse-objc-type) ;
+: method-arg-type ( method i -- type )
+ method_copyArgumentType
+ [ ascii alien>string parse-objc-type ] keep
+ (free) ;
+
: method-arg-types ( method -- args )
dup method_getNumberOfArguments
[ method-arg-type ] with map ;
diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor
index 45071f1cec..eb7cc60cca 100755
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@ -43,16 +43,17 @@ IN: cocoa.subclassing
: types= ( a b -- ? )
[ ascii alien>string ] bi@ = ;
-: (verify-method-type) ( class sel types -- )
- [ class_getInstanceMethod method_getTypeEncoding ]
- dip types=
- [ "Objective-C method types cannot be changed once defined" throw ]
- unless ;
-: verify-method-type ( class sel imp types -- class sel imp types )
- 4 ndup nip (verify-method-type) ;
+! : (verify-method-type) ( class sel types -- )
+! [ class_getInstanceMethod method_getTypeEncoding ]
+! dip types=
+! [ "Objective-C method types cannot be changed once defined" throw ]
+! unless ;
+! : verify-method-type ( class sel imp types -- class sel imp types )
+! 4 ndup nip (verify-method-type) ;
: (redefine-objc-method) ( class method -- )
- init-method verify-method-type drop
+ init-method ! verify-method-type
+ drop
[ class_getInstanceMethod ] dip method_setImplementation drop ;
: redefine-objc-methods ( imeth name -- )
From d4835de50bb721c75b69b391f04d187d9c5f93af Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 8 Sep 2008 22:32:19 -0700
Subject: [PATCH 5/7] disable method redefinition--is it really necessary when
the class is being redefined?
---
basis/cocoa/subclassing/subclassing.factor | 24 +++++++++++-----------
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor
index eb7cc60cca..59635f96df 100755
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@ -51,17 +51,17 @@ IN: cocoa.subclassing
! : verify-method-type ( class sel imp types -- class sel imp types )
! 4 ndup nip (verify-method-type) ;
-: (redefine-objc-method) ( class method -- )
- init-method ! verify-method-type
- drop
- [ class_getInstanceMethod ] dip method_setImplementation drop ;
-
-: redefine-objc-methods ( imeth name -- )
- dup class-exists? [
- objc_getClass swap [ (redefine-objc-method) ] with each
- ] [
- 2drop
- ] if ;
+! : (redefine-objc-method) ( class method -- )
+! init-method ! verify-method-type
+! drop
+! [ class_getInstanceMethod ] dip method_setImplementation drop ;
+!
+! : redefine-objc-methods ( imeth name -- )
+! dup class-exists? [
+! objc_getClass swap [ (redefine-objc-method) ] with each
+! ] [
+! 2drop
+! ] if ;
SYMBOL: +name+
SYMBOL: +protocols+
@@ -71,7 +71,7 @@ SYMBOL: +superclass+
clone [
prepare-methods
+name+ get "cocoa.classes" create drop
- +name+ get 2dup redefine-objc-methods swap [
+ +name+ get swap [
+protocols+ get , +superclass+ get , +name+ get , ,
\ (define-objc-class) ,
] [ ] make import-objc-class
From d0281c58d11675f284061f3fa7eaa8d206953b86 Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 8 Sep 2008 22:47:20 -0700
Subject: [PATCH 6/7] it's always the line you least expect
---
basis/cocoa/runtime/runtime.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/basis/cocoa/runtime/runtime.factor b/basis/cocoa/runtime/runtime.factor
index a553745919..3451ce5e6e 100644
--- a/basis/cocoa/runtime/runtime.factor
+++ b/basis/cocoa/runtime/runtime.factor
@@ -40,7 +40,7 @@ FUNCTION: Class objc_getMetaClass ( char* class ) ;
FUNCTION: Protocol objc_getProtocol ( char* class ) ;
FUNCTION: Class objc_allocateClassPair ( Class superclass, char* name, size_t extraBytes ) ;
-FUNCTION: Class objc_registerClassPair ( Class cls ) ;
+FUNCTION: void objc_registerClassPair ( Class cls ) ;
FUNCTION: id class_createInstance ( Class class, uint additionalByteCount ) ;
From fddcd3d475ca0d05f23ee4f2d1208908e0adcdcd Mon Sep 17 00:00:00 2001
From: Joe Groff <arcata@gmail.com>
Date: Mon, 8 Sep 2008 22:53:22 -0700
Subject: [PATCH 7/7] bring back method redefinition
---
basis/cocoa/subclassing/subclassing.factor | 38 +++++++++++-----------
1 file changed, 19 insertions(+), 19 deletions(-)
diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor
index 59635f96df..1ee39c35d5 100755
--- a/basis/cocoa/subclassing/subclassing.factor
+++ b/basis/cocoa/subclassing/subclassing.factor
@@ -43,25 +43,25 @@ IN: cocoa.subclassing
: types= ( a b -- ? )
[ ascii alien>string ] bi@ = ;
-! : (verify-method-type) ( class sel types -- )
-! [ class_getInstanceMethod method_getTypeEncoding ]
-! dip types=
-! [ "Objective-C method types cannot be changed once defined" throw ]
-! unless ;
-! : verify-method-type ( class sel imp types -- class sel imp types )
-! 4 ndup nip (verify-method-type) ;
+: (verify-method-type) ( class sel types -- )
+ [ class_getInstanceMethod method_getTypeEncoding ]
+ dip types=
+ [ "Objective-C method types cannot be changed once defined" throw ]
+ unless ;
+: verify-method-type ( class sel imp types -- class sel imp types )
+ 4 ndup nip (verify-method-type) ;
-! : (redefine-objc-method) ( class method -- )
-! init-method ! verify-method-type
-! drop
-! [ class_getInstanceMethod ] dip method_setImplementation drop ;
-!
-! : redefine-objc-methods ( imeth name -- )
-! dup class-exists? [
-! objc_getClass swap [ (redefine-objc-method) ] with each
-! ] [
-! 2drop
-! ] if ;
+: (redefine-objc-method) ( class method -- )
+ init-method ! verify-method-type
+ drop
+ [ class_getInstanceMethod ] dip method_setImplementation drop ;
+
+: redefine-objc-methods ( imeth name -- )
+ dup class-exists? [
+ objc_getClass swap [ (redefine-objc-method) ] with each
+ ] [
+ 2drop
+ ] if ;
SYMBOL: +name+
SYMBOL: +protocols+
@@ -71,7 +71,7 @@ SYMBOL: +superclass+
clone [
prepare-methods
+name+ get "cocoa.classes" create drop
- +name+ get swap [
+ +name+ get 2dup redefine-objc-methods swap [
+protocols+ get , +superclass+ get , +name+ get , ,
\ (define-objc-class) ,
] [ ] make import-objc-class