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

SCM Repository

[diderot] Annotation of /trunk/src/compiler/IL/ssa-fn.sml
ViewVC logotype

Annotation of /trunk/src/compiler/IL/ssa-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1232 - (view) (download)

1 : jhr 137 (* ssa-fn.sml
2 : jhr 124 *
3 : jhr 1232 * COPYRIGHT (c) 2011 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4 : jhr 124 * All rights reserved.
5 : jhr 137 *
6 : jhr 1116 * The SSAFn functor is used to generate the High, Med, and Low ILs in the Diderot
7 :     * compiler. These ILs have the same program and control-flow structure, but differ
8 :     * in their types and operators.
9 : jhr 124 *)
10 :    
11 : jhr 392 functor SSAFn (
12 : jhr 137
13 : jhr 1232 val ilName : string
14 : jhr 392 structure Ty : SSA_TYPES
15 :     structure Op : OPERATORS where type ty = Ty.ty
16 :    
17 :     ) : SSA = struct
18 :    
19 :     structure Ty = Ty
20 : jhr 192 structure Op = Op
21 : jhr 137
22 : jhr 1232 val ilName = ilName
23 :    
24 : jhr 1116 (***** CFG *****)
25 :    
26 :     datatype cfg = CFG of {
27 :     entry : node, (* the entry node of a graph; not necessarily an ENTRY node *)
28 :     exit : node (* the exit node of a graph; not necessarily an EXIT node. *)
29 :     }
30 :    
31 :     and node = ND of {
32 : jhr 256 id : Stamp.stamp,
33 :     props : PropList.holder,
34 :     kind : node_kind
35 : jhr 197 }
36 :    
37 : jhr 256 and node_kind
38 :     = NULL
39 :     | ENTRY of {
40 :     succ : node ref
41 :     }
42 :     | JOIN of {
43 :     preds : node list ref,
44 : jhr 1116 phis : phi list ref,
45 : jhr 256 succ : node ref
46 :     }
47 :     | COND of {
48 :     pred : node ref,
49 :     cond : var,
50 :     trueBranch : node ref,
51 :     falseBranch : node ref
52 :     }
53 : jhr 1116 | COM of { (* comment *)
54 : jhr 256 pred : node ref,
55 : jhr 1116 text : string list,
56 : jhr 256 succ : node ref
57 :     }
58 : jhr 1116 | ASSIGN of { (* assignment *)
59 :     pred : node ref,
60 :     stm : assign,
61 :     succ : node ref
62 :     }
63 : jhr 511 | NEW of { (* create new strand instance *)
64 : jhr 256 pred : node ref,
65 : jhr 511 strand : Atom.atom,
66 : jhr 256 args : var list,
67 :     succ : node ref
68 :     }
69 : jhr 1116 | EXIT of { (* includes die and stabilize *)
70 :     pred : node ref,
71 :     kind : ExitKind.kind, (* kind of exit node *)
72 :     live : var list (* live variables *)
73 : jhr 256 }
74 : jhr 197
75 : jhr 188 and rhs
76 :     = VAR of var
77 :     | LIT of Literal.literal
78 :     | OP of Op.rator * var list
79 : jhr 1116 | APPLY of ILBasis.name * var list (* basis function application *)
80 :     | CONS of Ty.ty * var list (* tensor/sequence-value construction *)
81 : jhr 188
82 : jhr 192 and var = V of {
83 : jhr 137 name : string, (* name *)
84 : jhr 1116 id : Stamp.stamp, (* unique ID *)
85 : jhr 394 ty : Ty.ty, (* type *)
86 : jhr 367 bind : var_bind ref, (* binding *)
87 : jhr 137 useCnt : int ref, (* count of uses *)
88 :     props : PropList.holder
89 : jhr 124 }
90 :    
91 : jhr 367 and var_bind
92 :     = VB_NONE
93 : jhr 1116 | VB_RHS of rhs (* defined by an assignment (includes globals and state variables) *)
94 :     | VB_PHI of var list (* defined by a phi node *)
95 :     | VB_PARAM (* parameter to a strand *)
96 : jhr 367
97 : jhr 192 withtype assign = (var * rhs)
98 : jhr 1116 and phi = (var * var list)
99 : jhr 188
100 : jhr 1116
101 :     (***** Program representation *****)
102 :    
103 : jhr 256 datatype program = Program of {
104 : jhr 1116 globalInit : cfg,
105 :     initially : initially,
106 : jhr 511 strands : strand list
107 : jhr 256 }
108 : jhr 188
109 : jhr 1116 and initially = Initially of {
110 :     isArray : bool, (* true for initially array, false for collection *)
111 :     rangeInit : cfg, (* code to compute bounds of iteration *)
112 :     iters : (var * var * var) list,
113 :     create : (cfg * Atom.atom * var list)
114 :     }
115 :    
116 : jhr 511 and strand = Strand of {
117 : jhr 256 name : Atom.atom,
118 :     params : var list,
119 : jhr 1116 state : (bool * var) list, (* output variables are marked with true *)
120 :     stateInit : cfg,
121 : jhr 256 methods : method list
122 :     }
123 : jhr 188
124 : jhr 256 and method = Method of {
125 :     name : Atom.atom,
126 :     stateIn : var list, (* names of state variables on method entry *)
127 : jhr 1116 body : cfg (* method body *)
128 : jhr 256 }
129 : jhr 188
130 : jhr 1116 structure Var =
131 :     struct
132 :     fun new (name, ty) = V{
133 :     name = name,
134 :     id = Stamp.new(),
135 :     ty = ty,
136 :     bind = ref VB_NONE,
137 :     useCnt = ref 0,
138 :     props = PropList.newHolder()
139 :     }
140 :     fun copy (V{name, ty, ...}) = new (name, ty)
141 :     fun name (V{name, ...}) = name
142 :     fun ty (V{ty, ...}) = ty
143 :     fun binding (V{bind, ...}) = !bind
144 :     fun setBinding (V{bind, ...}, vb) = bind := vb
145 :     fun useCount (V{useCnt, ...}) = !useCnt
146 :     fun same (V{id=a, ...}, V{id=b, ...}) = Stamp.same(a, b)
147 :     fun compare (V{id=a, ...}, V{id=b, ...}) = Stamp.compare(a, b)
148 :     fun hash (V{id, ...}) = Stamp.hash id
149 :     fun toString (V{name, id, ...}) = name ^ Stamp.toString id
150 :     (* properties *)
151 :     fun newProp initFn =
152 :     PropList.newProp (fn (V{props, ...}) => props, initFn)
153 :     fun newFlag () =
154 :     PropList.newFlag (fn (V{props, ...}) => props)
155 :     local
156 :     structure V =
157 :     struct
158 :     type ord_key = var
159 :     val compare = compare
160 :     end
161 :     in
162 :     structure Map = RedBlackMapFn (V)
163 :     structure Set = RedBlackSetFn (V)
164 :     end
165 :     structure Tbl = HashTableFn (
166 :     struct
167 :     type hash_key = var
168 :     val hashVal = hash
169 :     val sameKey = same
170 :     end)
171 :     end
172 :    
173 : jhr 256 structure Node =
174 :     struct
175 : jhr 511 fun id (ND{id, ...}) = id
176 :     fun kind (ND{kind, ...}) = kind
177 : jhr 256 fun same (ND{id=a, ...}, ND{id=b, ...}) = Stamp.same(a, b)
178 :     fun compare (ND{id=a, ...}, ND{id=b, ...}) = Stamp.compare(a, b)
179 :     fun hash (ND{id, ...}) = Stamp.hash id
180 :     fun toString (ND{id, kind, ...}) = let
181 :     val tag = (case kind
182 :     of NULL => "NULL"
183 :     | ENTRY _ => "ENTRY"
184 :     | JOIN _ => "JOIN"
185 :     | COND _ => "COND"
186 : jhr 1116 | COM _ => "COM"
187 :     | ASSIGN _ => "ASSIGN"
188 : jhr 256 | NEW _ => "NEW"
189 : jhr 1116 | EXIT{kind, ...} => ExitKind.toString kind
190 : jhr 256 (* end case *))
191 :     in
192 :     tag ^ Stamp.toString id
193 :     end
194 :     fun new kind = ND{id = Stamp.new(), props = PropList.newHolder(), kind = kind}
195 : jhr 1116 (* variable defs and uses *)
196 :     fun uses (ND{kind, ...}) = (case kind
197 :     of JOIN{phis, ...} => List.foldr (fn ((_, xs), ys) => xs@ys) [] (!phis)
198 :     | COND{cond, ...} => [cond]
199 :     | ASSIGN{stm=(y, rhs), ...} => (case rhs
200 :     of VAR x => [x]
201 :     | LIT _ => []
202 :     | OP(_, args) => args
203 :     | APPLY(_, args) => args
204 :     | CONS(_, args) => args
205 :     (* end case *))
206 :     | NEW{args, ...} => args
207 :     | EXIT{live, ...} => live
208 :     | _ => []
209 :     (* end case *))
210 :     fun defs (ND{kind, ...}) = (case kind
211 :     of JOIN{phis, ...} => List.map #1 (!phis)
212 :     | ASSIGN{stm=(y, _), ...} => [y]
213 :     | _ => []
214 :     (* end case *))
215 : jhr 256 val dummy = new NULL
216 :     fun mkENTRY () = new (ENTRY{succ = ref dummy})
217 :     fun mkJOIN phis = new (JOIN{preds = ref [], phis = ref phis, succ = ref dummy})
218 :     fun mkCOND {cond, trueBranch, falseBranch} = new (COND{
219 :     pred = ref dummy, cond = cond,
220 :     trueBranch = ref trueBranch, falseBranch = ref falseBranch
221 :     })
222 : jhr 1116 fun mkCOM text = new (COM{pred = ref dummy, text = text, succ = ref dummy})
223 :     fun mkASSIGN (lhs, rhs) = (
224 :     Var.setBinding (lhs, VB_RHS rhs);
225 :     new (ASSIGN{pred = ref dummy, stm = (lhs, rhs), succ = ref dummy}))
226 : jhr 511 fun mkNEW {strand, args} = new (NEW{
227 :     pred = ref dummy, strand = strand, args = args, succ = ref dummy
228 : jhr 256 })
229 : jhr 1116 fun mkEXIT (kind, xs) = new (EXIT{kind = kind, live = xs, pred = ref dummy})
230 :     fun mkFRAGMENT xs = mkEXIT (ExitKind.FRAGMENT, xs)
231 : jhr 1232 fun mkSINIT xs = mkEXIT (ExitKind.SINIT, xs)
232 : jhr 1116 fun mkRETURN xs = mkEXIT (ExitKind.RETURN, xs)
233 :     fun mkACTIVE xs = mkEXIT (ExitKind.ACTIVE, xs)
234 :     fun mkSTABILIZE xs = mkEXIT (ExitKind.STABILIZE, xs)
235 :     fun mkDIE () = mkEXIT (ExitKind.DIE, [])
236 :     fun isNULL (ND{kind=NULL, ...}) = true
237 :     | isNULL _ = false
238 : jhr 256 (* editing node edges *)
239 : jhr 511 fun hasPred (ND{kind, ...}) = (case kind
240 :     of NULL => false
241 :     | ENTRY _ => false
242 :     | _ => true
243 :     (* end case *))
244 : jhr 419 fun setPred (nd0 as ND{kind, ...}, nd) = (case kind
245 : jhr 1116 of NULL => raise Fail("setPred on NULL node " ^ toString nd0)
246 :     | ENTRY _ => raise Fail("setPred on ENTRY node " ^ toString nd0)
247 : jhr 256 | JOIN{preds, ...} => if List.exists (fn nd' => same(nd, nd')) (!preds)
248 :     then ()
249 : jhr 1116 else preds := !preds @ [nd] (* assume preds are added in order *)
250 : jhr 256 | COND{pred, ...} => pred := nd
251 : jhr 1116 | COM{pred, ...} => pred := nd
252 :     | ASSIGN{pred, ...} => pred := nd
253 : jhr 256 | NEW{pred, ...} => pred := nd
254 : jhr 1116 | EXIT{pred, ...} => pred := nd
255 : jhr 256 (* end case *))
256 : jhr 419 fun preds (nd as ND{kind, ...}) = (case kind
257 : jhr 1116 of NULL => [] (*raise Fail("preds on NULL node "^toString nd)*)
258 : jhr 256 | ENTRY _ => []
259 :     | JOIN{preds, ...} => !preds
260 :     | COND{pred, ...} => [!pred]
261 : jhr 1116 | COM{pred, ...} => [!pred]
262 :     | ASSIGN{pred, ...} => [!pred]
263 : jhr 256 | NEW{pred, ...} => [!pred]
264 : jhr 1116 | EXIT{pred, ...} => [!pred]
265 : jhr 256 (* end case *))
266 :     fun hasSucc (ND{kind, ...}) = (case kind
267 :     of NULL => false
268 : jhr 1116 | ENTRY _ => true
269 :     | JOIN _ => true
270 :     | COND _ => true
271 :     | COM _ => true
272 :     | ASSIGN _ => true
273 :     | NEW _ => true
274 : jhr 256 | EXIT _ => false
275 :     (* end case *))
276 : jhr 419 fun setSucc (nd0 as ND{kind, ...}, nd) = (case kind
277 :     of NULL => raise Fail("setSucc on NULL node "^toString nd0)
278 : jhr 256 | ENTRY{succ} => succ := nd
279 :     | JOIN{succ, ...} => succ := nd
280 : jhr 419 | COND _ => raise Fail("setSucc on COND node "^toString nd0)
281 : jhr 1116 | COM{succ, ...} => succ := nd
282 :     | ASSIGN{succ, ...} => succ := nd
283 : jhr 256 | NEW{succ, ...} => succ := nd
284 : jhr 419 | EXIT _ => raise Fail("setSucc on EXIT node "^toString nd0)
285 : jhr 256 (* end case *))
286 : jhr 419 fun succs (nd as ND{kind, ...}) = (case kind
287 : jhr 1116 of NULL => [] (*raise Fail("succs on NULL node "^toString nd)*)
288 : jhr 256 | ENTRY{succ} => [!succ]
289 :     | JOIN{succ, ...} => [!succ]
290 :     | COND{trueBranch, falseBranch, ...} => [!trueBranch, !falseBranch]
291 : jhr 1116 | COM{succ, ...} => [!succ]
292 :     | ASSIGN{succ, ...} => [!succ]
293 : jhr 256 | NEW{succ, ...} => [!succ]
294 :     | EXIT _ => []
295 :     (* end case *))
296 :     fun setTrueBranch (ND{kind=COND{trueBranch, ...}, ...}, nd) = trueBranch := nd
297 :     | setTrueBranch (nd, _) = raise Fail("setTrueBranch on " ^ toString nd)
298 :     fun setFalseBranch (ND{kind=COND{falseBranch, ...}, ...}, nd) = falseBranch := nd
299 :     | setFalseBranch (nd, _) = raise Fail("setFalseBranch on " ^ toString nd)
300 :     fun addEdge (nd1, nd2) = (
301 :     if hasSucc nd1
302 :     then (
303 :     setSucc (nd1, nd2);
304 :     setPred (nd2, nd1))
305 :     else ())
306 :     (*DEBUG*)handle ex => (
307 :     print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);
308 :     raise ex)
309 : jhr 1116 fun replaceInEdge {src, oldDst, dst} = (
310 :     (* first set the successor of src *)
311 :     case kind src
312 :     of COND{trueBranch, falseBranch, ...} =>
313 :     if same(!trueBranch, oldDst)
314 :     then trueBranch := dst
315 :     else falseBranch := dst
316 :     | _ => setSucc (src, dst)
317 :     (* end case *);
318 :     (* then set the predecessor of dst *)
319 :     setPred (dst, src))
320 :     (*DEBUG*)handle ex => (
321 :     print(concat["error in replaceInEdge(", toString src, ",", toString oldDst, ",", toString dst, ")\n"]);
322 :     raise ex)
323 :     fun replaceOutEdge {oldSrc, src, dst} = (
324 :     (* first set the successor of src *)
325 : jhr 1232 case kind oldSrc
326 :     of COND{trueBranch, falseBranch, ...} =>
327 :     if same(!trueBranch, dst)
328 :     then setTrueBranch (src, dst)
329 :     else setFalseBranch (src, dst)
330 :     | _ => setSucc (src, dst)
331 :     (* end case *);
332 : jhr 1116 (* then set the predecessor of dst *)
333 :     case kind dst
334 :     of JOIN{preds, ...} => let
335 :     fun edit [] = raise Fail "replaceOutEdge: cannot find predecessor"
336 :     | edit (nd::nds) = if same(nd, oldSrc) then src::nds else nd::edit nds
337 :     in
338 :     preds := edit (!preds)
339 :     end
340 :     | _ => setPred (dst, src)
341 :     (* end case *))
342 :     (*DEBUG*)handle ex => (
343 :     print(concat["error in replaceOutEdge(", toString oldSrc, ",", toString src, ",", toString dst, ")\n"]);
344 :     raise ex)
345 : jhr 283 (* properties *)
346 :     fun newProp initFn =
347 :     PropList.newProp (fn (ND{props, ...}) => props, initFn)
348 :     fun newFlag () =
349 :     PropList.newFlag (fn (ND{props, ...}) => props)
350 : jhr 256 end
351 : jhr 124
352 : jhr 1116 structure CFG =
353 : jhr 256 struct
354 : jhr 1116 val empty = CFG{entry = Node.dummy, exit = Node.dummy}
355 :    
356 :     fun isEmpty (CFG{entry, exit}) =
357 :     Node.same(entry, exit) andalso Node.isNULL entry
358 :    
359 :     (* create a basic block from a list of assignments *)
360 :     fun mkBlock [] = empty
361 :     | mkBlock (stm::stms) = let
362 :     val entry = Node.mkASSIGN stm
363 :     fun f (stm, prev) = let
364 :     val nd = Node.mkASSIGN stm
365 :     in
366 :     Node.addEdge (prev, nd);
367 :     nd
368 :     end
369 :     val exit = List.foldl f entry stms
370 : jhr 256 in
371 : jhr 1116 CFG{entry = entry, exit = exit}
372 : jhr 256 end
373 : jhr 1116
374 :     (* entry/exit nodes of a CFG *)
375 :     fun entry (CFG{entry = nd, ...}) = nd
376 :     fun exit (CFG{exit = nd, ...}) = nd
377 :    
378 :     (* return the list of variables that are live at exit from a CFG *)
379 :     fun liveAtExit cfg = (case Node.kind(exit cfg)
380 :     of EXIT{live, ...} => live
381 :     | _ => raise Fail "bogus exit node"
382 : jhr 256 (* end case *))
383 : jhr 1116
384 :     (* DFS sorting of the graph rooted at the entry to a statement; the resulting list will
385 :     * be in preorder with parents before children.
386 :     *)
387 :     fun sort (CFG{entry, ...}) = let
388 :     val {getFn, setFn} = PropList.newFlag (fn (ND{props, ...}) => props)
389 :     fun dfs (nd, l) =
390 :     if getFn nd
391 :     then l
392 :     else (
393 :     setFn (nd, true);
394 :     nd :: List.foldl dfs l (Node.succs nd))
395 :     val nodes = dfs (entry, [])
396 : jhr 256 in
397 : jhr 1116 List.app (fn nd => setFn(nd, false)) nodes;
398 :     nodes
399 : jhr 256 end
400 : jhr 137
401 : jhr 1116 (* apply a function to all of the nodes in the graph rooted at the entry to the statement *)
402 :     fun apply (f : node -> unit) (CFG{entry, ...}) = let
403 :     val {getFn, setFn} = PropList.newFlag (fn (ND{props, ...}) => props)
404 :     fun dfs (nd, l) =
405 :     if getFn nd
406 :     then l
407 :     else (
408 :     f nd; (* visit *)
409 :     setFn (nd, true);
410 :     nd :: List.foldl dfs l (Node.succs nd))
411 :     val nodes = dfs (entry, [])
412 :     in
413 :     List.app (fn nd => setFn(nd, false)) nodes
414 :     end
415 :    
416 :     (* delete a simple node from a CFG *)
417 :     fun deleteNode (nd as ND{kind, ...}) = (case kind
418 :     of ASSIGN{pred = ref pred, succ = ref succ, ...} => (
419 :     Node.setPred (succ, pred);
420 :     case Node.kind pred
421 :     of COND{trueBranch, falseBranch, ...} => (
422 :     (* note that we treat each branch independently, so that we handle the
423 :     * situation where both branches are the same node.
424 :     *)
425 :     if Node.same(!trueBranch, nd)
426 :     then Node.setTrueBranch(pred, succ)
427 :     else ();
428 :     if Node.same(!falseBranch, nd)
429 :     then Node.setFalseBranch(pred, succ)
430 :     else ())
431 :     | _ => Node.setSucc (pred, succ)
432 :     (* end case *))
433 :     | _ => raise Fail "unsupported deleteNode"
434 :     (* end case *))
435 :    
436 :     (* replace a simple node in a cfg with a subgraph *)
437 :     fun replaceNode (oldNd as ND{kind, ...}, node) = (case kind
438 :     of ASSIGN{pred, succ, ...} => (
439 :     Node.replaceInEdge {src = !pred, oldDst = oldNd, dst = node};
440 :     Node.replaceOutEdge {oldSrc = oldNd, src = node, dst = !succ})
441 :     | NEW{pred, succ, ...} => (
442 :     Node.replaceInEdge {src = !pred, oldDst = oldNd, dst = node};
443 :     Node.replaceOutEdge {oldSrc = oldNd, src = node, dst = !succ})
444 :     | EXIT{pred, ...} =>
445 :     Node.replaceInEdge {src = !pred, oldDst = oldNd, dst = node}
446 :     | _ => raise Fail "unsupported replaceNode"
447 :     (* end case *))
448 :    
449 :     (* replace a simple node in a cfg with a subgraph *)
450 :     fun replaceNodeWithCFG (nd as ND{kind, ...}, cfg as CFG{entry, exit}) =
451 :     if isEmpty cfg
452 :     then deleteNode nd
453 :     else (case kind
454 :     of ASSIGN{pred, succ, ...} => (
455 :     Node.replaceInEdge {src = !pred, oldDst = nd, dst = entry};
456 :     Node.replaceOutEdge {oldSrc = nd, src = exit, dst = !succ})
457 :     | _ => raise Fail "unsupported replaceNodeWithCFG"
458 :     (* end case *))
459 :    
460 :     (* concatenate two CFGs *)
461 :     fun concat (cfg1 as CFG{entry=e1, exit=x1}, cfg2 as CFG{entry=e2, exit=x2}) =
462 :     if isEmpty cfg1 then cfg2
463 :     else if isEmpty cfg2 then cfg1
464 :     else (
465 :     Node.setSucc (x1, e2);
466 :     Node.setPred (e2, x1);
467 :     CFG{entry = e1, exit = x2})
468 :    
469 :     (* append a node to a CFG *)
470 :     fun appendNode (cfg as CFG{entry, exit}, nd) =
471 :     if isEmpty cfg
472 :     then CFG{entry=nd, exit=nd}
473 :     else (
474 :     Node.setPred (nd, exit);
475 :     Node.setSucc (exit, nd);
476 :     CFG{entry=entry, exit=nd})
477 :    
478 : jhr 1232 (* update the exit of a CFG by modifying the live variable list *)
479 :     fun updateExit (CFG{entry, exit as ND{kind, ...}}, f) = let
480 :     val newExit = (case kind
481 :     of EXIT{pred, kind, live} => let
482 :     val newNd = Node.mkEXIT(kind, f live)
483 :     in
484 :     Node.replaceInEdge {src = !pred, oldDst = exit, dst = newNd};
485 :     newNd
486 :     end
487 :     | _ => raise Fail "bogus exit node for updateExit"
488 :     (* end case *))
489 :     in
490 :     CFG{entry=entry, exit=newExit}
491 :     end
492 : jhr 199 end
493 : jhr 197
494 : jhr 1232 structure RHS =
495 :     struct
496 :     fun vars rhs = (case rhs
497 :     of VAR x => [x]
498 :     | LIT _ => []
499 :     | OP(rator, xs) => xs
500 :     | APPLY(g, xs) => xs
501 :     | CONS(ty, xs) => xs
502 :     (* end case *))
503 : jhr 1116
504 : jhr 1232 fun map f = let
505 :     fun mapf rhs = (case rhs
506 :     of VAR x => VAR(f x)
507 :     | LIT _ => rhs
508 :     | OP(rator, xs) => OP(rator, List.map f xs)
509 :     | APPLY(g, xs) => APPLY(g, List.map f xs)
510 :     | CONS(ty, xs) => CONS(ty, List.map f xs)
511 :     (* end case *))
512 :     in
513 :     mapf
514 :     end
515 :    
516 :     fun app f = let
517 :     fun mapf rhs = (case rhs
518 :     of VAR x => f x
519 :     | LIT _ => ()
520 :     | OP(rator, xs) => List.app f xs
521 :     | APPLY(_, xs) => List.app f xs
522 :     | CONS(ty, xs) => List.app f xs
523 :     (* end case *))
524 :     in
525 :     mapf
526 :     end
527 :    
528 :     (* return a string representation of a rhs *)
529 :     fun toString rhs = (case rhs
530 :     of VAR x => Var.toString x
531 :     | LIT lit => Literal.toString lit
532 :     | OP(rator, xs) => String.concat [
533 :     Op.toString rator,
534 :     "(", String.concatWith "," (List.map Var.toString xs), ")"
535 :     ]
536 :     | APPLY(f, xs) => String.concat [
537 :     ILBasis.toString f,
538 :     "(", String.concatWith "," (List.map Var.toString xs), ")"
539 :     ]
540 :     | CONS(ty, xs) => String.concat [
541 :     "<", Ty.toString ty, ">[",
542 :     String.concatWith "," (List.map Var.toString xs), "]"
543 :     ]
544 :     (* end case *))
545 :     end
546 :    
547 : jhr 1116 (* return a string representation of a variable binding *)
548 :     fun vbToString VB_NONE = "NONE"
549 : jhr 1232 | vbToString (VB_RHS rhs) = concat["RHS(", RHS.toString rhs, ")"]
550 : jhr 1116 | vbToString (VB_PHI xs) = concat[
551 :     "PHI(", String.concatWith "," (List.map Var.toString xs), ")"
552 :     ]
553 :     | vbToString VB_PARAM = "PARAM"
554 :    
555 :    
556 : jhr 412 (* return a string representation of a PHI node *)
557 :     fun phiToString (y, xs) = String.concat [
558 :     Ty.toString(Var.ty y), " ", Var.toString y, " = PHI(",
559 :     String.concatWith "," (List.map Var.toString xs), ")"
560 :     ]
561 :    
562 :     (* return a string representation of an assignment *)
563 : jhr 1116 fun assignToString (y, rhs) =
564 : jhr 1232 String.concat [Ty.toString(Var.ty y), " ", Var.toString y, " = ", RHS.toString rhs]
565 : jhr 412
566 : jhr 1116 end (* SSAFn *)

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