diff --git a/compiler/heptagon/analysis/causal.ml b/compiler/heptagon/analysis/causal.ml index f53b395..a572207 100644 --- a/compiler/heptagon/analysis/causal.ml +++ b/compiler/heptagon/analysis/causal.ml @@ -115,14 +115,20 @@ let rec cand nc1 nc2 = | nc1, Aor(nc2, nc22) -> Aor(cand nc1 nc2, cand nc1 nc22) | Aac(ac1), Aac(ac2) -> Aac(Aand(ac1, ac2)) +let mk_tuple l = match l with + | [] -> Aempty + | [ac] -> Aac ac + | _ -> Aac (Atuple l) + let rec ctuple l = let rec norm_or l res = match l with - | [] -> Aac (Atuple (List.rev res)) + | [] -> mk_tuple (List.rev res) | Aempty::l -> norm_or l res | Aor (Aempty, nc2)::l -> norm_or (nc2::l) res | Aor (nc1, Aempty)::l -> norm_or (nc1::l) res | Aor(nc1, nc2)::l -> Aor(norm_or (nc1::l) res, norm_or (nc2::l) res) + | (Aac (Atuple l1))::l -> norm_or l (l1@res) | (Aac ac)::l -> norm_or l (ac::res) in norm_or l [] @@ -138,6 +144,8 @@ and norm = function | Clastread(n) -> Aac(Alastread(n)) | _ -> Aempty +exception Self_dependency + (* building a dependence graph from a scheduling constraint *) let build ac = (* associate a graph node for each name declaration *) @@ -172,19 +180,27 @@ let build ac = let make_graph ac n_to_graph lin_map = let attach node n = try - let g = Env.find n n_to_graph in add_depends node g + let g = Env.find n n_to_graph in + if g.g_tag = node.g_tag then + raise Self_dependency + else + add_depends node g with | Not_found -> () in let attach_lin node n = try - let g = Env.find n lin_map in add_depends g node + let g = Env.find n lin_map in + if g.g_tag = node.g_tag then + raise Self_dependency + else + add_depends g node with | Not_found -> () in let rec add_dependence g = function | Aread(n) -> attach g n; attach_lin g n - | Alinread(n) -> attach g n; attach_lin g n + | Alinread(n) -> attach g n | _ -> () in @@ -205,7 +221,7 @@ let build ac = (try node_for_tuple l with Not_found -> make ac) - | _ -> make ac + | _ -> raise Not_found in let rec make_graph ac = @@ -226,17 +242,8 @@ let build ac = | Aread(n) ->let g = make ac in attach g n; attach_lin g n; [g], [g] | Alinread(n) -> let g = Env.find n lin_map in attach g n; [g], [g] | Atuple(l) -> - let make_graph_tuple ac = - match ac with - | Aand _ | Atuple _ -> make_graph ac - | _ -> [], [] - in let g = node_for_ac ac in - List.iter (add_dependence g) l; - (* let top_l, bot_l = List.split (List.map make_graph_tuple l) in - let top_l = List.flatten top_l in - let bot_l = List.flatten bot_l in - g::top_l, g::bot_l *) [g], [g] + List.iter (add_dependence g) l; [g], [g] | _ -> [], [] in @@ -250,10 +257,15 @@ let build ac = (* the main entry. *) let check loc c = let check_ac ac = - let { g_bot = g_list } = build ac in - match cycle g_list with - | None -> () - | Some _ -> error (Ecausality_cycle ac) in + try + (let { g_bot = g_list } = build ac in + match cycle g_list with + | None -> () + | Some _ -> error (Ecausality_cycle ac)) + with + | Self_dependency -> error (Ecausality_cycle ac) + in + let rec check = function | Aempty -> () diff --git a/compiler/heptagon/analysis/causality.ml b/compiler/heptagon/analysis/causality.ml index 0b137af..f3eb953 100644 --- a/compiler/heptagon/analysis/causality.ml +++ b/compiler/heptagon/analysis/causality.ml @@ -145,7 +145,7 @@ and apply op e_list = let t1 = typing e1 in let i2 = typing e2 in let i3 = typing e3 in - cseq t1 (cor i2 i3) + ctuplelist [t1; i2; i3] | ( Efun _| Enode _ | Econcat | Eselect_slice | Eselect_dyn | Eselect_trunc | Eselect | Earray_fill | Ereinit) -> ctuplelist (List.map typing e_list) diff --git a/compiler/minils/transformations/schedule_interf.ml b/compiler/minils/transformations/schedule_interf.ml index b4289a9..7b59b4f 100644 --- a/compiler/minils/transformations/schedule_interf.ml +++ b/compiler/minils/transformations/schedule_interf.ml @@ -118,7 +118,10 @@ let schedule eq_list inputs node_list = let uses = Interference.compute_uses eq_list in let rec schedule_aux rem_eqs sched_eqs node_list ck costs = match rem_eqs with - | [] -> sched_eqs + | [] -> + if List.length node_list <> 0 then + Misc.internal_error "Node is unschedulable"; + sched_eqs | _ -> (* First choose the next equation to schedule depending on costs*) let eq = Cost.next_equation rem_eqs ck costs in