[MLton-devel] cvs commit: TextIO.inputLine update
Stephen Weeks
sweeks@users.sourceforge.net
Wed, 24 Sep 2003 10:45:27 -0700
sweeks 03/09/24 10:45:27
Modified: basis-library/io buffer-i.fun buffer-i.sig
fast-imperative-io.fun imperative-io.fun
imperative-io.sig stream-io.fun stream-io.sig
text-io.sig text-stream-io.sig
basis-library/libs/basis-1997/io text-io-convert.fun
benchmark/tests DLXSimulator.sml barnes-hut.sml hamlet.sml
model-elimination.sml vliw.sml
lib/mlton/basic error.sml http.sml instream.sig instream.sml
instream0.sml lines.sml
lib/mlton-stubs-in-smlnj text-io.sml
mlprof main.sml
regression echo.sml textio.sml
Log:
Fixed TextIO.inputLine to match the latest basis spec.
val inputLine: instream -> string option
Revision Changes Path
1.8 +4 -2 mlton/basis-library/io/buffer-i.fun
Index: buffer-i.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/buffer-i.fun,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- buffer-i.fun 10 Feb 2003 22:39:37 -0000 1.7
+++ buffer-i.fun 24 Sep 2003 17:45:25 -0000 1.8
@@ -307,7 +307,7 @@
else inps
val inp = V.concat (List.rev inps)
in
- inp
+ SOME inp
end
fun loop inps =
if updateB "inputLine" ib
@@ -335,7 +335,9 @@
in
loop' f
end
- else finish (inps, List.length inps > 0)
+ else (case inps of
+ [] => NONE
+ | _ => finish (inps, true))
in
loop []
end
1.3 +1 -1 mlton/basis-library/io/buffer-i.sig
Index: buffer-i.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/buffer-i.sig,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- buffer-i.sig 24 Nov 2002 01:19:36 -0000 1.2
+++ buffer-i.sig 24 Sep 2003 17:45:25 -0000 1.3
@@ -34,7 +34,7 @@
val openVector: vector -> inbuffer
- val inputLine: inbuffer -> vector
+ val inputLine: inbuffer -> vector option
end
signature BUFFER_I_EXTRA_FILE =
1.7 +3 -3 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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- fast-imperative-io.fun 16 Sep 2003 00:32:52 -0000 1.6
+++ fast-imperative-io.fun 24 Sep 2003 17:45:25 -0000 1.7
@@ -91,9 +91,9 @@
fun inputLine (In is) =
case !is of
Buffer b => BI.inputLine b
- | Stream s => let val (v, s') = SIO.inputLine s
- in is := Stream s'; v
- end
+ | Stream s =>
+ Option.map (fn (v, s') => (is := Stream s'; v)) (SIO.inputLine s)
+
fun canInput (In is, n) =
case !is of
Buffer b => BI.canInput (b, n)
1.7 +3 -3 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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- imperative-io.fun 16 Sep 2003 00:32:53 -0000 1.6
+++ imperative-io.fun 24 Sep 2003 17:45:25 -0000 1.7
@@ -64,9 +64,9 @@
fun inputAll (In is) = let val (v, is') = SIO.inputAll (!is)
in is := is'; v
end
- fun inputLine (In is) = let val (v, is') = SIO.inputLine (!is)
- in is := is'; v
- end
+ fun inputLine (In is) =
+ Option.map (fn (v, is') => (is := is'; v)) (SIO.inputLine (!is))
+
fun canInput (In is, n) = SIO.canInput (!is, n)
fun lookahead (In is) = Option.map (fn (c, is') => c) (SIO.input1 (!is))
fun closeIn (In is) = SIO.closeIn (!is)
1.5 +1 -1 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.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- imperative-io.sig 1 May 2003 17:45:13 -0000 1.4
+++ imperative-io.sig 24 Sep 2003 17:45:25 -0000 1.5
@@ -35,7 +35,7 @@
val equalsIn: instream * instream -> bool
val equalsOut: outstream * outstream -> bool
- val inputLine: instream -> vector
+ val inputLine: instream -> vector option
val openVector: vector -> instream
val outputSlice: outstream * (vector * int * int option) -> unit
val scanStream: ((elem, StreamIO.instream) StringCvt.reader ->
1.14 +4 -4 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.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- stream-io.fun 5 Sep 2003 23:01:01 -0000 1.13
+++ stream-io.fun 24 Sep 2003 17:45:25 -0000 1.14
@@ -488,7 +488,7 @@
SOME i => let
val inp' = V.extract(inp, pos, SOME (i - pos))
in
- (inp', updatePos (is, i))
+ SOME (inp', updatePos (is, i))
end
| NONE => if pos < V.length inp
then let
@@ -500,9 +500,9 @@
fun doit next =
case next of
Link {buf} => first (updateBufBeg (is, buf))
- | Eos {buf} => (empty, updateBufBeg (is, buf))
+ | Eos {buf} => NONE
| End => doit (extendB "inputLine" is)
- | _ => (empty, is)
+ | _ => NONE
in
doit (!next)
end)
@@ -532,7 +532,7 @@
else inps
val inp = V.concat (List.rev inps)
in
- (inp, is)
+ SOME (inp, is)
end
in
first is
1.6 +1 -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.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- stream-io.sig 2 May 2003 23:49:46 -0000 1.5
+++ stream-io.sig 24 Sep 2003 17:45:25 -0000 1.6
@@ -50,7 +50,7 @@
buffer_mode: IO.buffer_mode} -> outstream
val openVector: vector -> instream
- val inputLine: instream -> (vector * instream)
+ val inputLine: instream -> (vector * instream) option
val outputSlice: outstream * (vector * int * int option) -> unit
end
1.7 +1 -1 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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- text-io.sig 2 May 2003 23:49:46 -0000 1.6
+++ text-io.sig 24 Sep 2003 17:45:25 -0000 1.7
@@ -30,7 +30,7 @@
val input1: instream -> elem option
val input: instream -> vector
val inputAll: instream -> vector
- val inputLine: instream -> string
+ val inputLine: instream -> string option
val inputN: instream * int -> vector
val lookahead: instream -> elem option
val mkInstream: StreamIO.instream -> instream
1.5 +1 -1 mlton/basis-library/io/text-stream-io.sig
Index: text-stream-io.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/text-stream-io.sig,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- text-stream-io.sig 2 May 2003 23:49:46 -0000 1.4
+++ text-stream-io.sig 24 Sep 2003 17:45:25 -0000 1.5
@@ -4,6 +4,6 @@
where type elem = Char.char
where type vector = CharVector.vector
- val inputLine: instream -> string * instream
+ val inputLine: instream -> (string * instream) option
val outputSubstr: outstream * substring -> unit
end
1.3 +11 -0 mlton/basis-library/libs/basis-1997/io/text-io-convert.fun
Index: text-io-convert.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/libs/basis-1997/io/text-io-convert.fun,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- text-io-convert.fun 24 Nov 2002 01:19:37 -0000 1.2
+++ text-io-convert.fun 24 Sep 2003 17:45:26 -0000 1.3
@@ -4,9 +4,20 @@
struct
open TextIO
+ fun inputLine ins =
+ case TextIO.inputLine ins of
+ NONE => ""
+ | SOME s => s
+
structure StreamIO =
struct
open StreamIO
+
val inputAll = #1 o inputAll
+
+ fun inputLine ins =
+ case StreamIO.inputLine ins of
+ NONE => ("", ins)
+ | SOME (s, ins) => (s, ins)
end
end
1.5 +3 -3 mlton/benchmark/tests/DLXSimulator.sml
Index: DLXSimulator.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/benchmark/tests/DLXSimulator.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- DLXSimulator.sml 11 Sep 2003 20:23:32 -0000 1.4
+++ DLXSimulator.sml 24 Sep 2003 17:45:26 -0000 1.5
@@ -2611,9 +2611,9 @@
* instructions in a file into a list.
*)
fun ReadFileToInstr file
- = if (TextIO.endOfStream file)
- then []
- else (TextIO.inputLine file) :: (ReadFileToInstr file);
+ = (case TextIO.inputLine file of
+ NONE => []
+ | SOME l => l :: (ReadFileToInstr file));
(*
1.7 +5 -5 mlton/benchmark/tests/barnes-hut.sml
Index: barnes-hut.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/benchmark/tests/barnes-hut.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- barnes-hut.sml 6 Sep 2003 19:06:07 -0000 1.6
+++ barnes-hut.sml 24 Sep 2003 17:45:26 -0000 1.7
@@ -492,8 +492,8 @@
val strm = TextIO.openIn fname
val buf = ref(SS.full "")
fun getLn () = (case (TextIO.inputLine strm)
- of "" => raise Fail "inputData: EOF"
- | s => buf := SS.full s
+ of NONE => raise Fail "inputData: EOF"
+ | SOME s => buf := SS.full s
(* end case *))
fun skipWS () = let
val buf' = SS.dropl Char.isSpace (!buf)
@@ -747,9 +747,9 @@
else SOME(SS.string(SS.triml (size name+1) suffix))
end
fun get default = (case (TextIO.inputLine TextIO.stdIn)
- of "" => raise EOF
- | "\n" => default
- | s => substring(s, 0, size s - 1)
+ of NONE => raise EOF
+ | SOME "\n" => default
+ | SOME s => substring(s, 0, size s - 1)
(* end case *))
in
if (null (! defaults))
1.4 +3 -4 mlton/benchmark/tests/hamlet.sml
Index: hamlet.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/benchmark/tests/hamlet.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- hamlet.sml 18 May 2003 01:23:01 -0000 1.3
+++ hamlet.sml 24 Sep 2003 17:45:26 -0000 1.4
@@ -22813,11 +22813,10 @@
let
val _ = TextIO.output(TextIO.stdOut, "SML> ")
val _ = TextIO.flushOut TextIO.stdOut
- val source = TextIO.inputLine ins
in
- if source = "" then
- ()
- else
+ case TextIO.inputLine ins of
+ NONE => ()
+ | SOME source =>
loop(process arg source)
handle Error.Error _ => (* Syntax error *)
loop arg
1.4 +2 -2 mlton/benchmark/tests/model-elimination.sml
Index: model-elimination.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/benchmark/tests/model-elimination.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- model-elimination.sml 18 May 2003 01:23:02 -0000 1.3
+++ model-elimination.sml 24 Sep 2003 17:45:26 -0000 1.4
@@ -2360,8 +2360,8 @@
open TextIO
val fh = openIn filename
fun res () =
- case inputLine fh of "" => (closeIn fh; NIL)
- | s => CONS (s, lazify_thunk res)
+ case inputLine fh of NONE => (closeIn fh; NIL)
+ | SOME s => CONS (s, lazify_thunk res)
in
res ()
end;
1.5 +5 -1 mlton/benchmark/tests/vliw.sml
Index: vliw.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/benchmark/tests/vliw.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- vliw.sml 18 May 2003 01:23:02 -0000 1.4
+++ vliw.sml 24 Sep 2003 17:45:26 -0000 1.5
@@ -41,7 +41,11 @@
val open_out = TextIO.openOut
val close_in = TextIO.closeIn
val close_out = TextIO.closeOut
-val input_line = TextIO.inputLine
+val input_line =
+ fn ins =>
+ case TextIO.inputLine ins of
+ NONE => ""
+ | SOME s => s
type instream = TextIO.instream
type outstream = TextIO.outstream
fun outputc f x = TextIO.output(f, x)
1.5 +8 -7 mlton/lib/mlton/basic/error.sml
Index: error.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/error.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- error.sml 10 Jul 2002 15:15:03 -0000 1.4
+++ error.sml 24 Sep 2003 17:45:26 -0000 1.5
@@ -7,15 +7,16 @@
structure Error: ERROR =
struct
-fun bug msg = raise(Fail msg)
+fun bug msg = raise (Fail msg)
-fun reraise (exn, msg) = bug (concat [msg, "::",
- case exn of
- Fail msg => msg
- | _ => "?"])
+fun reraise (exn, msg) =
+ bug (concat [msg, "::",
+ case exn of
+ Fail msg => msg
+ | _ => "?"])
-fun unimplemented msg = raise Fail(concat["unimplemented: ", msg])
+fun unimplemented msg = raise Fail (concat ["unimplemented: ", msg])
-fun warning msg = TextIO.output(TextIO.stdErr, msg^"\n")
+fun warning msg = TextIO.output (TextIO.stdErr, concat [msg, "\n"])
end
1.6 +38 -33 mlton/lib/mlton/basic/http.sml
Index: http.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/http.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- http.sml 11 Feb 2003 04:55:00 -0000 1.5
+++ http.sml 24 Sep 2003 17:45:26 -0000 1.6
@@ -394,12 +394,14 @@
fun input (ins: In.t): t list Result.t =
let
fun loop (headers: string list): string list =
- let val line = In.inputLine ins
- in if line = "\r\n" orelse line = ""
- then headers
- else loop (line :: headers)
- end
- in fromString (concat (rev (loop [])))
+ case In.inputLine ins of
+ NONE => headers
+ | SOME l =>
+ if l = "\r\n"
+ then headers
+ else loop (l :: headers)
+ in
+ fromString (concat (rev (loop [])))
end
end
@@ -466,17 +468,18 @@
val requestIsValid = Option.isSome o requestLine
fun input (ins: In.t): t Result.t =
- let val line = In.inputLine ins
- in case requestLine line of
- NONE => Result.No line
- | SOME {method, uri, version} =>
- Result.map
- (Header.input ins, fn hs =>
- T {method = method,
- uri = uri,
- version = version,
- headers = hs})
- end
+ case In.inputLine ins of
+ NONE => Result.No ""
+ | SOME l =>
+ case requestLine l of
+ NONE => Result.No l
+ | SOME {method, uri, version} =>
+ Result.map
+ (Header.input ins, fn hs =>
+ T {method = method,
+ uri = uri,
+ version = version,
+ headers = hs})
val input =
Trace.trace ("Request.input", In.layout, Result.layout layout) input
@@ -753,22 +756,24 @@
fun output (r, out) = Out.output (out, toString r)
fun input (ins: In.t): t Result.t =
- let
- val line = In.inputLine ins
- open Regexp
- in
- case Compiled.matchAll (responseLine (), line) of
- NONE => Result.No line
- | SOME m =>
- let val {lookup, ...} = Match.stringFuns m
- val version = Version.extract m
- val status = Status.fromString (lookup status')
- in Result.map (Header.input ins, fn hs =>
- T {version = version,
- status = status,
- headers = hs})
- end
- end
+ case In.inputLine ins of
+ NONE => Result.No ""
+ | SOME l =>
+ let
+ open Regexp
+ in
+ case Compiled.matchAll (responseLine (), l) of
+ NONE => Result.No l
+ | SOME m =>
+ let val {lookup, ...} = Match.stringFuns m
+ val version = Version.extract m
+ val status = Status.fromString (lookup status')
+ in Result.map (Header.input ins, fn hs =>
+ T {version = version,
+ status = status,
+ headers = hs})
+ end
+ end
end
end
1.4 +1 -1 mlton/lib/mlton/basic/instream.sig
Index: instream.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/instream.sig,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- instream.sig 10 Apr 2002 07:50:31 -0000 1.3
+++ instream.sig 24 Sep 2003 17:45:26 -0000 1.4
@@ -20,7 +20,7 @@
val input: t -> string
val inputAll: t -> string
val inputChar: t -> char option
- val inputLine: t -> string
+ val inputLine: t -> string option
val inputN: t * int -> string
val inputNothing: t -> unit
(* inputTo(i, p) inputs up to but not including the first char
1.5 +1 -1 mlton/lib/mlton/basic/instream.sml
Index: instream.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/instream.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- instream.sml 10 Apr 2002 07:50:31 -0000 1.4
+++ instream.sml 24 Sep 2003 17:45:26 -0000 1.5
@@ -25,7 +25,7 @@
end
val inputLine =
- Trace.trace ("In.inputLine", layout, String.layout) inputLine
+ Trace.trace ("In.inputLine", layout, Option.layout String.layout) inputLine
fun 'a withClose (ins: t, f: t -> 'a): 'a =
DynamicWind.wind (fn () => f ins, fn () => close ins)
1.8 +4 -4 mlton/lib/mlton/basic/instream0.sml
Index: instream0.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/instream0.sml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- instream0.sml 28 Apr 2003 23:05:26 -0000 1.7
+++ instream0.sml 24 Sep 2003 17:45:26 -0000 1.8
@@ -24,8 +24,8 @@
let
fun loop a =
case inputLine ins of
- "" => a
- | l => loop (String.fold (l, a, f))
+ NONE => a
+ | SOME l => loop (String.fold (l, a, f))
in
loop a
end
@@ -34,8 +34,8 @@
let
fun loop ac =
case inputLine ins of
- "" => ac
- | l => loop (f (l, ac))
+ NONE => ac
+ | SOME l => loop (f (l, ac))
in loop ac
end
1.3 +27 -18 mlton/lib/mlton/basic/lines.sml
Index: lines.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/lines.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- lines.sml 10 Apr 2002 07:50:31 -0000 1.2
+++ lines.sml 24 Sep 2003 17:45:26 -0000 1.3
@@ -14,8 +14,8 @@
if i > stop
then ()
else (case In.inputLine ins of
- "" => ()
- | l =>
+ NONE => ()
+ | SOME l =>
(if i >= start
then Out.output(out, l)
else ();
@@ -23,24 +23,33 @@
in loop 0
end
-fun dropLast(ins, out, {start: int, last: int}): unit =
+fun dropLast (ins, out, {start: int, last: int}): unit =
let
- val _ = Assert.assert("Lines.dropLast", fn () =>
- start >= 0 andalso last >= 0)
- fun line() = In.inputLine ins
- val _ = Int.for(0, start, fn _ => (line(); ()))
- in if last = 0
- then In.outputAll(ins, out)
+ val _ = Assert.assert ("Lines.dropLast", fn () =>
+ start >= 0 andalso last >= 0)
+ fun line () = In.inputLine ins
+ val _ = Int.for (0, start, fn _ => (line (); ()))
+ in
+ if last = 0
+ then In.outputAll (ins, out)
else
- let val q = Int.fold(0, last, Queue.empty(), fn (_, q) =>
- Queue.enque(q, line()))
- fun loop(q: string Queue.t) =
- if In.endOf ins
- then ()
- else let val q = Queue.enque(q, line())
- val (l', q) = valOf(Queue.deque q)
- val _ = Out.output(out, l')
- in loop q
+ let
+ val q =
+ Int.fold (0, last, Queue.empty (), fn (_, q) =>
+ Queue.enque (q,
+ case line () of
+ NONE => ""
+ | SOME l => l))
+ fun loop (q: string Queue.t) =
+ case line () of
+ NONE => ()
+ | SOME l =>
+ let
+ val q = Queue.enque (q, l)
+ val (l', q) = valOf (Queue.deque q)
+ val _ = Out.output (out, l')
+ in
+ loop q
end
in loop q
end
1.3 +4 -0 mlton/lib/mlton-stubs-in-smlnj/text-io.sml
Index: text-io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton-stubs-in-smlnj/text-io.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- text-io.sml 10 Aug 2001 00:11:58 -0000 1.2
+++ text-io.sml 24 Sep 2003 17:45:27 -0000 1.3
@@ -2,6 +2,10 @@
struct
open OpenInt32 TextIO
+ fun inputLine ins =
+ case TextIO.inputLine ins of
+ "" => NONE
+ | s => SOME s
fun inputN (ins, n) = TextIO.inputN (ins, toInt n)
fun canInput (ins, n) = TextIO.canInput (ins, toInt n)
end
1.52 +15 -9 mlton/mlprof/main.sml
Index: main.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlprof/main.sml,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- main.sml 10 Jul 2003 05:56:02 -0000 1.51
+++ main.sml 24 Sep 2003 17:45:27 -0000 1.52
@@ -121,7 +121,10 @@
(afile, ["@MLton", "show-prof"],
fn ins =>
let
- fun line () = In.inputLine ins
+ fun line () =
+ case In.inputLine ins of
+ NONE => Error.bug "unexpected end of show-prof data"
+ | SOME l => l
val magic = valOf (Word.fromString (line ()))
fun vector (f: string -> 'a): 'a vector =
Vector.tabulate (valOf (Int.fromString (line ())),
@@ -319,21 +322,24 @@
File.withIn
(mlmonfile, fn ins =>
let
+ fun line () =
+ case In.inputLine ins of
+ NONE => Error.bug "unexpected end of mlmon file"
+ | SOME l => String.dropSuffix (line (), 1)
val _ =
- if "MLton prof\n" = In.inputLine ins
+ if "MLton prof" = line ()
then ()
else Error.bug "bad header"
val kind =
- case In.inputLine ins of
- "alloc\n" => Kind.Alloc
- | "time\n" => Kind.Time
+ case line () of
+ "alloc" => Kind.Alloc
+ | "time" => Kind.Time
| _ => Error.bug "invalid profile kind"
val style =
- case In.inputLine ins of
- "current\n" => Style.Current
- | "stack\n" => Style.Stack
+ case line () of
+ "current" => Style.Current
+ | "stack" => Style.Stack
| _ => Error.bug "invalid profile style"
- fun line () = String.dropSuffix (In.inputLine ins, 1)
val magic =
case Word.fromString (line ()) of
NONE => Error.bug "invalid magic"
1.11 +9 -8 mlton/regression/echo.sml
Index: echo.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/echo.sml,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- echo.sml 9 Feb 2003 17:22:20 -0000 1.10
+++ echo.sml 24 Sep 2003 17:45:27 -0000 1.11
@@ -1,5 +1,5 @@
(* -*- mode: sml -*-
- * $Id: echo.sml,v 1.10 2003/02/09 17:22:20 sweeks Exp $
+ * $Id: echo.sml,v 1.11 2003/09/24 17:45:27 sweeks Exp $
* http://www.bagley.org/~doug/shootout/
* from Tom 7
*)
@@ -18,17 +18,18 @@
let val (_, _, ins, outs) = MLton.Socket.accept listener
fun s b =
case TextIO.inputLine ins of
- "" => let in
+ NONE => let in
Posix.Process.wait ();
print (concat ["server processed ",
Int.toString b,
" bytes\n"])
end
- | i => let in
- TextIO.output(outs, i);
- TextIO.flushOut outs;
- s (b + 19)
- end
+ | SOME i =>
+ let in
+ TextIO.output(outs, i);
+ TextIO.flushOut outs;
+ s (b + 19)
+ end
in s 0
end
@@ -42,7 +43,7 @@
| c n = let in
TextIO.output(outs, data);
TextIO.flushOut outs;
- TextIO.inputLine ins = data
+ TextIO.inputLine ins = SOME data
orelse raise Error "Didn't receive the same data";
c (n - 1)
end
1.2 +10 -10 mlton/regression/textio.sml
Index: textio.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/textio.sml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- textio.sml 18 Jul 2001 05:51:07 -0000 1.1
+++ textio.sml 24 Sep 2003 17:45:27 -0000 1.2
@@ -291,8 +291,8 @@
tst' "test12a" (fn _ =>
let val is = openIn "empty.dat"
in
- (inputLine is = ""
- andalso inputLine is = "")
+ (inputLine is = NONE
+ andalso inputLine is = NONE)
before closeIn is
end);
@@ -300,8 +300,8 @@
tst' "test12b" (fn _ =>
let val is = openIn "small1.dat"
in
- (inputLine is = "+\n"
- andalso inputLine is = "")
+ (inputLine is = SOME "+\n"
+ andalso inputLine is = NONE)
before closeIn is
end);
@@ -309,10 +309,10 @@
tst' "test12c" (fn _ =>
let val is = openIn "text.dat"
in
- (inputLine is = "Line 1\n"
- andalso inputLine is = "Line 2\n"
- andalso inputLine is = "Line 3\n"
- andalso inputLine is = "")
+ (inputLine is = SOME "Line 1\n"
+ andalso inputLine is = SOME "Line 2\n"
+ andalso inputLine is = SOME "Line 3\n"
+ andalso inputLine is = NONE)
before closeIn is
end);
@@ -320,8 +320,8 @@
tst' "test12d" (fn _ =>
let val is = openIn "medium.dat"
in
- (inputLine is = longstring ^ "\n"
- andalso inputLine is = "")
+ (inputLine is = SOME (longstring ^ "\n")
+ andalso inputLine is = NONE)
before closeIn is
end);
-------------------------------------------------------
This sf.net email is sponsored by:ThinkGeek
Welcome to geek heaven.
http://thinkgeek.com/sf
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel