(* Parsercomb -- Hutton/Paulson-style parser combinators for Moscow ML.   Fritz Henglein, Ken Larsen, Peter Sestoft.   Documentation by sestoft@dina.kvl.dk.  Version 0.4 of 2000-04-30 *) structure Parsercomb :> Parsercomb =struct     datatype 'elm stream =	S of int * (int -> ('elm * 'elm stream) option)     type ('elm,'res) parser = 'elm stream -> ('res * 'elm stream) option     fun stream get src =	let fun next src n = 	        case get src of		    SOME(x, rest) => SOME(x, S(n+1, next rest))		  | NONE          => NONE	in S(0, next src) end     fun getItem (S(n, next)) = next n     exception Parse of string     infix 6 $-- --$ #-- --#    infix 5 --    infix 3 >> >>*    infix 2 >>=    infix 0 ||     fun commitChar expected par (strm as S(n, next)) = 	case par strm of 	    NONE => 		raise Parse (String.concat 			     ["Expected <", expected, "> but found <", 			      (case next n of				   NONE       => "eof>"				 | SOME(c, _) => str c ^ ">"),			      " at character number ", Int.toString n]) 	  | res as SOME _ => res     fun commitElem expected show par (strm as S(n, next)) = 	case par strm of 	    NONE => 		raise Parse (String.concat 			     ["Expected <", expected, "> but found <", 			      (case next n of				   NONE         => "eof>"				 | SOME(elm, _) => show elm ^ ">"),			      " at element number ", Int.toString n]) 	  | res as SOME _ => res		        fun scan (scanner : ('a, 'a stream) StringCvt.reader -> 'a stream -> 'b) =	scanner getItem      fun (par1 >>= parf2) strm =	case par1 strm of	    SOME(b, strm1) => parf2 b strm1	  | NONE           => NONE     fun success x strm = SOME(x, strm)     fun failure strm = NONE     fun eof r strm = 	case getItem strm of	    NONE       => SOME(r, strm)	  | SOME(c, _) => NONE     (* fun (par >> f) = par >>= (success o f) *)     fun (par >> f) strm = 	case par strm of	    SOME(x, strm1) => SOME(f x, strm1)	  | _              => NONE     fun (par >>* f) strm = 	case par strm of	    SOME(x, strm1) => 		(case f x of 		     SOME y => SOME(y, strm1)		   | NONE   => NONE)	  | _              => NONE     (* fun (par1 -- par2) = par1 >>= (fn r1 => par2 >> (fn r2 => (r1, r2))) *)     fun (par1 -- par2) strm =	case par1 strm of	    SOME(r1, strm1) => (case par2 strm1 of				    SOME(r2 , strm2) => SOME((r1,r2), strm2)				  | NONE => NONE)	  | NONE => NONE		    (* fun (par1 #-- par2) = (par1 -- par2) >> #2 *)     (* Define explicitly to make par2 a tail call; possible because no       backtracking over par1: *)     fun (par1 #-- par2) strm = 	case par1 strm of	    SOME (_, strm1) => par2 strm1	  | NONE            => NONE     fun (par1 --# par2) = (par1 -- par2) >> #1 	    fun (par1 || par2) strm =	case par1 strm of	    NONE => par2 strm	  | res  => res     fun skipWS par strm = par (StringCvt.skipWS getItem strm)     fun optional par strm0 =	case par strm0 of	    SOME(x, strm1) => SOME(SOME x, strm1)	  | NONE           => SOME(NONE,   strm0)		    fun repeat0 par strm =	let fun loop strm0 res =	        case par strm0 of		    SOME(x, strm1) => loop strm1 (x::res)		  | NONE           => SOME(List.rev res, strm0)	in loop strm [] end     fun repeat1 par = par -- repeat0 par     fun $ s strm0 =	let val len = size s	    val sub = String.sub	    infix sub	    fun loop n strm =		if n = len then SOME(s, strm)		else (case getItem strm of			  SOME(c, rest) => 			      if c = (s sub n) then loop (n+1) rest			      else NONE			| NONE => NONE)	in loop 0 strm0 end        fun (s $-- par) = $ s -- par >> #2     fun (par --$ s) = par -- $ s >> #1     fun getChar pred strm =	case getItem strm of	    res as SOME(c, src) => if pred c then res 				   else NONE	  | NONE => NONE     fun $# elm strm = 	case getItem strm of	    res as SOME(x, src) => if x = elm then res 				   else NONE	  | NONE => NONE     val getLit = $#     fun getChars0 pred strm = 	SOME(StringCvt.splitl pred getItem strm)     fun getChars1 pred strm =	case StringCvt.splitl pred getItem strm of	    ("", _) => NONE	  | res     => SOME res     fun getChars1 pred = 	repeat1 (getChar pred) >> op:: >> String.implode	    val getElem = getChar     fun getElems0 pred = repeat0 (getElem pred)      fun getElems1 pred = repeat1 (getElem pred)       fun compose(par1, par2) strm = 	let val par1stream = stream par1 strm	in par2 par1stream end     fun parse (par : ('a, 'b) parser) (strm : 'a stream) : 'b option = 	case par strm of	    NONE          => NONE	  | SOME (res, _) => SOME res     fun scanSubstr par sus = parse par (stream Substring.getc sus)     fun scanString par s = scanSubstr par (Substring.all s)     fun scanList par cs = parse par (stream List.getItem cs)end