[MLton-devel] cvs commit: bug fix for StreamIO space leak
Stephen Weeks
sweeks@users.sourceforge.net
Mon, 13 Oct 2003 17:10:13 -0700
sweeks 03/10/13 17:10:13
Modified: basis-library/io imperative-io.fun stream-io.fun
stream-io.sig
Log:
I didn't use Jared's patch, but I did use a similar approach. Now,
instead of keeping a list of open instreams, we keep a list of close
functions that have just enough information to close the instream. In
particular, they do not keep the whole instream alive.
Revision Changes Path
1.8 +2 -0 mlton/basis-library/io/imperative-io.fun
Index: imperative-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/imperative-io.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- imperative-io.fun 24 Sep 2003 17:45:25 -0000 1.7
+++ imperative-io.fun 14 Oct 2003 00:10:13 -0000 1.8
@@ -98,6 +98,8 @@
structure StreamIO =
struct
open StreamIO
+ fun makeCloseIn _ = raise Fail "<makeCloseIn>"
+ fun instreamUniq _ = raise Fail "<instreamUniq>"
fun input1' _ = raise (Fail "<input1'>")
fun equalsIn _ = raise (Fail "<equalsIn>")
fun instreamReader _ = raise (Fail "<instreamReader>")
1.17 +39 -29 mlton/basis-library/io/stream-io.fun
Index: stream-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/stream-io.fun,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -r1.16 -r1.17
--- stream-io.fun 9 Oct 2003 18:17:29 -0000 1.16
+++ stream-io.fun 14 Oct 2003 00:10:13 -0000 1.17
@@ -297,7 +297,8 @@
datatype instream = In of {common: {reader: reader,
augmented_reader: reader,
- tail: state ref ref},
+ tail: state ref ref,
+ uniq: unit ref},
pos: int,
buf: buf}
@@ -323,6 +324,7 @@
fun instreamReader is = instreamCommonSel (is, #reader)
fun readerSel (PIO.RD v, sel) = sel v
fun instreamName is = readerSel (instreamReader is, #name)
+ fun instreamUniq is = instreamCommonSel (is, #uniq)
val empty = V.tabulate (0, fn _ => someElem)
val line = V.tabulate (1, fn _ => lineElem)
@@ -598,12 +600,17 @@
| _ => SOME 0
end
- fun closeIn (is as In {common = {tail, ...}, ...}) =
- case !(!tail) of
- End => (!tail := Closed;
- ((readerSel (instreamReader is, #close)) ())
- handle exn => liftExn (instreamName is) "closeIn" exn)
- | _ => ()
+ fun makeCloseIn (In {common = {reader = PIO.RD {close, name, ...},
+ tail, ...},
+ ...}): unit -> unit =
+ fn () =>
+ case !(!tail) of
+ End =>
+ (!tail := Closed
+ ; close () handle exn => liftExn name "closeIn" exn)
+ | _ => ()
+
+ fun closeIn ins = makeCloseIn ins ()
fun endOfStream is =
let val (inp, _) = input is
@@ -634,7 +641,8 @@
in
In {common = {reader = reader,
augmented_reader = PIO.augmentReader reader,
- tail = ref next},
+ tail = ref next,
+ uniq = ref ()},
pos = 0,
buf = buf}
end
@@ -788,24 +796,25 @@
SOME ioDesc => valOf (Posix.FileSys.iodToFD ioDesc)
| NONE => liftExn (instreamName is) "inFd" (Fail "<no ioDesc>")
- val openInstreams : (instream * {close: bool}) list ref = ref []
+ val closeAtExits: {close: unit -> unit, uniq: unit ref} list ref = ref []
val mkInstream'' =
let
- val _ = Cleaner.addNew
- (Cleaner.atExit, fn () =>
- List.app (fn (is, {close}) =>
- if close
- then closeIn is
- else ()) (!openInstreams))
+ val _ = Cleaner.addNew (Cleaner.atExit, fn () =>
+ List.app (fn {close, ...} => close ())
+ (!closeAtExits))
in
- fn {reader, closed, buffer_contents, atExit} =>
+ fn {reader, closed, buffer_contents, atExit = {close = closeAtExit}} =>
let
- val is = mkInstream' {reader = reader,
- closed = closed,
- buffer_contents = buffer_contents}
- val _ = if closed
- then ()
- else openInstreams := (is,atExit) :: (!openInstreams)
+ val is =
+ mkInstream' {reader = reader,
+ closed = closed,
+ buffer_contents = buffer_contents}
+ val _ =
+ if closed orelse not closeAtExit
+ then ()
+ else closeAtExits := ({close = makeCloseIn is,
+ uniq = instreamUniq is}
+ :: (!closeAtExits))
in
is
end
@@ -820,11 +829,12 @@
then NONE
else SOME buffer_contents}
val closeIn = fn is =>
- let
- val _ = openInstreams := List.filter (fn (is',_) =>
- not (equalsIn (is, is')))
- (!openInstreams)
- in
- closeIn is
- end
+ let
+ val u = instreamUniq is
+ val _ =
+ closeAtExits :=
+ List.filter (fn {uniq, ...} => u = uniq) (!closeAtExits)
+ in
+ closeIn is
+ end
end
1.7 +2 -1 mlton/basis-library/io/stream-io.sig
Index: stream-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/stream-io.sig,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- stream-io.sig 24 Sep 2003 17:45:25 -0000 1.6
+++ stream-io.sig 14 Oct 2003 00:10:13 -0000 1.7
@@ -37,8 +37,8 @@
include STREAM_IO
val input1': instream -> elem option * instream
- val equalsIn: instream * instream -> bool
val instreamReader: instream -> reader
+ val makeCloseIn: instream -> unit -> unit
val mkInstream': {reader: reader,
closed: bool,
buffer_contents: vector option} -> instream
@@ -52,6 +52,7 @@
val openVector: vector -> instream
val inputLine: instream -> (vector * instream) option
val outputSlice: outstream * (vector * int * int option) -> unit
+ val instreamUniq: instream -> unit ref
end
signature STREAM_IO_EXTRA_FILE =
-------------------------------------------------------
This SF.net email is sponsored by: SF.net Giveback Program.
SourceForge.net hosts over 70,000 Open Source Projects.
See the people who have HELPED US provide better services:
Click here: http://sourceforge.net/supporters.php
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel