Commit 2f7e00e1 authored by Bruno Guillaume's avatar Bruno Guillaume

version 1.1.4: Bug fix

parent a3224428
# 1.1.4 (2019/03/06)
* Fix bug introduced in previous version
# 1.1.3 (2019/03/04)
* Fix bug in strategies implementation
......
......@@ -303,6 +303,85 @@ module Grs = struct
| Ast.Onf (s) -> onf_strat_simple_rewrite ?domain pointed s graph (* TODO check Onf (P) == 1 rule app ? *)
(* TODO: unused function, should be used for some cases like Seq (Onf(p1), Onf(p2)) *)
(* iter until normal form *)
let onf_rewrite ?domain pointed strat graph =
let rec loop graph2 =
match onf_strat_simple_rewrite ?domain pointed strat graph2 with
| None -> graph2
| Some x -> loop x in
loop graph
(* ============================================================================================= *)
(* Rewriting in the deterministic case with Graph_with_history.t type *)
(* ============================================================================================= *)
(* NB: the next 3 functions compute one step (with option output) for correct recusice call in case of Alt *)
(* the function [owh_rewrite] handle the iteration until normal_form *)
let owh_pack_rewrite ?domain decl_list gwh =
let rec loop = function
| [] -> None
| Rule r :: tail_decl ->
(match Rule.owh_apply ?domain r gwh with
| Some x -> Some x
| None -> loop tail_decl
)
| _ :: tail_decl -> loop tail_decl in
loop decl_list
let rec owh_intern_simple_rewrite ?domain pointed strat_name gwh =
let path = Str.split (Str.regexp "\\.") strat_name in
match search_from pointed path with
| None -> Error.build "Simple rewrite, cannot find strat %s" strat_name
| Some (Rule r,_) -> Rule.owh_apply ?domain r gwh
| Some (Package (_, decl_list), _) -> owh_pack_rewrite ?domain decl_list gwh
| Some (Strategy (_,ast_strat), new_pointed) ->
owh_strat_simple_rewrite ?domain new_pointed ast_strat gwh
and owh_strat_simple_rewrite ?domain pointed strat gwh =
match strat with
| Ast.Ref subname -> owh_intern_simple_rewrite ?domain pointed subname gwh
| Ast.Pick strat -> owh_strat_simple_rewrite ?domain pointed strat gwh
| Ast.Alt [] -> None
| Ast.Alt strat_list ->
let rec loop = function
| [] -> None
| head_strat :: tail_strat ->
match owh_strat_simple_rewrite ?domain pointed head_strat gwh with
| None -> loop tail_strat
| Some x -> Some x in
loop strat_list
| Ast.Seq [] -> Some gwh
| Ast.Seq (head_strat :: tail_strat) ->
begin
match owh_strat_simple_rewrite ?domain pointed head_strat gwh with
| None -> None
| Some gwh2 -> owh_strat_simple_rewrite ?domain pointed (Ast.Seq tail_strat) gwh2
end
| Ast.Try sub_strat
| Ast.Onf sub_strat
| Ast.Iter sub_strat -> owh_strat_simple_rewrite ?domain pointed sub_strat gwh
| Ast.If (s, s1, s2) ->
begin
(* NB: checking one real step is enough to decide… *)
match onf_strat_simple_rewrite ?domain pointed s gwh.Graph_with_history.graph with
| None -> owh_strat_simple_rewrite ?domain pointed s1 gwh
| Some _ -> owh_strat_simple_rewrite ?domain pointed s2 gwh
end
(* iter until normal form *)
let owh_rewrite ?domain pointed strat gwh =
let rec loop gwh2 =
match owh_strat_simple_rewrite ?domain pointed strat gwh2 with
| None -> gwh2
| Some x -> loop x in
loop gwh
(* ============================================================================================= *)
(* Rewriting in the non-deterministic case with Graph_with_history.t type *)
(* ============================================================================================= *)
......@@ -347,8 +426,8 @@ module Grs = struct
(fun gwh acc -> Graph_with_history_set.union acc (gwh_strat_simple_rewrite ?domain pointed (Ast.Seq tail_strat) gwh)
) first_strat Graph_with_history_set.empty
| Ast.Iter s
| Ast.Onf s -> iter_gwh ?domain pointed s gwh
| Ast.Iter s -> iter_gwh ?domain pointed s gwh
| Ast.Onf s -> Graph_with_history_set.singleton (owh_rewrite ?domain pointed strat gwh)
| Ast.Try strat ->
begin
......@@ -394,7 +473,7 @@ 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_string graph =
Rule.reset_rules ();
Timeout.start ();
......
......@@ -1053,10 +1053,11 @@ module Rule = struct
| Command.DEL_FEAT (tar_cn,feat_name) ->
let tar_gid = node_find tar_cn in
(match G_graph.del_feat graph tar_gid feat_name with
| None when !Global.safe_commands -> Error.run "XXX"
| None when !Global.safe_commands -> Error.run "DEL_FEAT the feat does not exist %s" (Loc.to_string loc)
| None -> (graph, created_nodes, eff)
| Some new_graph -> (new_graph, created_nodes, true)
)
(* TODO: an update feat is always considered as effective! is it OK? *)
| Command.SHIFT_IN (src_cn,tar_cn,label_cst) ->
let src_gid = node_find src_cn in
......@@ -1382,4 +1383,41 @@ module Rule = struct
Graph_with_history_set.union (gwh_apply_rule ?domain graph_with_history matching rule) acc
) Graph_with_history_set.empty matching_list
let owh_apply ?domain rule gwh =
let (pos,negs) = rule.pattern in
(* get the list of partial matching for positive part of the pattern *)
let graph = gwh.Graph_with_history.graph in
let matching_list =
extend_matching
?domain
(pos.graph,P_graph.empty)
graph
(init ~lexicons:rule.lexicons pos) in
try
let (first_matching_where_all_witout_are_fulfilled,_) =
List.find
(fun (sub, already_matched_gids) ->
List.for_all
(fun neg ->
let new_partial_matching = update_partial pos.graph neg (sub, already_matched_gids) in
fulfill ?domain (pos.graph,neg.graph) graph new_partial_matching
) negs
) matching_list in
let new_gwh =
List.fold_left
(fun acc_gwh command ->
let set = gwh_apply_command ?domain command acc_gwh first_matching_where_all_witout_are_fulfilled in
Graph_with_history_set.choose set
)
gwh
rule.commands in
Timeout.check (); incr_rules(); Some new_gwh
with Not_found ->
(* raised by List.find, no matching apply or
in Graph_with_history_set.choose.
TODO: in the second case, we should find another matching ???
*)
None
end (* module Rule *)
......@@ -73,6 +73,8 @@ module Rule : sig
val gwh_apply: ?domain: Domain.t -> t -> Graph_with_history.t -> Graph_with_history_set.t
val owh_apply: ?domain: Domain.t -> t -> Graph_with_history.t -> Graph_with_history.t option
......
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