structure FindEscape : FINDESCAPE =
struct

structure S = Symbol	      
structure A = Absyn
structure T = Types

local
    val debug_global = false
    val error = ErrorMsg.error

    fun debugSay (s) =
	if debug_global then
	    TextIO.print (s ^ "\n")
	else
	    ()
in
fun transverseProg(exp) = transverseExp(S.empty, 0, exp)
and transverseExp(escenv, depth, A.OpExp{left,oper,right,pos}) =
    (transverseExp(escenv, depth, left);
     transverseExp(escenv, depth, right))
  | transverseExp(escenv, depth, A.SeqExp(seq)) =
    app (fn (expr) => (transverseExp(escenv, depth, expr)))
	(map (fn (exp,pos) => exp) seq)
  | transverseExp(escenv, depth, A.IfExp{test,then',else',pos}) =
    (transverseExp(escenv, depth, test);
     transverseExp(escenv, depth, then');
     case else' of SOME exp => transverseExp(escenv, depth, exp)
		 | NONE => ())
  | transverseExp (escenv,depth, A.LetExp{decs=decs,body=body,...}) =
    let val escenv' = foldl (fn (dec, env) => transverseDec(env,depth,dec)) escenv decs
    in
	transverseExp(escenv', depth, body)
    end
  | transverseExp (escenv,depth, A.WhileExp{test=test,body=body,...}) =
    (transverseExp(escenv,depth, test);
     transverseExp(escenv,depth, body))
  | transverseExp (escenv,depth,A.VarExp(var)) =
    transverseVar(escenv,depth,var)
  | transverseExp _ = (debugSay "fell through")
     
and transverseVar(escenv, depth, A.SimpleVar(sym, pos)) =
    (case S.look(escenv, sym) of SOME (esclevel, flag)
				 => if esclevel < depth
				    then
					(print ("setting escape of " ^ (S.name sym)
						   ^ " to true (" ^ (Int.toString esclevel)
						   ^ " < " ^ (Int.toString depth) ^ ")\n");
					 flag := true)
				    else
					()
			      | NONE => error pos ("variable " ^ (S.name sym)
						   ^ " not defined, escape analysis failed!"))
  | transverseVar(escenv, depth, A.FieldVar(var, sym, pos)) =
    transverseVar(escenv, depth,var)
  | transverseVar(escenv, depth, A.SubscriptVar(var, exp, pos)) =
    (transverseVar(escenv, depth,var);
     transverseExp(escenv, depth,exp))
and transverseDec(escenv, depth, A.FunctionDec(decs)) =
    let
	fun every [] = true
	  | every (hd::tl) = hd andalso (every tl)
	fun leafp (A.CallExp(_)) = false
	  | leafp (A.SeqExp (exprs)) = every (map leafp (map #1 exprs))
	  | leafp (A.IfExp{test,then',else',pos}) = leafp test
						  andalso leafp then'
						  andalso (case else' of SOME exp => leafp exp
								       | NONE => true)
	  | leafp (A.AssignExp{exp=exp,...}) = leafp exp
	  | leafp (A.WhileExp{test=test,body=body,...}) = leafp test
                                                        andalso leafp body
	  | leafp (A.LetExp{decs=decs,body=body,...}) =
	    every (map (fn (A.VarDec{init=init,...}) => leafp init | _ => true) decs)
	    andalso leafp body
	  | leafp (A.ArrayExp{init=init,...}) = leafp init
	  | leafp (A.ForExp{lo=lo,hi=hi,body=body,...}) =
	    leafp lo
	    andalso leafp hi
	    andalso leafp body
	  | leafp (_) = true
    in
	(app (fn {name=name,params=params,body=body,leaf=leaf,...} :A.fundec =>
		 (* ah, the beauty of inefficiency *)
		 (leaf := leafp body;
		  print ("set leaf of " ^ (S.name name) ^ " to " ^ (Bool.toString (!leaf))^ "\n");
		  let val escenv' = foldr (fn ({name=name,escape=escape,...}:A.field, env)
					      =>
					      (print ("adding " ^ (S.name name) ^ " at "
							 ^ (Int.toString (depth+1)) ^ "\n");
					       S.enter(env,name,(depth+1, escape))))
					  escenv params
		  in
		      transverseExp(escenv', depth+1, body)
		  end)
		 ) decs);
	escenv
    end
  | transverseDec(escenv, depth, A.VarDec{name,escape,typ,init,pos}) =
    (print ("adding " ^ (S.name name) ^ " at "
	       ^ (Int.toString depth) ^ "\n");
     S.enter(escenv, name, (depth, escape)))
  | transverseDec(escenv,depth, A.TypeDec(decs)) =
    escenv
end
end