Home My Page Projects Code Snippets Project Openings diderot

# SCM Repository

[diderot] Diff of /branches/charisee/src/compiler/high-il/normalize.sml
 [diderot] / branches / charisee / src / compiler / high-il / normalize.sml

# Diff of /branches/charisee/src/compiler/high-il/normalize.sml

revision 2604, Fri Apr 25 18:23:44 2014 UTC revision 2605, Wed Apr 30 01:46:09 2014 UTC
# Line 21  Line 21
21      structure Order=OrderEin      structure Order=OrderEin
22       structure mk=mkOperators       structure mk=mkOperators
23      structure App=App      structure App=App
24        structure S=SummationEin
25
26
27  (********** Counters for statistics **********)  (********** Counters for statistics **********)
# Line 61  Line 62
62      fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)      fun incUse (IL.V{useCnt, ...}) = (useCnt := !useCnt + 1)
63      fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)      fun decUse (IL.V{useCnt, ...}) = (useCnt := !useCnt - 1)
64      fun use x = (incUse x; x)      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 *))

65  fun isEin x = (case V.binding x  fun isEin x = (case V.binding x
66          of IL.VB_RHS(IL.EINAPP (e,arg))=>SOME(IL.EINAPP (e,arg))          of IL.VB_RHS(IL.EINAPP (e,arg))=>SOME(IL.EINAPP (e,arg))
67          | IL.VB_RHS(IL.VAR x') => isEin x'          | IL.VB_RHS(IL.VAR x') => isEin x'
# Line 80  Line 69
69      (* end case *))      (* end case *))
70
71
72    (* get the binding of a kernel variable *)  val testing=0
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 *)
73
74          (*args are vars, how do I find if an einapp applied to an einapp?*)  fun doNormalize e=let
75

fun doNormalize e=(let
76      val ordered=Order.orderfn(e)      val ordered=Order.orderfn(e)
val str=print(String.concat ["\n Ordered:\n",P.printerE(ordered),"\n"])
77      val (n,change)=NE.normalize(ordered)      val (n,change)=NE.normalize(ordered)
78      in (case change      val e'=S.cleanSummation(n)
79          of 0 =>ordered      in (case testing
80          | _ => let          of 0 => e'
81              val str=String.concat ["\n =>",P.printerE(n)]          | _  => (print(String.concat ["\n Ordered:\n",P.printerE(ordered),"\n =>",P.printerE(n),"\n Move Sums \n =>", P.printerE(e')]);e')
val p=print str
in  n
end
82          (*end case*))          (*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))]
83              end              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
84
85              of NONE=> (rewrite(change,orig, place+1, es, done@[e]))  fun foundEin(paramCount,place,change,newE,newArgs,done,newEinApp,orig,lhs)= (case (List.nth(paramCount, place),testing)
86              | SOME(IL.EINAPP (e2,arg1))=>let      of (Ein.TEN(0,_),_)=> (change,orig, place+1,  done@[newEinApp])
87                  val Ein.EIN{params, index, body}=orig      | (_,0)=>(case App.app(orig,place,newE)
88                  val g=print(String.concat["checking argument:", Int.toString(place), "number of params",Int.toString(length(params)),"\n"])          of (0,subst) => (1,subst, place+length(newArgs), done@newArgs)
89                  val t=List.nth(params, place)          | (c,subst) => (incUse lhs;(*decUse e;*)(1,subst, place+length(newArgs), done@newArgs))
90                  in (case t          (*end case*))
91                      of Ein.TEN(0,_)=> (rewrite(change,orig, place+1, es, done@[e]))      | (_,_)=> let
92                      | _=> let          val (c,subst)=App.app(orig,place,newE)
93                          val m= print(String.concat["\n Apply at ", Int.toString(place),":--",P.printerE(e2),          val _ = print(String.concat["\n Apply at ", Int.toString(place),":--",P.printerE(newE),
94                          "\n"])                  "\n","Subst Result:\t", P.printerE(subst), "\n"])
95                          val (c,subst)=App.app(orig,place,e2)          in (case c
96                          val m= print(String.concat["\n","Subst Result:\t", P.printerE(subst), "\n"])              of 0 => (1,subst, place+length(newArgs), done@newArgs)
97                          in (case c of 0 => rewrite(1,subst, place+length(arg1), es,done@arg1)              |_ => (incUse lhs;(*decUse e;*)(1,subst, place+length(newArgs), done@newArgs))
|_=> (incUse lhs;(*decUse e;*)rewrite(1,subst, place+length(arg1), es,done@arg1)))
end
98                      (*end case*))                      (*end case*))
99                  end                  end
100              end      (*end case*))
101
val m= rewrite(0,ein, 0,args,[])
val t=print "\n\n\n"
in m end )
102
103
104
105  (*  fun doRHS (lhs, IL.EINAPP (ein, args))=let
106       | doRHS (lhs, IL.OP rhs) = (case rhs      val _ =(case testing
107             of (Op.Inside dim, [pos, f]) => (case getRHS f          of 0=> 0
108                   of SOME(Op.Field _, _) => NONE (* direct inside test does not need rewrite          | _ => (print(String.concat[V.toString  lhs,"=="," ---Current: ", P.printerE(ein), (String.concatWith "," (List.map V.toString args))]);1)
| 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)
])
109                  (* end case *))                  (* end case *))
110              | _ => NONE
111        fun rewrite(0,_,_, [], _)= NONE
112            | rewrite(_,orig,_, [], done)= SOME[(lhs,IL.EINAPP((doNormalize orig), done))]
113            | rewrite(change,orig, place, e::es,done)=(case (isEin e)
114                of NONE => rewrite(change,orig, place+1, es, done@[e])
115                | SOME(IL.EINAPP (newE,newA))=> let
116                    val Ein.EIN{params, index, body}=orig
117                    val (change',e',place',done')=foundEin(params,place,change,newE,newA,done,e,orig,lhs)
118                    in rewrite(change',e',place',es,done')
119                    end
120                | _ => raise Fail"isEin did not work"
121            (* end case *))            (* end case *))
122        in rewrite(0,ein, 0,args,[])
123        end
124
*)
125        | doRHS _ = NONE        | doRHS _ = NONE
126

127      structure Rewrite = RewriteFn (      structure Rewrite = RewriteFn (
128        struct        struct
129          structure IL = IL          structure IL = IL

Legend:
 Removed from v.2604 changed lines Added in v.2605