Move destructors to core

core/alien/c-types/c-types-docs.factor

@@ -1,7 +1,7 @@
 IN: alien.c-types
 USING: alien help.syntax help.markup libc kernel.private
 byte-arrays math strings hashtables alien.syntax
-bit-arrays float-arrays debugger ;
+bit-arrays float-arrays debugger destructors ;
 
 HELP: <c-type>
 { $values { "type" hashtable } }
@@ -222,6 +222,9 @@ $nl
 { $subsection realloc }
 "You must always free pointers returned by any of the above words when the block of memory is no longer in use:"
 { $subsection free }
+"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
+{ $subsection &free }
+{ $subsection |free }
 "You can unsafely copy a range of bytes from one memory location to another:"
 { $subsection memcpy }
 "You can copy a range of bytes from memory into a byte array:"

core/continuations/continuations-docs.factor

@@ -1,6 +1,6 @@
 USING: help.markup help.syntax kernel kernel.private
 continuations.private parser vectors arrays namespaces
-assocs words quotations io ;
+assocs words quotations ;
 IN: continuations
 
 ARTICLE: "errors-restartable" "Restartable errors"
@@ -28,13 +28,7 @@ $nl
 { $heading "Anti-pattern #3: Dropping and rethrowing" }
 "Do not use " { $link recover } " to handle an error by dropping it and throwing a new error. By losing the original error message, you signal to the user that something failed without leaving any indication of what actually went wrong. Either wrap the error in a new error containing additional information, or rethrow the original error. A more subtle form of this is using  " { $link throw } " instead of " { $link rethrow } ". The " { $link throw } " word should only be used when throwing new errors, and never when rethrowing errors that have been caught."
 { $heading "Anti-pattern #4: Logging and rethrowing" }
-"If you are going to rethrow an error, do not log a message. If you do so, the user will see two log messages for the same error, which will clutter logs without adding any useful information."
+"If you are going to rethrow an error, do not log a message. If you do so, the user will see two log messages for the same error, which will clutter logs without adding any useful information." ;
-{ $heading "Anti-pattern #5: Leaking external resources" }
-"Words which create objects corresponding to external resources should always be used with " { $link with-disposal } ". The following code is wrong:"
-{ $code
-    "<external-resource> ... do stuff ... dispose"
-}
-"The reason being that if " { $snippet "do stuff" } " throws an error, the resource will not be disposed of. The most important case where this can occur is with I/O streams, and the correct solution is to always use " { $link with-input-stream } " and " { $link with-output-stream } "; see " { $link "stdio" } " for details." ;
 
 ARTICLE: "errors" "Error handling"
 "Support for handling exceptional situations such as bad user input, implementation bugs, and input/output errors is provided by a set of words built using continuations."
@@ -88,19 +82,6 @@ $nl
 
 ABOUT: "continuations"
 
-HELP: dispose
-{ $values { "object" "a disposable object" } }
-{ $contract "Releases operating system resources associated with a disposable object. Disposable objects include streams, memory mapped files, and so on."
-$nl
-"No further operations can be performed on a disposable object after this call."
-$nl
-"Disposing an object which has already been disposed should have no effect, and in particular it should not fail with an error." }
-{ $notes "You must close disposable objects after you are finished working with them, to avoid leaking operating system resources. A convenient way to automate this is by using the " { $link with-disposal } " word." } ;
-
-HELP: with-disposal
-{ $values { "object" "a disposable object" } { "quot" "a quotation with stack effect " { $snippet "( object -- )" } } }
-{ $description "Calls the quotation, disposing the object with " { $link dispose } " after the quotation returns or if it throws an error." } ;
-
 HELP: catchstack*
 { $values { "catchstack" "a vector of continuations" } }
 { $description "Outputs the current catchstack." } ;

core/continuations/continuations.factor

@@ -150,16 +150,6 @@ ERROR: attempt-all-error ;
         ] { } make peek swap [ rethrow ] when
     ] if ; inline
 
-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
-
 TUPLE: condition error restarts continuation ;
 
 C: <condition> condition ( error restarts cc -- condition )

core/destructors/destructors-docs.factor

@@ -0,0 +1,71 @@
+USING: help.markup help.syntax libc kernel continuations io ;
+IN: destructors
+
+HELP: dispose
+{ $values { "disposable" "a disposable object" } }
+{ $contract "Releases operating system resources associated with a disposable object. Disposable objects include streams, memory mapped files, and so on."
+$nl
+"No further operations can be performed on a disposable object after this call."
+$nl
+"Disposing an object which has already been disposed should have no effect, and in particular it should not fail with an error. To help implement this pattern, add a " { $snippet "disposed" } " slot to your object and implement the " { $link dispose* } " method instead." }
+{ $notes "You must close disposable objects after you are finished working with them, to avoid leaking operating system resources. A convenient way to automate this is by using the " { $link with-disposal } " word."
+$nl
+"The default implementation assumes the object has a " { $snippet "disposable" } " slot. If the slot is set to " { $link f } ", it calls " { $link dispose* } " and sets the slot to " { $link f } "." } ;
+
+HELP: dispose*
+{ $values { "disposable" "a disposable object" } }
+{ $contract "Releases operating system resources associated with a disposable object. Disposable objects include streams, memory mapped files, and so on." }
+{ $notes
+    "This word should not be called directly. It can be implemented on objects with a " { $snippet "disposable" } " slot to ensure that the object is only disposed once."
+} ;
+
+HELP: with-disposal
+{ $values { "object" "a disposable object" } { "quot" "a quotation with stack effect " { $snippet "( object -- )" } } }
+{ $description "Calls the quotation, disposing the object with " { $link dispose } " after the quotation returns or if it throws an error." } ;
+
+HELP: with-destructors
+{ $values { "quot" "a quotation" } }
+{ $description "Calls a quotation within a new dynamic scope. This quotation may register destructors, on any object, by wrapping the object in a destructor and implementing " { $link dispose } " on that object type.  After the quotation finishes, if an error was thrown, all destructors are called and the error is then rethrown.  However, if the quotation was successful, only those destructors created with an 'always cleanup' flag will be destroyed." }
+{ $notes
+    "Destructors generalize " { $link with-disposal } ". The following two lines are equivalent, except that the second line establishes a new dynamic scope:"
+    { $code
+        "[ X ] with-disposal"
+        "[ &dispose X ] with-destructors"
+    }
+}
+{ $examples
+    { $code "[ 10 malloc &free ] with-destructors" }
+} ;
+
+HELP: &dispose
+{ $values { "disposable" "a disposable object" } }
+{ $description "Marks the object for unconditional disposal at the end of the current " { $link with-destructors } " scope." } ;
+
+HELP: |dispose
+{ $values { "disposable" "a disposable object" } }
+{ $description "Marks the object for disposal in the event of an error at the end of the current " { $link with-destructors } " scope." } ;
+
+ARTICLE: "destructors-anti-patterns" "Resource disposal anti-patterns"
+"Words which create objects corresponding to external resources should always be used with " { $link with-disposal } ". The following code is wrong:"
+{ $code
+    "<external-resource> ... do stuff ... dispose"
+}
+"The reason being that if " { $snippet "do stuff" } " throws an error, the resource will not be disposed of. The most important case where this can occur is with I/O streams, and the correct solution is to always use " { $link with-input-stream } " and " { $link with-output-stream } "; see " { $link "stdio" } " for details." ;
+
+ARTICLE: "destructors" "Deterministic resource disposal"
+"Operating system resources such as streams, memory mapped files, and so on are not managed by Factor's garbage collector and must be released when you are done with them. Failing to release a resource can lead to reduced performance and instability."
+$nl
+"Disposable object protocol:"
+{ $subsection dispose }
+{ $subsection dispose* }
+"Utility word for scoped disposal:"
+{ $subsection with-disposal }
+"Utility word for disposing multiple objects:"
+{ $subsection dispose-each }
+"Utility words for more complex disposal patterns:"
+{ $subsection with-destructors }
+{ $subsection &dispose }
+{ $subsection |dispose }
+{ $subsection "destructors-anti-patterns" } ;
+
+ABOUT: "destructors"

