(*
 * A recursive descent parser for the syntax
 *
 *    P ::= S
 *
 *    S ::=   eps                             (empty statement)
 *          | var ':=' E ';'                  (assign statement)
 *          | 'if' E 'then' S 'else' S 'fi'   (if statement)
 *          | 'while' E 'do' S 'od'           (while statement)
 *          | 'for' var E E 'do' S 'od'       (for statement)
 *          | S S                             (sequential composition)
 *
 *    E ::=   num
 *          | '-' num
 *          | var
 *          | '-' var
 *          | '(' E ')'
 *          | '-' '(' E ')'
 *          | E '*' E | E '/' E 
 *          | E '+' E | E '-' E 
 *          | E '<' E | E '>' E | E '=' E | E '!=' E 
 *          | E '&&' E | E '||' E 
 *
 * The empty statement is represented by the empty list.
 * Each of assign statements, if statements and while statements is a singleton list
 * whose element represents the statement.
 * A sequentially composed statement S1 S2 is represented by the list L1 @ L2, where
 * S1 is represented by the list L1 and S2 is represented by the list L2.
 *
 *)
structure Parser : Parser = struct
  open Scanner 

  exception UnbalancedParen
  exception UnexpectedAfterUnaryMinus
  exception NoMinusNorNumNorVarNorLparen
  exception NoSemicolon
  exception UnexpectedAfterVariable
  exception NoFi
  exception NoElse
  exception NoThen
  exception NoOdInWhile
  exception NoDoInWhile
  exception NoOdInFor
  exception NoDoInFor
  exception UnexpectedBeginingOfStatement

  (*
   * Nodes for expressions.
   *)
  datatype exp =
    NumNode of int
  | VarNode of string
  | UminusNode of exp
  | MulNode of exp*exp
  | DivNode of exp*exp
  | PlusNode of exp*exp
  | MinusNode of exp*exp
  | LtNode of exp*exp
  | GtNode of exp*exp
  | EqNode of exp*exp
  | NeqNode of exp*exp
  | AndNode of exp*exp
  | OrNode of exp*exp

  (*
   * Nodes for statements.
   *)
  datatype stm =
    AssignNode of exp*exp
  | IfNode of exp*(stm list)*(stm list)
  | WhileNode of exp*(stm list)
  | ForNode of exp*exp*exp*(stm list)

  (*
   * The syntax for expressions is rewritten as follows so that 
   * a recursive descent parser can be used.
   *
   *     F ::= ['-'] num | ['-'] var | ['-'] '(' E ')'
   *     E1 ::= F E11
   *     E11 ::= eps | '*' F E11 | '/' F E11
   *     E2 ::= E1 E22
   *     E22 ::= eps | '+' E1 E22 | '-' E1 E22
   *     E3 ::= E2 E33
   *     E33 ::= eps | '<' E2 E33 | '>' E2 E33 | '=' E2 E33 | '!=' E2 E33
   *     E4 ::= E3 E44
   *     E44 ::= eps | '&&' E3 E44 | '||' E3 E44
   *     E ::= E4
   *
   * The precedence of the operators is as follows:
   *
   *     (unary) '-'            (strongest)
   *     '*', '/'
   *     '+', (bynary) '-'
   *     '<', '>', '=', '!='
   *     '&&', '||'             (weakest)
   *
   * Every operator is left-associative, e.g. 3-2-1 is parsed as ((3-2)-1).
   *)
  fun E l = E4 l
  and F l
      = case l of 
          (Num n)::l1 => (NumNode n,l1)
        | (Var v)::l1 => (VarNode v,l1)
        | Lpar::l1 => let val (en,l2) = E l1
            in case l2 of
                 Rpar::l3 => (en,l3)
               | _ => raise UnbalancedParen end
        | Minus::l1 => (case l1 of
                         (Num n)::l2 => (UminusNode (NumNode n),l2)
                       | (Var v)::l2 => (UminusNode (VarNode v),l2)
                       | Lpar::l2 => let val (en,l3) = E l2
                                     in case l3 of
                                          Rpar::l4 => (UminusNode en,l4)
                                        | _ => raise UnbalancedParen end
                       | _ => raise UnexpectedAfterUnaryMinus)
        | _ => raise NoMinusNorNumNorVarNorLparen
  and E1 l = let val (en,l1) = F l
             in E11 en l1 end
  and E11 en l 
      = case l of
          Mul::l1 => let val (en1,l2) = F l1
                     in E11 (MulNode (en,en1)) l2 end
        | Div::l1 => let val (en1,l2) = F l1
                     in E11 (DivNode (en,en1)) l2 end
        | _ => (en,l)
  and E2 l = let val (en,l1) = E1 l
             in E22 en l1 end
  and E22 en l 
      = case l of 
          Plus::l1 => let val (en1,l2) = E1 l1
                      in E22 (PlusNode (en,en1)) l2 end
        | Minus::l1 => let val (en1,l2) = E1 l1
                       in E22 (MinusNode (en,en1)) l2 end
        | _ => (en,l)
  and E3 l = let val (en,l1) = E2 l 
             in E33 en l1 end
  and E33 en l
      = case l of
          Lt::l1 => let val (en1,l2) = E2 l1
                    in E33 (LtNode (en,en1)) l2 end
        | Gt::l1 => let val (en1,l2) = E2 l1
                    in E33 (GtNode (en,en1)) l2 end
        | Eq::l1 => let val (en1,l2) = E2 l1
                    in E33 (EqNode (en,en1)) l2 end
        | Neq::l1 => let val (en1,l2) = E2 l1
                     in E33 (NeqNode (en,en1)) l2 end
        | _ => (en,l)
  and E4 l = let val (en,l1) = E3 l
             in E44 en l1 end
  and E44 en l
      = case l of
          And::l1 => let val (en1,l2) = E3 l1
                     in E44 (AndNode (en,en1)) l2 end
        | Or::l1 => let val (en1,l2) = E3 l1
                    in E44 (OrNode (en,en1)) l2 end
        | _ => (en,l)

  fun S l 
      = case l of
          (Var v)::l1 => (case l1 of
                            Assign::l2 => let val (en,l3) = E l2
                              in case l3 of
                                   Semc::l4 => (AssignNode (VarNode v,en),l4)
                                 | _ => raise NoSemicolon end
                          | _ => raise UnexpectedAfterVariable)
        | If::l1 => let val (en,l2) = E l1
            in case l2 of
                 Then::l3 => let val (sl,l4) = SS [] l3
                   in case l4 of
                        Else::l5 => let val (sl1,l6) = SS [] l5
                          in case l6 of
                               Fi::l7 => (IfNode (en,sl,sl1),l7)
                             | _ => raise NoFi end
                      | _ => raise NoElse end
               | _ => raise NoThen end
        | While::l1 => let val (en,l2) = E l1
            in case l2 of 
                 Do::l3 => let val (sl,l4) = SS [] l3
                   in case l4 of
                        Od::l5 => (WhileNode (en,sl),l5)
                      | _ => raise NoOdInWhile end
               | _ => raise NoDoInWhile end
        | For::((Var v)::l1) => let val (en1,l2) = E l1;
                                    val (en2,l3) = E l2
            in case l3 of 
                 Do::l4 => let val (sl,l5) = SS [] l4
                   in case l5 of
                        Od::l6 => (ForNode (VarNode v,en1,en2,sl),l6)
                      | _ => raise NoOdInFor end
               | _ => raise NoDoInFor end
        | _ => raise UnexpectedBeginingOfStatement
  and SS sl l 
      = case l of
          (Var s)::l1 => let val (sn,l2) = S ((Var s)::l1)
            in SS (sl @ [sn]) l2 end
        | If::l1 => let val (sn,l2) = S (If::l1)
            in SS (sl @ [sn]) l2 end
        | While::l1 => let val (sn,l2) = S (While::l1)
            in SS (sl @ [sn]) l2 end
        | For::l1 => let val (sn,l2) = S (For::l1)
            in SS (sl @ [sn]) l2 end
        | _ => (sl,l)

  (*
   * parser converts a list of tokens into a list of parse trees.
   * subparser is auxiliary for parser.
   *)
  fun subparser sl [] = sl
    | subparser sl tl = let val (n,l) = S tl
                        in subparser (sl @ [n]) l end

  fun parser l = subparser [] l
end