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

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 *)
This diff is collapsed.
......@@ -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