[MLton-devel] cvs commit: TextIO.* now raises Io with name field

Stephen Weeks MLton@mlton.org
Fri, 07 Feb 2003 16:42:34 -0800


sweeks      03/02/07 16:42:34

  Modified:    basis-library/io bin-io.sig bin-or-text-io.fun
                        fast-imperative-io.fun imperative-io.fun
                        imperative-io.sig text-io.sig
               basis-library/mlton io.fun io.sig socket.sml
               basis-library/system unix.sml
               doc/user-guide extensions.tex
               lib/mlton/basic exn.sml process.sml
               lib/mlton-stubs io.sig
  Log:
  Associate a name with instreams and outstreams so that the Io
  exception has a name.
  
  Update the exception layout function used in the error mssage
  pretty-printer for command lines so that the function and name are
  displayed.
  
  opefully, this means that when there are problems like Tom Murphy
  encountered with /tmp being full, the error message will look
  something like
  
  openOut "/tmp/whatever.s": No space left on device

Revision  Changes    Path
1.5       +2 -2      mlton/basis-library/io/bin-io.sig

Index: bin-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/bin-io.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- bin-io.sig	24 Nov 2002 01:19:35 -0000	1.4
+++ bin-io.sig	8 Feb 2003 00:42:31 -0000	1.5
@@ -88,8 +88,8 @@
 
       val equalsIn: instream * instream -> bool
       val equalsOut: outstream * outstream -> bool
-      val newIn: Posix.IO.file_desc -> instream
-      val newOut: Posix.IO.file_desc -> outstream
+      val newIn: Posix.IO.file_desc * string -> instream
+      val newOut: Posix.IO.file_desc * string -> outstream
       val inFd: instream -> Posix.IO.file_desc
       val outFd: outstream -> Posix.IO.file_desc
 



1.5       +59 -42    mlton/basis-library/io/bin-or-text-io.fun

Index: bin-or-text-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/bin-or-text-io.fun,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- bin-or-text-io.fun	6 Feb 2003 23:59:33 -0000	1.4
+++ bin-or-text-io.fun	8 Feb 2003 00:42:31 -0000	1.5
@@ -112,11 +112,18 @@
   | Buffered of buf
     
 datatype outstream' =
-   Out of {fd: FS.file_desc,
+   Out of {bufStyle: bufStyle,
 	   closed: bool ref,
-	   bufStyle: bufStyle}
+	   fd: FS.file_desc,
+	   name: string}
 type outstream = outstream' ref
 
+local
+   fun make f (ref (Out r)) = f r
+in
+   val outName = make #name
+end
+
 fun equalsOut (os1, os2) = os1 = os2
 
 fun outFd (ref (Out {fd, ...})) = fd
@@ -125,13 +132,13 @@
 val getOutstream = !
 val setOutstream = op :=
    
-fun flushOut (ref (Out {fd, bufStyle, closed, ...})): unit =
+fun flushOut (out as ref (Out {fd, bufStyle, closed, ...})): unit =
    (case (!closed, bufStyle) of
        (true, _) => ()
      | (_,    Unbuffered) => ()
      | (_,    Line b) => flush (fd, b)
      | (_,    Buffered b) => flush (fd, b))
-       handle exn => raise IO.Io {name = "<unimplemented>",
+       handle exn => raise IO.Io {name = outName out,
 				  function = "flushOut",
 				  cause = exn}
 
@@ -148,7 +155,7 @@
 	     ; openOuts := List.filter (fn out' => out <> out') (!openOuts))
       in (* flushOut out must be before closed := true *)
 	 (flushOut out; clean ())
-	 handle exn => (clean (); raise IO.Io {name = "<unimplemented",
+	 handle exn => (clean (); raise IO.Io {name = outName out,
 					       function = "closeOut",
 					       cause = exn})
       end
@@ -175,30 +182,33 @@
 		       then flushOut out
 		    else closeOut out) (!openOuts))
    in
-      fn (fd, bufStyle) =>
+      fn (fd, bufStyle, name) =>
       let
