Commit fe7ec3a0 authored by Bruno Guillaume's avatar Bruno Guillaume
Browse files

remove unused code (GTK GUI related)

parent 233dae21
......@@ -511,145 +511,6 @@ module Grs = struct
then [onf_rewrite ~config (top grs) strat graph]
else gwh_simple_rewrite ~config grs strat graph
(* ============================================================================================= *)
(* production of rew_display of linear rewriting history for GUI *)
(* ============================================================================================= *)
type linear_rd = {
graph: G_graph.t;
steps: (string * G_graph.t * Libgrew_types.big_step) list;
know_normal_form: bool;
}
let wrd_pack_rewrite ~config decl_list graph_with_big_step =
let rec loop = function
| [] -> None
| Rule r :: tail_decl ->
(match Rule.wrd_apply_opt ~config r graph_with_big_step with
| Some x -> Some x
| None -> loop tail_decl
)
| _ :: tail_decl -> loop tail_decl in
loop decl_list
let rec wrd_pack_iter_rewrite ~config decl_list graph_with_big_step =
match (graph_with_big_step, wrd_pack_rewrite ~config decl_list graph_with_big_step) with
| (_, Some (new_gr, new_bs)) -> wrd_pack_iter_rewrite ~config decl_list (new_gr, Some new_bs)
| ((gr, Some bs), None) -> Some (gr, bs)
| ((gr, None), None) -> None
(* functions [wrd_intern_simple_rewrite] and [wrd_strat_simple_rewrite] computes
one normal form and output the data needed for rew_display production.
output = list of ... transformed later into rew_display by [build_rew_display_from_linear_rd]
[iter_flag] is set to true when rules application should be put together (in the old modules style).
*)
let rec wrd_intern_simple_rewrite ~config iter_flag pointed strat_name linear_rd =
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,_) when iter_flag ->
begin (* pack iterations on one rule as one "package" *)
match wrd_pack_iter_rewrite ~config [Rule r] (linear_rd.graph, None) with
| None -> None
| Some (new_graph, big_step) -> Some {
steps = (sprintf "Onf(%s)" (Rule.get_name r), linear_rd.graph, big_step) :: linear_rd.steps;
graph = new_graph;
know_normal_form = true;
}
end
| Some (Rule r,_) ->
begin
match Rule.wrd_apply_opt ~config r (linear_rd.graph, None) with
| None -> None
| Some (new_graph, big_step) -> Some {
steps = (Rule.get_name r, linear_rd.graph, big_step) :: linear_rd.steps;
graph = new_graph;
know_normal_form=false
}
end
| Some (Package (name, decl_list), _) when iter_flag ->
begin
match wrd_pack_iter_rewrite ~config decl_list (linear_rd.graph, None) with
| None -> None
| Some (new_graph, big_step) -> Some {
steps = (name, linear_rd.graph, big_step) :: linear_rd.steps;
graph = new_graph;
know_normal_form = true;
}
end
| Some (Package (name, decl_list), _) ->
begin
match wrd_pack_rewrite ~config decl_list (linear_rd.graph, None) with
| None -> None
| Some (new_graph, big_step) -> Some {
steps = (name, linear_rd.graph, big_step) :: linear_rd.steps;
graph = new_graph;
know_normal_form = true;
}
end
| Some (Strategy (_,ast_strat), new_pointed) ->
wrd_strat_simple_rewrite ~config iter_flag new_pointed ast_strat linear_rd
and wrd_strat_simple_rewrite ~config iter_flag pointed strat linear_rd =
match strat with
| Ast.Ref subname -> wrd_intern_simple_rewrite iter_flag ~config pointed subname linear_rd
| Ast.Pick strat -> wrd_strat_simple_rewrite iter_flag ~config pointed strat linear_rd
| Ast.Alt [] -> None
| Ast.Alt strat_list ->
let rec loop = function
| [] -> None
| head_strat :: tail_strat ->
match wrd_strat_simple_rewrite ~config false pointed head_strat linear_rd with
| None -> loop tail_strat
| Some x -> Some x in
loop strat_list
| Ast.Seq [] -> Some linear_rd
| Ast.Seq (head_strat :: tail_strat) ->
begin
match wrd_strat_simple_rewrite ~config false pointed head_strat linear_rd with
| None -> None
| Some gwrd -> wrd_strat_simple_rewrite iter_flag ~config pointed (Ast.Seq tail_strat) gwrd
end
| Ast.Iter sub_strat
| Ast.Onf sub_strat ->
begin
match wrd_strat_simple_rewrite ~config true pointed sub_strat linear_rd with
| None -> Some {linear_rd with know_normal_form = true}
| Some gwrd when gwrd.know_normal_form -> Some gwrd
| Some gwrd -> wrd_strat_simple_rewrite ~config iter_flag pointed strat gwrd
end
| Ast.Try sub_strat ->
begin
match wrd_strat_simple_rewrite ~config false pointed sub_strat linear_rd with
| None -> Some linear_rd
| Some i -> Some i
end
| Ast.If (s, s1, s2) ->
begin
match onf_strat_simple_rewrite ~config pointed s linear_rd.graph with
| Some _ -> wrd_strat_simple_rewrite iter_flag ~config pointed s1 linear_rd
| None -> wrd_strat_simple_rewrite iter_flag ~config pointed s2 linear_rd
end
let build_rew_display_from_linear_rd linear_rd =
List.fold_left
(fun acc (n,g,bs) -> Libgrew_types.Node (g, n, [Libgrew_types.swap bs, acc])) (Libgrew_types.Leaf linear_rd.graph) linear_rd.steps
let wrd_rewrite ~config grs strat graph =
Rule.reset_rules ();
Timeout.start ();
begin
match wrd_strat_simple_rewrite ~config false (top grs) (Parser.strategy strat) {graph; steps=[]; know_normal_form=false} with
| None -> Libgrew_types.Leaf graph
| Some linear_rd -> build_rew_display_from_linear_rd linear_rd
end
|> (fun x -> Timeout.stop (); x)
let eud2ud = load ~config:(Conllx_config.build "ud") (Filename.concat DATADIR "eud2ud.grs")
let apply_eud2ud ~config graph =
match simple_rewrite ~config eud2ud "main" graph with
......
......@@ -42,8 +42,6 @@ module Grs : sig
val onf_rewrite_opt: config:Conllx_config.t -> t -> string -> G_graph.t -> G_graph.t option
val wrd_rewrite: config:Conllx_config.t -> t -> string -> G_graph.t -> Libgrew_types.rew_display
(* [apply grs_name t] apply a deterministic GRS of the given [name]
[Error.Run] is raised if the name in unknown or the GRS application not deterministic *)
val apply: config:Conllx_config.t -> string -> G_graph.t -> G_graph.t
......
......@@ -1354,55 +1354,6 @@ module Rule = struct
else None
with Error.Run (msg,_) -> Error.run ~loc:rule.loc "%s" msg
let rec wrd_apply_opt ~config rule (graph, big_step_opt) =
try
let {Pattern.ker; exts} = rule.pattern in
(* get the list of partial matching for kernel part of the pattern *)
let matching_list =
Matching.extend_matching
~config
(ker.graph,P_graph.empty)
graph
(Matching.init ~lexicons:rule.lexicons ker) in
match List.find_opt
(fun (sub, already_matched_gids) ->
List.for_all
(fun (ext,polarity) ->
Matching.test_extension ~config ker graph ext (sub, already_matched_gids) = polarity
) exts
) matching_list with
| None -> None
| Some (first_matching_where_all_witout_are_fulfilled,_) ->
let final_state =
List.fold_left
(fun state command -> onf_apply_command ~config first_matching_where_all_witout_are_fulfilled command state)
{ graph;
created_nodes = [];
effective = false;
e_mapping = first_matching_where_all_witout_are_fulfilled.e_match;
}
rule.commands in
let rule_app = {
Libgrew_types.rule_name = rule.name;
up = Matching.match_deco rule.pattern first_matching_where_all_witout_are_fulfilled;
down = Matching.down_deco (String_map.empty, first_matching_where_all_witout_are_fulfilled,final_state.created_nodes) rule.commands
} in
let new_big_step = match big_step_opt with
| None -> {Libgrew_types.small_step = []; first=rule_app}
| Some {Libgrew_types.small_step; first} -> {Libgrew_types.small_step = (graph,rule_app) :: small_step; first} in
if final_state.effective
then
begin
Timeout.check ();
incr_rules rule.name;
Some (final_state.graph, new_big_step)
end
else None
with Error.Run (msg,_) -> Error.run ~loc:rule.loc "%s" msg
let find cnode ?loc gwh matching =
match cnode with
| Command.Pat pid ->
......
......@@ -82,8 +82,6 @@ module Rule : sig
(** [of_ast ast_rule] returns the Rule.t value corresponding to [ast_rule] *)
val of_ast: config:Conllx.Conllx_config.t -> Ast.rule -> t
val wrd_apply_opt: config:Conllx.Conllx_config.t -> t -> (G_graph.t * Libgrew_types.big_step option) -> (G_graph.t * Libgrew_types.big_step) option
val onf_apply_opt: config:Conllx.Conllx_config.t -> t -> G_graph.t -> G_graph.t option
val gwh_apply: config:Conllx.Conllx_config.t -> t -> Graph_with_history.t -> Graph_with_history_set.t
......
......@@ -347,15 +347,8 @@ end
(** {2 Rewrite} *)
(* ==================================================================================================== *)
module Rewrite = struct
type display = Libgrew_types.rew_display
let size = Libgrew_types.rew_display_size
let set_max_rules bound = Grew_rule.Rule.set_max_rules bound
let display ~config gr grs strat =
Libgrew.handle ~name:"Rewrite.display" (fun () -> Grew_grs.Grs.wrd_rewrite ~config grs strat gr) ()
let set_timeout t = Grew_base.Timeout.timeout := t
let simple_rewrite ~config gr grs strat =
......
......@@ -205,13 +205,9 @@ module Grs : sig
end
(* ==================================================================================================== *)
(** {2 Rewrite history} *)
(** {2 Rewrite} *)
(* ==================================================================================================== *)
module Rewrite: sig
type display = Libgrew_types.rew_display
val size: display -> int
val set_max_rules: int -> unit
(** [display gr grs seq] builds the [display] (datatype used by the GUI) given by
......@@ -219,7 +215,6 @@ module Rewrite: sig
@param gr the graph to rewrite
@param grs the graph rewriting system
@param strat the name of the strategy to apply *)
val display: config:Conllx_config.t -> Graph.t -> Grs.t -> string -> display
val at_least_one: Grs.t -> string -> bool
val at_most_one: Grs.t -> string -> bool
......
......@@ -24,16 +24,3 @@ type big_step = {
}
let swap bs = {bs with small_step = List.rev bs.small_step}
(* the main type for display the result of a rewriting *)
type rew_display =
| Empty (* pour les besoin du dev *)
| Leaf of G_graph.t
| Local_normal_form of G_graph.t * step_name * rew_display
| Node of G_graph.t * step_name * (big_step * rew_display) list
let rec rew_display_size = function
| Empty -> 0
| Leaf _ -> 1
| Local_normal_form (_,_,rd) -> rew_display_size rd
| Node (_,_,l) -> List.fold_left (fun acc (_,rd) -> acc+(rew_display_size rd)) 0 l
......@@ -26,12 +26,3 @@ type big_step = {
}
val swap : big_step -> big_step
(** the main type for display the result of a rewriting *)
type rew_display =
| Empty (* pour les besoin du dev *)
| Leaf of G_graph.t
| Local_normal_form of G_graph.t * step_name * rew_display
| Node of G_graph.t * step_name * (big_step * rew_display) list
val rew_display_size: rew_display -> int
\ No newline at end of file
Supports Markdown
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