Project

General

Profile

Revision 3b2bd83d src/causality.ml

View differences:

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 no-mem 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 component-wise 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