-	 val out = ref (Out {fd = fd,
+	 val out = ref (Out {bufStyle = bufStyle,
 			     closed = ref false,
-			     bufStyle = bufStyle})
+			     fd = fd,
+			     name = name})
       in openOuts := out :: !openOuts
 	 ; out
       end
    end
 
-val stdErr = newOut (FS.stderr, Unbuffered)
+val stdErr = newOut (FS.stderr, Unbuffered, "<stderr>")
 
 val newOut =
-   fn fd =>
+   fn (fd, name) =>
    let
       val b = Buf {size = ref 0,
 		   array = Primitive.Array.array bufSize}
-   in newOut (fd,
-	      if Posix.ProcEnv.isatty fd
-		 then Line b
-	      else Buffered b)
+      val bufStyle =
+	 if Posix.ProcEnv.isatty fd
+	    then Line b
+	 else Buffered b
+   in
+      newOut (fd, bufStyle, name)
    end
 
-val stdOut = newOut FS.stdout
+val stdOut = newOut (FS.stdout, "<stdout>")
 
 local
    val readWrite =
@@ -210,8 +220,9 @@
       (newOut (FS.createf (path,
                            FS.O_WRONLY,
                            FS.O.flags (FS.O.trunc::fileTypeFlags),
-                           readWrite)))
-      handle exn => raise IO.Io {name = "<unimplemented>",
+                           readWrite),
+	       path))
+      handle exn => raise IO.Io {name = path,
 				 function = "openOut",
 				 cause = exn}
 	 
@@ -219,15 +230,16 @@
       (newOut (FS.createf (path,
                            FS.O_WRONLY,
                            FS.O.flags (FS.O.append::fileTypeFlags),
-                           readWrite)))
-      handle exn => raise IO.Io {name = "<unimplemented>",
+                           readWrite),
+	       path))
+      handle exn => raise IO.Io {name = path,
 				 function = "openAppend",
 				 cause = exn}
 end
 
-fun output (out as ref (Out {fd, closed, bufStyle, ...}), s): unit =
+fun output (out as ref (Out {bufStyle, closed, fd, ...}), s): unit =
    if !closed
-      then raise IO.Io {name = "<unimplemented>",
+      then raise IO.Io {name = outName out,
 			function = "output",
 			cause = IO.ClosedStream}
    else
@@ -250,7 +262,7 @@
 	    Unbuffered => put ()
 	  | Line b => doit (b, fn () => NativeVector.hasLine s)
 	  | Buffered b => doit (b, fn () => false)
-      end handle exn => raise IO.Io {name = "<unimplemented>",
+      end handle exn => raise IO.Io {name = outName out,
 				     function = "output",
 				     cause = exn}
 
@@ -259,7 +271,7 @@
 in
    fun output1 (out as ref (Out {fd, closed, bufStyle, ...}), c: elem): unit =
       if !closed
-	 then raise IO.Io {name = "<unimplemented>",
+	 then raise IO.Io {name = outName out,
 			   function = "output1",
 			   cause = IO.ClosedStream}
       else
@@ -286,7 +298,7 @@
 		   ; flushGen (fd, buf1, 0, 1, PIO.writeArr))
 	     | Line b => doit (b, NativeVector.isLine c)
 	     | Buffered b => doit (b, false)
-	 end handle exn => raise IO.Io {name = "<unimplemented>",
+	 end handle exn => raise IO.Io {name = outName out,
 					function = "output",
 					cause = exn}
 end
@@ -304,13 +316,15 @@
 	       eof: bool ref,
 	       fd: FS.file_desc,
 	       first: int ref, (* index of first character *)
-	       last: int ref  (* one past the index of the last char *)
-	       }
-
-      local fun make f (T r) = f r
+	       last: int ref,  (* one past the index of the last char *)
+	       name: string}
+	 
+      local
+	 fun make f (T r) = f r
       in
 	 val closed = make #closed
 	 val fd = make #fd
+	 val name = make #name
       end
 
       val isClosed = ! o closed
@@ -340,13 +354,14 @@
 					else closeIn b)
 		(!openIns))
 	 in
