diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 index 0000000000000000000000000000000000000000..b32e51eb1b02361dddf3402a250da78fc9d21fd7 --- /dev/null +++ b/doc/Makefile @@ -0,0 +1,5 @@ +all: + dot -Tpdf arch.dot -o arch.pdf + +clean: + rm -f arch.pdf \ No newline at end of file diff --git a/doc/arch.dot b/doc/arch.dot index f9723998164e28408f8947c7a3eedf60752bb20a..44b4c0c900f3aba29d16b2399f144431084cb473 100644 --- a/doc/arch.dot +++ b/doc/arch.dot @@ -1,29 +1,32 @@ digraph grew { node [shape=Mrecord]; - grew_rule [label="{grew_rule|Instance(_set)\nRule}"] - grew_command [label="{grew_command|Command}"] - grew_grs [label="{grew_grs|Rewrite_history\nModul\nSequence\nGrs}"] - grew_graph [label="{grew_graph|P_deco\nP_graph\nG_deco\nConcat_item\nG_graph}"] - grew_ast [label="{grew_ast|Ast}"] - grew_fs [label="{grew_fs|Domain\nG_fs\nP_fs}"] - grew_node [label="{grew_node|G_node\nP_node}"] - grew_edge [label="{grew_edge|Label\nG_edge\nP_edge}"] - grew_html [label="{grew_html|Html_doc\nHtml_rh\nHtml_sentences\nGr_stat\nCorpus_stat}"] + rankdir = LR; + grew_base + grew_types [label="grew_types|Pid(_map\|_set)\nGid(_map)\nMassoc[_gid\|_pid]\nLabel\nDomain\nConll\nLex_par\nConcat_item"] + grew_ast [label="grew_ast|Ast"] + grew_fs [label="grew_fs|G_fs\nP_fs"] + grew_edge [label="grew_edge|G_edge\nP_edge"] + grew_node [label="grew_node|G_node\nP_node"] + grew_command [label="grew_command|Command"] + grew_graph [label="grew_graph|P_deco\nP_graph\nG_deco\nG_graph"] + grew_rule [label="grew_rule|Instance(_set)\nRule"] + grew_grs [label="grew_grs|Rewrite_history\nModul\nSequence\nGrs"] + grew_html [label="grew_html|Html_doc\nHtml_rh\nHtml_sentences\nHtml_annot\nGr_stat\nCorpus_stat"] -grew_ast -> grew_utils -grew_command -> grew_edge -grew_command -> grew_fs +grew_ast -> grew_types -> grew_base grew_edge -> grew_ast grew_fs -> grew_ast +grew_command -> grew_edge +grew_command -> grew_fs +grew_node -> grew_edge +grew_node -> grew_fs grew_graph -> grew_node grew_graph -> grew_command +libgrew_types -> grew_graph +grew_rule -> libgrew_types grew_grs -> grew_rule grew_html -> grew_grs -grew_node -> grew_edge -grew_node -> grew_fs -grew_rule -> grew_types -grew_types -> grew_graph libgrew -> grew_html -libgrew -> grew_types [style=dotted] +libgrew -> libgrew_types [style=dotted] } \ No newline at end of file diff --git a/src/grew_ast.ml b/src/grew_ast.ml index 006a10379d19f2225c4187e12cc0327c3a57bd42..c18cf8f126d17acf2534ff5af1feea71bf6bd053 100644 --- a/src/grew_ast.ml +++ b/src/grew_ast.ml @@ -210,14 +210,14 @@ module Ast = struct | Includ of (string * Loc.t) type grs_with_include = { - domain_wi: Domain.domain; + domain_wi: Domain.t; labels_wi: (string * string list) list; (* the list of global edge labels *) modules_wi: module_or_include list; sequences_wi: sequence list; } type grs = { - domain: Domain.domain; + domain: Domain.t; labels: (string * string list) list; modules: modul list; sequences: sequence list; diff --git a/src/grew_ast.mli b/src/grew_ast.mli index 07f5c2d528b458a1ec1d6cda0c1ef393d0cd5dfe..c5a6f9e6a0af118ba8032681a5d693ccb90e7a52 100644 --- a/src/grew_ast.mli +++ b/src/grew_ast.mli @@ -147,7 +147,7 @@ module Ast : sig | Includ of (string * Loc.t) type grs_with_include = { - domain_wi: Domain.domain; + domain_wi: Domain.t; labels_wi: (string * string list) list; (* the list of global edge labels *) modules_wi: module_or_include list; sequences_wi: sequence list; @@ -155,7 +155,7 @@ module Ast : sig (* a GRS: graph rewriting system *) type grs = { - domain: Domain.domain; + domain: Domain.t; labels: (string * string list) list; modules: modul list; sequences: sequence list; diff --git a/src/grew_base.ml b/src/grew_base.ml index f1a618ad5c3b522d590903422bf63513e586f96e..4003088853ee86ada23744005d1415d0d5951cc8 100644 --- a/src/grew_base.ml +++ b/src/grew_base.ml @@ -510,33 +510,6 @@ module Id = struct with Not_found -> None end (* module Id *) -(* ================================================================================ *) -module Html = struct - let css = String.concat "\n" [ - ""; - "" - ] - - let enter out_ch ?title ?header base_name = - fprintf out_ch "\n"; - (match title with - | Some t -> fprintf out_ch "\n%s\n%s\n\n" css t - | None -> fprintf out_ch "\n%s\n\n" css - ); - fprintf out_ch "\n"; - - (match header with None -> () | Some s -> fprintf out_ch "%s\n" s); - - (match title with - | Some t -> fprintf out_ch "

%s

\n" t - | None -> () - ) - - let leave out_ch = - fprintf out_ch "\n"; - fprintf out_ch "\n"; -end (* module Html *) - (* ================================================================================ *) (* copy from leopar *) module Timeout = struct diff --git a/src/grew_base.mli b/src/grew_base.mli index b4299dbbc3d26798af01a4ee91a5c170fbd0dca5..3be79ae856088e9e38aeab5824f8123480092dac 100644 --- a/src/grew_base.mli +++ b/src/grew_base.mli @@ -137,6 +137,7 @@ module List_: sig val prev_next_iter: (?prev:'a -> ?next:'a -> 'a -> unit) -> 'a list -> unit end +(* ================================================================================ *) module type OrderedType = sig type t @@ -152,7 +153,7 @@ module type OrderedType = end (** Input signature of the functor {!Map.Make}. *) - +(* ================================================================================ *) module type S = sig type key @@ -197,9 +198,10 @@ module type S = val rename: (key * key) list -> 'a t -> 'a t end - +(* ================================================================================ *) module Massoc_make (Ord : OrderedType) : S with type key = Ord.t +(* ================================================================================ *) module Error: sig exception Build of (string * Loc.t option) exception Run of (string * Loc.t option) @@ -210,6 +212,7 @@ module Error: sig val bug: ?loc: Loc.t -> ('a, unit, string, 'b) format4 -> 'a end +(* ================================================================================ *) module Id: sig type name = string type t = int @@ -222,11 +225,7 @@ module Id: sig val build_opt: name -> table -> t option end -module Html: sig - val enter: out_channel -> ?title: string -> ?header: string -> string -> unit - val leave: out_channel -> unit -end - +(* ================================================================================ *) module Timeout: sig exception Stop diff --git a/src/grew_command.ml b/src/grew_command.ml index 757c4ce4488f146fb82b475f498416069530d95b..3f8afdcf675eab7d247dd73761a8e2a0337c327e 100644 --- a/src/grew_command.ml +++ b/src/grew_command.ml @@ -18,7 +18,7 @@ open Grew_ast open Grew_edge open Grew_fs -(* ==================================================================================================== *) +(* ================================================================================ *) module Command = struct type command_node = (* a command node is either: *) | Pat of Pid.t (* a node identified in the pattern *) diff --git a/src/grew_command.mli b/src/grew_command.mli index 525599151cb8866294cd023d5263f969f22da5a4..f3a96c7f2834258b227c8fa58db8b7a614bd23f6 100644 --- a/src/grew_command.mli +++ b/src/grew_command.mli @@ -14,7 +14,7 @@ open Grew_types open Grew_edge -(* ==================================================================================================== *) +(* ================================================================================ *) module Command : sig type command_node = (* a command node is either: *) | Pat of Pid.t (* a node identified in the pattern *) diff --git a/src/grew_edge.ml b/src/grew_edge.ml index aaad9b94b5f31f797c5552fc9b82d3ed0eb1c0dc..72c279b3b2a5fe1d2c9dec98f6c8534bcdaf02a1 100644 --- a/src/grew_edge.ml +++ b/src/grew_edge.ml @@ -105,4 +105,3 @@ module P_edge = struct | list -> Binds (i, list)) | _ -> Fail end (* module P_edge *) - diff --git a/src/grew_edge.mli b/src/grew_edge.mli index aca842aaac97ebd21b2d0d7e8595dc7ece56cda4..1be6f643cbb2738d19e38e53491bdb0edc113658 100644 --- a/src/grew_edge.mli +++ b/src/grew_edge.mli @@ -13,8 +13,6 @@ open Grew_types open Grew_ast - - (* ================================================================================ *) (** The module [G_edge] defines the type of Graph label edges: atomic edges *) module G_edge: sig @@ -30,7 +28,6 @@ module G_edge: sig val to_dep: ?deco:bool -> t -> string end (* module G_edge *) - (* ================================================================================ *) (** The module [G_edge] defines the type of Graph label edges: atomic edges *) module P_edge: sig diff --git a/src/grew_fs.ml b/src/grew_fs.ml index 5b7d8bd8246b7c59d977eaa15417a9d0637aedd4..e082bad4e655a9bf600cfbc43da0e87d542ed810 100644 --- a/src/grew_fs.ml +++ b/src/grew_fs.ml @@ -15,7 +15,7 @@ open Grew_base open Grew_types open Grew_ast -(* ==================================================================================================== *) +(* ================================================================================ *) module G_feature = struct type t = string * value @@ -44,9 +44,9 @@ module G_feature = struct match Str.split (Str.regexp ":C:") string_val with | [] -> Error.bug "[G_feature.to_dot] feature value '%s'" string_val | fv::_ -> bprintf buff "%s=%s\n" feat_name fv -end +end (* module G_feature *) -(* ==================================================================================================== *) +(* ================================================================================ *) module P_feature = struct (* feature= (feature_name, disjunction of atomic values) *) @@ -94,9 +94,9 @@ module P_feature = struct match List_.pos var l with | Some index -> (name, Param index) | None -> Error.build ~loc "[P_feature.build] Unknown pattern variable '%s'" var -end +end (* module P_feature *) -(* ==================================================================================================== *) +(* ================================================================================ *) module G_fs = struct (* list are supposed to be striclty ordered wrt compare*) type t = G_feature.t list @@ -257,7 +257,7 @@ module G_fs = struct ) end (* module G_fs *) -(* ==================================================================================================== *) +(* ================================================================================ *) module P_fs = struct (* list are supposed to be striclty ordered wrt compare*) type t = P_feature.t list diff --git a/src/grew_graph.ml b/src/grew_graph.ml index 7b10d6f7f15e234763bc2b99fe2b43875068aa7e..028ed994298d44005947873ecd8117dc7d34f2d2 100644 --- a/src/grew_graph.ml +++ b/src/grew_graph.ml @@ -215,13 +215,6 @@ module G_deco = struct ) t.edges end (* module G_deco *) -(* ================================================================================ *) -module Concat_item = struct - type t = - | Feat of (Gid.t * string) - | String of string -end (* module Concat_item *) - (* ================================================================================ *) module G_graph = struct type t = { diff --git a/src/grew_graph.mli b/src/grew_graph.mli index 96eab9a4e92c802519b378c7ccd6b6e4dc03ea68..d3181584bbd1eaed70b6d4e515140b24a2e8576f 100644 --- a/src/grew_graph.mli +++ b/src/grew_graph.mli @@ -17,7 +17,7 @@ open Grew_edge open Grew_node open Grew_command -(* ==================================================================================================== *) +(* ================================================================================ *) module P_deco: sig type t = { nodes: Pid.t list; @@ -27,7 +27,7 @@ module P_deco: sig val empty:t end (* module P_deco *) -(* ==================================================================================================== *) +(* ================================================================================ *) module G_deco: sig type t = { nodes: (Gid.t * (string * string list)) list; @@ -37,10 +37,9 @@ module G_deco: sig val empty:t val dump: t -> unit - end (* module G_deco *) -(* ==================================================================================================== *) +(* ================================================================================ *) module P_graph: sig type t = P_node.t Pid_map.t @@ -74,14 +73,7 @@ module P_graph: sig (extension * Id.table) end (* module P_graph *) -(* ==================================================================================================== *) -module Concat_item : sig - type t = - | Feat of (Gid.t * string) - | String of string -end (* module Concat_item *) - -(* ==================================================================================================== *) +(* ================================================================================ *) module G_graph: sig type t @@ -178,6 +170,4 @@ module G_graph: sig (string * string) list * (string * string) list list * (int * string * int) list - -end - +end (* module G_graph *) \ No newline at end of file diff --git a/src/grew_grs.ml b/src/grew_grs.ml index 3d3f3319bd2a6df54dc69445c909082c4ed3fc7e..15810f46d71d9864328f7ed3bfaec52bf53fab37 100644 --- a/src/grew_grs.ml +++ b/src/grew_grs.ml @@ -21,7 +21,7 @@ open Grew_graph open Grew_rule open Grew_parser -(* ==================================================================================================== *) +(* ================================================================================ *) module Rewrite_history = struct type t = { instance: Instance.t; @@ -132,7 +132,7 @@ module Rewrite_history = struct in loop t end (* module Rewrite_history *) -(* ==================================================================================================== *) +(* ================================================================================ *) module Modul = struct type t = { name: string; @@ -172,7 +172,7 @@ module Modul = struct check modul; modul end (* module Modul *) -(* ==================================================================================================== *) +(* ================================================================================ *) module Sequence = struct type t = { name: string; @@ -198,7 +198,7 @@ module Sequence = struct check module_list sequence; sequence end (* module Sequence *) -(* ==================================================================================================== *) +(* ================================================================================ *) module Grs = struct type t = { diff --git a/src/grew_grs.mli b/src/grew_grs.mli index 30cc49b19f5355973c174f87d7efd5d8707078ca..8197a9c005ca18d147b961b040edb5553bd00e87 100644 --- a/src/grew_grs.mli +++ b/src/grew_grs.mli @@ -13,7 +13,7 @@ open Grew_graph open Grew_rule open Grew_ast -(* ==================================================================================================== *) +(* ================================================================================ *) module Rewrite_history: sig type t = { instance: Instance.t; @@ -54,9 +54,9 @@ module Rewrite_history: sig val det_dep_string: t -> string option val conll_dep_string: ?keep_empty_rh:bool -> t -> string option -end +end (* module Rewrite_history *) -(* ==================================================================================================== *) +(* ================================================================================ *) module Modul: sig type t = { name: string; @@ -67,9 +67,9 @@ module Modul: sig confluent: bool; loc: Loc.t; } -end +end (* module Modul *) -(* ==================================================================================================== *) +(* ================================================================================ *) module Grs: sig type t @@ -95,4 +95,4 @@ module Grs: sig val filter_iter: (string -> Rule.t -> unit) -> t -> unit val modules_of_sequence: t -> string -> Modul.t list -end +end (* module Grs *) diff --git a/src/grew_html.ml b/src/grew_html.ml index 3e282e6c15cc189ac1d9e9433675f478427b3458..6e5359cd092fbdf78a73b868986857ccf1f568d3 100644 --- a/src/grew_html.ml +++ b/src/grew_html.ml @@ -38,7 +38,7 @@ let html_header ?css_file ?title ?(add_lines=[]) buff = List.iter (fun line -> wnl " %s" line) add_lines; wnl " "; -(* ====================================================================================================*) +(* ================================================================================*) module Html_doc = struct let string_of_concat_item = function @@ -377,7 +377,7 @@ module Html_doc = struct (function | Domain.Closed (feat_name,values) -> wnl "%s : %s
" feat_name (String.concat " | " values) | Domain.Open feat_name -> wnl " %s : *
" feat_name - | Domain.Int feat_name -> wnl " %s : #
" feat_name + | Domain.Num feat_name -> wnl " %s : #
" feat_name ) ast.Ast.domain; wnl " "; @@ -496,7 +496,7 @@ module Html_doc = struct done end (* module Html_doc *) -(* ==================================================================================================== *) +(* ================================================================================ *) module Html_rh = struct let build ?filter ?main_feat ?(dot=false) ?(init_graph=true) ?(out_gr=false) ?header ?graph_file prefix t = @@ -637,7 +637,7 @@ module Html_rh = struct close_out out_ch end (* module Html_rh *) -(* ====================================================================================================*) +(* ================================================================================*) module Html_sentences = struct let build ~title output_dir sentences = let buff = Buffer.create 32 in @@ -674,9 +674,7 @@ module Html_sentences = struct close_out out_ch end (* module Html_sentences *) - - -(* ====================================================================================================*) +(* ================================================================================*) module Gr_stat = struct (** the type [gr] stores the stats for the rewriting of one gr file *) @@ -792,7 +790,7 @@ module Gr_stat = struct with Sys_error msg -> Error (sprintf "Sys_error: %s" msg) end (* module Gr_stat *) -(* ====================================================================================================*) +(* ================================================================================*) module Corpus_stat = struct (** the [t] type stores stats for a corpus of gr_files *) (* @@ -1006,11 +1004,8 @@ module Corpus_stat = struct let out_ch = open_out (Filename.concat output_dir "index.html") in fprintf out_ch "%s" (Buffer.contents buff); close_out out_ch - end (* module Stat *) - -(* ==================================================================================================== *) module Html_annot = struct let script_lines static_dir = [ @@ -1134,5 +1129,4 @@ module Html_annot = struct fprintf out_ch "%s" (Buffer.contents buff); close_out out_ch; () - end (* module Html_annot *) diff --git a/src/grew_html.mli b/src/grew_html.mli index a892360a42097e8ba702cbda772c1a39c7edf096..092c307a6f5bd653ba303e793a77efc0b84931dd 100644 --- a/src/grew_html.mli +++ b/src/grew_html.mli @@ -12,16 +12,18 @@ open Grew_rule open Grew_grs +(* ================================================================================ *) module Html_doc : sig (* dep is a flag which is true iff dep file are shown in doc (iff dep2pict is available) *) val build: dep:bool -> corpus:bool -> string -> Grs.t -> unit -end +end (* module Html_doc *) +(* ================================================================================ *) module Html_sentences : sig val build: title:string -> string -> (bool * string * int * string) list -> unit -end - +end (* module Html_sentences *) +(* ================================================================================ *) module Html_rh: sig val build: @@ -45,8 +47,9 @@ module Html_rh: sig string -> Instance.t option -> unit -end +end (* module Html_rh *) +(* ================================================================================ *) module Gr_stat: sig type t @@ -55,8 +58,9 @@ module Gr_stat: sig val save: string -> t -> unit val load: string -> t -end +end (* module Gr_stat *) +(* ================================================================================ *) module Corpus_stat: sig type t @@ -70,8 +74,9 @@ module Corpus_stat: sig input_dir:string -> output_dir:string -> t -> unit -end +end (* module Corpus_stat *) +(* ================================================================================ *) module Html_annot: sig val build: title:string -> string -> string -> (string * Rewrite_history.t) list -> unit -end +end (* module Html_annot *) diff --git a/src/grew_node.ml b/src/grew_node.ml index 8e2445775d7fa3f21c0f24e43ec495d05dd04697..bf42b5836e670d5763f8c9bf1d0f4ece2e856c9f 100644 --- a/src/grew_node.ml +++ b/src/grew_node.ml @@ -89,8 +89,7 @@ module G_node = struct let position_comp n1 n2 = Pervasives.compare n1.position n2.position let rename mapping n = {n with next = Massoc_gid.rename mapping n.next} -end -(* ================================================================================ *) +end (* module G_node *) (* ================================================================================ *) module P_node = struct @@ -130,5 +129,4 @@ module P_node = struct else raise P_fs.Fail let compare_pos t1 t2 = Pervasives.compare t1.loc t2.loc -end -(* ================================================================================ *) +end (* module P_node *) \ No newline at end of file diff --git a/src/grew_rule.ml b/src/grew_rule.ml index 90a078e777c5bb02506effb5d8104a01d47130e3..98adad675915f9e2f11b94618e8ddb001b7cdc5b 100644 --- a/src/grew_rule.ml +++ b/src/grew_rule.ml @@ -21,7 +21,6 @@ open Grew_node open Grew_command open Grew_graph - (* ================================================================================ *) module Instance = struct type t = { @@ -69,7 +68,7 @@ module Instance = struct let save_dot_png ?filter ?main_feat base t = ignore (Dot.to_png_file (G_graph.to_dot ?main_feat t.graph) (base^".png")) -IFDEF DEP2PICT THEN + IFDEF DEP2PICT THEN let save_dep_png ?filter ?main_feat base t = let (_,_,highlight_position) = Dep2pict.Dep2pict.fromDepStringToPng_with_pos @@ -82,10 +81,10 @@ IFDEF DEP2PICT THEN (G_graph.to_dep ?filter ?main_feat t.graph) (base^".svg") in highlight_position -ELSE + ELSE let save_dep_png ?filter ?main_feat base t = None let save_dep_svg ?filter ?main_feat base t = None -ENDIF + ENDIF end (* module Instance *) (* ================================================================================ *) @@ -392,7 +391,6 @@ module Rule = struct } exception Fail -(* ================================================================================ *) type partial = { sub: matching; unmatched_nodes: Pid.t list; @@ -405,7 +403,7 @@ module Rule = struct - all partial matching have the same domain - the domain of the pattern P is the disjoint union of domain([sub]) and [unmatched_nodes] *) - + (* ---------------------------------------------------------------------- *) let init param pattern = let roots = P_graph.roots pattern.graph in @@ -426,16 +424,7 @@ module Rule = struct check = pattern.constraints; } -(* (\* Ocaml < 3.12 doesn't have exists function for maps! *\) *) -(* exception True *) -(* let gid_map_exists fct map = *) -(* try *) -(* Gid_map.iter (fun k v -> if fct k v then raise True) map; *) -(* false *) -(* with True -> true *) -(* (\* Ocaml < 3.12 doesn't have exists function for maps! *\) *) - - + (* ---------------------------------------------------------------------- *) let fullfill graph matching cst = let get_node pid = G_graph.find (Pid_map.find pid matching.n_match) graph in let get_string_feat pid = function @@ -479,6 +468,7 @@ module Rule = struct | (Ast.Ge, Some fv1, Some fv2) when fv1 >= fv2 -> true | _ -> false + (* ---------------------------------------------------------------------- *) (* returns all extension of the partial input matching *) let rec extend_matching (positive,neg) (graph:G_graph.t) (partial:partial) = match (partial.unmatched_edges, partial.unmatched_nodes) with @@ -533,6 +523,7 @@ module Rule = struct (extend_matching_from (positive,neg) graph pid gid partial) @ acc ) graph [] + (* ---------------------------------------------------------------------- *) and extend_matching_from (positive,neg) (graph:G_graph.t) pid (gid : Gid.t) partial = if List.mem gid partial.already_matched_gids then [] (* the required association pid -> gid is not injective *) @@ -569,10 +560,12 @@ module Rule = struct extend_matching (positive,neg) graph new_partial with P_fs.Fail -> [] -(* the exception below is added to handle unification failure in merge!! *) + (* ---------------------------------------------------------------------- *) + (* the exception below is added to handle unification failure in merge!! *) exception Command_execution_fail -(** [apply_command instance matching created_nodes command] returns [(new_instance, new_created_nodes)] *) + (* ---------------------------------------------------------------------- *) + (** [apply_command instance matching created_nodes command] returns [(new_instance, new_created_nodes)] *) let apply_command (command,loc) instance matching (created_nodes, (activated_nodes:((Pid.t * string) * Gid.t) list)) = let node_find cnode = find ~loc cnode (matching, (created_nodes, activated_nodes)) in @@ -735,9 +728,9 @@ module Rule = struct (created_nodes, activated_nodes) ) -(** [apply_rule instance matching rule] returns a new instance after the application of the rule - [Command_execution_fail] is raised if some merge unification fails - *) + (* ---------------------------------------------------------------------- *) + (** [apply_rule instance matching rule] returns a new instance after the application of the rule + [Command_execution_fail] is raised if some merge unification fails *) let apply_rule instance matching rule = (* Timeout check *) @@ -770,8 +763,7 @@ module Rule = struct | Some bs -> Some { bs with Libgrew_types.small_step = (instance.Instance.graph, rule_app) :: bs.Libgrew_types.small_step } } -(*-----------------------------*) - + (* ---------------------------------------------------------------------- *) let update_partial pos_graph without (sub, already_matched_gids) = let neg_graph = without.graph in let unmatched_nodes = @@ -804,16 +796,17 @@ module Rule = struct } + (* ---------------------------------------------------------------------- *) let fulfill (pos_graph,neg_graph) graph new_partial_matching = match extend_matching (pos_graph, neg_graph) graph new_partial_matching with | [] -> true (* the without pattern in not found -> OK *) | x -> false -(* ================================================================================ *) -(* ================================================================================ *) -(* ================================================================================ *) -(* ================================================================================ *) + (* ================================================================================ *) + (* ================================================================================ *) + (* ================================================================================ *) + (* ================================================================================ *) let match_in_graph rule graph = let pos_graph = rule.pos.graph in @@ -836,12 +829,13 @@ module Rule = struct ) matching_list in List.map fst filtered_matching_list -(* ================================================================================ *) -(* ================================================================================ *) -(* ================================================================================ *) -(* ================================================================================ *) + (* ================================================================================ *) + (* ================================================================================ *) + (* ================================================================================ *) + (* ================================================================================ *) + (* ---------------------------------------------------------------------- *) (** [one_step instance rules] computes the list of one-step reduct with rules *) let one_step instance rules = List.fold_left @@ -855,7 +849,8 @@ module Rule = struct ) acc matching_list ) [] rules -(** [conf_one_step instance rules] computes one Some (one-step reduct) with rules, None if no rule apply *) + (* ---------------------------------------------------------------------- *) + (** [conf_one_step instance rules] computes one Some (one-step reduct) with rules, None if no rule apply *) let rec conf_one_step (instance : Instance.t) = function | [] -> None | rule::rule_tail -> @@ -883,7 +878,8 @@ module Rule = struct with Not_found -> (* try another rule *) conf_one_step instance rule_tail -(** filter nfs being equal *) + (* ---------------------------------------------------------------------- *) + (** filter nfs being equal *) let rec filter_equal_nfs nfs = Instance_set.fold (fun nf acc -> @@ -892,11 +888,9 @@ module Rule = struct else Instance_set.add nf acc ) nfs Instance_set.empty -(** normalize [t] according to the [rules] - * [t] is a raw graph - * Info about the commands applied on [t] are kept - *) - + (* ---------------------------------------------------------------------- *) + (** normalize [t] according to the [rules]. [t] is a raw graph + Info about the commands applied on [t] are kept *) (* type: Instance.t -> t list -> Instance_set.t *) let normalize_instance modul_name instance rules = let rec loop to_do_set nf_set = @@ -921,7 +915,7 @@ module Rule = struct then Log.fwarning "In module \"%s\", %d nf are produced, only %d different ones" modul_name nfs_card reduced_nfs_card; reduced_nfs - + (* ---------------------------------------------------------------------- *) (* [filter_instance instance filters] return a boolean: - true iff the instance does NOT match any pattern in [filters] *) let filter_instance filters instance = @@ -950,13 +944,13 @@ module Rule = struct else loop filter_tail in loop filters - - + (* ---------------------------------------------------------------------- *) let rec conf_normalize instance rules = match conf_one_step instance rules with | Some new_instance -> conf_normalize new_instance rules | None -> Instance.rev_steps instance + (* ---------------------------------------------------------------------- *) let normalize modul_name ?(confluent=false) rules filters instance = if confluent then @@ -968,5 +962,4 @@ module Rule = struct let output_set = normalize_instance modul_name instance rules in let (good_set, bad_set) = Instance_set.partition (filter_instance filters) output_set in (good_set, bad_set) - end (* module Rule *) diff --git a/src/grew_rule.mli b/src/grew_rule.mli index e2b9f23e77fa4d40208bb2d53f80a77334f0060a..7ee5888e80f0bed2f84291d9007f4aa411e3ee31 100644 --- a/src/grew_rule.mli +++ b/src/grew_rule.mli @@ -54,7 +54,6 @@ module Instance : sig val save_dot_png: ?filter: string list -> ?main_feat: string -> string -> t -> unit end (* module Instance *) - (* ================================================================================ *) module Instance_set : Set.S with type elt = Instance.t @@ -90,5 +89,4 @@ module Rule : sig type matching val match_in_graph: t -> G_graph.t -> matching list - end (* module Rule *) diff --git a/src/grew_types.ml b/src/grew_types.ml index 9fc8f228d61b9b46cbb8ff8a155a665516d7ee08..84681696beea160d46b484b7409c12678262f632 100644 --- a/src/grew_types.ml +++ b/src/grew_types.ml @@ -62,12 +62,6 @@ module Pid_map = false with True -> true - (* let range key_set m = *) - (* IntSet.fold (fun k s -> (IntSet.add (find k m) s)) key_set IntSet.empty *) - - (* let keys m = *) - (* fold (fun k v s -> (IntSet.add k s)) m IntSet.empty *) - (* union of two maps*) let union_map m m' = fold (fun k v m'' -> (add k v m'')) m m' end (* module Pid_map *) @@ -214,30 +208,30 @@ module Label = struct with Not_found -> Error.build "[Label.from_string] unknown edge label '%s'" string end (* module Label *) -(* ==================================================================================================== *) +(* ================================================================================ *) module Domain = struct type feature_spec = | Closed of feature_name * feature_atom list (* cat:V,N *) | Open of feature_name (* phon, lemma, ... *) - | Int of feature_name (* position *) + | Num of feature_name (* position *) - type domain = feature_spec list + type t = feature_spec list let is_defined feature_name domain = List.exists (function | Closed (fn,_) when fn = feature_name -> true | Open fn when fn = feature_name -> true - | Int fn when fn = feature_name -> true + | Num fn when fn = feature_name -> true | _ -> false ) domain let rec normalize_domain = function - | [] -> [Int "position"] - | (Int "position") :: tail -> Log.warning "[Domain] declaration of the feature name \"position\" in useless"; normalize_domain tail + | [] -> [Num "position"] + | (Num "position") :: tail -> Log.warning "[Domain] declaration of the feature name \"position\" in useless"; normalize_domain tail | (Open "position") :: _ | (Closed ("position",_)) :: _ -> Error.build "[Domain] The feature named \"position\" is reserved and must be types 'integer', you cannot not redefine it" - | (Int fn) :: tail | (Open fn) :: tail | Closed (fn,_) :: tail when is_defined fn tail -> + | (Num fn) :: tail | (Open fn) :: tail | Closed (fn,_) :: tail when is_defined fn tail -> Error.build "[Domain] The feature named \"%s\" is defined several times" fn | x :: tail -> x :: (normalize_domain tail) @@ -258,7 +252,7 @@ module Domain = struct | [] -> Error.build ?loc "[GRS] Unknown feature name '%s'" name | ((Open n)::_) when n = name -> List.map (fun s -> String s) values - | ((Int n)::_) when n = name -> + | ((Num n)::_) when n = name -> (try List.map (fun s -> Float (String_.to_float s)) values with Failure _ -> Error.build ?loc "[GRS] The feature '%s' is of type int" name) | ((Closed (n,vs))::_) when n = name -> @@ -280,7 +274,7 @@ module Domain = struct let feature_names () = match !current with | None -> None - | Some dom -> Some (List.map (function Closed (fn, _) | Open fn | Int fn -> fn) dom) + | Some dom -> Some (List.map (function Closed (fn, _) | Open fn | Num fn -> fn) dom) end (* Domain *) (* ================================================================================ *) @@ -440,3 +434,11 @@ module Lex_par = struct ) | l -> Error.run "Lexical parameter are not functionnal" end (* module Lex_par *) + +(* ================================================================================ *) +module Concat_item = struct + type t = + | Feat of (Gid.t * feature_name) + | String of string +end (* module Concat_item *) + diff --git a/src/grew_types.mli b/src/grew_types.mli index 8d1e4bb76834f1e50092ecf873b6fbebd556e4bd..d0e40d0b269f9bd893d5213ff45ab0393bc43f4b 100644 --- a/src/grew_types.mli +++ b/src/grew_types.mli @@ -92,14 +92,14 @@ module Domain: sig type feature_spec = | Closed of feature_name * feature_atom list (* cat:V,N *) | Open of feature_name (* phon, lemma, ... *) - | Int of feature_name (* position *) + | Num of feature_name (* position *) - type domain = feature_spec list - val normalize_domain: domain -> domain + type t = feature_spec list + val normalize_domain: t -> t val reset: unit -> unit - val init: domain -> unit + val init: t -> unit val build: ?loc:Loc.t -> feature_name -> feature_atom list -> value list @@ -162,4 +162,12 @@ module Lex_par: sig val get_command_value: int -> t -> string end (* module Lex_par *) +(* ================================================================================ *) +module Concat_item : sig + type t = + | Feat of (Gid.t * feature_name) + | String of string +end (* module Concat_item *) + + diff --git a/src/parser/gr_grs_parser.mly b/src/parser/gr_grs_parser.mly index e5c7dc8223720c865d2d8b2464576218693b8eeb..c4206c6fa9cde55a5bf21ccccf5ed54522f3e1cf 100644 --- a/src/parser/gr_grs_parser.mly +++ b/src/parser/gr_grs_parser.mly @@ -210,7 +210,7 @@ features_group: { match feature_values with | ["*"] -> Domain.Open feature_name - | ["#"] -> Domain.Int feature_name + | ["#"] -> Domain.Num feature_name | _ -> Domain.Closed (feature_name, List.sort Pervasives.compare feature_values) }