Fix for dep when using linear types and automata
This commit is contained in:
parent
9d1702587a
commit
29a6721121
|
@ -37,19 +37,19 @@ struct
|
||||||
let rec nametograph_env g var_list node_env =
|
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
|
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
|
match eqs with
|
||||||
| [] -> g_list, n_to_graph, node_env
|
| [] -> g_list, n_to_graph, lin_map, node_env
|
||||||
| eq :: eqs ->
|
| eq :: eqs ->
|
||||||
let g = make eq in
|
let g = make eq in
|
||||||
let node_env = nametograph_env g (Read.def [] eq) node_env in
|
let node_env = nametograph_env g (Read.def [] eq) node_env in
|
||||||
let n_to_graph = nametograph g (Read.def [] eq)
|
let n_to_graph = nametograph g (Read.def [] eq)
|
||||||
(Read.antidep eq) n_to_graph in
|
(Read.antidep eq) n_to_graph in
|
||||||
let n_to_graph = nametograph g (Read.linear_read eq) true n_to_graph in
|
let lin_map = nametograph g (Read.linear_read eq) true lin_map in
|
||||||
init_graph eqs (g :: g_list) n_to_graph node_env
|
init_graph eqs (g :: g_list) n_to_graph lin_map node_env
|
||||||
in
|
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) =
|
let attach_one node (g, is_antidep) =
|
||||||
if is_antidep then
|
if is_antidep then
|
||||||
add_depends g node
|
add_depends g node
|
||||||
|
@ -57,9 +57,9 @@ struct
|
||||||
add_depends node g
|
add_depends node g
|
||||||
in
|
in
|
||||||
|
|
||||||
let attach node n =
|
let attach env node n =
|
||||||
try
|
try
|
||||||
let l = Env.find n names_to_graph in
|
let l = Env.find n env in
|
||||||
List.iter (attach_one node) l
|
List.iter (attach_one node) l
|
||||||
with
|
with
|
||||||
| Not_found -> () in
|
| Not_found -> () in
|
||||||
|
@ -68,12 +68,15 @@ struct
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| node :: g_list ->
|
| node :: g_list ->
|
||||||
let names = Read.read (containt node) in
|
let names = Read.read (containt node) in
|
||||||
List.iter (attach node) names;
|
List.iter (attach names_to_graph node) names;
|
||||||
make_graph g_list names_to_graph in
|
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 =
|
let g_list, names_to_graph, lin_map, node_env =
|
||||||
init_graph eqs [] Env.empty Env.empty in
|
init_graph eqs [] Env.empty Env.empty Env.empty in
|
||||||
make_graph g_list names_to_graph;
|
make_graph g_list names_to_graph lin_map;
|
||||||
g_list, node_env
|
g_list, node_env
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
|
@ -154,6 +154,12 @@ let rec assocd value = function
|
||||||
else
|
else
|
||||||
assocd value l
|
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 } *)
|
(** { 3 Compiler iterators } *)
|
||||||
|
|
||||||
|
@ -224,6 +230,11 @@ let fold_righti f l acc =
|
||||||
| h :: l -> f i h (aux (i + 1) l acc) in
|
| h :: l -> f i h (aux (i + 1) l acc) in
|
||||||
aux 0 l acc
|
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
|
exception Assert_false
|
||||||
let internal_error passe =
|
let internal_error passe =
|
||||||
Format.eprintf "@.---------@\n
|
Format.eprintf "@.---------@\n
|
||||||
|
|
|
@ -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
|
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 *)
|
(** Mapfold *)
|
||||||
val mapfold: ('acc -> 'b -> 'c * 'acc) -> 'acc -> 'b list -> 'c list * 'acc
|
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
|
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
|
('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a
|
||||||
|
|
||||||
(** Mapi *)
|
(** 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 mapi: (int -> 'a -> 'b) -> 'a list -> 'b list
|
||||||
val mapi2: (int -> 'a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
|
val mapi2: (int -> 'a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
|
||||||
val mapi3: (int -> 'a -> 'b -> 'c -> 'd) ->
|
val mapi3: (int -> 'a -> 'b -> 'c -> 'd) ->
|
||||||
|
|
Loading…
Reference in a new issue