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

SCM Repository

[diderot] Annotation of /branches/vis15/src/compiler/tree-ir/tree-pp.sml
ViewVC logotype

Annotation of /branches/vis15/src/compiler/tree-ir/tree-pp.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3749 - (view) (download)
Original Path: branches/vis15/src/compiler/tree-ir/tree-ir-pp.sml

1 : jhr 3691 (* tree-ir-pp.sml
2 :     *
3 :     * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
4 :     *
5 :     * COPYRIGHT (c) 2016 The University of Chicago
6 :     * All rights reserved.
7 :     *
8 :     * Printing for the TreeIR
9 :     *)
10 :    
11 :     structure TreeIRPP : sig
12 :    
13 :     val statement : TextIO.outstream * TreeIR.stm -> unit
14 :    
15 :     val block : TextIO.outstream * TreeIR.block -> unit
16 :    
17 :     val program : TextIO.outstream * TreeIR.program -> unit
18 :    
19 :     end = struct
20 :    
21 :     structure IR = TreeIR
22 :     structure Op = IR.Op
23 :     structure Var = IR.Var
24 :     structure Ty = IR.Ty
25 :    
26 :     fun indent (outS, i) = TextIO.output(outS, StringCvt.padLeft #" " i "")
27 :     fun incIndent (outS, i) = (outS, i+2)
28 :     fun decIndent (outS, i) = (outS, Int.max(0, i-2))
29 :     fun pr ((outS, _), s) = TextIO.output(outS, s)
30 :     fun prl (out, l) = pr(out, concat l)
31 :     fun prln (out, l) = (indent out; prl(out, l))
32 :    
33 :     fun descToString NONE = ""
34 :     | descToString (SOME desc) = String.toString desc
35 :    
36 :     fun expToString e = let
37 :     fun argsToS (lp, args, rp, l) = let
38 :     fun argToS ([], l) = l
39 :     | argToS ([e], l) = toS (e, l)
40 :     | argToS (e::es, l) = toS(e, "," :: argToS(es, l))
41 :     in
42 :     lp :: argToS(args, rp :: l)
43 :     end
44 :     and toS (IR.E_Global x, l) = "::" :: IR.GlobalVar.toString x :: l
45 :     | toS (IR.E_State x, l) = IR.StateVar.toString x :: l
46 :     | toS (IR.E_Var x, l) = Var.name x :: l
47 :     | toS (IR.E_Lit lit, l) = Literal.toString lit :: l
48 :     | toS (IR.E_Op(rator, args), l) = Op.toString rator :: argsToS ("(", args, ")", l)
49 :     | toS (IR.E_Cons(ty, args), l) =
50 :     "<" :: Ty.toString ty :: ">" :: argsToS ("[", args, "]", l)
51 :     | toS (IR.E_Seq(ty, args), l) =
52 :     "<" :: Ty.toString ty :: ">" :: argsToS ("{", args, "}", l)
53 :     in
54 :     String.concat (toS (e, []))
55 :     end
56 :    
57 :     fun argsToString (prefix, es) = String.concat[
58 :     prefix, "(", String.concatWith "," (List.map expToString es), ")"
59 :     ]
60 :    
61 :     fun ppGlobalDecl out x = prln (out, [
62 :     if IR.GlobalVar.isInput x then "input " else "",
63 :     Ty.toString(IR.GlobalVar.ty x), " ", IR.GlobalVar.name x, ";\n"
64 :     ])
65 :    
66 :     fun ppVarDecl out x = prln (out, [Ty.toString(Var.ty x), " ", Var.name x, ";\n"])
67 :    
68 :     fun ppStrand out strand = let
69 :     val IR.Strand{name, params, state, stateInit, initM, updateM, stabilizeM} = strand
70 :     val out' = incIndent out
71 :     fun ppParams [] = ()
72 :     | ppParams [x] = prl(out, [Ty.toString (Var.ty x), " ", Var.name x])
73 :     | ppParams (x::r) = (
74 :     prl(out, [Ty.toString (Var.ty x), " ", Var.name x, ","]);
75 :     ppParams r)
76 :     fun ppSVarDecl (IR.SV{varying, output, name, ty, ...}) = let
77 :     val v = if varying then "varying " else ""
78 :     val out = if output then "output " else ""
79 :     in
80 :     prln (out', [v, out, Ty.toString ty, " ", name, ";\n"])
81 :     end
82 :     in
83 :     prln (out, ["strand ", Atom.toString name, " ("]);
84 :     ppParams params; pr(out, ") {\n");
85 :     List.app ppSVarDecl state;
86 :     prln (out', ["init () "]); ppBlock(out', stateInit); pr (out', "\n");
87 :     ppMethod (out', "initially", initM);
88 :     ppMethod (out', "update", SOME updateM);
89 :     ppMethod (out', "stabilize", stabilizeM);
90 :     prln (out, ["}\n"])
91 :     end
92 :    
93 :     and ppMethod (out, name, SOME body) = (
94 :     prln (out, [name, " () "]);
95 :     ppBlock (out, body);
96 :     pr (out, "\n"))
97 :     | ppMethod (_, _, NONE) = ()
98 :    
99 :     and ppBlock (out, IR.Block{locals, body}) = let
100 :     val out' = incIndent out
101 :     in
102 :     pr (out, "{\n");
103 :     List.app (ppVarDecl out') locals;
104 :     List.app (fn stm => ppStm(out', stm)) body;
105 :     indent out; pr (out, "}")
106 :     end
107 :    
108 :     and ppStm (out, stm) = (case stm
109 :     of IR.S_Comment text => let
110 :     val out = decIndent out
111 :     in
112 :     List.app (fn s => prln(out, ["// ", s, "\n"])) text
113 :     end
114 :     | IR.S_Assign([], e) => prln(out, [expToString e, ";\n"])
115 :     | IR.S_Assign([x], e) => prln(out, [Var.name x, " = ", expToString e, ";\n"])
116 :     | IR.S_Assign(x::xs, e) => (
117 :     prln(out, ["(", Var.name x]);
118 :     List.app (fn x => prl(out, [",", Var.name x])) xs;
119 :     prl (out, [") = ", expToString e, ";\n"]))
120 :     | IR.S_GAssign(x, e) => prln(out, [IR.GlobalVar.name x, " = ", expToString e, ";\n"])
121 :     | IR.S_IfThen(cond, blk) => (
122 :     prln (out, ["if (", expToString cond, ") "]);
123 :     ppBlock (out, blk);
124 :     pr (out, "\n"))
125 :     | IR.S_IfThenElse(cond, blk1, blk2) => (
126 :     prln (out, ["if (", expToString cond, ") "]);
127 :     ppBlock (out, blk1);
128 :     pr (out, " else ");
129 :     ppBlock (out, blk2);
130 :     pr (out, "\n"))
131 :     | IR.S_Foreach(x, e, blk) => (
132 :     prln (out, [
133 :     "foreach ", Ty.toString(Var.ty x), " ", Var.name x, " in ", expToString e, " "
134 :     ]);
135 :     ppBlock (out, blk);
136 :     pr (out, "\n"))
137 :     | IR.S_LoadNrrd(x, ty, nrrd) =>
138 :     prln (out, [
139 :     Var.name x, " = load<", Ty.toString ty, "> (\"", String.toString nrrd, "\");\n"
140 :     ])
141 :     | IR.S_Input(x, name, desc, NONE) =>
142 :     prln (out, [
143 :     IR.GlobalVar.name x, " = input<", Ty.toString(IR.GlobalVar.ty x), "> (\"",
144 :     String.toString name, "\",\"", descToString desc, "\");\n"
145 :     ])
146 :     | IR.S_Input(x, name, desc, SOME dflt) =>
147 :     prln (out, [
148 :     IR.GlobalVar.name x, " = input<", Ty.toString(IR.GlobalVar.ty x), "> (\"",
149 :     String.toString name, "\",\"", descToString desc, "\",",
150 :     expToString dflt, ");\n"
151 :     ])
152 :     | IR.S_InputNrrd(x, name, desc, NONE) =>
153 :     prln (out, [
154 :     IR.GlobalVar.name x, " = input-nrrd<", Ty.toString(IR.GlobalVar.ty x), "> (\"",
155 :     String.toString name, "\",\"", descToString desc, "\");\n"
156 :     ])
157 :     | IR.S_InputNrrd(x, name, desc, SOME dflt) =>
158 :     prln (out, [
159 :     IR.GlobalVar.name x, " = input-nrrd<", Ty.toString(IR.GlobalVar.ty x), "> (\"",
160 :     String.toString name, "\",\"", descToString desc, "\",\"",
161 :     String.toString dflt, "\");\n"
162 :     ])
163 : jhr 3749 | IR.S_New(strand, args) =>
164 :     prln (out, [argsToString("new "^Atom.toString strand, args), ";\n"])
165 :     | IR.S_Save([], _) => raise Fail "bogus Save statement"
166 :     | IR.S_Save([x], rhs) =>
167 :     prln (out, [IR.StateVar.toString x, " = ", expToString rhs, ";\n"])
168 :     | IR.S_Save(x::xs, e) => (
169 :     prln(out, ["(", IR.StateVar.toString x]);
170 :     List.app (fn x => prl(out, [",", IR.StateVar.toString x])) xs;
171 :     prl (out, [") = ", expToString e, ";\n"]))
172 : jhr 3691 | IR.S_Exit es => prln (out, [argsToString("exit", es), ";\n"])
173 :     (* return functions for methods *)
174 :     | IR.S_Active => prln (out, ["active;\n"])
175 :     | IR.S_Stabilize => prln (out, ["stabilize;\n"])
176 :     | IR.S_Die => prln (out, ["die;\n"])
177 :     (* end case *))
178 :    
179 :     fun statement (outS, stm) = ppStm((outS, 0), stm)
180 :    
181 :     fun block (outS, blk) = (ppBlock ((outS, 0), blk); pr ((outS, 0), "\n"))
182 :    
183 :     fun program (outS, prog) = let
184 :     val IR.Program{
185 :     props, consts, inputs, constInit, globals, globalInit, strand, create, update
186 :     } = prog
187 :     val out = (outS, 0)
188 :     val out' = incIndent out
189 :     in
190 :     pr(out, "//***** PROPERTIES *****\n");
191 :     case props
192 :     of [] => prln(out', ["none\n"])
193 :     | _ => prln(out', [String.concatWith " " (List.map Properties.toString props), "\n"])
194 :     (* end case *);
195 :     prln(out, ["//***** CONSTS *****\n"]);
196 :     List.app (ppGlobalDecl out') consts;
197 :     prln(out, ["//***** INPUTS *****\n"]);
198 :     (* FIXME
199 :     List.app (ppGlobalDecl out') inputs;
200 :     *)
201 :     prln(out, ["//***** CONST INIT *****\n"]);
202 :     indent out'; ppBlock (out', constInit); pr (out, "\n");
203 :     prln(out, ["//***** GLOBALS *****\n"]);
204 :     List.app (ppGlobalDecl out') globals;
205 :     prln(out, ["//***** GLOBAL INIT *****\n"]);
206 :     indent out'; ppBlock (out', globalInit); pr (out, "\n");
207 :     prln(out, ["//***** STRAND *****\n"]);
208 :     ppStrand out strand;
209 :     prln(out, ["//***** CREATE *****\n"]);
210 :     (* FIXME
211 :     indent out'; ppBlock (out', create); pr (out, "\n");
212 :     *)
213 :     case update
214 :     of SOME blk => (
215 :     prln(out, ["//***** GLOBAL UPDATE *****\n"]);
216 :     indent out'; ppBlock (out', blk); pr (out, "\n"))
217 :     | NONE => ()
218 :     (* end case *)
219 :     end
220 :    
221 :     end

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