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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log 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