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

SCM Repository

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

Diff of /branches/vis12/src/compiler/high-to-mid/high-to-mid.sml

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

revision 358, Tue Sep 28 13:38:09 2010 UTC revision 365, Wed Sep 29 20:07:58 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 SrcIL.Var.Tbl.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    
33    (* expand the field Inside operator into a image-space test *)    (* expand the field Inside operator into a image-space test *)
34      fun expandInside (env, result, pos, fld) = let      fun expandInside (env, result, pos, fld) = let
35            val pos' = lookupVar (env, pos)            val pos = rename (env, pos)
36            val fld = (case fld            val fld = (case SrcIL.Var.binding fld
37                   of SrcIL.OP(SrcOp.Field fld, []) => fld                   of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
38                    | _ => raise Fail "bogus field binding"                    | _ => raise Fail "bogus field binding"
39                  (* end case *))                  (* end case *))
40            fun expand (FieldDef.CONV(_, img, _)) = let            fun expand (FieldDef.CONV(_, img, _)) = let
41                  val imgPos = DstIL.Var.new "x"                  val imgPos = DstIL.Var.new "x"
42                  in [                  in [
43                    (imgPos, DstIL.OP(DstOp.Transform img, [pos'])),                    (imgPos, DstIL.OP(DstOp.Transform img, [pos])),
44                    (result, DstIL.OP(DstOp.Inside img, [imgPos]))                    (result, DstIL.OP(DstOp.Inside img, [imgPos]))
45                  ] end                  ] end
46              | expand (FieldDef.NEG fld) = expand fld              | expand (FieldDef.NEG fld) = expand fld
# Line 43  Line 50 
50            end            end
51    
52      fun expandProbe (env, result, fld, pos) = let      fun expandProbe (env, result, fld, pos) = let
53            val pos' = lookupVar (env, pos)            val pos = rename (env, pos)
54            val fld = (case fld            val fld = (case SrcIL.Var.binding fld
55                   of SrcIL.OP(SrcOp.Field fld, []) => fld                   of SrcIL.VB_RHS(SrcIL.OP(SrcOp.Field fld, [])) => fld
56                    | _ => raise Fail "bogus field binding"                    | _ => raise Fail "bogus field binding"
57                  (* end case *))                  (* end case *))
58            in            in
59              Probe.expand (result, fld, pos')              Probe.expand (result, fld, pos)
60              end
61    
62        fun cvtTy SrcOp.BoolTy = DstOp.BoolTy
63          | cvtTy SrcOp.StringTy = DstOp.StringTy
64          | cvtTy SrcOp.IntTy = DstOp.IntTy
65          | cvtTy (SrcOp.TensorTy[]) = DstOp.realTy
66          | cvtTy (SrcOp.TensorTy[d]) = DstOp.VecTy d
67          | cvtTy _ = raise Fail "unexpected higher-order tensor type"
68    
69        fun arity (SrcOp.TensorTy[]) = 1
70          | arity (SrcOp.TensorTy[d]) = d
71          | arity _ = raise Fail "arity"
72    
73        fun expandOp (env, y, rator, args) = let
74              fun assign rator' =
75                    [(y, DstIL.OP(rator', List.map (fn x => rename(env, x)) args))]
76              in
77                case rator
78                 of SrcOp.Add ty => assign (DstOp.Add(cvtTy ty))
79                  | SrcOp.Sub ty => assign (DstOp.Sub(cvtTy ty))
80                  | SrcOp.Mul ty => assign (DstOp.Mul(cvtTy ty))
81                  | SrcOp.Div ty => assign (DstOp.Div(cvtTy ty))
82                  | SrcOp.Neg ty => assign (DstOp.Neg(cvtTy ty))
83                  | SrcOp.LT ty => assign (DstOp.LT(cvtTy ty))
84                  | SrcOp.LTE ty => assign (DstOp.LTE(cvtTy ty))
85                  | SrcOp.EQ ty => assign (DstOp.EQ(cvtTy ty))
86                  | SrcOp.NEQ ty => assign (DstOp.NEQ(cvtTy ty))
87                  | SrcOp.GT ty => assign (DstOp.GT(cvtTy ty))
88                  | SrcOp.GTE ty => assign (DstOp.GTE(cvtTy ty))
89                  | SrcOp.Dot ty => assign (DstOp.Dot(arity ty))
90                  | SrcOp.Cross => assign DstOp.Cross
91                  | SrcOp.Norm ty => assign (DstOp.Norm(arity ty))
92                  | SrcOp.Scale ty => assign (DstOp.Scale(arity ty))
93                  | SrcOp.InvScale ty => assign (DstOp.InvScale(arity ty))
94                  | SrcOp.CL => assign DstOp.CL
95                  | SrcOp.PrincipleEvec ty => assign (DstOp.PrincipleEvec(cvtTy ty))
96                  | SrcOp.Subscript ty => assign (DstOp.Subscript(cvtTy ty))
97                  | SrcOp.Max => assign DstOp.Max
98                  | SrcOp.Min => assign DstOp.Min
99                  | SrcOp.Sin => assign DstOp.Sin
100                  | SrcOp.Cos => assign DstOp.Cos
101                  | SrcOp.Pow => assign DstOp.Pow
102                  | SrcOp.Not => assign DstOp.Not
103                  | SrcOp.IntToReal => assign DstOp.IntToReal
104                  | SrcOp.TruncToInt => assign (DstOp.TruncToInt 1)
105                  | SrcOp.RoundToInt => assign (DstOp.RoundToInt 1)
106                  | SrcOp.CeilToInt => assign (DstOp.CeilToInt 1)
107                  | SrcOp.FloorToInt => assign (DstOp.FloorToInt 1)
108                  | SrcOp.LoadImage info => assign (DstOp.LoadImage info)
109                  | SrcOp.Inside => (case args
110                       of [pos, fld] => expandInside(env, y, pos, fld)
111                      (* end case *))
112    (* QUESTION: there is no MidIL equivalant, but these might be floating
113     * around, which could cause invalid MidIL to be generated.
114     *)
115                  | SrcOp.Field fld => []
116                  | SrcOp.Probe => (case args
117                       of [fld, pos] => expandProbe(env, y, fld, pos)
118                      (* end case *))
119                  | SrcOp.Input s => assign (DstOp.Input s)
120                  | SrcOp.InputWithDefault s => assign (DstOp.InputWithDefault s)
121                  | _ => raise Fail("unexpected " ^ SrcOp.toString rator)
122                (* end case *)
123              end
124    
125        fun expand (env, (y, rhs)) = let
126              val y' = rename (env, y)
127              fun assign rhs = [(y', rhs)]
128              in
129                case rhs
130                 of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
131                  | SrcIL.LIT lit => assign (DstIL.LIT lit)
132                  | SrcIL.OP(rator, args) =>
133                      expandOp (env, y', rator, args)
134                  | SrcIL.CONS args =>
135                      assign (DstIL.CONS(List.map (fn x => rename(env, x)) args))
136                (* end case *)
137            end            end
138    
139      fun translate prog = raise Fail "FIXME"      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}) =
151              raise Fail "unimplemented"
152    
153    end    end

Legend:
Removed from v.358  
changed lines
  Added in v.365

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