-- A recursive-descent parser for expressions

import Prelude hiding ((<*>))

infixr 4 <*>

-- the type of tokens delivered by the scanner:
data Token = Id | Num | Plus | Times | LParen| RParen | EOF
   deriving (Eq,Show)

scanner :: String -> [Token]
scanner _ = [Id, Plus, Num, Times, Id, EOF] -- example scan


-- type of a parser: [Token] -> [Token]
-- input: list of tokens to parse
-- output: list of unconsumed tokens
type Parser = [Token] -> [Token]

-- sequence combinator for parsers:
-- input: two parsers p1 and p2
-- output: a parser that recognizes the concatenation of p1 and p2
(<*>)    :: Parser -> Parser -> Parser
p1 <*> p2 = \ts -> p2 (p1 ts)


-- a parser for a terminal symbol just consumes a single token, if possible:
terminal :: Token -> Parser
terminal tok (t:ts) =
  if tok==t
  then ts
  else error ("Wrong token \""++show t++"\", expected: "++show tok++"\n")

parse_E :: Parser
parse_E ts =
  case (head ts) of
    Id     -> (parse_T <*> parse_E') ts
    Num    -> (parse_T <*> parse_E') ts
    LParen -> (parse_T <*> parse_E') ts
    _      -> parse_error "E" ts

parse_E' :: Parser
parse_E' ts =
  case (head ts) of
    Plus   -> (terminal Plus <*> parse_T <*> parse_E') ts
    RParen -> ts
    EOF    -> ts
    _      -> parse_error "T'" ts

parse_T :: Parser
parse_T ts =
  case (head ts) of
    Id     -> (parse_F <*> parse_T') ts
    Num    -> (parse_F <*> parse_T') ts
    LParen -> (parse_F <*> parse_T') ts
    _      -> parse_error "T" ts

parse_T' :: Parser
parse_T' ts =
  case (head ts) of
    Plus   -> ts
    Times  -> (terminal Times <*> parse_F <*> parse_T') ts
    RParen -> ts
    EOF    -> ts
    _      -> parse_error "T'" ts

parse_F :: Parser
parse_F (t:ts) =
  case t of
    Id     -> ts
    Num    -> ts
    LParen -> (parse_E <*> terminal RParen) ts
    _      -> parse_error "F" (t:ts)

parse_error s ts =
   error ("Wrong token " ++ show (head ts) ++ " at beginning of " ++ s)

main1 = parse_E [Id, Plus, Num, Times, Id, EOF] -- x + 3 * y
main2 = parse_E [LParen, Id, Plus, Num, RParen, Times, Id, EOF] -- (x+3)*y
main3 = parse_E [LParen, Id, Plus, Num, LParen, Times, Id, EOF] -- (x+4(*y