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

SCM Repository

[diderot] View of /branches/vis12/src/compiler/c-util/gen-inputs.sml
ViewVC logotype

View of /branches/vis12/src/compiler/c-util/gen-inputs.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2708 - (download) (annotate)
Sat Sep 20 18:46:49 2014 UTC (4 years, 10 months ago) by jhr
File size: 15296 byte(s)
  Merging some changes from the vis12-cl branch and fixing an issue with the
  dynamic sequence inputs.
(* gen-inputs.sml
 *
 * COPYRIGHT (c) 2012 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *)

structure GenInputs : sig

  (* input variable descriptor: type, name, description, has default *)
    type input_desc = (TreeIL.Ty.ty * string * string option * TreeIL.exp option)

    val gatherInputs : TreeIL.block -> input_desc list

  (*** Support for standalone executables ***)

  (* generate the input initialization structure that we use to initialize input
   * globals from command-line arguments in stand-alone executables.
   *)
    val genInputsStruct : Properties.props * input_desc list -> CLang.decl

  (* generate the functions that handle inputs for standalone executables.  These are:
   *	InitDefaults	-- called to initialize the default input values
   *	RegisterInputs	-- called to register the command-line options for the input globals
   *	InitInptus	-- called to initialize the input globals from the values specified
   *			   on the command line.
   *)
    val genExecInputFuns : Properties.props * input_desc list -> CLang.decl list

  (*** Support for libraries ***)

  (* generate the typedef for the defined-input flag struct. *)
    val genDefinedInpStruct : Properties.props * input_desc list -> CLang.decl

  (* generated the functions to initialize inputs for the library API.  This function also
   * generates the function to initialize the defined input flags struct.
   *)
    val genInputFuns : Properties.props * input_desc list -> CLang.decl list

  end = struct

    structure IL = TreeIL
    structure Ty = TreeIL.Ty
    structure CL = CLang
    structure N = CNames
    structure ToC = TreeToC
    structure TrTy = CTyTranslate

    type input_desc = (Ty.ty * string * string option * IL.exp option)

    val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
    val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")

  (* world pointer cast to the world prefix type *)
    val wrldPrefix = CL.mkCast(wrldPrefixTy, CL.mkVar "wrld")

    type props = Properties.props

  (* translate a TreeIL type to the C types used to represent it in the external API *)
    val trType = CTyTranslate.toCType

  (* an l-value expression for accessing a defined-input flag *)
    fun defined name = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "definedInp"), name)

  (* an l-value expression for accessing a global variable *)
    fun global name = CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld", "globals"), name)

  (* gather the input globals from the input initialization block *)
    fun gatherInputs (IL.Block{body, ...}) = let
	  fun inputInfo cvt (x, name, desc, NONE) =
		SOME(IL.Var.ty x, name, desc, NONE)
	    | inputInfo cvt (x, name, desc, SOME v) =
		SOME(IL.Var.ty x, name, desc, SOME(cvt v))
          fun gather (IL.S_Input inp) = inputInfo (fn e => e) inp
            | gather (IL.S_InputNrrd inp) = inputInfo (fn s => TreeIL.E_Lit(Literal.String s)) inp
            | gather _ = NONE
          in
            List.mapPartial gather body
          end

  (* generate the input initialization structure that we use to initialize input
   * globals from command-line arguments in stand-alone executables.
   *)
    fun genInputsStruct (tgt : props, inputs) = let
	  fun mkField (Ty.DynSeqTy _, name, _, _) = (CL.charPtr, name)
	    | mkField (Ty.ImageTy _, name, _, _) = (CL.charPtr, name)
	    | mkField (ty, name, _, _) = (trType ty, name)
	  in
	    CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.inputsTy tgt))
	  end

    local
      fun subscript (e, i) = CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i))

    (* initialize an external C representation from constant expressions *)
      fun initC {ty, dst, src} = let
	    fun cvtExp e = TreeToC.trExp (TreeIL.Var.Map.empty, e)
	    fun simpleInit () = [CL.mkAssign(dst, cvtExp src)]
	    in
	      case (ty, src)
	       of (Ty.BoolTy, _) => simpleInit ()
		| (Ty.StringTy, _) => simpleInit ()
		| (Ty.IntTy, _) => simpleInit ()
		| (Ty.TensorTy[], _) => simpleInit ()
		| (Ty.TensorTy[n], TreeIL.E_Cons(_, es)) => let
		    fun lp (_, []) = []
		      | lp (i, e::es) = CL.mkAssign(subscript(dst, i), cvtExp e) :: lp(i+1, es)
		    in
		      lp(0, es)
		    end
		| (Ty.DynSeqTy _, _) => simpleInit ()
		| _ => raise Fail(concat["CTyTranslate.initC(", Ty.toString ty, ") not supported yet"])
	      (* end case *)
	    end
    in
  (* generate code to initialize the default input values *)
    fun genInitDefaults (tgt, inputs) = let
	(* the inputs pointer type *)
	  val inputPtrTy = CL.T_Ptr(CL.T_Named(N.inputsTy tgt))
	(* some common variables *)
	  val inpV = CL.mkVar "inp"
	(* initialize a given input *)
	  fun initInput ((ty, name, _, SOME dflt), stms) = let
		val lhs = CL.mkIndirect(inpV, name)
		in
		  initC {ty=ty, dst=lhs, src=dflt} @ stms
		end
	    | initInput (_, stms) = stms
	  in
	    CL.D_Func(
	      ["static"], CL.voidTy, N.initDefaults,
	      [CL.PARAM([], inputPtrTy, "inp")],
	      CL.mkBlock(List.foldr initInput [] inputs))
	  end
    end (* local *)

  (* generate code to register command-line options for setting the input variables *)
    fun genRegisterInputs (tgt, inputs) = let
	(* the inputs pointer type *)
	  val inputPtrTy = CL.T_Ptr(CL.T_Named(N.inputsTy tgt))
	(* some common variables *)
	  val inpV = CL.mkVar "inp"
	  val optsV = CL.mkVar "opts"
	(* register a given input *)
	  fun registerInput (ty, name, desc, optDflt) = CL.mkCall(N.input ty, [
		  optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
		  if TrTy.isCArrayTy ty
		    then CL.mkIndirect(inpV, name)
		    else CL.mkUnOp(CL.%&, CL.mkIndirect(inpV, name)),
		  CL.mkBool(Option.isSome optDflt)
		])
	  in
	    CL.D_Func(
	      ["static"], CL.voidTy, N.registerOpts,
	      [CL.PARAM([], inputPtrTy, "inp"), CL.PARAM([], CL.T_Ptr(CL.T_Named N.optionsTy), "opts")],
	      CL.mkBlock(List.map registerInput inputs))
	  end

  (* generate code to initialize the global input variables from the command-line inputs *)
    fun genInitInputs (tgt, inputs) = let
	(* the world pointer type *)
	  val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
	(* the global state pointer type *)
	  val globPtrTy = CL.T_Ptr(CL.T_Named(N.globalTy tgt))
	(* the inputs pointer type *)
	  val inputPtrTy = CL.T_Ptr(CL.T_Named(N.inputsTy tgt))
	(* some common variables *)
	  val inpV = CL.mkVar "inp"
	  val optsV = CL.mkVar "opts"
	(* set to true if the initialization code uses a status variable *)
	  val usesStatus = ref false
	(* initialize a given input global; for sequences and images, this requires
	 * loading the value from the specified nrrd file, while for other types
	 * we just copy the values.
	 *)
	  fun initInput ((Ty.DynSeqTy elemTy, name, desc, optDflt), stms) = let
		val (loadFn, nDims, dims) = (case elemTy
		       of Ty.BoolTy => ("Diderot_DynSeqLoadBoolFromFile", CL.mkInt 0, CL.mkInt 0)
			| Ty.IntTy => ("Diderot_DynSeqLoadIntFromFile", CL.mkInt 0, CL.mkInt 0)
			| Ty.TensorTy[] => ("Diderot_DynSeqLoadRealFromFile", CL.mkInt 0, CL.mkInt 0)
			| Ty.TensorTy _ => raise Fail "TODO: sequences of tensors"
			| Ty.SeqTy elemTy => raise Fail "TODO: sequences of sequences"
			| _ => raise Fail "unsupported dynamic sequence type"
		      (* end case *))
		in
		  CL.mkAssign(global name,
		    CL.mkApply(loadFn, [
			wrldPrefix, CL.mkIndirect(inpV, name), nDims, dims
		      ])) :: stms
		end
	    | initInput ((Ty.ImageTy info, name, desc, optDflt), stms) = let
		val loadFn = (case ImageInfo.dim info
		       of 1 => "Diderot_LoadImage1D"
			| 2 => "Diderot_LoadImage2D"
			| 3 => "Diderot_LoadImage3D"
			| _ => raise Fail "image with dimension > 3"
		      (* end case *))
		in
		  CL.mkCall(loadFn, [
		      wrldPrefix, CL.mkIndirect(inpV, name), CL.mkAddrOf(global name)
		    ]) :: stms
		end
	    | initInput ((ty, name, _, _), stms) =
		TrTy.copyFromC{ty=ty, dst=global name, src=CL.mkIndirect(inpV, name)} @ stms
	  in
	    CL.D_Func(
	      ["static"], CL.voidTy, N.initInputs,
	      [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], inputPtrTy, "inp")],
	      CL.mkBlock(
		CL.mkDeclInit(globPtrTy, "glob", CL.mkIndirect(CL.mkVar "wrld", "globals")) ::
		List.foldr initInput [] inputs))
	  end

  (* generate the functions that handle inputs for standalone executables.  These are:
   *	InitDefaults	-- called to initialize the default input values
   *	RegisterInputs	-- called to register the command-line options for the input globals
   *	InitInptus	-- called to initialize the input globals from the values specified
   *			   on the command line.
   *)
    fun genExecInputFuns arg = [
	    genInitDefaults arg,
	    genRegisterInputs arg,
	    genInitInputs arg
	  ]

  (* generate the typedef for the defined-input flag struct. *)
    fun genDefinedInpStruct (tgt : props, inputs) = let
	  fun mkField (_, name, _, _) = (CL.boolTy, name)
	  in
	    CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.definedInpTy tgt))
	  end

    fun genDefineInp (tgt, inputs) = let
	(* the world pointer type *)
	  val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
          val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
	  fun initFlag (_, name, _, _) = CL.mkAssign(defined name, CL.mkBool false)
	  in
	    CL.D_Func(
	      ["static"], CL.voidTy, N.initDefined tgt,
	      [wrldParam],
	      CL.mkBlock(List.map initFlag inputs))
	  end

    fun genCheckInputs (tgt, inputs) = let
	(* the world pointer type *)
	  val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
          val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
	(* the inputs pointer type *)
	  fun check (ty, name, _, optDflt) = let
		val dfltStm = (case optDflt
		       of SOME v => let
			  (* get default file name for images and sequences *)
			    fun getName () = (case v
				   of IL.E_Lit(Literal.String s) => CL.mkStr s
				    | _ => raise Fail "expected string for default nrrd"
				  (* end case *))
			    in
			      case ty
			       of Ty.DynSeqTy elemTy =>
				    GenLoadNrrd.loadSeqFromFile (global name, elemTy, getName())
				| Ty.ImageTy info =>
				    GenLoadNrrd.loadImage (global name, info, getName())
				| _ => CL.mkBlock(ToC.trAssign(ToC.empty, global name, v))
			      (* end case *)
			    end
			| NONE => CL.mkBlock[
			      World.errorMsgAdd(CL.mkStr(concat["undefined input \"", name, "\"\n"])),
			      CL.mkReturn(SOME(CL.mkBool true))
			    ]
		      (* end case *))
		in
		  CL.mkIfThen(CL.mkUnOp(CL.%!, defined name), dfltStm)
		end
	  in
	    CL.D_Func(
	      ["static"], CL.boolTy, N.checkDefined tgt,
	      [wrldParam],
	      CL.mkBlock(List.map check inputs @ [CL.mkReturn(SOME(CL.mkBool false))]))
	  end

  (* for each input variable we generate two or three top-level declarations in the
   * exported API.
   *)
    fun genInputFuns (tgt, inputs) = let
	(* the world pointer type *)
	  val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
          val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
	(* create decls for an input variable *)
          fun mkInputDecls (ty, name, desc, optDflt) = let
              (* create a description declaration for the input variable *)
                val descDcl = (case desc
		       of SOME desc => [
			      CL.D_Var([], CL.T_Ptr(CL.T_Named "const char"),
				N.inputDesc(tgt, name),
				SOME(CL.I_Exp(CL.mkStr desc)))
			    ]
			| NONE => []
		      (* end case *))
                val getDcl = if (Option.isSome optDflt)
                        then let
                          val getName = N.inputGet(tgt, name)
			(* generate code for a function that returns the current value of
			 * an input global.
			 *)
			  fun mkFunc outTy = CL.D_Func([], CL.voidTy, getName,
				[wrldParam, CL.PARAM([], outTy, "v")],
				CL.mkBlock(TrTy.copyToC{
				    ty=ty, dst=CL.mkUnOp(CL.%*, CL.mkVar "v"),
				    src=global name
				  }))
