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 512, Tue Feb 8 19:32:42 2011 UTC revision 552, Fri Feb 18 15:09:08 2011 UTC
# Line 10  Line 10 
10    
11  functor CodeGenFn (T : TARGET) : sig  functor CodeGenFn (T : TARGET) : sig
12    
13      val generate : LowIL.program -> T.program      val generate : string * LowIL.program -> unit
14    
15    end = struct    end = struct
16    
17      structure IL = LowIL      structure IL = TreeIL
18      structure V = LowIL.Var      structure Ty = IL.Ty
19      structure Op = LowOps      structure Op = IL.Op
20      structure Nd = LowIL.Node      structure V = IL.Var
21      structure CFG = LowIL.Node  
22      (* convert LowIL types to T types *)
23    (* a mapping from LowIL variables to target expressions.  Variables get      fun cvtTy ty = (case ty
24     * removed when the expressions are used as arguments.             of Ty.BoolTy => T.boolTy
25     *)              | Ty.StringTy => T.stringTy
26      structure VDefTbl : sig              | Ty.IVecTy 1 => T.intTy
27          type tbl              | Ty.IVecTy n => T.ivecTy n         (* FIXME: what about vector splits? *)
28                | Ty.VecTy 1 => T.realTy
29          val newTbl : unit -> tbl              | Ty.VecTy n => T.vecTy n           (* FIXME: what about vector splits? *)
30          val getDefOf : tbl -> V.var -> T.exp              | Ty.AddrTy info => T.imageDataTy info
31          val useDefOf : tbl -> V.var -> T.exp              | Ty.ImageTy info => T.imageTy info
32          val setDefOf : tbl -> (V.var * T.exp) -> unit            (* end case *))
33    
34          val clear : tbl -> unit      fun addBindings (env, xs, ys) =
35              ListPair.foldlEq (fn (x, y, env) => V.Map.insert(env, x, y)) env (xs, ys)
36          val bind : tbl -> (V.var * T.exp) -> T.stm list  
37        fun lookup (env, x) = (case V.Map.find (env, x)
38        (* force all pending expressions into variables *)             of SOME x' => x'
39          val flush : tbl -> T.stm list              | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
40              (* end case *))
41        end = struct  
42        fun trExp (env, e) = (case e
43          type info = {             of IL.E_Var x => (case V.kind x
44              cnt : int ref,      (* count of oustanding uses (usually 1) *)                   of IL.VK_Global => T.Expr.global(lookup(env, x))
45              bind : T.exp                    | IL.VK_State strand => T.Expr.getState(lookup(env, x))
46            }                    | IL.VK_Local => T.Expr.var(lookup(env, x))
47                    (* end case *))
48          type tbl = info V.Tbl.hash_table              | IL.E_Lit(Literal.Int n) => T.Expr.intLit n
49                | IL.E_Lit(Literal.Bool b) => T.Expr.boolLit b
50          fun newTbl () = V.Tbl.mkTable (512, Fail "vtbl")              | IL.E_Lit(Literal.Float f) => T.Expr.floatLit f
51                | IL.E_Lit(Literal.String s) => T.Expr.stringLit s
52          fun getDefOf tbl x = (case V.Tbl.find tbl x              | IL.E_Op(rator, args) => (case (rator, trExps(env, args))
53                 of NONE => ??                   of (Op.Add ty, [a, b])         => T.Expr.add(a, b)
54                  | SOME{bind, cnt} => bind                    | (Op.Sub ty, [a, b])         => T.Expr.sub(a, b)
55                (* end case *))                    | (Op.Mul ty, [a, b])         => T.Expr.mul(a, b)
56                      | (Op.Div ty, [a, b])         => T.Expr.divide(a, b)
57          fun useDefOf tbl x = (case V.Tbl.find tbl x                    | (Op.Neg ty, [a])            => T.Expr.neg a
58                 of NONE => ??                    | (Op.LT ty, [a, b])          => T.Expr.lt(a, b)
59                  | SOME{cnt=ref 1, bind} => (                    | (Op.LTE ty, [a, b])         => T.Expr.lte(a, b)
60                      ignore (V.Tbl.remove tbl x);                    | (Op.EQ ty, [a, b])          => T.Expr.equ(a, b)
61                      bind)                    | (Op.NEQ ty, [a, b])         => T.Expr.neq(a, b)
62                  | SOME{cnt, bind} =>  => (                    | (Op.GT ty, [a, b])          => T.Expr.gt(a, b)
63                      cnt := !cnt - 1;                    | (Op.GTE ty, [a, b])         => T.Expr.gte(a, b)
64                      bind)                    | (Op.Not, [a])               => T.Expr.not a
65                (* end case *))                    | (Op.Max, [a, b])            => T.Expr.max(a, b)
66                      | (Op.Min, [a, b])            => T.Expr.min(a, b)
67          fun setDefOf tbl (x, exp) =                    | (Op.Sin, [a])               => T.Expr.sin a
68                V.Tbl.insert tbl (x, {cnt = ref(V.useCount x), bind = exp})                    | (Op.Cos, [a])               => T.Expr.cos a
69                      | (Op.Pow, [a, b])            => T.Expr.pow(a, b)
70          fun assign tbl (x, exp) = let                    | (Op.Dot d, [a, b])          => T.Expr.dot(a, b)
71                      val lhs : T.local_var = ??                    | (Op.Cross, [a, b])          => T.Expr.cross(a, b)
72                      in                    | (Op.Select(ty, i), [a])     => T.Expr.select(i, a)
73                        V.Tbl.insert tbl                    | (Op.Norm d, [a])            => T.Expr.length a
74                          (x, {cnt = V.useCount x, bind = T.Expr.var lhs});                    | (Op.Scale d, [a, b])        => T.Expr.mul(a, b)
75                        [T.Stmt.assign(lhs, exp)]                    | (Op.InvScale d, [a, b])     => T.Expr.divide(a, b)
76                      end                    | (Op.CL, _)                  => raise Fail "CL unimplemented"
77                      | (Op.PrincipleEvec ty, _)    => raise Fail "PrincipleEvec unimplemented"
78          fun bind tbl (x, exp) = (case V.useCount lhs  (*
79                 of 1 => (V.Tbl.insert tbl (x, {cnt = 1, bind = exp}); [])                    | (Op.Subscript ty,
                 | n => let (* bind exp to a new target variable *)  
                     val lhs : T.local_var = ??  
                     in  
                       V.Tbl.insert tbl (x, {cnt = n, bind = T.Expr.var lhs});  
                       [T.Stmt.assign(lhs, exp)]  
                     end  
               (* end case *))  
   
       end (*  VDefTbl *)  
   
 (* FIXME: what about splitting code where the target width doesn't match the  
  * source width?  
80   *)   *)
81      fun doRator (vtbl, lhs, rator, args) = let                    | (Op.Floor d, [a])           => T.Expr.floor a
82            val args' = List.map (VDefTbl.useDefOf vtbl) args                    | (Op.IntToReal, [a])         => T.Expr.toReal a
83            val rhs' = (case rator                    | (Op.TruncToInt d, [a])      => T.Expr.truncToInt a
84  (* ??? *)                    | (Op.RoundToInt d, [a])      => T.Expr.roundToInt a
85                  (* end case *))                    | (Op.CeilToInt d, [a])       => T.Expr.ceilToInt a
86            in                    | (Op.FloorToInt d, [a])      => T.Expr.floorToInt a
87              VDefTbl.bind vtbl (lhs, rhs')                    | (Op.ImageAddress d, [a])    => T.Expr.imageAddr a
88            end                    | (Op.LoadVoxels(info, 1), [a]) => T.Expr.getImgData a
89                      | (Op.LoadVoxels _, [a])      => raise Fail "impossible"
90    (* translate a LowIL assignment to a list of zero or more target statements *)                    | (Op.PosToImgSpace d, [v, x]) => T.Expr.posToImgSpace(v, x)
91      fun doAssign vtbl (lhs, rhs) = let                    | (Op.GradToWorldSpace d, [v, x]) => T.Expr.intLit 0 (* FIXME *)
92            fun setDef rhs = (VTbl.setDefOf vtbl (lhs, rhs); [])                    | (Op.LoadImage info, [a])    => raise Fail "impossible"
93            in                    | (Op.Inside(d, s), [x, v])   => T.Expr.inside(x, v, s)
94              case rhs                    | (Op.Input(ty, name), [])    => raise Fail "impossible"
95               of IL.VAR x => setDef (T.Expr.var(VDefTbl.useDefOf vtbl x))                    | (Op.InputWithDefault(ty, name), [a]) => T.Expr.intLit 0 (* FIXME *)
96                | IL.LIT(Literal.Int n) => setDef (T.Expr.intLit n)                    | _ => raise Fail(concat[
97                | IL.LIT(Literal.Bool b) => setDef (T.Expr.boolLit b)                          "incorrect number of arguments for ", Op.toString rator
98                | IL.LIT(Literal.Float f) => setDef (T.Expr.floatLit f)                        ])
99                | IL.LIT(Literal.String s) => setDef (T.Expr.stringLit s)                  (* end case *))
100                | IL.OP(rator, args) => doRator(vtbl, lhs, rator, args)            (* end case *))
101                | IL.CONS args =>  
102                    VTbl.assign ctbl (lhs, T.Expr.vector (List.map (VDefTbl.useDefOf vtbl) args))      and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps
103              (* end case *)  
104            end      fun trStmt (env, stm) = (case stm
105               of IL.S_Comment text => [T.Stmt.comment text]
106      datatype open_if = T.stm list * IL.node -> stm              | IL.S_Assign(x, exp) => (case V.kind x
107                     of IL.VK_Global => [T.Stmt.assign(lookup(env, x), trExp(env, exp))]
108      fun gen (vtbl, cfg) = let                    | IL.VK_State strand =>
109            val doAssign = doAssign vtbl                        [T.Stmt.assignState(lookup(env, x), trExp(env, exp))]
110            fun doNode (vtbl, ifStk, stms, nd) = (case Nd.kind nd                    | IL.VK_Local => [T.Stmt.assign(lookup(env, x), trExp(env, exp))]
111                   of IL.NULL =>                  (* end case *))
112                    | IL.ENTRY{succ} =>              | IL.S_Cons(lhs, args) =>
113                    | IL.JOIN{phis, succ, ...} =>                  [T.Stmt.cons(lookup(env, lhs), trExps(env, args))]
114                    | IL.COND{cond, trueBranch, falseBranch, ...} => let              | IL.S_LoadVoxels(lhs, dim, addr) =>
115                        fun kThen (stms', _) = let                  [T.Stmt.getImgData(lookup(env, lhs), dim, trExp(env, addr))]
116                              val thenBlk = T.Stmt.block (List.rev stms')              | IL.S_LoadImage(lhs, dim, name) =>
117                              fun kElse (stms', succ) = let                  T.Stmt.loadImage (lookup(env, lhs), dim, trExp(env, name))
118                                    val stm = T.Stmt.ifthenelse (              | IL.S_Input(lhs, name, optDflt) =>
119                                          VDefTbl.useDefOf vtbl cond,                  T.Stmt.input(lookup(env, lhs), name, Option.map (fn e => trExp(env, e)) optDflt)
120                                          thenBlk,              | IL.S_IfThen(cond, thenBlk) =>
121                                          T.Stmt.block (List.rev stms'))                  [T.Stmt.ifthen(trExp(env, cond), trBlock(env, thenBlk))]
122                                    in              | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
123                                      doNode (vtbl, ifStk, stm::stms, succ)                  [T.Stmt.ifthenelse(trExp(env, cond),
124                                    end                    trBlock(env, thenBlk),
125                              in                    trBlock(env, elseBlk))]
126                                doNode (vtbl, kElse::ifStk, [], !falseBranch)              | IL.S_Die => [T.Stmt.die()]
127                              end              | IL.S_Stabilize => [T.Stmt.stabilize()]
128                        in            (* end case *))
129                          doNode (vtbl, kThen::ifStk, [], !trueBranch)  
130                        end      and trBlock (env, IL.Block{locals, body}) = let
131                    | IL.COM {text, succ, ...} =>            val env = List.foldl
132                    | IL.ASSIGN{stm, succ, ...} =>                  (fn (x, env) => V.Map.insert(env, x, T.Var.var(cvtTy(V.ty x), V.name x)))
133                    | IL.NEW{strand, args, succ, ...} =>                    env locals
134                    | IL.DIE _ =>            in
135                    | IL.STABILIZE _ =>              T.Stmt.block(List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body)
136                    | IL.EXIT _ =>            end
137                  (* end case *))  
138            in      fun trMethod (strand, env) (IL.Method{name, body}) =
139            end            T.Strand.method (strand, Atom.toString name, trBlock (env, body))
140    
141      fun gen (vtbl, stm) = let      fun trStrand (prog, env) (IL.Strand{name, params, state, stateInit, methods}) = let
142            val doAssign = doAssign vtbl            val strand = T.Strand.define(prog, Atom.toString name)
143            fun mkBlock [] = ?            val state' =
144              | mkBlock [s] = s                  List.map (fn x => T.Var.state(strand, cvtTy(V.ty x), V.name x)) state
145              | mkBlock stms = T.Stmt.block stms            val env = addBindings (env, state, state')
146            fun doStmt (IL.STM{kind, next, ...}) = let          (* define the parameters and add them to the environment *)
147                  val stms = (case kind            val params' = List.map (fn x => T.Var.param(cvtTy(V.ty x), V.name x)) params
148                         of IL.S_SIMPLE nd => doNode nd            val env = addBindings (env, params, params')
149                          | IL.S_IF{cond, thenBranch, elseBranch} => let            in
150                              val IL.ND{kind=IL.COND{cond, ...}, ...} = cond              T.Strand.init (strand, params', trBlock (env, stateInit));
151                              val s1 = mkBlock(doStmt thenBranch)              List.app (trMethod (strand, env)) methods
152                              val s2 = mkBlock(doStmt elseBranch)            end
153                              in  
154  (* FIXME: check for empty else branch *)      fun generate (fileStem, srcProg) = let
155                                T.ifthenelse(VDefTbl.useDefOf vtbl cond, s1, s2)            val treeProg as TreeIL.Program{globals, globalInit, strands} = LowToTree.translate srcProg
156                              end  val _ = (
157                          | IL.S_LOOP{hdr, cond, body} => raise Fail "LOOP not supported yet"  TextIO.output(Log.logFile(), "********** After translation to TreeIL **********\n");
158                        (* end case *))  TreeILPP.program (Log.logFile(), treeProg))
159                  val rest = (case next            val prog = T.newProgram ()
160                         of NONE => VDefTbl.flush vtbl          (* define the globals and initialize the environment *)
161                          | SOME stm = doStmt stm            val env = let
162                        (* end case *))                  fun gvar (x, env) =
163                  in                        V.Map.insert(env, x, T.Var.global(prog, cvtTy(V.ty x), V.name x))
164                    stms @ rest                  in
165                  end                    List.foldl gvar V.Map.empty globals
166            and doNode (IL.ND{kind, ...}) = (case kind                  end
167                   of IL.NULL => ??            in
168                    | IL.ENTRY{succ} => nextNode succ            (* global initialization *)
169                    | IL.JOIN{succ, ...} =>              T.globalInit (prog, trBlock (env, globalInit));
170                    | IL.COND{cond, ...} =>            (* translate strands *)
171                    | IL.BLOCK{body, succ, ...} =>              List.app (trStrand (prog, env)) strands;
172                        List.app doAssign body @ nextNode succ            (* output the program *)
173                    | IL.NEW{strand, args, ...} =>              T.generate (fileStem, prog)
                   | IL.DIE _ =>  
                   | IL.STABILIZE _ =>  
                   | IL.EXIT _ =>  
                 (* end case *))  
           and nextNode nd = if isFirst nd then [] else doNode nd  
           in  
             mkBlock (doStmt stm)  
174            end            end
175    
176    end    end

Legend:
Removed from v.512  
changed lines
  Added in v.552

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