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

SCM Repository

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

Diff of /branches/vis15/src/compiler/cxx-util/gen-inputs-util.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 3896, Sun May 22 18:24:49 2016 UTC revision 3897, Sun May 22 20:39:23 2016 UTC
# Line 8  Line 8 
8    
9  structure GenInputsUtil : sig  structure GenInputsUtil : sig
10    
11    (* input variable descriptor: tree var, name, description, and default *)      type input_desc = TreeGlobalVar.t Inputs.input
     type input_desc = (TreeIR.global_var * string * string option * TreeIR.exp option)  
12    
13    (* an l-value expression for accessing a defined-input flag for the given global input *)    (* an l-value expression for accessing a defined-input flag for the given global input *)
14      val defined : TreeIR.global_var -> CLang.exp      val defined : TreeGlobalVar.t -> CLang.exp
15    
16    (*** Support for standalone executables ***)    (*** Support for standalone executables ***)
17    
   (* generate the input initialization structure that we use to initialize input  
    * globals from command-line arguments in stand-alone executables.  
    *)  
     val genInputsStruct : CodeGenEnv.t * input_desc list -> CLang.decl list  
   
18    (* generate the common functions that handle inputs for standalone executables.  These are:    (* generate the common functions that handle inputs for standalone executables.  These are:
19     *    InitDefaults    -- called to initialize the default input values     *    init_defaults    -- called to initialize the default input values
20     *    RegisterInputs  -- called to register the command-line options for the input globals     *    register_inputs  -- called to register the command-line options for the input globals
    * These will be extended with a target-specific InitInputs function.  
21     *)     *)
22      val genExecInputFuns : CodeGenEnv.t * input_desc list -> CLang.decl list      val genExecInputFuns : CodeGenEnv.t * TreeIR.program -> CLang.decl list
23    
24    (*** Support for libraries ***)    (*** Support for libraries ***)
25    
26    (* generate the typedef for the defined-input flag struct. *)    (* generate the typedef for the defined-input flag struct. *)
27      val genDefinedInpStruct : CodeGenEnv.t * input_desc list -> CLang.decl list      val genDefinedInpStruct : input_desc list -> CLang.decl list
28    
29    (* generate the function that initializes the defined-input flag struct. *)    (* generate the function that initializes the defined-input flag struct. *)
30      val genDefineInp : CodeGenEnv.t * input_desc list -> CLang.decl      val genDefineInp : input_desc list -> CLang.decl
31    
32    end = struct    end = struct
33    
34      structure IR = TreeIR      structure IR = TreeIR
35      structure Ty = TreeTypes      structure Ty = APITypes
36      structure GVar = TreeGlobalVar      structure GVar = TreeGlobalVar
37      structure CL = CLang      structure CL = CLang
38      structure ToC = TreeToCxx      structure ToC = TreeToCxx
39      structure Env = CodeGenEnv      structure Env = CodeGenEnv
40        structure Inp = Inputs
41    
42      type input_desc = (TreeIR.global_var * string * string option * IR.exp option)      type input_desc = GVar.t Inp.input
   
   (* translate a TreeIR type to the C types used to represent it in the external API *)  
     val trType = ToC.trAPIType  
   
   (* an l-value expression for accessing a defined-input flag *)  
     fun defined gv = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "definedInp"), GVar.name gv)  
43    
44    (* generate the input initialization structure that we use to initialize input      val worldPtrTy = CL.T_Ptr(CL.T_Named "world")
45     * globals from command-line arguments in stand-alone executables.      val globalPtrTy = CL.T_Ptr(CL.T_Named "globals")
    *)  
     fun genInputsStruct (_, []) = []  
       | genInputsStruct (env, 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 "inputs")]  
           end  
