[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