-	    fn fd =>
-	    let val b = T {fd = fd,
-			   eof = ref false,
+	    fn (fd, name) =>
+	    let val b = T {buf = Primitive.Array.array bufSize,
 			   closed = ref false,
+			   eof = ref false,
+			   fd = fd,
 			   first = ref 0,
 			   last = ref 0,
-			   buf = Primitive.Array.array bufSize}
+			   name = name}
 	    in openIns := b :: !openIns
 	       ; b
 	    end
@@ -355,10 +370,10 @@
       (* update returns true iff there is a character now available.
        * Equivalently, it returns the value of not (!eof).
        *)
-      fun update (T {buf, closed, eof, fd, first, last, ...},
+      fun update (T {buf, closed, eof, fd, first, last, name, ...},
 		  function: string): bool =
 	 if !closed
-	    then raise IO.Io {name = "<unimplemented>",
+	    then raise IO.Io {name = name,
 			      function = function,
 			      cause = IO.ClosedStream}
 	 else if !eof
@@ -423,7 +438,8 @@
 	       else NONE
 	 end
 
-      fun inputN (T {fd, eof, first, last, buf, ...}, bytesToRead: int): vector =
+      fun inputN (b as T {buf, eof, fd, first, last, name, ...},
+		  bytesToRead: int): vector =
 	 if !eof
 	    then (eof := false; NativeVector.empty)
 	 else
@@ -463,7 +479,7 @@
 			   (Array.extract (dst, 0, SOME bytesRead)))
 		  end
 	    end
-	 handle exn => raise IO.Io {name = "<unimplemented>",
+	 handle exn => raise IO.Io {name = name,
 				    function = "inputN",
 				    cause = exn}
 
@@ -479,7 +495,7 @@
 		 else SOME 0
 	 end
 
-      fun inputAll (T {fd, eof, first, last, buf, ...}) =
+      fun inputAll (T {buf, eof, fd, first, last, name, ...}) =
 	 if !eof
 	    then (eof := false; NativeVector.empty)
 	 else
@@ -492,7 +508,7 @@
 		     else loop (v :: vs)
 		  end
 	    in loop vs
-	    end handle exn => raise IO.Io {name = "<unimplemented>",
+	    end handle exn => raise IO.Io {name = name,
 					   function = "inputAll",
 					   cause = exn}
 
@@ -693,15 +709,16 @@
       Buf b => Buf.closeIn b
     | Stream s => StreamIO.closeIn s
 
-fun newIn fd = T (ref (Buf (Buf.newIn fd)))
+fun newIn (fd, name) = T (ref (Buf (Buf.newIn (fd, name))))
    
-val stdIn = newIn FS.stdin
+val stdIn = newIn (FS.stdin, "<stdin>")
 
 fun openIn path =
    newIn (FS.openf (path,
                     FS.O_RDONLY,
-                    FS.O.flags fileTypeFlags))
-   handle exn => raise IO.Io {name = "<unimplemented>",
+                    FS.O.flags fileTypeFlags),
+	  path)
+   handle exn => raise IO.Io {name = path,
 			      function = "openIn",
 			      cause = exn}
 



1.5       +4 -4      mlton/basis-library/io/fast-imperative-io.fun

Index: fast-imperative-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/fast-imperative-io.fun,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- fast-imperative-io.fun	7 Feb 2003 18:16:16 -0000	1.4
+++ fast-imperative-io.fun	8 Feb 2003 00:42:31 -0000	1.5
@@ -241,9 +241,9 @@
 	  end
           handle exn => liftExn file "openAppend" exn
       end
-      val newOut = fn fd => newOut {fd = fd, 
-				    name = "<unknown>", 
-				    appendMode = false}
+      val newOut = fn (fd, name) => newOut {fd = fd, 
+					    name = name,
+					    appendMode = false}
       val outFd = SIO.outFd o getOutstream
 
       (*---------------*)
@@ -275,6 +275,6 @@
 		 name = file}
 	end
         handle exn => liftExn file "newIn" exn
-      val newIn = fn fd => newIn {fd = fd, name = "<unknown>"}
+      val newIn = fn (fd, name) => newIn {fd = fd, name = name}
       fun inFd is = withIn (is, BI.inFd, SIO.inFd)
    end



1.5       +4 -4      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.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- imperative-io.fun	7 Feb 2003 18:16:16 -0000	1.4
+++ imperative-io.fun	8 Feb 2003 00:42:31 -0000	1.5
@@ -212,9 +212,9 @@
 	  end
           handle exn => liftExn file "openAppend" exn
       end
-      val newOut = fn fd => newOut {fd = fd, 
-				    name = "<unknown>", 
-				    appendMode = false}
+      val newOut = fn (fd, name) => newOut {fd = fd, 
+					    name = name,
+					    appendMode = false}
       val outFd = SIO.outFd o getOutstream
 
       (*---------------*)
@@ -246,6 +246,6 @@
 		 name = file}
 	end
         handle exn => liftExn file "newIn" exn
