From e435a7aa59ac2a5edf8a4d82c3b8ec4c22674e26 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Mon, 21 Nov 2011 16:38:16 -0800
Subject: [PATCH] cocoa.messages: Apply mrjbq's patch to show the name of the
 cooca function in sender stubs. rename 'method' in stack effects to
 'signature' since we are passing an array with the return value and
 arguments, not the method.

---
 basis/cocoa/messages/messages.factor | 30 +++++++++++++++-------------
 1 file changed, 16 insertions(+), 14 deletions(-)

diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index 8c2b045b71..f1670e1de9 100644
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -5,17 +5,17 @@ arrays assocs classes.struct continuations combinators compiler
 core-graphics.types stack-checker kernel math namespaces make
 quotations sequences strings words cocoa.runtime cocoa.types io
 macros memoize io.encodings.utf8 effects layouts libc lexer init
-core-foundation fry generalizations specialized-arrays ;
+core-foundation fry generalizations specialized-arrays locals ;
 QUALIFIED-WITH: alien.c-types c
 IN: cocoa.messages
 
 SPECIALIZED-ARRAY: void*
 
-: make-sender ( method function -- quot )
+: make-sender ( signature function -- quot )
     [ over first , f , , second , \ alien-invoke , ] [ ] make ;
 
-: sender-stub ( method function -- word )
-    [ "( sender-stub )" f <word> dup ] 2dip
+: sender-stub ( name signature function -- word )
+    [ "( sender-stub:" ")" surround f <word> dup ] 2dip
     over first large-struct? [ "_stret" append ] when
     make-sender dup infer define-declared ;
 
@@ -25,13 +25,13 @@ SYMBOL: super-message-senders
 message-senders [ H{ } clone ] initialize
 super-message-senders [ H{ } clone ] initialize
 
-: cache-stub ( method assoc function -- )
-    '[ _ sender-stub ] cache drop ;
+:: cache-stub ( name signature function assoc -- )
+    signature assoc [ [ name ] dip function sender-stub ] cache drop ;
 
-: cache-stubs ( method -- )
-    [ super-message-senders get "objc_msgSendSuper" cache-stub ]
-    [ message-senders get "objc_msgSend" cache-stub ]
-    bi ;
+: cache-stubs ( name signature -- )
+    [ "objc_msgSendSuper" super-message-senders get cache-stub ]
+    [ "objc_msgSend" message-senders get cache-stub ]
+    2bi ;
 
 : <super> ( receiver -- super )
     [ ] [ object_getClass class_getSuperclass ] bi
@@ -209,11 +209,13 @@ ERROR: no-objc-type name ;
     [ utf8 alien>string parse-objc-type ] keep
     (free) ;
 
+: method-name ( method -- name )
+    method_getName sel_getName ;
+
 : register-objc-method ( method -- )
-    dup method-return-type over method-arg-types 2array
-    dup cache-stubs
-    swap method_getName sel_getName
-    objc-methods get set-at ;
+    [ method-name ]
+    [ [ method-return-type ] [ method-arg-types ] bi 2array ] bi
+    [ cache-stubs ] [ swap objc-methods get set-at ] 2bi ;
 
 : each-method-in-class ( class quot -- )
     [ { uint } [ class_copyMethodList ] with-out-parameters ] dip