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 1803 - (view) (download)

1 : jhr 1774 (* 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 : jhr 1803 type input_desc = (TreeIL.Ty.ty * string * string * bool)
10 : jhr 1774
11 : jhr 1803 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 : jhr 1774 end = struct
18 :    
19 : jhr 1803 structure IL = TreeIL
20 :     structure Ty = TreeIL.Ty
21 : jhr 1774 structure CL = CLang
22 :     structure N = CNames
23 :    
24 : jhr 1803 type input_desc = (Ty.ty * string * string * bool)
25 :    
26 :     val nrrdPtrTy = CL.T_Ptr(CL.T_Named "Nrrd")
27 :    
28 :     type target_desc = TargetUtil.target_desc
29 :    
30 :     (* translate TreeIL types to CLang types *)
31 :     val trType = TreeTyToC.trType
32 :    
33 :     (* gather the input globals from the input initialization block *)
34 :     fun gatherInputs (IL.Block{body, ...}) = let
35 :     fun gather (IL.S_Input(x, name, desc, NONE)) = SOME(IL.Var.ty x, name, desc, false)
36 :     | gather (IL.S_Input(x, name, desc, SOME _)) = SOME(IL.Var.ty x, name, desc, true)
37 :     | gather _ = NONE
38 :     in
39 :     List.mapPartial gather body
40 :     end
41 :    
42 :     (* old input code from tree-to-c.sml
43 :     | IL.S_Input(lhs, name, desc, optDflt) => let
44 :     val lhs = VarToC.lvalueVar (env, lhs)
45 :     val (initCode, hasDflt) = (case optDflt
46 :     of SOME e => ([CL.mkAssign(lhs, trExp(env, e))], true)
47 :     | NONE => ([], false)
48 :     (* end case *))
49 :     val code = [CL.mkCall(N.input(V.ty lhs), [
50 :     CL.mkVar "opts",
51 :     CL.mkStr name,
52 :     CL.mkStr desc,
53 :     addrOf lhs,
54 :     CL.mkBool hasDflt])]
55 :     in
56 :     initCode
57 :     end
58 :     *)
59 :    
60 :     fun genRegisterInputs (tgt : target_desc, inputs) = let
61 : jhr 1774 val prefix = #namespace tgt
62 :     (* the world pointer type *)
63 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(prefix ^ "World_t"))
64 :     in
65 :     CL.D_Func(
66 :     [], CL.voidTy, N.registerOpts,
67 :     [CL.PARAM([], worldPtrTy, "wrld"), CL.PARAM([], CL.T_Ptr(CL.T_Named N.optionsTy), "opts")],
68 :     (* FIXME: fill in the code! *)
69 :     CL.mkBlock[])
70 :     end
71 :    
72 : jhr 1803 (* for each input variable we generate two or three top-level declaraions *)
73 :     fun genInputFuns (tgt : target_desc, inputs) = let
74 :     val prefix = #namespace tgt
75 :     (* the world pointer type *)
76 :     val worldPtrTy = CL.T_Ptr(CL.T_Named(prefix ^ "World_t"))
77 :     val wrldParam = CL.PARAM([], worldPtrTy, "wrld")
78 :     (* create decls for an input variable *)
79 :     fun mkInputDecls (ty, name, desc, hasDflt) = let
80 :     (* create a description declaration for the input variable *)
81 :     val descDcl = if (desc = "")
82 :     then []
83 :     else [
84 :     CL.D_Var([], CL.T_Ptr(CL.T_Named "const char"),
85 :     concat[prefix, "Desc_", name],
86 :     SOME(CL.I_Exp(CL.mkStr desc)))
87 :     ]
88 :     val getDcl = if hasDflt
89 :     then let
90 :     val name = concat[prefix, name]
91 :     (* convert the input type to a by-reference C type *)
92 :     val outTy = (case ty
93 :     of Ty.BoolTy => CL.T_Ptr(trType ty)
94 :     | Ty.StringTy => CL.T_Ptr(trType ty)
95 :     | Ty.IntTy => CL.T_Ptr(trType ty)
96 :     | Ty.TensorTy[] => CL.T_Ptr(trType ty)
97 :     | Ty.TensorTy _=> trType ty
98 :     | Ty.SeqTy _ => trType ty
99 :     | Ty.DynSeqTy _ => CL.T_Ptr(trType ty)
100 :     | Ty.ImageTy _ => CL.T_Ptr CL.charPtr
101 :     | _ => raise Fail(concat["bogus input type ", Ty.toString ty])
102 :     (* end case *))
103 :     in [
104 :     CL.D_Func([], CL.voidTy, name, [wrldParam, CL.PARAM([], outTy, "v")],
105 :     CL.mkBlock[] (* FIXME *))
106 :     ] end
107 :     else []
108 :     val setDcl = (case ty
109 :     of Ty.ImageTy _ => [
110 :     CL.D_Func(
111 :     [], CL.voidTy, concat[prefix, "Set_", name, "_ByName"],
112 :     [wrldParam, CL.PARAM(["const"], CL.charPtr, "s")],
113 :     CL.mkBlock[] (* FIXME *)),
114 :     CL.D_Func(
115 :     [], CL.voidTy, concat[prefix, "Set_", name],
116 :     [wrldParam, CL.PARAM([], nrrdPtrTy, "data")],
117 :     CL.mkBlock[] (* FIXME *))
118 :     ]
119 :     | Ty.DynSeqTy _ => raise Fail "dynamic input not supported yet"
120 :     | _ => [
121 :     CL.D_Func(
122 :     [], CL.voidTy, concat[prefix, "Set_", name],
123 :     [wrldParam, CL.PARAM([], trType ty, "v")],
124 :     CL.mkBlock[] (* FIXME *))
125 :     ]
126 :     (* end case *))
127 :     in
128 :     descDcl @ getDcl @ setDcl
129 :     end
130 :     in
131 :     List.foldr (fn (input, dcls) => mkInputDecls input @ dcls) [] inputs
132 :     end
133 :    
134 : jhr 1774 end

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