jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

Fix for dep when using linear types and automata

Browse source
This commit is contained in:
Cédric Pasteur 2011-09-07 17:27:58 +02:00
parent 9d1702587a
commit 29a6721121
3 changed files with 31 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
compiler/utilities/global/dep.ml
View file

@ -37,19 +37,19 @@ struct
let rec nametograph_env g var_list node_env =
List.fold_left (fun env x -> Env.add x g env) node_env var_list in
let rec init_graph eqs g_list n_to_graph node_env =
let rec init_graph eqs g_list n_to_graph lin_map node_env =
match eqs with
| [] -> g_list, n_to_graph, node_env
| [] -> g_list, n_to_graph, lin_map, node_env
| eq :: eqs ->
let g = make eq in
let node_env = nametograph_env g (Read.def [] eq) node_env in
let n_to_graph = nametograph g (Read.def [] eq)
(Read.antidep eq) n_to_graph in
let n_to_graph = nametograph g (Read.linear_read eq) true n_to_graph in
init_graph eqs (g :: g_list) n_to_graph node_env
let lin_map = nametograph g (Read.linear_read eq) true lin_map in
init_graph eqs (g :: g_list) n_to_graph lin_map node_env
in
let rec make_graph g_list names_to_graph =
let rec make_graph g_list names_to_graph lin_map =
let attach_one node (g, is_antidep) =
if is_antidep then
add_depends g node
@ -57,9 +57,9 @@ struct
add_depends node g
in
let attach node n =
let attach env node n =
try
let l = Env.find n names_to_graph in
let l = Env.find n env in
List.iter (attach_one node) l
with
| Not_found -> () in
@ -68,12 +68,15 @@ struct
| [] -> ()
| node :: g_list ->
let names = Read.read (containt node) in
List.iter (attach node) names;
make_graph g_list names_to_graph in
List.iter (attach names_to_graph node) names;
let reads = Misc.list_diff names (Read.linear_read (containt node)) in
List.iter (attach lin_map node) names;
make_graph g_list names_to_graph lin_map
in
let g_list, names_to_graph, node_env =
init_graph eqs [] Env.empty Env.empty in
make_graph g_list names_to_graph;
let g_list, names_to_graph, lin_map, node_env =
init_graph eqs [] Env.empty Env.empty Env.empty in
make_graph g_list names_to_graph lin_map;
g_list, node_env
end

11
compiler/utilities/misc.ml
View file

@ -154,6 +154,12 @@ let rec assocd value = function
else
assocd value l
(** [list_diff l dl] returns [l] without the elements belonging to [dl].*)
let rec list_diff l dl = match l with
| [] -> []
| x::l ->
let l = list_diff l dl in
if List.mem x dl then l else x::l
(** { 3 Compiler iterators } *)
@ -224,6 +230,11 @@ let fold_righti f l acc =
| h :: l -> f i h (aux (i + 1) l acc) in
aux 0 l acc
let rec map3 f l1 l2 l3 = match l1, l2, l3 with
| [], [], [] -> []
| v1::l1, v2::l2, v3::l3 -> (f v1 v2 v3)::(map3 f l1 l2 l3)
| _ -> invalid_arg "Misc.map3"
exception Assert_false
let internal_error passe =
Format.eprintf "@.---------@\n

5
compiler/utilities/misc.mli
View file

@ -74,6 +74,9 @@ val list_compare : ('a -> 'a -> int) -> 'a list -> 'a list -> int
val option_compare : ('a -> 'a -> int) -> 'a option -> 'a option -> int
(** [list_diff l dl] returns [l] without the elements belonging to [dl].*)
val list_diff : 'a list -> 'a list -> 'a list
(** Mapfold *)
val mapfold: ('acc -> 'b -> 'c * 'acc) -> 'acc -> 'b list -> 'c list * 'acc
val mapfold2: ('acc -> 'b -> 'd -> 'c * 'acc) -> 'acc -> 'b list -> 'd list -> 'c list * 'acc
@ -97,6 +100,8 @@ val fold_left4 :
('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a
(** Mapi *)
val map3: ('a -> 'b -> 'c -> 'd) ->
'a list -> 'b list -> 'c list -> 'd list
val mapi: (int -> 'a -> 'b) -> 'a list -> 'b list
val mapi2: (int -> 'a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
val mapi3: (int -> 'a -> 'b -> 'c -> 'd) ->