Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * | |
4 | * MLton is released under a BSD-style license. | |
5 | * See the file MLton-LICENSE for details. | |
6 | *) | |
7 | ||
8 | functor ParseSexp (S: PARSE_SEXP_STRUCTS): PARSE_SEXP = | |
9 | struct | |
10 | ||
11 | open S | |
12 | ||
13 | type 'a t = Sexp.t -> 'a | |
14 | ||
15 | fun parse (p, s) = p s | |
16 | ||
17 | fun anything x = x | |
18 | ||
19 | datatype sexp = datatype Sexp.t | |
20 | ||
21 | exception Parse | |
22 | ||
23 | fun wrap (parser, f) sexp = f (parser sexp) | |
24 | ||
25 | fun anyString sexp = | |
26 | case sexp of | |
27 | Atom s => s | |
28 | | _ => raise Parse | |
29 | ||
30 | fun atom f = wrap(anyString, f) | |
31 | fun string s = atom(fn s' => if String.equals(s, s') then () else raise Parse) | |
32 | ||
33 | fun cons(fx, fl) s = | |
34 | case s of | |
35 | List(x :: l) => (fx x, fl(List l)) | |
36 | | _ => raise Parse | |
37 | ||
38 | fun list f s = | |
39 | case s of | |
40 | List l => List.map(l, f) | |
41 | | _ => raise Parse | |
42 | ||
43 | fun tuple2(f1, f2) s = | |
44 | case s of | |
45 | List[s1, s2] => (f1 s1, f2 s2) | |
46 | | _ => raise Parse | |
47 | ||
48 | fun tuple3(f1, f2, f3) s = | |
49 | case s of | |
50 | List[s1, s2, s3] => (f1 s1, f2 s2, f3 s3) | |
51 | | _ => raise Parse | |
52 | ||
53 | fun tuple4(f1, f2, f3, f4) s = | |
54 | case s of | |
55 | List[s1, s2, s3, s4] => (f1 s1, f2 s2, f3 s3, f4 s4) | |
56 | | _ => raise Parse | |
57 | ||
58 | fun tuple5(f1, f2, f3, f4, f5) s = | |
59 | case s of | |
60 | List[s1, s2, s3, s4, s5] => (f1 s1, f2 s2, f3 s3, f4 s4, f5 s5) | |
61 | | _ => raise Parse | |
62 | ||
63 | fun or [] s = raise Parse | |
64 | | or (f :: fs) s = f s handle Parse => or fs s | |
65 | ||
66 | fun fold (parse: 'a t, base: 'b, f: 'a * 'b -> 'b): 'b t = | |
67 | wrap (list parse, fn l => List.fold (l, base, f)) | |
68 | ||
69 | end | |
70 | ||
71 | structure ParseSexp = ParseSexp(structure Sexp = Sexp) |