Commit | Line | Data |
---|---|---|
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 | ||
9 | structure Reader: READER = | |
10 | struct | |
11 | ||
12 | open Int | |
13 | ||
14 | type ('a, 'b) reader = 'b -> ('a * 'b) option | |
15 | ||
16 | fun 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 | ||
26 | fun 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 | ||
38 | fun 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 | |
49 | val _ = ignore | |
50 | ||
51 | fun 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 | ||
57 | fun 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 | ||
66 | fun reader2 reader = | |
67 | map (fn [y, z] => (y, z) | _ => raise Fail "Reader.reader2") | |
68 | (readerN (reader, 2)) | |
69 | val _ = reader2 | |
70 | ||
71 | fun reader3 reader = | |
72 | map (fn [x, y, z] => (x, y, z) | _ => raise Fail "Reader.reader3") | |
73 | (readerN (reader, 3)) | |
74 | ||
75 | fun reader4 reader = | |
76 | map (fn [w, x, y, z] => (w, x, y, z) | _ => raise Fail "Reader.reader4") | |
77 | (readerN (reader, 4)) | |
78 | ||
79 | end |