(* Copyright 2003 by University of Chicago *)
(* Jing Cao and Lukasz Ziarek *)

structure PPAst: PPAST = 
struct

local structure EM = ErrorMsg
      structure M = Modules
      structure B = Bindings
      structure S = Symbol
      structure BT = BasicTypes

      open Ast Tuples Fixity VarCon Types PrettyPrint PPUtil PPType PPVal
in

val internals = ElabControl.internals

val lineprint = ref false

fun C f x y = f y x

val nullFix = INfix(0,0)
val infFix = INfix(1000000,100000)
fun strongerL(INfix(_,m),INfix(n,_)) = m >= n
  | strongerL _ = false			(* should not matter *)
fun strongerR(INfix(_,m),INfix(n,_)) = n > m
  | strongerR _ = true			(* should not matter *)

fun prpos(ppstrm: PrettyPrint.ppstream,
          source: Source.inputSource, charpos: int) =
    if (!lineprint) then
      let val (file:string,line:int,pos:int) = Source.filepos source charpos
       in add_string ppstrm (Int.toString line);
	  add_string ppstrm ".";
	  add_string ppstrm (Int.toString pos)
      end
    else add_string ppstrm (Int.toString charpos)

fun bug msg = ErrorMsg.impossible("PPAst: "^msg)
val arrowStamp = BT.arrowStamp
fun strength(ty) =
    case ty
      of VarTy(_) => 1
       | ConTy(tycon, args) => 
		if length(tycon)=1 then
			let fun test(tyc::[]) = 
				if S.eq(S.strSymbol("->"), tyc) then 0
				else 2
			      | test(_) = 2	
			in test(tycon)
			end
		else 2
       | RecordTy _ => 2
       | TupleTy _ => 1
       | _ => 2

fun checkpat (n,nil) = true
  | checkpat (n, (sym,_)::fields) = S.eq(sym, numlabel n) andalso checkpat(n+1,fields)

fun checkexp (n, nil) = true
  | checkexp (n, (sym,exp)::fields) =
	S.eq(sym, numlabel n) andalso checkexp (n+1, fields)

fun isTUPLEpat (RecordPat{def=[_],...}) = false
  | isTUPLEpat (RecordPat{def=defs,flexibility=false}) = checkpat(1,defs)
  | isTUPLEpat _ = false

fun isTUPLEexp (RecordExp[_]) = false
  | isTUPLEexp (RecordExp fields) = checkexp(1,fields)
  | isTUPLEexp (MarkExp(a,_)) = isTUPLEexp a
  | isTUPLEexp _ = false

fun lookFIX (env,sym) =
    Lookup.lookFix (env,S.fixSymbol(S.name sym))

fun stripMark (MarkExp(a,_)) = stripMark a
  | stripMark x = x

fun trim [x] = []
  | trim (a::b) = a::trim b
  | trim [] = []


