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/gen-tys-and-ops.sml
ViewVC logotype

View of /branches/vis15/src/compiler/cxx-util/gen-tys-and-ops.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4098 - (download) (annotate)
Wed Jun 29 16:36:57 2016 UTC (3 years, 1 month ago) by jhr
File size: 21292 byte(s)
  working on merge
(* gen-tys-and-ops.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.
 *)

structure GenTysAndOps : sig

    val gen : CodeGenEnv.t * CollectInfo.t -> CLang.decl list

  end = struct

    structure IR = TreeIR
    structure Ty = TreeTypes
    structure CL = CLang
    structure RN = CxxNames
    structure Env = CodeGenEnv

    val zero = RealLit.zero false

    fun mkReturn exp = CL.mkReturn(SOME exp)
    fun mkInt i = CL.mkInt(IntInf.fromInt i)
    fun mkFunc (ty, name, params, body) = CL.D_Func(["inline"], ty, [], name, params, body)
   (* make a constructor function's prototype and out-of-line definition *)
    fun mkConstr (cls, params, inits) = (
	    CL.D_Constr([], [], cls, params, NONE),
	    CL.D_Constr(["inline"], [CL.SC_Type(CL.T_Named cls)], cls, params, SOME(inits, CL.mkBlock[]))
	  )
   (* make a member function prototype and out-of-line definition *)
    fun mkMemberFn (cls, ty, f, params, body) = (
	    CL.D_Proto([], ty, f, params),
	    CL.D_Func(["inline"], ty, [CL.SC_Type(CL.T_Named cls)], f, params, body)
	  )

    fun genTyDecl env = let
	  val (realTy, realTyName, realTySz) = if #double(Env.target env)
		then (CL.double, "double", 8)
		else (CL.float, "float", 4)
	(* generate the type and member declarations for a recorded type *)
	  fun genDecl (ty, (tyDcls, fnDefs)) = (case ty
		 of Ty.VecTy(w, pw) => let
		      val cTyName = RN.vecTyName w
		      val cTy = CL.T_Named cTyName
		      val typedefDcl = CL.D_Verbatim[concat[
			      "typedef ", realTyName, " ", cTyName,
			      " __attribute__ ((vector_size (",
			      Int.toString(realTySz * pw), ")));"
			    ]]
		      in
			(typedefDcl :: tyDcls, fnDefs)
		      end
		  | Ty.TensorRefTy shape => let
		      val name = RN.tensorRefStruct shape
		      val thisData = CL.mkIndirect(CL.mkVar "this", "_data")
		    (* constructor from float/double pointer *)
		      val (constrProto1, constrDef1) = mkConstr (name,
			    [CL.PARAM([], CL.constPtrTy realTy, "src")],
			    [CL.mkApply("_data", [CL.mkVar "src"])])
		    (* constructor from tensor struct *)
		      val (constrProto2, constrDef2) = mkConstr(name,
			    [CL.PARAM([],
				CL.T_Named(concat["struct ", RN.tensorStruct shape, " const &"]),
				"ten")
			      ],
			    [CL.mkApply("_data", [CL.mkSelect(CL.mkVar "ten", "_data")])])
		    (* copy constructor *)
		      val (constrProto3, constrDef3) = mkConstr (name,
			    [CL.PARAM([], CL.T_Named(name ^ " const &"), "ten")],
			    [CL.mkApply("_data", [CL.mkSelect(CL.mkVar "ten", "_data")])])
		    (* subscript operator *)
		      val subscriptDcl = CL.D_Func([], CL.T_Named(realTyName ^ " const &"),
			    [], "operator[]",
			    [CL.PARAM([], CL.uint32, "i")],
			    CL.mkReturn(SOME(CL.mkSubscript(thisData, CL.mkVar "i"))))
		    (* address at function *)
		      val addrAtDcl = CL.D_Func([], CL.constPtrTy(realTy), [], "addr",
			    [CL.PARAM([], CL.uint32, "i")],
			    CL.mkReturn(SOME(CL.mkAddrOf(CL.mkSubscript(thisData, CL.mkVar "i")))))
		    (* last vector as tensor_ref *)
		      val lastDcl = (case shape
			    of [] => raise Fail "unexpected TensorRef[]"
			     | [_] => []
			     | _::dd => let
				val d = List.last dd
				in [
				  CL.D_Func([], RN.tensorRefTy[d], [], "last",
				    [CL.PARAM([], CL.uint32, "i")],
			    	    CL.mkReturn(
				      SOME(CL.mkAddrOf(CL.mkSubscript(thisData, CL.mkVar "i")))))
				] end
			    (* end case *))
		      val members = CL.mkVarDcl(CL.constPtrTy realTy, "_data") ::
				  constrProto1 :: constrProto2 :: constrProto3 ::
				  subscriptDcl ::
				  addrAtDcl :: lastDcl
		      val structDcl = CL.D_ClassDef{
			      name = name,
			      args = NONE,
			      from = NONE,
			      public = members,
			      protected = [],
			      private = []
			    }
		      in
			(structDcl :: tyDcls, constrDef1 :: constrDef2 :: constrDef3 :: fnDefs)
		      end
		  | Ty.TensorTy shape => let
		      val len = List.foldl Int.* 1 shape
		      val name = RN.tensorStruct shape
		      val thisData = CL.mkIndirect(CL.mkVar "this", "_data")
		      val returnThis = CL.mkReturn(SOME(CL.mkUnOp(CL.%*, CL.mkVar "this")))
		    (* code for initializing a tensor from pointer (src). *)
		      fun copyFromArray src = if (len < 4)
			    then let
			      fun cpy i = CL.mkAssign(
				    CL.mkSubscript(thisData, mkInt i),
			            CL.mkSubscript(src, mkInt i))
			      in
				CL.mkBlock (List.tabulate (len, cpy))
			      end
			    else CL.mkCall("std::memcpy", [
			        thisData, src,
				CL.mkBinOp(mkInt len, CL.#*, CL.mkSizeof realTy)
			      ])
		    (* loop for initializing tensor from an initializer_list *)
		      val copyFromInitializerList = [
			      CL.mkDeclInit(CL.int32, "i", CL.mkInt 0),
			      CL.mkFor(
				CL.T_Named "auto",
				[("it", CL.mkDispatch(CL.mkVar "il", "begin", []))],
				CL.mkBinOp(CL.mkVar "it", CL.#!=, CL.mkDispatch(CL.mkVar "il", "end", [])),
				[CL.mkUnOp(CL.%++, CL.mkVar "i"), CL.mkUnOp(CL.%++, CL.mkVar "it")],
				CL.mkAssign(
				  CL.mkSubscript(thisData, CL.mkVar "i"),
				  CL.mkUnOp(CL.%*, CL.mkVar "it")))
			    ]
		    (* default constructor *)
		      val constrDcl1 = CL.D_Constr ([], [], name, [], SOME([], CL.mkBlock[]))
		    (* constructor from initializer list *)
		      val constrDcl2 = CL.D_Constr([], [], name,
			    [CL.PARAM([], CL.T_Template("std::initializer_list", [realTy]), "il")],
			    SOME([], CL.mkBlock copyFromInitializerList))
		    (* constructor from float/double pointer *)
		      val constrDcl3 = CL.D_Constr([], [], name,
			    [CL.PARAM([], CL.constPtrTy realTy, "src")],
			    SOME([], copyFromArray (CL.mkVar "src")))
		    (* copy constructor *)
		      val constrDcl4 = CL.D_Constr([], [], name,
			    [CL.PARAM([], CL.T_Named(name ^ " const &"), "ten")],
			    SOME([], copyFromArray (CL.mkSelect(CL.mkVar "ten", "_data"))))
		    (* destructor *)
		      val destrDcl = CL.D_Destr([], [], name, SOME(CL.mkBlock[]))
		    (* assignment from Tensor *)
		      val (assignProto1, assignDef1) = mkMemberFn(name,
			      CL.T_Named(name ^ " &"), "operator=",
			      [CL.PARAM([], CL.T_Named name, "const & src")],
			      CL.mkBlock[
				  copyFromArray(CL.mkSelect(CL.mkVar "src", "_data")),
				  returnThis
				])
		    (* assignment from TensorRef *)
		      val (assignProto2, assignDef2) = mkMemberFn(name,
			      CL.T_Named(name ^ " &"), "operator=",
			      [CL.PARAM([], CL.T_Named(RN.tensorRefStruct shape), "const & src")],
			      CL.mkBlock[
				  copyFromArray(CL.mkSelect(CL.mkVar "src", "_data")),
				  returnThis
				])
		    (* assignment from initializer list *)
		      val (assignProto3, assignDef3) = mkMemberFn(name,
			      CL.T_Named(name ^ " &"), "operator=",
			      [CL.PARAM([], CL.T_Template("std::initializer_list", [realTy]), "il")],
			      CL.mkBlock(copyFromInitializerList @ [returnThis]))
		    (* subscript operator *)
		      val subscriptDcl = CL.D_Func([], CL.T_Named(realTyName ^ " &"), [], "operator[]",
			    [CL.PARAM([], CL.uint32, "i")],
			    CL.mkReturn(SOME(CL.mkSubscript(thisData, CL.mkVar "i"))))
		    (* address at function *)
		      val addrAtDcl = CL.D_Func([], CL.constPtrTy realTy, [], "addr",
			    [CL.PARAM([], CL.uint32, "i")],
			    CL.mkReturn(SOME(CL.mkAddrOf(CL.mkSubscript(thisData, CL.mkVar "i")))))
		    (* last vector as tensor_ref *)
		      val lastDcl = (case shape
			    of [] => raise Fail "unexpected TensorTy[]"
			     | [_] => []
			     | _::dd => let
				val d = List.last dd
				in [
				  CL.D_Func([], RN.tensorRefTy[d], [], "last",
				      [CL.PARAM([], CL.uint32, "i")],
				      CL.mkReturn(
					SOME(CL.mkAddrOf(CL.mkSubscript(thisData, CL.mkVar "i")))))
				] end
			    (* end case *))
		      val structDcl = CL.D_ClassDef{
			      name = name,
			      args = NONE,
			      from = NONE,
			      public =
				  CL.mkVarDcl(CL.T_Array(realTy, SOME len), "_data") ::
				  constrDcl1 :: constrDcl2 :: constrDcl3 :: constrDcl4 ::
				  destrDcl ::
				  assignProto1 :: assignProto2 :: assignProto3 ::
				  subscriptDcl ::
				  addrAtDcl ::
				  lastDcl,
			      protected = [],
			      private = []
			    }
		      val fnDefs = assignDef3 :: assignDef2 :: assignDef1 :: fnDefs
		      in
			(structDcl :: tyDcls, fnDefs)
		      end
		  | Ty.TupleTy tys => raise Fail "FIXME: TupleTy"
(* TODO
		  | Ty.SeqTy(ty, NONE) =>
		  | Ty.SeqTy(ty, SOME n) =>
*)
		  | ty => (tyDcls, fnDefs)
		(* end case *))
	  in
	    genDecl
	  end

    fun genSeqTrait env = let
	  val ns = #namespace(Env.target env)
	  val realTy = Env.realTy env
	  fun trType ty = TypeToCxx.trQType(env, TypeToCxx.NSDiderot, ty)
	  fun trait ({argTy, baseTy, elemTy, ndims, dims}, dcls) = let
	      (* the name of the teem function table for the given base type *)
		val loadTbl = (case baseTy
		       of Ty.BoolTy => "nrrdILoad"
			| Ty.IntTy => "nrrdILoad"
			| Ty.VecTy(1, 1) => if #double(Env.target env)
			    then "nrrdDLoad"
			    else "nrrdFLoad"
			| ty => raise Fail("genSeqTrait.loadFn: unexpected type " ^ Ty.toString ty)
		      (* end case *))
		val loadTblTy = CL.constPtrTy(CL.T_Named "__details::load_fn_ptr<base_type>")
		val dimArrTy = CL.T_Array(CL.uint32, SOME ndims)
		val seqTy = CL.T_Template("dynseq_traits", [argTy])
		val scope = CL.SC_Type seqTy
		in
		  CL.D_Template([], CL.D_ClassDef{
		      name = "dynseq_traits",
		      args = SOME[argTy],
		      from = NONE,
		      public = [
			  CL.D_Typedef("value_type", elemTy),
			  CL.D_Typedef("base_type", trType baseTy),
			  CL.D_Var(
			    ["static"],
			    CL.constPtrTy(CL.T_Named "__details::load_fn_ptr<base_type>"),
			    [], "load_fn_tbl", NONE),
			  CL.D_Var(
			    ["static", "const"], CL.uint32, [], "ndims", SOME(CL.I_Exp(mkInt ndims))),
			  CL.D_Var(
			    ["static", "const"], dimArrTy, [], "dims", NONE)
			],
		      protected = [],
		      private = []
		    }) ::
		  CL.D_Var(
		    ["const"],
		    CL.T_Ptr(
		      CL.T_Template("__details::load_fn_ptr", [CL.T_Member(seqTy, "base_type")])),
		    [scope], "load_fn_tbl",
		    SOME(CL.I_Exp(CL.mkVar loadTbl))) ::
		  CL.D_Var(
		    ["const"], dimArrTy, [scope], "dims",
		    SOME(CL.I_Exps(List.map (CL.I_Exp o mkInt) dims))) ::
		  dcls
		end
	  fun genTrait (ty, dcls) = (case ty
		 of Ty.SeqTy(argTy, NONE) => let
		      fun baseTy (Ty.SeqTy(ty, _)) = baseTy ty
			| baseTy (Ty.TensorTy[]) = Ty.realTy
			| baseTy ty = ty
		      val argTy = trType argTy
		    (* for sequences of scalar values, we set nDims to 0 so that it matches the
		     * format of a nrrd, where the dimension is not represented.
		     *)
		      fun scalarSeqTrait ty = trait ({
				argTy = argTy, baseTy = ty, elemTy = argTy,
				ndims = 0, dims = []
			      },
			    dcls)
		      in
			case baseTy ty
			 of ty as Ty.TensorTy(shp as _::_) => trait ({
				  argTy = argTy, baseTy = Ty.realTy,
				  elemTy = argTy, ndims = List.length shp,
				  dims = shp
				},
			      dcls)
			  | ty as Ty.BoolTy => scalarSeqTrait ty
			  | ty as Ty.IntTy => scalarSeqTrait ty
			  | ty as Ty.VecTy(1, 1) => scalarSeqTrait ty
			  | ty => raise Fail "FIXME: unsupported dynamic sequence type"
			(* end case *)
		      end
		  | _ => dcls
		(* end case *))
	  in
	    genTrait
	  end

    datatype operation = datatype CollectInfo.operation

    val ostreamRef = CL.T_Named "std::ostream&"

    fun output (e, e') = CL.mkBinOp(e, CL.#<<, e')

  (* generate code for the expression "e << s", where "s" is string literal *)
    fun outString (CL.E_BinOp(e, CL.#<<, CL.E_Str s1), s2) =
	  output (e, CL.mkStr(s1 ^ String.toCString s2))
      | outString (e, s) = output (e, CL.mkStr(String.toCString s))

  (* generate a printing function for tensors with the given shape *)
    fun genTensorPrinter shape = let
	  fun ten i = CL.mkSubscript(CL.mkSelect(CL.mkVar "ten", "_data"), mkInt i)
	  fun prefix (true, lhs) = lhs
	    | prefix (false, lhs) = outString(lhs, ",")
	  fun lp (isFirst, lhs, i, [d]) = let
		fun lp' (_, lhs, i, 0) = (i, outString(lhs, "]"))
		  | lp' (isFirst, lhs, i, n) =
		      lp' (false, output (prefix (isFirst, lhs), ten i), i+1, n-1)
		in
		  lp' (true, outString(lhs, "["), i, d)
		end
	    | lp (isFirst, lhs, i, d::dd) = let
		fun lp' (_, lhs, i, 0) = (i, outString(lhs, "]"))
		  | lp' (isFirst, lhs, i, n) = let
		      val (i, lhs) = lp (true, prefix (isFirst, lhs), i, dd)
		      in
			lp' (false, lhs, i, n-1)
		      end
		in
		  lp' (true, outString(lhs, "["), i, d)
		end
	  val params = [
		  CL.PARAM([], ostreamRef, "outs"),
		  CL.PARAM([], RN.tensorRefTy shape, "const & ten")
		]
	  val (_, exp) = lp (true, CL.mkVar "outs", 0, shape)
	  in
	    CL.D_Func(["static"], ostreamRef, [], "operator<<", params, mkReturn exp)
	  end

  (* builds AST for the statememt "return (x <= lo) ? lo : (hi < x) ? hi : x;" *)
    fun mkClampStm (x, lo, hi) =
	  mkReturn(
	    CL.mkCond(CL.mkBinOp(x, CL.#<=, lo), lo,
	      CL.mkCond(CL.mkBinOp(hi, CL.#<, x), hi,
		x)))

    fun mkLerp (ty, name, realTy, mkT) = mkFunc(
	  ty, name,
	  [CL.PARAM([], ty, "a"), CL.PARAM([], ty, "b"), CL.PARAM([], realTy, "t")],
	  mkReturn (
	    CL.mkBinOp(
	      CL.mkVar "a",
	      CL.#+,
	      CL.mkBinOp(
		mkT(CL.mkVar "t"),
		CL.#*,
		CL.mkBinOp(CL.mkVar "b", CL.#-, CL.mkVar "a")))))

    fun doOp env (rator, dcls) = let
	  val realTy = Env.realTy env
	  fun mkVec (w, pw, f) = CL.mkVec(
		RN.vecTy w,
		List.tabulate(pw, fn i => if i < w then f i else CL.mkFlt(zero, realTy)))
	  fun mkVMap (ty, name, f, w, pw) = let
		fun f' i = CL.mkApply(f, [CL.mkSubscript(CL.mkVar "v", mkInt i)])
		in
		  mkFunc(ty, name, [CL.PARAM([], ty, "v")], mkReturn (mkVec (w, pw, f')))
		end
	  val dcl = (case rator
		 of Print(Ty.TensorRefTy shape) => genTensorPrinter shape
		  | Print(Ty.TupleTy tys) => raise Fail "FIXME: printer for tuples"
		  | Print(Ty.SeqTy(ty, NONE)) => raise Fail "FIXME: printer for dynseq"
		  | Print(Ty.SeqTy(ty, SOME n)) => raise Fail "FIXME: printer for sequence"
		  | Print ty => CL.D_Verbatim[] (* no printer needed *)
		  | RClamp => let
		      val name = "clamp"
		      val params = [
			      CL.PARAM([], realTy, "x"),
			      CL.PARAM([], realTy, "lo"),
			      CL.PARAM([], realTy, "hi")
			    ]
		      in
			mkFunc(realTy, name, params,
			  mkClampStm (CL.mkVar "x", CL.mkVar "lo", CL.mkVar "hi"))
		      end
		  | RLerp => mkLerp (realTy, "lerp", realTy, fn x => x)
		  | VScale(w, pw) => let
		      val cTy = RN.vecTy w
		      in
			mkFunc(cTy, RN.vscale w,
			  [CL.PARAM([], realTy, "s"), CL.PARAM([], cTy, "v")],
			  mkReturn(
			    CL.mkBinOp(mkVec(w, pw, fn _ => CL.mkVar "s"), CL.#*, CL.mkVar "v")))
		      end
		  | VSum(w, pw) => let
		      val name = RN.vsum w
		      val params = [CL.PARAM([], RN.vecTy w, "v")]
		      fun mkSum 0 = CL.mkSubscript(CL.mkVar "v", mkInt 0)
		        | mkSum i = CL.mkBinOp(mkSum(i-1), CL.#+, CL.mkSubscript(CL.mkVar "v", mkInt i))
		      in
			mkFunc(realTy, name, params, mkReturn(mkSum(w-1)))
		      end
		  | VDot(w, pw) => let
		      val name = RN.vdot w
		      val vTy = RN.vecTy w
		      val params = [CL.PARAM([], vTy, "u"), CL.PARAM([], vTy, "v")]
		      fun mkSum 0 = CL.mkSubscript(CL.mkVar "w", mkInt 0)
		        | mkSum i = CL.mkBinOp(mkSum(i-1), CL.#+, CL.mkSubscript(CL.mkVar "w", mkInt i))
		      in
			mkFunc(realTy, name, params,
			  CL.mkBlock[
			      CL.mkDeclInit(vTy, "w", CL.mkBinOp(CL.mkVar "u", CL.#*, CL.mkVar "v")),
			      mkReturn(mkSum(w-1))
			    ])
		      end
		  | VClamp(w, pw) => let
		      val cTy = RN.vecTy w
		      val name = RN.vclamp w
		      val params = [
			      CL.PARAM([], cTy, "v"),
			      CL.PARAM([], realTy, "lo"),
			      CL.PARAM([], realTy, "hi")
			    ]
		      fun mkInit x = SOME(CL.I_Exps(List.tabulate(pw,
			    fn i => CL.I_Exp(if i < w then x else CL.mkFlt(zero, realTy)))))
		      val loDcl = CL.mkDecl(cTy, "vlo", mkInit(CL.mkVar "lo"))
		      val hiDcl = CL.mkDecl(cTy, "vhi", mkInit(CL.mkVar "hi"))
		      in
			mkFunc(cTy, name, params,
			  CL.mkBlock [
			      loDcl, hiDcl,
			      mkClampStm (CL.mkVar "v", CL.mkVar "vlo", CL.mkVar "vhi")
			    ])
		      end
		  | VMapClamp(w, pw) => let
		      val cTy = RN.vecTy w
		      val name = RN.vclamp w
		      val params = [
			      CL.PARAM([], cTy, "v"),
			      CL.PARAM([], cTy, "vlo"),
			      CL.PARAM([], cTy, "vhi")
			    ]
		      in
			mkFunc(cTy, name, params,
			  mkClampStm (CL.mkVar "v", CL.mkVar "vlo", CL.mkVar "vhi"))
		      end
		  | VLerp(w, pw) =>
		      mkLerp (RN.vecTy w, RN.vlerp w, realTy, fn x => mkVec(w, pw, fn i => x))
		  | VCeiling(w, pw) => mkVMap (RN.vecTy w, RN.vceiling w, "std::ceiling", w, pw)
		  | VFloor(w, pw) => mkVMap (RN.vecTy w, RN.vfloor w, "std::floor", w, pw)
		  | VRound(w, pw) => mkVMap (RN.vecTy w, RN.vround w, "std::round", w, pw)
		  | VTrunc(w, pw) => mkVMap (RN.vecTy w, RN.vtrunc w, "std::trunc", w, pw)
		  | VToInt(w, pw) => let
		      val intTy = Env.intTy env
		      in
			mkFunc(CL.voidTy, RN.vtoi w,
			  [ CL.PARAM([], CL.T_Array(intTy, SOME w), "dst"),
			    CL.PARAM([], RN.vecTy w, "src")],
			  CL.mkBlock(List.tabulate (w,
			    fn i => CL.mkAssign(
			      CL.mkSubscript(CL.mkVar "dst", mkInt i),
			      CL.mkCons(intTy, [CL.mkSubscript(CL.mkVar "src", mkInt i)])))))
		      end
		  | VLoad(w, pw) => let
		      val name = RN.vload w
		      val cTy = RN.vecTy w
		      fun arg i = CL.mkSubscript(CL.mkVar "vp", mkInt i)
		      in
			mkFunc(cTy, name,
			  [CL.PARAM(["const"], CL.T_Ptr realTy, "vp")],
			  mkReturn(mkVec (w, pw, arg)))
		      end
		  | VCons(w, pw) => let
		      val name = RN.vcons w
		      val cTy = RN.vecTy w
		      val params = List.tabulate(w, fn i => CL.PARAM([], realTy, "r"^Int.toString i))
		      fun arg i = CL.mkVar("r"^Int.toString i)
		      in
			mkFunc(cTy, name, params, mkReturn(mkVec (w, pw, arg)))
		      end
		  | VPack layout => let
		      val name = RN.vpack (#wid layout)
		      val vParamTys = Ty.piecesOf layout
		      val vParams = List.mapi
			    (fn (i, Ty.VecTy(w, _)) => CL.PARAM([], RN.vecTy w, "v"^Int.toString i))
			      vParamTys
		      val dstTy = RN.tensorTy[#wid layout]
		      fun mkAssign (i, v, j) =
			    CL.mkAssign(
			      CL.mkSubscript(CL.mkSelect(CL.mkVar "dst", "_data"), mkInt i),
			      CL.mkSubscript(v, mkInt j))
		      fun mkAssignsForPiece (dstStart, pieceIdx, wid, stms) = let
			    val piece = CL.mkVar("v"^Int.toString pieceIdx)
			    fun mk (j, stms) = if (j < wid)
				  then mk (j+1, mkAssign (dstStart+j, piece, j) :: stms)
				  else stms
			    in
			      mk (0, stms)
			    end
		      fun mkAssigns (_, [], _, stms) = CL.mkBlock(List.rev stms)
			| mkAssigns (i, Ty.VecTy(w, _)::tys, offset, stms) =
			    mkAssigns (i+1, tys, offset+w, mkAssignsForPiece(offset, i, w, stms))
		      in
			mkFunc(CL.voidTy, name,
			  CL.PARAM([], dstTy, "&dst") :: vParams,
			  mkAssigns (0, vParamTys, 0, []))
		      end
		  | TensorCopy shp => CL.D_Verbatim[]
(*
		  | TensorCopy shp => let
		      val name = RN.tensorCopy shp
		      val dim = List.foldl Int.* 1 shp
		      val dstTy = CL.T_Array(realTy, SOME dim)
		      in
			mkFunc(CL.voidTy, name,
			  [CL.PARAM([], dstTy, "dst"), CL.PARAM([], CL.constPtrTy realTy, "src")],
			  CL.mkCall("std::memcpy", [
			      CL.mkVar "dst", CL.mkVar "src", CL.mkSizeof dstTy
			    ]))
		      end
*)
		  | Transform d => let
		      val e = CL.mkDispatch(CL.mkVar "img", "world2image", [])
		      val (resTy, e) = if (d = 1)
			    then (realTy, e)
			    else let val ty = RN.tensorRefTy[d, d]
			      in (ty, CL.mkCons(ty, [e])) end
		      in
			mkFunc(resTy, "world2image",
			  [CL.PARAM([], CL.T_Template(RN.qImageTyName d, [realTy]), "const & img")],
			  CL.mkReturn(SOME e))
		      end
		  | Translate d => let
		      val e = CL.mkDispatch(CL.mkVar "img", "translate", [])
		      val (resTy, e) = if (d = 1)
			    then (realTy, e)
			    else let val ty = RN.tensorRefTy[d]
			      in (ty, CL.mkCons(ty, [e])) end
		      in
			mkFunc(resTy, "translate",
			  [CL.PARAM([], CL.T_Template(RN.qImageTyName d, [realTy]), "const & img")],
			  CL.mkReturn(SOME e))
		      end
		(* end case *))
	  in
	    dcl :: dcls
	  end

    val first = CL.D_Comment["***** Begin synthesized types and operations *****"]
    val last = CL.D_Comment["***** End synthesized types and operations *****"]
    val noDcls = CL.D_Comment["***** No synthesized types or operations *****"]

    fun gen (env, info) = let
	  val spec = Env.target env
	  val genTrait = genSeqTrait env
	  val genTyDecl = genTyDecl env
	  val opDcls = List.foldl (doOp env) [] (CollectInfo.listOps info)
	  val tys = CollectInfo.listTypes info
	  val (tyDcls, fnDefs) = List.foldr genTyDecl ([], []) tys
	  val dcls = tyDcls @ fnDefs @ opDcls
	  val traitDcls = List.foldl genTrait [] tys
	  in
	    if List.null dcls andalso List.null traitDcls
	      then [noDcls]
	      else let
		val res = [last]
		val res = if List.null traitDcls
		      then res
		      else CL.D_Namespace("diderot", traitDcls) :: res
		val res = if List.null dcls
		      then res
		      else CL.D_Namespace(#namespace(Env.target env), dcls) :: res
		in
		  first :: res
		end
	  end

  end

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