tools.destructors: destructors. and leaks words now output a 'show instances' link which lists all relevant disposables

db4
Slava Pestov 2009-08-24 20:21:38 -05:00
parent 3be328056d
commit b12bbaf7ec
2 changed files with 49 additions and 19 deletions
basis/tools/destructors
core/destructors

View File

@ -1,31 +1,51 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs classes destructors fry kernel math namespaces
prettyprint sequences sets sorting ;
prettyprint sequences sets sorting continuations accessors arrays
io io.styles combinators.smart ;
IN: tools.destructors
<PRIVATE
: disposable-tally ( -- assoc )
disposables get
H{ } clone [ [ keys ] dip '[ class _ inc-at ] each ] keep ;
: subtract-values ( assoc1 assoc2 -- assoc )
[ [ keys ] bi@ append prune ] 2keep
H{ } clone [
'[
[ _ _ [ at 0 or ] bi-curry@ bi - ] keep _ set-at
] each
] keep ;
: class-tally ( assoc -- assoc' )
H{ } clone [ [ keys ] dip '[ dup class _ push-at ] each ] keep ;
: (disposables.) ( assoc -- )
>alist sort-keys simple-table. ;
class-tally >alist [ first2 [ length ] keep 3array ] map [ second ] sort-with
standard-table-style [
[
[ "Disposable class" write ] with-cell
[ "Instances" write ] with-cell
[ ] with-cell
] with-row
[
[
[
[ pprint-cell ]
[ pprint-cell ]
[ [ "[ List instances ]" swap write-object ] with-cell ]
tri*
] input<sequence
] with-row
] each
] tabular-output nl ;
: sort-disposables ( seq -- seq' )
[ disposable? ] partition [ [ id>> ] sort-with ] dip append ;
PRIVATE>
: disposables. ( -- )
disposable-tally (disposables.) ;
disposables get (disposables.) ;
: disposables-of-class. ( class -- )
[ disposables get values sort-disposables ] dip
'[ _ instance? ] filter stack. ;
: leaks ( quot -- )
disposable-tally [ call disposable-tally ] dip subtract-values
(disposables.) ; inline
disposables get clone
debug-leaks? on
[
[ call disposables get clone ] dip
] [ ] [ debug-leaks? off ] cleanup
assoc-diff (disposables.) ; inline

View File

@ -1,24 +1,34 @@
! Copyright (C) 2007, 2009 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors continuations kernel namespaces make
sequences vectors sets assocs init ;
sequences vectors sets assocs init math ;
IN: destructors
SYMBOL: disposables
[ H{ } clone disposables set-global ] "destructors" add-init-hook
ERROR: already-unregistered disposable ;
SYMBOL: debug-leaks?
<PRIVATE
SLOT: continuation
: register-disposable ( obj -- )
debug-leaks? get [ continuation >>continuation ] when
disposables get conjoin ;
: unregister-disposable ( obj -- )
disposables get delete-at ;
disposables get 2dup key? [ already-unregistered ] unless delete-at ;
PRIVATE>
TUPLE: disposable < identity-tuple disposed id ;
TUPLE: disposable < identity-tuple
{ id integer }
{ disposed boolean }
continuation ;
M: disposable hashcode* nip id>> ;