46    
47      local    (* translate a TreeIR type to the C types used to represent it in the external API *)
48        fun subscript (e, i) = CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i))      val trType = CodeGenUtil.trAPIType
49    
     (* initialize an external C representation from constant expressions *)  
       fun initC env {ty, dst, src} = let  
             fun cvtExp e = ToC.trExp (env, e)  
             fun simpleInit () = [CL.mkAssign(dst, cvtExp src)]  
             in  
               case (ty, src)  
                of (APITypes.BoolTy, _) => simpleInit ()  
                 | (APITypes.StringTy, _) => simpleInit ()  
                 | (APITypes.IntTy, _) => simpleInit ()  
                 | (APITypes.TensorTy[], _) => simpleInit ()  
                 | (APITypes.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  
                 | (APITypes.SeqTy(_, NONE), _) => simpleInit ()  
                 | (APITypes.ImageTy _, _) => simpleInit ()  
                 | _ => let  
                     val (tmp, stm) = ToC.expToVar(TreeVar.Map.empty, trType(env, ty), "tmp", src)  
                     in  
                       stm @ CTyTranslate.copyToC{ty = ty, dst=dst, src=tmp}  
                     end  
               (* end case *)  
             end  
     in  
50    (* generate code to initialize the default input values *)    (* generate code to initialize the default input values *)
51      fun genInitDefaults (env, inputs) = let      fun genInitDefaults (env, constInit) =
           val initC = initC env  
         (* the inputs pointer type *)  
           val inputPtrTy = CL.T_Ptr (Env.optionsTy env)  
         (* 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.apiTy gv, dst=lhs, src=dflt} @ stms  
                 end  
             | initInput (_, stms) = stms  
           in  
52              CL.D_Func(              CL.D_Func(
53                ["static"], CL.voidTy, RN.initDefaults,              ["static"], CL.voidTy, "init_defaults",
54                [CL.PARAM([], inputPtrTy, "inp")],              [CL.PARAM([], globalPtrTy, Env.global env)],
55                CL.mkBlock(List.foldr initInput [] inputs))              ToC.trBlock (env, constInit))
           end  
     end (* local *)  
56    
57    (* generate code to register command-line options for setting the input variables *)    (* generate code to register command-line options for setting the input variables *)
58      fun genRegisterInputs (env, inputs) = let      fun genRegisterInputs (env, inputs) = let
59            val inputPtrTy = CL.T_Ptr(CL.T_Named "inputs")          (* pointer to the globals *)
60              val globalsV = Env.global env
61              val globalsE = CL.mkVar globalsV
62          (* the options pointer type *)          (* the options pointer type *)
63            val optionsPtrTy = CL.T_Ptr (Env.optionsTy env)            val optionsPtrTy = CL.T_Ptr (Env.optionsTy env)
64          (* some common variables *)          (* some common variables *)
65            val inpV = CL.mkVar "inp"            val inpV = CL.mkVar "inp"
66            val optsV = CL.mkVar "opts"            val optsV = CL.mkVar "opts"
67          (* register a given input *)          (* register a given input *)
68            fun registerInput (gv, name, desc, optDflt) = CL.mkCall(RN.inputOpt(GVar.ty gv), [            fun registerInput (Inp.INP{var, name, ty, desc, init}) =
69                    optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),                  CL.mkCallExp(
70                    if TrTy.isCArrayTy(GVar.ty gv)                    CL.mkIndirect(optsV, "add"),
71                      then CL.mkIndirect(inpV, GVar.name gv)                    [ CL.mkStr name,
72                      else CL.mkUnOp(CL.%&, CL.mkIndirect(inpV, GVar.name gv)),                      CL.mkStr(Option.getOpt(desc, "")),
73                    CL.mkBool(Option.isSome optDflt)                      if Ty.isCArrayTy ty
74                          then CL.mkIndirect(globalsE, GVar.name var)
75                          else CL.mkAddrOf(CL.mkIndirect(globalsE, GVar.name var)),
76                        case init of Inp.NoDefault => CL.mkBool false | _ => CL.mkBool true
77                  ])                  ])
78            in            in
79              CL.D_Func(              CL.D_Func(
80                ["static"], CL.voidTy, RN.registerOpts,                ["static"], CL.voidTy, "register_inputs",
81                [CL.PARAM([], inputPtrTy, "inp"), CL.PARAM([], optionsPtrTy, "opts")],                [CL.PARAM([], globalPtrTy, globalsV), CL.PARAM([], optionsPtrTy, "opts")],
82                CL.mkBlock(List.map registerInput inputs))                CL.mkBlock(List.map registerInput inputs))
83            end            end
84    
85    (* generate the common functions that handle inputs for standalone executables.  These are:    (* generate the common functions that handle inputs for standalone executables.  These are:
86     *    InitDefaults    -- called to initialize the default input values     *    init_defaults    -- called to initialize the default input values
87     *    RegisterInputs  -- called to register the command-line options for the input globals     *    register_inputs  -- called to register the command-line options for the input globals
    * These will be extended with a target-specific InitInputs function.  
88     *)     *)
89      fun genExecInputFuns (_, []) = []      fun genExecInputFuns (env, IR.Program{inputs, constInit, ...}) = [
90        | genExecInputFuns arg = [              genInitDefaults (env, constInit),
91              genInitDefaults arg,              genRegisterInputs (env, inputs)
             genRegisterInputs arg  
92            ]            ]
93    
94      (* an l-value expression for accessing a defined-input flag *)
95        fun defined gv = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "definedInp"), GVar.name gv)
96    
97    (* generate the typedef for the defined-input flag struct. *)    (* generate the typedef for the defined-input flag struct. *)
98      fun genDefinedInpStruct (_, []) = []      fun genDefinedInpStruct [] = []
99        | genDefinedInpStruct (env, inputs) = let        | genDefinedInpStruct inputs = let
100            fun mkField (gv, _, _, _) = (CL.boolTy, GVar.name gv)            fun mkField (Inp.INP{var, ...}) = (CL.boolTy, GVar.name var)
101            in            in
102              [CL.D_StructDef(NONE, List.map mkField inputs, SOME "defined_inputs")]              [CL.D_StructDef(NONE, List.map mkField inputs, SOME "defined_inputs")]
103            end            end
104    
105    (* generate the function that initializes the defined-input flag struct. *)    (* generate the function that initializes the defined-input flag struct. *)
106      fun genDefineInp (tgt, inputs) = let      fun genDefineInp inputs = let
107          (* the world pointer type *)          (* the world pointer type *)
           val worldPtrTy = RN.worldPtrTy tgt  
108            val wrldParam = CL.PARAM([], worldPtrTy, "wrld")            val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
109            fun initFlag (gv, _, _, _) = CL.mkAssign(defined gv, CL.mkBool false)            fun initFlag (Inp.INP{var, ...}) = CL.mkAssign(defined var, CL.mkBool false)
110            in            in
111              CL.D_Func(              CL.D_Func(
112                ["static"], CL.voidTy, RN.initDefined tgt,                ["static"], CL.voidTy, "init_defined_inputs",
113                [wrldParam],                [wrldParam],
114                CL.mkBlock(List.map initFlag inputs))                CL.mkBlock(List.map initFlag inputs))
115            end            end

Legend:
Removed from v.3896  
changed lines
  Added in v.3897

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