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
[diderot] / 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 363, Wed Sep 29 18:05:48 2010 UTC revision 364, Wed Sep 29 18:06:12 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
           val pos' = lookupVar (env, pos)  
35            val fld = (case fld            val fld = (case fld
36                   of SrcIL.OP(SrcOp.Field fld, []) => fld                   of SrcIL.OP(SrcOp.Field fld, []) => fld
37                    | _ => raise Fail "bogus field binding"                    | _ => raise Fail "bogus field binding"
# Line 33  Line 39 
39            fun expand (FieldDef.CONV(_, img, _)) = let            fun expand (FieldDef.CONV(_, img, _)) = let
40                  val imgPos = DstIL.Var.new "x"                  val imgPos = DstIL.Var.new "x"
41                  in [                  in [
42                    (imgPos, DstIL.OP(DstOp.Transform img, [pos'])),                    (imgPos, DstIL.OP(DstOp.Transform img, [pos])),
43                    (result, DstIL.OP(DstOp.Inside img, [imgPos]))                    (result, DstIL.OP(DstOp.Inside img, [imgPos]))
44                  ] end                  ] end
45              | expand (FieldDef.NEG fld) = expand fld              | expand (FieldDef.NEG fld) = expand fld
# Line 43  Line 49 
49            end            end
50    
51      fun expandProbe (env, result, fld, pos) = let      fun expandProbe (env, result, fld, pos) = let
           val pos' = lookupVar (env, pos)  
52            val fld = (case fld            val fld = (case fld
53                   of SrcIL.OP(SrcOp.Field fld, []) => fld                   of SrcIL.OP(SrcOp.Field fld, []) => fld
54                    | _ => raise Fail "bogus field binding"                    | _ => raise Fail "bogus field binding"
55                  (* end case *))                  (* end case *))
56            in            in
57              Probe.expand (result, fld, pos')              Probe.expand (result, fld, pos)
58              end
59    
60        fun expandOp (env, y, rator, args) = let
61              fun assign rator' = [(y, DstIL.OP(rator', args))]
62              in
63                case rator
64                 of SrcIL.Add ty => assign (DstIL.Add(cvtTy ty))
65                  | SrcIL.Sub ty => assign (DstIL.Sub(cvtTy ty))
66                  | SrcIL.Mul ty => assign (DstIL.Mul(cvtTy ty))
67                  | SrcIL.Div ty => assign (DstIL.Div(cvtTy ty))
68                  | SrcIL.Neg ty => assign (DstIL.Neg(cvtTy ty))
69                  | SrcIL.LT ty => assign (DstIL.LT(cvtTy ty))
70                  | SrcIL.LTE ty => assign (DstIL.LTE(cvtTy ty))
71                  | SrcIL.EQ ty => assign (DstIL.EQ(cvtTy ty))
72                  | SrcIL.NEQ ty => assign (DstIL.NEQ(cvtTy ty))
73                  | SrcIL.GT ty => assign (DstIL.GT(cvtTy ty))
74                  | SrcIL.GTE ty => assign (DstIL.GTE(cvtTy ty))
75                  | SrcIL.Dot ty => assign (DstIL.Dot(cvtTy ty))
76                  | SrcIL.Cross => assign (DstIL.Cross)
77                  | SrcIL.Norm ty => assign (DstIL.Norm(cvtTy ty))
78                  | SrcIL.Scale ty => assign (DstIL.Scale(cvtTy ty))
79                  | SrcIL.InvScale ty => assign (DstIL.InvScale(cvtTy ty))
80                  | SrcIL.CL => assign (DstIL.CL)
81                  | SrcIL.PrincipleEvec ty => assign (DstIL.PrincipleEvec(cvtTy ty))
82                  | SrcIL.Subscript ty => assign (DstIL.Subscript(cvtTy ty))
83                  | SrcIL.Max => assign (DstIL.Max)
84                  | SrcIL.Min => assign (DstIL.Min)
85                  | SrcIL.Sin => assign (DstIL.Sin)
86                  | SrcIL.Cos => assign (DstIL.Cos)
87                  | SrcIL.Pow => assign (DstIL.Pow)
88                  | SrcIL.Not => assign (DstIL.Not)
89                  | SrcIL.IntToReal => assign (DstIL.IntToReal)
90                  | SrcIL.TruncToInt => assign (DstIL.TruncToInt)
91                  | SrcIL.RoundToInt => assign (DstIL.RoundToInt)
92                  | SrcIL.CeilToInt => assign (DstIL.CeilToInt)
93                  | SrcIL.FloorToInt => assign (DstIL.FloorToInt)
94                  | SrcIL.LoadImage info => assign (DstIL.LoadImage info)
95                  | SrcIL.Convolve => assign (DstIL.Convolve)
96                  | SrcIL.Inside => expandInside(env, y, #1 args, #2 args)
97                  | SrcIL.Probe => expandProbe(env, y, #1 args, #2 args)
98                  | SrcIL.Input s => assign (DstIL.Input s)
99                  | SrcIL.InputWithDefault => assign (DstIL.InputWithDefault s)
100                  | _ => raise Fail("unexpected " ^ SrcIL.Op.toString rator)
101                (* end case *))
102    
103        fun expand (env, (y, rhs)) = let
104              val y' = rename (env, y)
105              fun assign rhs = [(y', rhs)]
106              in
107                case rhs
108                 of SrcIL.VAR x => assign (DstIL.VAR(rename(env, x)))
109                  | SrcIL.LIT lit => assign (DstIL.LIT lit)
110                  | SrcIL.OP(rator, args) =>
111                      expandOp (env, y', rator, List.map (fn x => rename(env, x)) args)
112                  | SrcIL.CONS args =>
113                      assign (DstIL.CONS(List.map (fn x => rename(env, x)) args))
114                (* end case *)
115            end            end
116    
117      fun translate prog = raise Fail "FIXME"      structure Trans =  TranslateFn (
118          struct
119            structure SrcIL = SrcIL
120            structure DstIL = DstIL
121    
122            type var_env = var_env
123    
124            val rename = rename
125            val expand = expand
126          end)
127    
128        fun translate (SrcIL.Program{globals, globalInit, actors}) =
129              raise Fail "unimplemented"
130    
131    end    end
Legend:
Removed from v.363  
changed lines
  Added in v.364
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge