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/mk-low-ir.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/mid-to-low/mk-low-ir.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3661 - (view) (download)

1 : jhr 3648 (* mk-low-ir.sml
2 :     *
3 :     * Helper code to build LowIR assigments using the AvailRHS infrastructure.
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 MkLowIR : sig
12 :    
13 : jhr 3653 (* an environment that maps De Bruijn indices to their iteration-index value *)
14 :     type index_env = int IntRedBlackMap.map
15 :    
16 : jhr 3648 (* make "x := <int-literal>" *)
17 :     val intLit : AvailRHS.t * IntLit.t -> LowIR.var
18 :     (* make "x := <real-literal>" *)
19 :     val realLit : AvailRHS.t * RealLit.t -> LowIR.var
20 :     (* make "x := <real-literal>", where the real literal is specified as an integer *)
21 :     val intToRealLit : AvailRHS.t * int -> LowIR.var
22 : jhr 3661
23 :     (* generate a reduction sequence using the given binary operator *)
24 :     val reduce : AvailRHS.t * (AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var) * LowIR.var list
25 :     -> LowIR.var
26 :    
27 :     (* scalar arithmetic *)
28 :     val realAdd : AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var
29 :     val realSub : AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var
30 :     val realMul : AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var
31 :     val realDiv : AvailRHS.t * LowIR.var * LowIR.var -> LowIR.var
32 :     val realNeg : AvailRHS.t * LowIR.var -> LowIR.var
33 :    
34 : jhr 3648 (* make "x := [args]" *)
35 :     val cons : AvailRHS.t * int list * LowIR.var list -> LowIR.var
36 : jhr 3653 (* code for δ_{i,j} *)
37 :     val delta : AvailRHS.t * index_env * Ein.mu * Ein.mu -> LowIR.var
38 :     (* code for ε_{i,j} *)
39 :     val epsilon2 : AvailRHS.t * index_env * Ein.index_id * Ein.index_id -> LowIR.var
40 :     (* code for ε_{i,j,k} *)
41 :     val epsilon3 : AvailRHS.t * index_env * Ein.index_id * Ein.index_id * Ein.index_id -> LowIR.var
42 : jhr 3648
43 : jhr 3653 (* evaluate δ_{i,j} *)
44 :     val evalDelta : index_env * Ein.mu * Ein.mu -> int
45 :    
46 : jhr 3648 end = struct
47 :    
48 :     structure IR = LowIR
49 :     structure V = IR.Var
50 :     structure Ty = LowTypes
51 :     structure Op = LowOps
52 : jhr 3653 structure E = Ein
53 :     structure IMap = IntRedBlackMap
54 : jhr 3648
55 : jhr 3653 (* an environment that maps De Bruijn indices to their iteration-index value *)
56 :     type index_env = int IMap.map
57 :    
58 : jhr 3660 val add = AvailRHS.addAssign
59 : jhr 3648
60 : jhr 3660 fun intLit (avail, n) = add (avail, "intLit", Ty.intTy, IR.LIT(Literal.Int n))
61 :     fun realLit (avail, r) = add (avail, "realLit", Ty.realTy, IR.LIT(Literal.Real r))
62 : jhr 3648 fun intToRealLit (avail, n) = realLit (avail, RealLit.fromInt(IntInf.fromInt n))
63 : jhr 3661
64 : jhr 3660 fun cons (avail, shp, args) = add (avail, "tensor", Ty.TensorTy shp, IR.CONS(args, Ty.TensorTy shp))
65 : jhr 3648
66 : jhr 3661 (* scalar arithmetic *)
67 : jhr 3653 local
68 : jhr 3661 fun scalarOp2 rator (avail, x, y) = add (avail, "r", Ty.realTy, IR.OP(rator, [x, y]))
69 :     in
70 :     val realAdd = scalarOp2 Op.RAdd
71 :     val realSub = scalarOp2 Op.RSub
72 :     val realMul = scalarOp2 Op.RMul
73 :     val realDiv = scalarOp2 Op.RDiv
74 :     fun realNeg (avail, x) = add (avail, "r", Ty.realTy, IR.OP(Op.RNeg, [x]))
75 :     end (* local *)
76 :    
77 :     fun reduce (avail, rator, []) = raise Fail "reduction with no arguments"
78 :     | reduce (avail, rator, arg::args) = let
79 :     fun gen (acc, []) = acc
80 :     | gen (acc, x::xs) = gen (rator (avail, acc, x), xs)
81 :     in
82 :     gen (arg, args)
83 :     end
84 :    
85 :     local
86 : jhr 3653 fun lookupMu (mapp, E.V id) = (case IMap.find (mapp, id)
87 :     of SOME n => n
88 :     | NONE => raise Fail(concat["lookupMu(_, V ", Int.toString id, "): out of bounds"])
89 :     (* end case *))
90 :     | lookupMu (_, E.C i) = i
91 :     fun lookupIdx (mapp, id) = (case IMap.find(mapp, id)
92 :     of SOME x => x
93 :     | NONE => raise Fail(concat["lookupIdx(_, V ", Int.toString id, "): out of bounds"])
94 :     (* end case *))
95 :     in
96 :     fun evalDelta (mapp, i, j) = let
97 :     val i' = lookupMu (mapp, i)
98 :     val j' = lookupMu (mapp, j)
99 :     in
100 :     if (i' = j') then 1 else 0
101 :     end
102 :    
103 :     fun delta (avail, mapp, i, j) = intToRealLit (avail, evalDelta (mapp, i, j))
104 :    
105 :     fun epsilon2 (avail, mapp, i, j) = let
106 :     val i' = lookupIdx (mapp, i)
107 :     val j' = lookupIdx (mapp, j)
108 :     in
109 :     if (i' = j')
110 :     then intToRealLit (avail, 0)
111 :     else if (j' > i')
112 :     then intToRealLit (avail, 1)
113 :     else intToRealLit (avail, ~1)
114 :     end
115 :    
116 :     fun epsilon3 (avail, mapp, i, j, k) = let
117 :     val i' = lookupIdx (mapp, i)
118 :     val j' = lookupIdx (mapp, j)
119 :     val k' = lookupIdx (mapp, k)
120 :     in
121 :     if (i' = j' orelse j' = k' orelse i' = k')
122 :     then intToRealLit (avail, 0)
123 :     else if (j' > i')
124 :     then if (j' > k' andalso k' > i')
125 :     then intToRealLit (avail, ~1)
126 :     else intToRealLit (avail, 1)
127 :     else if (i' > k' andalso k' > j')
128 :     then intToRealLit (avail, 1)
129 :     else intToRealLit (avail, ~1)
130 :     end
131 :    
132 :     end (* local *)
133 :    
134 : jhr 3648 end

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