datatype token =
    Key of string
  | Name of string
;

exception SynError of string;

fun $a (Key b :: toks) =
      if a=b then (a, toks) else raise SynError a
  | $a _ =
      raise SynError "Symbol expected";

fun id (Name a :: toks) = (a, toks)
  | id toks = raise SynError "Identifier expected";

infix 3 >>;

fun (ph >> f) toks =
      let val (x, toks') = ph toks
      in  (f x, toks') end;

infix 0 ||;

fun (ph1 || ph2) toks =
      ph1 toks handle SynError _ => ph2 toks;

infix 5 ~~;

fun (ph1 ~~ ph2) toks =
      let val (x, toks1) = ph1 toks
          val (y, toks2) = ph2 toks1
      in ((x,y), toks2) end;

fun empty toks = ([], toks);

fun many ph toks =
      ( ph ~~ many ph >> (op ::) || empty ) toks;

fun snd (_, y) = y;

fun many_sep ph sep toks =
      ( ph ~~ ( (sep ~~ many_sep ph sep >> snd) || empty ) >> (op ::) ) toks;

fun parser ph toks =
      (case ph toks
         of (x, [])   => x
          | (_, _::_) => raise SynError "Extra characters in phrase"
      );

datatype typ
  = Con of string * typ list
  | Var of string
;

local
  fun typ toks =
    (   atom ~~ $"->" ~~ typ   >> (fn ((S, _), T) => Con("->", [S,T]))
    ||  atom
    ) toks
  and atom toks =
    (   id                     >> Var
    ||  $"(" ~~ typ ~~ $")"    >> (fn ((_, T), _) => T)
  ) toks;
in
  val parseTypeExp = parser typ;
end;

val t1 = [Name "a", Key "->", Name "b", Key "->", Name "c"];
val t2 = [Key "(", Name "a", Key "->", Name "b", Key ")", Key "->", Name "c"];
parseTypeExp t1;
parseTypeExp t2;