Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /branches/charisee/src/compiler/high-il/app-ein.sml
ViewVC logotype

Annotation of /branches/charisee/src/compiler/high-il/app-ein.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3700 - (view) (download)

1 : cchiw 3448 (* substitution 179
2 : cchiw 2845 * Apply EIN opperator arguments to EIN operator.
3 : cchiw 2507 *
4 : jhr 3349 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
5 :     *
6 :     * COPYRIGHT (c) 2015 The University of Chicago
7 : cchiw 2507 * All rights reserved.
8 :     *)
9 :    
10 :     structure App = struct
11 :    
12 :     local
13 :    
14 :     structure E = Ein
15 :     structure P = Printer
16 :     in
17 :    
18 : cchiw 2845 fun insert (key, value) d =fn s =>
19 :     if s = key then SOME value
20 :     else d s
21 :    
22 :     fun lookup k d = d k
23 :     val empty =fn key =>NONE
24 : cchiw 2507
25 : cchiw 2845 fun mapId(i ,dict,shift)=(case (lookup i dict)
26 :     of NONE =>i+shift
27 :     | SOME j=>j
28 :     (*end case*))
29 : cchiw 2507
30 : cchiw 2845 fun mapIndex(v ,dict,shift)= (case (lookup v dict)
31 :     of NONE =>let val E.V(i)=v in E.V(i+shift) end
32 :     | SOME j=>j
33 : cchiw 2515 (*end case*))
34 : cchiw 2507
35 : cchiw 2845 fun mapId2(i ,dict,shift)= (case (lookup i dict)
36 :     of NONE =>(print "Err out of range";i+shift)
37 :     | SOME j=>j
38 : cchiw 2507 (*end case*))
39 :    
40 : cchiw 2870 fun rewriteSubst(e,subId,mx,paramShift,sumShift,newArgs,done)=let
41 : cchiw 2845 fun insertIndex([],_,dict,shift)=(dict,shift)
42 :     | insertIndex(e1::es, n,dict,_)=(case e1
43 :     of E.V e=> insertIndex(es, n+1, insert(E.V n ,E.V e) dict,e-n)
44 :     | E.C e => insertIndex(es, n+1, insert(E.V n ,E.C e) dict,e-n)
45 :     (*end case*))
46 : cchiw 2507
47 : cchiw 2845 val (subMu,shift)=insertIndex(mx,0,empty,0)
48 :     val shift'=Int.max(sumShift, shift)
49 :     fun mapMu(E.V i)= mapIndex((E.V i), subMu, shift')
50 :     | mapMu c = c
51 :     fun mapAlpha mx=List.map mapMu mx
52 :     fun mapSingle(i)=let
53 :     val E.V v=mapIndex(E.V i,subMu, shift')
54 :     in
55 :     v
56 :     end
57 :     fun mapSum []=[]
58 :     | mapSum ((a,b,c)::e)=[((mapMu a),b,c)]@mapSum(e)
59 :     fun mapParam(id)= mapId2(id, subId, 0)
60 :     fun apply e=(case e
61 : cchiw 3448 of E.B _ => e
62 :     | E.Tensor(id, mx) => E.Tensor(mapParam id,mapAlpha mx)
63 :     | E.G(E.Delta (i,j)) => E.G(E.Delta(mapMu i,mapMu j))
64 :     | E.G(E.Epsilon(i, j, k)) => E.G(E.Epsilon(mapSingle i, mapSingle j, mapSingle k))
65 :     | E.G(E.Eps2(i, j)) => E.G(E.Eps2(mapSingle i, mapSingle j))
66 :     | E.Field(id, mx) => E.Field(mapParam id,mapAlpha mx)
67 :     | E.Lift e1 => E.Lift(apply e1)
68 :     | E.Conv (v,mx,h,ux) => E.Conv(mapParam v, mapAlpha mx, mapParam h, mapAlpha ux)
69 :     | E.Partial mx => E.Partial (mapAlpha mx)
70 :     | E.Apply(e1, e2) => E.Apply(apply e1, apply e2)
71 :     | E.Probe(f, pos) => E.Probe(apply f, apply pos)
72 :     | E.Value _ => raise Fail "expression before expand"
73 :     | E.Img _ => raise Fail "expression before expand"
74 :     | E.Krn _ => raise Fail "expression before expand"
75 :     | E.Sum(c,esum) => E.Sum(mapSum c, apply esum)
76 :     | E.Op1(E.PowEmb(sx,n),e1) => E.Op1(E.PowEmb(mapSum sx,n),apply e1)
77 :     | E.Op1(op1,e1) => E.Op1(op1,apply e1)
78 :     | E.Op2(op2,e1,e2) => E.Op2(op2,apply e1,apply e2)
79 :     | E.Opn(opn,e1) => E.Opn(opn,List.map apply e1)
80 : cchiw 2845 (*end case*))
81 :     in
82 :     apply e
83 :     end
84 : cchiw 2507
85 : cchiw 2845 (*params subst*)
86 :     fun rewriteParams(params, params2, place)=let
87 :     val beg=List.take(params,place)
88 :     val next=List.drop(params,place+1)
89 :     val params'=beg@params2@next
90 :     val n= length(params)
91 :     val n2=length(params2)
92 :     val nbeg=length(beg)
93 :     val nnext=length(next)
94 :     fun createDict(0,shift1, shift2,dict)= dict
95 :     | createDict(n,shift1, shift2,dict)=createDict(n-1,shift1,shift2, insert(n+shift1,n+shift2) dict)
96 :     val origId=createDict(nnext,place,place+n2-1,empty)
97 :     val subId=createDict(n2,~1,place-1,empty)
98 :     in
99 :     (params',origId,subId,nbeg)
100 :     end
101 : cchiw 2507
102 :    
103 : cchiw 2845 (*Looks for params id that match substitution*)
104 : cchiw 3444 fun app(E.EIN{params, index, body},place,e2,newArgs,done)=let
105 : cchiw 2845 val changed = ref 0
106 :     val params2=E.params e2
107 :     val index2=E.index e2
108 :     val body2=E.body e2
109 :     val (params',origId,substId,paramShift)=rewriteParams(params,params2,place)
110 : cchiw 3696 (*val err=String.concat["Wrong size for Subst:",
111 : cchiw 2906 P.printbody body,"-with-",P.printbody body2,"@",Int.toString place]
112 : cchiw 3696 *)
113 :     fun err(mx)=String.concat["\n***\nWrong size for Subst:",
114 :     P.printbody body,"-with-",P.printbody body2,"@",Int.toString place,
115 :     "index2:", Int.toString( length index2), "mx:",Int.toString(length mx)]
116 : cchiw 2507
117 : cchiw 3700
118 : cchiw 2845 val sumIndex=ref (length index)
119 :     fun rewrite(id,mx ,e)=let
120 :     val ref x=sumIndex
121 :     in
122 :     if(id=place) then
123 :     if(length(mx)=length(index2)) then
124 : cchiw 2870 (changed:=1; rewriteSubst(body2,substId,mx,paramShift,x,newArgs,done))
125 : cchiw 3696 else ( raise Fail(err(mx));E.B(E.Const 0))
126 : cchiw 2845 else (case e
127 : cchiw 2870 of E.Tensor(id,mx) => E.Tensor(mapId(id,origId,0), mx)
128 :     | E.Field(id,mx) => E.Field(mapId(id,origId,0), mx)
129 : cchiw 2845 | _ => raise Fail"Id error:Term to be replaced is not a Tensor or Fields"
130 :     (*end case*))
131 :     end
132 :     fun sumI(e)=let
133 :     val (E.V v,_,_)=List.nth(e, length(e)-1)
134 :     in v end
135 : cchiw 2507
136 : cchiw 3444 fun apply b=(case b
137 : cchiw 3448 of E.B _ => b
138 :     | E.Tensor(id, mx) => rewrite (id,mx,b)
139 :     | E.G _ => b
140 :     | E.Field(id, mx) => rewrite (id,mx,b)
141 :     | E.Lift e1 => E.Lift(apply e1)
142 :     | E.Conv (v,mx,h,ux) => E.Conv(mapId(v, origId,0), mx, mapId(h,origId,0), ux)
143 :     | E.Partial mx => b
144 :     | E.Apply(e1, e2) => E.Apply(apply e1, apply e2)
145 :     | E.Probe(f, pos) => E.Probe(apply f, apply pos)
146 :     | E.Value _ => raise Fail "expression before expand"
147 :     | E.Img _ => raise Fail "expression before expand"
148 :     | E.Krn _ => raise Fail "expression before expand"
149 :     | E.Sum(c,esum) => (sumIndex:=sumI(c); E.Sum(c, apply esum))
150 :     | E.Op1(E.PowEmb(sx,n),e1) => (sumIndex:=sumI(sx);E.Op1(E.PowEmb(sx,n),apply e1))
151 :     | E.Op1(op1, e1) => E.Op1(op1,apply e1)
152 :     | E.Op2(op2, e1,e2) => E.Op2(op2,apply e1,apply e2)
153 :     | E.Opn(opn, es) => E.Opn(opn,List.map apply es)
154 : cchiw 2845 (*end case*))
155 :     val body''=apply body
156 :     val ref g=changed
157 :     in
158 : cchiw 3444 ( g,E.EIN{params=params', index=index, body=body''})
159 : cchiw 2507 end
160 :    
161 :    
162 :     end; (* local *)
163 :    
164 :     end (* local *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0