Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/smlnj-lib/Util/parser-comb.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-lib/Util/parser-comb.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1335 - (view) (download)

1 : monnier 2 (* parser-comb-sig.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 AT&T Research.
4 :     *
5 :     * Parser combinators over readers. These are modeled after the Haskell
6 :     * combinators of Hutton and Meijer. The main difference is that they
7 :     * return a single result, instead of a list of results. This means that
8 :     * "or" is a committed choice; once one branch succeeds, the others will not
9 :     * be enabled. While this is somewhat limiting, for many applications it
10 :     * will not be a problem. For more substantial parsing problems, one should
11 :     * use ML-Yacc and/or ML-Lex.
12 :     *)
13 :    
14 :     structure ParserComb : PARSER_COMB =
15 :     struct
16 :     structure SC = StringCvt
17 :    
18 :     type ('a, 'strm) parser = (char, 'strm) SC.reader -> ('a, 'strm) SC.reader
19 :    
20 :     fun result v getc strm = SOME(v, strm)
21 :    
22 :     fun failure getc strm = NONE
23 :    
24 :     fun wrap (p, f) getc strm = (case (p getc strm)
25 :     of NONE => NONE
26 :     | (SOME(x, strm)) => SOME(f x, strm)
27 :     (* end case *))
28 :    
29 :     fun seqWith f (p1, p2) getc strm = (case (p1 getc strm)
30 :     of SOME(t1, strm1) => (case (p2 getc strm1)
31 :     of SOME(t2, strm2) => SOME(f(t1, t2), strm2)
32 :     | NONE => NONE
33 :     (* end case *))
34 :     | NONE => NONE
35 :     (* end case *))
36 :     fun seq (p1, p2) = seqWith (fn x => x) (p1, p2)
37 :    
38 :     fun bind (p1, p2') getc strm = (case (p1 getc strm)
39 : monnier 289 of SOME(t1, strm1) => p2' t1 getc strm1
40 : monnier 2 | NONE => NONE
41 :     (* end case *))
42 :    
43 :     fun eatChar pred getc strm = (case getc strm
44 :     of (res as SOME(c, strm')) => if (pred c) then res else NONE
45 :     | _ => NONE
46 :     (* end case *))
47 :    
48 : mblume 1335 fun char (c: char) = eatChar (fn c' => (c = c'))
49 : monnier 2
50 :     fun string s getc strm = let
51 :     fun eat (ss, strm) = (case (Substring.getc ss, getc strm)
52 :     of (SOME(c1, ss'), SOME(c2, strm')) =>
53 :     if (c1 = c2) then eat(ss', strm') else NONE
54 :     | (NONE, _) => SOME(s, strm)
55 :     | _ => NONE
56 :     (* end case *))
57 :     in
58 :     eat (Substring.all s, strm)
59 :     end
60 :    
61 :     fun skipBefore pred p getc strm = let
62 :     fun skip' strm = (case getc strm
63 :     of NONE => NONE
64 :     | SOME(c, strm') =>
65 :     if (pred c) then skip' strm' else p getc strm
66 :     (* end case *))
67 :     in
68 :     skip' strm
69 :     end
70 :    
71 :     fun or (p1, p2) getc strm = (case (p1 getc strm)
72 :     of NONE => (case (p2 getc strm)
73 :     of NONE => NONE
74 :     | res => res
75 :     (* end case *))
76 :     | res => res
77 :     (* end case *))
78 :    
79 :     fun or' l getc strm = let
80 :     fun tryNext [] = NONE
81 :     | tryNext (p::r) = (case (p getc strm)
82 :     of NONE => tryNext r
83 :     | res => res
84 :     (* end case *))
85 :     in
86 :     tryNext l
87 :     end
88 :    
89 :     fun zeroOrMore p getc strm = let
90 :     val p = p getc
91 :     fun parse (l, strm) = (case (p strm)
92 :     of (SOME(item, strm)) => parse (item::l, strm)
93 :     | NONE => SOME(rev l, strm)
94 :     (* end case *))
95 :     in
96 :     parse ([], strm)
97 :     end
98 :    
99 :     fun oneOrMore p getc strm = (case (zeroOrMore p getc strm)
100 :     of (res as (SOME(_::_, _))) => res
101 :     | _ => NONE
102 :     (* end case *))
103 :    
104 :     fun option p getc strm = (case (p getc strm)
105 :     of SOME(x, strm) => SOME(SOME x, strm)
106 :     | NONE => SOME(NONE, strm)
107 :     (* end case *))
108 :    
109 :     (* parse a token consisting of characters satisfying the predicate.
110 :     * If this succeeds, then the resulting string is guaranteed to be
111 :     * non-empty.
112 :     *)
113 :     fun token pred getc strm = (case (zeroOrMore (eatChar pred) getc strm)
114 :     of (SOME(res as _::_, strm)) => SOME(implode res, strm)
115 :     | _ => NONE
116 :     (* end case *))
117 :    
118 :     end;

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0