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 3888, Fri May 20 22:06:33 2016 UTC revision 3896, Sun May 22 18:24:49 2016 UTC
# Line 8  Line 8 
8    
9  structure GenInputsUtil : sig  structure GenInputsUtil : sig
10    
11    (* input variable descriptor: type, name, description, and default *)    (* input variable descriptor: tree var, name, description, and default *)
12      type input_desc = (TreeIR.global_var * string * string option * TreeIR.exp option)      type input_desc = (TreeIR.global_var * string * string option * TreeIR.exp option)
13    
     val gatherInputs : TreeIR.block -> input_desc list  
   
14    (* 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 *)
15      val defined : TreeIR.global_var -> CLang.exp      val defined : TreeIR.global_var -> CLang.exp
16    
# Line 21  Line 19 
19    (* generate the input initialization structure that we use to initialize input    (* generate the input initialization structure that we use to initialize input
20     * globals from command-line arguments in stand-alone executables.     * globals from command-line arguments in stand-alone executables.
21     *)     *)
22      val genInputsStruct : Properties.t * input_desc list -> CLang.decl list      val genInputsStruct : CodeGenEnv.t * input_desc list -> CLang.decl list
23    
24    (* generate the common functions that handle inputs for standalone executables.  These are:    (* generate the common functions that handle inputs for standalone executables.  These are:
25     *    InitDefaults    -- called to initialize the default input values     *    InitDefaults    -- called to initialize the default input values
26     *    RegisterInputs  -- called to register the command-line options for the input globals     *    RegisterInputs  -- called to register the command-line options for the input globals
27     * These will be extended with a target-specific InitInputs function.     * These will be extended with a target-specific InitInputs function.
28     *)     *)
29      val genExecInputFuns : Properties.t * input_desc list -> CLang.decl list      val genExecInputFuns : CodeGenEnv.t * input_desc list -> CLang.decl list
30    
31    (*** Support for libraries ***)    (*** Support for libraries ***)
32    
33    (* generate the typedef for the defined-input flag struct. *)    (* generate the typedef for the defined-input flag struct. *)
34      val genDefinedInpStruct : Properties.t * input_desc list -> CLang.decl list      val genDefinedInpStruct : CodeGenEnv.t * input_desc list -> CLang.decl list
35    
36    (* generate the function that initializes the defined-input flag struct. *)    (* generate the function that initializes the defined-input flag struct. *)
37      val genDefineInp : Properties.t * input_desc list -> CLang.decl      val genDefineInp : CodeGenEnv.t * input_desc list -> CLang.decl
38    
39    end = struct    end = struct
40    
# Line 44  Line 42 
42      structure Ty = TreeTypes      structure Ty = TreeTypes
43      structure GVar = TreeGlobalVar      structure GVar = TreeGlobalVar
44      structure CL = CLang      structure CL = CLang
     structure RN = RuntimeNames  