core/destructors/destructors.factor

@@ -0,0 +1,56 @@
+! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors continuations kernel namespaces
+sequences vectors ;
+IN: destructors
+
+TUPLE: disposable disposed ;
+
+GENERIC: dispose* ( disposable -- )
+
+ERROR: already-disposed disposable ;
+
+: check-disposed ( disposable -- )
+    dup disposed>> [ already-disposed ] [ drop ] if ; inline
+
+GENERIC: dispose ( disposable -- )
+
+M: object dispose
+    dup disposed>> [ drop ] [ t >>disposed dispose* ] if ;
+
+: dispose-each ( seq -- )
+    [
+        [ [ dispose ] curry [ , ] recover ] each
+    ] { } make dup empty? [ drop ] [ peek rethrow ] if ;
+
+: with-disposal ( object quot -- )
+    over [ dispose ] curry [ ] cleanup ; inline
+
+<PRIVATE
+
+SYMBOL: always-destructors
+
+SYMBOL: error-destructors
+
+: do-always-destructors ( -- )
+    always-destructors get <reversed> dispose-each ;
+
+: do-error-destructors ( -- )
+    error-destructors get <reversed> dispose-each ;
+
+PRIVATE>
+
+: &dispose ( disposable -- disposable )
+    dup always-destructors get push ; inline
+
+: |dispose ( disposable -- disposable )
+    dup error-destructors get push ; inline
+
+: with-destructors ( quot -- )
+    [
+        V{ } clone always-destructors set
+        V{ } clone error-destructors set
+        [ do-always-destructors ]
+        [ do-error-destructors ]
+        cleanup
+    ] with-scope ; inline

core/io/encodings/encodings.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: math kernel sequences sbufs vectors namespaces growable
-strings io classes continuations combinators io.styles
+strings io classes continuations destructors combinators
-io.streams.plain splitting byte-arrays sequences.private
+io.styles io.streams.plain splitting byte-arrays
-accessors ;
+sequences.private accessors ;
 IN: io.encodings
 
 ! The encoding descriptor protocol

core/io/files/files-docs.factor

@@ -300,8 +300,8 @@ HELP: exists?
 { $description "Tests if the file named by " { $snippet "path" } " exists." } ;
 
 HELP: directory?
-{ $values { "path" "a pathname string" } { "?" "a boolean" } }
+{ $values { "file-info" file-info } { "?" "a boolean" } }
-{ $description "Tests if " { $snippet "path" } " names a directory." } ;
+{ $description "Tests if " { $snippet "file-info" } " is a directory." } ;
 
 HELP: (directory)
 { $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }

core/io/files/files-tests.factor

@@ -1,14 +1,14 @@
 IN: io.files.tests
 USING: tools.test io.files io.files.private io threads kernel
 continuations io.encodings.ascii io.files.unique sequences
-strings accessors io.encodings.utf8 math ;
+strings accessors io.encodings.utf8 math destructors ;
 
 \ exists? must-infer
 \ (exists?) must-infer
 
 [ ] [ "blahblah" temp-file dup exists? [ delete-directory ] [ drop ] if ] unit-test
 [ ] [ "blahblah" temp-file make-directory ] unit-test
