From 3ee0e5e7b41b307b246ac3bf6ce61d52c96e3a1b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9dric=20Pasteur?= Date: Wed, 20 Apr 2011 11:19:18 +0200 Subject: [PATCH] First version of interference.ml --- compiler/minils/analysis/interference.ml | 344 ++++++++++++++++++ compiler/minils/minils.ml | 3 + compiler/minils/mls_utils.ml | 21 +- .../utilities/minils/interference_graph.ml | 35 +- 4 files changed, 392 insertions(+), 11 deletions(-) create mode 100644 compiler/minils/analysis/interference.ml diff --git a/compiler/minils/analysis/interference.ml b/compiler/minils/analysis/interference.ml new file mode 100644 index 0000000..b5d5ddb --- /dev/null +++ b/compiler/minils/analysis/interference.ml @@ -0,0 +1,344 @@ +open Idents +open Interference_graph + +let memoize f = + let map = Hashtbl.create 100 in + fun x -> + try + Hashtbl.find map x + with + | Not_found -> let r = f x in Hashtbl.add map x r; r + +let memoize_couple f = + let map = Hashtbl.create 100 in + fun (x,y) -> + try + Hashtbl.find map (x,y) + with + | Not_found -> + let r = f (x,y) in Hashtbl.add map (x,y) r; Hashtbl.add map (y,x) r; r + +(** [iter_couple f l] calls f for all x and y distinct in [l]. *) +let rec iter_couple f l = match l with + | [] -> () + | x::l -> + List.iter (f x) l; + iter_couple f l + +module ListMap = functor (Ord:OrderedType) -> +struct + include Map.Make(Ord) + + let add_element k v m = + try + add k (v::(find k m)) m + with + | Not_found -> add k [v] m +end + +type TyEnv = + ListMap.Make (struct + type t = Types.ty + let compare = Global_compare.type_compare + end) + + +module world = struct + let vds = ref Idents.Env.empty + let memories = ref IvarSet.empty + + let init_world f = + (* build vds cache *) + let build env vd = + Idents.Env.add vd.v_ident vd env + in + let env = build Idents.Env.empty f.n_input in + let env = build env f.n_output in + let env = build env f.n_local in + vds := env; + (* build the set of memories *)ml + let mems = Mls_utils.node_memory_vars f in + memories := List.fold_left (fun s (x, _) -> IvarSet.add (Ivar x) s) IvarSet.empty mems + + let vd_from_ident x = + Idents.Env.find x !vds + + let is_optimized_ty ty = true + + let is_memory x = + Idents.IdentSet.mem x !memories + + let rec ivar_type iv = match iv with + | Ivar x -> + let vd = vd_from_ident x in + vd.v_type + | Ifield(_, f) -> + Modules.find_field f + + let igs = ref [] + + let node_for_ivar iv = + let rec _node_for_ivar igs x = + match igs with + | [] -> (*Format.eprintf "Var not in graph: %s\n" (ivar_to_string x); *) raise Not_found + | ig::igs -> + (try + ig, node_for_value ig iv + with Not_found -> + _node_for_ivar igs iv) + in + _node_for_ivar !World.igs iv + + let node_for_name x = + node_for_ivar (Ivar x) +end + +(** Helper functions to work with the multiple interference graphs *) + +let by_ivar f x y = + let igx, nodex = World.node_for_ivar x in + let igy, nodey = World.node_for_ivar y in + if igx == igy then + f igx nodex nodey + +let by_name f x y = + let igx, nodex = World.node_for_name x in + let igy, nodey = World.node_for_name y in + if igx == igy then + f igx nodex nodey + +let add_interference_link_from_name = by_name add_interference_link +let add_interference_link_from_ivar = by_ivar add_interference_link +let add_affinity_link_from_name = by_name add_affinity_link +let coalesce_from_name = by_name coalesce +let have_same_value_from_name = by_name have_same_value + + + +(** Returns a map giving the number of uses of each ivar in the equations [eqs]. *) +let compute_uses eqs = + let aux env eq = + let incr_uses env iv = + if IvarEnv.mem iv env then + IvarEnv.add iv ((IvarEnv.find iv env) + 1) env + else + IvarEnv.add iv 1 env + in + List.fold_left incr_uses env (InterfRead.read eq) + in + List.fold_left aux IvarEnv.empty eqs + +let number_uses iv uses = + try + IvarEnv.find iv uses + with + | Not_found -> 0 + +let add_uses uses env iv = + if World.is_optimized iv then + IvarEnv.add iv (number_uses iv uses) env + else + env + +let compute_live_vars mems eqs = + let uses = compute_uses eqs in + let aux eq (env,res) = + let decr_uses env iv = + if World.is_optimized iv then + try + IvarEnv.add iv ((IvarEnv.find iv env) - 1) env + with + | Not_found -> assert false + else + env + in + let env = List.fold_left decr_uses env (InterfRead.read eq) in + let alive_vars = IvarEnv.fold (fun iv n acc -> if acc > 0 then iv::acc else acc) env [] in + let res = (eq, alive_vars)::res in + let env = List.fold_left (add_uses uses) env (InterfRead.def eq) in + env, res + in + let env = List.fold_left (add_uses uses) IvarEnv.empty mems in + let _, res = List.fold_right aux eqs (env, []) in + res + + +let disjoint_clock is_mem ck1 ck2 = + match vdx.v_clock, vdy.v_clock with + | Clocks.Con(ck1, c1, n1), Clocks.Con(ck2,c2,n2) -> + let separated_by_reset = + (match x_is_mem, y_is_mem with + | true, true -> are_separated_by_reset c1 c2 + | _, _ -> true) in + ck1 = ck2 & n1 = n2 & c1 <> c2 & separated_by_reset + | _ -> false + +(** [should_interfere x y] returns whether variables x and y + can interfere. *) +let should_interfere x y = + let vdx = World.vd_from_ident x in + let vdy = World.vd_from_ident y in + if Global_compare.compare_type vdx.v_type vdy.v_type <> 0 then + false + else ( + let x_is_mem = World.is_memory x in + let y_is_mem = World.is_memory y in + let are_copies = have_same_value_by_name x y in + let disjoint_clocks = disjoint_clock (x_is_mem && y_is_mem) vdx.v_clock vdy.v_clock in + not (disjoint_clocks or are_copies) + ) + +let should_interfere = memoize_couple should_interfere + +(** Builds the (empty) interference graphs corresponding to the + variable declaration list vds. It just creates one graph per type + and one node per declaration. *) +let init_interference_graph () = + (** Adds a node to the list of nodes for the given type. *) + let add_node env iv ty = + let ty = unalias_type ty in + if World.is_optimized_ty ty then + TyEnv.add_element ty (mk_node iv) env + else + env + in + (** Adds a node for the variable and all fields of a variable. *) + let rec add_ivar env iv ty = + let env = add_node env iv ty in + (match ty with + | Tid n -> + (try + let fields = find_struct n in + List.fold_left (fun env { f_name = f; f_type = ty } -> + add_ivar env (Ifield (iv, f)) ty) env fields + with + Not_found -> env + ) + | _ -> env + ) + in + let env = Idents.Env.fold + (fun _ vd env -> add_ivar env (Ivar vd.v_ident) vd.v_type) TyEnv.empty !World.vds in + World.igs := TyEnv.fold mk_graph [] env + + +(** Adds interferences between all the variables in + the list. If force is true, then interference is added + whatever the variables are, without checking if interference + is real. *) +let rec add_interferences_from_list force vars = + let add_interference x y = + match x, y with + | IVar x, IVar y -> + if force or should_interfere x y then + add_interference_link_from_ivar (IVar x) (IVar y) + | _, _ -> add_interference_link_from_ivar x y + in + iter_couple add_interference vars + +(** Adds to the interference graphs [igs] the + interference resulting from the live vars sets + stored in hash. *) +let add_interferences igs live_vars = + List.iter (fun (_, vars) -> add_interferences_from_list false vars) live_vars + + + +(** [filter_vars l] returns a list of variables whose fields appear in + a list of ivar.*) +let rec filter_fields = function + | [] -> [] + | (IField (id, f))::l -> id::(filter_fields l) + | _::l -> filter_fields l + +(** Returns all the fields of a variable (when it corresponds to a record). *) +let rec record_vars acc iv ty = + let acc = iv::acc in + match ty with + | Tid n -> + (try + let fields = find_struct n in + List.fold_left (fun acc { f_name = n; f_type = ty } -> + record_vars acc (Ifield(iv, n)) ty) acc fields + with + Not_found -> acc + ) + | _ -> acc + +(** Adds all fields of a var in the list of live variables of + every equation. If x is live in eq, then so are all x.f. *) +let fix_records_live_vars live_vars = + let fix_one_list vars = + List.fold_left (fun acc iv -> record_vars [] iv (World.ivar_type)) [] vars + in + List.map (fun (eq, vars) -> eq, fix_one_list vars) live_vars + +(** Adds the interference between records variables + caused by interferences between their fields. *) +let add_records_field_interferences () = + let add_record_interf n1 n2 = + if interfere n1 n2 then + let v1 = filter_fields n1 in + let v2 = filter_fields n2 in + iter_couple add_interference_link_from_name v1 v2 + in + List.iter (fun ig -> iter_interf add_record_interf ig.g_nodes) igs + + + +(** [process_eq igs eq] adds to the interference graphs igs + the links corresponding to the equation. Interferences + corresponding to live vars sets are already added by build_interf_graph. +*) +let process_eq ({ eq_lhs = pat; eq_rhs = e } as eq) = + (** Other cases*) + match pat, e.e_desc with + (* | Eapp ({ a_op = (Efun f | Enode f) }, e_list, _) -> + let targeting = (find_value f).node_targeting in + apply_targeting igs targeting e_list pat eq *) + | _, Eiterator(Imap, { a_op = Enode f | Efun f }, _, e_list, _) -> + let invars = List.map var_from_exp e_list in + let outvars = vars_from_pat pat in + List.iter (fun inv -> List.iter + (add_affinity_link_from_name inv) outvars) invars + | Evarpat x, Efby(_, e) -> (* x = _ fby y *) + let y = assert_1 (InterfRead.read e) in + add_affinity_link_from_name y x + | Evarpat x, Eextvalue { w_desc = Wvar y } -> + (* Add links between variables with the same value *) + add_same_value_link_from_name y x + | _ -> () (* do nothing *) + +(** Add the special init and return equations to the dependency graph + (resp at the bottom and top) *) +let add_init_return_eq f = + (** a_1,..,a_p = __init__ *) + let eq_init = mk_equation (pat_from_dec_list f.n_input) + (mk_extvalue_exp (Wconst (mk_static_int 0))) in + (** __return__ = o_1,..,o_q *) + let eq_return = mk_equation (Etuplepat []) + (mk_exp (tuple_from_dec_list f.n_output)) in + (eq_init::f.n_equs)@[eq_return] + + +let build_interf_graph f = + World.init f; + (** Init interference graph *) + init_interference_graph (); + + let eqs = add_init_return_eq f in + (** Build live vars sets for each equation *) + let live_vars = compute_live_vars eqs in + (* Coalesce linear variables *) + (*coalesce_linear_vars igs vds;*) + (** Other cases*) + List.iter process_eq f.n_equs; + (* Make sure the interference between records are coherent *) + let live_vars = fix_records_live_vars live_vars in + (* Add interferences from live vars set*) + add_interferences live_vars; + (* Add interferences between records implied by IField values*) + add_records_field_interferences (); + + (* Return the graphs *) + !World.igs diff --git a/compiler/minils/minils.ml b/compiler/minils/minils.ml index fbd38ea..38b5649 100644 --- a/compiler/minils/minils.ml +++ b/compiler/minils/minils.ml @@ -154,6 +154,9 @@ let mk_exp ty ?(clock = fresh_clock()) ?(loc = no_location) desc = { e_desc = desc; e_ty = ty; e_ck = clock; e_loc = loc } +let extvalue_exp ?(clock = fresh_clock()) ?(loc = no_location) ty desc = + mk_exp ~clock:clock ~loc:loc ty (Eextvalue (mk_extvalue ~clock:clock ~loc:loc ty desc)) + let mk_var_dec ?(loc = no_location) ?(clock = fresh_clock()) ident ty = { v_ident = ident; v_type = ty; v_clock = clock; v_loc = loc } diff --git a/compiler/minils/mls_utils.ml b/compiler/minils/mls_utils.ml index 6844894..12e3258 100644 --- a/compiler/minils/mls_utils.ml +++ b/compiler/minils/mls_utils.ml @@ -62,6 +62,15 @@ let is_record_type ty = match ty with let is_op = function | { qual = Pervasives; name = _ } -> true | _ -> false +let pat_from_dec_list decs = + Etuplepat (List.map (fun vd -> Evarpat vd.v_ident) decs) + +let tuple_from_dec_list decs = + let aux vd = + mk_extvalue ~clock:vd.v_clock vd.v_type (Wvar vd.v_ident) + in + Eapp(mk_app Earray, List.map aux decs, None) + module Vars = struct let add x acc = if List.mem x acc then acc else x :: acc @@ -159,13 +168,11 @@ end (* Assumes normal form, all fby are solo rhs *) let node_memory_vars n = let eq _ acc ({ eq_lhs = pat; eq_rhs = e } as eq) = - match e.e_desc with - | Efby(_, _) -> - let v_l = Vars.vars_pat [] pat in - let t_l = Types.unprod e.e_ty in - let acc = (List.combine v_l t_l) @ acc in - eq, acc - | _ -> eq, acc + match pat, e.e_desc with + | Evarpat x, Efby(_, _) -> + let acc = (x, e.e_ty) :: acc in + eq, acc + | _, _ -> eq, acc in let funs = { Mls_mapfold.defaults with eq = eq } in let _, acc = node_dec_it funs [] n in diff --git a/compiler/utilities/minils/interference_graph.ml b/compiler/utilities/minils/interference_graph.ml index a51d99f..98d4dbf 100644 --- a/compiler/utilities/minils/interference_graph.ml +++ b/compiler/utilities/minils/interference_graph.ml @@ -1,11 +1,30 @@ open Graph type ilink = - | Iinterference - | Iaffinity - | Isame_value + | Iinterference + | Iaffinity + | Isame_value + +type ivar = + | Ivar of Idents.var_ident + | Ifield of ivar * Names.field_name + +type IvarEnv = + Map.Make (struct + type t = ivar + let compare = compare + end) + +type IvarSet = + Set.Make (struct + type t = ivar + let compare = compare + end) + +let rec ivar_to_string = function + | IVar n -> Idents.name n + | IField(iv,f) -> (ivar_to_string iv)^"."^(shortname f) -type ivar = Minils.extvalue_desc module VertexValue = struct type t = ivar list ref @@ -131,3 +150,11 @@ let coalesce g n1 n2 = (* coalesce nodes in the graph*) G.coalesce g.g_graph n1 n2 +(** Iterates [f] on all the couple of nodes interfering in the graph g *) +let iter_interf f g = + let do_f e = + if G.E.label e = Iinterference then + f (G.V.label (G.E.src e)) (G.V.label (G.E.dst e)) + in + G.iter_edges do_f g.g_graph +