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

SCM Repository

[diderot] Annotation of /branches/vis12-cl/src/compiler/c-util/gen-inputs-util.sml
ViewVC logotype

Annotation of /branches/vis12-cl/src/compiler/c-util/gen-inputs-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3088 - (view) (download)

1 : jhr 3088 (* gen-inputs-util.sml
2 : jhr 1820 *
3 : jhr 3043 * COPYRIGHT (c) 2015 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 : jhr 1820 * All rights reserved.
5 :     *)
6 :    
7 : jhr 2724 structure GenInputsUtil : sig
8 : jhr 1820
9 : jhr 2724 (* input variable descriptor: type, name, description, and default *)
10 : jhr 3043 type input_desc = (TreeIL.global_var * string * string option * TreeIL.exp option)
11 : jhr 1820
12 :     val gatherInputs : TreeIL.block -> input_desc list
13 :    
14 : jhr 3043 (* an l-value expression for accessing a defined-input flag for the given global input *)
15 :     val defined : TreeIL.global_var -> CLang.exp
16 : jhr 2726
17 : jhr 2048 (*** Support for standalone executables ***)
18 :    
19 : jhr 2041 (* generate the input initialization structure that we use to initialize input
20 :     * globals from command-line arguments in stand-alone executables.
21 :     *)
22 : jhr 3043 val genInputsStruct : Properties.props * input_desc list -> CLang.decl list
23 : jhr 2041
24 : jhr 2724 (* generate the common functions that handle inputs for standalone executables. These are:
25 : jhr 2999 * InitDefaults -- called to initialize the default input values
26 :     * RegisterInputs -- called to register the command-line options for the input globals
27 : jhr 2724 * These will be extended with a target-specific InitInputs function.
28 : jhr 2048 *)
29 : jhr 2082 val genExecInputFuns : Properties.props * input_desc list -> CLang.decl list
30 : jhr 1820
31 : jhr 2048 (*** Support for libraries ***)
32 : jhr 2041
33 : jhr 2048 (* generate the typedef for the defined-input flag struct. *)
34 : jhr 3043 val genDefinedInpStruct : Properties.props * input_desc list -> CLang.decl list
35 : jhr 2048
36 : jhr 2724 (* generate the function that initializes the defined-input flag struct. *)
37 : jhr 2726 val genDefineInp : Properties.props * input_desc list -> CLang.decl
38 : jhr 2724
39 : jhr 1820 end = struct
40 :    
41 :     structure IL = TreeIL
42 :     structure Ty = TreeIL.Ty
43 : jhr 3043 structure GVar = IL.GlobalVar
44 : jhr 1820 structure CL = CLang
45 :     structure N = CNames
46 : jhr 2051 structure ToC = TreeToC
47 : jhr 1820 structure TrTy = CTyTranslate
48 :    
49 : jhr 3043 type input_desc = (TreeIL.global_var * string * string option * IL.exp option)
50 : jhr 1820
51 :     (* translate a TreeIL type to the C types used to represent it in the external API *)
52 :     val trType = CTyTranslate.toCType
53 :    
54 : jhr 2048 (* an l-value expression for accessing a defined-input flag *)
55 : jhr 3043 fun defined gv = CL.mkSelect(CL.mkIndirect(CL.mkVar "wrld", "definedInp"), GVar.name gv)
56 : jhr 2048
57 : jhr 1820 (* gather the input globals from the input initialization block *)
58 :     fun gatherInputs (IL.Block{body, ...}) = let
59 : jhr 3043 fun inputInfo cvt (x, name, desc, NONE) = SOME(x, name, desc, NONE)
60 :     | inputInfo cvt (x, name, desc, SOME v) = SOME(x, name, desc, SOME(cvt v))
61 : jhr 2048 fun gather (IL.S_Input inp) = inputInfo (fn e => e) inp
62 :     | gather (IL.S_InputNrrd inp) = inputInfo (fn s => TreeIL.E_Lit(Literal.String s)) inp
63 : jhr 1820 | gather _ = NONE
64 :     in
65 :     List.mapPartial gather body
66 :     end
67 :    
68 : jhr 2041 (* generate the input initialization structure that we use to initialize input
69 :     * globals from command-line arguments in stand-alone executables.
70 :     *)
71 : jhr 3043 fun genInputsStruct (_, []) = []
72 :     | genInputsStruct (tgt : Properties.props, inputs) = let
73 :     fun mkField (gv, _, _, _) = (case GVar.ty gv
74 :     of Ty.DynSeqTy _ => (CL.charPtr, GVar.name gv)
75 :     | Ty.ImageTy _ => (CL.charPtr, GVar.name gv)
76 :     | ty => (trType ty, GVar.name gv)
77 :     (* end case *))
78 : jhr 2999 in
79 : jhr 3088 [CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.inputsTyName tgt))]
80 : jhr 2999 end
81 : jhr 2041
82 : jhr 2118 local
83 :     fun subscript (e, i) = CL.mkSubscript(e, CL.mkInt(IntInf.fromInt i))
84 :    
85 :     (* initialize an external C representation from constant expressions *)
86 :     fun initC {ty, dst, src} = let
87 : jhr 2999 fun cvtExp e = TreeToC.trExp (TreeIL.Var.Map.empty, e)
88 :     fun simpleInit () = [CL.mkAssign(dst, cvtExp src)]
89 :     in
90 :     case (ty, src)
91 :     of (Ty.BoolTy, _) => simpleInit ()
92 :     | (Ty.StringTy, _) => simpleInit ()
93 :     | (Ty.IntTy, _) => simpleInit ()
94 :     | (Ty.TensorTy[], _) => simpleInit ()
95 :     | (Ty.TensorTy[n], TreeIL.E_Cons(_, es)) => let
96 :     fun lp (_, []) = []
97 :     | lp (i, e::es) = CL.mkAssign(subscript(dst, i), cvtExp e) :: lp(i+1, es)
98 :     in
99 :     lp(0, es)
100 :     end
101 :     | (Ty.DynSeqTy _, _) => simpleInit ()
102 :     | (Ty.ImageTy _, _) => simpleInit ()
103 : jhr 3043 | _ => let
104 :     val (tmp, stm) = TreeToC.expToVar(TreeIL.Var.Map.empty, CTyTranslate.toType ty, "tmp", src)
105 :     in
106 :     stm @ CTyTranslate.copyToC{ty = ty, dst=dst, src=tmp}
107 :     end
108 : jhr 2999 (* end case *)
109 :     end
110 : jhr 2118 in
111 : jhr 2048 (* generate code to initialize the default input values *)
112 :     fun genInitDefaults (tgt, inputs) = let
113 : jhr 2999 (* the inputs pointer type *)
114 : jhr 3088 val inputPtrTy = N.inputsPtrTy tgt
115 : jhr 2999 (* some common variables *)
116 :     val inpV = CL.mkVar "inp"
117 :     (* initialize a given input *)
118 : jhr 3043 fun initInput ((gv, name, _, SOME dflt), stms) = let
119 :     val lhs = CL.mkIndirect(inpV, GVar.name gv)
120 : jhr 2999 in
121 : jhr 3043 initC {ty=GVar.ty gv, dst=lhs, src=dflt} @ stms
122 : jhr 2999 end
123 :     | initInput (_, stms) = stms
124 :     in
125 :     CL.D_Func(
126 :     ["static"], CL.voidTy, N.initDefaults,
127 :     [CL.PARAM([], inputPtrTy, "inp")],
128 :     CL.mkBlock(List.foldr initInput [] inputs))
129 :     end
130 : jhr 2118 end (* local *)
131 : jhr 2048
132 : jhr 1845 (* generate code to register command-line options for setting the input variables *)
133 : jhr 1820 fun genRegisterInputs (tgt, inputs) = let
134 : jhr 2999 (* the inputs pointer type *)
135 : jhr 3088 val inputPtrTy = N.inputsPtrTy tgt
136 : jhr 2999 (* some common variables *)
137 :     val inpV = CL.mkVar "inp"
138 :     val optsV = CL.mkVar "opts"
139 :     (* register a given input *)
140 : jhr 3088 fun registerInput (gv, name, desc, optDflt) = CL.mkCall(N.inputOpt(GVar.ty gv), [
141 : jhr 2999 optsV, CL.mkStr name, CL.mkStr(Option.getOpt(desc, "")),
142 : jhr 3043 if TrTy.isCArrayTy(GVar.ty gv)
143 :     then CL.mkIndirect(inpV, GVar.name gv)
144 :     else CL.mkUnOp(CL.%&, CL.mkIndirect(inpV, GVar.name gv)),
145 : jhr 2999 CL.mkBool(Option.isSome optDflt)
146 :     ])
147 :     in
148 :     CL.D_Func(
149 :     ["static"], CL.voidTy, N.registerOpts,
150 : jhr 3088 [CL.PARAM([], inputPtrTy, "inp"), CL.PARAM([], N.optionsPtrTy, "opts")],
151 : jhr 2999 CL.mkBlock(List.map registerInput inputs))
152 :     end
153 : jhr 2041
154 : jhr 2724 (* generate the common functions that handle inputs for standalone executables. These are:
155 : jhr 2999 * InitDefaults -- called to initialize the default input values
156 :     * RegisterInputs -- called to register the command-line options for the input globals
157 : jhr 2724 * These will be extended with a target-specific InitInputs function.
158 : jhr 2048 *)
159 : jhr 3043 fun genExecInputFuns (_, []) = []
160 :     | genExecInputFuns arg = [
161 : jhr 2999 genInitDefaults arg,
162 :     genRegisterInputs arg
163 :     ]
164 : jhr 2048
165 :     (* generate the typedef for the defined-input flag struct. *)
166 : jhr 3043 fun genDefinedInpStruct (_, []) = []
167 :     | genDefinedInpStruct (tgt : Properties.props, inputs) = let
168 :     fun mkField (gv, _, _, _) = (CL.boolTy, GVar.name gv)
169 : jhr 2999 in
170 : jhr 3088 [CL.D_StructDef(NONE, List.map mkField inputs, SOME(N.definedInpTyName tgt))]
171 : jhr 2999 end
172 : jhr 2048
173 : jhr 2724 (* generate the function that initializes the defined-input flag struct. *)
174 : jhr 2048 fun genDefineInp (tgt, inputs) = let
175 : jhr 2999 (* the world pointer type *)
176 : jhr 3088 val worldPtrTy = N.worldPtrTy tgt
177 : jhr 2048 val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
178 : jhr 3043 fun initFlag (gv, _, _, _) = CL.mkAssign(defined gv, CL.mkBool false)
179 : jhr 2999 in
180 :     CL.D_Func(
181 :     ["static"], CL.voidTy, N.initDefined tgt,
182 :     [wrldParam],
183 :     CL.mkBlock(List.map initFlag inputs))
184 :     end
185 : jhr 2048
186 : jhr 1820 end

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