Commit a409d328 authored by bguillaum's avatar bguillaum

- main_feat is now a list and is used in the "dot" representation

- recursive use of include is allowed

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6710 7838e531-6607-4d57-9587-6c381814729c
parent e3dc9704
......@@ -12,6 +12,8 @@ module Feature = struct
let get_name = function | Equal (n,_) -> n | Different (n,_) -> n
let get_atom = function | Equal (n,[one]) -> Some one | _ -> None
let compare feat1 feat2 = Pervasives.compare (get_name feat1) (get_name feat2)
(* suppose all feat_names to be different and ordered *)
......@@ -80,39 +82,50 @@ module Feature_structure = struct
let to_string t = List_.to_string string_of_feature "\\n" t
let get_main ?main_feat t =
let main_list = match main_feat with
| None -> []
| Some string -> Str.split (Str.regexp " *; *") string in
let rec loop = function
| [] -> (None, t)
| feat_name :: tail ->
(match List.partition (fun f -> Feature.get_name f = feat_name) t with
| ([], _) -> loop tail
| ([one], sub) -> (Some one, sub)
| _ -> Log.critical "[Feature_structure.to_dep] several feature with the same name") in
loop main_list
let escape string =
Str.global_replace (Str.regexp_string "//PV//") ";"
(Str.global_replace (Str.regexp_string "//AND//") "&" string)
let to_dot ?main_feat t =
let (main_opt, sub) = get_main ?main_feat t in
sprintf "%s%s"
(match main_opt with
| Some feat -> escape (match Feature.get_atom feat with Some atom -> atom^"|" | None -> "")
| None -> "" )
(List_.to_string string_of_feature "\\n" sub)
let gr_of_feature = function
| Feature.Equal (feat_name, [one]) -> sprintf "%s=\"%s\"" feat_name one
| _ -> Log.critical "[Feature_structure.gr_of_feature] all feature in gr must be atomic value"
let to_gr t = List_.to_string gr_of_feature ", " t
let to_dep ?main_feat t =
let main = match main_feat with None -> "label" | Some mf -> mf in
let wordform =
try
match
(List.find
(function Feature.Equal (f, _) | Feature.Different (f, _) when f=main -> true | _ -> false)
t
) with
| Feature.Equal (_,[ph]) | Feature.Different (_,[ph]) ->
Str.global_replace (Str.regexp_string "//PV//") ";"
(Str.global_replace (Str.regexp_string "//AND//") "&" ph)
| _ -> raise Not_found
with Not_found -> "" in
let fs =
Str.global_replace (Str.regexp_string "//PV//") ";"
(Str.global_replace (Str.regexp_string "//AND//") "&"
(List_.to_string string_of_feature "#"
(List.filter
(function Feature.Equal (f, _) | Feature.Different (f, _) when f=main -> false | _ -> true) t)
)
) in
match fs with
| "" -> sprintf " word=\"%s\"; " wordform
| s -> sprintf " word=\"%s\"; subword=\"%s\"; " wordform s
let to_dep ?main_feat t =
let (main_opt, sub) = get_main ?main_feat t in
sprintf " word=\"%s\"; subword=\"%s\"; "
(match main_opt with
| Some feat -> escape (match Feature.get_atom feat with Some atom -> atom | None -> "")
| None -> "")
(escape (List_.to_string string_of_feature "#" sub))
let rec set_feat feature_name atoms = function
| [] -> [Feature.Equal (feature_name, atoms)]
......
......@@ -16,6 +16,7 @@ module Feature_structure: sig
val empty: t
val to_string: t -> string
val to_dot: ?main_feat: string -> t -> string
val to_gr: t -> string
val to_dep: ?main_feat: string -> t -> string
......
......@@ -178,16 +178,20 @@ module Graph = struct
Buffer.contents buff
let to_dot ?(deco=Deco.empty) graph =
let to_dot ?main_feat ?(deco=Deco.empty) graph =
let buff = Buffer.create 32 in
bprintf buff "digraph G {\n";
bprintf buff " rankdir=LR;\n";
bprintf buff " node [shape=Mrecord];\n";
(* list of the nodes *)
IntMap.iter
(fun id node ->
bprintf buff "N%d[shape=Mrecord, label=\"{%s}\", color=%s]\n"
id (Feature_structure.to_string node.Node.fs) (if List.mem id deco.Deco.nodes then "red" else "black")
bprintf buff " N%d [label=\"%s\", color=%s]\n"
id
(Feature_structure.to_dot ?main_feat node.Node.fs)
(if List.mem id deco.Deco.nodes then "red" else "black")
) graph.map;
(* list of the edges *)
IntMap.iter
......@@ -195,7 +199,7 @@ module Graph = struct
Massoc.iter
(fun tar edge ->
let deco = List.mem (id,Edge.as_label edge,tar) deco.Deco.edges in
bprintf buff "N%d->N%d%s\n" id tar (Edge.to_dot ~deco edge)
bprintf buff " N%d -> N%d%s\n" id tar (Edge.to_dot ~deco edge)
) node.Node.next
) graph.map;
......
......@@ -51,7 +51,7 @@ module Graph : sig
val find: int -> t -> Node.t
val to_gr: t -> string
val to_dot: ?deco:Deco.t -> t -> string
val to_dot: ?main_feat:string -> ?deco:Deco.t -> t -> string
val to_dep: ?main_feat:string -> ?deco:Deco.t -> t -> string
val add_edge : t -> int -> Edge.t -> int -> t option
......
......@@ -24,6 +24,6 @@ and big_step = {
small_step: (Graph.t * rule_app) list;
}
let to_dot_graph ?(deco=Deco.empty) graph = Graph.to_dot graph ~deco
let to_dot_graph ?main_feat ?(deco=Deco.empty) graph = Graph.to_dot ?main_feat graph ~deco
let to_dep_graph ?main_feat ?(deco=Deco.empty) graph = Graph.to_dep ?main_feat ~deco graph
let to_gr_graph graph = Graph.to_gr graph
......@@ -31,6 +31,6 @@ and big_step = {
(** {2 Types displaying} *)
val to_dot_graph : ?deco:deco -> graph -> string
val to_dot_graph : ?main_feat:string -> ?deco:deco -> graph -> string
val to_dep_graph : ?main_feat:string -> ?deco:deco -> graph -> string
val to_gr_graph: graph -> string
......@@ -73,7 +73,7 @@ let localize t = (t,get_loc ())
%start <Grew_ast.Ast.grs_with_include> grs_with_include
%start <Grew_ast.Ast.grs> grs
%start <Grew_ast.Ast.gr> gr
%start <Grew_ast.Ast.modul list> included
%start <Grew_ast.Ast.module_or_include list> included
%%
/*=============================================================================================*/
......@@ -210,7 +210,7 @@ global_labels:
/*=============================================================================================*/
included:
| x = list(grew_module) EOF { x }
| x = list (module_or_include) EOF { x }
modules:
| x = list(grew_module) { x }
......
......@@ -87,7 +87,7 @@ module Grew_parser = struct
if Filename.is_relative inc_file
then Filename.concat (Filename.dirname main_file) inc_file
else inc_file in
(parse_file_to_module_list sub_file)
(flatten_modules (parse_file_to_module_list sub_file))
@ (flatten_modules tail) in
{
Ast.domain = grs_with_includes.Ast.domain_wi;
......
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