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

SCM Repository

[diderot] Diff of /trunk/src/compiler/high-to-mid/high-to-mid.sml
ViewVC logotype

Diff of /trunk/src/compiler/high-to-mid/high-to-mid.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 334, Thu Aug 19 20:53:07 2010 UTC revision 387, Fri Oct 8 15:29:24 2010 UTC
# Line 14  Line 14 
14    
15      structure SrcIL = HighIL      structure SrcIL = HighIL
16      structure SrcOp = HighOps      structure SrcOp = HighOps
17        structure VTbl = SrcIL.Var.Tbl
18      structure DstIL = MidIL      structure DstIL = MidIL
19      structure DstOp = MidOps      structure DstOp = MidOps
     structure VMap = SrcIL.Var.Map  
20    
21      fun lookupVar (env, x) = (case VMap.find(env, x)      type var_env = DstIL.var VTbl.hash_table
22    
23        fun rename (env : var_env, x) = (case VTbl.find env x
24             of SOME x' => x'             of SOME x' => x'
25              | NONE => raise Fail("unknown variable "^SrcIL.Var.toString x)              | NONE => let
26                    val x' = DstIL.Var.new (SrcIL.Var.name x)
27                    in
28                      VTbl.insert env (x, x');
29                      x'
30                    end
31            (* end case *))            (* end case *))
32        fun renameList (env, xs) = List.map (fn x => rename(env, x)) xs
33    
34    (* expand the field Inside operator into a image-space test *)    (* expand the field Inside operator into a image-space test *)
35      fun expandInside (env, result, pos, fld) = let      fun expandInside (env, result, pos, fld) = let
36            val pos' = lookupVar (env, pos)            val pos = rename (env, pos)
37            val fld = (case valueOf fld            val fld = (case SrcIL.Var.binding fld
38                   of SrcIL.OP(SrcOp.Field fld, []) => fld                   of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
39                    | _ => raise Fail "bogus field binding"                    | _ => raise Fail "bogus field binding"
40                  (* end case *))                  (* end case *))
41            fun expand (FieldDef.CONV(_, img, _)) = let            fun expand (FieldDef.CONV(_, img, _)) = let
42                  val imgPos = DstIL.Var.new "x"                  val imgPos = DstIL.Var.new "x"
43                  in [                  in [
44                    (imgPos, DstIL.OP(DstOp.Transform img, [pos'])),                    (imgPos, DstIL.OP(DstOp.Transform img, [pos])),
45                    (result, DstIL.OP(DstOp.Inside img, [imgPos]))                    (result, DstIL.OP(DstOp.Inside img, [imgPos]))
46                  ] end                  ] end
47              | expand (FieldDef.NEG fld) = expand fld              | expand (FieldDef.NEG fld) = expand fld
# Line 42  Line 50 
50              expand fld              expand fld
51            end            end
52    
53      val expandProbe = Probe.expand      fun expandProbe (env, result, fld, pos) = let
54              val pos = rename (env, pos)
55              val fld = (case SrcIL.Var.binding fld
56                     of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
57                      | _ => raise Fail "bogus field binding"
58                    (* end case *))
59              in
60                Probe.expand (result, fld, pos)
61              end
62    
63      fun translate prog = raise Fail "FIXME"      fun cvtTy SrcOp.BoolTy = DstOp.BoolTy
64          | cvtTy SrcOp.StringTy = DstOp.StringTy
65          | cvtTy SrcOp.IntTy = DstOp.IntTy
66          | cvtTy (SrcOp.TensorTy[]) = DstOp.realTy
67          | cvtTy (SrcOp.TensorTy[d]) = DstOp.VecTy d
68          | cvtTy _ = raise Fail "unexpected higher-order tensor type"
69    
70        fun arity (SrcOp.TensorTy[]) = 1
71          | arity (SrcOp.TensorTy[d]) = d
72          | arity _ = raise Fail "arity"
73    
74        fun expandOp (env, y, rator, args) = let
75              fun assign rator' =
76                    [(y, DstIL.OP(rator', renameList(env, args)))]
77              in
78                case rator
79                 of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))
80                  | SrcOp.Sub ty => assign (DstOp.Sub(cvtTy ty))
81                  | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))
82                  | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))
83                  | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))
84                  | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
85                  | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
86                  | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
87                  | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
88                  | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
89                  | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
90                  | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
91                  | SrcOp.Cross => assign DstOp.Cross
92                  | SrcOp.Norm ty => assign (DstOp.Norm(arity ty))
93                  | SrcOp.Scale ty => assign (DstOp.Scale(arity ty))
94                  | SrcOp.InvScale ty => assign (DstOp.InvScale(arity ty))
95                  | SrcOp.CL => assign DstOp.CL
96                  | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
97                  | SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty))
98                  | SrcOp.Max => assign DstOp.Max
99                  | SrcOp.Min => assign DstOp.Min
100                  | SrcOp.Sin => assign DstOp.Sin
101                  | SrcOp.Cos => assign DstOp.Cos
102                  | SrcOp.Pow => assign DstOp.Pow
103                  | SrcOp.Not => assign DstOp.Not
104                  | SrcOp.IntToReal => assign DstOp.IntToReal
105                  | SrcOp.TruncToInt => assign (DstOp.TruncToInt 1)
106                  | SrcOp.RoundToInt => assign (DstOp.RoundToInt 1)
107                  | SrcOp.CeilToInt => assign (DstOp.CeilToInt 1)
108                  | SrcOp.FloorToInt => assign (DstOp.FloorToInt 1)
109                  | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
110                  | SrcOp.Inside => (case args
111                       of [pos, fld] => expandInside(env, y, pos, fld)
112                      (* end case *))
113    (* QUESTION: there is no MidIL equivalant, but these might be floating
114     * around, which could cause invalid MidIL to be generated.
115     *)
116                  | SrcOp.Field fld => []
117                  | SrcOp.Probe => (case args
118                       of [fld, pos] => expandProbe(env, y, fld, pos)
119                      (* end case *))
120                  | SrcOp.Input s => assign (DstOp.Input s)
121                  | SrcOp.InputWithDefault s => assign (DstOp.InputWithDefault s)
122                  | _ => raise Fail("unexpected " ^ SrcOp.toString rator)
123                (* end case *)
124              end
125    
126      (* expand a SrcIL assignment to a list of DstIL assignments *)
127        fun expand (env, (y, rhs)) = let
128              val y' = rename (env, y)
129              fun assign rhs = [(y', rhs)]
130              in
131                case rhs
132                 of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
133                  | SrcIL.LIT lit => assign (DstIL.LIT lit)
134                  | SrcIL.OP(rator, args) => expandOp (env, y', rator, args)
135                  | SrcIL.CONS args => assign (DstIL.CONS(renameList(env, args)))
136                (* end case *)
137              end
138    
139        structure Trans =  TranslateFn (
140          struct
141            structure SrcIL = SrcIL
142            structure DstIL = DstIL
143    
144            type var_env = var_env
145    
146            val rename = rename
147            val expand = expand
148          end)
149    
150        fun translate (SrcIL.Program{globals, globalInit, actors}) = let
151              val env = VTbl.mkTable (256, Fail "env")
152              fun transMethod (SrcIL.Method{name, stateIn, stateOut, body}) =
153                    DstIL.Method{
154                        name = name,
155                        stateIn = renameList (env, stateIn),
156                        stateOut = renameList (env, stateOut),
157                        body = Trans.translate (env, body)
158                      }
159              fun transActor (SrcIL.Actor{name, params, state, stateInit, methods}) =
160                    DstIL.Actor{
161                        name = name,
162                        params = renameList (env, params),
163                        state = renameList (env, state),
164                        stateInit = Trans.translate (env, stateInit),
165                        methods = List.map transMethod methods
166                      }
167              in
168                DstIL.Program{
169                    globals = renameList (env, globals),
170                    globalInit = Trans.translate (env, globalInit),
171                    actors = List.map transActor actors
172                  }
173              end
174    
175    end    end

Legend:
Removed from v.334  
changed lines
  Added in v.387

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