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

SCM Repository

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

View of /branches/vis15/src/compiler/tree-to-c/gen-type-wrappers.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3867 - (download) (annotate)
Mon May 16 21:33:24 2016 UTC (3 years, 2 months ago) by jhr
File size: 3171 byte(s)
  working on merge: code generation
(* gen-type-wrappers.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 GenTypeWrappers : sig

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

  end = struct

    structure Ty = TreeTypes
    structure CL = CLang

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

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

    fun genWrapper ((ty, _), dcls) = (case ty
	   of Ty.TensorTy[shape] => let
		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 *))

    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, true), 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 *))
      | genPrinter _ = dcls

    fun gen info = let
	  val tys = CollectInfo.listTypes info
	  in
	    List.foldr genWrapper (List.foldr genPrinter [] tys) tys
	  end

  end

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