Completed Parser

-- Import character-related functions from the standard library.
import Data.Char


-- The goal is to lex and parse a string like this
example_string :: String
example_string = "(3 + (4 * 5))"


-- The token type
data Token = Lit Int
  | LParen | RParen
  | Plus | Times
  deriving Show

-- The expression type
data Arith_Expr = Num Int
    | PlusE Arith_Expr Arith_Expr
    | TimesE Arith_Expr Arith_Expr
  deriving Show


-- A lexer, on the same scheme as last time.
lexer :: String -> [Token]
lexer ('(' : cs) = LParen : lexer cs
lexer (')' : cs) = RParen : lexer cs
lexer ('+' : cs) = Plus : lexer cs
lexer ('*' : cs) = Times : lexer cs
lexer [] = []
lexer (c : cs) = if isSpace c then lexer cs
  else if isDigit c
  then let (int_string, rest) = break (not . isDigit) (c : cs)
       in (Lit (read int_string) : lexer rest)
  else error ("couldn't lex this: " ++ show (c : cs))


-- If we look at our rules, we see that all the rules for parsing an
-- S-sum-expression begin by parsing a P-product-expression. Then they either
-- continue the sum with a plus token or just promote the P expression.
parser_sexpr :: [Token] -> (Arith_Expr, [Token])
parser_sexpr toks =
  let (expr, toks2) = parser_pexpr toks
  in case toks2 of
    Plus : toks3 ->
      let (expr2, toks4) = parser_sexpr toks3
      in (PlusE expr expr2, toks4)
    _ -> (expr, toks2)


-- Likewise P-product-expressions start with an atom, and then optionally
-- add a times token and another argument after it.
parser_pexpr :: [Token] -> (Arith_Expr, [Token])
parser_pexpr toks =
  let (expr, toks2) = parser_atom toks
  in case toks2 of
    Times : toks3 ->
      let (expr2, toks4) = parser_pexpr toks3
      in (TimesE expr expr2, toks4)
    _ -> (expr, toks2)

-- Finally, atoms are either literals, and just that, or they are an open
-- parenthesis followed by a valid expression followed by a close parenthesis.
parser_atom :: [Token] -> (Arith_Expr, [Token])
parser_atom (Lit i : toks) = (Num i, toks)
parser_atom (LParen : toks) =
    let (expr, toks2) = parser_sexpr toks
    in case toks2 of
      (RParen : toks3) -> (expr, toks3)
      _ -> error ("parser_atom: expecting ')', got: " ++ show toks2)
parser_atom toks = error ("parser_atom: got: " ++ show toks)