diff --git a/src/grew_base.ml b/src/grew_base.ml index 1f35722d17365e70f13b55db136508563e24ade5..9794cac911de8581d2b3f6a8f9bb1d39f7a42c04 100644 --- a/src/grew_base.ml +++ b/src/grew_base.ml @@ -68,6 +68,37 @@ module String_ = struct |> (Str.global_replace (Str.regexp "\\( \\|\t\\)*$") "") |> (Str.global_replace (Str.regexp "^\\( \\|\t\\)*") "") + + let rec match_star_re re s = + let star_re = Str.full_split (Str.regexp "\\*+") re in + let len = String.length s in + let rec loop pos = function + | [] -> pos = len + + | [Str.Delim "*"] -> true + + | Str.Text t :: tail -> + if Str.string_match (Str.regexp_string t) s pos + then loop (pos+(String.length t)) tail + else false + + (* if the [re] ends with some text jump to the end and test for the text *) + | [Str.Delim "*"; Str.Text t] -> + Str.string_match (Str.regexp_string t) s (len - (String.length t)) + + (* if the [re] required for some text [t], + we consider the first occurence which is more general than other occurences *) + | Str.Delim "*" :: Str.Text t :: tail -> + begin + try + let new_pos = Str.search_forward (Str.regexp_string t) s pos in + loop (new_pos+(String.length t)) tail + with Not_found -> false + end + | _ -> Error.build "Ill formed regular expression \"%s\"" re + in + loop 0 star_re + end (* module String_ *) (* ================================================================================ *) diff --git a/src/grew_base.mli b/src/grew_base.mli index cb9c884165938727aa6caf078a3d14c9673ce1c8..2a1adf500d5d9f831c182c6ebd9527011973038c 100644 --- a/src/grew_base.mli +++ b/src/grew_base.mli @@ -30,6 +30,9 @@ module String_: sig (* [rm_peripheral_white s] returns the string [s] without any white space ot tab at the beginning or at the end of the string. *) val rm_peripheral_white: string -> string + + (** [match_star_re star_re string] returns true iff the string match the [star_re] *) + val match_star_re: string -> string -> bool end diff --git a/src/grew_edge.ml b/src/grew_edge.ml index 72c279b3b2a5fe1d2c9dec98f6c8534bcdaf02a1..f88cb9cca4522df3d796bf1660d408ab5a9965e3 100644 --- a/src/grew_edge.ml +++ b/src/grew_edge.ml @@ -81,26 +81,25 @@ module P_edge = struct | Binds of string * Label.t list let match_ pattern_edge graph_label = - match pattern_edge with - | {id = Some i; u_label = Pos l} when List.mem graph_label l -> Binds (i, [graph_label]) - | {id = None; u_label = Pos l} when List.mem graph_label l -> Ok graph_label - | {id = Some i; u_label = Neg l} when not (List.mem graph_label l) -> Binds (i, [graph_label]) - | {id = None; u_label = Neg l} when not (List.mem graph_label l) -> Ok graph_label + | {id = Some i; u_label = Pos l} when Label.match_list l graph_label -> Binds (i, [graph_label]) + | {id = None; u_label = Pos l} when Label.match_list l graph_label -> Ok graph_label + | {id = Some i; u_label = Neg l} when not (Label.match_list l graph_label) -> Binds (i, [graph_label]) + | {id = None; u_label = Neg l} when not (Label.match_list l graph_label) -> Ok graph_label | _ -> Fail let match_list pattern_edge graph_edge_list = match pattern_edge with - | {id = None; u_label = Pos l} when List.exists (fun label -> List.mem label l) graph_edge_list -> + | {id = None; u_label = Pos l} when List.exists (fun label -> Label.match_list l label) graph_edge_list -> Ok (List.hd graph_edge_list) - | {id = None; u_label = Neg l} when List.exists (fun label -> not (List.mem label l)) graph_edge_list -> + | {id = None; u_label = Neg l} when List.exists (fun label -> not (Label.match_list l label)) graph_edge_list -> Ok (List.hd graph_edge_list) | {id = Some i; u_label = Pos l} -> - (match List.filter (fun label -> List.mem label l) graph_edge_list with + (match List.filter (fun label -> Label.match_list l label) graph_edge_list with | [] -> Fail | list -> Binds (i, list)) | {id = Some i; u_label = Neg l} -> - (match List.filter (fun label -> not (List.mem label l)) graph_edge_list with + (match List.filter (fun label -> not (Label.match_list l label)) graph_edge_list with | [] -> Fail | list -> Binds (i, list)) | _ -> Fail diff --git a/src/grew_types.ml b/src/grew_types.ml index 7980d67590293133fe7d5f74e26994614c04b30c..61e05d87f0c82701798304fa56dac767d0892ffe 100644 --- a/src/grew_types.ml +++ b/src/grew_types.ml @@ -132,12 +132,21 @@ module Label = struct type t = | Global of int (* globally defined labels: their names are in the [full] array *) | Local of int (* locally defined labels: names array should be provided! UNTESTED *) + | Pattern of string + + let match_ p_label g_label = match (p_label, g_label, !full) with + | (Global p, Global g, _) when p=g -> true + | (Pattern p, Global i, Some table) when String_.match_star_re p table.(i) -> true + | _ -> false + + let match_list p_label_list g_label = List.exists (fun p_label -> match_ p_label g_label) p_label_list (** [to_string t] returns a string for the label *) let to_string ?(locals=[||]) t = match (!full, t) with | (Some table, Global i) -> table.(i) | (Some _, Local i) -> fst locals.(i) + | (_, Pattern s) -> s | _ -> Error.bug "[Label.to_string] labels were not properly initialized" let to_int = function @@ -150,6 +159,7 @@ module Label = struct let get_style = function | Global i -> !styles.(i) | Local i -> Log.warning "Style of locally defined labels is not implemented"; default + | Pattern _ -> default (** Computes the style of a label from its options and maybe its shape (like I:...). *) let parse_option string_label options = @@ -205,13 +215,16 @@ module Label = struct sprintf "[label=\"%s\", %s]" style.text (String.concat ", " dot_items) let from_string ?loc ?(locals=[||]) string = - match !full with - | None -> Error.bug "[Label.from_string] labels were not properly initialized" - | Some table -> - try Global (Id.build ?loc string table) - with Not_found -> - try Local (Array_.dicho_find_assoc string locals) - with Not_found -> Error.build "[Label.from_string] unknown edge label '%s'" string + if String.contains string '*' + then Pattern string + else + match !full with + | None -> Error.bug "[Label.from_string] labels were not properly initialized" + | Some table -> + try Global (Id.build ?loc string table) + with Not_found (* TODO (CANNOT BE RAISED) *) -> + try Local (Array_.dicho_find_assoc string locals) + with Not_found -> Error.build "[Label.from_string] unknown edge label '%s'" string end (* module Label *) (* ================================================================================ *) diff --git a/src/grew_types.mli b/src/grew_types.mli index 2fadb334a938933b1e032d2d565c4cd73f4ada50..f165689833c407501538162e0f95ca979c49981d 100644 --- a/src/grew_types.mli +++ b/src/grew_types.mli @@ -74,6 +74,10 @@ module Label : sig type t + val match_: t -> t -> bool + + val match_list: t list -> t -> bool + val init: decl list -> unit val to_string: ?locals:decl array -> t -> string