Commit ef867aba authored by Bruno Guillaume's avatar Bruno Guillaume

add functions Rewrite.at_(least|most)_one

parent 2f4d9ee1
......@@ -470,6 +470,9 @@ module Grs = struct
) grs.modules
end (* module Grs *)
module New_grs = struct
type decl =
......@@ -896,6 +899,48 @@ module New_grs = struct
| Some [] -> Libgrew_types.Leaf instance.Instance.graph
| Some ((s1,b1,i1) :: tail) -> loop (s1,b1,Libgrew_types.Leaf i1.Instance.graph) tail
(* return true if strat always return at least one graph *)
let at_least_one grs strat =
let rec loop pointed strat =
match strat with
| New_ast.Ref strat_name ->
begin
let path = Str.split (Str.regexp "\\.") strat_name in
match search_from pointed path with
| None -> Error.build "cannot find strat %s" strat_name
| Some (Rule _,_)
| Some (Package _, _) -> false
| Some (Strategy (_,ast_strat), new_pointed) -> loop new_pointed ast_strat
end
| New_ast.Pick s -> loop pointed s
| New_ast.Alt l -> List.exists (fun s -> loop pointed s) l
| New_ast.Seq l -> List.for_all (fun s -> loop pointed s) l
| New_ast.Iter _ -> true
| New_ast.If (_,s1, s2) -> (loop pointed s1) && (loop pointed s2)
| New_ast.Try (s) -> loop pointed s in
loop (top grs) (Parser.strategy strat)
(* return true if strat always return at most one graph *)
let at_most_one grs strat =
let rec loop pointed strat =
match strat with
| New_ast.Ref strat_name ->
begin
let path = Str.split (Str.regexp "\\.") strat_name in
match search_from pointed path with
| None -> Error.build "cannot find strat %s" strat_name
| Some (Rule _,_)
| Some (Package _, _) -> false
| Some (Strategy (_,ast_strat), new_pointed) -> loop new_pointed ast_strat
end
| New_ast.Pick s -> true
| New_ast.Alt [one] -> loop pointed one
| New_ast.Alt _ -> false
| New_ast.Seq l -> List.for_all (fun s -> loop pointed s) l
| New_ast.Iter s -> loop pointed s
| New_ast.If (_,s1, s2) -> (loop pointed s1) || (loop pointed s2)
| New_ast.Try (s) -> loop pointed s in
loop (top grs) (Parser.strategy strat)
end
module Univ_grs = struct
......
......@@ -123,6 +123,8 @@ module New_grs : sig
val det_rew_display: t -> string -> G_graph.t -> Libgrew_types.rew_display
val get_strat_list: t -> string list
val at_least_one: t -> string -> bool
val at_most_one: t -> string -> bool
end
module Univ_grs : sig
......
......@@ -314,6 +314,8 @@ module Rewrite = struct
type display = Libgrew_types.rew_display
type history = Grew_grs.Rewrite_history.t
let size = Libgrew_types.rew_display_size
let set_max_depth_det value = Grew_rule.Rule.set_max_depth_det value
let set_max_depth_non_det value = Grew_rule.Rule.set_max_depth_non_det value
......@@ -336,6 +338,11 @@ module Rewrite = struct
let new_simple_rewrite ~gr ~grs ~strat =
handle ~name:"Rewrite.new_simple_rewrite" (fun () -> Grew_grs.New_grs.simple_rewrite grs strat gr) ()
let at_least_one ~grs ~strat =
handle ~name:"Rewrite.new_simple_rewrite" (fun () -> Grew_grs.New_grs.at_least_one grs strat) ()
let at_most_one ~grs ~strat =
handle ~name:"Rewrite.new_simple_rewrite" (fun () -> Grew_grs.New_grs.at_most_one grs strat) ()
let is_empty rh =
handle ~name:"Rewrite.is_empty" (fun () -> Grew_grs.Rewrite_history.is_empty rh) ()
......
......@@ -153,6 +153,7 @@ module Rewrite: sig
type display = Libgrew_types.rew_display
type history
val size: display -> int
val set_max_depth_det: int -> unit
val set_max_depth_non_det: int -> unit
val set_debug_loop: unit -> unit
......@@ -165,6 +166,8 @@ module Rewrite: sig
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 at_least_one: grs:New_grs.t -> strat:string -> bool
val at_most_one: grs:New_grs.t -> strat:string -> bool
val set_timeout: float option -> unit
......
......@@ -34,3 +34,8 @@ 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
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
......@@ -39,3 +39,4 @@ type rew_display =
| Local_normal_form of graph * module_name * rew_display
| Node of graph * module_name * (big_step * rew_display) list
val rew_display_size: rew_display -> int
\ No newline at end of file
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