1 ! Copyright (C) 2007, 2009 Doug Coleman, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors continuations kernel namespaces make
4 sequences vectors sets assocs init ;
9 [ H{ } clone disposables set-global ] "destructors" add-init-hook
13 : register-disposable ( obj -- )
14 disposables get conjoin ;
16 : unregister-disposable ( obj -- )
17 disposables get delete-at ;
21 TUPLE: disposable < identity-tuple disposed id ;
23 M: disposable hashcode* nip id>> ;
25 : new-disposable ( class -- disposable )
26 new \ disposable counter >>id
27 dup register-disposable ; inline
29 GENERIC: dispose* ( disposable -- )
31 ERROR: already-disposed disposable ;
33 : check-disposed ( disposable -- )
34 dup disposed>> [ already-disposed ] [ drop ] if ; inline
36 GENERIC: dispose ( disposable -- )
39 dup disposed>> [ drop ] [ t >>disposed dispose* ] if ;
42 [ unregister-disposable ] [ call-next-method ] bi ;
44 : dispose-each ( seq -- )
46 [ [ dispose ] curry [ , ] recover ] each
47 ] { } make [ last rethrow ] unless-empty ;
49 : with-disposal ( object quot -- )
50 over [ dispose ] curry [ ] cleanup ; inline
54 SYMBOL: always-destructors
56 SYMBOL: error-destructors
58 : do-always-destructors ( -- )
59 always-destructors get <reversed> dispose-each ;
61 : do-error-destructors ( -- )
62 error-destructors get <reversed> dispose-each ;
66 : &dispose ( disposable -- disposable )
67 dup always-destructors get push ; inline
69 : |dispose ( disposable -- disposable )
70 dup error-destructors get push ; inline
72 : with-destructors ( quot -- )
74 V{ } clone always-destructors set
75 V{ } clone error-destructors set
76 [ do-always-destructors ]
77 [ do-error-destructors ]