-[ t ] [ "blahblah" temp-file directory? ] unit-test
+[ t ] [ "blahblah" temp-file file-info directory? ] unit-test
 
 [ t ] [
     [ temp-directory "loldir" append-path delete-directory ] ignore-errors

core/io/files/files.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.backend io.files.private io hashtables kernel math
 memory namespaces sequences strings assocs arrays definitions
-system combinators splitting sbufs continuations io.encodings
+system combinators splitting sbufs continuations destructors
-io.encodings.binary init accessors math.order ;
+io.encodings io.encodings.binary init accessors math.order ;
 IN: io.files
 
 HOOK: (file-reader) io-backend ( path -- stream )
@@ -172,11 +172,9 @@ SYMBOL: +socket+
 SYMBOL: +unknown+
 
 ! File metadata
-: exists? ( path -- ? )
+: exists? ( path -- ? ) normalize-path (exists?) ;
-    normalize-path (exists?) ;
 
-: directory? ( path -- ? )
+: directory? ( file-info -- ? ) type>> +directory+ = ;
-    file-info file-info-type +directory+ = ;
 
 <PRIVATE
 
@@ -232,7 +230,7 @@ HOOK: make-directory io-backend ( path -- )
 : fixup-directory ( path seq -- newseq )
     [
         dup string?
-        [ tuck append-path directory? 2array ] [ nip ] if
+        [ tuck append-path file-info directory? 2array ] [ nip ] if
     ] with map
     [ first { "." ".." } member? not ] filter ;
 

core/io/io-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax quotations hashtables kernel
-classes strings continuations ;
+classes strings continuations destructors ;
 IN: io
 
 ARTICLE: "stream-protocol" "Stream protocol"

core/io/io.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: hashtables generic kernel math namespaces sequences
-continuations assocs io.styles ;
+continuations destructors assocs io.styles ;
 IN: io
 
 GENERIC: stream-readln ( stream -- str/f )

core/io/streams/c/c.factor

@@ -2,37 +2,37 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private namespaces io io.encodings
 sequences math generic threads.private classes io.backend
-io.files continuations byte-arrays ;
+io.files continuations destructors byte-arrays accessors ;
 IN: io.streams.c
 
-TUPLE: c-writer handle ;
+TUPLE: c-writer handle disposed ;
 
-C: <c-writer> c-writer
+: <c-writer> ( handle -- stream ) f c-writer boa ;
 
 M: c-writer stream-write1
-    c-writer-handle fputc ;
+    handle>> fputc ;
 
 M: c-writer stream-write
-    c-writer-handle fwrite ;
+    handle>> fwrite ;
 
 M: c-writer stream-flush
-    c-writer-handle fflush ;
+    handle>> fflush ;
 
-M: c-writer dispose
+M: c-writer dispose*
-    c-writer-handle fclose ;
+    handle>> fclose ;
 
-TUPLE: c-reader handle ;
+TUPLE: c-reader handle disposed ;
 
-C: <c-reader> c-reader
+: <c-reader> ( handle -- stream ) f c-reader boa ;
 
 M: c-reader stream-read
-    c-reader-handle fread ;
+    handle>> fread ;
 
 M: c-reader stream-read-partial
     stream-read ;
 
 M: c-reader stream-read1
-    c-reader-handle fgetc ;
+    handle>> fgetc ;
 
 : read-until-loop ( stream delim -- ch )
     over stream-read1 dup [
@@ -45,8 +45,8 @@ M: c-reader stream-read-until
     [ swap read-until-loop ] B{ } make swap
     over empty? over not and [ 2drop f f ] when ;
 
-M: c-reader dispose
+M: c-reader dispose*
-    c-reader-handle fclose ;
+    handle>> fclose ;
 
 M: object init-io ;
 

core/io/streams/nested/nested.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays generic assocs kernel namespaces strings
-quotations io continuations accessors sequences ;
+quotations io continuations destructors accessors sequences ;
 IN: io.streams.nested
 
 TUPLE: filter-writer stream ;

core/io/streams/string/string.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2003, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io kernel math namespaces sequences sbufs strings
-generic splitting growable continuations io.streams.plain
+generic splitting growable continuations destructors
-io.encodings math.order ;
+io.streams.plain io.encodings math.order ;
 IN: io.streams.string
 
 M: growable dispose drop ;

core/libc/libc-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax alien ;
+USING: help.markup help.syntax alien destructors ;
 IN: libc
 
 HELP: malloc
@@ -36,5 +36,13 @@ HELP: with-malloc
 { $values { "size" "a positive integer" } { "quot" "a quotation with stack effect " { $snippet "( c-ptr -- )" } } }
 { $description "Allocates a zeroed block of " { $snippet "n" } " bytes and passes it to the quotation. When the quotation returns, the block is freed." } ;
 
+HELP: &free
+{ $values { "alien" c-ptr } }
+{ $description "Marks the block of memory for unconditional deallocation at the end of the current " { $link with-destructors } " scope." } ;
+
+HELP: |free
+{ $values { "alien" c-ptr } }
+{ $description "Marks the object for deallocation in the event of an error at the end of the current " { $link with-destructors } " scope." } ;
+
 ! Defined in alien-docs.factor
 ABOUT: "malloc"

core/libc/libc.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2004, 2005 Mackenzie Straight
-! Copyright (C) 2007 Slava Pestov
+! Copyright (C) 2007, 2008 Slava Pestov
-! Copyright (C) 2007 Doug Coleman
+! Copyright (C) 2007, 2008 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien assocs continuations init kernel namespaces ;
+USING: alien assocs continuations destructors init kernel
+namespaces accessors ;
 IN: libc
 
 <PRIVATE
@@ -76,3 +77,18 @@ PRIVATE>
 
 : strlen ( alien -- len )
     "size_t" "libc" "strlen" { "char*" } alien-invoke ;
+
+<PRIVATE
+
+! Memory allocations
+TUPLE: memory-destructor alien ;
+
+M: memory-destructor dispose* alien>> free ;
+
+PRIVATE>
+
+: &free ( alien -- alien )
+    dup memory-destructor boa &dispose drop ; inline
+
+: |free ( alien -- alien )
+    dup memory-destructor boa |dispose drop ; inline

extra/benchmark/sockets/sockets.factor

@@ -1,6 +1,7 @@
 USING: io.sockets io kernel math threads io.encodings.ascii
 io.streams.duplex debugger tools.time prettyprint
-concurrency.count-downs namespaces arrays continuations ;
+concurrency.count-downs namespaces arrays continuations
+destructors ;
 IN: benchmark.sockets
 
 SYMBOL: counter

extra/bunny/bunny.factor

@@ -4,7 +4,7 @@ opengl.glu shuffle http.client vectors namespaces ui.gadgets
 ui.gadgets.canvas ui.render ui splitting combinators tools.time
 system combinators.lib float-arrays continuations
 opengl.demo-support multiline ui.gestures bunny.fixed-pipeline
-bunny.cel-shaded bunny.outlined bunny.model accessors ;
+bunny.cel-shaded bunny.outlined bunny.model accessors destructors ;
 IN: bunny
 
 TUPLE: bunny-gadget model geom draw-seq draw-n ;

extra/bunny/cel-shaded/cel-shaded.factor

@@ -1,5 +1,6 @@
-USING: arrays bunny.model continuations kernel multiline opengl opengl.shaders
+USING: arrays bunny.model continuations destructors kernel
-    opengl.capabilities opengl.gl sequences sequences.lib accessors ;
+multiline opengl opengl.shaders opengl.capabilities opengl.gl
+sequences sequences.lib accessors ;
 IN: bunny.cel-shaded
 
 STRING: vertex-shader-source

extra/bunny/fixed-pipeline/fixed-pipeline.factor

@@ -1,4 +1,4 @@
-USING: alien.c-types continuations kernel
+USING: alien.c-types continuations destructors kernel
 opengl opengl.gl bunny.model ;
 IN: bunny.fixed-pipeline
 

extra/bunny/model/model.factor

@@ -2,7 +2,8 @@ USING: alien alien.c-types arrays sequences math math.vectors
 math.matrices math.parser io io.files kernel opengl opengl.gl
 opengl.glu io.encodings.ascii opengl.capabilities shuffle
 http.client vectors splitting tools.time system combinators
-float-arrays continuations namespaces sequences.lib accessors ;
+float-arrays continuations destructors namespaces sequences.lib
+accessors ;
 IN: bunny.model
 
 : numbers ( str -- seq )

extra/bunny/outlined/outlined.factor

@@ -1,7 +1,7 @@
-USING: arrays bunny.model bunny.cel-shaded continuations kernel
+USING: arrays bunny.model bunny.cel-shaded continuations
-math multiline opengl opengl.shaders opengl.framebuffers
+destructors kernel math multiline opengl opengl.shaders
-opengl.gl opengl.capabilities sequences ui.gadgets combinators
+opengl.framebuffers opengl.gl opengl.capabilities sequences
-accessors ;
+ui.gadgets combinators accessors ;
 IN: bunny.outlined
 
 STRING: outlined-pass1-fragment-shader-main-source

extra/cairo/cairo.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: cairo.ffi kernel accessors sequences
-namespaces fry continuations ;
+namespaces fry continuations destructors ;
 IN: cairo
 
 TUPLE: cairo-t alien ;

extra/checksums/openssl/openssl.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors byte-arrays alien.c-types kernel continuations
-sequences io openssl openssl.libcrypto checksums ;
+destructors sequences io openssl openssl.libcrypto checksums ;
 IN: checksums.openssl
 
 ERROR: unknown-digest name ;

extra/combinators/lib/lib-tests.factor

@@ -19,6 +19,13 @@ IN: combinators.lib.tests
 [ { 1 2 } { 2 4 } { 3 8 } { 4 16 } { 5 32 } ] [ 1 2 3 4 5 [ dup 2^ 2array ] 5 napply ] unit-test
 [ [ dup 2^ 2array ] 5 napply ] must-infer
 
+[ { "xyc" "xyd" } ] [ "x" "y" { "c" "d" } [ 3append ] 2 nwith map ] unit-test
+
+[ { "foo" "xbarx" } ]
+[
+    { "oof" "bar" } { [ reverse ] [ "x" swap "x" 3append ] } parallel-call
+] unit-test
+
 ! &&
 
 [ t ] [

extra/combinators/lib/lib.factor

@@ -4,7 +4,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel combinators fry namespaces quotations hashtables
 sequences assocs arrays inference effects math math.ranges
-arrays.lib shuffle macros bake continuations ;
+arrays.lib shuffle macros continuations locals ;
 
 IN: combinators.lib
 
@@ -20,17 +20,15 @@ MACRO: nslip ( n -- ) dup saver [ call ] rot restorer 3append ;
 
 MACRO: nkeep ( n -- )
   [ ] [ 1+ ] [ ] tri
-  [ [ , ndup ] dip , -nrot , nslip ]
+  '[ [ , ndup ] dip , -nrot , nslip ] ;
-  bake ;
 
 : 4keep ( w x y z quot -- w x y z ) 4 nkeep ; inline 
 
 MACRO: ncurry ( n -- ) [ curry ] n*quot ;
 
-MACRO: nwith ( quot n -- )
+MACRO:: nwith ( quot n -- )
-  tuck 1+ dup
+  [let | n' [ n 1+ ] |
-  [ , -nrot [ , nrot , call ] , ncurry ]
+    [ n' -nrot [ n' nrot quot call ] n ncurry ] ] ;
-  bake ;
 
 MACRO: napply ( n -- )
   2 [a,b]
@@ -110,8 +108,8 @@ MACRO: switch ( quot -- )
 ! : pcall ( seq quots -- seq ) [ call ] 2map ;
 
 MACRO: parallel-call ( quots -- )
-    [ [ unclip % r> dup >r push ] bake ] map concat
+    [ '[ [ unclip @ ] dip [ push ] keep ] ] map concat
-    [ V{ } clone >r % drop r> >array ] bake ;
+    '[ V{ } clone @ nip >array ] ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! map-call and friends

extra/concurrency/mailboxes/mailboxes.factor

@@ -1,17 +1,13 @@
 ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: concurrency.mailboxes
-USING: dlists threads sequences continuations
+USING: dlists threads sequences continuations destructors
 namespaces random math quotations words kernel arrays assocs
 init system concurrency.conditions accessors debugger ;
 
-TUPLE: mailbox threads data closed ;
+TUPLE: mailbox threads data disposed ;
 
-: check-closed ( mailbox -- )
+M: mailbox dispose* threads>> notify-all ;
-    closed>> [ "Mailbox closed" throw ] when ; inline
-
-M: mailbox dispose
-    t >>closed threads>> notify-all ;
 
 : <mailbox> ( -- mailbox )
     <dlist> <dlist> f mailbox boa ;
@@ -27,7 +23,7 @@ M: mailbox dispose
     >r threads>> r> "mailbox" wait ;
 
 : block-unless-pred ( mailbox timeout pred -- )
-    pick check-closed
+    pick check-disposed
     pick data>> over dlist-contains? [
         3drop
     ] [
@@ -35,7 +31,7 @@ M: mailbox dispose
     ] if ; inline
 
 : block-if-empty ( mailbox timeout -- mailbox )
-    over check-closed
+    over check-disposed
     over mailbox-empty? [
         2dup wait-for-mailbox block-if-empty
     ] [

extra/core-foundation/fsevents/fsevents.factor

@@ -3,7 +3,7 @@
 USING: alien alien.c-types alien.strings alien.syntax kernel
 math sequences namespaces assocs init accessors continuations
 combinators core-foundation core-foundation.run-loop
-io.encodings.utf8 ;
+io.encodings.utf8 destructors ;
 IN: core-foundation.fsevents
 
 ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
@@ -187,7 +187,7 @@ SYMBOL: event-stream-callbacks
         dup [ call drop ] [ 3drop ] if
     ] alien-callback ;
 
-TUPLE: event-stream info handle closed ;
+TUPLE: event-stream info handle disposed ;
 
 : <event-stream> ( quot paths latency flags -- event-stream )
     >r >r >r
@@ -197,13 +197,10 @@ TUPLE: event-stream info handle closed ;
     dup enable-event-stream
     f event-stream boa ;
 
-M: event-stream dispose
+M: event-stream dispose*
-    dup closed>> [ drop ] [
-        t >>closed
     {
         [ info>> remove-event-source-callback ]
         [ handle>> disable-event-stream ]
         [ handle>> FSEventStreamInvalidate ]
         [ handle>> FSEventStreamRelease ]
-        } cleave
+    } cleave ;
-    ] if ;

extra/db/db.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs classes continuations kernel math
+USING: arrays assocs classes continuations destructors kernel math
 namespaces sequences sequences.lib classes.tuple words strings
 tools.walker accessors combinators.lib ;
 IN: db
@@ -25,7 +25,7 @@ GENERIC: make-db* ( seq class -- db )
 GENERIC: db-open ( db -- db )
 HOOK: db-close db ( handle -- )
 
-: dispose-statements ( seq -- ) [ dispose drop ] assoc-each ;
+: dispose-statements ( assoc -- ) values dispose-each ;
 
 : dispose-db ( db -- ) 
     dup db [

extra/db/mysql/mysql.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for license.
-USING: alien continuations io kernel prettyprint sequences
+USING: alien continuations destructors io kernel prettyprint
-db db.mysql.ffi ;
+sequences db db.mysql.ffi ;
 IN: db.mysql
 
 TUPLE: mysql-db handle host user password db port ;

extra/db/postgresql/postgresql.factor

@@ -5,7 +5,7 @@ kernel math math.parser namespaces prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
 combinators sequences.lib classes locals words tools.walker
-namespaces.lib accessors random db.queries ;
+namespaces.lib accessors random db.queries destructors ;
 USE: tools.walker
 IN: db.postgresql
 

extra/db/sqlite/sqlite.factor

@@ -6,7 +6,7 @@ prettyprint sequences strings classes.tuple alien.c-types
 continuations db.sqlite.lib db.sqlite.ffi db.tuples
 words combinators.lib db.types combinators math.intervals
 io namespaces.lib accessors vectors math.ranges random
-math.bitfields.lib db.queries ;
+math.bitfields.lib db.queries destructors ;
 USE: tools.walker
 IN: db.sqlite
 

extra/db/tuples/tuples.factor

@@ -3,7 +3,7 @@
 USING: arrays assocs classes db kernel namespaces
 classes.tuple words sequences slots math accessors
 math.parser io prettyprint db.types continuations
-mirrors sequences.lib combinators.lib ;
+destructors mirrors sequences.lib combinators.lib ;
 IN: db.tuples
 
 : define-persistent ( class table columns -- )

extra/destructors/destructors-docs.factor

@@ -1,16 +0,0 @@
-USING: help.markup help.syntax libc kernel continuations ;
-IN: destructors
-
-HELP: with-destructors
-{ $values { "quot" "a quotation" } }
-{ $description "Calls a quotation within a new dynamic scope. This quotation may register destructors, on any object, by wrapping the object in a destructor and implementing " { $link dispose } " on that object type.  After the quotation finishes, if an error was thrown, all destructors are called and the error is then rethrown.  However, if the quotation was successful, only those destructors created with an 'always cleanup' flag will be destroyed." }
-{ $notes
-    "Destructors generalize " { $link with-disposal } ". The following two lines are equivalent:"
-    { $code
-        "[ X ] with-disposal"
-        "[ &dispose X ] with-destructors"
-    }
-}
-{ $examples
-    { $code "[ 10 malloc &free ] with-destructors" }
-} ;

extra/destructors/destructors.factor

@@ -1,54 +0,0 @@
-! Copyright (C) 2007 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors continuations io.backend libc
-kernel namespaces sequences system vectors ;
-IN: destructors
-
-<PRIVATE
-
-SYMBOL: always-destructors
-
-SYMBOL: error-destructors
-
-: do-always-destructors ( -- )
-    always-destructors get <reversed> dispose-each ;
-
-: do-error-destructors ( -- )
-    error-destructors get <reversed> dispose-each ;
-
-PRIVATE>
-
-: &dispose dup always-destructors get push ; inline
-
-: |dispose dup error-destructors get push ; inline
-
-: with-destructors ( quot -- )
-    [
-        V{ } clone always-destructors set
-        V{ } clone error-destructors set
-        [ do-always-destructors ]
-        [ do-error-destructors ] cleanup
-    ] with-scope ; inline
-
-TUPLE: only-once object destroyed ;
-
-M: only-once dispose
-    dup destroyed>> [ drop ] [
-        [ object>> dispose ] [ t >>destroyed drop ] bi
-    ] if ;
-
-: <only-once> f only-once boa ;
-
-! Memory allocations
-TUPLE: memory-destructor alien ;
-
-C: <memory-destructor> memory-destructor
-
-M: memory-destructor dispose ( obj -- )
-    alien>> free ;
-
-: &free ( alien -- alien )
-    <memory-destructor> <only-once> &dispose ; inline
-
-: |free ( alien -- alien )
-    <memory-destructor> <only-once> |dispose ; inline

extra/help/handbook/handbook.factor

@@ -105,6 +105,7 @@ ARTICLE: "objects" "Objects"
 "An " { $emphasis "object" } " is any datum which may be identified. All values are objects in Factor. Each object carries type information, and types are checked at runtime; Factor is dynamically typed."
 { $subsection "equality" }
 { $subsection "math.order" }
+{ $subsection "destructors" }
 { $subsection "classes" }
 { $subsection "tuples" }
 { $subsection "generic" }
@@ -207,7 +208,8 @@ ARTICLE: "io" "Input and output"
 { $subsection "io.pipes" }
 { $heading "Other features" }
 { $subsection "io.timeouts" }
-{ $subsection "checksums" } ;
+{ $subsection "checksums" }
+{ $see-also "destructors" } ;
 
 ARTICLE: "tools" "Developer tools"
 { $subsection "tools.vocabs" }

extra/html/html.factor

@@ -3,7 +3,7 @@
 USING: generic assocs help http io io.styles io.files continuations
 io.streams.string kernel math math.order math.parser namespaces
 quotations assocs sequences strings words html.elements
-xml.entities sbufs continuations ;
+xml.entities sbufs continuations destructors ;
 IN: html
 
 GENERIC: browser-link-href ( presented -- href )

extra/http/server/static/static.factor

@@ -91,7 +91,7 @@ TUPLE: file-responder root hook special allow-listings ;
 
 : serve-object ( filename -- response )
     serving-path dup exists?
-    [ dup directory? [ serve-directory ] [ serve-file ] if ]
+    [ dup file-info directory? [ serve-directory ] [ serve-file ] if ]
     [ drop <404> ]
     if ;
 

extra/io/launcher/launcher.factor

@@ -151,7 +151,7 @@ M: process timed-out kill-process ;
 
 M: object run-pipeline-element
     [ >process swap >>stdout swap >>stdin run-detached ]
-    [ drop [ [ close-handle ] when* ] bi@ ]
+    [ drop [ [ dispose ] when* ] bi@ ]
     3bi
     wait-for-process ;
 
@@ -164,7 +164,7 @@ M: object run-pipeline-element
                     [ swap out>> or ] change-stdout
                 run-detached
             ]
-            [ out>> close-handle ]
+            [ out>> dispose ]
             [ in>> <input-port> ]
         } cleave r> <decoder>
     ] with-destructors ;
