Cleanups
parent
594751381e
commit
8b863ed5e5
|
@ -62,23 +62,18 @@ objc-methods global [ H{ } assoc-like ] change-at
|
|||
dup objc-methods get at
|
||||
[ ] [ "No such method: " prepend throw ] ?if ;
|
||||
|
||||
: make-dip ( quot n -- quot' )
|
||||
dup
|
||||
\ >r <repetition> >quotation -rot
|
||||
\ r> <repetition> >quotation 3append ;
|
||||
|
||||
MEMO: make-prepare-send ( selector method super? -- quot )
|
||||
[
|
||||
[ \ <super> , ] when
|
||||
swap <selector> , \ selector ,
|
||||
] [ ] make
|
||||
swap second length 2 - make-dip ;
|
||||
swap second length 2 - '[ @ _ ndip ] ;
|
||||
|
||||
MACRO: (send) ( selector super? -- quot )
|
||||
[ dup lookup-method ] dip
|
||||
[ make-prepare-send ] 2keep
|
||||
super-message-senders message-senders ? get at
|
||||
[ slip execute ] 2curry ;
|
||||
'[ _ _ slip execute ] ;
|
||||
|
||||
: send ( receiver args... selector -- return... ) f (send) ; inline
|
||||
|
||||
|
@ -172,7 +167,7 @@ assoc-union alien>objc-types set-global
|
|||
] unless ;
|
||||
|
||||
: (parse-objc-type) ( i string -- ctype )
|
||||
2dup nth [ 1+ ] 2dip {
|
||||
[ 1+ ] [ nth ] 2bi {
|
||||
{ [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
|
||||
{ [ dup CHAR: ^ = ] [ 3drop "void*" ] }
|
||||
{ [ dup CHAR: { = ] [ drop objc-struct-type ] }
|
||||
|
@ -234,11 +229,12 @@ assoc-union alien>objc-types set-global
|
|||
: import-objc-class ( name quot -- )
|
||||
2dup unless-defined
|
||||
dupd define-objc-class-word
|
||||
[
|
||||
'[
|
||||
_
|
||||
dup
|
||||
objc-class register-objc-methods
|
||||
objc-meta-class register-objc-methods
|
||||
] curry try ;
|
||||
] try ;
|
||||
|
||||
: root-class ( class -- root )
|
||||
dup class_getSuperclass [ root-class ] [ ] ?if ;
|
||||
|
|
|
@ -14,10 +14,10 @@ IN: hash2
|
|||
: <hash2> ( size -- hash2 ) f <array> ;
|
||||
|
||||
: 2= ( a b pair -- ? )
|
||||
first2 swapd [ = ] 2dip = and ; inline
|
||||
first2 swapd [ = ] 2bi@ and ; inline
|
||||
|
||||
: (assoc2) ( a b alist -- {a,b,val} )
|
||||
[ [ 2dup ] dip 2= ] find [ 3drop ] dip ; inline
|
||||
[ 2= ] with with find nip ; inline
|
||||
|
||||
: assoc2 ( a b alist -- value )
|
||||
(assoc2) dup [ third ] when ; inline
|
||||
|
@ -29,7 +29,7 @@ IN: hash2
|
|||
[ 2dup hashcode2 ] dip [ length mod ] keep ; inline
|
||||
|
||||
: hash2 ( a b hash2 -- value/f )
|
||||
hash2@ nth [ assoc2 ] [ 2drop f ] if* ;
|
||||
hash2@ nth dup [ assoc2 ] [ 3drop f ] if ;
|
||||
|
||||
: set-hash2 ( a b value hash2 -- )
|
||||
[ -rot ] dip hash2@ [ set-assoc2 ] change-nth ;
|
||||
|
|
Loading…
Reference in New Issue