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-print.sml
ViewVC logotype

View of /branches/vis15/src/compiler/cxx-util/gen-print.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3868 - (download) (annotate)
Mon May 16 23:04:12 2016 UTC (3 years, 2 months ago) by jhr
Original Path: branches/vis15/src/compiler/c-util/gen-print.sml
File size: 3925 byte(s)
  Working on merge
(* gen-print.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 GenPrint : sig

    val genWrappers : TargetSpec.t * CollectInfo.t -> CLang.decl list

    val genPrintStm : CL.exp * TreeTypes.ty list * CL.exp list -> CL.stm;

  end = struct

    structure IR = TreeIR
    structure CL = CLang

    fun tensorStruct shape = "tensor_" ^ String.concatWithMap "_" Int.toString shape
    fun tensorTy shape = CL.Named(tensorStruct shape)

    fun genWrapper (spec : TargetSpec.t, ty, dcls) = (case ty
	   of Ty.TensorTy shape => let
		val realTy = if #double spec then CL.double else CL.float
		val len = List.foldl Int.* 1 shape
		val name = tensorStruct shape
		val structDcl = CL.D_ClassDef{
			name = name,
			from = NONE,
			public = [
			    CL.M_Var([], CL.T_Ptr realTy, "_data")
			  ]
			protected = [],
			private = []
		      }
		val constrDcl = CL.D_Func(
		      ["inline"], concat[name, "::", name],
		      [PARAM([], CL.T_Array(realTy, SOME len), "data")],
		      CL.mkAssign(CL.mkIndirect(CL.mkVar "this", "_data"), CL.mkVar "data"))
		in
		  structDcl :: constrDcl :: dcls
		end
	    | Ty.TupleTy tys => raise Fail "FIXME: TupleTy"
(* TODO
	    | Ty.SeqTy(ty, NONE) =>
	    | Ty.SeqTy(ty, SOME n) =>
*)
	    | ty => dcls
	  (* end case *))

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

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

  (* generate code for the expression "e << s", where "s" is string literal *)
    fun outString (CL.BinOp(e, CL.#<<, CL.E_Str s1), s2) =
	  output (e, CL.E_Str(s1 ^ String.toCString s2))
      | outString (e, s) = output (e, CL.E_Str(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(IntLit.fromInt 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([], outstreamRef, "outs"),
		  CL.PARAM([], tensorTy shape, "ten")
		]
	  val stm = CL.mkReturn (lp (true, CL.mkVar "outs", 0, shape))
	  in
	    CL.D_Func(["static"], ostreamRef, "operator<<", [], stm)
	  end

    fun genPrinter (ty, dcls) = (case ty
	   of Ty.TensorTy shape => genTensorPrinter shape :: dcls
	    | Ty.TupleTy tys => raise Fail "FIXME: printer for tuples"
(* the following two types will be handled by template expansion
	    | Ty.SeqTy(ty, NONE) =>
	    | Ty.SeqTy(ty, SOME n) =>
*)
	    | ty => dcls
	  (* end case *))

    fun genWrappers (spec, info) = let
	  fun gen (ty, true, (wrapDcls, prDcls)) = let
		val wrapDcls = genWrapper (spec, ty, wrapDcls)
		val prDcls = genPrinter (ty, prDcls)
		in
		  (wrapDcls, prDcls)
		end
	  val (wrapDcls, prDcls) = CollectInfo.foldOverTypes gen ([], []) info
	  in
	    wrapDcls @ prDcls
	  end

    fun genPrintStm (outS, tys, args) = let
	  fun mkExp (lhs, [], []) = CL.mkBinOp(lhs, CL.#<<, CL.mkVar "std::end")
	    | mkExp (lhs, ty::tys, e::es) = let
	      (* if necessary, wrap the argument so that the correct "<<" instance is used *)
		val e = (case ty
		       of Ty.TensorTy shape => CL.mkApply(tensorStruct shape, [e])
			| _ => e
		      (* end case *))
		in
		  CL.mkExpStm (mkExp (CL.mkBinOp(lhs, CL.#<<, e), tys, es))
		end
	  in
	  end

  end

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