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

Parent Directory | Revision Log

---

Revision 1820 - (view) (download)

1 :	jhr	1820	(* gen-inputs.sml
2 :			*
3 :			* COPYRIGHT (c) 2012 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :			* All rights reserved.
5 :			*)
6 :
7 :			structure GenInputs : sig
8 :
9 :			type input_desc = (TreeIL.Ty.ty * string * string * bool)
10 :
11 :			val gatherInputs : TreeIL.block -> input_desc list
12 :
13 :			val genRegisterInputs : TargetUtil.target_desc * input_desc list -> CLang.decl
14 :
15 :			val genInputFuns : TargetUtil.target_desc * input_desc list -> CLang.decl list
16 :
17 :			end = struct
18 :
19 :			structure IL = TreeIL
20 :			structure Ty = TreeIL.Ty
21 :			structure CL = CLang
22 :			structure N = CNames
23 :			structure TrTy = CTyTranslate
24 :
25 :			type input_desc = (Ty.ty * string * string * bool)
26 :
27 :			val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
28 :			val wrldPrefixTy = CL.T_Ptr(CL.T_Named "WorldPrefix_t")
29 :
30 :			type target_desc = TargetUtil.target_desc
31 :
32 :			(* translate a TreeIL type to the C types used to represent it in the external API *)
33 :			val trType = CTyTranslate.toCType
34 :
35 :			(* an l-value expression for accessing a global variable *)
36 :			fun global name = CL.mkIndirect(CL.mkIndirect(CL.mkVar "wrld", "globals"), name)
37 :
38 :			(* gather the input globals from the input initialization block *)
39 :			fun gatherInputs (IL.Block{body, ...}) = let
40 :			fun gather (IL.S_Input(x, name, desc, NONE)) = SOME(IL.Var.ty x, name, desc, false)
41 :			| gather (IL.S_Input(x, name, desc, SOME _)) = SOME(IL.Var.ty x, name, desc, true)
42 :			| gather _ = NONE
43 :			in
44 :			List.mapPartial gather body
45 :			end
46 :
47 :			(* old input code from tree-to-c.sml
48 :			| IL.S_Input(lhs, name, desc, optDflt) => let
49 :			val lhs = VarToC.lvalueVar (env, lhs)
50 :			val (initCode, hasDflt) = (case optDflt
51 :			of SOME e => ([CL.mkAssign(lhs, trExp(env, e))], true)
52 :			| NONE => ([], false)
53 :			(* end case *))
54 :			val code = [CL.mkCall(N.input(V.ty lhs), [
55 :			CL.mkVar "opts",
56 :			CL.mkStr name,
57 :			CL.mkStr desc,
58 :			addrOf lhs,
59 :			CL.mkBool hasDflt])]
60 :			in
61 :			initCode
62 :			end
63 :			*)
64 :
65 :			fun genRegisterInputs (tgt, inputs) = let
66 :			(* the world pointer type *)
67 :			val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
68 :			in
69 :			CL.D_Func(
70 :			[], CL.voidTy, N.registerOpts,
71 :			[CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], CL.T_Ptr(CL.T_Named N.optionsTy), "opts")],
72 :			(* FIXME: fill in the code! *)
73 :			CL.mkBlock[])
74 :			end
75 :
76 :			(* for each input variable we generate two or three top-level declaraions *)
77 :			fun genInputFuns (tgt, inputs) = let
78 :			(* the world pointer type *)
79 :			val worldPtrTy = CL.T_Ptr(CL.T_Named(N.worldTy tgt))
80 :			val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
81 :			(* create decls for an input variable *)
82 :			fun mkInputDecls (ty, name, desc, hasDflt) = let
83 :			(* create a description declaration for the input variable *)
84 :			val descDcl = if (desc = "")
85 :			then []
86 :			else [
87 :			CL.D_Var([], CL.T_Ptr(CL.T_Named "const char"),
88 :			N.inputDesc(tgt, name),
89 :			SOME(CL.I_Exp(CL.mkStr desc)))
90 :			]
91 :			val getDcl = if hasDflt
92 :			then let
93 :			val getName = N.inputGet(tgt, name)
94 :			(* convert the input type to a by-reference C type *)
95 :			val outTy = (case ty
96 :			of Ty.BoolTy => CL.T_Ptr(trType ty)
97 :			| Ty.StringTy => CL.T_Ptr(trType ty)
98 :			| Ty.IntTy => CL.T_Ptr(trType ty)
99 :			| Ty.TensorTy[] => CL.T_Ptr(trType ty)
100 :			| Ty.TensorTy _ => trType ty
101 :			| Ty.SeqTy _ => trType ty
102 :			| Ty.DynSeqTy _ => CL.T_Ptr(trType ty)
103 :			| Ty.ImageTy _ => CL.T_Ptr CL.charPtr
104 :			| _ => raise Fail(concat["bogus input type ", Ty.toString ty])
105 :			(* end case *))
106 :			in [
107 :			CL.D_Func([], CL.voidTy, getName, [wrldParam, CL.PARAM([], outTy, "v")],
108 :			CL.mkBlock(
109 :			TrTy.copyToC{ty=ty, dst=CL.mkUnOp(CL.%*, CL.mkVar "v"), src=global name}))
110 :			] end
111 :			else []
112 :			val setDcl = (case ty
113 :			of Ty.ImageTy info => let
114 :			val dim = ImageInfo.dim info
115 :			in [
116 :			CL.D_Func(
117 :			[], CL.boolTy, N.inputSetByName(tgt, name),
118 :			[wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
119 :			CL.mkBlock[
120 :			(* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
121 :			CL.mkReturn(SOME(
122 :			CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
123 :			CL.mkApply(N.loadImage dim, [
124 :			CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
125 :			CL.mkVar "s", CL.mkUnOp(CL.%&, global name)
126 :			]))))
127 :			]),
128 :			CL.D_Func(
129 :			[], CL.boolTy, N.inputSet(tgt, name),
130 :			[wrldParam, CL.PARAM([], nrrdPtrTy, "nin")],
131 :			CL.mkBlock[
132 :			(* FIXME: we should also generate code to check that the loaded image has the right type, etc. *)
133 :			CL.mkReturn(SOME(
134 :			CL.mkBinOp(CL.mkVar "DIDEROT_FAIL", CL.#==,
135 :			CL.mkApply(N.setImage dim, [
136 :			CL.mkCast(wrldPrefixTy, CL.mkVar "wrld"),
137 :			CL.mkVar "nin", CL.mkUnOp(CL.%&, global name)
138 :			]))))
139 :			])
140 :			] end
141 :			| Ty.DynSeqTy _ => raise Fail "dynamic input not supported yet"
142 :			| _ => [
143 :			CL.D_Func(
144 :			[], CL.boolTy, N.inputSet(tgt, name),
145 :			[wrldParam, CL.PARAM([], trType ty, "v")],
146 :			CL.mkBlock(
147 :			TrTy.copyFromC{ty=ty, dst=global name, src=CL.mkVar "v"} @
148 :			[CL.mkReturn(SOME(CL.mkVar "false"))]))
149 :			]
150 :			(* end case *))
151 :			in
152 :			descDcl @ getDcl @ setDcl
153 :			end
154 :			in
155 :			List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) [] inputs
156 :			end
157 :
158 :			end

---

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