(* normalize.sml
*
* COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
* All rights reserved.
*)
structure Normalize : sig
val transform : HighIL.program -> HighIL.program
end = struct
structure IL = HighIL
structure Op = HighOps
structure V = IL.Var
structure Ty = HighILTypes
structure ST = Stats
structure NE = NormalizeEin
structure P=Printer
structure Order=OrderEin
structure mk=mkOperators
structure App=App
(********** Counters for statistics **********)
val cntInsideScale = ST.newCounter "high-opt:inside-scale"
val cntInsideOffset = ST.newCounter "high-opt:inside-offset"
val cntInsideNeg = ST.newCounter "high-opt:inside-meg"
val cntInsideCurl = ST.newCounter "high-opt:inside-curl"
val cntInsideDiff = ST.newCounter "high-opt:inside-diff"
val cntProbeAdd = ST.newCounter "high-opt:probe-add"
val cntProbeSub = ST.newCounter "high-opt:probe-sub"
val cntProbeScale = ST.newCounter "high-opt:probe-scale"
val cntProbeOffset = ST.newCounter "high-opt:probe-offset"
val cntProbeNeg = ST.newCounter "high-opt:probe-neg"
val cntProbeCurl = ST.newCounter "high-opt:probe-curl"
val cntDiffField = ST.newCounter "high-opt:diff-field"
val cntDiffAdd = ST.newCounter "high-opt:diff-add"
val cntDiffScale = ST.newCounter "high-opt:diff-scale"
val cntDiffOffset = ST.newCounter "high-opt:diff-offset"
val cntDiffNeg = ST.newCounter "high-opt:diff-neg"
val cntCurlScale = ST.newCounter "high-opt:curl-scale"
val cntCurlNeg = ST.newCounter "high-opt:curl-neg"
val cntUnused = ST.newCounter "high-opt:unused"
val firstCounter = cntInsideScale
val lastCounter = cntUnused
structure UnusedElim = UnusedElimFn (
structure IL = IL
val cntUnused = cntUnused)
fun useCount (IL.V{useCnt, ...}) = !useCnt
(* adjust a variable's use count *)
fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)
fun use x = (incUse x; x)
fun getRHS x = (case V.binding x
of IL.VB_RHS(IL.OP arg) => SOME arg
| IL.VB_RHS(IL.VAR x') => getRHS x'
(*| IL.VB_RHS(IL.EINAPP (e,arg))=>*)
| _ => NONE
(* end case *))
fun isEin x = (case V.binding x
of IL.VB_RHS(IL.EINAPP (e,arg))=>SOME(IL.EINAPP (e,arg))
| IL.VB_RHS(IL.VAR x') => isEin x'
|_=>NONE
(* end case *))
(* get the binding of a kernel variable *)
fun getKernelRHS h = (case getRHS h
of SOME(Op.Kernel(kernel, k), []) => (kernel, k)
| _ => raise Fail(concat[
"bogus kernel binding ", V.toString h, " = ", IL.vbToString(V.binding h)
])
(* end case *))
(* optimize the rhs of an assignment, returning NONE if there is no change *)
(*args are vars, how do I find if an einapp applied to an einapp?*)
(*where to add type checker*)
fun doNormalize e=(let
val ordered=Order.orderfn(e)
val (n,change)=NE.normalize(ordered)
in (case change
of 0 =>ordered
| _ => let
val str=String.concat ["\n Ordered:\n",P.printerE(ordered),"\n =>",P.printerE(n)]
val p=print str
in n
end
(*end case*))
end)
fun printX(IL.ASSGN (x, IL.OP(opss,args)))= let
val a= print(String.concat(["\n",V.toString x,"==",Op.toString opss," : "]))
in print (String.concatWith "," (List.map V.toString args)) end
| printX(IL.ASSGN(x,IL.LIT _))= print(String.concat["\n :",V.toString x,"==...Lit"])
| printX(IL.ASSGN(x,IL.CONS (_, varl)))= let
val y= List.map (fn e1=> V.toString e1) varl
in print(String.concat[ "\n",(V.toString x),"==",(String.concatWith "," y)]) end
| printX(IL.ASSGN (x, _))=print(String.concat["\n",V.toString x,"==","CONS"])
fun check params _=1
fun doRHS (lhs, IL.EINAPP (ein, args))=(let
val x= print (String.concat[V.toString lhs,"=="," ---Current: ", P.printerE(ein)])
val g= print (String.concatWith "," (List.map V.toString args))
fun rewrite(0,_,_, [], _)= (print "No Subst ";NONE)
| rewrite(_,orig,_, [], done)= let
val n=doNormalize orig
val r=print(String.concat["\n Return:\t",P.printerE(n)])
in
SOME[(lhs,IL.EINAPP(n, done))]
end
| rewrite(change,orig, place, e::es,done)=let
val v =isEin e
val g=print(String.concat["\n checking argument First:", Int.toString(place)])
in case v
of NONE=> (rewrite(change,orig, place+1, es, done@[e]))
| SOME(IL.EINAPP (e2,arg1))=>let
val Ein.EIN{params, index, body}=orig
val g=print(String.concat["checking argument:", Int.toString(place), "number of params",Int.toString(length(params)),"\n"])
val t=List.nth(params, place)
in (case t
of Ein.TEN(0,_)=> (rewrite(change,orig, place+1, es, done@[e]))
| _=> let
val m= print(String.concat["\n Apply at ", Int.toString(place),":--",P.printerE(e2),
"\n"])
val (c,subst)=App.app(orig,place,e2)
val m= print(String.concat["\n","Subst Result:\t", P.printerE(subst), "\n"])
in (case c of 0 => rewrite(1,subst, place+length(arg1), es,done@arg1)
|_=> (incUse lhs;(*decUse e;*)rewrite(1,subst, place+length(arg1), es,done@arg1)))
end
(*end case*))
end
end
val m= rewrite(0,ein, 0,args,[])
val t=print "\n\n\n"
in m end )
(*
| doRHS (lhs, IL.OP rhs) = (case rhs
of (Op.Inside dim, [pos, f]) => (case getRHS f
of SOME(Op.Field _, _) => NONE (* direct inside test does not need rewrite
| SOME(Op.OffsetField, [f', _]) => (
ST.tick cntInsideOffset;
decUse f;
SOME[(lhs, IL.OP(Op.Inside dim, [pos, use f']))])*)
| _ => raise Fail(concat[
"inside: bogus field binding ", V.toString f, " = ", IL.vbToString(V.binding f)
])
(* end case *))
| _ => NONE
(* end case *))
*)
| doRHS _ = NONE
structure Rewrite = RewriteFn (
struct
structure IL = IL
val doAssign = doRHS
fun doMAssign _ = NONE
val elimUnusedVars = UnusedElim.reduce
end)
val transform = Rewrite.transform
end