Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / cocoa / messages / messages.factor

diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index 9a1bebd38f326e16b29a06bdbc7852129dcf8d19..9da285f34c157980de5d51d3a57f3d4275467019 100644 (file)
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -2,10 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.strings arrays assocs
 continuations combinators compiler compiler.alien stack-checker kernel
-math namespaces make parser quotations sequences strings words
+math namespaces make 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 ;
+libc.private lexer init core-foundation fry generalizations
+specialized-arrays.direct.alien ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )
@@ -22,15 +22,13 @@ 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> [
@@ -70,7 +68,7 @@ MACRO: (send) ( selector super? -- quot )
     [ 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
 
@@ -167,13 +165,19 @@ assoc-union alien>objc-types set-global
         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) ;