-      val newIn = fn fd => newIn {fd = fd, name = "<unknown>"}
+      val newIn = fn (fd, name) => newIn {fd = fd, name = name}
       val inFd = SIO.inFd o getInstream
    end



1.3       +2 -2      mlton/basis-library/io/imperative-io.sig

Index: imperative-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/imperative-io.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- imperative-io.sig	24 Nov 2002 01:19:36 -0000	1.2
+++ imperative-io.sig	8 Feb 2003 00:42:31 -0000	1.3
@@ -49,8 +49,8 @@
 
       val inFd: instream -> Posix.IO.file_desc
       val outFd: outstream -> Posix.IO.file_desc
-      val newIn: Posix.IO.file_desc -> instream
-      val newOut: Posix.IO.file_desc -> outstream
+      val newIn: Posix.IO.file_desc * string -> instream
+      val newOut: Posix.IO.file_desc * string -> outstream
       val stdIn: instream
       val stdErr: outstream
       val stdOut: outstream



1.4       +2 -2      mlton/basis-library/io/text-io.sig

Index: text-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/text-io.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- text-io.sig	24 Nov 2002 01:19:36 -0000	1.3
+++ text-io.sig	8 Feb 2003 00:42:31 -0000	1.4
@@ -114,7 +114,7 @@
       val equalsIn: instream * instream -> bool
       val equalsOut: outstream * outstream -> bool
       val inFd: instream -> Posix.IO.file_desc
-      val newIn: Posix.IO.file_desc -> instream
-      val newOut: Posix.IO.file_desc -> outstream
+      val newIn: Posix.IO.file_desc * string -> instream
+      val newOut: Posix.IO.file_desc * string -> outstream
       val outFd: outstream -> Posix.IO.file_desc
    end



1.3       +2 -1      mlton/basis-library/mlton/io.fun

Index: io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/io.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- io.fun	29 Dec 2002 01:22:58 -0000	1.2
+++ io.fun	8 Feb 2003 00:42:31 -0000	1.3
@@ -14,7 +14,8 @@
 	     newOut (createf (name, O_WRONLY, O.flags [O.excl],
 			      let open S
 			      in flags [irusr, iwusr]
-			      end)))
+			      end),
+		     name))
 	 end handle e as PosixError.SysErr (_, SOME s) =>
 	    if s = Posix.Error.exist
 	       then loop ()



1.2       +2 -2      mlton/basis-library/mlton/io.sig

Index: io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/io.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- io.sig	17 Jun 2002 06:28:56 -0000	1.1
+++ io.sig	8 Feb 2003 00:42:31 -0000	1.2
@@ -4,8 +4,8 @@
       type outstream
 	 
       val inFd: instream -> Posix.IO.file_desc
-      val newIn: Posix.IO.file_desc -> instream
-      val newOut: Posix.IO.file_desc -> outstream
+      val newIn: Posix.IO.file_desc * string -> instream
+      val newOut: Posix.IO.file_desc * string -> outstream
       val outFd: outstream -> Posix.IO.file_desc
    end
 



1.4       +2 -2      mlton/basis-library/mlton/socket.sml

Index: socket.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/mlton/socket.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- socket.sml	29 Dec 2002 01:22:58 -0000	1.3
+++ socket.sml	8 Feb 2003 00:42:31 -0000	1.4
@@ -62,8 +62,8 @@
 fun sockToIO sock =
    let
       val fd = Socket.sockToFD sock
