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

Beginning to implement Objective C subclassing

release
slava 2006-03-08 21:07:17 +00:00
parent c89a40f902
commit 17ba89b5cd
4 changed files with 86 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
library/cocoa/init-cocoa.factor
View File

@ -37,5 +37,5 @@ USING: cocoa compiler io kernel objc sequences words ;
"WebFrame"
"WebView"
} [
dup print flush define-objc-class
dup print flush import-objc-class
] each

12
library/cocoa/runtime.factor
View File

@ -12,6 +12,16 @@ FUNCTION: bool sel_isMapped ( SEL aSelector ) ;
FUNCTION: SEL sel_registerName ( char* str ) ;
: CLS_CLASS HEX: 1 ;
: CLS_META HEX: 2 ;
: CLS_INITIALIZED HEX: 4 ;
: CLS_POSING HEX: 8 ;
: CLS_MAPPED HEX: 10 ;
: CLS_FLUSH_CACHE HEX: 20 ;
: CLS_GROW_CACHE HEX: 40 ;
: CLS_NEED_BIND HEX: 80 ;
: CLS_METHOD_ARRAY HEX: 100 ;
BEGIN-STRUCT: objc-class
FIELD: void* isa
FIELD: void* super-class
@ -35,6 +45,8 @@ FUNCTION: objc-class* objc_getClass ( char* class ) ;
FUNCTION: objc-class* objc_getMetaClass ( char* class ) ;
FUNCTION: void objc_addClass ( objc-class* class ) ;
FUNCTION: id class_createInstance ( objc-class* class, uint additionalByteCount ) ;
FUNCTION: id class_createInstanceFromZone ( objc-class* class, uint additionalByteCount, void* zone ) ;

35
library/cocoa/subclassing.factor
View File

@ -3,3 +3,38 @@
IN: objc
USING: alien kernel kernel-internals libc math sequences ;
: <method-lists> ( -- lists )
"void*" <malloc-object> -1 over 0 set-alien-unsigned-cell ;
: <objc-class> ( name info -- class )
"objc-class" <malloc-object>
[ set-objc-class-info ] keep
[ >r <malloc-string> r> set-objc-class-name ] keep
<method-lists> over set-objc-class-methodLists ;
! 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 ;
: <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 ;
: <new-class> ( metaclass superclass name -- class )
CLS_CLASS <objc-class>
[ set-objc-class-super-class ] keep
[ set-objc-class-isa ] keep ;
: (define-objc-class) ( superclass name -- class )
>r objc-class r> [ <meta-class> ] 2keep <new-class>
dup objc_addClass ;
: define-objc-class ( superclass name -- class )
dup class-exists?
[ nip objc-class ] [ (define-objc-class) ] if ;

31
library/cocoa/utilities.factor
View File

@ -26,8 +26,9 @@ C: selector ( name -- sel ) [ set-selector-name ] keep ;
>r method_getArgumentInfo drop
r> *char* ;
: objc-primitive-type ( char -- ctype )
H{
SYMBOL: objc>alien-types
H{
{ CHAR: c "char" }
{ CHAR: i "int" }
{ CHAR: s "short" }
@ -46,7 +47,12 @@ C: selector ( name -- sel ) [ set-selector-name ] keep ;
{ CHAR: @ "id" }
{ CHAR: # "id" }
{ CHAR: : "SEL" }
} hash ;
} hash objc>alien-types set-global
SYMBOL: alien>objc-types
objc>alien-types get hash>alist [ reverse ] map alist>hash
alien>objc-types get
: objc-struct-type ( i string -- ctype )
2dup CHAR: = -rot index* swap subseq ;
@ -57,7 +63,7 @@ C: selector ( name -- sel ) [ set-selector-name ] keep ;
{ [ dup CHAR: ^ = ] [ 3drop "void*" ] }
{ [ dup CHAR: { = ] [ drop objc-struct-type ] }
{ [ dup CHAR: [ = ] [ 3drop "void*" ] }
{ [ t ] [ 2nip objc-primitive-type ] }
{ [ t ] [ 2nip objc>alien-types get hash ] }
} cond ;
: parse-objc-type ( string -- ctype ) 0 swap (parse-objc-type) ;
@ -132,20 +138,23 @@ C: selector ( name -- sel ) [ set-selector-name ] keep ;
pick c-struct?
[ make-objc-send-stret ] [ make-objc-send ] if ;
: define-objc-method ( returns types selector -- )
: import-objc-method ( returns types selector -- )
[ make-objc-method "[" ] keep "]" append3 create-in
swap define-compound ;
: define-objc-methods ( seq -- )
[ first3 swap define-objc-method ] each ;
: import-objc-methods ( seq -- )
[ first3 swap import-objc-method ] each ;
: define-objc-class-word ( name -- )
create-in over [ objc_getClass ] curry define-compound ;
create-in over [ objc-class ] curry define-compound ;
: define-objc-class ( name -- )
: import-objc-class ( name -- )
[
"objc-" over append in set
dup define-objc-class-word
dup instance-methods define-objc-methods
class-methods define-objc-methods
dup instance-methods import-objc-methods
class-methods import-objc-methods
] with-scope ;
: root-class ( class -- class )
dup objc-class-super-class [ root-class ] [ ] ?if ;