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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/mid-to-low/ein-to-scalar.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/mid-to-low/ein-to-scalar.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3741 - (view) (download)

1 : jhr 3646 (* ein-to-scalar.sml
2 :     *
3 :     * Generate LowIR scalar computations that implement Ein expressions.
4 :     *
5 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
6 :     *
7 :     * COPYRIGHT (c) 2016 The University of Chicago
8 :     * All rights reserved.
9 :     *)
10 :    
11 :     structure EinToScalar : sig
12 :    
13 : jhr 3728 (* expand a scalar-valued Ein operator application to LowIR code; return the LowIR
14 :     * vaiable that holds the result of the application (the assignments will be added
15 :     * to avail).
16 :     *)
17 :     val expand : {
18 :     avail : AvailRHS.t, (* the generated LowIR assignments *)
19 :     mapp : int IntRedBlackMap.map, (* mapping from deBruijn indices to argument IDs *)
20 :     params : Ein.param_kind list, (* formal parameters of Ein operator *)
21 :     body : Ein.ein_exp, (* the EIN operator body *)
22 :     lowArgs : LowIR.var list (* corresponding LowIR arguments *)
23 :     } -> LowIR.var
24 : jhr 3646
25 :     end = struct
26 :    
27 :     structure IR = LowIR
28 :     structure Ty = LowTypes
29 :     structure Op = LowOps
30 :     structure Var = LowIR.Var
31 :     structure E = Ein
32 : jhr 3648 structure Mk = MkLowIR
33 : jhr 3646 structure IMap = IntRedBlackMap
34 :    
35 : jhr 3653 fun mapIndex (mapp, id) = (case IMap.find(mapp, id)
36 : jhr 3649 of SOME x => x
37 :     | NONE => raise Fail(concat["mapIndex(_, V ", Int.toString id, "): out of bounds"])
38 :     (* end case *))
39 :    
40 : jhr 3666 (* FIXME: we probably do not need the params (depending on how we implement FieldToLow.expand *)
41 : cchiw 3741 fun expand {avail, mapp, params, body, lowArgs} = let
42 : jhr 3653 fun gen (mapp, body) = let
43 :     (*********sumexpression ********)
44 :     fun tb n = List.tabulate (n, fn e => e)
45 : cchiw 3741 fun sumCheck (mappOrig, (E.V v, lb, ub) :: sumx, e) = let
46 : jhr 3653 fun sumloop mapp = gen (mapp, e)
47 :     fun sumI1 (left, (v, [i], lb1), [], rest) = let
48 : cchiw 3741 (*val _ = print (concat["\ninsert: last item overll", Int.toString v, " to ",Int.toString (lb1+i)]) *)
49 :     val mapp = IMap.insert (left, v, lb1+i)
50 : jhr 3653 val vD = gen (mapp, e)
51 :     in
52 :     rest@[vD]
53 :     end
54 :     | sumI1 (left, (v, i::es, lb1), [], rest) = let
55 : cchiw 3741 (* val _ = print (concat["\ninsertb ", Int.toString v, " to ",Int.toString (i+lb1)])*)
56 : jhr 3653 val mapp = IMap.insert (left, v, i+lb1)
57 :     val vD = gen (mapp, e)
58 :     in
59 :     sumI1 (mapp, (v, es, lb1), [], rest@[vD])
60 :     end
61 : cchiw 3741 | sumI1 (left, (v, [i], lb1), (E.V a, lb2, ub2) ::sx, rest) = let
62 :     (* val _ = print( concat["\n insert- last item in list for item ", Int.toString v, " to ",Int.toString( i+lb1)])*)
63 :     in
64 :     sumI1 (IMap.insert (left, v, lb1+i), (a, tb (ub2-lb2+1), lb2), sx, rest)
65 :     end
66 : jhr 3653 | sumI1 (left, (v, s::es, lb1), (E.V a, lb2, ub2) ::sx, rest) = let
67 : cchiw 3741 (*val _ = print( concat["\ninsertd ", Int.toString v, " to ",Int.toString (s+lb1)])*)
68 : jhr 3653 val mapp = IMap.insert (left, v, s+lb1)
69 :     val xx = tb (ub2-lb2+1)
70 : cchiw 3741 (* val _ =print( concat["\ndoing inner ", Int.toString a])*)
71 : jhr 3653 val rest' = sumI1 (mapp, (a, xx, lb2), sx, rest)
72 :     in
73 :     sumI1 (mapp, (v, es, lb1), (E.V a, lb2, ub2) ::sx, rest')
74 :     end
75 :     | sumI1 _ = raise Fail "None Variable-index in summation"
76 :     in
77 : cchiw 3741 sumI1 (mappOrig, (v, tb (ub-lb+1), lb), sumx, [])
78 : jhr 3653 end
79 :     in
80 :     case body
81 :     of E.Value v => Mk.intToRealLit (avail, mapIndex (mapp, v))
82 :     | E.Const c => Mk.intToRealLit (avail, c)
83 :     | E.Delta(i, j) => Mk.delta (avail, mapp, i, j)
84 :     | E.Epsilon(i, j, k) => Mk.epsilon3 (avail, mapp, i, j, k)
85 :     | E.Eps2(i, j) => Mk.epsilon2 (avail, mapp, i, j)
86 : jhr 3728 | E.Tensor(id, ix) => Mk.tensorIndex (avail, mapp, List.nth(lowArgs, id), ix)
87 : jhr 3665 | E.Op1(op1, e1) => let
88 :     val arg = gen (mapp, e1)
89 :     in
90 :     case op1
91 :     of E.Neg => Mk.realNeg (avail, arg)
92 :     | _ => raise Fail "FIXME: unimplemented"
93 :     (*
94 :     | E.Exp
95 :     | E.Sqrt
96 :     | E.Cosine
97 :     | E.ArcCosine
98 :     | E.Sine
99 :     | E.ArcSine
100 :     | E.Tangent
101 :     | E.ArcTangent
102 :     | E.PowInt of int
103 :     | E.PowReal of Rational.t
104 :     | E.PowEmb of sumrange list * int
105 :     *)
106 :     (* end case *)
107 :     end
108 : jhr 3661 | E.Op2(E.Sub, e1, e2) => Mk.realSub (avail, gen (mapp, e1), gen (mapp, e2))
109 :     | E.Opn(E.Add, es) =>
110 :     Mk.reduce (avail, Mk.realAdd, List.map (fn e => gen(mapp, e)) es)
111 :     | E.Opn(E.Prod, es) =>
112 :     Mk.reduce (avail, Mk.realMul, List.map (fn e => gen(mapp, e)) es)
113 : jhr 3653 | E.Op2(E.Div, e1 as E.Tensor (_, [_]), e2 as E.Tensor (_, [])) =>
114 :     gen (mapp, E.Opn(E.Prod, [E.Op2 (E.Div, E.Const 1, e2), e1]))
115 : jhr 3661 | E.Op2(E.Div, e1, e2) => Mk.realDiv (avail, gen (mapp, e1), gen (mapp, e2))
116 : jhr 3728 | E.Sum(sx, E.Opn(E.Prod, prod as (E.Img(Vid, _, _) :: E.Krn(Hid, _, _) ::_))) =>
117 :     FieldToLow.expand {
118 :     avail = avail, mapp = mapp,
119 :     sx = sx, prod = prod,
120 : cchiw 3741 lowArgs = lowArgs
121 : jhr 3728 }
122 : jhr 3661 | E.Sum(sumx, e) =>
123 :     Mk.reduce (avail, Mk.realAdd, sumCheck (mapp, sumx, e))
124 : cchiw 3741 (* FIXME:need to add to normalize *)
125 :     | E.Probe(E.Epsilon e1, e2) => gen(mapp,E.Epsilon e1)
126 :     | E.Probe(E.Eps2 e1, e2) => gen(mapp,E.Eps2 e1)
127 :     | E.Probe(E.Const e1, e2) => gen(mapp, E.Const e1)
128 :     | E.Probe(E.Delta e1, e2) => gen(mapp, E.Delta e1)
129 :     | E.Probe e => raise Fail("probe ein-exp: " ^ EinPP.expToString body)
130 : jhr 3653 | _ => raise Fail("unsupported ein-exp: " ^ EinPP.expToString body)
131 :     (*end case*)
132 :     end
133 :     in
134 :     gen (mapp, body)
135 :     end
136 : jhr 3646
137 :     end

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