steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

destructors: use hash-sets to keep track of disposables.

db4
John Benediktsson 2013-03-08 16:30:33 -08:00
parent 4b5833f252
commit 26506a4b0b
3 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/libc/libc.factor
View File

@ -72,7 +72,7 @@ M: realloc-error summary
[ <malloc-ptr> unregister-disposable ] when* ; [ <malloc-ptr> unregister-disposable ] when* ;
: malloc-exists? ( alien -- ? ) : malloc-exists? ( alien -- ? )
<malloc-ptr> disposables get key? ; <malloc-ptr> disposables get in? ;
PRIVATE> PRIVATE>

19
basis/tools/destructors/destructors.factor
View File

@ -1,16 +1,19 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs classes destructors fry kernel math namespaces USING: accessors arrays assocs classes combinators.smart
prettyprint sequences sets sorting continuations accessors arrays continuations destructors fry io io.styles kernel namespaces
io io.styles combinators.smart ; prettyprint sequences sets sorting ;
FROM: sets => members ;
IN: tools.destructors IN: tools.destructors
<PRIVATE <PRIVATE
: class-tally ( assoc -- assoc' ) : class-tally ( set -- assoc' )
H{ } clone [ [ keys ] dip '[ dup class-of _ push-at ] each ] keep ; H{ } clone [
[ members ] dip '[ dup class-of _ push-at ] each
] keep ;
: (disposables.) ( assoc -- ) : (disposables.) ( set -- )
class-tally >alist [ first2 [ length ] keep 3array ] map [ second ] sort-with class-tally >alist [ first2 [ length ] keep 3array ] map [ second ] sort-with
standard-table-style [ standard-table-style [
[ [
@ -39,7 +42,7 @@ PRIVATE>
disposables get (disposables.) ; disposables get (disposables.) ;
: disposables-of-class. ( class -- ) : disposables-of-class. ( class -- )
[ disposables get values sort-disposables ] dip [ disposables get members sort-disposables ] dip
'[ _ instance? ] filter stack. ; '[ _ instance? ] filter stack. ;
: leaks ( quot -- ) : leaks ( quot -- )
@ -48,4 +51,4 @@ PRIVATE>
[ [
[ call disposables get clone ] dip [ call disposables get clone ] dip
] [ f debug-leaks? set-global ] [ ] cleanup ] [ f debug-leaks? set-global ] [ ] cleanup
assoc-diff (disposables.) ; inline diff (disposables.) ; inline

6
core/destructors/destructors.factor
View File

@ -17,10 +17,10 @@ SLOT: continuation
: register-disposable ( obj -- ) : register-disposable ( obj -- )
debug-leaks? get-global [ current-continuation >>continuation ] when debug-leaks? get-global [ current-continuation >>continuation ] when
disposables get conjoin ; disposables get adjoin ;
: unregister-disposable ( obj -- ) : unregister-disposable ( obj -- )
disposables get 2dup key? [ delete-at ] [ drop already-unregistered ] if ; disposables get 2dup in? [ delete ] [ drop already-unregistered ] if ;
PRIVATE> PRIVATE>
@ -92,7 +92,7 @@ PRIVATE>
] with-scope ; inline ] with-scope ; inline
[ [
H{ } clone disposables set-global HS{ } clone disposables set-global
V{ } clone always-destructors set-global V{ } clone always-destructors set-global
V{ } clone error-destructors set-global V{ } clone error-destructors set-global
] "destructors" add-startup-hook ] "destructors" add-startup-hook