datatype Expr = Val of int | Plus of Expr * Expr | Minus of Expr * Expr | 
                Times of Expr * Expr | Divide of Expr * Expr;

datatype Token = tPlus | tMinus | tDivide | tTimes | tVal of int | tLBrak | tRBrak;

fun eval (Val v) = v
  | eval (Plus (e1, e2)) = (eval e1) + (eval e2)
  | eval (Times (e1, e2)) = (eval e1) * (eval e2)
  | eval (Minus (e1, e2)) = (eval e1) - (eval e2)
  | eval (Divide (e1, e2)) = (eval e1) div (eval e2);

type 'a Parser = (Token list -> (Token list * 'a) list);

fun return a = fn tl => [(tl,a)];

infixr >>=;
fun p >>= f = fn tl => List.concat (map (fn (tl',a) => (f a) tl') (p tl));

infixr pThen;
fun p1 pThen p2 = p1 >>= (fn a => (p2 >>= (fn b => return (a,b))));

infixr pOr;
fun p1 pOr p2 = fn tl => (p1 tl) @ (p2 tl);

fun tok2op t = case t of tTimes => Times | tDivide => Divide | tMinus => Minus | tPlus => Plus;

fun parseTok t [] = []
  | parseTok t (t'::tl) = if (t' = t) then [(tl,t)] else [];

fun parseVal [] = []
  | parseVal (t'::tl) = case t' of tVal n => [(tl, Val n)] | _ => [];

fun parseExpr tl = 
    (((parseTerm pThen ((parseTok tPlus) pOr (parseTok tMinus)) pThen parseExpr)
          >>= (fn (t1,(tok,t2)) => return ((tok2op tok) (t1, t2))))
         pOr parseTerm) tl
and parseTerm tl =
    (((parseFactor pThen ((parseTok tTimes) pOr (parseTok tDivide)) pThen parseTerm)
          >>= (fn (t1,(tok,t2)) => return ((tok2op tok) (t1, t2))))
         pOr parseFactor) tl
and parseFactor tl = ((((parseTok tLBrak) pThen parseExpr pThen (parseTok tRBrak))
                           >>= (fn (_,(e,_)) => return e))
                          pOr parseVal) tl;

fun getWhile c l = 
    let fun gw al [] = (al,[]) |
            gw al (b::bl) = if c b then gw (b::al) bl else (al, b::bl) 
        val (xl,yl) = gw [] l in
        (rev xl, yl)
    end;

fun string2tokens s = 
    let fun s2t [] = []
          | s2t (c::cs) = if Char.isDigit c then 
                              let val (ns, cs') = getWhile Char.isDigit cs 
                                  val (SOME v) = Int.fromString(implode (c::ns)) in
                                  (tVal v) :: (s2t cs') 
                              end
                          else case c of 
                                   #"(" => tLBrak :: (s2t cs) | 
                                   #")" => tRBrak :: (s2t cs) |
                                   #"*" => tTimes :: (s2t cs) |
                                   #"/" => tDivide :: (s2t cs) |
                                   #"-" => tMinus :: (s2t cs) |
                                   #"+" => tPlus :: (s2t cs) |
                                   _ => (s2t cs) in
        s2t (explode s)
    end;

fun fst (x,_) = x;
fun snd (_,y) = y;
fun isEmpty [] = true | isEmpty _ = false;
fun parse s = map snd (List.filter (isEmpty o fst) (parseExpr (string2tokens s)));