functor PPrint(LambdaAst : LAMBDA_AST) : PPRINT = struct
  
  structure LambdaAst = LambdaAst

  val ppAlpha = ref false

  local 
    open LambdaAst Compiler.PrettyPrint
  in
    fun ppVar pps (s, i) =
      let val str = s ^ (if !ppAlpha then Int.toString i else "") in
	add_string pps str
      end

    fun ppNum pps i = 
      if i >= 0 then add_string pps (Int.toString i)
      else add_string pps ("-"^(Int.toString (~1 * i)))

    fun ppList printer pps style list =
      let 
	val pp = add_string pps
	fun ppListH [] = ()
	  | ppListH [x] = printer pps x
	  | ppListH (x::rest) = 
	  (printer pps x;
	   add_break pps (1, 0);
	   ppListH rest)
      in
	(begin_block pps style 0;
	 ppListH list;
	 end_block pps)
      end

    fun ppBinop pps b = 
      let val pp = add_string pps in
      case b of 
	Plus =>  pp "+ "
      | Times => pp "* "
      | Minus => pp "- "
      | Cons =>  pp "cons "
      | And =>   pp "and "
      | Or  =>   pp "or "
      end

    fun ppUnop pps u = 
      let val pp = add_string pps in
      case u of 
	Head =>  pp "hd "
      | Tail =>  pp "tl "
      | ZeroP => pp "zero? "
      end

    fun ppExpr pps e = 
      let val pp = add_string pps in
      case e of
	Var v => ppVar pps v
      | True => pp "#t"
      | False => pp "#f"
      | Num i => ppNum pps i
      | Binop (b, e1, e2) => 
	  (pp "(";
	   ppBinop pps b;
	   ppExpr pps e1;
	   add_break pps (1, 0);
	   ppExpr pps e2;
	   pp ")"
	   )
      | Unop (u, e1) => 
	  (pp "(";
	   ppUnop pps u;
	   ppExpr pps e1;
	   pp ")"
	   )
      | If (e1, e2, e3) => 
	  (pp "(if ";
	   ppExpr pps e1;
	   add_break pps (1, 2);
	   ppExpr pps e2;
	   add_break pps (1, 2);
	   ppExpr pps e3;
	   pp ")")
      | Lambda(v, e) => 
	  (pp "(fn ";
	   begin_block pps INCONSISTENT 2;
	   pp "(";
	   ppVar pps v;
	   pp ")";
	   add_break pps (1, 2);
	   ppExpr pps e;
	   end_block pps;
	   pp ")"
	   )
      | App (e1, e2) => 
	  (begin_block pps INCONSISTENT 0;
	   pp "(";
	   ppList ppExpr pps INCONSISTENT [e1, e2];
	   pp ")";
	   end_block pps)
      | Letrec (v, e1, e2) => 
	  (pp "(letrec ";
	   begin_block pps INCONSISTENT 2;
	   pp "(";
	   ppVar pps v;
	   add_break pps (1, 0);
	   ppExpr pps e1;
	   pp ")";
	   add_break pps (1, 2);
	   ppExpr pps e2;
	   end_block pps;
	   pp ")"
	   )
      | For (v, e1, e2) => 
	  (pp "(for ";
	   ppVar pps v;
	   add_break pps (1, 0);
	   ppExpr pps e1;
	   add_break pps (1, 0);
	   ppExpr pps e2;
	   pp ")"
	   )
      | Yield e => 
	  (pp "(yield ";
	   ppExpr pps e;
	   pp ")"
	   )
      | Print e => 
	  (pp "(print ";
	   ppExpr pps e;
	   pp ")"
	   )
      end

    fun ppE e = 
      let val s = pp_to_string 75 ppExpr e in print s end

  end


end


