Commit 088c6085 authored by Bruno Guillaume's avatar Bruno Guillaume

version 0.47.2: Dealing with increasing Grs

parent b916663c
## 0.47.2 (2018/05/04)
* Deal with increasing Grs
## 0.47.1 (2018/03/16)
* fix bug in grs loading with relative path
* Fix bug in grs loading with relative path
# 0.47.0 (2018/03/13)
* Add conll_fields in domain definition
......
0.47.1
\ No newline at end of file
0.47.2
\ No newline at end of file
......@@ -1088,7 +1088,9 @@ module Delta = struct
let set_feat seed_graph gid feat_name new_val_opt t =
(* equal_orig is true iff new val is the same as the one in seed_graph *)
let equal_orig = (new_val_opt = G_fs.get_atom feat_name (G_node.get_fs (G_graph.find gid seed_graph))) in
let equal_orig =
try (new_val_opt = G_fs.get_atom feat_name (G_node.get_fs (G_graph.find gid seed_graph)))
with Not_found -> false (* when gid is in created nodes *) in
let rec loop = fun old -> match old with
| [] when equal_orig -> []
| [] -> [(gid,feat_name), new_val_opt]
......@@ -1105,12 +1107,13 @@ module Graph_with_history = struct
seed: G_graph.t;
delta: Delta.t;
graph: G_graph.t;
added_gids: (string * Gid.t) list;
}
let from_graph graph = { graph; seed=graph; delta = Delta.empty }
let from_graph graph = { graph; seed=graph; delta = Delta.empty; added_gids = [] }
(* WARNING: compare is correct only on data with the same seed! *)
let compare t1 t2 = Pervasives.compare t1.delta t2.delta
let compare t1 t2 = Pervasives.compare (t1.delta,t1.added_gids) (t2.delta, t2.added_gids)
end (* module Graph_with_history*)
module Graph_with_history_set = Set.Make (Graph_with_history)
......@@ -215,6 +215,7 @@ module Graph_with_history : sig
seed: G_graph.t;
delta: Delta.t;
graph: G_graph.t;
added_gids: (string * Gid.t) list;
}
val from_graph: G_graph.t -> t
......
......@@ -1144,11 +1144,13 @@ module Grs = struct
) in
loop (Graph_with_history_set.singleton gwh, Graph_with_history_set.empty, Graph_with_history_set.empty)
let gwh_simple_rewrite grs strat graph =
let gwh_simple_rewrite grs strat_string graph =
let domain = domain grs in
let casted_graph = G_graph.cast ?domain graph in
let strat = Parser.strategy strat_string in
let gwh = Graph_with_history.from_graph casted_graph in
let set = gwh_strat_simple_rewrite ?domain (top grs) (Parser.strategy strat) gwh in
let set = gwh_strat_simple_rewrite ?domain (top grs) strat gwh in
List.map
(fun gwh -> gwh.Graph_with_history.graph)
(Graph_with_history_set.elements set)
......
......@@ -1488,7 +1488,7 @@ module Rule = struct
let (new_gid,new_graph) = G_graph.add_unordered graph in
(new_graph, (created_name,new_gid) :: created_nodes, true)
let rec onf_apply ?domain rule graph =
let onf_apply ?domain rule graph =
let (pos,negs) = rule.pattern in
(* get the list of partial matching for positive part of the pattern *)
let matching_list =
......@@ -1587,16 +1587,16 @@ module Rule = struct
let find cnode ?loc matching =
let find cnode ?loc gwh matching =
match cnode with
| Command.Pat pid ->
(try Pid_map.find pid matching.n_match
with Not_found -> Error.bug ?loc "Inconsistent matching pid '%s' not found" (Pid.to_string pid))
| Command.New name -> Error.bug ?loc "New node must not appear HERE !" name
| Command.New name -> List.assoc name gwh.Graph_with_history.added_gids
let gwh_apply_command ?domain (command,loc) gwh matching =
let node_find cnode = find ~loc cnode matching in
let node_find cnode = find ~loc cnode gwh matching in
match command with
| Command.ADD_EDGE (src_cn,tar_cn,edge) ->
......@@ -1748,16 +1748,28 @@ module Rule = struct
|> (List.fold_right (fun (s,e,t) -> Delta.add_edge s e t) add_edges)
}
| _ -> Error.bug "Add node must not occur here !!!"
| Command.NEW_AFTER (created_name,base_cn) ->
let base_gid = node_find base_cn in
let (new_gid,new_graph) = G_graph.add_after base_gid gwh.Graph_with_history.graph in
{ gwh with
Graph_with_history.graph = new_graph;
added_gids = (created_name, new_gid) :: gwh.Graph_with_history.added_gids
}
| Command.NEW_BEFORE (created_name,base_cn) ->
let base_gid = node_find base_cn in
let (new_gid,new_graph) = G_graph.add_before base_gid gwh.Graph_with_history.graph in
{ gwh with
Graph_with_history.graph = new_graph;
added_gids = (created_name, new_gid) :: gwh.Graph_with_history.added_gids
}
| Command.NEW_NODE (created_name) ->
let (new_gid,new_graph) = G_graph.add_unordered gwh.Graph_with_history.graph in
{ gwh with
Graph_with_history.graph = new_graph;
added_gids = (created_name, new_gid) :: gwh.Graph_with_history.added_gids
}
(* ---------------------------------------------------------------------- *)
(** [apply_rule graph_with_history matching rule] returns a new graph_with_history after the application of the rule *)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment