Revision 3b2bd83d src/causality.ml
src/causality.ml  

20  20 
open Graph 
21  21 
open Format 
22  22  
23 
exception Cycle of ident list 

23 
type error = 

24 
 DataCycle of ident list 

25 
 NodeCycle of ident list 

26  
27 
exception Error of error 

24  28  
25 
module IdentDepGraph = Graph.Imperative.Digraph.ConcreteBidirectional (IdentModule) 

26  29  
30 
module IdentDepGraph = Graph.Imperative.Digraph.ConcreteBidirectional (IdentModule) 

31 
(*module DotGraph = Graphviz.Dot (IdentDepGraph)*) 

32 
module Bfs = Traverse.Bfs (IdentDepGraph) 

33 


27  34 
(* Dependency of mem variables on mem variables is cut off 
28  35 
by duplication of some mem vars into local node vars. 
29  36 
Thus, cylic dependency errors may only arise between nomem vars. 
...  ...  
225  232 
 Expr_arrow (e1, e2) > add_dep lhs_is_mem lhs e2 (add_dep lhs_is_mem lhs e1 g) 
226  233 
 Expr_when (e, c, _) > add_dep lhs_is_mem lhs e (add_var lhs_is_mem lhs c g) 
227  234 
 Expr_appl (f, e, None) > 
228 
if Basic_library.is_internal_fun f


235 
if Basic_library.is_expr_internal_fun rhs


229  236 
(* tuple componentwise dependency for internal operators *) 
230  237 
then 
231  238 
List.fold_right (add_dep lhs_is_mem lhs) (expr_list_of_expr e) g 
...  ...  
278  285 
 Expr_pre e 
279  286 
 Expr_when (e,_,_) > get_expr_calls prednode e 
280  287 
 Expr_appl (id,e, _) > 
281 
if not (Basic_library.is_internal_fun id) && prednode id


288 
if not (Basic_library.is_expr_internal_fun expr) && prednode id


282  289 
then ESet.add expr (get_expr_calls prednode e) 
283  290 
else (get_expr_calls prednode e) 
284  291  
...  ...  
311  318 
) prog g in 
312  319 
g 
313  320  
321 
(* keep subgraph of [gr] consisting of nodes accessible from node [v] *) 

322 
let slice_graph gr v = 

323 
begin 

324 
let gr' = new_graph () in 

325 
IdentDepGraph.add_vertex gr' v; 

326 
Bfs.iter_component (fun v > IdentDepGraph.iter_succ (fun s > IdentDepGraph.add_vertex gr' s; IdentDepGraph.add_edge gr' v s) gr v) gr v; 

327 
gr' 

328 
end 

329 


314  330 
let rec filter_static_inputs inputs args = 
315  331 
match inputs, args with 
316  332 
 [] , [] > [] 
...  ...  
368  384 
let scc_l = Cycles.scc_list g in 
369  385 
List.iter (fun partition > 
370  386 
if wrong_partition g partition then 
371 
raise (Cycle partition)


387 
raise (Error (DataCycle partition))


372  388 
else () 
373  389 
) scc_l 
374  390  
...  ...  
515  531 
Format.fprintf fmt "}@." 
516  532 
end 
517  533  
518 
let pp_error fmt trace = 

519 
fprintf fmt "@.Causality error, cyclic data dependencies: %a@." 

520 
(fprintf_list ~sep:", " pp_print_string) trace 

534 
let pp_error fmt err = 

535 
match err with 

536 
 DataCycle trace > 

537 
fprintf fmt "@.Causality error, cyclic data dependencies: %a@." 

538 
(fprintf_list ~sep:", " pp_print_string) trace 

539 
 NodeCycle trace > 

540 
fprintf fmt "@.Causality error, cyclic node calls: %a@." 

541 
(fprintf_list ~sep:", " pp_print_string) trace 

521  542  
522  543 
(* Merges elements of graph [g2] into graph [g1] *) 
523  544 
let merge_with g1 g2 = 
Also available in: Unified diff