-      val ins = TextIO.newIn fd
-      val out = TextIO.newOut (Posix.IO.dup fd)
+      val ins = TextIO.newIn (fd, "<socket>")
+      val out = TextIO.newOut (Posix.IO.dup fd, "<socket>")
    in (ins, out)
    end
 



1.4       +11 -7     mlton/basis-library/system/unix.sml

Index: unix.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/unix.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- unix.sml	29 Dec 2002 01:22:59 -0000	1.3
+++ unix.sml	8 Feb 2003 00:42:32 -0000	1.4
@@ -99,21 +99,25 @@
     local
       fun mkInstreamOf (newIn, closeIn) (PROC {ins, ...}) =
 	case !ins of
-	  FD file_desc => let val str' = newIn file_desc
+	  FD file_desc => let val str' = newIn (file_desc, "<process>")
 			  in ins := STR (str', closeIn); str'
 			  end
 	| STR (str, _) => str
-      fun mkOutstreamOf (newOut, closeOut) (PROC {outs, ...}) =
+      fun mkOutstreamOf (newOut, closeOut) (PROC {outs, pid, ...}) =
 	case !outs of
-	  FD file_desc => let val str' = newOut file_desc
+	  FD file_desc => let val str' = newOut (file_desc, "<process>")
 			  in outs := STR (str', closeOut); str'
 			  end
 	| STR (str, _) => str
     in
-      fun textInstreamOf proc = mkInstreamOf (TextIO.newIn, TextIO.closeIn) proc
-      fun textOutstreamOf proc = mkOutstreamOf (TextIO.newOut, TextIO.closeOut) proc
-      fun binInstreamOf proc = mkInstreamOf (BinIO.newIn, BinIO.closeIn) proc
-      fun binOutstreamOf proc = mkOutstreamOf (BinIO.newOut, BinIO.closeOut) proc
+      fun textInstreamOf proc =
+	 mkInstreamOf (TextIO.newIn, TextIO.closeIn) proc
+      fun textOutstreamOf proc =
+	 mkOutstreamOf (TextIO.newOut, TextIO.closeOut) proc
+      fun binInstreamOf proc =
+	 mkInstreamOf (BinIO.newIn, BinIO.closeIn) proc
+      fun binOutstreamOf proc =
+	 mkOutstreamOf (BinIO.newOut, BinIO.closeOut) proc
     end
     fun streamsOf pr = (textInstreamOf pr, textOutstreamOf pr)
 



1.36      +9 -7      mlton/doc/user-guide/extensions.tex

Index: extensions.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/extensions.tex,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -r1.35 -r1.36
--- extensions.tex	14 Jan 2003 20:34:51 -0000	1.35
+++ extensions.tex	8 Feb 2003 00:42:32 -0000	1.36
@@ -274,8 +274,8 @@
       val inFd: instream -> Posix.IO.file_desc
       val mkstemp: string -> string * outstream
       val mkstemps: {prefix: string, suffix: string} -> string * outstream
-      val newIn: Posix.IO.file_desc -> instream
-      val newOut: Posix.IO.file_desc -> outstream
+      val newIn: Posix.IO.file_desc * string -> instream
+      val newOut: Posix.IO.file_desc * string -> outstream
       val outFd: outstream -> Posix.IO.file_desc
    end
 \end{verbatim}
@@ -292,11 +292,13 @@
 \entry{mkstemps \{prefix, suffix\}}
 {\tt mkstemps} is like {\tt mkstemp}, except it has both a prefix and suffix.
 
-\entry{newIn fd} create a new instream from file descriptor {\tt 
-fd}.
-
-\entry{newOut} create a new outstream from file descriptor {\tt 
-fd}.
+\entry{newIn (fd, name)} create a new instream from file descriptor
+{\tt fd}, with {\tt name} used in {\tt Io} exceptions if later
+raised.
+
+\entry{newOut (fd, name)} create a new outstream from file descriptor
+{\tt  fd}, with {\tt name} used in {\tt Io} exceptions if later
+raised.
 
 \entry{outFd out} return the file descriptor corresponding to
 {\tt out}.



1.7       +2 -2      mlton/lib/mlton/basic/exn.sml

Index: exn.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/exn.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- exn.sml	7 Feb 2003 23:19:22 -0000	1.6
+++ exn.sml	8 Feb 2003 00:42:33 -0000	1.7
@@ -30,8 +30,8 @@
 		  | SOME se => seq [str (OS.errorMsg se), str ": "],
 		       str s]
        | Fail s => str s
-       | IO.Io {cause, function, ...} =>
-	    seq [str (concat ["IO ", function, ": "]), layout cause]
+       | IO.Io {cause, function, name, ...} =>
+	    seq [str (concat [function, " ", name, ": "]), layout cause]
        | _ => seq [str "unhandled exception: ", str (exnName e)]
    end
 



1.11      +14 -7     mlton/lib/mlton/basic/process.sml

Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/process.sml,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- process.sml	28 Jan 2003 05:18:37 -0000	1.10
+++ process.sml	8 Feb 2003 00:42:33 -0000	1.11
@@ -86,14 +86,17 @@
 
 fun closes l = List.foreach (l, FileDesc.close)
 
+val pname = "<process>"
+   
 fun forkIn (c: Out.t -> unit): Pid.t * In.t =
    let
       val {infd, outfd} = FileDesc.pipe ()
       val pid = fork (fn () =>
-		     (FileDesc.close infd
-		      ; c (MLton.TextIO.newOut outfd)))
+		      (FileDesc.close infd
+		       ; c (MLton.TextIO.newOut (outfd, pname))))
       val _ = FileDesc.close outfd
