Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /MLRISC/releases/release-110.64/ir-archive/cfg-restructure.sml
ViewVC logotype

Annotation of /MLRISC/releases/release-110.64/ir-archive/cfg-restructure.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2656 - (view) (download)

1 : george 912 (*
2 :     * This module inserts preheaders and other stuff.
3 :     * This is probably no longer used.
4 :     *
5 :     * -- Allen
6 :     *)
7 :    
8 :     functor ControlFlowGraphRestructure
9 :     (structure Loop : LOOP_STRUCTURE) : CONTROL_FLOW_GRAPH_RESTRUCTURE =
10 :     struct
11 :     structure Loop = Loop
12 :     structure G = Graph
13 :    
14 :     fun restructure (G.GRAPH cfg,G.GRAPH loop)
15 :     { add_preheader,
16 :     add_landing_pad
17 :     } =
18 :     let val add_node = #add_node cfg
19 :     fun preheader f =
20 :     fn {header,backedges} =>
21 :     let val in_edges = #in_edges cfg header
22 :     fun g([],entries) = entries
23 :     | g((e as (i,j,_))::es,entries) =
24 :     if List.exists (fn (i',j',_) => i=i' andalso j=j')
25 :     backedges then g(es,entries)
26 :     else g(es,e::entries)
27 :     in f{header =(header,#node_info cfg header),
28 :     entries=g(in_edges,[])
29 :     }
30 :     end
31 :    
32 :     fun landing_pads f = fn {exits} => app (fn e => f {exit=e}) exits
33 :    
34 :     fun nop _ = ()
35 :     val insert_preheader = case add_preheader of
36 :     SOME f => preheader f
37 :     | NONE => nop
38 :     val insert_landing_pads = case add_landing_pad of
39 :     SOME f => landing_pads f
40 :     | NONE => nop
41 :     fun process_loop(i,Loop.LOOP{header,backedges=[],exits,...}) = ()
42 :     | process_loop(i,Loop.LOOP{header,backedges,exits,...}) =
43 :     (insert_preheader{header=header,backedges=backedges};
44 :     insert_landing_pads{exits=exits}
45 :     )
46 :     in
47 :     #forall_nodes loop process_loop
48 :     end
49 :    
50 :     end
51 :    

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