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

# SCM Repository

[smlnj] View of /sml/branches/SMLNJ/src/smlnj-lib/Util/parser-comb.sml
 [smlnj] / sml / branches / SMLNJ / src / smlnj-lib / Util / parser-comb.sml

# View of /sml/branches/SMLNJ/src/smlnj-lib/Util/parser-comb.sml

Mon Sep 7 21:11:35 1998 UTC (21 years, 1 month ago) by monnier
File size: 3284 byte(s)
```110.8
```
```(* parser-comb-sig.sml
*
* COPYRIGHT (c) 1996 AT&T Research.
*
* combinators of Hutton and Meijer.  The main difference is that they
* return a single result, instead of a list of results.  This means that
* "or" is a committed choice; once one branch succeeds, the others will not
* be enabled.  While this is somewhat limiting, for many applications it
* will not be a problem.  For more substantial parsing problems, one should
* use ML-Yacc and/or ML-Lex.
*)

structure ParserComb : PARSER_COMB =
struct
structure SC = StringCvt

type ('a, 'strm) parser = (char, 'strm) SC.reader -> ('a, 'strm) SC.reader

fun result v getc strm = SOME(v, strm)

fun failure getc strm = NONE

fun wrap (p, f) getc strm = (case (p getc strm)
of NONE => NONE
| (SOME(x, strm)) => SOME(f x, strm)
(* end case *))

fun seqWith f (p1, p2) getc strm = (case (p1 getc strm)
of SOME(t1, strm1) => (case (p2 getc strm1)
of SOME(t2, strm2) => SOME(f(t1, t2), strm2)
| NONE => NONE
(* end case *))
| NONE => NONE
(* end case *))
fun seq (p1, p2) = seqWith (fn x => x) (p1, p2)

fun bind (p1, p2') getc strm = (case (p1 getc strm)
of SOME(t1, strm1) => p2' t1 getc strm1
| NONE => NONE
(* end case *))

fun eatChar pred getc strm = (case getc strm
of (res as SOME(c, strm')) => if (pred c) then res else NONE
| _ => NONE
(* end case *))

fun char c = eatChar (fn c' => (c = c'))

fun string s getc strm = let
fun eat (ss, strm) = (case (Substring.getc ss, getc strm)
of (SOME(c1, ss'), SOME(c2, strm')) =>
if (c1 = c2) then eat(ss', strm') else NONE
| (NONE, _) => SOME(s, strm)
| _ => NONE
(* end case *))
in
eat (Substring.all s, strm)
end

fun skipBefore pred p getc strm = let
fun skip' strm = (case getc strm
of NONE => NONE
| SOME(c, strm') =>
if (pred c) then skip' strm' else p getc strm
(* end case *))
in
skip' strm
end

fun or (p1, p2) getc strm = (case (p1 getc strm)
of NONE => (case (p2 getc strm)
of NONE => NONE
| res => res
(* end case *))
| res => res
(* end case *))

fun or' l getc strm = let
fun tryNext [] = NONE
| tryNext (p::r) = (case (p getc strm)
of NONE => tryNext r
| res => res
(* end case *))
in
tryNext l
end

fun zeroOrMore p getc strm = let
val p = p getc
fun parse (l, strm) = (case (p strm)
of (SOME(item, strm)) => parse (item::l, strm)
| NONE => SOME(rev l, strm)
(* end case *))
in
parse ([], strm)
end

fun oneOrMore p getc strm = (case (zeroOrMore p getc strm)
of (res as (SOME(_::_, _))) => res
| _ => NONE
(* end case *))

fun option p getc strm = (case (p getc strm)
of SOME(x, strm) => SOME(SOME x, strm)
| NONE => SOME(NONE, strm)
(* end case *))

(* parse a token consisting of characters satisfying the predicate.
* If this succeeds, then the resulting string is guaranteed to be
* non-empty.
*)
fun token pred getc strm = (case (zeroOrMore (eatChar pred) getc strm)
of (SOME(res as _::_, strm)) => SOME(implode res, strm)
| _ => NONE
(* end case *))

end;
```