-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types alien.strings arrays assocs
-continuations combinators compiler compiler.alien kernel math
-namespaces make parser quotations sequences strings words
-cocoa.runtime io macros memoize io.encodings.utf8
-effects libc libc.private parser lexer init core-foundation fry
-generalizations specialized-arrays.direct.alien call ;
+continuations combinators compiler compiler.alien stack-checker kernel
+math namespaces make quotations sequences strings words
+cocoa.runtime io macros memoize io.encodings.utf8 effects libc
+libc.private lexer init core-foundation fry generalizations
+specialized-arrays.direct.alien ;
IN: cocoa.messages
: make-sender ( method function -- quot )
: sender-stub ( method function -- word )
[ "( sender-stub )" f <word> dup ] 2dip
over first large-struct? [ "_stret" append ] when
- make-sender define ;
+ make-sender dup infer define-declared ;
SYMBOL: message-senders
SYMBOL: super-message-senders
message-senders [ H{ } clone ] initialize
super-message-senders [ H{ } clone ] initialize
-: cache-stub ( method function hash -- )
- [
- over get [ 2drop ] [ over [ sender-stub ] dip set ] if
- ] bind ;
+: cache-stub ( method assoc function -- )
+ '[ _ sender-stub ] cache drop ;
: cache-stubs ( method -- )
- dup
- "objc_msgSendSuper" super-message-senders get cache-stub
- "objc_msgSend" message-senders get cache-stub ;
+ [ super-message-senders get "objc_msgSendSuper" cache-stub ]
+ [ message-senders get "objc_msgSend" cache-stub ]
+ bi ;
: <super> ( receiver -- super )
"objc-super" <c-object> [
[ dup lookup-method ] dip
[ make-prepare-send ] 2keep
super-message-senders message-senders ? get at
- '[ _ call _ execute ] ;
+ 1quotation append ;
: send ( receiver args... selector -- return... ) f (send) ; inline
drop "void*"
] unless ;
+ERROR: no-objc-type name ;
+
+: decode-type ( ch -- ctype )
+ 1string dup objc>alien-types get at
+ [ ] [ no-objc-type ] ?if ;
+
: (parse-objc-type) ( i string -- ctype )
- [ [ 1+ ] dip ] [ nth ] 2bi {
+ [ [ 1 + ] dip ] [ nth ] 2bi {
{ [ dup "rnNoORV" member? ] [ drop (parse-objc-type) ] }
{ [ dup CHAR: ^ = ] [ 3drop "void*" ] }
{ [ dup CHAR: { = ] [ drop objc-struct-type ] }
{ [ dup CHAR: [ = ] [ 3drop "void*" ] }
- [ 2nip 1string objc>alien-types get at ]
+ [ 2nip decode-type ]
} cond ;
: parse-objc-type ( string -- ctype ) 0 swap (parse-objc-type) ;