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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3810 - (download) (annotate)
Tue May 3 23:26:44 2016 UTC (3 years ago) by jhr
File size: 7877 byte(s)
  Working on merge
(* gen-inputs-util.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2015 The University of Chicago
 * All rights reserved.
 *)

structure GenInputsUtil : sig

  (* input variable descriptor: type, name, description, and default *)
    type input_desc = (TreeIR.global_var * string * string option * TreeIR.exp option)

    val gatherInputs : TreeIR.block -> input_desc list

  (* an l-value expression for accessing a defined-input flag for the given global input *)
    val defined : TreeIR.global_var -> CLang.exp

  (*** 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.t * input_desc list -> CLang.decl list

  (* generate the common 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
   * These will be extended with a target-specific InitInputs function.
   *)
    val genExecInputFuns : Properties.t * input_desc list -> CLang.decl list

  (*** Support for libraries ***)

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

  (* generate the function that initializes the defined-input flag struct. *)
    val genDefineInp : Properties.t * input_desc list -> CLang.decl

  end = struct

    structure IR = TreeIR
    structure Ty = TreeTypes
    structure GVar = IR.GlobalVar
    structure CL = CLang
    structure RN = RuntimeNames
    structure ToC = TreeToC
    structure TrTy = CTyTranslate

    type input_desc = (TreeIR.global_var * string * string option * IR.exp option)

  (* translate a TreeIR 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 gv = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "definedInp"), GVar.name gv)

  (* gather the input globals from the input initialization block *)
    fun gatherInputs (IR.Block{body, ...}) = let
          fun inputInfo cvt (x, name, desc, NONE) = SOME(x, name, desc, NONE)
            | inputInfo cvt (x, name, desc, SOME v) = SOME(x, name, desc, SOME(cvt v))
          fun gather (IR.S_Input inp) = inputInfo (fn e => e) inp
            | gather (IR.S_InputNrrd inp) = inputInfo (fn s => TreeIR.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 (_, []) = []
      | genInputsStruct (tgt : Properties.t, inputs) = let
          fun mkField (gv, _, _, _) = (case GVar.ty gv
                 of Ty.SeqTy(_, NONE) => (CL.charPtr, GVar.name gv)
                  | Ty.ImageTy _ => (CL.charPtr, GVar.name gv)
                  | ty => (trType ty, GVar.name gv)
                (* end case *))
          in
            [CL.D_StructDef(NONE, List.map mkField inputs, SOME(RN.inputsTyName 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 (TreeIR.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], TreeIR.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.SeqTy(_, NONE), _) => simpleInit ()
                | (Ty.ImageTy _, _) => simpleInit ()
                | _ => let
                    val (tmp, stm) = TreeToC.expToVar(TreeIR.Var.Map.empty, CTyTranslate.toType ty, "tmp", src)
                    in
                      stm @ CTyTranslate.copyToC{ty = ty, dst=dst, src=tmp}
                    end
              (* end case *)
            end
    in
  (* generate code to initialize the default input values *)
    fun genInitDefaults (tgt, inputs) = let
        (* the inputs pointer type *)
          val inputPtrTy = RN.inputsPtrTy tgt
        (* some common variables *)
          val inpV = CL.mkVar "inp"
        (* initialize a given input *)
          fun initInput ((gv, name, _, SOME dflt), stms) = let
                val lhs = CL.mkIndirect(inpV, GVar.name gv)
                in
                  initC {ty=GVar.ty gv, dst=lhs, src=dflt} @ stms
                end
            | initInput (_, stms) = stms
          in
            CL.D_Func(
              ["static"], CL.voidTy, RN.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 = RN.inputsPtrTy tgt
        (* some common variables *)
          val inpV = CL.mkVar "inp"
          val optsV = CL.mkVar "opts"
        (* register a given input *)
          fun registerInput (gv, name, desc, optDflt) = CL.mkCall(RN.inputOpt(GVar.ty gv), [
                  optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
                  if TrTy.isCArrayTy(GVar.ty gv)
                    then CL.mkIndirect(inpV, GVar.name gv)
                    else CL.mkUnOp(CL.%&, CL.mkIndirect(inpV, GVar.name gv)),
                  CL.mkBool(Option.isSome optDflt)
                ])
          in
            CL.D_Func(
              ["static"], CL.voidTy, RN.registerOpts,
              [CL.PARAM([], inputPtrTy, "inp"), CL.PARAM([], RN.optionsPtrTy, "opts")],
              CL.mkBlock(List.map registerInput inputs))
          end

  (* generate the common 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
   * These will be extended with a target-specific InitInputs function.
   *)
    fun genExecInputFuns (_, []) = []
      | genExecInputFuns arg = [
            genInitDefaults arg,
            genRegisterInputs arg
          ]

  (* generate the typedef for the defined-input flag struct. *)
    fun genDefinedInpStruct (_, []) = []
      | genDefinedInpStruct (tgt : Properties.t, inputs) = let
          fun mkField (gv, _, _, _) = (CL.boolTy, GVar.name gv)
          in
            [CL.D_StructDef(NONE, List.map mkField inputs, SOME(RN.definedInpTyName tgt))]
          end

  (* generate the function that initializes the defined-input flag struct. *)
    fun genDefineInp (tgt, inputs) = let
        (* the world pointer type *)
          val worldPtrTy = RN.worldPtrTy tgt
          val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
          fun initFlag (gv, _, _, _) = CL.mkAssign(defined gv, CL.mkBool false)
          in
            CL.D_Func(
              ["static"], CL.voidTy, RN.initDefined tgt,
              [wrldParam],
              CL.mkBlock(List.map initFlag inputs))
          end

  end

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