(* Allows more print depth.                                         *)
Compiler.Control.Print.printDepth:= 100;

datatype arithExp = AST_ID of string | AST_NUM of int | 
    AST_NEG of arithExp | AST_PLUS of arithExp * arithExp | 
    AST_MINUS of arithExp * arithExp | AST_PRODUCT of arithExp * arithExp | 
    AST_QUOTIENT of arithExp * arithExp | AST_ERROR of string;
    
datatype token = ID of string | NUM of int | Plus | Minus | Mult | Div | Neg
  | LParen | RParen | EOF;

signature PCFPARSER =
sig
    val parse : token list -> arithExp
end

structure PCFparser : PCFPARSER =
struct
    (* Output an error message *)
    fun error (msg:string) = print msg

    (* Parses an expression.  If an expression is found, returns a
       tuple containing the ast for the expression and the input
       following the expression.  If an expression is not found, it
       returns an error and consumes all remaining input.
    *)
       (* Expression -> Term TermTail *)
    fun parseExpression ((ID v)::tl) = parseTermTail(parseTerm((ID v)::tl))
      | parseExpression ((NUM n)::tl) = parseTermTail(parseTerm((NUM n)::tl))
      | parseExpression (LParen::tl) = parseTermTail(parseTerm(LParen::tl))
      | parseExpression (Neg::tl) = parseTermTail(parseTerm(Neg::tl))
       (* error cases *)
      | parseExpression [EOF] = 
          (error "Unexpected end of input\n";
           (AST_ERROR "Unexpected end of input", nil))

      | parseExpression _ = 
          (error "Fatal error\n";
           (AST_ERROR "Fatal error", nil))

    (* Parses a term.  If a term is found, returns a
       tuple containing the ast for the term and the input
       following the factor.  If a term is not found, it
       returns an error and consumes all remaining input.
    *)
       (* Term -> Factor FactorTail *)
and parseTerm ((ID v)::tl) = parseFactorTail(parseFactor((ID v)::tl))
      | parseTerm ((NUM n)::tl)  = parseFactorTail(parseFactor((NUM n)::tl))
      | parseTerm (LParen::tl)  = parseFactorTail(parseFactor(LParen::tl))
      | parseTerm (Neg::tl)  = parseFactorTail(parseFactor(Neg::tl))
       (* error cases *)
      | parseTerm [EOF] = 
          (error "Unexpected end of input\n";
           (AST_ERROR "Unexpected end of input", nil))

      | parseTerm _ = 
          (error "Fatal error\n";
           (AST_ERROR "Fatal error", nil))

    (* Parses a factor.  If a factor is found, returns a
       tuple containing the ast for the factor and the input
       following the factor.  If a factor is not found, it
       returns an error and consumes all remaining input.
    *)
       (* Factor -> Id | Num | ~ Factor | ( Expression ) *)
and parseFactor ((ID v)::rest) = (AST_ID v,rest)
      | parseFactor ((NUM n)::rest)  = (AST_NUM n,rest)
      | parseFactor (Neg::others)  = let
            val (fact,rest) = parseFactor others
           in (AST_NEG fact,rest)
           end
      | parseFactor (LParen::rest)  = 
            let val (eTree,rest2) = parseExpression rest
         in if hd rest2 = RParen then (eTree,tl rest2) 
		else (error "no closing parenthesis\n"; 
		(AST_ERROR "no closing parenthesis",nil))
	 end
       (* error cases *)
      | parseFactor [EOF] = 
          (error "Unexpected end of input\n";
           (AST_ERROR "Unexpected end of input", nil))

      | parseFactor _ = 
          (error "Fatal error\n";
           (AST_ERROR "Fatal error", nil))

    (* Parses the tail of a term.  If a term is found, returns a
       tuple containing the ast for the term and the input
       following the factor.  If a term is not found, it
       returns an error and consumes all remaining input.
    *)
       (* TermTail -> { AddOp Term TermTail }  *)
and parseTermTail (left, Plus::others) = let
               		val (right,rest) = parseTerm others
 		in parseTermTail(AST_PLUS (left,right), rest)
		end
      | parseTermTail (left, Minus::others) = let
               		val (right,rest) = parseTerm others
 		in parseTermTail(AST_MINUS (left,right), rest)
		end
      | parseTermTail (term, RParen::others) = (term, RParen::others)
      | parseTermTail (term, EOF::others) = (term, EOF::others)

       (* error cases *)
      | parseTermTail _ = 
          (error "Fatal error\n";
           (AST_ERROR "Fatal error", nil))

    (* Parses the tail of a factor.  If a factor is found, returns a
       tuple containing the ast for the factor and the input
       following the factor.  If a term is not found, it
       returns an error and consumes all remaining input.
    *)
       (* FactorTail -> { MultOP Factor FactorTail } *)
and parseFactorTail (left, Mult::others) = let
               		val (right,rest) = parseTerm others
 		in parseFactorTail(AST_PRODUCT(left,right), rest)
		end
      | parseFactorTail (left, Div::others) = let
               		val (right,rest) = parseTerm others
 		in parseFactorTail(AST_QUOTIENT (left,right), rest)
		end
       (* Legal tokens to follow TermTail *)
      | parseFactorTail (term, Plus::others) = (term, Plus::others)
      | parseFactorTail (term, Minus::others) = (term, Minus::others)
      | parseFactorTail (term, RParen::others) = (term, RParen::others)
      | parseFactorTail (term, EOF::others) = (term, EOF::others)

       (* error cases *)
      | parseFactorTail _ = 
          (error "Fatal error\n";
           (AST_ERROR "Fatal error", nil))



    (* Return an AST for the list of tokens passed in. *)
  fun parse tokens =
      let 
        val (ast1, rest) = parseExpression tokens
      in
        if rest = [EOF] orelse rest = nil then
          ast1
        else
          (error "Fatal error -- more input than expected.\n";
           AST_ERROR "More input than expected.")
      end

end;  (* of structure PCFParser *)


(*  #CheckMatch Debug := true; -- put back in if run on Mac *)

(* The final definition of the function puts the pieces together.   *)

fun parsefile str = PCFparser.parse (PCFlexer.lex str);

fun parsestr str = PCFparser.parse (PCFlexer.lexstr str)