(* 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 : TargetUtil.target_desc * 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 : TargetUtil.target_desc * input_desc list -> CLang.decl list
(*** Support for libraries ***)
(* generate the typedef for the defined-input flag struct. *)
val genDefinedInpStruct : TargetUtil.target_desc * 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 : 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 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")
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 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 : 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 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) = let
val lhs = CL.mkIndirect(inpV, name)
val rhs = TreeToC.trExp (TreeIL.Var.Map.empty, dflt)
in
SOME(CL.mkAssign(lhs, rhs))
end
| initInput _ = NONE
in
CL.D_Func(
["static"], CL.voidTy, N.initDefaults,
[CL.PARAM([], inputPtrTy, "inp")],
CL.mkBlock(List.mapPartial initInput inputs))
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, optDflt) = CL.mkCall(N.input ty, [
optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
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"
(* 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) = CL.mkCall("dummy", [
optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
CL.mkUnOp(CL.%&, global name),
CL.mkBool(Option.isSome optDflt)
]) :: stms
| initInput ((Ty.ImageTy info, name, desc, optDflt), stms) = CL.mkCall("dummy", [
optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
CL.mkUnOp(CL.%&, global name),
CL.mkBool(Option.isSome optDflt)
]) :: stms
| 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 : target_desc, 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 => (case ty
of Ty.DynSeqTy _ => raise Fail "DynSeqTy"
| Ty.ImageTy info =>
GenLoadNrrd.loadImage (global name, info, ToC.trExp(ToC.empty, v))
| _ => CL.mkBlock(ToC.trAssign(ToC.empty, global name, v))
(* end case *))
| 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)
(* 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.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))))
] 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(
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