@@ -181,7 +181,7 @@ M: object run-pipeline-element
                     [ swap in>> or ] change-stdout
                 run-detached
             ]
-            [ in>> close-handle ]
+            [ in>> dispose ]
             [ out>> <output-port> ]
         } cleave r> <encoder>
     ] with-destructors ;
@@ -199,7 +199,7 @@ M: object run-pipeline-element
                     [ swap in>> or ] change-stdin
                 run-detached
             ]
-            [ [ out>> close-handle ] [ in>> close-handle ] bi* ]
+            [ [ out>> dispose ] [ in>> dispose ] bi* ]
             [ [ in>> <input-port> ] [ out>> <output-port> ] bi* ]
         } 2cleave r> <encoder-duplex>
     ] with-destructors ;

extra/io/mmap/mmap-docs.factor

@@ -1,4 +1,5 @@
-USING: help.markup help.syntax alien math continuations ;
+USING: help.markup help.syntax alien math continuations
+destructors ;
 IN: io.mmap
 
 HELP: mapped-file

extra/io/mmap/mmap.factor

@@ -1,23 +1,19 @@
 ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: continuations io.backend kernel quotations sequences
+USING: continuations destructors io.backend kernel quotations
-system alien alien.accessors accessors sequences.private ;
+sequences system alien alien.accessors accessors
+sequences.private ;
 IN: io.mmap
 
