core: trim using lists with lint.vocabs tool

[factor.git] / core / destructors / destructors.factor

diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor
index ac3751e32ed8bf40fc96656de69ab7b935f5e701..1ed1ce843384049e35c6b21abcc4595e977d260d 100644 (file)
--- a/core/destructors/destructors.factor
+++ b/core/destructors/destructors.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2007, 2009 Doug Coleman, Slava Pestov.
+! Copyright (C) 2007, 2010 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors continuations kernel namespaces make
-sequences vectors sets assocs init math ;
+USING: accessors assocs continuations kernel namespaces
+sequences sets ;
 IN: destructors
 
 SYMBOL: disposables
@@ -15,11 +15,11 @@ SYMBOL: debug-leaks?
 SLOT: continuation
 
 : register-disposable ( obj -- )
-    debug-leaks? get-global [ continuation >>continuation ] when
-    disposables get conjoin ;
+    debug-leaks? get-global [ current-continuation >>continuation ] when
+    disposables get adjoin ;
 
 : unregister-disposable ( obj -- )
-    disposables get 2dup key? [ delete-at ] [ drop already-unregistered ] if ;
+    dup disposables get ?delete [ drop ] [ already-unregistered ] if ;
 
 PRIVATE>
 
@@ -34,28 +34,32 @@ GENERIC: dispose* ( disposable -- )
 
 ERROR: already-disposed disposable ;
 
-: check-disposed ( disposable -- )
-    dup disposed>> [ already-disposed ] [ drop ] if ; inline
+: check-disposed ( disposable -- disposable )
+    dup disposed>> [ already-disposed ] when ; inline
 
 GENERIC: dispose ( disposable -- )
 
-M: object dispose
-    dup disposed>> [ drop ] [ t >>disposed dispose* ] if ;
+: unless-disposed ( disposable quot -- )
+    [ dup disposed>> [ drop ] ] dip if ; inline
+
+M: object dispose [ t >>disposed dispose* ] unless-disposed ;
 
 M: disposable dispose
-    dup disposed>> [ drop ] [
+    [
         [ unregister-disposable ]
         [ call-next-method ]
         bi
-    ] if ;
+    ] unless-disposed ;
+
+: dispose-to ( obj accum -- )
+    [ dispose ] [ push ] bi-curry* recover ; inline
 
 : dispose-each ( seq -- )
-    [
-        [ [ dispose ] curry [ , ] recover ] each
-    ] { } make [ last rethrow ] unless-empty ;
+    V{ } clone [ [ dispose-to ] curry each ] keep
+    [ last rethrow ] unless-empty ;
 
 : with-disposal ( object quot -- )
-    over [ dispose ] curry [ ] cleanup ; inline
+    over [ dispose ] curry finally ; inline
 
 <PRIVATE
 
@@ -78,21 +82,21 @@ PRIVATE>
     dup error-destructors get push ; inline
 
 : with-destructors ( quot -- )
-    [
-        V{ } clone always-destructors set
-        V{ } clone error-destructors set
+    H{ } clone
+    V{ } clone always-destructors pick set-at
+    V{ } clone error-destructors pick set-at [
         [ do-always-destructors ]
         [ do-error-destructors ]
         cleanup
-    ] with-scope ; inline
+    ] with-variables ; inline
 
-[
-    H{ } clone disposables set-global
+STARTUP-HOOK: [
+    HS{ } clone disposables set-global
     V{ } clone always-destructors set-global
     V{ } clone error-destructors set-global
-] "destructors" add-startup-hook
+]
 
-[
+SHUTDOWN-HOOK: [
     do-always-destructors
     do-error-destructors
-] "destructors" add-shutdown-hook
+]