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

SCM Repository

[diderot] Diff of /branches/pure-cfg/src/compiler/cl-target/tree-to-cl.sml
ViewVC logotype

Diff of /branches/pure-cfg/src/compiler/cl-target/tree-to-cl.sml

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

revision 1243, Wed May 18 18:32:36 2011 UTC revision 1244, Wed May 18 19:30:16 2011 UTC
# Line 1  Line 1 
1  (* tree-to-cl.sml  (* tree-to-c.sml
2   *   *
3   * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)   * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * Translate TreeIL to the OpenCL version of CLang.   * Translate TreeIL to the C version of CLang.
7   *)   *)
8    
9  structure TreeToCL : sig  structure TreeToCL : sig
# Line 16  Line 16 
16    
17      val trBlock : env * (env * TreeIL.exp list * CLang.stm -> CLang.stm list) * TreeIL.block -> CLang.stm      val trBlock : env * (env * TreeIL.exp list * CLang.stm -> CLang.stm list) * TreeIL.block -> CLang.stm
18    
19        val trFragment : env * TreeIL.block -> env * CLang.stm list
20    
21      val trAssign : env * TreeIL.var * TreeIL.exp -> CLang.stm list      val trAssign : env * TreeIL.var * TreeIL.exp -> CLang.stm list
22    
23      val trExp : env * TreeIL.exp -> CLang.exp      val trExp : env * TreeIL.exp -> CLang.exp
# Line 54  Line 56 
56              | Ty.TensorTy[] => !RN.gRealTy              | Ty.TensorTy[] => !RN.gRealTy
57              | Ty.TensorTy[n] => CL.T_Named(RN.vecTy n)              | Ty.TensorTy[n] => CL.T_Named(RN.vecTy n)
58              | Ty.TensorTy[n, m] => CL.T_Named(RN.matTy(n,m))              | Ty.TensorTy[n, m] => CL.T_Named(RN.matTy(n,m))
59              | Ty.AddrTy(ImageInfo.ImgInfo{ty=([], rTy), ...}) => CL.T_Ptr(CL.T_Num rTy)              | Ty.AddrTy(ImageInfo.ImgInfo{ty=(_, rTy), ...}) => CL.T_Ptr(CL.T_Num rTy)
60              | Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}) => CL.T_Ptr(CL.T_Named(RN.imageTy dim))              | Ty.ImageTy(ImageInfo.ImgInfo{dim, ...}) => CL.T_Ptr(CL.T_Named(RN.imageTy dim))
61              | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])              | _ => raise Fail(concat["TreeToC.trType(", Ty.toString ty, ")"])
62            (* end case *))            (* end case *))
# Line 86  Line 88 
88        val dLookup = mkLookup ""        val dLookup = mkLookup ""
89      in      in
90      fun trApply (f, args) = let      fun trApply (f, args) = let
91            val f' = if !Controls.doublePrecision then dLookup f else fLookup f            val f' = if !RN.doublePrecision then dLookup f else fLookup f
92            in            in
93              CL.mkApply(f', args)              CL.mkApply(f', args)
94            end            end
# Line 242  Line 244 
244              | (Op.PosToImgSpace(ImageInfo.ImgInfo{dim, ...}), [img, pos]) =>              | (Op.PosToImgSpace(ImageInfo.ImgInfo{dim, ...}), [img, pos]) =>
245                  CL.mkApply(RN.toImageSpace dim, [img, pos])                  CL.mkApply(RN.toImageSpace dim, [img, pos])
246              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>              | (Op.TensorToWorldSpace(info, ty), [v, x]) =>
247                  raise Fail "TensorToWorldSpace unimplemented"                  CL.mkApply(RN.toWorldSpace ty, [v, x])
248              | (Op.LoadImage info, [a]) =>              | (Op.LoadImage info, [a]) =>
249                  raise Fail("impossible " ^ Op.toString rator)                  raise Fail("impossible " ^ Op.toString rator)
250              | (Op.Inside(ImageInfo.ImgInfo{dim, ...}, s), [pos, img]) =>              | (Op.Inside(ImageInfo.ImgInfo{dim, ...}, s), [pos, img]) =>
# Line 293  Line 295 
295                    [CL.mkCall(RN.mulMatMat(m,n,p), lhs :: trExps(env, args))]                    [CL.mkCall(RN.mulMatMat(m,n,p), lhs :: trExps(env, args))]
296                | IL.E_Op(Op.Identity n, args) =>                | IL.E_Op(Op.Identity n, args) =>
297                    [CL.mkCall(RN.identityMat n, [lhs])]                    [CL.mkCall(RN.identityMat n, [lhs])]
298                | IL.E_Op(Op.Zero(Ty.TensorTy[n,m]), args) =>                | IL.E_Op(Op.Zero(Ty.TensorTy[m,n]), args) =>
299                    [CL.mkCall(RN.zeroMat(m,n), [lhs])]                    [CL.mkCall(RN.zeroMat(m,n), [lhs])]
300                  | IL.E_Op(Op.TensorToWorldSpace(info, ty as Ty.TensorTy[_,_]), args) =>
301                      [CL.mkCall(RN.toWorldSpace ty, lhs :: trExps(env, args))]
302                | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>                | IL.E_Op(Op.LoadVoxels(info, n), [a]) =>
303                    if (n > 1)                    if (n > 1)
304                      then let                      then let
# Line 330  Line 334 
334              (* end case *)              (* end case *)
335            end            end
336    
337      fun trBlock (env : env, saveState, blk) = let      fun trLocals (env : env, locals) =
338              List.foldl
339                (fn (x, env) => V.Map.insert(env, x, V(trType(V.ty x), V.name x)))
340                  env locals
341    
342          (* generate code to check the status of runtime-system calls *)          (* generate code to check the status of runtime-system calls *)
343            fun checkSts mkDecl = let            fun checkSts mkDecl = let
344                  val sts = freshVar "sts"                  val sts = freshVar "sts"
# Line 340  Line 348 
348                      CL.mkBinOp(CL.mkVar "DIDEROT_OK", CL.#!=, CL.mkVar sts),                      CL.mkBinOp(CL.mkVar "DIDEROT_OK", CL.#!=, CL.mkVar sts),
349                      CL.mkCall("exit", [intExp 1]))]                      CL.mkCall("exit", [intExp 1]))]
350                  end                  end
351    
352        fun trStms (env, saveState, stms) = let
353            fun trStmt (env, stm) = (case stm            fun trStmt (env, stm) = (case stm
354                   of IL.S_Comment text => [CL.mkComment text]                   of IL.S_Comment text => [CL.mkComment text]
355                    | IL.S_Assign(x, exp) => trAssign (env, x, exp)                    | IL.S_Assign(x, exp) => trAssign (env, x, exp)
356                    | IL.S_IfThen(cond, thenBlk) =>                    | IL.S_IfThen(cond, thenBlk) =>
357                        [CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk))]                        [CL.mkIfThen(trExp(env, cond), trBlk(env, saveState, thenBlk))]
358                    | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>                    | IL.S_IfThenElse(cond, thenBlk, elseBlk) =>
359                        [CL.mkIfThenElse(trExp(env, cond),                        [CL.mkIfThenElse(trExp(env, cond),
360                          trBlk(env, thenBlk),                          trBlk(env, saveState, thenBlk),
361                          trBlk(env, elseBlk))]                          trBlk(env, saveState, elseBlk))]
362                      | IL.S_New _ => raise Fail "new not supported yet" (* FIXME *)
363                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let                    | IL.S_LoadImage(lhs, dim, name) => checkSts (fn sts => let
364                        val lhs = lookup(env, lhs)                        val lhs = lookup(env, lhs)
365                        val name = trExp(env, name)                        val name = trExp(env, name)
# Line 377  Line 388 
388                        in                        in
389                          initCode @ code                          initCode @ code
390                        end)                        end)
391  (* FIXME: what about the args? *)                    | IL.S_Exit args =>
392                    | IL.S_Exit args => [CL.mkReturn NONE]                        saveState (env, args, CL.mkReturn NONE)
393                    | IL.S_Active args =>                    | IL.S_Active args =>
394                        saveState (env, args, CL.mkReturn(SOME(CL.mkVar RN.kActive)))                        saveState (env, args, CL.mkReturn(SOME(CL.mkVar RN.kActive)))
395                    | IL.S_Stabilize args =>                    | IL.S_Stabilize args =>
396                        saveState (env, args, CL.mkReturn(SOME(CL.mkVar RN.kStabilize)))                        saveState (env, args, CL.mkReturn(SOME(CL.mkVar RN.kStabilize)))
397                    | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar RN.kDie))]                    | IL.S_Die => [CL.mkReturn(SOME(CL.mkVar RN.kDie))]
398                  (* end case *))                  (* end case *))
399            and trBlk (env, IL.Block{locals, body}) = let            in
400                  val env = List.foldl              List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] stms
401                        (fn (x, env) => V.Map.insert(env, x, V(trType(V.ty x), V.name x)))            end
402                          env locals  
403                  val stms = List.foldr (fn (stm, stms) => trStmt(env, stm)@stms) [] body      and trBlk (env, saveState, IL.Block{locals, body}) = let
404              val env = trLocals (env, locals)
405              val stms = trStms (env, saveState, body)
406                  fun mkDecl (x, stms) = (case V.Map.find (env, x)                  fun mkDecl (x, stms) = (case V.Map.find (env, x)
407                         of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms                         of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
408                          | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])                          | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
# Line 398  Line 411 
411                  in                  in
412                    CL.mkBlock stms                    CL.mkBlock stms
413                  end                  end
414    
415        fun trFragment (env, IL.Block{locals, body}) = let
416              val env = trLocals (env, locals)
417              val stms = trStms (env, fn _ => raise Fail "exit in fragment", body)
418              fun mkDecl (x, stms) = (case V.Map.find (env, x)
419                     of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
420                      | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
421                    (* end case *))
422              val stms = List.foldr mkDecl stms locals
423            in            in
424              trBlk (env, blk)              (env, stms)
425            end            end
426    
427        val trBlock = trBlk
428    
429    end    end

Legend:
Removed from v.1243  
changed lines
  Added in v.1244

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