-TUPLE: mapped-file address handle length closed ;
+TUPLE: mapped-file address handle length disposed ;
 
-: check-closed ( mapped-file -- mapped-file )
+M: mapped-file length dup check-disposed length>> ;
-    dup closed>> [
-        "Mapped file is closed" throw
-    ] when ; inline
-
-M: mapped-file length check-closed length>> ;
 
 M: mapped-file nth-unsafe
-    check-closed address>> swap alien-unsigned-1 ;
+    dup check-disposed address>> swap alien-unsigned-1 ;
 
 M: mapped-file set-nth-unsafe
-    check-closed address>> swap set-alien-unsigned-1 ;
+    dup check-disposed address>> swap set-alien-unsigned-1 ;
 
 INSTANCE: mapped-file sequence
 
@@ -29,10 +25,7 @@ HOOK: (mapped-file) io-backend ( path length -- address handle )
 
 HOOK: close-mapped-file io-backend ( mmap -- )
 
-M: mapped-file dispose ( mmap -- )
+M: mapped-file dispose* ( mmap -- ) close-mapped-file ;
-    dup closed>> [ drop ] [
-        t >>closed close-mapped-file
-    ] if ;
 
 : with-mapped-file ( path length quot -- )
     >r <mapped-file> r> with-disposal ; inline

extra/io/monitors/monitors-docs.factor

@@ -1,5 +1,5 @@
 IN: io.monitors
-USING: help.markup help.syntax continuations
+USING: help.markup help.syntax continuations destructors
 concurrency.mailboxes quotations ;
 
 HELP: with-monitors

extra/io/monitors/monitors-tests.factor

@@ -1,7 +1,7 @@
 IN: io.monitors.tests
 USING: io.monitors tools.test io.files system sequences
 continuations namespaces concurrency.count-downs kernel io
