# SCM Repository

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

Parent Directory | Revision Log

Revision

File size: 3284 byte(s)

**290**- (**download**) (**annotate**)*Sat May 22 21:01:25 1999 UTC*(20 years, 10 months ago) by*monnier*File size: 3284 byte(s)

This commit was generated by cvs2svn to compensate for changes in r289, which included commits to RCS files with non-trunk default branches.

(* parser-comb-sig.sml * * COPYRIGHT (c) 1996 AT&T Research. * * Parser combinators over readers. These are modeled after the Haskell * 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;

root@smlnj-gforge.cs.uchicago.edu | ViewVC Help |

Powered by ViewVC 1.0.0 |