steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cocoa.messages: if a class cannot be found, IMPORT: no longer fails at parse time. Instead, there will be a runtime error when the class word is executed

db4
Slava Pestov 2010-02-21 22:27:32 +13:00
parent 2f70ebd4d0
commit 0da6f78088
1 changed files with 8 additions and 6 deletions
basis/cocoa/messages

14
basis/cocoa/messages/messages.factor
View File

@ -76,13 +76,13 @@ MACRO: (send) ( selector super? -- quot )
: super-send ( receiver args... selector -- return... ) t (send) ; inline : super-send ( receiver args... selector -- return... ) t (send) ; inline
! Runtime introspection ! Runtime introspection
SYMBOL: class-startup-hooks SYMBOL: class-init-hooks
class-startup-hooks [ H{ } clone ] initialize class-init-hooks [ H{ } clone ] initialize
: (objc-class) ( name word -- class ) : (objc-class) ( name word -- class )
2dup execute dup [ 2nip ] [ 2dup execute dup [ 2nip ] [
drop over class-startup-hooks get at [ call( -- ) ] when* drop over class-init-hooks get at [ call( -- ) ] when*
2dup execute dup [ 2nip ] [ 2dup execute dup [ 2nip ] [
2drop "No such class: " prepend throw 2drop "No such class: " prepend throw
] if ] if
@ -229,7 +229,7 @@ ERROR: no-objc-type name ;
: class-exists? ( string -- class ) objc_getClass >boolean ; : class-exists? ( string -- class ) objc_getClass >boolean ;
: define-objc-class-word ( quot name -- ) : define-objc-class-word ( quot name -- )
[ class-startup-hooks get set-at ] [ class-init-hooks get set-at ]
[ [
[ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi [ "cocoa.classes" create ] [ '[ _ objc-class ] ] bi
(( -- class )) define-declared (( -- class )) define-declared
@ -237,8 +237,10 @@ ERROR: no-objc-type name ;
: import-objc-class ( name quot -- ) : import-objc-class ( name quot -- )
over define-objc-class-word over define-objc-class-word
[ objc-class register-objc-methods ] dup objc_getClass [
[ objc-meta-class register-objc-methods ] bi ; [ objc-class register-objc-methods ]
[ objc-meta-class register-objc-methods ] bi
] [ drop ] if ;
: root-class ( class -- root ) : root-class ( class -- root )
dup class_getSuperclass [ root-class ] [ ] ?if ; dup class_getSuperclass [ root-class ] [ ] ?if ;