(* FIXME: for images and sequences, it is not clear what the get function should return.
 * For now, we just return 0
 *)
			(* for images and sequences, we currently return 0 *)
			  fun nrrdFunc () = CL.D_Func([], CL.voidTy, getName,
				[wrldParam, CL.PARAM([], CL.T_Ptr CL.voidPtr, "v")],
				CL.mkAssign(CL.mkUnOp(CL.%*, CL.mkVar "v"), CL.mkInt 0))
                          val func = (case ty
                                 of Ty.BoolTy => mkFunc(CL.T_Ptr(trType ty))
                                  | Ty.StringTy => mkFunc(CL.T_Ptr(trType ty))
                                  | Ty.IntTy => mkFunc(CL.T_Ptr(trType ty))
                                  | Ty.TensorTy[] => mkFunc(CL.T_Ptr(trType ty))
                                  | Ty.TensorTy _ => mkFunc(trType ty)
                                  | Ty.SeqTy _ => mkFunc(trType ty)
                                  | Ty.DynSeqTy _ => nrrdFunc ()
                                  | Ty.ImageTy _ => nrrdFunc ()
                                  | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
                                (* end case *))
                          in
			    [func]
                          end
                        else []
                val setDcl = (case ty
                       of Ty.ImageTy info => [
                              CL.D_Func(
                                [], CL.boolTy, N.inputSetByName(tgt, name),
                                [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
				CL.appendStm(
				  GenLoadNrrd.loadImage (global name, info, CL.mkVar "s"),
				  CL.mkReturn(SOME(CL.mkBool false)))),
                              CL.D_Func(
                                [], CL.boolTy, N.inputSet(tgt, name),
                                [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
				CL.appendStm(
				  GenLoadNrrd.setImage (global name, info, CL.mkVar "nin"),
				  CL.mkReturn(SOME(CL.mkBool false))))
                            ]
			| Ty.DynSeqTy elemTy => [
                              CL.D_Func(
                                [], CL.boolTy, N.inputSetByName(tgt, name),
                                [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
				CL.appendStm(
				  GenLoadNrrd.loadSeqFromFile (global name, elemTy, CL.mkVar "s"),
				  CL.mkReturn(SOME(CL.mkBool false)))),
                              CL.D_Func(
                                [], CL.boolTy, N.inputSet(tgt, name),
                                [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
				CL.appendStm(
				  GenLoadNrrd.loadSeq (global name, elemTy, CL.mkVar "nin"),
				  CL.mkReturn(SOME(CL.mkBool false))))
			    ]
                        | _ => [
                              CL.D_Func(
                                [], CL.boolTy, N.inputSet(tgt, name),
                                [wrldParam, CL.PARAM([], trType ty, "v")],
                                CL.mkBlock(
				  CL.mkAssign(defined name, CL.mkBool true) ::
                                  TrTy.copyFromC{ty=ty, dst=global name, src=CL.mkVar "v"} @
                                    [CL.mkReturn(SOME(CL.mkVar "false"))]))
                            ]
                      (* end case *))
                in
                  (descDcl @ getDcl @ setDcl)
                end
	  val extras = [
		  genCheckInputs (tgt, inputs),
		  genDefineInp (tgt, inputs)
		]
          in
            List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) extras inputs
          end

  end

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