From f0f0cfb7c3a6eb3a01c019b5f69fdd4835c9ce65 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Thu, 1 May 2008 21:42:51 -0500
Subject: [PATCH] dispose-each

---
 core/continuations/continuations-tests.factor | 19 ++++++++++++++++++-
 core/continuations/continuations.factor       |  5 +++++
 extra/destructors/destructors.factor          |  7 ++-----
 extra/io/server/server.factor                 |  2 +-
 4 files changed, 26 insertions(+), 7 deletions(-)

diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor
index 8b396763e1..b0c216e82f 100755
--- a/core/continuations/continuations-tests.factor
+++ b/core/continuations/continuations-tests.factor
@@ -1,6 +1,6 @@
 USING: kernel math namespaces io tools.test sequences vectors
 continuations debugger parser memory arrays words
-kernel.private ;
+kernel.private accessors ;
 IN: continuations.tests
 
 : (callcc1-test)
@@ -100,3 +100,20 @@ SYMBOL: error-counter
     [ 3 ] [ always-counter get ] unit-test
     [ 1 ] [ error-counter get ] unit-test
 ] with-scope
+
+TUPLE: dispose-error ;
+
+M: dispose-error dispose 3 throw ;
+
+TUPLE: dispose-dummy disposed? ;
+
+M: dispose-dummy dispose t >>disposed? drop ;
+
+T{ dispose-error } "a" set
+T{ dispose-dummy } "b" set
+
+[ f ] [ "b" get disposed?>> ] unit-test
+
+[ { "a" "b" } [ get ] map dispose-each ] [ 3 = ] must-fail-with
+
+[ t ] [ "b" get disposed?>> ] unit-test
diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index cf67280cca..3e675b1f0f 100755
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -138,6 +138,11 @@ SYMBOL: thread-error-hook
 
 GENERIC: dispose ( object -- )
 
+: dispose-each ( seq -- )
+    [
+        [ [ dispose ] curry [ , ] recover ] each
+    ] { } make dup empty? [ drop ] [ peek rethrow ] if ;
+
 : with-disposal ( object quot -- )
     over [ dispose ] curry [ ] cleanup ; inline
 
diff --git a/extra/destructors/destructors.factor b/extra/destructors/destructors.factor
index 87b5740786..c3914e9c93 100755
--- a/extra/destructors/destructors.factor
+++ b/extra/destructors/destructors.factor
@@ -26,14 +26,11 @@ M: destructor dispose
 : add-always-destructor ( obj -- )
     <destructor> always-destructors get push ;
 
-: dispose-each ( seq -- )
-    <reversed> [ dispose ] each ;
-
 : do-always-destructors ( -- )
-    always-destructors get dispose-each ;
+    always-destructors get <reversed> dispose-each ;
 
 : do-error-destructors ( -- )
-    error-destructors get dispose-each ;
+    error-destructors get <reversed> dispose-each ;
 
 : with-destructors ( quot -- )
     [
diff --git a/extra/io/server/server.factor b/extra/io/server/server.factor
index 1d5ed16dc5..45e3b1de66 100755
--- a/extra/io/server/server.factor
+++ b/extra/io/server/server.factor
@@ -47,7 +47,7 @@ PRIVATE>
     ] with-variable ; inline
 
 : stop-server ( -- )
-    servers get [ dispose ] each ;
+    servers get dispose-each ;
 
 <PRIVATE