fun ppPat (context as (env, source_opt)) ppstrm =
    let val ppsay = add_string ppstrm

	fun pp_symbol_list symbol_list =
		let fun pr _ (symbol) = (ppSym ppstrm symbol)
		in ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm "/")),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end	    
	fun ppPat' (WildPat,_) = (ppsay "_")
	  | ppPat' (VarPat p, d) =  pp_symbol_list(p)
	  | ppPat' (IntPat i,_) = ppsay(IntInf.toString i)
	  | ppPat' (WordPat w,_) = ppsay(IntInf.toString w)
	  | ppPat' (StringPat s, _) = pp_mlstr ppstrm s
	  | ppPat' (CharPat s,_) = (ppsay "#"; pp_mlstr ppstrm s)
	  | ppPat' (LayeredPat {varPat,expPat},d) =
		(begin_block ppstrm CONSISTENT 0;
		 ppPat'(varPat,d); ppsay " as "; ppPat'(expPat,d-1);
		 end_block ppstrm)
	  | ppPat' (RecordPat{def=[],flexibility},_) =
		if flexibility then ppsay "{...}"
		else ppsay "()"
	  | ppPat' (r as RecordPat{def,flexibility},d) =
		if isTUPLEpat r
		then ppClosedSequence ppstrm
			{front=(C add_string "("),
			 sep=(fn ppstrm => (add_string ppstrm ","; add_break ppstrm (0,0))),
			 back=(C add_string ")"),
			 pr=(fn _ => fn (sym,pat) => ppPat' (pat, d-1)),
			 style=INCONSISTENT}
			def
		else ppClosedSequence ppstrm
			{front=(C add_string "{"),
			 sep=(fn ppstrm => (add_string ppstrm ","; add_break ppstrm (0,0))),
			 back=(fn ppstrm => if flexibility then add_string ppstrm ",...}"
					    else add_string ppstrm "}"),
			 pr=(fn ppstrm => fn (sym,pat) => (ppSym ppstrm sym; add_string ppstrm "=";
			     ppPat' (pat, d-1))),
			 style=INCONSISTENT}
			def  
	  | ppPat' (ListPat nil, d) = ppsay "[]"
	  | ppPat' (ListPat l, d) =	
		let fun pr _ pat = ppPat'(pat, d-1)
		in ppClosedSequence ppstrm
		   {front=(C add_string "["),
		    sep=(fn ppstrm => (add_string ppstrm ",";add_break ppstrm (0,0))),
		    back=(C add_string "]"),
	 	    pr=pr,
		    style=INCONSISTENT}
		   l
		end
	  | ppPat' (TuplePat t, d) = 
	    	let fun pr _ pat = ppPat'(pat, d-1)
	    	in ppClosedSequence ppstrm
			     {front=(C add_string "("),
			      sep=(fn ppstrm => (add_string ppstrm ",";
						 add_break ppstrm (0,0))),
			      back=(C add_string ")"),
			      pr=pr,
			      style=INCONSISTENT}
			     t
	    	end
	  | ppPat' (FlatAppPat fap, d) =
		let fun pr _ {item,fixity,region} = ppPat'(item,d-1)		
		in ppSequence ppstrm
			{sep=(fn ppstrm => (add_break ppstrm (1,0))),
			 pr=pr,
			 style=INCONSISTENT}
			fap
		end 
	  | ppPat' (AppPat {constr, argument}, d) = 
		(begin_block ppstrm CONSISTENT 0;
		 ppPat'(constr,d); ppsay " as "; ppPat'(argument,d);
		 end_block ppstrm)
	  | ppPat' (ConstraintPat {pattern, constraint}, d) = 
		(begin_block ppstrm INCONSISTENT 0;
		 ppPat' (pattern, d-1); ppsay " :";
		 add_break ppstrm (1,2);
		 ppty context ppstrm (constraint, d);
		 end_block ppstrm)
	  | ppPat' (VectorPat nil, d) = ppsay "#[]"
	  | ppPat' (VectorPat v, d) = 
		let fun pr _ pat = ppPat'(pat, d-1)
		in ppClosedSequence ppstrm
		   {front=(C add_string "#["),
		    sep=(fn ppstrm => (add_string ppstrm ",";add_break ppstrm (1,0))),
		    back=(C add_string "]"),
	 	    pr=pr,
		    style=INCONSISTENT}
		   v
		end
	  | ppPat' (MarkPat (pat, (s,e)), d) = 
	    (case source_opt
		of SOME source =>
		     if !internals
		     then (ppsay "<MARK(";
			   prpos(ppstrm,source,s); ppsay ",";
			   prpos(ppstrm,source,e); ppsay "): ";
			   ppPat'(pat,d); ppsay ">")
		     else ppPat'(pat,d)
	         | NONE => ppPat'(pat,d))

          | ppPat' (OrPat orpat, d) =
		let fun pr _ pat = ppPat'(pat, d-1)		
		in ppClosedSequence ppstrm
			{front=(C add_string "("),
			 sep=(fn ppstrm => (add_break ppstrm (1,0); add_string ppstrm "| ")),
			 back=(C add_string ")"),
			 pr=pr,
			 style=INCONSISTENT}
		end (orpat)
	
    in ppPat'
    end


and ppExp (context as (env, source_opt)) ppstrm =
  let val ppsay = add_string ppstrm
      fun lparen() = ppsay "(" 
      fun rparen() = ppsay ")"
      fun lpcond(atom) = if atom then ppsay "(" else ()      
      fun rpcond(atom) = if atom then ppsay ")" else ()
      fun pp_symbol_list symbol_list =
		let fun pr _ (symbol) = (ppSym ppstrm symbol)
		in ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm "/")),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end

      fun ppExp' (_,_,0) = ppsay "<exp>"
	| ppExp' (VarExp p,_,_) = pp_symbol_list(p)
	| ppExp' (FnExp nil,_,d) = ppsay "<function>"
	| ppExp' (FnExp rules,_,d)=	
		let fun pr _ pat = ppRule context ppstrm(pat, d-1)
		in ppClosedSequence ppstrm
		   {front=(C add_string "["),
		    sep=(fn ppstrm => (add_string ppstrm ",";add_break ppstrm (0,0))),
		    back=(C add_string "]"),
	 	    pr=pr,
		    style=INCONSISTENT}
		   rules
		end

	| ppExp' (FlatAppExp fap,_,d) = 
		let fun pr _ {item,fixity,region} = ppExp'(item,true, d)		
		in ppSequence ppstrm
			{sep=(fn ppstrm => (add_break ppstrm (1,0))),
			 pr=pr,
			 style=INCONSISTENT}
			fap
		end 
	| ppExp'(e as AppExp _,atom,d) =
	      let val infix0 = INfix(0,0)
	       in lpcond(atom);
		  ppAppExp(e,nullFix,nullFix,d);
		  rpcond(atom)
	      end
	| ppExp' (CaseExp {expr, rules},_,d) = 
	      (begin_block ppstrm CONSISTENT 0;
	       ppsay "(case "; ppExp'(expr,true,d-1); nl_indent ppstrm 2;
	       ppvlist ppstrm ("of ","   | ",
		 (fn ppstrm => fn r => ppRule context ppstrm (r,d-1)), 
                  trim rules);
	       rparen();
	       end_block ppstrm)
	| ppExp' (LetExp {dec, expr},_,d) =
	      (begin_block ppstrm CONSISTENT 0;
		ppsay "let ";
		begin_block ppstrm CONSISTENT 0;
		 ppDec context ppstrm (dec,d-1); 
		end_block ppstrm;
		add_break ppstrm (1,0);
		ppsay "in ";
		begin_block ppstrm CONSISTENT 0;
		 ppExp'(expr,false,d-1);
		end_block ppstrm;
		add_break ppstrm (1,0);
		ppsay "end";
	       end_block ppstrm)
 	| ppExp'(SeqExp exps,_,d) =
	      ppClosedSequence ppstrm
	        {front=(C add_string "("),
		 sep=(fn ppstrm => (add_string ppstrm ";";
				    add_break ppstrm (1,0))),
		 back=(C add_string ")"),
		 pr=(fn _ => fn exp => ppExp'(exp,false,d-1)),
		 style=INCONSISTENT}
		exps
	| ppExp' (IntExp i,_,_) = ppsay (IntInf.toString i)
	| ppExp' (WordExp w,_,_) = ppsay (IntInf.toString w)
	| ppExp' (RealExp r,_,_) = ppsay r
	| ppExp' (StringExp s,_,_) = pp_mlstr ppstrm s
	| ppExp' (CharExp s,_,_) = (ppsay "#"; pp_mlstr ppstrm s)
	| ppExp'(r as RecordExp fields,_,d) =
	      if isTUPLEexp r
	      then ppClosedSequence ppstrm
		     {front=(C add_string "("),
		      sep=(fn ppstrm => (add_string ppstrm ",";
					 add_break ppstrm (0,0))),
		      back=(C add_string ")"),
		      pr=(fn _ => fn (_,exp) => ppExp'(exp,false,d-1)),
		      style=INCONSISTENT}
		     fields
	      else ppClosedSequence ppstrm
		     {front=(C add_string "{"),
		      sep=(fn ppstrm => (add_string ppstrm ",";
					 add_break ppstrm (0,0))),
		      back=(C add_string "}"),
		      pr=(fn ppstrm => fn (name,exp) =>
			  (ppSym ppstrm name; ppsay "=";
			   ppExp'(exp,false,d))),
		      style=INCONSISTENT}
		     fields
	| ppExp' (ListExp p,_,d) = 
		 ppClosedSequence ppstrm
		     {front=(C add_string "["),
		      sep=(fn ppstrm => (add_string ppstrm ",";
					 add_break ppstrm (0,0))),
		      back=(C add_string "]"),
		      pr=(fn ppstrm => fn exp =>
			  (ppExp'(exp,false,d-1))),
		      style=INCONSISTENT}
		     p
	| ppExp' (TupleExp p,_,d)=
		ppClosedSequence ppstrm
		     {front=(C add_string "("),
		      sep=(fn ppstrm => (add_string ppstrm ",";
					 add_break ppstrm (0,0))),
		      back=(C add_string ")"),
		      pr=(fn ppstrm => fn exp =>
			  (ppExp'(exp,false,d-1))),
		      style=INCONSISTENT}
		     p
	| ppExp'(SelectorExp name, atom,d) =
	      (begin_block ppstrm CONSISTENT 0;
	        lpcond(atom);
	        ppsay "#"; ppSym ppstrm name;
	        ppsay ">";
		rpcond(atom);
	       end_block ppstrm)
	| ppExp' (ConstraintExp {expr,constraint},atom,d) = 
	     (begin_block ppstrm INCONSISTENT 0;
	       lpcond(atom);
	       ppExp'(expr,false,d); ppsay ":";
	       add_break ppstrm (1,2);
	       ppty context ppstrm (constraint,d);
	       rpcond(atom);
	      end_block ppstrm)
        | ppExp'(HandleExp{expr,rules},atom,d) =
	     (begin_block ppstrm CONSISTENT 0;
	       lpcond(atom);
	       ppExp'(expr,atom,d-1); add_newline ppstrm; ppsay "handle ";
	       nl_indent ppstrm 2;
	       ppvlist ppstrm ("  ","| ",
		  (fn ppstrm => fn r => ppRule context ppstrm (r,d-1)), rules);
	       rpcond(atom);
	      end_block ppstrm)
	| ppExp' (RaiseExp exp,atom,d) = 
	      (begin_block ppstrm CONSISTENT 0;
	       lpcond(atom);
	       ppsay "raise "; ppExp'(exp,true,d-1);
	       rpcond(atom);
	       end_block ppstrm)
	| ppExp' (IfExp { test, thenCase, elseCase },atom,d) =
	      (begin_block ppstrm CONSISTENT 0;
	       lpcond(atom);
	       ppsay "if ";
	       begin_block ppstrm CONSISTENT 0;
	        ppExp' (test, false, d-1);
	       end_block ppstrm;
	       add_break ppstrm (1, 0);
	       ppsay "then ";
	       begin_block ppstrm CONSISTENT 0;
	        ppExp' (thenCase, false, d-1);
	       end_block ppstrm;
	       add_break ppstrm (1, 0);
	       ppsay "else ";
	       begin_block ppstrm CONSISTENT 0;
	        ppExp' (elseCase, false, d-1);
	       end_block ppstrm;
	       rpcond(atom);
	       end_block ppstrm)
	| ppExp' (AndalsoExp (e1, e2),atom,d) =
	      (begin_block ppstrm CONSISTENT 0;
	       lpcond(atom);
	       begin_block ppstrm CONSISTENT 0;
	       ppExp' (e1,true,d-1);
	       end_block ppstrm;
	       add_break ppstrm (1, 0);
	       ppsay "andalso ";
	       begin_block ppstrm CONSISTENT 0;
	       ppExp' (e2,true,d-1);
	       end_block ppstrm;
	       rpcond(atom);
	       end_block ppstrm)
	 | ppExp' (OrelseExp (e1, e2),atom,d) =
	      (begin_block ppstrm CONSISTENT 0;
	       lpcond(atom);
	       begin_block ppstrm CONSISTENT 0;
	       ppExp' (e1,true,d-1);
	       end_block ppstrm;
	       add_break ppstrm (1, 0);
	       ppsay "orelse ";
	       begin_block ppstrm CONSISTENT 0;
	       ppExp' (e2,true,d-1);
	       end_block ppstrm;
	       rpcond(atom);
	       end_block ppstrm)
	 | ppExp' (WhileExp { test, expr },atom,d) =
	      (begin_block ppstrm CONSISTENT 0;
	       ppsay "while ";
	       begin_block ppstrm CONSISTENT 0;
	        ppExp'(test,false,d-1);
	       end_block ppstrm;
	       add_break ppstrm (1, 0);
	       ppsay "do ";
	       begin_block ppstrm CONSISTENT 0;
	         ppExp'(expr,false,d-1);
	       end_block ppstrm;
	       end_block ppstrm)
	
	 | ppExp'(VectorExp nil,_,d) = ppsay "#[]"
	 | ppExp'(VectorExp exps,_,d) =
	      let fun pr _ exp = ppExp'(exp,false,d-1)
	      in  ppClosedSequence ppstrm
		    {front=(C add_string "#["),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string "]"),
		     pr=pr,
		     style=INCONSISTENT}
		    exps
	      end
	 | ppExp'(MarkExp (exp,(s,e)),atom,d) =
	      (case source_opt
		of SOME source =>
		     if !internals
		     then (ppsay "<MARK(";
			   prpos(ppstrm,source,s); ppsay ",";
			   prpos(ppstrm,source,e); ppsay "): ";
			   ppExp'(exp,false,d); ppsay ">")
		     else ppExp'(exp,atom,d)
	         | NONE => ppExp'(exp,atom,d))
	 and ppAppExp (_,_,_,0) = add_string ppstrm "<exp>"
	   | ppAppExp arg =
	    let val ppsay = add_string ppstrm
		fun fixitypp(name,rand,leftFix,rightFix,d) =
		    let val dname = SymPath.toString(SymPath.SPATH name)
			val thisFix = case name
					of [id] => lookFIX(env,id)
					 | _ => NONfix
			fun prNon exp =
			    (begin_block ppstrm INCONSISTENT 2;
			     ppsay dname; add_break ppstrm (1,0);
			     ppExp'(exp,true,d-1);
			     end_block ppstrm)
		     in case thisFix
			  of INfix _ =>
			     (case stripMark rand
				of RecordExp[(_,pl),(_,pr)] =>
				    let val atom = strongerL(leftFix,thisFix)
					     orelse strongerR(thisFix,rightFix)
					val (left,right) =
					    if atom then (nullFix,nullFix)
					    else (leftFix,rightFix)
				     in (begin_block ppstrm INCONSISTENT 2;
					  lpcond(atom);
					  ppAppExp (pl,left,thisFix,d-1);
					  add_break ppstrm (1,0);
					  ppsay dname;
					  add_break ppstrm (1,0);
					  ppAppExp (pr,thisFix,right,d-1);
					  rpcond(atom);
					 end_block ppstrm)
				    end
				 | e' => prNon e')
			   | NONfix => prNon rand
		    end
		fun appPrint(_,_,_,0) = ppsay "#"
		  | appPrint(AppExp{function=rator,argument=rand},l,r,d) =
		    (case stripMark rator
		       of VarExp v =>
			   let val path = v
			    in fixitypp(path,rand,l,r,d)
			   end
		        | rator =>
			   (begin_block ppstrm INCONSISTENT 2;
			     ppExp'(rator,true,d-1); add_break ppstrm (1,2);
			     ppExp'(rand,true,d-1);
			    end_block ppstrm))
		  | appPrint(MarkExp(exp,(s,e)),l,r,d) =
		      (case source_opt
			of SOME source =>
			     if !internals
			     then (ppsay "<MARK(";
				   prpos(ppstrm,source,s); ppsay ",";
				   prpos(ppstrm,source,e); ppsay "): ";
				   ppExp'(exp,false,d); ppsay ">")
			     else appPrint(exp,l,r,d)
			 | NONE => appPrint(exp,l,r,d))
		  | appPrint (e,_,_,d) = ppExp'(e,true,d)
	     in appPrint arg
	    end
  in (fn(exp,depth)=> ppExp'(exp,false,depth))
  end
	
and ppRule (context as (env,source_opt)) ppstrm (Rule{pat,exp},d) =
    if d>0 then (begin_block ppstrm CONSISTENT 0;
	  ppPat context ppstrm (pat,d-1);
	  add_string ppstrm " =>"; add_break ppstrm (1,2);
	  ppExp context ppstrm (exp,d-1);
	  end_block ppstrm)
    else add_string ppstrm "<rule>"

and ppStrexp (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	   fun pp_symbol_list symbol_list =
		let fun pr _ (symbol) = (ppSym ppstrm symbol)
		in ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm "/")),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end
        fun  ppStrexp'(_,0) = ppsay "<strexp>"

	   | ppStrexp'(VarStr p, d) = pp_symbol_list(p)

           | ppStrexp'(BaseStr de, d) = ppDec context ppstrm (de, d)

	   | ppStrexp'(ConstrainedStr (stre, sige), d) = ppStrexp' (stre, d-1)

	   | ppStrexp'(AppStr (path, str_list), d) = 
		  let fun pr _ (strl, bool) = (ppStrexp context ppstrm (strl,d))
	        in pp_symbol_list(path); ppClosedSequence ppstrm
		    {front=(C add_string "("),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string ")"),
		     pr=pr,
		     style=INCONSISTENT}
		     str_list
	        end	
	   
           | ppStrexp'(AppStrI (path, str_list), d) = 
		  let fun pr _ (strl, bool) = (ppStrexp context ppstrm (strl,d))
	          in pp_symbol_list(path); ppClosedSequence ppstrm
		    {front=(C add_string "("),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string ")"),
		     pr=pr,
		     style=INCONSISTENT}
		     str_list
	          end	

	   | ppStrexp'(LetStr(dec,body),d) =
	      (begin_block ppstrm CONSISTENT 0;
	       ppsay "let "; ppDec context ppstrm (dec,d-1); 
               add_newline ppstrm;
	       ppsay " in "; ppStrexp'(body,d-1); add_newline ppstrm;
	       ppsay "end";
	       end_block ppstrm)

         | ppStrexp'(MarkStr(body,(s,e)),d) =
	      (case source_opt
		of SOME source =>
	           (ppsay "MARKstr(";
		      ppStrexp'(body,d); ppsay ",";
		      prpos(ppstrm,source,s); ppsay ",";
		      prpos(ppstrm,source,e); ppsay ")")
	         | NONE => ppStrexp'(body,d))
    in
	ppStrexp'
    end

and ppFctexp (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun pp_symbol_list symbol_list =
		let fun pr _ (symbol) = (ppSym ppstrm symbol)
		in ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm "/")),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end    
	fun ppFctexp'(_, 0) = ppsay "<fctexp>"
            | ppFctexp'(BaseFct {params,body,constraint}, d) = 
		(begin_block ppstrm CONSISTENT 0;
		 add_newline ppstrm;
		 ppStrexp context ppstrm (body, d);
		 add_newline ppstrm;
		 end_block ppstrm)
	    | ppFctexp'(VarFct (p, _), d) = pp_symbol_list(p)
            | ppFctexp'(LetFct(dec,body),d) =
	     	(begin_block ppstrm CONSISTENT 0;
	         ppsay "let "; ppDec context ppstrm (dec,d-1); 
                 add_newline ppstrm;
	         ppsay " in "; ppFctexp'(body,d-1); add_newline ppstrm;
	         ppsay "end";
	         end_block ppstrm)
	    | ppFctexp'(AppFct(path,sblist, _),d) = ppsay "need to implement AppFct"
	    | ppFctexp'(MarkFct(body,(s,e)),d) =
	     	(case source_opt
	       		of SOME source =>
	           		(ppsay "MARKfct(";
		    		 ppFctexp'(body,d); ppsay ",";
		    		 prpos(ppstrm,source,s); ppsay ",";
		    		 prpos(ppstrm,source,e); ppsay ")")
               		 | NONE => ppFctexp'(body,d))

    in
	ppFctexp'
    end

and ppWhereSpec (context as (env,source_opt)) ppstrm =
  let val ppsay = add_string ppstrm
      fun ppWhereSpec'(_,0) = ppsay "<WhereSpec>"
        | ppWhereSpec'(WhType([],[],ty),d) = ppty context ppstrm (ty, d)
	| ppWhereSpec'(WhType(slist,tvlist,ty),d) = 
		let fun pr _ (sym:symbol, tv:Ast.tyvar) = (ppSym ppstrm sym; ppsay" - "; ppTyvar context ppstrm (tv, d))
		    val tuple_list =  ListPair.zip(slist:symbol list,tvlist:Ast.tyvar list)
	        in  ppClosedSequence ppstrm
		    {front=(C add_string "["),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string "]"),
		     pr=pr,
		     style=INCONSISTENT}
		     tuple_list
	        end
	  | ppWhereSpec'(WhStruct(slist,slist'),d) =
		let fun pr _ (sym:symbol, sym':symbol) = (ppSym ppstrm sym; ppsay" - "; ppSym ppstrm sym')
		    val tuple_list =  ListPair.zip(slist:symbol list,slist':symbol list)
	        in  ppClosedSequence ppstrm
		    {front=(C add_string "["),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string "]"),
		     pr=pr,
		     style=INCONSISTENT}
		    tuple_list
		end
  in
      ppWhereSpec'
  end

and ppSigExp (context as (env,source_opt)) ppstrm =
  let val ppsay = add_string ppstrm
      fun ppSigExp'(_,0) = ppsay "<SigExp>"
	| ppSigExp'(VarSig s,d) = (ppSym ppstrm s)
	| ppSigExp'(AugSig (sigs, wherel),d) =
		  let fun pr _ (wheres) = (ppWhereSpec context ppstrm (wheres,d-1))
	        in ppSigExp context ppstrm (sigs,d); ppsay" =";
			add_newline ppstrm; ppsay"sig"; add_newline ppstrm;
			ppSequence ppstrm
		     {sep=(fn ppstrm => (add_newline ppstrm)),
		     pr=pr,
		     style=INCONSISTENT}
		     wherel; add_newline ppstrm; ppsay"end"
	        end	
	| ppSigExp'(BaseSig specl,d) = 
		let fun pr _ (speci) = (ppSpec context ppstrm (speci,d))
	        in ppsay"sig"; add_newline ppstrm; ppSequence ppstrm
		    {sep=(fn ppstrm => (add_newline ppstrm)),
		     pr=pr,
		     style=INCONSISTENT}
		     specl; add_newline ppstrm; ppsay"end"
	        end
	| ppSigExp'(MarkSig (m,r),d) = ppSigExp context ppstrm (m,d)
  in
      ppSigExp'
  end

and ppFsigExp (context as (env,source_opt)) ppstrm =
  let val ppsay = add_string ppstrm
      fun ppFsigExp'(_,0) = ppsay "<FsigExp>"
	| ppFsigExp'(VarFsig s,d) = ppSym ppstrm s
	| ppFsigExp'(BaseFsig {param,result},d) =
		(*NEED TO ASK MACQUEEN*) 
		ppsay "need to implement Basefsig"
	| ppFsigExp'(MarkFsig (m,r),d) = ppFsigExp context ppstrm (m,d)
  in
      ppFsigExp'
  end

and ppSpec (context as (env,source_opt)) ppstrm =
  let val ppsay = add_string ppstrm
	fun pp_symbol_list symbol_list =
		let fun pr _ (symbol) = (ppSym ppstrm symbol)
		in ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm "/")),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end
      fun ppSpec'(_,0) = ppsay "<Spec>"
	  | ppSpec'(StrSpec sspo_list,d) =
		let fun pr _ (symbol, sigexp, path) = (
			case path
				of SOME p => (ppSym ppstrm symbol; ppsay " = "; ppSigExp context ppstrm (sigexp,d);
						   ppsay " "; pp_symbol_list(p))
				 | NONE =>  (ppSym ppstrm symbol; ppsay " = "; ppSigExp context ppstrm (sigexp,d))
			)
		in ppClosedSequence ppstrm
		    {front=(C add_string "structure "),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=pr,
		     style=INCONSISTENT}
		     sspo_list
		end 
	  | ppSpec'(TycSpec (stto_list, bool),d) = 
		let fun pr _ (symbol, tyvar_list, tyo) = (
			case tyo
				of SOME ty => (ppSym ppstrm symbol; ppsay " : "; ppty context ppstrm(ty, d))
				 | NONE =>  (ppSym ppstrm symbol)
			)
		in ppClosedSequence ppstrm
		    {front=(C add_string "type "),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=pr,
		     style=INCONSISTENT}
		     stto_list
		end 
	  | ppSpec'(FctSpec sf_list,d) =
		let fun pr _ (symbol, fsigexp) = (ppSym ppstrm symbol; ppsay " = "; ppFsigExp context ppstrm (fsigexp, d)) 
		in ppClosedSequence ppstrm
		    {front=(C add_string "functor "),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=pr,
		     style=INCONSISTENT}
		     sf_list
		end 
	  | ppSpec'(ValSpec st_list,d) = 
		let fun pr _ (symbol, ty) = (ppSym ppstrm symbol; ppsay " : "; ppty context ppstrm (ty, d)) 
		in ppClosedSequence ppstrm
		    {front=(C add_string "val "),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=pr,
		     style=INCONSISTENT}
		     st_list
		end 
	  | ppSpec'(DataSpec {datatycs, withtycs},d) = 
		let fun prd _ (dbing) = (ppDb context ppstrm (dbing, d))
		    fun prw _ (tbing) = (ppTb context ppstrm (tbing, d))
		in (begin_block ppstrm CONSISTENT 0;
	         ppClosedSequence ppstrm
		    {front=(C add_string "datatype "),
		     sep=(fn ppstrm => (add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=prd,
		     style=INCONSISTENT}
		    datatycs;
	         add_newline ppstrm;
	         ppClosedSequence ppstrm
		    {front=(C add_string "withtype "),
		     sep=(fn ppstrm => (add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=prw,
		     style=INCONSISTENT}
		    withtycs;
	         end_block ppstrm)
		end
	  | ppSpec'(ExceSpec sto_list,d) = 
		let fun pr _ (symbol, tyo) = (
			case tyo
				of SOME ty => (ppSym ppstrm symbol; ppsay " : "; ppty context ppstrm (ty, d))
				 | NONE =>  ppSym ppstrm symbol
		)
		in ppClosedSequence ppstrm
		    {front=(C add_string "exception "),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=pr,
		     style=INCONSISTENT}
		     sto_list
		end
	  | ppSpec'(ShareStrSpec p_list,d) = 
		let fun pr _ (path) = pp_symbol_list path 
		in ppClosedSequence ppstrm
		    {front=(C add_string "structure sharing "),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=pr,
		     style=INCONSISTENT}
		     p_list
		end 
	  | ppSpec'(ShareTycSpec p_list,d) = 
		let fun pr _ (path) = pp_symbol_list path 
		in ppClosedSequence ppstrm
		    {front=(C add_string "type sharing "),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=pr,
		     style=INCONSISTENT}
		     p_list
		end 
	  | ppSpec'(IncludeSpec sigexp ,d) = ppSigExp context ppstrm (sigexp, d)
	  | ppSpec'(MarkSpec (m,r),d) = ppSpec context ppstrm (m,d)
  in
      ppSpec'
  end

and ppDec (context as (env,source_opt)) ppstrm =
  let val ppsay = add_string ppstrm
	fun pp_symbol_list symbol_list =
		let fun pr _ (symbol) = (ppSym ppstrm symbol)
		in ppClosedSequence ppstrm
		    {front=(C add_string "["),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string "]"),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end

      fun ppDec'(_,0) = ppsay "<dec>"
        | ppDec'(ValDec (vbs, tyvars),d) =
		(begin_block ppstrm CONSISTENT 0;
	  	 ppvlist ppstrm ("val ","and ",
	     	 (fn ppstrm => fn vb => ppVb context ppstrm (vb,d-1)),vbs);
	   	 end_block ppstrm)
	  | ppDec'(ValrecDec (rvbs, tyvars),d) = 
		(begin_block ppstrm CONSISTENT 0;
	   	 ppvlist ppstrm ("val rec ","and ",
	     	 (fn ppstrm => fn rvb => ppRvb context ppstrm (rvb,d-1)),rvbs);
	   	 end_block ppstrm)
        | ppDec'(FunDec (fbs,tyvars),d) =
		(begin_block ppstrm CONSISTENT 0;
	   	 ppvlist ppstrm ("val fun ","and ",
	     	 (fn ppstrm => fn fb => ppFb context ppstrm (fb,d-1)),fbs);
	   	 end_block ppstrm)
        | ppDec'(TypeDec tycs,d) =
	      let fun pr _ (tyc) = (ppTb context ppstrm (tyc, d))
	      in  ppClosedSequence ppstrm
		    {front=(C add_string "type "),
		     sep=(fn ppstrm => (add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=pr,
		     style=INCONSISTENT}
		    tycs
	      end 	
	   | ppDec'(DatatypeDec{datatycs,withtycs=[]},d) = 
	 	let fun prd _ (dbing) = (ppDb context ppstrm (dbing, d))
		in ppClosedSequence ppstrm
		    {front=(C add_string "datatype "),
		     sep=(fn ppstrm => (add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=prd,
		     style=INCONSISTENT}
		    datatycs
		end             
        | ppDec'(DatatypeDec{datatycs,withtycs},d) = 
	 	let fun prd _ (dbing) = (ppDb context ppstrm (dbing, d))
		    fun prw _ (tbing) = (ppTb context ppstrm (tbing, d))
		in (begin_block ppstrm CONSISTENT 0;
	         ppClosedSequence ppstrm
		    {front=(C add_string "datatype "),
		     sep=(fn ppstrm => (add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=prd,
		     style=INCONSISTENT}
		    datatycs;
	         add_newline ppstrm;
	         ppClosedSequence ppstrm
		    {front=(C add_string "withtype "),
		     sep=(fn ppstrm => (add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=prw,
		     style=INCONSISTENT}
		    withtycs;
	         end_block ppstrm)
		end
	  | ppDec'(AbstypeDec{abstycs,withtycs=[],body},d) = 
		let fun prd _ (dbing) = (ppDb context ppstrm (dbing, d))
		    fun prw _ (tbing) = (ppTb context ppstrm (tbing, d))
		in (begin_block ppstrm CONSISTENT 0;
	         (ppClosedSequence ppstrm
		    {front=(C add_string "datatype "),
		     sep=(fn ppstrm => (add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=prd,
		     style=INCONSISTENT}
		    abstycs);
		    add_newline ppstrm;
		    ppDec' (body, d);
	          end_block ppstrm)
		end
        | ppDec'(AbstypeDec{abstycs,withtycs,body},d) = 
		let fun prd _ (dbing) = (ppDb context ppstrm (dbing, d))
		    fun prw _ (tbing) = (ppTb context ppstrm (tbing, d))
		in (begin_block ppstrm CONSISTENT 0;
	         (ppClosedSequence ppstrm
		    {front=(C add_string "datatype "),
		     sep=(fn ppstrm => (add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=prd,
		     style=INCONSISTENT}
		    abstycs);
	         add_newline ppstrm;
	         (ppClosedSequence ppstrm
		    {front=(C add_string "withtype "),
		     sep=(fn ppstrm => (add_break ppstrm (1,0))),
		     back=(C add_string ""),
		     pr=prw,
		     style=INCONSISTENT}
		    withtycs);
		 add_newline ppstrm;
		 ppDec' (body, d);
	      	 end_block ppstrm)
		end
        | ppDec'(ExceptionDec ebs,d) =
		(begin_block ppstrm CONSISTENT 0;
	      	 ((fn ppstrm => fn eb => ppEb context ppstrm (eb,d-1)),ebs);
		 end_block ppstrm)
        | ppDec'(StrDec sbs,d) = let
	      fun f ppstrm (Strb{name, def, constraint}) =
		  (ppSym ppstrm name;
		   add_break ppstrm (1,2);
		   ppStrexp context ppstrm (def,d-1))
		  | f _ _ = bug "ppDec:STRdec:STRB"
	      in
	        begin_block ppstrm CONSISTENT 0;
	        ppvlist ppstrm ("structure ","and ", f, sbs);
	        end_block ppstrm
	      end
        | ppDec'(AbsDec sbs,d) = let
	      fun f ppstrm (Strb{name, def, constraint}) =
		    (ppSym ppstrm name;
		     add_break ppstrm (1,2);
		     ppStrexp context ppstrm (def,d-1))
		   | f _ _ = bug "ppDec':ABSdec"
	      in
	        begin_block ppstrm CONSISTENT 0;
	        ppvlist ppstrm ("abstraction ","and ", f, sbs);
	        end_block ppstrm
	      end
        | ppDec'(FctDec fbs,d) = 
	     let fun f ppstrm (Fctb{name=fname, def}) =
                  (ppSym ppstrm fname;
		        add_break ppstrm (1, 2); 
		        ppFctexp context ppstrm (def,d-1))
		     | f _ _ = bug "ppDec':FCTdec"
	     in
	        begin_block ppstrm CONSISTENT 0;
	        ppvlist ppstrm ("functor ","and ", f, fbs);
             end_block ppstrm
	     end
        | ppDec'(SigDec sigvars,d) = 
	    let fun f ppstrm (Sigb{name=fname, def}) =
                  (ppSym ppstrm fname;
		        add_break ppstrm (1, 2); ppsay "= ";
		        ppSigExp context ppstrm (def,d))
		     | f _ _ = bug "ppDec':FCTdec"
	    in
	      begin_block ppstrm CONSISTENT 0;
	      ppvlist ppstrm ("signature ","and ", f, sigvars);
              end_block ppstrm
	    end
        | ppDec'(FsigDec sigvars,d) = 
		let fun pr _ sigv = ppFsigb context ppstrm (sigv,d)
		in (begin_block ppstrm CONSISTENT 0;
	          ppSequence ppstrm
	          {sep=add_newline,
	          pr=pr,
	          style=CONSISTENT}
	          sigvars;
	        end_block ppstrm)
		end
        | ppDec'(LocalDec(inner,outer),d) =
	    (begin_block ppstrm CONSISTENT 0;
	     ppsay "local"; nl_indent ppstrm 2;
	     ppDec'(inner,d-1); add_newline ppstrm;
	     ppsay "in ";
	     ppDec'(outer,d-1); add_newline ppstrm;
	     ppsay "end";
	     end_block ppstrm)
        | ppDec'(SeqDec decs,d) =
	    (begin_block ppstrm CONSISTENT 0;
	     ppSequence ppstrm
	       {sep=add_newline,
	        pr=(fn ppstrm => fn dec => ppDec'(dec,d)),
	        style=CONSISTENT}
	        decs;
	     end_block ppstrm)
        | ppDec'(OpenDec strbs,d) = 
		(begin_block ppstrm CONSISTENT 0;
	   	 ppsay "open ";
	   	 ppSequence ppstrm
	     	 {sep=(fn ppstrm => add_break ppstrm (1,0)),
	      	  pr=(fn ppstrm => fn sp => pp_symbol_list sp),
	      	  style=INCONSISTENT}
            	 strbs;
	   	 end_block ppstrm)

        | ppDec'(OvldDec ovldvar,d) =
		(*ASK MACQUEEN IF THIS NEEDS TO BE PRINTED, in comments it says overloading "internal"*) 
		ppsay "OVLDdec,need to implement"
	| ppDec'(FixDec {fixity,ops},d) =
	  	(begin_block ppstrm CONSISTENT 0;
	   		case fixity
	     		of NONfix => ppsay "nonfix "
	      		| INfix (i,_) => 
		    		(if i mod 2 = 0 then 
		       		 ppsay "infix "
		     		 else ppsay "infixr ";
		     		 if i div 2 > 0 then
		       		 (ppsay(Int.toString(i div 2));
				 ppsay " ")
		     		 else ());
	   		ppSequence ppstrm
	     		{sep=(fn ppstrm => add_break ppstrm (1,0)),
	     		 pr=ppSym,style=INCONSISTENT}
	     		 ops;
	  		 end_block ppstrm)

        | ppDec'(MarkDec(dec,(s,e)),d) =  
	   (case source_opt
	    of SOME source =>
	       (ppsay "MarkDec(";
		  ppDec'(dec,d); ppsay ",";
		  prpos(ppstrm,source,s); ppsay ",";
		  prpos(ppstrm,source,e); ppsay ")")

	     | NONE => ppDec'(dec,d))

	  
     in ppDec'
    end

and ppVb (context as (env,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun ppVb'(_,0)= ppsay "<binding>"
	  | ppVb'(Vb{pat,exp,...},d) = 
		(begin_block ppstrm CONSISTENT 0;
	  	 ppPat context ppstrm (pat,d-1); add_string ppstrm " =";
	  	 add_break ppstrm (1,2); ppExp context ppstrm (exp,d-1);
	  	 end_block ppstrm)
	  | ppVb'(MarkVb (vb,region),d) = ppVb' (vb,d)
    in
	ppVb'
    end

and ppRvb (context as (_,source_opt)) ppstrm  = 
    let val ppsay = add_string ppstrm
	fun ppRvb'(_,0)= ppsay "<rec binding>"
	  | ppRvb'(Rvb{var, exp, ...},d) =
		(begin_block ppstrm INCONSISTENT 0;
	  	 ppSym ppstrm var; add_string ppstrm " =";
	  	 add_break ppstrm (1,2); ppExp context ppstrm (exp,d-1);
	  	 end_block ppstrm)
	  | ppRvb'(MarkRvb (rvb, region), d) = ppRvb' (rvb, d)
    in
	ppRvb'
    end

and ppFb (context as (_,source_opt)) ppstrm  = 
    let val ppsay = add_string ppstrm
	fun ppFb'(_,0)= ppsay "<F.binding>"
	  | ppFb'(Fb (clauses, ops),d) =
		let fun pr _ (cl:clause) = (ppClause context ppstrm (cl,d))
	        in  ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     pr=pr,
		     style=INCONSISTENT}
		     clauses
	        end		
	  | ppFb'(MarkFb (t,r),d) = ppFb context ppstrm (t,d)
    in
	ppFb'
    end

and ppClause (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun ppClause'(Clause{pats,resultty,exp},d) =

	(case resultty
	   of SOME a =>
		let (*val first::sec::last = pats*)
		    fun s(pats) = 
			case pats of 
			    []=> NONE
			  | first::[]=> NONE
			  | first::sec::last => SOME sec
		    val sec = s(pats)
		    fun lpra(SOME arglist) =
			(case arglist of
			    {item = TuplePat t,fixity=fix ,region=r} => add_string ppstrm ""
			  | {item = RecordPat{def=[],flexibility=false}, fixity=fix ,region=r} => add_string ppstrm ""
			  | _ => add_string ppstrm "(")
		      | lpra(NONE) = add_string ppstrm ""

		    fun rpra(SOME arglist) =
			(case arglist of
			    {item = TuplePat t,fixity=fix ,region=r} => add_string ppstrm ""
			  | {item = RecordPat{def=[],flexibility=false}, fixity=fix ,region=r} => add_string ppstrm ""
			  | _ => add_string ppstrm ")")
		      | rpra(NONE) = add_string ppstrm ""
		    fun pr _ {item,fixity,region} = ppPat context ppstrm (item,d)		
		in    (begin_block ppstrm INCONSISTENT 0;
	  	 	(ppSequence ppstrm
			{sep=(fn ppstrm => 
				 (add_break ppstrm (1,0); 
				  lpra(sec))),
			 pr=pr,
			 style=INCONSISTENT}
			pats);
			rpra(sec);
			add_string ppstrm " ->"; add_break ppstrm (1,0); 
			ppExp context ppstrm (exp,d); add_string ppstrm ":"; ppty context ppstrm (a,d);
	  	 	end_block ppstrm)	
		end 
	   | NONE =>
	     
		let (*val first::sec::last = pats*)
		    fun s(pats) = 
			case pats of 
			    []=> NONE
			  | first::[]=> NONE
			  | first::sec::last => SOME sec
		    val sec = s(pats)
		    fun lpra(SOME arglist) =
			(case arglist of
			    {item = TuplePat t,fixity=fix ,region=r} => add_string ppstrm ""
			  | {item = RecordPat{def=[],flexibility=false}, fixity=fix ,region=r} => add_string ppstrm ""
			  | _ => add_string ppstrm "(")
		      | lpra(NONE) = add_string ppstrm ""
		    fun rpra(SOME arglist) =
			(case arglist of
			    {item = TuplePat t,fixity=fix ,region=r} => add_string ppstrm ""
			  | {item = RecordPat{def=[],flexibility=false}, fixity=fix ,region=r} => add_string ppstrm ""
			  | _ => add_string ppstrm ")")
		      | rpra(NONE) = add_string ppstrm ""	
		    val counter = 1
		    fun pr _ {item,fixity,region} =ppPat context ppstrm (item,d)

		in    (begin_block ppstrm INCONSISTENT 0;
	  	 	(ppSequence ppstrm
			{sep=(fn ppstrm => (add_break ppstrm (1,0); lpra(sec))),
			 pr=pr,			 
			 style=INCONSISTENT}
			pats);
			rpra(sec);
			add_string ppstrm  " ->";
	  	 	add_break ppstrm (1,0); ppExp context ppstrm (exp,d);
	  	 	end_block ppstrm)	
		end 
	) (*matches case resultty*)
    in
	ppClause'
    end

and ppTb (context as (_,source_opt)) ppstrm  = 
    let val ppsay = add_string ppstrm
	  fun pp_tyvar_list (symbol_list, d) =
		let fun pr _ (tyvar) = (ppTyvar context ppstrm (tyvar, d))
		in ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm "*";add_break ppstrm (1,0))),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end

	  fun ppTb'(_,0)= ppsay "<T.binding>"
	    | ppTb'(Tb{tyc,def,tyvars},d) = 
		(begin_block ppstrm INCONSISTENT 0;
	  	 ppSym ppstrm tyc; add_string ppstrm " =";
	  	 add_break ppstrm (1,0); ppty context ppstrm (def, d);
		 pp_tyvar_list (tyvars,d);
	  	 end_block ppstrm)
	    | ppTb'(MarkTb (t,r),d) = ppTb context ppstrm (t,d)
    in
	ppTb'
    end

and ppDb (context as (_,source_opt)) ppstrm  = 
    let val ppsay = add_string ppstrm
	  fun pp_tyvar_list (symbol_list, d) =
		let fun pr _ (tyvar) = (ppTyvar context ppstrm (tyvar, d))
		in ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm "*";
					add_break ppstrm (1,0))),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end
	  fun ppDb'(_,0)= ppsay "<D.binding>"
	    | ppDb'(Db{tyc,tyvars,rhs,lazyp},d) = 
			(begin_block ppstrm INCONSISTENT 0;
	  	         ppSym ppstrm tyc; add_string ppstrm " =";
	  	         add_break ppstrm (1,0); ppDbrhs context ppstrm (rhs,d);
	  	         end_block ppstrm)
	    | ppDb'(MarkDb (t,r),d) = ppDb context ppstrm (t,d)
    in
	ppDb'
    end

and ppDbrhs (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun ppDbrhs'(_,0)= ppsay "<dbrhs>"
	  | ppDbrhs'(Constrs const,d) = 
		let fun pr _ (sym:symbol, tv:Ast.ty option) = (
			case tv
				of SOME a =>
					(ppSym ppstrm sym; ppsay" of "; ppty context ppstrm (a, d))
				 | NONE =>
					(ppSym ppstrm sym))
	        in  ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm " |";
					add_break ppstrm (1,0))),
		     pr=pr,
		     style=INCONSISTENT}
		     const
	        end
	  | ppDbrhs'(Repl symlist,d) = 
		let fun pr _ (sym:symbol) = (ppSym ppstrm sym)
	        in  ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm " |";
					add_break ppstrm (1,0))),
		     pr=pr,
		     style=INCONSISTENT}
		     symlist
	        end
    in
	ppDbrhs'
    end

and ppEb (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun pp_symbol_list symbol_list =
		let fun pr _ (symbol) = (ppSym ppstrm symbol)
		in ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm "/")),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end
	fun ppEb'(_,0)= ppsay "<Eb>"
	  | ppEb'(EbGen{exn, etype},d) = 
		(case etype
			of SOME a => 
				(begin_block ppstrm CONSISTENT 0;
	  	 		 ppSym ppstrm exn; add_string ppstrm " =";
	  	 		 add_break ppstrm (1,2); ppty context ppstrm (a,d-1);
	  	 		 end_block ppstrm)
			 | NONE =>
				(begin_block ppstrm CONSISTENT 0;
	  	 		 ppSym ppstrm exn; 
	  	  		 end_block ppstrm)
		)
	  | ppEb'(EbDef{exn, edef},d) = 
		(*ASK MACQUEEN IF WE NEED TO PRINT EDEF*)
		(begin_block ppstrm CONSISTENT 0;
	  	 ppSym ppstrm exn; add_string ppstrm " =";
	  	 add_break ppstrm (1,2); pp_symbol_list(edef);
	  	 end_block ppstrm)
	  | ppEb'(MarkEb (t,r),d) = ppEb context ppstrm (t,d)
    in
	ppEb'
    end

and ppStrb (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun ppStrb'(_,0)= ppsay "<Strb>"
	  | ppStrb'(Strb{name,def,constraint},d) = 
	 (*ASK MACQUEEN ABOUT CONSTRAINT*)
		(begin_block ppstrm CONSISTENT 0;
	  	 ppSym ppstrm name; add_string ppstrm " =";
	  	 add_break ppstrm (1,2); ppStrexp context ppstrm (def,d-1);
	  	 end_block ppstrm)
	  | ppStrb'(MarkStrb (t,r),d) = ppStrb context ppstrm (t,d)
    in
	ppStrb'
    end

and ppFctb (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun ppFctb'(_,0)= ppsay "<Fctb>"
	  | ppFctb'(Fctb{name,def},d) =
		(begin_block ppstrm CONSISTENT 0;
	  	 ppSym ppstrm name; add_string ppstrm " =";
	  	 add_break ppstrm (1,2); ppFctexp context ppstrm (def,d-1);
	  	 end_block ppstrm) 
	  | ppFctb'(MarkFctb (t,r),d) = ppFctb context ppstrm (t,d)
    in
	ppFctb'
    end

and ppSigb (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun ppSigb'(_,0)= ppsay "<Sigb>"
	  | ppSigb'(Sigb{name,def},d) = 
		(begin_block ppstrm CONSISTENT 0;
	  	 ppSym ppstrm name; add_string ppstrm " =";
	  	 add_break ppstrm (1,2); ppSigExp context ppstrm (def,d-1);
	  	 end_block ppstrm)
	  | ppSigb'(MarkSigb (t,r),d) = ppSigb context ppstrm (t,d)
    in
	ppSigb'
    end

and ppFsigb (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun ppFsigb'(_,0)= ppsay "<Fsigb>"
	  | ppFsigb'(Fsigb{name,def},d) = 
		(begin_block ppstrm CONSISTENT 0;
	  	 ppSym ppstrm name; add_string ppstrm " =";
	  	 add_break ppstrm (1,2); ppFsigExp context ppstrm (def,d-1);
	  	 end_block ppstrm)
	  | ppFsigb'(MarkFsigb (t,r),d) = ppFsigb context ppstrm (t,d)
    in
	ppFsigb'
    end

and ppTyvar (context as (_,source_opt)) ppstrm =
    let val ppsay = add_string ppstrm
	fun ppTyvar'(_,0)= ppsay "<tyvar>"
	  | ppTyvar'(Tyv s,d) = (ppSym ppstrm s) 
	  | ppTyvar'(MarkTyv (t,r),d) = ppTyvar context ppstrm (t,d)
    in
	ppTyvar'
    end
and ppty (context as (env, source_opt)) ppstrm =			
  let val ppsay = add_string ppstrm
	fun pp_symbol_list symbol_list =
		let fun pr _ (symbol) = (ppSym ppstrm symbol)
		in ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm ".")),
		     pr=pr,
		     style=INCONSISTENT}
		     symbol_list
		end
      fun ppty' (_,0) = ppsay"<type>"
        | ppty' (VarTy t,d) =  (ppTyvar context ppstrm (t,d))
	| ppty' (ConTy (tycon, []),d) = 
		(begin_block ppstrm CONSISTENT 1;
		 pp_symbol_list(tycon);
		 end_block ppstrm)
	| ppty' (ConTy (tycon, args),d) = 
		(begin_block ppstrm CONSISTENT 1;
		 ppTypeArgs(args,d);
		 pp_symbol_list(tycon);
		 end_block ppstrm)
					
		
	| ppty' (RecordTy s, d) = 
		let fun pr _ (sym:symbol, tv:Ast.ty) = 
			(ppSym ppstrm sym; ppsay" - "; ppty context ppstrm (tv, d))
	        in  ppClosedSequence ppstrm
		    {front=(C add_string "{"),
		     sep=(fn ppstrm => (add_string ppstrm ",";
					add_break ppstrm (1,0))),
		     back=(C add_string "}"),
		     pr=pr,
		     style=INCONSISTENT}
		     s
	        end
	| ppty' (TupleTy t, d) = 
		let fun pr _ (tv:Ast.ty) = (ppty context ppstrm (tv, d))
	      in  ppSequence ppstrm
		    {sep=(fn ppstrm => (add_string ppstrm " *";
		     add_break ppstrm (1,0))),
		     pr=pr,
		     style=INCONSISTENT}
		     t
	      end
	| ppty' (MarkTy (t,r),d) = (ppty context ppstrm (t,d))
	and ppTypeArgs ([],d) = ()
	  | ppTypeArgs ([ty],d) = 
	     (if strength ty <= 1
	      then (begin_block ppstrm INCONSISTENT 1;
                    ppsay "("; 
                    ppty' (ty,d); 
                    ppsay ")";
                    end_block ppstrm)
	      else ppty' (ty,d);
	      add_break ppstrm (1,0))
	  | ppTypeArgs (tys,d) =
              ppClosedSequence ppstrm 
	        {front=C add_string "(",
		    sep=fn ppstrm => (add_string ppstrm ",";
                                   add_break ppstrm (0,0)),
		     back=C add_string ") ",
		     style=INCONSISTENT, 
                pr=fn _ => fn ty => ppty' (ty,d)}
		tys 
  in ppty'
  end

end (* top-level local *)
end (* structure PPAst *)