-   in (pid, MLton.TextIO.newIn infd)
+   in
+      (pid, MLton.TextIO.newIn (infd, pname))
    end
 
 fun forkOut (c: In.t -> unit): Pid.t * Out.t =
@@ -101,9 +104,10 @@
       val {infd, outfd} = FileDesc.pipe ()
       val pid = fork (fn () =>
 		      (FileDesc.close outfd
-		       ; c (MLton.TextIO.newIn infd)))
+		       ; c (MLton.TextIO.newIn (infd, pname))))
       val _ = FileDesc.close infd
-   in (pid, MLton.TextIO.newOut outfd)
+   in
+      (pid, MLton.TextIO.newOut (outfd, pname))
    end
 
 fun forkInOut (c: In.t * Out.t -> unit): Pid.t * In.t * Out.t =
@@ -112,9 +116,12 @@
       val {infd = in2, outfd = out2} = FileDesc.pipe ()
       val pid = fork (fn () =>
 		      (closes [in1, out2]
-		       ; c (MLton.TextIO.newIn in2, MLton.TextIO.newOut out1)))
+		       ; c (MLton.TextIO.newIn (in2, pname),
+			    MLton.TextIO.newOut (out1, pname))))
       val _ = closes [in2, out1]
-   in (pid, MLton.TextIO.newIn in1, MLton.TextIO.newOut out2)
+   in (pid,
+       MLton.TextIO.newIn (in1, pname),
+       MLton.TextIO.newOut (out2, pname))
    end
 
 fun wait (p: Pid.t): unit =



1.2       +2 -2      mlton/lib/mlton-stubs/io.sig

Index: io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs/io.sig,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- io.sig	6 Aug 2002 03:19:19 -0000	1.1
+++ io.sig	8 Feb 2003 00:42:33 -0000	1.2
@@ -4,8 +4,8 @@
       type outstream
 	 
       val inFd: instream -> Posix.IO.file_desc
-      val newIn: Posix.IO.file_desc -> instream
-      val newOut: Posix.IO.file_desc -> outstream
+      val newIn: Posix.IO.file_desc * string -> instream
+      val newOut: Posix.IO.file_desc * string -> outstream
       val outFd: outstream -> Posix.IO.file_desc
    end
 





-------------------------------------------------------
This SF.NET email is sponsored by:
SourceForge Enterprise Edition + IBM + LinuxWorld = Something 2 See!
http://www.vasoftware.com
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel