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

SCM Repository

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

Diff of /branches/lamont/src/compiler/c-util/gen-inputs.sml

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

revision 2297, Fri Mar 15 22:05:31 2013 UTC revision 2298, Fri Mar 15 22:18:22 2013 UTC
# Line 16  Line 16 
16    (* generate the input initialization structure that we use to initialize input    (* generate the input initialization structure that we use to initialize input
17     * globals from command-line arguments in stand-alone executables.     * globals from command-line arguments in stand-alone executables.
18     *)     *)
19      val genInputsStruct : TargetUtil.target_desc * input_desc list -> CLang.decl      val genInputsStruct : Properties.props * input_desc list -> CLang.decl
20    
21    (* generate the functions that handle inputs for standalone executables.  These are:    (* generate the functions that handle inputs for standalone executables.  These are:
22     *    InitDefaults    -- called to initialize the default input values     *    InitDefaults    -- called to initialize the default input values
# Line 24  Line 24 
24     *    InitInptus      -- called to initialize the input globals from the values specified     *    InitInptus      -- called to initialize the input globals from the values specified
25     *                       on the command line.     *                       on the command line.
26     *)     *)
27      val genExecInputFuns : TargetUtil.target_desc * input_desc list -> CLang.decl list      val genExecInputFuns : Properties.props * input_desc list -> CLang.decl list
28    
29    (*** Support for libraries ***)    (*** Support for libraries ***)
30    
31    (* generate the typedef for the defined-input flag struct. *)    (* generate the typedef for the defined-input flag struct. *)
32      val genDefinedInpStruct : TargetUtil.target_desc * input_desc list -> CLang.decl      val genDefinedInpStruct : Properties.props * input_desc list -> CLang.decl
33    
34    (* generated the functions to initialize inputs for the library API.  This function also    (* generated the functions to initialize inputs for the library API.  This function also
35     * generates the function to initialize the defined input flags struct.     * generates the function to initialize the defined input flags struct.
36     *)     *)
37      val genInputFuns : TargetUtil.target_desc * input_desc list -> CLang.decl list      val genInputFuns : Properties.props * input_desc list -> CLang.decl list
38    
39    end = struct    end = struct
40    
# Line 50  Line 50 
50      val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")      val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
51      val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")      val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")
52    
53      type target_desc = TargetUtil.target_desc      type props = Properties.props
54    
55    (* translate a TreeIL type to the C types used to represent it in the external API *)    (* translate a TreeIL type to the C types used to represent it in the external API *)
56      val trType = CTyTranslate.toCType      val trType = CTyTranslate.toCType
# Line 77  Line 77 
77    (* generate the input initialization structure that we use to initialize input    (* generate the input initialization structure that we use to initialize input
78     * globals from command-line arguments in stand-alone executables.     * globals from command-line arguments in stand-alone executables.
79     *)     *)
80      fun genInputsStruct (tgt : target_desc, inputs) = let      fun genInputsStruct (tgt : props, inputs) = let
81            fun mkField (Ty.DynSeqTy _, name, _, _) = (CL.charPtr, name)            fun mkField (Ty.DynSeqTy _, name, _, _) = (CL.charPtr, name)
82              | mkField (Ty.ImageTy _, name, _, _) = (CL.charPtr, name)              | mkField (Ty.ImageTy _, name, _, _) = (CL.charPtr, name)
83              | mkField (ty, name, _, _) = (trType ty, name)              | mkField (ty, name, _, _) = (trType ty, name)
# Line 85  Line 85 
85              CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.inputsTy tgt))              CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.inputsTy tgt))
86            end            end
87    
88        local
89          fun subscript (e, i) = CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i))
90    
91        (* initialize an external C representation from constant expressions *)
92          fun initC {ty, dst, src} = let
93                fun cvtExp e = TreeToC.trExp (TreeIL.Var.Map.empty, e)
94                fun simpleInit () = [CL.mkAssign(dst, cvtExp src)]
95                in
96                  case (ty, src)
97                   of (Ty.BoolTy, _) => simpleInit ()
98                    | (Ty.StringTy, _) => simpleInit ()
99                    | (Ty.IntTy, _) => simpleInit ()
100                    | (Ty.TensorTy[], _) => simpleInit ()
101                    | (Ty.TensorTy[n], TreeIL.E_Cons(_, es)) => let
102                        fun lp (_, []) = []
103                          | lp (i, e::es) = CL.mkAssign(subscript(dst, i), cvtExp e) :: lp(i+1, es)
104                        in
105                          lp(0, es)
106                        end
107                    | _ => raise Fail(concat["CTyTranslate.initC(", Ty.toString ty, ") not supported yet"])
108                  (* end case *)
109                end
110        in
111    (* generate code to initialize the default input values *)    (* generate code to initialize the default input values *)
112      fun genInitDefaults (tgt, inputs) = let      fun genInitDefaults (tgt, inputs) = let
113          (* the inputs pointer type *)          (* the inputs pointer type *)
# Line 92  Line 115 
115          (* some common variables *)          (* some common variables *)
116            val inpV = CL.mkVar "inp"            val inpV = CL.mkVar "inp"
117          (* initialize a given input *)          (* initialize a given input *)
118            fun initInput (ty, name, _, SOME dflt) = let            fun initInput ((ty, name, _, SOME dflt), stms) = let
119                  val lhs = CL.mkIndirect(inpV, name)                  val lhs = CL.mkIndirect(inpV, name)
                 val rhs = TreeToC.trExp (TreeIL.Var.Map.empty, dflt)  
120                  in                  in
121                    SOME(CL.mkAssign(lhs, rhs))                    initC {ty=ty, dst=lhs, src=dflt} @ stms
122                  end                  end
123              | initInput _ = NONE              | initInput (_, stms) = stms
124            in            in
125              CL.D_Func(              CL.D_Func(
126                ["static"], CL.voidTy, N.initDefaults,                ["static"], CL.voidTy, N.initDefaults,
127                [CL.PARAM([], inputPtrTy, "inp")],                [CL.PARAM([], inputPtrTy, "inp")],
128                CL.mkBlock(List.mapPartial initInput inputs))                CL.mkBlock(List.foldr initInput [] inputs))
129            end            end
130        end (* local *)
131    
132    (* generate code to register command-line options for setting the input variables *)    (* generate code to register command-line options for setting the input variables *)
133      fun genRegisterInputs (tgt, inputs) = let      fun genRegisterInputs (tgt, inputs) = let
# Line 116  Line 139 
139          (* register a given input *)          (* register a given input *)
140            fun registerInput (ty, name, desc, optDflt) = CL.mkCall(N.input ty, [            fun registerInput (ty, name, desc, optDflt) = CL.mkCall(N.input ty, [
141                    optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),                    optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
142                    CL.mkUnOp(CL.%&, CL.mkIndirect(inpV, name)),                    if TrTy.isCArrayTy ty
143                        then CL.mkIndirect(inpV, name)
144                        else CL.mkUnOp(CL.%&, CL.mkIndirect(inpV, name)),
145                    CL.mkBool(Option.isSome optDflt)                    CL.mkBool(Option.isSome optDflt)
146                  ])                  ])
147            in            in
# Line 175  Line 200 
200            ]            ]
201    
202    (* generate the typedef for the defined-input flag struct. *)    (* generate the typedef for the defined-input flag struct. *)
203      fun genDefinedInpStruct (tgt : target_desc, inputs) = let      fun genDefinedInpStruct (tgt : props, inputs) = let
204            fun mkField (_, name, _, _) = (CL.boolTy, name)            fun mkField (_, name, _, _) = (CL.boolTy, name)
205            in            in
206              CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.definedInpTy tgt))              CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.definedInpTy tgt))

Legend:
Removed from v.2297  
changed lines
  Added in v.2298

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