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

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/codegen/codegen-fn.sml
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/codegen/codegen-fn.sml

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

revision 531, Mon Feb 14 17:45:57 2011 UTC revision 532, Mon Feb 14 20:26:41 2011 UTC
# Line 14  Line 14 
14    
15    end = struct    end = struct
16    
17      structure Ty = TreeIL.Ty      structure IL = TreeIL
18        structure Ty = IL.Ty
19        structure Op = IL.Op
20        structure V = IL.Var
21    
22    (* convert LowIL types to T types *)    (* convert LowIL types to T types *)
23      fun cvtTy ty = (case ty      fun cvtTy ty = (case ty
# Line 28  Line 31 
31              | Ty.ImageTy =>  raise Fail "FIXME: ImageTy"              | Ty.ImageTy =>  raise Fail "FIXME: ImageTy"
32            (* end case *))            (* end case *))
33    
34  (*      fun lookup (env, x) = (case V.Map.find (env, x)
35  (* FIXME: what about splitting code where the target width doesn't match the             of SOME x' => x'
36   * source width?              | NONE => raise Fail "lookup"
37   *)            (* end case *))
38      fun doRator vtbl = let  
39            val exp = VDefTbl.useDefOf vtbl      fun trExp (env, e) = (case e
40            val bind = VDefTbl.bind vtbl             of IL.E_Var x => (case V.kind x
41            fun f (lhs, rator, args) = (case (rator, args)                   of IL.VK_Global => T.Expr.global(lookup(env, x))
42                   of (Op.Add ty, [a, b])         => bind (lhs, T.Expr.add(exp a, exp b))                    | IL.VK_State strand => raise Fail "FIXME: state var"
43                    | (Op.Sub ty, [a, b])         => bind (lhs, T.Expr.sub(exp a, exp b))                    | IL.VK_Local => T.Expr.var(lookup(env, x))
44                    | (Op.Mul ty, [a, b])         => bind (lhs, T.Expr.mul(exp a, exp b))                  (* end case *))
45                    | (Op.Div ty, [a, b])         => bind (lhs, T.Expr.divide(exp a, exp b))              | IL.E_Lit(Literal.Int n) => T.Expr.intLit n
46                    | (Op.Neg ty, [a])            => bind (lhs, T.Expr.neg(exp a))              | IL.E_Lit(Literal.Bool b) => T.Expr.boolLit b
47                    | (Op.LT ty, [a, b])          => bind (lhs, T.Expr.lt(exp a, exp b))              | IL.E_Lit(Literal.Float f) => T.Expr.floatLit f
48                    | (Op.LTE ty, [a, b])         => bind (lhs, T.Expr.lte(exp a, exp b))              | IL.E_Lit(Literal.String s) => T.Expr.stringLit s
49                    | (Op.EQ ty, [a, b])          => bind (lhs, T.Expr.equ(exp a, exp b))              | IL.E_Op(rator, args) => (case (rator, trExps(env, args))
50                    | (Op.NEQ ty, [a, b])         => bind (lhs, T.Expr.neq(exp a, exp b))                   of (Op.Add ty, [a, b])         => T.Expr.add(a, b)
51                    | (Op.GT ty, [a, b])          => bind (lhs, T.Expr.gt(exp a, exp b))                    | (Op.Sub ty, [a, b])         => T.Expr.sub(a, b)
52                    | (Op.GTE ty, [a, b])         => bind (lhs, T.Expr.gte(exp a, exp b))                    | (Op.Mul ty, [a, b])         => T.Expr.mul(a, b)
53                    | (Op.Not, [a])               => bind (lhs, T.Expr.not(exp a))                    | (Op.Div ty, [a, b])         => T.Expr.divide(a, b)
54                    | (Op.Max, [a, b])            => bind (lhs, T.Expr.max(exp a, exp b))                    | (Op.Neg ty, [a])            => T.Expr.neg a
55                    | (Op.Min, [a, b])            => bind (lhs, T.Expr.min(exp a, exp b))                    | (Op.LT ty, [a, b])          => T.Expr.lt(a, b)
56                    | (Op.Sin, [a])               => bind (lhs, T.Expr.sin(exp a))                    | (Op.LTE ty, [a, b])         => T.Expr.lte(a, b)
57                    | (Op.Cos, [a])               => bind (lhs, T.Expr.cos(exp a))                    | (Op.EQ ty, [a, b])          => T.Expr.equ(a, b)
58                    | (Op.Pow, [a, b])            => bind (lhs, T.Expr.pow(exp a, exp b))                    | (Op.NEQ ty, [a, b])         => T.Expr.neq(a, b)
59                    | (Op.Dot d, [a, b])          => bind (lhs, T.Expr.dot(exp a, exp b))                    | (Op.GT ty, [a, b])          => T.Expr.gt(a, b)
60                    | (Op.Cross, [a, b])          => bind (lhs, T.Expr.cross(exp a, exp b))                    | (Op.GTE ty, [a, b])         => T.Expr.gte(a, b)
61                    | (Op.Select(ty, i), [a])     => bind (lhs, T.Expr.select(i, exp a))                    | (Op.Not, [a])               => T.Expr.not a
62                    | (Op.Norm d, [a])            => bind (lhs, T.Expr.length(exp a))                    | (Op.Max, [a, b])            => T.Expr.max(a, b)
63                    | (Op.Scale d, [a, b])        => bind (lhs, T.Expr.mul(exp a, exp b))                    | (Op.Min, [a, b])            => T.Expr.min(a, b)
64                    | (Op.InvScale d, [a, b])     => bind (lhs, T.Expr.divide(exp a, exp b))                    | (Op.Sin, [a])               => T.Expr.sin a
65                      | (Op.Cos, [a])               => T.Expr.cos a
66                      | (Op.Pow, [a, b])            => T.Expr.pow(a, b)
67                      | (Op.Dot d, [a, b])          => T.Expr.dot(a, b)
68                      | (Op.Cross, [a, b])          => T.Expr.cross(a, b)
69                      | (Op.Select(ty, i), [a])     => T.Expr.select(i, a)
70                      | (Op.Norm d, [a])            => T.Expr.length a
71                      | (Op.Scale d, [a, b])        => T.Expr.mul(a, b)
72                      | (Op.InvScale d, [a, b])     => T.Expr.divide(a, b)
73                    | (Op.CL, _)                  => raise Fail "CL unimplemented"                    | (Op.CL, _)                  => raise Fail "CL unimplemented"
74                    | (Op.PrincipleEvec ty, _)    => raise Fail "PrincipleEvec unimplemented"                    | (Op.PrincipleEvec ty, _)    => raise Fail "PrincipleEvec unimplemented"
75  (*  (*
76                    | (Op.Subscript ty,                    | (Op.Subscript ty,
77  *)  *)
78                    | (Op.Floor d, [a])           => bind (lhs, T.Expr.floor(exp a))                    | (Op.Floor d, [a])           => T.Expr.floor a
79                    | (Op.IntToReal, [a])         => bind (lhs, T.Expr.toReal(exp a))                    | (Op.IntToReal, [a])         => T.Expr.toReal a
80                    | (Op.TruncToInt d, [a])      => bind (lhs, T.Expr.truncToInt(exp a))                    | (Op.TruncToInt d, [a])      => T.Expr.truncToInt a
81                    | (Op.RoundToInt d, [a])      => bind (lhs, T.Expr.roundToInt(exp a))                    | (Op.RoundToInt d, [a])      => T.Expr.roundToInt a
82                    | (Op.CeilToInt d, [a])       => bind (lhs, T.Expr.ceilToInt(exp a))                    | (Op.CeilToInt d, [a])       => T.Expr.ceilToInt a
83                    | (Op.FloorToInt d, [a])      => bind (lhs, T.Expr.floorToInt(exp a))                    | (Op.FloorToInt d, [a])      => T.Expr.floorToInt a
84                    | (Op.ImageAddress, [a])      => bind (lhs, T.Expr.imageAddr(exp a))                    | (Op.ImageAddress, [a])      => T.Expr.imageAddr a
85                    | (Op.LoadVoxels(rTy, n), [a]) => [] (* FIXME *)                    | (Op.LoadVoxels(rTy, n), [a]) => T.Expr.intLit 0 (* FIXME *)
86                    | (Op.PosToImgSpace d, [v, x]) => [] (* FIXME *)                    | (Op.PosToImgSpace d, [v, x]) => T.Expr.intLit 0 (* FIXME *)
87                    | (Op.GradToWorldSpace d, [v, x]) => [] (* FIXME *)                    | (Op.GradToWorldSpace d, [v, x]) => T.Expr.intLit 0 (* FIXME *)
88                    | (Op.LoadImage info, [a]) => [] (* FIXME *)                    | (Op.LoadImage info, [a]) => T.Expr.intLit 0 (* FIXME *)
89                    | (Op.Inside d, [v, x]) => [] (* FIXME *)                    | (Op.Inside d, [v, x]) => T.Expr.intLit 0 (* FIXME *)
90                    | (Op.Input(ty, name), []) => [] (* FIXME *)                    | (Op.Input(ty, name), []) => T.Expr.intLit 0 (* FIXME *)
91                    | (Op.InputWithDefault(ty, name), [a]) => [] (* FIXME *)                    | (Op.InputWithDefault(ty, name), [a]) => T.Expr.intLit 0 (* FIXME *)
92                    | _ => raise Fail(concat[                    | _ => raise Fail(concat[
93                          "incorrect number of arguments for ", Op.toString rator                          "incorrect number of arguments for ", Op.toString rator
94                        ])                        ])
95                  (* end case *))                  (* end case *))
96            in              | IL.E_Cons args => T.Expr.intLit 0 (* FIXME *)
97              f            (* end case *))
           end  
98    
99    (* translate a LowIL assignment to a list of zero or more target statements *)      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
     fun doAssign vtbl = let  
           val setDefOf = VDefTbl.setDefOf vtbl  
           val doRator = doRator vtbl  
           fun assign (lhs, rhs) = let  
                 fun setDef rhs = (setDefOf (lhs, rhs); [])  
                 in  
                   case rhs  
                    of IL.VAR x => setDef (VDefTbl.useDefOf vtbl x)  
                     | IL.LIT(Literal.Int n) => setDef (T.Expr.intLit n)  
                     | IL.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)  
                     | IL.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)  
                     | IL.LIT(Literal.String s) => setDef (T.Expr.stringLit s)  
                     | IL.OP(rator, args) => doRator(lhs, rator, args)  
                     | IL.CONS args =>  
                         VDefTbl.assign vtbl  
                           (lhs, T.Expr.vector (List.map (VDefTbl.useDefOf vtbl) args))  
                   (* end case *)  
                 end  
           in  
             assign  
           end  
100    
101      fun gen (vtbl, cfg) = let      fun trStmt (env, stm) = (case stm
102            val doAssign = doAssign vtbl             of IL.S_Comment text => T.Stmt.comment text
103            fun doNode (vtbl, ifCont, stms, nd) = (case Nd.kind nd  (* FIXME: special case for when x is a strand-state variable *)
104                   of IL.NULL => raise Fail "unexpected NULL"              | IL.S_Assign(x, exp) => (case V.kind x
105                    | IL.ENTRY{succ} => doNode (vtbl, ifCont, stms, !succ)                   of IL.VK_Global => T.Stmt.assignState(lookup(env, x), trExp(env, exp))
106                    | IL.JOIN{phis, succ, ...} => ifCont (stms, Nd.kind nd)                    | IL.VK_State strand => raise Fail "FIXME: state var"
107                    | IL.COND{cond, trueBranch, falseBranch, ...} => let                    | IL.VK_Local => T.Stmt.assign(lookup(env, x), trExp(env, exp))
108                        fun kThen (stms', _) = let                  (* end case *))
109                              val thenBlk = T.Stmt.block (List.rev stms')              | IL.S_IfThen(cond, thenBlk) =>
110                              fun kElse (stms', IL.JOIN{phis, succ, ...}) = let                  T.Stmt.ifthen(trExp(env, cond), trBlock(env, thenBlk))
111                                    val stm = T.Stmt.ifthenelse (              | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
112                                          VDefTbl.useDefOf vtbl cond,                  T.Stmt.ifthenelse(trExp(env, cond),
113                                          thenBlk,                    trBlock(env, thenBlk),
114                                          T.Stmt.block (List.rev stms'))                    trBlock(env, elseBlk))
115                                    in              | IL.S_Die => T.Stmt.die()
116  (* FIXME: what do we do about phis? *)              | IL.S_Stabilize => T.Stmt.stabilize()
                                     doNode (vtbl, ifCont, stm::stms, !succ)  
                                   end  
                             in  
                               doNode (vtbl, kElse, [], !falseBranch)  
                             end  
                       in  
                         doNode (vtbl, kThen, [], !trueBranch)  
                       end  
                   | IL.COM {text, succ, ...} =>  
                       doNode (vtbl, ifCont, T.Stmt.comment text :: stms, !succ)  
                   | IL.ASSIGN{stm, succ, ...} =>  
                       doNode (vtbl, ifCont, doAssign stm @ stms, !succ)  
                   | IL.NEW{strand, args, succ, ...} => raise Fail "NEW unimplemented"  
                   | IL.DIE _ =>  
                       T.Stmt.block (List.rev (T.Stmt.die() :: stms))  
                   | IL.STABILIZE _ =>  
                       T.Stmt.block (List.rev stms)  
                   | IL.EXIT _ => T.Stmt.block (List.rev (T.Stmt.stabilize() :: stms))  
117                  (* end case *))                  (* end case *))
           in  
             doNode (vtbl, fn _ => raise Fail "bogus ifCont at JOIN node", [], CFG.entry cfg)  
           end  
118    
119    (* generate the global-variable declarations and initialization code *)      and trBlock (env, IL.Block{locals, body}) = (
120      fun genGlobals (vtbl, prog, globals, globalInit) = let  (* what about the locals?? *)
121  (* FIXME: we should put the initialization code in a function! *)            T.Stmt.block(List.map (fn stm => trStmt(env, stm)) body))
           in  
             List.app markGlobal globals;  
             gen (vtbl, globalInit)  
           end  
 *)  
122    
123      fun generate (fileStem, srcProg) = let      fun generate (fileStem, srcProg) = let
124            val TreeIL.Program{globals, globalInit, strands} = LowToTree.translate srcProg            val TreeIL.Program{globals, globalInit, strands} = LowToTree.translate srcProg
125            val prog = T.newProgram ()            val prog = T.newProgram ()
126            (* define the globals and initialize the environment *)
127              val env = let
128                    fun gvar (x, env) =
129                          V.Map.insert(env, x, T.Var.global(prog, cvtTy(V.ty x), V.name x))
130                    in
131                      List.foldl gvar V.Map.empty globals
132                    end
133              val globalInit = trBlock (env, globalInit)
134            in            in
135            (* output the program *)            (* output the program *)
136              T.generate (fileStem, prog)              T.generate (fileStem, prog)

Legend:
Removed from v.531  
changed lines
  Added in v.532

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