(* 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 * bool)

    val gatherInputs : TreeIL.block -> input_desc list

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

  (* generate a function to register command-line options for setting the input variables *)
    val genRegisterInputs : TargetUtil.target_desc * input_desc list -> CLang.decl

  (* generate a function to initialize the global input variables from the command-line inputs *)
    val genInitInputs : TargetUtil.target_desc * input_desc list -> CLang.decl

  (* generated the functions to initialize inputs for the library API *)
    val genInputFuns : TargetUtil.target_desc * input_desc list -> CLang.decl list

  end = struct

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

    type input_desc = (Ty.ty * string * string option * bool)

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

    type target_desc = TargetUtil.target_desc

  (* 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 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 (x, name, desc, NONE) = SOME(IL.Var.ty x, name, desc, false)
	    | inputInfo (x, name, desc, SOME _) = SOME(IL.Var.ty x, name, desc, true)
          fun gather (IL.S_Input inp) = inputInfo inp
            | gather (IL.S_InputNrrd inp) = inputInfo 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 : target_desc, 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

  (* 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, hasDflt) = CL.mkCall(N.input ty, [
		  optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
		  CL.mkUnOp(CL.%&, CL.mkIndirect(inpV, name)),
		  CL.mkBool hasDflt
		])
	  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 globV = CL.mkVar "glob"
	  val optsV = CL.mkVar "opts"
	(* 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, hasDflt) = CL.mkCall("dummy", [
		  optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
		  CL.mkUnOp(CL.%&, CL.mkIndirect(globV, name)),
		  CL.mkBool hasDflt
		])
	    | initInput (Ty.ImageTy info, name, desc, hasDflt) = CL.mkCall("dummy", [
		  optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
		  CL.mkUnOp(CL.%&, CL.mkIndirect(globV, name)),
		  CL.mkBool hasDflt
		])
	    | initInput (ty, name, _, _) =
		CL.mkAssign(CL.mkIndirect(globV, name), CL.mkIndirect(inpV, name))
	  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.map initInput inputs))
	  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, hasDflt) = 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 hasDflt
                        then let
                          val getName = N.inputGet(tgt, name)
                        (* convert the input type to a by-reference C type *)
                          val outTy = (case ty
                                 of Ty.BoolTy => CL.T_Ptr(trType ty)
                                  | Ty.StringTy => CL.T_Ptr(trType ty)
                                  | Ty.IntTy => CL.T_Ptr(trType ty)
                                  | Ty.TensorTy[] => CL.T_Ptr(trType ty)
                                  | Ty.TensorTy _ => trType ty
                                  | Ty.SeqTy _ => trType ty
                                  | Ty.DynSeqTy _ => CL.T_Ptr(trType ty)
                                  | Ty.ImageTy _ => CL.T_Ptr CL.charPtr
                                  | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
                                (* end case *))
                          in [
                            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}))
                          ] end
                        else []
                val setDcl = (case ty
                       of Ty.ImageTy info => let
                            val dim = ImageInfo.dim info
                            in [
                              CL.D_Func(
                                [], CL.boolTy, N.inputSetByName(tgt, name),
                                [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
                                CL.mkBlock[
(* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
                                    CL.mkReturn(SOME(
                                      CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
                                        CL.mkApply(N.loadImage dim, [
                                            CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
                                            CL.mkVar "s", CL.mkUnOp(CL.%&, global name)
                                          ]))))
                                  ]),
                              CL.D_Func(
                                [], CL.boolTy, N.inputSet(tgt, name),
                                [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
                                CL.mkBlock[
(* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
                                    CL.mkReturn(SOME(
                                      CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
                                        CL.mkApply(N.setImage dim, [
                                            CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
                                            CL.mkVar "nin", CL.mkUnOp(CL.%&, global name)
                                          ]))))
                                  ])
                            ] end
(* dynamic sequence loader prototype:
Diderot_DynSeq_t *Diderot_DynSeqLoadTY (
    WorldPrefix_t *wrld,
    Nrrd *nin,
    unsigned int nDims,
    unsigned int *dims);
*)
(*
                        | Ty.DynSeqTy elemTy => [
                              CL.D_Func(
                                [], CL.boolTy, N.inputSetByName(tgt, name),
                                [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
                                CL.mkBlock[
                                    CL.mkReturn(SOME(
                                      CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
                                        CL.mkApply(N.loadSeq elemTy, [
                                            CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
                                            CL.mkVar "s", CL.mkUnOp(CL.%&, global name)
                                          ]))))
                                  ]),
                              CL.D_Func(
                                [], CL.boolTy, N.inputSet(tgt, name),
                                [wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
                                CL.mkBlock[
                                    CL.mkReturn(SOME(
                                      CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
                                        CL.mkApply(N.loadSeq elemTy, [
                                            CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
                                            CL.mkVar "nin", CL.mkUnOp(CL.%&, global name)
                                          ]))))
                                  ])
                            ]
*)
                        | Ty.DynSeqTy elemTy => raise Fail "dynamic input not supported yet"
                        | _ => [
                              CL.D_Func(
                                [], CL.boolTy, N.inputSet(tgt, name),
                                [wrldParam, CL.PARAM([], trType ty, "v")],
                                CL.mkBlock(
                                  TrTy.copyFromC{ty=ty, dst=global name, src=CL.mkVar "v"} @
                                    [CL.mkReturn(SOME(CL.mkVar "false"))]))
                            ]
                      (* end case *))
                in
                  descDcl @ getDcl @ setDcl
                end
          in
            List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) [] inputs
          end

  end