From 5fdee1a6112b970afd232fb0ede9f5faa053f015 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 6 Oct 2007 13:39:59 -0400
Subject: [PATCH] Less consing of quotations

---
 extra/cocoa/messages/messages.factor | 24 +++++++++++-------------
 1 file changed, 11 insertions(+), 13 deletions(-)

diff --git a/extra/cocoa/messages/messages.factor b/extra/cocoa/messages/messages.factor
index c1543868e1..83f7217615 100644
--- a/extra/cocoa/messages/messages.factor
+++ b/extra/cocoa/messages/messages.factor
@@ -3,7 +3,8 @@
 USING: alien alien.c-types alien.compiler
 arrays assocs combinators compiler inference.transforms kernel
 math namespaces parser prettyprint prettyprint.sections
-quotations sequences strings words cocoa.runtime io macros ;
+quotations sequences strings words cocoa.runtime io macros
+memoize ;
 IN: cocoa.messages
 
 : make-sender ( method function -- quot )
@@ -20,10 +21,8 @@ IN: cocoa.messages
 SYMBOL: message-senders
 SYMBOL: super-message-senders
 
-global [
-    message-senders [ H{ } assoc-like ] change
-    super-message-senders [ H{ } assoc-like ] change
-] bind
+message-senders global [ H{ } assoc-like ] change-at
+super-message-senders global [ H{ } assoc-like ] change-at
 
 : cache-stub ( method function hash -- )
     [
@@ -56,14 +55,14 @@ TUPLE: selector name object ;
 
 SYMBOL: selectors
 
-H{ } clone selectors set-global
+selectors global [ H{ } assoc-like ] change-at
 
 : cache-selector ( string -- selector )
     selectors get-global [ <selector> ] cache ;
 
 SYMBOL: objc-methods
 
-H{ } clone objc-methods set-global
+objc-methods global [ H{ } assoc-like ] change-at
 
 : lookup-method ( selector -- method )
     dup objc-methods get at
@@ -74,7 +73,7 @@ H{ } clone objc-methods set-global
     \ >r <repetition> >quotation -rot
     \ r> <repetition> >quotation 3append ;
 
-: make-prepare-send ( selector method super? -- quot )
+MEMO: make-prepare-send ( selector method super? -- quot )
     [
         [ \ <super> , ] when
         swap cache-selector , \ selector ,
@@ -82,11 +81,10 @@ H{ } clone objc-methods set-global
     swap second length 2 - make-dip ;
 
 MACRO: (send) ( selector super? -- quot )
-    [
-        >r dup lookup-method r>
-        [ make-prepare-send % ] 2keep
-        super-message-senders message-senders ? get at ,
-    ] [ ] make ;
+    >r dup lookup-method r>
+    [ make-prepare-send ] 2keep
+    super-message-senders message-senders ? get at
+    [ slip execute ] 2curry ;
 
 : send ( args... receiver selector -- return... ) f (send) ; inline