-threads calendar prettyprint ;
+threads calendar prettyprint destructors ;
 
 os { winnt linux macosx } member? [
     [

extra/io/monitors/monitors.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io.backend kernel continuations namespaces sequences
+USING: io.backend kernel continuations destructors namespaces
-assocs hashtables sorting arrays threads boxes io.timeouts
+sequences assocs hashtables sorting arrays threads boxes
-accessors concurrency.mailboxes ;
+io.timeouts accessors concurrency.mailboxes ;
 IN: io.monitors
 
 HOOK: init-monitors io-backend ( -- )

extra/io/monitors/recursive/recursive.factor

@@ -1,13 +1,14 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors sequences assocs arrays continuations combinators kernel
+USING: accessors sequences assocs arrays continuations
-threads concurrency.messaging concurrency.mailboxes concurrency.promises
+destructors combinators kernel threads concurrency.messaging
-io.files io.monitors debugger ;
+concurrency.mailboxes concurrency.promises io.files io.monitors
+debugger ;
 IN: io.monitors.recursive
 
 ! Simulate recursive monitors on platforms that don't have them
 
-TUPLE: recursive-monitor < monitor children thread ready ;
+TUPLE: recursive-monitor < monitor children thread ready disposed ;
 
 : notify? ( -- ? ) monitor tget ready>> promise-fulfilled? ;
 
@@ -35,13 +36,10 @@ DEFER: add-child-monitor
 : remove-child-monitor ( monitor -- )
     monitor tget children>> delete-at* [ dispose ] [ drop ] if ;
 
-M: recursive-monitor dispose
+M: recursive-monitor dispose*
-    dup queue>> closed>> [
-        drop
-    ] [
     [ "stop" swap thread>> send-synchronous drop ]
-        [ queue>> dispose ] bi
+    [ queue>> dispose ]
-    ] if ;
+    bi ;
 
 : stop-pump ( -- )
     monitor tget children>> [ nip dispose ] assoc-each ;

extra/io/pipes/pipes-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax continuations io ;
+USING: help.markup help.syntax continuations destructors io ;
 IN: io.pipes
 
 HELP: pipe

extra/io/pipes/pipes-tests.factor

@@ -1,6 +1,6 @@
 USING: io io.pipes io.streams.string io.encodings.utf8
 io.streams.duplex io.encodings io.timeouts namespaces
-continuations tools.test kernel calendar ;
+continuations tools.test kernel calendar destructors ;
 IN: io.pipes.tests
 
 [ "Hello" ] [

extra/io/pipes/pipes.factor

@@ -9,7 +9,7 @@ IN: io.pipes
 TUPLE: pipe in out ;
 
 M: pipe dispose ( pipe -- )
-    [ in>> close-handle ] [ out>> close-handle ] bi ;
+    [ in>> dispose ] [ out>> dispose ] bi ;
 
 HOOK: (pipe) io-backend ( -- pipe )
 

extra/io/ports/ports-docs.factor

@@ -1,5 +1,6 @@
 USING: io io.buffers io.backend help.markup help.syntax kernel
-byte-arrays sbufs words continuations byte-vectors classes ;
+byte-arrays sbufs words continuations destructors
+byte-vectors classes ;
 IN: io.ports
 
 ARTICLE: "io.ports" "Non-blocking I/O implementation"

extra/io/ports/ports.factor

@@ -10,7 +10,7 @@ IN: io.ports
 SYMBOL: default-buffer-size
 64 1024 * default-buffer-size set-global
 
-TUPLE: port handle error timeout closed ;
+TUPLE: port handle error timeout disposed ;
 
 M: port timeout timeout>> ;
 
@@ -18,21 +18,6 @@ M: port set-timeout (>>timeout) ;
 
 GENERIC: init-handle ( handle -- )
 
-GENERIC: close-handle ( handle -- )
-
-TUPLE: handle-destructor handle ;
-
-C: <handle-destructor> handle-destructor
-
-M: handle-destructor dispose ( obj -- )
-    handle>> close-handle ;
-
-: &close-handle ( handle -- handle )
-    dup <handle-destructor> <only-once> &dispose drop ; inline
-
-: |close-handle ( handle -- handle )
-    dup <handle-destructor> <only-once> |dispose drop ; inline
-
 : <port> ( handle class -- port )
     new
         swap dup init-handle >>handle ; inline
@@ -40,14 +25,6 @@ M: handle-destructor dispose ( obj -- )
 : pending-error ( port -- )
     [ f ] change-error drop [ throw ] when* ;
 
-ERROR: port-closed-error port ;
-
-M: port-closed-error summary
-    drop "Port has been closed" ;
-
-: check-closed ( port -- port )
-    dup closed>> [ port-closed-error ] when ;
-
 TUPLE: buffered-port < port buffer ;
 
 : <buffered-port> ( handle class -- port )
@@ -69,7 +46,7 @@ HOOK: (wait-to-read) io-backend ( port -- )
     [ f >>eof drop f ] r> if ; inline
 
 M: input-port stream-read1
-    check-closed
+    dup check-disposed
     dup wait-to-read [ buffer>> buffer-pop ] unless-eof ;
 
 : read-step ( count port -- byte-array/f )
@@ -77,7 +54,7 @@ M: input-port stream-read1
     [ dupd buffer>> buffer-read ] unless-eof nip ;
 
 M: input-port stream-read-partial ( max stream -- byte-array/f )
-    check-closed
+    dup check-disposed
     >r 0 max >integer r> read-step ;
 
 : read-loop ( count port accum -- )
@@ -92,7 +69,7 @@ M: input-port stream-read-partial ( max stream -- byte-array/f )
     ] if ;
 
 M: input-port stream-read
-    check-closed
+    dup check-disposed
     >r 0 max >fixnum r>
     2dup read-step dup [
         pick over length > [
@@ -115,12 +92,12 @@ TUPLE: output-port < buffered-port ;
     tuck buffer>> can-write? [ drop ] [ stream-flush ] if ;
 
 M: output-port stream-write1
-    check-closed
+    dup check-disposed
     1 over wait-to-write
     buffer>> byte>buffer ;
 
 M: output-port stream-write
-    check-closed
+    dup check-disposed
     over length over buffer>> buffer-size > [
         [ buffer>> buffer-size <groups> ]
         [ [ stream-write ] curry ] bi
@@ -136,15 +113,13 @@ HOOK: (wait-to-write) io-backend ( port -- )
     dup buffer>> buffer-empty? [ drop ] [ (wait-to-write) ] if ;
 
 M: output-port stream-flush ( port -- )
-    check-closed
+    dup check-disposed
     [ flush-port ] [ pending-error ] bi ;
 
-GENERIC: close-port ( port -- )
+M: output-port dispose*
-
-M: output-port close-port
     [ flush-port ] [ call-next-method ] bi ;
 
-M: buffered-port close-port
+M: buffered-port dispose*
     [ call-next-method ]
     [ [ [ buffer-free ] when* f ] change-buffer drop ]
     bi ;
@@ -153,11 +128,7 @@ HOOK: cancel-io io-backend ( port -- )
 
 M: port timed-out cancel-io ;
 
-M: port close-port
+M: port dispose* [ cancel-io ] [ handle>> dispose ] bi ;
-    [ cancel-io ] [ handle>> close-handle ] bi ;
-
-M: port dispose
-    dup closed>> [ drop ] [ t >>closed close-port ] if ;
 
 : <ports> ( read-handle write-handle -- input-port output-port )
     [

extra/io/server/server.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.sockets io.files io.streams.duplex logging
-continuations kernel math math.parser namespaces parser
+continuations destructors kernel math math.parser namespaces
-sequences strings prettyprint debugger quotations calendar
+parser sequences strings prettyprint debugger quotations
-threads concurrency.combinators assocs fry ;
+calendar threads concurrency.combinators assocs fry ;
 IN: io.server
 
 SYMBOL: servers

extra/io/sockets/secure/secure.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel symbols namespaces continuations
-io.sockets sequences ;
+destructors io.sockets sequences ;
 IN: io.sockets.secure
 
 SYMBOL: ssl-backend

extra/io/sockets/sockets-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax io io.backend threads
-strings byte-arrays continuations quotations ;
+strings byte-arrays continuations destructors quotations ;
 IN: io.sockets
 
 ARTICLE: "network-addressing" "Address specifiers"

extra/io/sockets/sockets.factor

@@ -187,7 +187,7 @@ SYMBOL: local-address
 TUPLE: server-port < port addr encoding ;
 
 : check-server-port ( port -- port )
-    check-closed
+    dup check-disposed
     dup server-port? [ "Not a server port" throw ] unless ; inline
 
 GENERIC: (server) ( addrspec -- handle )
@@ -216,7 +216,7 @@ HOOK: (datagram) io-backend ( addr -- datagram )
     dup (datagram) datagram-port <port> swap >>addr ;
 
 : check-datagram-port ( port -- port )
-    check-closed
+    dup check-disposed
     dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
 
 HOOK: (receive) io-backend ( datagram -- packet addrspec )

extra/io/streams/duplex/duplex-docs.factor

@@ -18,9 +18,6 @@ HELP: <duplex-stream>
 { $values { "in" "an input stream" } { "out" "an output stream" } { "stream" " a duplex stream" } }
 { $description "Creates a duplex stream. Writing to a duplex stream will write to " { $snippet "out" } ", and reading from a duplex stream will read from " { $snippet "in" } ". Closing a duplex stream closes both the input and output streams." } ;
 
-HELP: stream-closed-twice
-{ $error-description "This error is thrown when performing an I/O operation on a " { $link duplex-stream } " which has been closed with " { $link dispose } "." } ;
-
 HELP: with-stream
 { $values { "stream" duplex-stream } { "quot" quotation } }
 { $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to  " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;

extra/io/streams/duplex/duplex-tests.factor

@@ -1,18 +1,13 @@
 USING: io.streams.duplex io io.streams.string
-kernel continuations tools.test ;
+kernel continuations tools.test destructors accessors ;
 IN: io.streams.duplex.tests
 
 ! Test duplex stream close behavior
-TUPLE: closing-stream closed? ;
+TUPLE: closing-stream < disposable ;
 
 : <closing-stream> closing-stream new ;
 
-M: closing-stream dispose
+M: closing-stream dispose* drop ;
-    dup closing-stream-closed? [
-        "Closing twice!" throw
-    ] [
-        t swap set-closing-stream-closed?
-    ] if ;
 
 TUPLE: unclosable-stream ;
 
@@ -30,14 +25,14 @@ M: unclosable-stream dispose
     <unclosable-stream> <closing-stream> [
         <duplex-stream>
         [ dup dispose ] [ 2drop ] recover
-    ] keep closing-stream-closed?
+    ] keep disposed>>
 ] unit-test
 
 [ t ] [
     <closing-stream> [ <unclosable-stream>
         <duplex-stream>
         [ dup dispose ] [ 2drop ] recover
-    ] keep closing-stream-closed?
+    ] keep disposed>>
 ] unit-test
 
 [ "Hey" ] [

extra/io/streams/duplex/duplex.factor

@@ -1,50 +1,33 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations io io.encodings io.encodings.private
+USING: kernel continuations destructors io io.encodings
-io.timeouts debugger inspector listener accessors delegate
+io.encodings.private io.timeouts debugger inspector listener
-delegate.protocols ;
+accessors delegate delegate.protocols ;
 IN: io.streams.duplex
 
 ! We ensure that the stream can only be closed once, to preserve
 ! integrity of duplex I/O ports.
 
-TUPLE: duplex-stream in out closed ;
+TUPLE: duplex-stream in out ;
 
-: <duplex-stream> ( in out -- stream )
+C: <duplex-stream> duplex-stream
-    f duplex-stream boa ;
 
-ERROR: stream-closed-twice ;
+CONSULT: input-stream-protocol duplex-stream in>> ;
 
-M: stream-closed-twice summary
+CONSULT: output-stream-protocol duplex-stream out>> ;
-    drop "Attempt to perform I/O on closed stream" ;
-
-<PRIVATE
-
-: check-closed ( stream -- stream )
-    dup closed>> [ stream-closed-twice ] when ; inline
-
-: in ( duplex -- stream ) check-closed in>> ;
-
-: out ( duplex -- stream ) check-closed out>> ;
-
-PRIVATE>
-
-CONSULT: input-stream-protocol duplex-stream in ;
-
-CONSULT: output-stream-protocol duplex-stream out ;
 
 M: duplex-stream set-timeout
-    [ in set-timeout ] [ out set-timeout ] 2bi ;
+    [ in>> set-timeout ] [ out>> set-timeout ] 2bi ;
 
 M: duplex-stream dispose
     #! The output stream is closed first, in case both streams
     #! are attached to the same file descriptor, the output
     #! buffer needs to be flushed before we close the fd.
-    dup closed>> [
+    [
-        t >>closed
+        [ out>> &dispose drop ]
-        [ dup out>> dispose ]
+        [ in>> &dispose drop ]
-        [ dup in>> dispose ] [ ] cleanup
+        bi
-    ] unless drop ;
+    ] with-destructors ;
 
 : <encoder-duplex> ( stream-in stream-out encoding -- duplex )
     tuck re-encode >r re-decode r> <duplex-stream> ;

extra/io/streams/null/null.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: io.streams.null
-USING: kernel io io.timeouts io.streams.duplex continuations ;
+USING: kernel io io.timeouts io.streams.duplex destructors ;
 
 TUPLE: null-stream ;
 

extra/io/unix/backend/backend.factor

@@ -4,20 +4,18 @@ USING: alien generic assocs kernel kernel.private math
 io.ports sequences strings structs sbufs threads unix
 vectors io.buffers io.backend io.encodings math.parser
 continuations system libc qualified namespaces io.timeouts
-io.encodings.utf8 accessors inspector combinators ;
+io.encodings.utf8 destructors accessors inspector combinators ;
 QUALIFIED: io
 IN: io.unix.backend
 
 ! I/O tasks
 GENERIC: handle-fd ( handle -- fd )
 
-TUPLE: fd fd closed ;
+TUPLE: fd fd disposed ;
 
 : <fd> ( n -- fd ) f fd boa ;
 
-M: fd dispose
+M: fd dispose* fd>> close-file ;
-    dup closed>>
-    [ drop ] [ t >>closed fd>> close-file ] if ;
 
 M: fd handle-fd fd>> ;
 
@@ -112,8 +110,6 @@ M: fd init-handle ( fd -- )
     [ F_SETFL O_NONBLOCK fcntl drop ]
     [ F_SETFD FD_CLOEXEC fcntl drop ] bi ;
 
-M: fd close-handle ( fd -- ) dispose ;
-
 ! Readers
 : eof ( reader -- )
     dup buffer>> buffer-empty? [ t >>eof ] when drop ;

extra/io/unix/files/files.factor

@@ -33,7 +33,7 @@ M: unix (file-writer) ( path -- stream )
 
 : open-append ( path -- fd )
     [
-        append-flags file-mode open-file |close-handle
+        append-flags file-mode open-file |dispose
         dup 0 SEEK_END lseek io-error
     ] with-destructors ;
 

extra/io/unix/launcher/launcher-tests.factor

@@ -1,7 +1,7 @@
 IN: io.unix.launcher.tests
 USING: io.files tools.test io.launcher arrays io namespaces
 continuations math io.encodings.binary io.encodings.ascii
-accessors kernel sequences io.encodings.utf8 ;
+accessors kernel sequences io.encodings.utf8 destructors ;
 
 [ ] [
     [ "launcher-test-1" temp-file delete-file ] ignore-errors

extra/io/unix/linux/monitors/monitors.factor

@@ -12,7 +12,7 @@ SYMBOL: watches
 
 SYMBOL: inotify
 
-TUPLE: linux-monitor < monitor wd inotify watches ;
+TUPLE: linux-monitor < monitor wd inotify watches disposed ;
 
 : <linux-monitor> ( wd path mailbox -- monitor )
     linux-monitor new-monitor
@@ -54,14 +54,12 @@ M: linux (monitor) ( path recursive? mailbox -- monitor )
         IN_CHANGE_EVENTS swap add-watch
     ] if ;
 
-M: linux-monitor dispose ( monitor -- )
+M: linux-monitor dispose* ( monitor -- )
-    dup inotify>> closed>> [ drop ] [
     [ [ wd>> ] [ watches>> ] bi delete-at ]
     [
         [ inotify>> handle>> ] [ wd>> ] bi
         inotify_rm_watch io-error
-        ] bi
+    ] bi ;
-    ] if ;
 
 : ignore-flags? ( mask -- ? )
     {

extra/io/unix/macosx/macosx.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.unix.bsd io.backend io.monitors core-foundation.fsevents
 continuations kernel sequences namespaces arrays system locals
-accessors ;
+accessors destructors ;
 IN: io.unix.macosx
 
 TUPLE: macosx-monitor < monitor handle ;

extra/io/unix/mmap/mmap.factor

@@ -9,7 +9,7 @@ IN: io.unix.mmap
 :: mmap-open ( length prot flags path -- alien fd )
     [
         f length prot flags
-        path open-r/w |close-handle
+        path open-r/w |dispose
         [ 0 mmap dup MAP_FAILED = [ (io-error) ] when ] keep
     ] with-destructors ;
 

extra/io/unix/sockets/secure/secure.factor

@@ -117,7 +117,7 @@ M: ssl (server) addrspec>> (server) ;
 
 M: ssl (accept)
     [
-        addrspec>> (accept) |close-handle <ssl-socket> |close-handle
+        addrspec>> (accept) |dispose <ssl-socket> |dispose
         dup do-ssl-accept
     ] with-destructors ;
 

extra/io/unix/sockets/sockets.factor

@@ -13,7 +13,7 @@ EXCLUDE: io.sockets => accept ;
 IN: io.unix.sockets
 
 : socket-fd ( domain type -- fd )
-    0 socket dup io-error <fd> |close-handle dup init-handle ;
+    0 socket dup io-error <fd> |dispose dup init-handle ;
 
 : set-socket-option ( fd level opt -- )
     >r >r handle-fd r> r> 1 <int> "int" heap-size setsockopt io-error ;

extra/io/unix/unix-tests.factor

@@ -1,7 +1,7 @@
 USING: io.files io.sockets io kernel threads
 namespaces tools.test continuations strings byte-arrays
 sequences prettyprint system io.encodings.binary io.encodings.ascii
-io.streams.duplex ;
+io.streams.duplex destructors ;
 IN: io.unix.tests
 
 ! Unix domain stream sockets

extra/irc/irc.factor

@@ -3,7 +3,7 @@
 USING: arrays calendar combinators channels concurrency.messaging fry io
        io.encodings.8-bit io.sockets kernel math namespaces sequences
        sequences.lib splitting strings threads
-       continuations classes.tuple ascii accessors ;
+       continuations destructors classes.tuple ascii accessors ;
 IN: irc
 
 ! utils
@@ -143,7 +143,7 @@ SYMBOL: irc-client
     " hostname servername :irc.factor" irc-print ;
 
 : CONNECT ( server port -- stream )
-    <inet> latin1 <client> ;
+    <inet> latin1 <client> drop ;
 
 : JOIN ( channel password -- )
     "JOIN " irc-write

extra/logging/server/server.factor

@@ -1,10 +1,10 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces kernel io calendar sequences io.files
-io.sockets continuations prettyprint assocs math.parser
+io.sockets continuations destructors prettyprint assocs
-words debugger math combinators concurrency.messaging
+math.parser words debugger math combinators
-threads arrays init math.ranges strings calendar.format
+concurrency.messaging threads arrays init math.ranges strings
-io.encodings.utf8 ;
+calendar.format io.encodings.utf8 ;
 IN: logging.server
 
 : log-root ( -- string )

extra/openssl/openssl.factor

@@ -137,14 +137,11 @@ M: ssl-handle init-handle file>> init-handle ;
 
 HOOK: ssl-shutdown io-backend ( handle -- )
 
-M: ssl-handle close-handle
+M: ssl-handle dispose*
-    dup disposed>> [ drop ] [
-        t >>disposed
     [ ssl-shutdown ]
     [ handle>> SSL_free ]
-        [ file>> close-handle ]
+    [ file>> dispose ]
-        tri
+    tri ;
-    ] if ;
 
 ERROR: certificate-verify-error result ;
 

extra/random/windows/windows.factor

@@ -1,7 +1,6 @@
 USING: accessors alien.c-types byte-arrays continuations
 kernel windows windows.advapi32 init namespaces random
 destructors locals ;
-USE: tools.walker
 IN: random.windows
 
 TUPLE: windows-rng provider type ;

extra/semantic-db/semantic-db.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays combinators combinators.cleave combinators.lib
 continuations db db.tuples db.types db.sqlite kernel math
 math.parser namespaces parser sets sequences sequences.deep
-sequences.lib strings words ;
+sequences.lib strings words destructors ;
 IN: semantic-db
 
 TUPLE: node id content ;

extra/shuffle/shuffle.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences namespaces math inference.transforms
-       combinators macros quotations math.ranges bake ;
+       combinators macros quotations math.ranges fry ;
 
 IN: shuffle
 
@@ -19,7 +19,7 @@ MACRO: ndrop ( n -- ) [ drop ] n*quot ;
 
 : nnip ( n -- ) swap >r ndrop r> ; inline
 
-MACRO: ntuck ( n -- ) 2 + [ dup , -nrot ] bake ;
+MACRO: ntuck ( n -- ) 2 + '[ dup , -nrot ] ;
 
 : 2swap ( x y z t -- z t x y ) rot >r rot r> ; inline
 

extra/smtp/server/server.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators kernel prettyprint io io.timeouts io.server
 sequences namespaces io.sockets continuations calendar
-io.encodings.ascii io.streams.duplex ;
+io.encodings.ascii io.streams.duplex destructors ;
 IN: smtp.server
 
 ! Mock SMTP server for testing purposes.

extra/tools/deploy/backend/backend.factor

@@ -6,7 +6,7 @@ continuations math definitions mirrors splitting parser classes
 inspector layouts vocabs.loader prettyprint.config prettyprint
 debugger io.streams.c io.files io.backend
 quotations io.launcher words.private tools.deploy.config
-bootstrap.image io.encodings.utf8 accessors ;
+bootstrap.image io.encodings.utf8 destructors accessors ;
 IN: tools.deploy.backend
 
 : copy-vm ( executable bundle-name extension -- vm )

extra/ui/gadgets/panes/panes.factor

@@ -8,7 +8,8 @@ hashtables io kernel namespaces sequences io.styles strings
 quotations math opengl combinators math.vectors
 sorting splitting io.streams.nested assocs
 ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids
-ui.gadgets.grid-lines classes.tuple models continuations ;
+ui.gadgets.grid-lines classes.tuple models continuations
+destructors ;
 IN: ui.gadgets.panes
 
 TUPLE: pane output current prototype scrolls?