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