45      structure ToC = TreeToCxx      structure ToC = TreeToCxx
46      structure TrTy = CTyTranslate      structure Env = CodeGenEnv
47    
48      type input_desc = (TreeIR.global_var * string * string option * IR.exp option)      type input_desc = (TreeIR.global_var * string * string option * IR.exp option)
49    
50    (* translate a TreeIR type to the C types used to represent it in the external API *)    (* translate a TreeIR type to the C types used to represent it in the external API *)
51      val trType = CTyTranslate.toCType      val trType = ToC.trAPIType
52    
53    (* an l-value expression for accessing a defined-input flag *)    (* an l-value expression for accessing a defined-input flag *)
54      fun defined gv = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "definedInp"), GVar.name gv)      fun defined gv = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "definedInp"), GVar.name gv)
55    
   (* 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  
   
56    (* generate the input initialization structure that we use to initialize input    (* generate the input initialization structure that we use to initialize input
57     * globals from command-line arguments in stand-alone executables.     * globals from command-line arguments in stand-alone executables.
58     *)     *)
59      fun genInputsStruct (_, []) = []      fun genInputsStruct (_, []) = []
60        | genInputsStruct (tgt : Properties.t, inputs) = let        | genInputsStruct (env, inputs) = let
61            fun mkField (gv, _, _, _) = (case GVar.ty gv            fun mkField (gv, _, _, _) = (case GVar.ty gv
62                   of Ty.SeqTy(_, NONE) => (CL.charPtr, GVar.name gv)                   of Ty.SeqTy(_, NONE) => (CL.charPtr, GVar.name gv)
63                    | Ty.ImageTy _ => (CL.charPtr, GVar.name gv)                    | Ty.ImageTy _ => (CL.charPtr, GVar.name gv)
64                    | ty => (trType ty, GVar.name gv)                    | ty => (trType ty, GVar.name gv)
65                  (* end case *))                  (* end case *))
66            in            in
67              [CL.D_StructDef(NONE, List.map mkField inputs, SOME(RN.inputsTyName tgt))]              [CL.D_StructDef(NONE, List.map mkField inputs, SOME "inputs")]
68            end            end
69    
70      local      local
71        fun subscript (e, i) = CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i))        fun subscript (e, i) = CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i))
72    
73      (* initialize an external C representation from constant expressions *)      (* initialize an external C representation from constant expressions *)
74        fun initC {ty, dst, src} = let        fun initC env {ty, dst, src} = let
75              fun cvtExp e = ToC.trExp (TreeIR.Var.Map.empty, e)              fun cvtExp e = ToC.trExp (env, e)
76              fun simpleInit () = [CL.mkAssign(dst, cvtExp src)]              fun simpleInit () = [CL.mkAssign(dst, cvtExp src)]
77              in              in
78                case (ty, src)                case (ty, src)
79                 of (Ty.BoolTy, _) => simpleInit ()                 of (APITypes.BoolTy, _) => simpleInit ()
80                  | (Ty.StringTy, _) => simpleInit ()                  | (APITypes.StringTy, _) => simpleInit ()
81                  | (Ty.IntTy, _) => simpleInit ()                  | (APITypes.IntTy, _) => simpleInit ()
82                  | (Ty.TensorTy[], _) => simpleInit ()                  | (APITypes.TensorTy[], _) => simpleInit ()
83                  | (Ty.TensorTy[n], TreeIR.E_Cons(_, es)) => let                  | (APITypes.TensorTy[n], TreeIR.E_Cons(_, es)) => let
84                      fun lp (_, []) = []                      fun lp (_, []) = []
85                        | lp (i, e::es) = CL.mkAssign(subscript(dst, i), cvtExp e) :: lp(i+1, es)                        | lp (i, e::es) = CL.mkAssign(subscript(dst, i), cvtExp e) :: lp(i+1, es)
86                      in                      in
87                        lp(0, es)                        lp(0, es)
88                      end                      end
89                  | (Ty.SeqTy(_, NONE), _) => simpleInit ()                  | (APITypes.SeqTy(_, NONE), _) => simpleInit ()
90                  | (Ty.ImageTy _, _) => simpleInit ()                  | (APITypes.ImageTy _, _) => simpleInit ()
91                  | _ => let                  | _ => let
92                      val (tmp, stm) = ToC.expToVar(TreeVar.Map.empty, CTyTranslate.toType ty, "tmp", src)                      val (tmp, stm) = ToC.expToVar(TreeVar.Map.empty, trType(env, ty), "tmp", src)
93                      in                      in
94                        stm @ CTyTranslate.copyToC{ty = ty, dst=dst, src=tmp}                        stm @ CTyTranslate.copyToC{ty = ty, dst=dst, src=tmp}
95                      end                      end
# Line 111  Line 97 
97              end              end
98      in      in
99    (* generate code to initialize the default input values *)    (* generate code to initialize the default input values *)
100      fun genInitDefaults (tgt, inputs) = let      fun genInitDefaults (env, inputs) = let
101              val initC = initC env
102          (* the inputs pointer type *)          (* the inputs pointer type *)
103            val inputPtrTy = RN.inputsPtrTy tgt            val inputPtrTy = CL.T_Ptr (Env.optionsTy env)
104          (* some common variables *)          (* some common variables *)
105            val inpV = CL.mkVar "inp"            val inpV = CL.mkVar "inp"
106          (* initialize a given input *)          (* initialize a given input *)
107            fun initInput ((gv, name, _, SOME dflt), stms) = let            fun initInput ((gv, name, _, SOME dflt), stms) = let
108                  val lhs = CL.mkIndirect(inpV, GVar.name gv)                  val lhs = CL.mkIndirect(inpV, GVar.name gv)
109                  in                  in
110                    initC {ty=GVar.ty gv, dst=lhs, src=dflt} @ stms                    initC {ty=GVar.apiTy gv, dst=lhs, src=dflt} @ stms
111                  end                  end
112              | initInput (_, stms) = stms              | initInput (_, stms) = stms
113            in            in
# Line 132  Line 119 
119      end (* local *)      end (* local *)
120    
121    (* generate code to register command-line options for setting the input variables *)    (* generate code to register command-line options for setting the input variables *)
122      fun genRegisterInputs (tgt, inputs) = let      fun genRegisterInputs (env, inputs) = let
123          (* the inputs pointer type *)            val inputPtrTy = CL.T_Ptr(CL.T_Named "inputs")
124            val inputPtrTy = RN.inputsPtrTy tgt          (* the options pointer type *)
125              val optionsPtrTy = CL.T_Ptr (Env.optionsTy env)
126          (* some common variables *)          (* some common variables *)
127            val inpV = CL.mkVar "inp"            val inpV = CL.mkVar "inp"
128            val optsV = CL.mkVar "opts"            val optsV = CL.mkVar "opts"
# Line 149  Line 137 
137            in            in
138              CL.D_Func(              CL.D_Func(
139                ["static"], CL.voidTy, RN.registerOpts,                ["static"], CL.voidTy, RN.registerOpts,
140                [CL.PARAM([], inputPtrTy, "inp"), CL.PARAM([], RN.optionsPtrTy, "opts")],                [CL.PARAM([], inputPtrTy, "inp"), CL.PARAM([], optionsPtrTy, "opts")],
141                CL.mkBlock(List.map registerInput inputs))                CL.mkBlock(List.map registerInput inputs))
142            end            end
143    
# Line 166  Line 154 
154    
155    (* generate the typedef for the defined-input flag struct. *)    (* generate the typedef for the defined-input flag struct. *)
156      fun genDefinedInpStruct (_, []) = []      fun genDefinedInpStruct (_, []) = []
157        | genDefinedInpStruct (tgt : Properties.t, inputs) = let        | genDefinedInpStruct (env, inputs) = let
158            fun mkField (gv, _, _, _) = (CL.boolTy, GVar.name gv)            fun mkField (gv, _, _, _) = (CL.boolTy, GVar.name gv)
159            in            in
160              [CL.D_StructDef(NONE, List.map mkField inputs, SOME(RN.definedInpTyName tgt))]              [CL.D_StructDef(NONE, List.map mkField inputs, SOME "defined_inputs")]
161            end            end
162    
163    (* generate the function that initializes the defined-input flag struct. *)    (* generate the function that initializes the defined-input flag struct. *)

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

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