1structure PEGParse :> PEGParse = 2struct 3 4 datatype ('tok,'nt,'value)pegsym = 5 empty of 'value 6 | any of 'tok -> 'value 7 | tok of ('tok -> bool) * ('tok -> 'value) 8 | nt of 'nt * ('value -> 'value) 9 | seq of ('tok,'nt,'value)pegsym * ('tok,'nt,'value)pegsym * ('value -> 'value -> 'value) 10 | choice of ('tok,'nt,'value)pegsym * ('tok,'nt,'value)pegsym * ('value -> 'value) * ('value -> 'value) 11 | rpt of ('tok,'nt,'value)pegsym * ('value list -> 'value) 12 | not of ('tok,'nt,'value)pegsym * 'value 13 14 datatype ('tok,'nt,'value) grammar = PEG of { start : ('tok,'nt,'value)pegsym, rules : 'nt -> ('tok,'nt,'value)pegsym option } 15 16 datatype ('source,'tok,'nt,'value)kont = 17 ksym of ('tok,'nt,'value)pegsym * ('source,'tok,'nt,'value)kont * ('source,'tok,'nt,'value)kont 18 | appf1 of ('value -> 'value) * ('source,'tok,'nt,'value)kont 19 | appf2 of ('value -> 'value -> 'value) * ('source,'tok,'nt,'value)kont 20 | returnTo of 'source * 'value option list * ('source,'tok,'nt,'value)kont 21 | poplist of ('value list -> 'value) * ('source,'tok,'nt,'value)kont 22 | listsym of ('tok,'nt,'value)pegsym * ('value list -> 'value) * ('source,'tok,'nt,'value)kont 23 | kdone 24 | kfailed 25 26fun poplistval f acc stk = 27 case stk of 28 [] => raise Fail "Invariant failure in poplist" 29 | SOME h :: t => poplistval f (h::acc) t 30 | NONE::rest => SOME(f acc)::rest 31 32 33fun pegexec G get e inp stk k fk = let 34 fun pe e inp stk k fk = 35 case e of 36 empty v => applykont k inp (SOME v::stk) 37 | tok(P,f) => 38 let 39 in 40 case get inp of 41 NONE => applykont fk inp stk 42 | SOME(inp',t) => if P t then applykont k inp' (SOME (f t)::stk) 43 else applykont fk inp stk 44 end 45 | any f => 46 let 47 in 48 case get inp of 49 NONE => applykont fk inp stk 50 | SOME(inp',t) => applykont k inp' (SOME (f t)::stk) 51 end 52 | seq(e1,e2,f) => pe e1 inp stk (ksym(e2,appf2(f,k),returnTo(inp,stk,fk))) fk 53 | choice(e1,e2,f1,f2) => pe e1 inp stk (appf1(f1,k)) (returnTo(inp,stk,ksym(e2,appf1(f2,k),fk))) 54 | not(e,v) => pe e inp stk (returnTo(inp,stk,fk)) (returnTo(inp,SOME v::stk,k)) 55 | rpt(e,f) => pe e inp (NONE::stk) (listsym(e,f,k)) (poplist(f,k)) 56 | nt(nm,f) => pe (G nm) inp stk (appf1(f,k)) fk 57 and applykont k0 inp stk = 58 case k0 of 59 ksym(e,k,fk) => pe e inp stk k fk 60 | appf1(f,k) => 61 let 62 in 63 case stk of 64 SOME v::rest => applykont k inp (SOME (f v)::rest) 65 | _ => raise Fail "Invariant failure in appf1" 66 end 67 | appf2(f,k) => 68 let 69 in 70 case stk of 71 SOME v1::SOME v2::rest => applykont k inp (SOME (f v2 v1)::rest) 72 | _ => raise Fail "Invariant failure in appf2" 73 end 74 | returnTo(inp,stk,k) => applykont k inp stk 75 | poplist(f,k) => applykont k inp (poplistval f [] stk) 76 | listsym(e,f,k) => pe e inp stk (listsym(e,f,k)) (poplist(f,k)) 77 | kdone => SOME(inp,valOf (hd stk)) 78 | kfailed => NONE 79in 80 pe e inp stk k fk 81end 82 83end (* struct *) 84