basis/tools/destructors/destructors.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs classes destructors fry kernel math namespaces
   4 prettyprint sequences sets sorting ;
   5 IN: tools.destructors
   6
   7 <PRIVATE
   8
   9 : disposable-tally ( -- assoc )
  10     disposables get
  11     H{ } clone [ [ keys ] dip '[ class _ inc-at ] each ] keep ;
  12
  13 : subtract-values ( assoc1 assoc2 -- assoc )
  14     [ [ keys ] bi@ append prune ] 2keep
  15     H{ } clone [
  16         '[
  17             [ _ _ [ at 0 or ] bi-curry@ bi - ] keep _ set-at
  18         ] each
  19     ] keep ;
  20
  21 : (disposables.) ( assoc -- )
  22     >alist sort-keys simple-table. ;
  23
  24 PRIVATE>
  25
  26 : disposables. ( -- )
  27     disposable-tally (disposables.) ;
  28
  29 : leaks ( quot -- )
  30     disposable-tally [ call disposable-tally ] dip subtract-values
  31     (disposables.) ; inline