Une MAJ de sécurité est nécessaire sur notre version actuelle. Elle sera effectuée lundi 02/08 entre 12h30 et 13h. L'interruption de service devrait durer quelques minutes (probablement moins de 5 minutes).

Commit 2e4bfc9d authored by Bruno Guillaume's avatar Bruno Guillaume
Browse files

functions for GUI in the deterministic case

parent 38686d47
......@@ -495,7 +495,15 @@ module New_ast = struct
| Include of string
type grs = decl list
end (* module New_ast *)
let strat_list grs =
let rec loop pref = function
[] -> []
| Strategy (_,name,_) :: tail -> name :: (loop pref tail)
| Package (_,pack_name,decl_list) :: tail -> (loop (pref^"."^pack_name) decl_list) @ (loop pref tail)
| _ :: tail -> loop pref tail
in loop "" grs
end (* module New_ast *)
......
......@@ -266,4 +266,6 @@ module New_ast : sig
| Include of string
type grs = decl list
val strat_list: grs -> string list
end (* module New_ast *)
......@@ -603,7 +603,6 @@ module New_grs = struct
| Strategy of string * New_ast.strat
| Package of string * decl list
type t = {
filename: string;
domain: Domain.t option;
......@@ -611,6 +610,8 @@ module New_grs = struct
ast: New_ast.grs;
}
let get_strat_list grs = Grew_ast.New_ast.strat_list grs.ast
let rec dump_decl indent = function
| Rule r -> printf "%srule %s\n" (String.make indent ' ') (Rule.get_name r)
| Strategy (name, def) -> printf "%sstrat %s\n" (String.make indent ' ') name
......@@ -628,7 +629,7 @@ module New_grs = struct
let rec build_decl ?domain = function
| New_ast.Package (loc, name, decl_list) -> Package (name, List.map build_decl decl_list)
| New_ast.Package (loc, name, decl_list) -> Package (name, List.map (build_decl ?domain) decl_list)
| New_ast.Rule ast_rule -> Rule (Rule.build ?domain "TODO: remove this arg (old grs)" ast_rule)
| New_ast.Strategy (loc, name, ast_strat) -> Strategy (name, ast_strat)
| _ -> Error.bug "[build_decl] Inconsistent ast for new_grs"
......@@ -731,76 +732,123 @@ module New_grs = struct
| Pack (_,mother) -> search_from mother path
)
let rec intern_simple_rewrite pointed strat_name instance =
(* det apply a package to an instance = apply only top level rules in the package *)
let det_pack_rewrite ?domain decl_list instance =
let rec loop = function
| [] -> None
| Rule r :: tail_decl ->
(match Rule.det_apply ?domain r instance with
| Some x -> Some x
| None -> loop tail_decl
)
| _ :: tail_decl -> loop tail_decl in
loop decl_list
(* apply a package to an instance = apply only top level rules in the package *)
let pack_rewrite ?domain decl_list instance =
List.fold_left
(fun acc decl -> match decl with
| Rule r -> Instance_set.union acc (Rule.apply ?domain r instance)
| _ -> acc
) Instance_set.empty decl_list
(* deterministic case *)
let rec det_intern_simple_rewrite ?domain pointed strat_name instance =
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.apply r instance
| Some (Package (_, decl_list), _) -> pack_rewrite decl_list instance
| Some (Rule r,_) -> Rule.det_apply ?domain r instance
| Some (Package (_, decl_list), _) -> det_pack_rewrite ?domain decl_list instance
| Some (Strategy (_,ast_strat), new_pointed) ->
strat_simple_rewrite new_pointed ast_strat instance
det_strat_simple_rewrite new_pointed ast_strat instance
and det_strat_simple_rewrite ?domain pointed strat instance =
match strat with
| New_ast.Ref subname -> det_intern_simple_rewrite ?domain pointed subname instance
| New_ast.Pick strat -> det_strat_simple_rewrite ?domain pointed strat instance
| New_ast.Alt [] -> None
| New_ast.Alt strat_list ->
let rec loop = function
| [] -> None
| head_strat :: tail_strat ->
match det_strat_simple_rewrite ?domain pointed head_strat instance with
| None -> loop tail_strat
| Some x -> Some x in
loop strat_list
and det_intern_simple_rewrite pointed strat_name instance =
| New_ast.Seq [] -> Some instance
| New_ast.Seq (head_strat :: tail_strat) ->
begin
match det_strat_simple_rewrite ?domain pointed head_strat instance with
| None -> None
| Some inst -> det_strat_simple_rewrite ?domain pointed (New_ast.Seq tail_strat) inst
end
| New_ast.Iter strat ->
begin
match det_strat_simple_rewrite ?domain pointed strat instance with
| None -> Some instance
| Some inst -> det_strat_simple_rewrite ?domain pointed (New_ast.Iter strat) inst
end
| New_ast.Try strat ->
begin
match det_strat_simple_rewrite ?domain pointed strat instance with
| None -> Some instance
| Some i -> Some i
end
| New_ast.If (s, s1, s2) ->
begin
match det_strat_simple_rewrite ?domain pointed s instance with
| None -> det_strat_simple_rewrite ?domain pointed s1 instance
| Some _ -> det_strat_simple_rewrite ?domain pointed s2 instance
end
(* non deterministic case *)
let rec intern_simple_rewrite ?domain pointed strat_name instance =
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.det_apply r instance
| Some (Package (_, decl_list), _) -> det_pack_rewrite decl_list instance
| Some (Rule r,_) -> Rule.apply r instance
| Some (Package (_, decl_list), _) -> pack_rewrite decl_list instance
| Some (Strategy (_,ast_strat), new_pointed) ->
det_strat_simple_rewrite new_pointed ast_strat instance
and pack_rewrite decl_list instance =
List.fold_left
(fun acc decl ->
match decl with
| Rule r -> Instance_set.union acc (Rule.apply r instance)
| _ -> acc
) Instance_set.empty decl_list
and det_pack_rewrite decl_list instance =
let rec loop = function
| [] -> None
| Rule r :: tail_decl ->
(match Rule.det_apply r instance with
| None -> loop tail_decl
| Some x -> Some x
)
| _ :: tail_decl -> loop tail_decl in
loop decl_list
strat_simple_rewrite ?domain new_pointed ast_strat instance
and strat_simple_rewrite pointed strat instance =
and strat_simple_rewrite ?domain pointed strat instance =
match strat with
| New_ast.Ref subname -> intern_simple_rewrite pointed subname instance
| New_ast.Ref subname -> intern_simple_rewrite ?domain pointed subname instance
| New_ast.Pick strat ->
begin
match det_strat_simple_rewrite pointed strat instance with
match det_strat_simple_rewrite ?domain pointed strat instance with
| None -> Grew_rule.Instance_set.empty
| Some x -> Instance_set.singleton x
end
| New_ast.Alt [] -> Grew_rule.Instance_set.empty
| New_ast.Alt strat_list -> List.fold_left
(fun acc strat -> Instance_set.union acc (strat_simple_rewrite pointed strat instance)
(fun acc strat -> Instance_set.union acc (strat_simple_rewrite ?domain pointed strat instance)
) Instance_set.empty strat_list
| New_ast.Seq [] -> Instance_set.singleton instance
| New_ast.Seq (head_strat :: tail_strat) ->
let first_strat = strat_simple_rewrite pointed head_strat instance in
let first_strat = strat_simple_rewrite ?domain pointed head_strat instance in
Instance_set.fold
(fun instance acc -> Instance_set.union acc (strat_simple_rewrite pointed (New_ast.Seq tail_strat) instance)
(fun instance acc -> Instance_set.union acc (strat_simple_rewrite ?domain pointed (New_ast.Seq tail_strat) instance)
) first_strat Instance_set.empty
| New_ast.Iter strat ->
let one_step = strat_simple_rewrite pointed strat instance in
let one_step = strat_simple_rewrite ?domain pointed strat instance in
if Instance_set.is_empty one_step
then Instance_set.singleton instance
else Instance_set.fold
(fun instance acc -> Instance_set.union acc (strat_simple_rewrite pointed (New_ast.Iter strat) instance)
(fun instance acc -> Instance_set.union acc (strat_simple_rewrite ?domain pointed (New_ast.Iter strat) instance)
) one_step Instance_set.empty
| New_ast.Try strat ->
begin
let one_step = strat_simple_rewrite pointed strat instance in
let one_step = strat_simple_rewrite ?domain pointed strat instance in
if Instance_set.is_empty one_step
then Instance_set.singleton instance
else one_step
......@@ -808,59 +856,170 @@ module New_grs = struct
| New_ast.If (s, s1, s2) ->
begin
match det_strat_simple_rewrite pointed s instance with
| None -> strat_simple_rewrite pointed s1 instance
| Some _ -> strat_simple_rewrite pointed s2 instance
match det_strat_simple_rewrite ?domain pointed s instance with
| None -> strat_simple_rewrite ?domain pointed s1 instance
| Some _ -> strat_simple_rewrite ?domain pointed s2 instance
end
and det_strat_simple_rewrite pointed strat instance =
let simple_rewrite grs strat graph =
let domain = domain grs in
let instance = Instance.from_graph graph in
let set = strat_simple_rewrite ?domain (top grs) (Parser.strategy strat) instance in
List.map
(fun inst -> inst.Instance.graph)
(Instance_set.elements set)
let det_pack_one ?domain decl_list instance =
let rec loop = function
| [] -> None
| Rule r :: tail_decl ->
(match Rule.det_apply ?domain r instance with
| Some x -> Some (x, Rule.get_name r)
| None -> loop tail_decl
)
| _ :: tail_decl -> loop tail_decl in
loop decl_list
let det_iter_pack ?domain decl_list instance = (* return a (big step, inst) *)
match det_pack_one decl_list instance with
| None -> None
| Some (x, rule_name) ->
let first = {Libgrew_types.rule_name; up=G_deco.empty; down=G_deco.empty} in
let rec loop inst =
match det_pack_one ?domain decl_list inst with
| None -> ([], inst)
| Some (next, rule_name) ->
let (tail, final) = loop next in
(
(inst.Instance.graph, {Libgrew_types.rule_name; up=G_deco.empty; down=G_deco.empty} ) :: tail,
final
) in
let (small_step, final) = loop x in
Some ({ Libgrew_types.first; small_step }, final)
let rec det_rew_display_tmp ?domain pointed strat instance =
match strat with
| New_ast.Ref subname -> det_intern_simple_rewrite pointed subname instance
| New_ast.Pick strat -> det_strat_simple_rewrite pointed strat instance
| New_ast.Ref subname ->
let path = Str.split (Str.regexp "\\.") subname in
begin
match search_from pointed path with
| None -> Error.build "Simple rewrite, cannot find strat %s" subname
| Some (Rule r,_) ->
begin
match Rule.det_apply ?domain r instance with
| None -> None
| Some inst -> Some [(
Rule.get_name r,
{ Libgrew_types.first = {Libgrew_types.rule_name=Rule.get_name r; up=G_deco.empty; down=G_deco.empty}; small_step = [] },
inst
)]
end
| Some (Package (_, decl_list), _) ->
begin
match det_pack_one ?domain decl_list instance with
| None -> None
| Some (inst,rule_name) -> Some [(
rule_name,
{ Libgrew_types.first = {Libgrew_types.rule_name=rule_name; up=G_deco.empty; down=G_deco.empty}; small_step = [] },
inst
)]
end
| Some (Strategy (_,ast_strat), new_pointed) ->
det_rew_display_tmp ?domain new_pointed ast_strat instance
end
| New_ast.Pick strat -> det_rew_display_tmp ?domain pointed strat instance
| New_ast.Alt [] -> None
| New_ast.Alt strat_list ->
let rec loop = function
| [] -> None
| head_strat :: tail_strat ->
match det_strat_simple_rewrite pointed head_strat instance with
match det_rew_display_tmp ?domain pointed head_strat instance with
| None -> loop tail_strat
| Some x -> Some x in
loop strat_list
| New_ast.Seq [] -> Some instance
| New_ast.Seq [] -> Some []
| New_ast.Seq (head_strat :: tail_strat) ->
begin
match det_strat_simple_rewrite pointed head_strat instance with
match det_rew_display_tmp ?domain pointed head_strat instance with
| None -> None
| Some inst -> det_strat_simple_rewrite pointed (New_ast.Seq tail_strat) inst
| Some [] -> det_rew_display_tmp ?domain pointed (New_ast.Seq tail_strat) instance
| Some (((_,_,inst) :: _) as l) ->
begin
match det_rew_display_tmp ?domain pointed (New_ast.Seq tail_strat) inst with
| None -> None
| Some l2 -> Some (l2 @ l)
end
end
| New_ast.Iter (New_ast.Ref subname) ->
let path = Str.split (Str.regexp "\\.") subname in
begin
match search_from pointed path with
| None -> Error.build "Simple rewrite, cannot find strat %s" subname
| Some (Rule r,_) ->
begin
match det_iter_pack [Rule r] instance with
| Some (big_step, final) -> Some [(Rule.get_name r, big_step, final)]
| None -> Some []
end
| Some (Package (pack_name, decl_list), _) ->
begin
match det_iter_pack decl_list instance with
| Some (big_step, final) -> Some [(pack_name, big_step, final)]
| None -> Some []
end
| Some (Strategy (_,ast_strat), new_pointed) ->
det_rew_display_tmp ?domain new_pointed ast_strat instance
end
| New_ast.Iter strat ->
begin
match det_strat_simple_rewrite pointed strat instance with
| None -> Some instance
| Some inst -> det_strat_simple_rewrite pointed (New_ast.Iter strat) inst
end
match det_rew_display_tmp ?domain pointed strat instance with
| None -> Some []
| Some [] -> Some []
| Some (((_,_,inst) :: _) as l) ->
begin
match det_rew_display_tmp ?domain pointed (New_ast.Iter strat) inst with
| None -> Some l
| Some l2 -> Some (l2 @ l)
end
end
| New_ast.Try strat ->
begin
match det_strat_simple_rewrite pointed strat instance with
| None -> Some instance
match det_rew_display_tmp ?domain pointed strat instance with
| None -> Some []
| Some i -> Some i
end
| New_ast.If (s, s1, s2) ->
begin
match det_strat_simple_rewrite pointed s instance with
| None -> det_strat_simple_rewrite pointed s1 instance
| Some _ -> det_strat_simple_rewrite pointed s2 instance
match det_strat_simple_rewrite ?domain pointed s instance with
| None -> det_rew_display_tmp ?domain pointed s1 instance
| Some _ -> det_rew_display_tmp ?domain pointed s2 instance
end
let simple_rewrite grs strat graph =
let det_rew_display grs strat graph =
let domain = domain grs in
let instance = Instance.from_graph graph in
let set = strat_simple_rewrite (top grs) (Parser.strategy strat) instance in
List.map
(fun inst -> inst.Instance.graph)
(Instance_set.elements set)
let rec loop (s,b,rd) = function
| [] -> Libgrew_types.Node (instance.Instance.graph, s, [b, rd])
| (s2, b2, i2) :: tail -> loop (s2, b2, Libgrew_types.Node (i2.Instance.graph,s,[b,rd])) tail in
match det_rew_display_tmp ?domain (top grs) (Parser.strategy strat) instance with
| None -> Libgrew_types.Empty
| Some [] -> Libgrew_types.Leaf instance.Instance.graph
| Some ((s1,b1,i1) :: tail) -> loop (s1,b1,Libgrew_types.Leaf i1.Instance.graph) tail
end
......@@ -120,4 +120,7 @@ module New_grs : sig
val domain: t -> Domain.t option
val simple_rewrite: t -> string -> G_graph.t -> G_graph.t list
val det_rew_display: t -> string -> G_graph.t -> Libgrew_types.rew_display
val get_strat_list: t -> string list
end
\ No newline at end of file
......@@ -94,7 +94,7 @@ module G_node = struct
let of_conll ?loc ?prec ?succ ?domain line =
if line = Conll.root
then { empty with conll_root=true; succ}
then { empty with conll_root=true; succ; position = Ordered 0.}
else { empty with fs = G_fs.of_conll ?loc ?domain line; position = Ordered (float_of_conll_id line.Conll.id); prec; succ; efs=line.Conll.efs }
let pst_leaf ?loc ?domain phon position =
......
......@@ -298,6 +298,13 @@ module New_grs = struct
) ()
let to_json _ = failwith "TODO New_grs.to_json"
let get_strat_list grs =
handle ~name:"New_grs.get_strat_list"
(fun () ->
Grew_grs.New_grs.get_strat_list grs
) ()
end
(* ==================================================================================================== *)
......@@ -315,6 +322,9 @@ module Rewrite = struct
let display ~gr ~grs ~seq =
handle ~name:"Rewrite.display" (fun () -> Grew_grs.Grs.build_rew_display grs seq gr) ()
let new_display ~gr ~grs ~strat =
handle ~name:"Rewrite.new_display" (fun () -> Grew_grs.New_grs.det_rew_display grs strat gr) ()
let set_timeout t = Grew_base.Timeout.timeout := t
let rewrite ~gr ~grs ~seq =
......
......@@ -142,6 +142,7 @@ module New_grs : sig
val to_json: t -> string
val get_strat_list: t -> string list
end
(* ==================================================================================================== *)
......@@ -162,6 +163,8 @@ module Rewrite: sig
@param grs the graph rewriting system
@param seq the name of the sequence to apply *)
val display: gr:Graph.t -> grs:Grs.t -> seq:string -> display
val new_display: gr:Graph.t -> grs:New_grs.t -> strat:string -> display
val set_timeout: float option -> unit
......
......@@ -21,6 +21,12 @@ type rule_app = {
down: G_deco.t;
}
(* the type for big edges which correspond to a module *)
type big_step = {
first: rule_app;
small_step: (G_graph.t * rule_app) list;
}
(* the main type for display the result of a rewriting *)
type rew_display =
| Empty (* pour les besoin du dev *)
......@@ -28,8 +34,3 @@ type rew_display =
| Local_normal_form of G_graph.t * module_name * rew_display
| Node of G_graph.t * module_name * (big_step * rew_display) list
(* the type for big edges which correspond to a module *)
and big_step = {
first: rule_app;
small_step: (G_graph.t * rule_app) list;
}
......@@ -26,6 +26,12 @@ type rule_app = {
down: deco;
}
(** the type for big edges which correspond the a module *)
type big_step = {
first: rule_app;
small_step: (graph * rule_app) list;
}
(** the main type for display the result of a rewriting *)
type rew_display =
| Empty (* pour les besoin du dev *)
......@@ -33,8 +39,3 @@ type rew_display =
| Local_normal_form of graph * module_name * rew_display
| Node of graph * module_name * (big_step * rew_display) list
(** the type for big edges which correspond the a module *)
and big_step = {
first: rule_app;
small_step: (graph * rule_app) list;
}
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