basis/tools/deploy/shaker/strip-cocoa.factor

   1 ! Copyright (C) 2007, 2009 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: cocoa cocoa.messages cocoa.application cocoa.nibs assocs
   4 namespaces kernel kernel.private words compiler.units sequences
   5 init vocabs memoize accessors ;
   6 IN: tools.deploy.shaker.cocoa
   7
   8 : pool ( obj -- obj' ) \ pool get [ ] cache ;
   9
  10 : pool-array ( obj -- obj' ) [ pool ] map pool ;
  11
  12 : pool-keys ( assoc -- assoc' ) [ [ pool-array ] dip ] assoc-map ;
  13
  14 : pool-values ( assoc -- assoc' ) [ pool-array ] assoc-map ;
  15
  16 H{ } clone \ pool [
  17     [
  18         ! Only keeps those methods that we actually call
  19         sent-messages get super-sent-messages get assoc-union
  20         objc-methods [ assoc-intersect pool-values ] change
  21
  22         sent-messages get
  23         super-sent-messages get
  24         [ keys [ objc-methods get at dup ] H{ } map>assoc ] bi@
  25         super-message-senders [ assoc-intersect pool-keys ] change
  26         message-senders [ assoc-intersect pool-keys ] change
  27
  28         sent-messages off
  29         super-sent-messages off
  30
  31         alien>objc-types off
  32         objc>alien-types off
  33
  34         ! We need this for strip-stack-traces to work fully
  35         { message-senders super-message-senders }
  36         [ get values compile ] each
  37     ] with-global
  38 ] with-variable
  39
  40 \ make-prepare-send reset-memoized
  41 \ <selector> reset-memoized
  42
  43 \ (send) def>> second clear-assoc