basis/tools/destructors/destructors.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs classes combinators.smart
   4 continuations destructors fry io io.styles kernel namespaces
   5 prettyprint sequences sets sorting ;
   6 IN: tools.destructors
   7
   8 <PRIVATE
   9
  10 : class-tally ( set -- assoc' )
  11     members [ class-of ] collect-by ;
  12
  13 : (disposables.) ( set -- )
  14     class-tally >alist [ first2 [ length ] keep 3array ] map [ second ] sort-with
  15     standard-table-style [
  16         [
  17             [ "Disposable class" write ] with-cell
  18             [ "Instances" write ] with-cell
  19             [ ] with-cell
  20         ] with-row
  21         [
  22             [
  23                 [
  24                     [ pprint-cell ]
  25                     [ pprint-cell ]
  26                     [ [ "[ List instances ]" swap write-object ] with-cell ]
  27                     tri*
  28                 ] input<sequence
  29             ] with-row
  30         ] each
  31     ] tabular-output nl ;
  32
  33 : sort-disposables ( seq -- seq' )
  34     [ disposable? ] partition [ [ id>> ] sort-with ] dip append ;
  35
  36 PRIVATE>
  37
  38 : disposables. ( -- )
  39     disposables get (disposables.) ;
  40
  41 : disposables-of-class. ( class -- )
  42     [ disposables get members sort-disposables ] dip
  43     '[ _ instance? ] filter stack. ;
  44
  45 : leaks ( quot -- disposables )
  46     disposables get clone
  47     t debug-leaks? set-global
  48     [
  49         [ call disposables get clone ] dip
  50     ] [ f debug-leaks? set-global ] finally
  51     diff ; inline
  52
  53 : leaks. ( quot -- )
  54     leaks (disposables.) ; inline