Import Upstream version 20180207
[hcoop/debian/mlton.git] / basis-library / util / reader.sml
CommitLineData
7f918cf1
CE
1(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
3 * Copyright (C) 1997-2000 NEC Research Institute.
4 *
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
7 *)
8
9structure Reader: READER =
10struct
11
12open Int
13
14type ('a, 'b) reader = 'b -> ('a * 'b) option
15
16fun list (reader: ('a, 'b) reader): ('a list, 'b) reader =
17 fn state =>
18 let
19 fun loop (state, accum) =
20 case reader state of
21 NONE => SOME (rev accum, state)
22 | SOME (a, state) => loop (state, a :: accum)
23 in loop (state, [])
24 end
25
26fun readerN (reader: ('a, 'b) reader, n: int): ('a list, 'b) reader =
27 fn (state :'b) =>
28 let
29 fun loop (n, state, accum) =
30 if n <= 0
31 then SOME (rev accum, state)
32 else case reader state of
33 NONE => NONE
34 | SOME (x, state) => loop (n - 1, state, x :: accum)
35 in loop (n, state, [])
36 end
37
38fun ignore f reader =
39 let
40 fun loop state =
41 case reader state of
42 NONE => NONE
43 | SOME (x, state) =>
44 if f x
45 then loop state
46 else SOME (x, state)
47 in loop
48 end
49val _ = ignore
50
51fun map (f: 'a -> 'c) (reader: ('a, 'b) reader): ('c, 'b) reader =
52 fn (b: 'b) =>
53 case reader b of
54 NONE => NONE
55 | SOME (a, b) => SOME (f a, b)
56
57fun mapOpt (f: 'a -> 'c option) (reader: ('a, 'b) reader): ('c, 'b) reader =
58 fn (b: 'b) =>
59 case reader b of
60 NONE => NONE
61 | SOME (a, b) =>
62 case f a of
63 NONE => NONE
64 | SOME c => SOME (c, b)
65
66fun reader2 reader =
67 map (fn [y, z] => (y, z) | _ => raise Fail "Reader.reader2")
68 (readerN (reader, 2))
69val _ = reader2
70
71fun reader3 reader =
72 map (fn [x, y, z] => (x, y, z) | _ => raise Fail "Reader.reader3")
73 (readerN (reader, 3))
74
75fun reader4 reader =
76 map (fn [w, x, y, z] => (w, x, y, z) | _ => raise Fail "Reader.reader4")
77 (readerN (reader, 4))
78
79end