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

SCM Repository

[diderot] View of /branches/vis15/src/compiler/c-util/tree-to-c.sml
ViewVC logotype

View of /branches/vis15/src/compiler/c-util/tree-to-c.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3866 - (download) (annotate)
Mon May 16 16:48:13 2016 UTC (3 years, 2 months ago) by jhr
File size: 10389 byte(s)
working on merge
(* tree-to-cxx.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2016 The University of Chicago
 * All rights reserved.
 *
 * Translate TreeIR to the C++ version of CLang.
 *)


structure TreeToCxx : sig

    type env = CLang.typed_var TreeVar.Map.map

    val empty : env

    val trType : TreeTypes.t -> CLang.ty

    val trBlock : env * TreeIR.block -> CLang.stm

    val trExp : env * TreeIR.exp -> CLang.exp

  (* translate an expression to a variable form; return the variable (as an expression)
   * and the (optional) declaration.
   *)
    val expToVar : env * CLang.ty * string * TreeIR.exp -> CLang.exp * CLang.stm list

    val trAssign : env * CLang.exp * TreeIR.exp -> CLang.stm list

  end = struct

    structure CL = CLang
    structure IR = TreeIR
    structure Op = TreeOps
    structure Ty = TreeTypes
    structure V = TreeVar
    structure VMap = VMap

    datatype var = datatype CL.typed_var
    type env = CLang.typed_var VMap.map

    val empty = VMap.empty

    fun lookup (env, x) = (case VMap.find (env, x)
           of SOME(V(_, x')) => x'
            | NONE => raise Fail(concat["lookup(_, ", V.name x, ")"])
          (* end case *))

    local
      fun global env = CL.mkVar(lookup(env, PseudoVars.global))
      fun selfIn env = CL.mkVar(lookup(env, PseudoVars.selfIn))
      fun selfOut env = CL.mkVar(lookup(env, PseudoVars.selfOut))
    in
  (* translate a local variable that occurs in an l-value context *)
    fun lvalueVar (env, x) = CL.mkVar(lookup(env, x))
  (* translate a variable that occurs in an r-value context *)
    fun rvalueVar (env, x) = CL.mkVar(lookup(env, x))

  (* translate a global variable that occurs in an l-value context *)
    fun lvalueGlobalVar (env, x) = CL.mkIndirect(global env, TreeGlobalVar.name x)
  (* translate a global variable that occurs in an r-value context *)
    val rvalueGlobalVar = lvalueGlobalVar

  (* translate a strand state variable that occurs in an l-value context *)
    fun lvalueStateVar (env, x) = CL.mkIndirect(selfOut env, TreeStateVar.name x)
  (* translate a strand state variable that occurs in an r-value context *)
    fun rvalueStateVar (env, x) = CL.mkIndirect(selfIn env, TreeStateVar.name x)
    end (* local *)

  (* generate new variables *)
    local
      val count = ref 0
      fun freshName prefix = let
            val n = !count
            in
              count := n+1;
              concat[prefix, "_", Int.toString n]
            end
    in
    fun tmpVar () = freshName "tmp"
    fun freshVar prefix = freshName prefix
    end (* local *)

  (* integer literal expression *)
    fun intExp (i : int) = CL.mkInt(IntInf.fromInt i)

    fun addrOf e = CL.mkUnOp(CL.%&, e)

  (* make an application of a function from the "std" namespace *)
    fun mkStdApply (f, args) = CL.mkApply("std::" ^ f, args)

  (* make an application of a function from the "diderot" namespace *)
    fun mkDiderotApply (f, args) = CL.mkApply("diderot::" ^ f, args)

  (* Translate a TreeIR operator application to a CLang expression *)
    fun trOp (rator, args) = (case (rator, args)
	    | (Op.IAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
	    | (Op.ISub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
	    | (Op.IMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
	    | (Op.IDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
	    | (Op.IMod, [a, b]) => CL.mkBinOp(a, CL.#%, b)
	    | (Op.INeg, [a]) => CL.mkUnOp(CL.%-, a)
	    | (Op.RAdd, [a, b]) => CL.mkBinOp(a, CL.#+, b)
	    | (Op.RSub, [a, b]) => CL.mkBinOp(a, CL.#-, b)
	    | (Op.RMul, [a, b]) => CL.mkBinOp(a, CL.#*, b)
	    | (Op.RDiv, [a, b]) => CL.mkBinOp(a, CL.#/, b)
	    | (Op.RNeg, [a]) => CL.mkUnOp(CL.%-, a)
	    | (Op.RClamp, [a, b, c]) =>
	    | (Op.RLerp, [a, b, c]) =>
            | (Op.LT ty, [a, b]) => CL.mkBinOp(a, CL.#<, b)
            | (Op.LTE ty, [a, b]) => CL.mkBinOp(a, CL.#<=, b)
            | (Op.EQ ty, [a, b]) => CL.mkBinOp(a, CL.#==, b)
            | (Op.NEQ ty, [a, b]) => CL.mkBinOp(a, CL.#!=, b)
            | (Op.GTE ty, [a, b]) => CL.mkBinOp(a, CL.#>=, b)
            | (Op.GT ty, [a, b]) => CL.mkBinOp(a, CL.#>, b)
            | (Op.Not, [a]) => CL.mkUnOp(CL.%!, a)
	    | (Op.Abs ty, args) => mkStdApply("abs", args)
	    | (Op.Max ty, args) => mkStdApply("min", args)
	    | (Op.Min ty, args) => mkStdApply("max", args)
	    | (Op.VAdd d, [a, b]) => CL.mkBinOp(a, CL.#+, b)
	    | (Op.VSub d, [a, b]) => CL.mkBinOp(a, CL.#-, b)
	    | (Op.VScale d, [a, b]) =>
	    | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)
	    | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)
	    | (Op.VSum d, [a, b]) =>
	    | (Op.VIndex(d, i), [a]) =>
	    | (Op.VClamp d, [a, b, c]) =>
	    | (Op.VMapClamp d, [a, b, c]) =>
	    | (Op.VLerp d, [a, b, c]) =>
	    | (Op.TensorIndex(ty, idxs), [a]) =>
	    | (Op.ProjectLast(ty, idxs), [a]) =>
	    | (Op.EigenVecs2x2, []) =>
	    | (Op.EigenVecs3x3, []) =>
	    | (Op.EigenVals2x2, []) =>
	    | (Op.EigenVals3x3, []) =>
	    | (Op.Zero ty, []) =>
	    | (Op.Select(ty * int), []) =>
	    | (Op.Subscript ty, []) =>
	    | (Op.MkDynamic(ty * int), []) =>
	    | (Op.Append ty, []) =>
	    | (Op.Prepend ty, []) =>
	    | (Op.Concat ty, []) =>
	    | (Op.Range, []) =>
	    | (Op.Length ty, []) =>
	    | (Op.SphereQuery(ty * ty), []) =>
	    | (Op.Sqrt, []) =>
	    | (Op.Cos, []) =>
	    | (Op.ArcCos, []) =>
	    | (Op.Sin, []) =>
	    | (Op.ArcSin, []) =>
	    | (Op.Tan, []) =>
	    | (Op.ArcTan, []) =>
	    | (Op.Exp, []) =>
	    | (Op.Ceiling d, []) =>
	    | (Op.Floor d, []) =>
	    | (Op.Round d, []) =>
	    | (Op.Trunc d, []) =>
	    | (Op.IntToReal, []) =>
	    | (Op.RealToInt d, []) =>
(*
	    | R_All of ty
	    | R_Exists of ty
	    | R_Max of ty
	    | R_Min of ty
	    | R_Sum of ty
	    | R_Product of ty
	    | R_Mean of ty
	    | R_Variance of ty
*)
	    | (Op.Transform(ImageInfo.info * int), []) =>
	    | (Op.Translate(ImageInfo.info), []) =>
	    | (Op.BaseAddress(ImageInfo.info), []) =>
	    | (Op.ControlIndex(ImageInfo.info * idxctl * int), []) =>
	    | (Op.Inside(ImageInfo.info * int), []) =>
	    | (Op.ImageDim(ImageInfo.info * int), []) =>
	    | (Op.LoadSeq(ty * string), []) =>
	    | (Op.LoadImage(ty * string), []) =>
	    | (Op.MathFn f, args) => CL.mkApply(??, args)
	    | _ => raise Fail(concat[
		   "unknown or incorrect operator ", Op.toString rator
		 ])
	  (* end case *))

    fun trExp (env, e) = (case e
           of IR.E_Global x => rvalueGlobalVar (env, x)
            | IR.E_State x => rvalueStateVar (env, x)
            | IR.E_Var x => rvalueVar (env, x)
            | IR.E_Lit(Literal.Int n) => CL.mkIntTy(n, !CTyN.gIntTy)
            | IR.E_Lit(Literal.Bool b) => CL.mkBool b
            | IR.E_Lit(Literal.Float f) => CL.mkFlt(f, !CTyN.gRealTy)
            | IR.E_Lit(Literal.String s) => CL.mkStr s
            | IR.E_Op(rator, args) => trOp (rator, trExps(env, args))
            | IR.E_Apply(f, args) => trApply(f, trExps(env, args))
            | IR.E_Cons(Ty.TensorTy[n], args) => CL.mkApply(MathN.mkVec n, trExps(env, args))
            | IR.E_Cons(ty, _) => raise Fail(concat["E_Cons(", Ty.toString ty, ", _) in expression"])
          (* end case *))

    and trExps (env, exps) = List.map (fn exp => trExp(env, exp)) exps

  (* translate a print expression *)
    fun trPrint (env, tys, args) = let
	  fun mkExp (lhs, []) = CL.mkBinOp(lhs, CL.#<<, CL.mkVar "std::end")
	    | mkExp (lhs, e) = CL.mkBinOp(lhs, CL.#<<, trExp(env, e))
	  in
	    CL.mkExpStm (mkExp (CL.mkIndirect(CL.mkVar "wrld", "_output"), args))
	  end

    fun trLocals (env : env, locals) =
          List.foldl
            (fn (x, env) => VMap.insert(env, x, V(trType(V.ty x), V.name x)))
              env locals

    fun trStms (env, stms) = let
          fun trStm (stm, (env, stms)) = (case stm
                 of IR.S_Comment text => CL.mkComment text :: stms
                  | IR.S_Assign(isDecl, x, exp) => let
		      val (env, stm) = trAssign (env, lvalueVar (env, x), exp)
		      in
			(env, stm::stms)
		      end
		  | IR.S_MAssign(xs, exp) =>
                      (env, trMultiAssign (env, List.map (fn x => lvalueVar (env, x)) xs, exp) :: stms)
                  | IR.S_GAssign(x, exp) =>
		      (env, trAssign (env, lvalueGlobalVar (env, x), exp) :: stms)
                  | IR.S_IfThen(cond, thenBlk) =>
                      (env, CL.mkIfThen(trExp(env, cond), trBlk(env, thenBlk)) :: stms)
                  | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let
		      val stm = CL.mkIfThenElse(trExp(env, cond),
			    trBlk(env, thenBlk),
			    trBlk(env, elseBlk))
		      in
			(env, stm :: stms)
		      end
		  | IR.S_Foreach(x, IR.E_Op(Op.Range, [lo, hi]), blk) => ??
		  | IR.S_Foreach(x, e, blk) => ??
                  | IR.S_New(strand, args) => ??
                  | IR.S_Save(x, exp) => trAssign (env, lvalueStateVar(env, x), exp)
                  | IR.S_LoadNrrd(lhs, Ty.DynSeqTy ty, nrrd) =>
                      [GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd)]
                  | IR.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) =>
                      [GenLoadNrrd.loadImage (lvalueVar (env, lhs), info, CL.mkStr nrrd)]
                  | IR.S_Input(_, _, _, NONE) => []
                  | IR.S_Input(gv, name, _, SOME dflt) => [
                        CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt))
                      ]
                  | IR.S_InputNrrd _ => (env, stms)
                  | IR.S_Exit args => (env, stms)
		  | IR.S_Print(tys, args) => ??
                  | IR.S_Active => (env, CL.mkReturn(SOME(CL.mkVar RN.kActive)) :: stms)
                  | IR.S_Stabilize => (env, CL.mkReturn(SOME(CL.mkVar RN.kStabilize)) :: stms)
                  | IR.S_Die => (env, CL.mkReturn(SOME(CL.mkVar RN.kDie)) :: stms)
                (* end case *))
          in
            List.rev (#2 (List.foldl trStm (env, []) stms))
          end

    and trBlock (env, IR.Block{locals, body}) = let
          val env = trLocals (env, locals)
          val stms = trStms (env, body)
          fun mkDecl (x, stms) = (case VMap.find (env, x)
                 of SOME(V(ty, x')) => CL.mkDecl(ty, x', NONE) :: stms
                  | NONE => raise Fail(concat["mkDecl(", V.name x, ", _)"])
                (* end case *))
          val stms = List.foldr mkDecl stms locals
          in
            CL.mkBlock stms
          end

  end

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