functor ParseTINYFUN (
structure TINY : 
sig
datatype Program = op := of  string * IntExp
                 | Seq   of Program * Program
                 | If    of BoolExp * Program
                 | While of BoolExp * Program

and IntExp  = Const of int
            | Value of string
            | ++ of IntExp * IntExp

and BoolExp = Bool of bool
            | << of IntExp * IntExp
            | == of IntExp * IntExp
;
end
and Parse : PARSE
) 
=
struct
local
open Parse TINY
in

infix ++ := << ==
infix 9 -: :-

fun a -: b = a -- b >> #1
and a :- b = a -- b >> #2

fun intPrecs _ = 0

and intOps "+" = (fn a => fn b => a ++ b)
|   intOps  s   = raise SynError ("Unknown operation" ^ s)

fun SEQ  (s,[]) = s
|   SEQ  (s,(h :: t)) = SEQ(Seq(s,h), t)

fun getInt s = (## || $"~" -- ## >> (~ o #2)) s

and getBoolExp s = (
    $"true"                                           >> (fn _ => Bool true)
||  $"false"                                          >> (fn _ => Bool false)
||  (getIntExp -: $"<" -- getIntExp)                  >> op <<
||  (getIntExp -: $"=" -- getIntExp)                  >> op ==
    ) s

and getAtomicIntExp s = (
      getInt                                                         >> Const
||    id                                                             >> Value
    ) s

and getIntExp s = ( 
    getAtomicIntExp -: $"+" -- getIntExp                             >> op++
||  getAtomicIntExp
    ) s

and atomicStatement s = (
    (id -: $":=" -- getIntExp)                                       >> op :=
||  ($"if" :- getBoolExp -: $"then" -- getStatement -: $"end")       >> If 
||  ($"while" :- getBoolExp -: $"do" -- getStatement -: $"end")      >> While 
     ) s 

and getStatement s = (
     atomicStatement -: $";" -- getStatement                         >> Seq
||   atomicStatement 
     ) s 
end
end ;