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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3870 - (download) (annotate)
Tue May 17 13:53:58 2016 UTC (3 years, 4 months ago) by jhr
Original Path: branches/vis15/src/compiler/c-util/tree-to-cxx.sml
File size: 12310 byte(s)
  Working on merge (code generation)
(* 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)
	   of (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]) => CL.mkApply("clamp", [a, b, c])
	    | (Op.RLerp, [a, b, c]) => CL.mkApply("lerp", [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]) => CL.mkApply("vscale", [a, b])
	    | (Op.VMul d, [a, b]) => CL.mkBinOp(a, CL.#*, b)
	    | (Op.VNeg d, [a]) => CL.mkUnOp(CL.%-, a)
	    | (Op.VSum d, [a]) => CL.mkApply("vsum", [a, b])
	    | (Op.VIndex(d, i), [a]) => CL.mkSubscript(a, intExp i)
	    | (Op.VClamp d, [a, b, c]) => CL.mkApply("clamp", [a, b, c])
	    | (Op.VMapClamp d, [a, b, c]) => CL.mkApply("clamp", [a, b, c])
	    | (Op.VLerp d, [a, b, c]) => CL.mkApply("lerp", [a, b, c])
	    | (Op.TensorIndex(ty, idxs), [a]) => ??
	    | (Op.ProjectLast(ty, idxs), [a]) => ??
	    | (Op.EigenVals2x2, [a]) => ??
	    | (Op.EigenVals3x3, [a]) => ??
	    | (Op.Zero ty, []) => ??
	    | (Op.Select(ty, i), [a]) => ??
	    | (Op.Subscript ty, [a, b]) => ??
	    | (Op.MkDynamic(ty, i), [a]) => ??
	    | (Op.Append ty, [a, b]) => ??
	    | (Op.Prepend ty, [a, b]) => ??
	    | (Op.Concat ty, [a, b]) => ??
	    | (Op.Range, [a, b]) => ??
	    | (Op.Length ty, [a]) => ??
	    | (Op.SphereQuery(ty1, ty2), []) => ??
	    | (Op.Sqrt, [a]) => mkStdApply("sqrt", [a])
	    | (Op.Cos, [a]) => mkStdApply("cos", [a])
	    | (Op.ArcCos, [a]) => mkStdApply("acos", [a])
	    | (Op.Sin, [a]) => mkStdApply("sin", [a])
	    | (Op.ArcSin, [a]) => mkStdApply("asin", [a])
	    | (Op.Tan, [a]) => mkStdApply("tan", [a])
	    | (Op.ArcTan, [a]) => mkStdApply("atan", [a])
	    | (Op.Exp, [a]) => mkStdApply("exp", [a])
	    | (Op.Ceiling 1, [a]) => mkStdApply("ceil", [a])
	    | (Op.Ceiling d, [a]) => ??
	    | (Op.Floor 1, [a]) => mkStdApply("floor", [a])
	    | (Op.Floor d, [a]) => ??
	    | (Op.Round 1, [a]) => mkStdApply("round", [a])
	    | (Op.Round d, [a]) => ??
	    | (Op.Trunc 1, [a]) => mkStdApply("trun", [a])
	    | (Op.Trunc d, [a]) => ??
	    | (Op.IntToReal, [a]) => ??
	    | (Op.RealToInt 1, [a]) => ??
	    | (Op.RealToInt d, [a]) => ??
(*
	    | 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 info, [img]) => ??
	    | (Op.Translate info, [img]) => ??
	    | (Op.BaseAddress info, [img]) => ??
	    | (Op.ControlIndex(info, ctl, i), [a]) => ??
	    | (Op.Inside(info, i), [pos, img]) => ??
	    | (Op.ImageDim(info, i), [img]) => ??
	    | (Op.LoadSeq(ty, file), []) => ??
	    | (Op.LoadImage(ty, file), []) => ??
	    | (Op.MathFn f, args) => mkStdApply(MathFns.toString f, 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.Real 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_Vec(d, args) => ??
            | IR.E_Cons(args, Ty.TensorTy shape) => ??
            | IR.E_Seq(args, ty) => ??
	    | IR.E_Pack(layout, args) => ??
	    | IR.E_VLoad(layout, e, i) => ??
          (* end case *))

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

    fun trMultiAssign (env, lhs, IR.E_Op(rator, args)) = (case (lhs, rator, args)
           of ([vals, vecs], Op.EigenVecs2x2, [m]) => let
                val (m, stms) = expToVar (env, CTyN.matTy(2,2), "m", m)
                in
                  stms @ [CL.mkCall(MathN.evecs2x2, [
                      vals, vecs,
                      matIndex (m, CL.mkInt 0, CL.mkInt 0),
                      matIndex (m, CL.mkInt 0, CL.mkInt 1),
                      matIndex (m, CL.mkInt 1, CL.mkInt 1)
                    ])]
                end
            | ([vals, vecs], Op.EigenVecs3x3, [m]) => let
                val (m, stms) = expToVar (env, CTyN.matTy(3,3), "m", m)
                in
                  stms @ [CL.mkCall(MathN.evecs3x3, [
                      vals, vecs,
                      matIndex (m, CL.mkInt 0, CL.mkInt 0),
                      matIndex (m, CL.mkInt 0, CL.mkInt 1),
                      matIndex (m, CL.mkInt 0, CL.mkInt 2),
                      matIndex (m, CL.mkInt 1, CL.mkInt 1),
                      matIndex (m, CL.mkInt 1, CL.mkInt 2),
                      matIndex (m, CL.mkInt 2, CL.mkInt 2)
                    ])]
                end
            | _ => raise Fail "bogus multi-assignment"
          (* end case *))
      | trMultiAssign (env, lhs, rhs) = raise Fail "bogus multi-assignment"

    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 : CL.stm list) = let
          fun trStm (stm, (env, stms : CL.stm list)) = (case stm
                 of IR.S_Comment text => (env, 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), trBlock(env, thenBlk)) :: stms)
                  | IR.S_IfThenElse(cond, thenBlk, elseBlk) => let
		      val stm = CL.mkIfThenElse(trExp(env, cond),
			    trBlock(env, thenBlk),
			    trBlock(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.SeqTy(ty, NONE), nrrd) =>
                      (env, GenLoadNrrd.loadSeqFromFile (lvalueVar (env, lhs), ty, CL.mkStr nrrd) :: stms)
                  | IR.S_LoadNrrd(lhs, Ty.ImageTy info, nrrd) =>
                      (env, GenLoadNrrd.loadImage (lvalueVar (env, lhs), info, CL.mkStr nrrd) :: stms)
                  | IR.S_Input(_, _, _, NONE) => (env, stms)
                  | IR.S_Input(gv, name, _, SOME dflt) =>
                      (env, CL.mkAssign(lvalueGlobalVar (env, gv), trExp(env, dflt)) :: stms)
                  | IR.S_InputNrrd _ => (env, stms)
                  | IR.S_Exit => (env, stms)
		  | IR.S_Print(tys, args) => let
		      val args = List.map (fn e => trExp(env, e)) args
		      val stm = GenPrint.genPrintStm (
			    CL.mkIndirect(CL.mkVar "wrld", "_output"),
			    tys, args)
		      in
			(env, stm::stms)
		      end
                  | 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