Commit eeae0985 authored by bguillaum's avatar bguillaum

move strategies definition in grew_ast.ml

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@9145 7838e531-6607-4d57-9587-6c381814729c
parent 52af666e
......@@ -2,7 +2,7 @@ digraph grew {
node [shape=Mrecord];
rankdir = LR;
grew_base [label="grew_base|String_map\nString_set\nInt_map\nInt_set\nString_\nDot\nLoc\nFile\nArray_\nList_\nMassoc_make()\nError\nId\nTimeout\nGlobal"]
grew_types [label="grew_types|Pid(_map\|_set)\nGid(_map)\nMassoc[_gid\|_pid]\nLabel_domain\nFeature_domain\nDomain\nLabel\nFeature_value\nLex_par\nConcat_item\nStrategy"]
grew_types [label="grew_types|Pid(_map\|_set)\nGid(_map)\nMassoc[_gid\|_pid]\nLabel_domain\nFeature_domain\nDomain\nLabel\nFeature_value\nLex_par\nConcat_item"]
grew_ast [label="grew_ast|Ast"]
grew_loader [label="grew_loader|Loader\nParser"]
grew_fs [label="grew_fs|G_feature\nP_feature\nG_fs\nP_fs"]
......
......@@ -314,6 +314,49 @@ module Ast = struct
mod_dir: string; (* the directory where the module is defined (for lp file localisation) *)
}
type strat_def = (* /!\ The list must not be empty in the Seq or Plus constructor *)
| Ref of string (* reference to a module name or to another strategy *)
| Seq of strat_def list (* a sequence of strategies to apply one after the other *)
| Plus of strat_def list (* a set of strategies to apply in parallel *)
| Star of strat_def (* a strategy to apply iteratively *)
| Diamond of strat_def (* pick one normal form a the given strategy *)
| Sequence of string list (* compatibility mode with old code *)
let rec strat_def_to_string = function
| Ref m -> m
| Seq l -> "[" ^ (String.concat "; " (List.map strat_def_to_string l)) ^ "]"
| Plus l -> "[" ^ (String.concat "+" (List.map strat_def_to_string l)) ^ "]"
| Star s -> "[" ^ (strat_def_to_string s) ^"]" ^ "*"
| Diamond s -> "◇" ^ "[" ^(strat_def_to_string s)^"]"
| Sequence names -> "{" ^ (String.concat ";" names) ^ "}"
(* invariant: Seq list and Plus list are not empty in the input and so not empty in the output *)
let rec strat_def_flatten = function
| Sequence l -> Sequence l
| Ref m -> Ref m
| Star s -> Star (strat_def_flatten s)
| Diamond s -> Diamond (strat_def_flatten s)
| Seq l ->
let fl = List.map strat_def_flatten l in
let rec loop = function
| [] -> []
| (Seq l) :: tail -> l @ (loop tail)
| x :: tail -> x :: (loop tail)
in Seq (loop fl)
| Plus l ->
let fl = List.map strat_def_flatten l in
let rec loop = function
| [] -> []
| (Plus l) :: tail -> l @ (loop tail)
| x :: tail -> x :: (loop tail)
in Plus (loop fl)
type strategy = {
strat_name: string;
strat_def: strat_def;
strat_doc: string list;
strat_loc: Loc.t;
}
(** a GRS: graph rewriting system *)
......@@ -331,13 +374,13 @@ module Ast = struct
type grs_wi = {
domain_wi: domain_wi option;
modules_wi: module_or_include list;
strategies_wi: Strategy.t list;
strategies_wi: strategy list;
}
type grs = {
domain: domain option;
modules: modul list;
strategies: Strategy.t list;
strategies: strategy list;
}
type gr = {
......
......@@ -187,33 +187,50 @@ module Ast : sig
type domain_wi = Dom of domain | Dom_file of string
type strat_def = (* /!\ The list must not be empty in the Seq or Plus constructor *)
| Ref of string (* reference to a module name or to another strategy *)
| Seq of strat_def list (* a sequence of strategies to apply one after the other *)
| Plus of strat_def list (* a set of strategies to apply in parallel *)
| Star of strat_def (* a strategy to apply iteratively *)
| Diamond of strat_def (* pick one normal form a the given strategy *)
| Sequence of string list (* compatibility mode with old code *)
val strat_def_to_string: strat_def -> string
val strat_def_flatten: strat_def -> strat_def
(* a strategy is given by its descrition in the grs file and the 4 fields: *)
type strategy = {
strat_name:string; (* a unique name of the stratgy *)
strat_def:strat_def; (* the definition itself *)
strat_doc:string list; (* lines of docs (if any in the GRS file) *)
strat_loc:Loc.t; (* the location of the [name] of the strategy *)
}
type grs_wi = {
domain_wi: domain_wi option;
modules_wi: module_or_include list;
strategies_wi: Strategy.t list;
strategies_wi: strategy list;
}
(* a GRS: graph rewriting system *)
type grs = {
domain: domain option;
modules: modul list;
strategies: Strategy.t list;
strategies: strategy list;
}
val empty_grs: grs
type gr = {
meta: string list;
nodes: node list;
edges: edge list;
}
val complete_graph: gr -> gr
val empty_grs: grs
(* phrase structure tree *)
type pst =
| Leaf of (Loc.t * string) (* phon *)
| T of (Loc.t * string * pst list)
val word_list: pst -> string list
end (* module Ast *)
......@@ -190,7 +190,7 @@ module Grs = struct
type t = {
domain: Domain.t option;
modules: Modul.t list; (* the ordered list of modules used from rewriting *)
strategies: Strategy.t list;
strategies: Ast.strategy list;
filename: string;
ast: Ast.grs;
}
......@@ -201,7 +201,7 @@ module Grs = struct
let get_domain t = t.domain
let sequence_names t = List.map (fun s -> s.Strategy.name) t.strategies
let sequence_names t = List.map (fun s -> s.Ast.strat_name) t.strategies
let empty = {domain=None; modules=[]; strategies=[]; ast=Ast.empty_grs; filename=""; }
......@@ -217,9 +217,9 @@ module Grs = struct
(* check for duplicate strategies *)
let rec loop already_defined = function
| [] -> ()
| s::_ when List.mem s.Strategy.name already_defined ->
Error.build ~loc:s.Strategy.loc "Sequence '%s' is defined twice" s.Strategy.name
| s::tail -> loop (s.Strategy.name :: already_defined) tail in
| s::_ when List.mem s.Ast.strat_name already_defined ->
Error.build ~loc:s.Ast.strat_loc "Sequence '%s' is defined twice" s.Ast.strat_name
| s::tail -> loop (s.Ast.strat_name :: already_defined) tail in
loop [] t.strategies
let domain_build ast_domain =
......@@ -237,7 +237,7 @@ module Grs = struct
(* ---------------------------------------------------------------------------------------------------- *)
let rewrite grs strategy_name graph =
let strategy = List.find (fun s -> s.Strategy.name = strategy_name) grs.strategies in
let strategy = List.find (fun s -> s.Ast.strat_name = strategy_name) grs.strategies in
let rec old_loop instance module_list =
match module_list with
......@@ -266,22 +266,22 @@ module Grs = struct
let loop instance def =
match def with
| Strategy.Sequence module_list -> old_loop instance module_list
| Ast.Sequence module_list -> old_loop instance module_list
| _ -> failwith "Not yet implemented" in
loop (Instance.from_graph graph) (strategy.Strategy.def)
loop (Instance.from_graph graph) (strategy.Ast.strat_def)
(* [new_style grs module_list] return an equivalent strategy expressed with Seq, Diamond and Star *)
let new_style grs module_list =
Strategy.Seq
Ast.Seq
(List.map
(fun module_name ->
let modul =
try List.find (fun m -> m.Modul.name=module_name) grs.modules
with Not_found -> Log.fcritical "No module named '%s'" module_name in
if modul.Modul.confluent
then Strategy.Diamond (Strategy.Star (Strategy.Ref module_name))
else Strategy.Star (Strategy.Ref module_name)
then Ast.Diamond (Ast.Star (Ast.Ref module_name))
else Ast.Star (Ast.Ref module_name)
) module_list
)
......@@ -289,11 +289,11 @@ module Grs = struct
let one_rewrite grs strat inst =
let rec loop inst = function
(* name can refer to another strategy def or to a module *)
| Strategy.Ref name ->
| Ast.Ref name ->
begin
try
let sub_strat = List.find (fun s -> s.Strategy.name = name) grs.strategies in
loop inst sub_strat.Strategy.def
let sub_strat = List.find (fun s -> s.Ast.strat_name = name) grs.strategies in
loop inst sub_strat.Ast.strat_def
with Not_found ->
let modul =
try List.find (fun m -> m.Modul.name=name) grs.modules
......@@ -301,44 +301,44 @@ module Grs = struct
Rule.conf_one_step ?domain: grs.domain name inst modul.Modul.rules
end
(* Union of strategies *)
| Strategy.Plus [] -> None (* the list can be empty in a recursive call! *)
| Strategy.Plus (head::tail) ->
| Ast.Plus [] -> None (* the list can be empty in a recursive call! *)
| Ast.Plus (head::tail) ->
begin
match loop inst head with
| Some new_inst -> Some new_inst
| None -> loop inst (Strategy.Plus tail)
| None -> loop inst (Ast.Plus tail)
end
(* Sequence of strategies *)
| Strategy.Seq [] -> Log.fcritical "Empty sequence in strategy definition"
| Strategy.Seq [one] -> loop inst one
| Strategy.Seq (head::tail) ->
| Ast.Seq [] -> Log.fcritical "Empty sequence in strategy definition"
| Ast.Seq [one] -> loop inst one
| Ast.Seq (head::tail) ->
begin
match loop inst head with
| Some new_inst -> loop new_inst (Strategy.Seq tail)
| Some new_inst -> loop new_inst (Ast.Seq tail)
| None -> None
end
(* Interation of a strategy *)
| Strategy.Star sub_strat ->
| Ast.Star sub_strat ->
begin
match loop inst sub_strat with
| None -> Some inst
| Some new_inst -> loop new_inst (Strategy.Star sub_strat)
| Some new_inst -> loop new_inst (Ast.Star sub_strat)
end
(* Diamond *)
| Strategy.Diamond sub_strat -> loop inst sub_strat
| Ast.Diamond sub_strat -> loop inst sub_strat
(* Old style seq definition *)
| Strategy.Sequence module_list -> loop inst (new_style grs module_list) in
| Ast.Sequence module_list -> loop inst (new_style grs module_list) in
loop inst strat
let simple_rewrite grs strat_desc graph =
let rec loop inst = function
(* name can refer to another strategy def or to a module *)
| Strategy.Ref name ->
| Ast.Ref name ->
begin
try
let sub_strat = List.find (fun s -> s.Strategy.name = name) grs.strategies in
loop inst sub_strat.Strategy.def
let sub_strat = List.find (fun s -> s.Ast.strat_name = name) grs.strategies in
loop inst sub_strat.Ast.strat_def
with Not_found ->
let modul =
try List.find (fun m -> m.Modul.name=name) grs.modules
......@@ -346,32 +346,32 @@ module Grs = struct
Rule.one_step ?domain: grs.domain name inst modul.Modul.rules
end
(* Union of strategies *)
| Strategy.Plus strat_list -> List_.flat_map (loop inst) strat_list
| Ast.Plus strat_list -> List_.flat_map (loop inst) strat_list
(* Sequence of strategies *)
| Strategy.Seq [] -> Log.fcritical "Empty sequence in strategy definition"
| Strategy.Seq [one] -> loop inst one
| Strategy.Seq (head::tail) ->
| Ast.Seq [] -> Log.fcritical "Empty sequence in strategy definition"
| Ast.Seq [one] -> loop inst one
| Ast.Seq (head::tail) ->
let after_first_mod = loop inst head in
List_.flat_map (fun new_inst -> loop new_inst (Strategy.Seq tail)) after_first_mod
List_.flat_map (fun new_inst -> loop new_inst (Ast.Seq tail)) after_first_mod
(* Interation of a strategy *)
| Strategy.Star sub_strat ->
| Ast.Star sub_strat ->
begin
match loop inst sub_strat with
| [] -> [inst]
| l -> List_.flat_map (fun new_inst -> loop new_inst (Strategy.Star sub_strat)) l
| l -> List_.flat_map (fun new_inst -> loop new_inst (Ast.Star sub_strat)) l
end
(* Diamond *)
| Strategy.Diamond sub_strat ->
| Ast.Diamond sub_strat ->
begin
match one_rewrite grs sub_strat inst with
| Some new_inst -> [new_inst]
| None -> []
end
(* Old style seq definition *)
| Strategy.Sequence module_list -> loop inst (new_style grs module_list) in
| Ast.Sequence module_list -> loop inst (new_style grs module_list) in
List.map
(fun inst -> inst.Instance.graph)
(loop (Instance.from_graph graph) (Parser.strategy strat_desc))
(loop (Instance.from_graph graph) (Parser.strat_def strat_desc))
......@@ -404,7 +404,7 @@ module Grs = struct
(* ---------------------------------------------------------------------------------------------------- *)
let build_rew_display grs strategy_name graph =
let strategy = List.find (fun s -> s.Strategy.name = strategy_name) grs.strategies in
let strategy = List.find (fun s -> s.Ast.strat_name = strategy_name) grs.strategies in
let instance = Instance.from_graph graph in
let rec old_loop instance module_list =
......@@ -451,19 +451,19 @@ module Grs = struct
and loop instance strat_def =
printf "%s===> loop strat_def=%s\n%!"
(String.make (2 * (max 0 !indent)) ' ')
(Strategy.to_string strat_def);
(Ast.strat_def_to_string strat_def);
incr indent;
match strat_def with
| Strategy.Sequence module_list -> old_loop instance module_list
| Ast.Sequence module_list -> old_loop instance module_list
(* ========> reference to a module or to another strategy <========= *)
| Strategy.Ref name ->
| Ast.Ref name ->
begin
try
let strategy = List.find (fun s -> s.Strategy.name = name) grs.strategies in
loop instance strategy.Strategy.def
let strategy = List.find (fun s -> s.Ast.strat_name = name) grs.strategies in
loop instance strategy.Ast.strat_def
with Not_found ->
let modul =
try List.find (fun m -> m.Modul.name=name) grs.modules
......@@ -487,17 +487,17 @@ module Grs = struct
end
(* ========> Strat defined as a sequence of sub-strategies <========= *)
| Strategy.Seq [] -> Log.bug "[Grs.build_rew_display] Empty sequence!"; exit 2
| Strategy.Seq [one] -> let res = loop instance one in decr indent; res
| Strategy.Seq (head_strat :: tail_strat) ->
| Ast.Seq [] -> Log.bug "[Grs.build_rew_display] Empty sequence!"; exit 2
| Ast.Seq [one] -> let res = loop instance one in decr indent; res
| Ast.Seq (head_strat :: tail_strat) ->
let one_step = loop instance head_strat in decr indent;
apply_leaf (Strategy.Seq tail_strat) one_step
apply_leaf (Ast.Seq tail_strat) one_step
| Strategy.Diamond strat -> diamond (loop instance strat)
| Ast.Diamond strat -> diamond (loop instance strat)
(* ========> Strat defined as a sequence of sub-strategies <========= *)
| Strategy.Plus [] -> Log.bug "[Grs.build_rew_display] Empty union!"; exit 2
| Strategy.Plus strat_list ->
| Ast.Plus [] -> Log.bug "[Grs.build_rew_display] Empty union!"; exit 2
| Ast.Plus strat_list ->
let rd_list = List.map (fun strat -> loop instance strat) strat_list in
let (opt_lnf, opt_node_info) =
List.fold_left (fun (acc_lnf, acc_node) rd ->
......@@ -524,16 +524,16 @@ module Grs = struct
Libgrew_types.Node (graph,acc_name,(bs, Libgrew_types.Leaf graph) :: acc_bs_rd_list)
end
| Strategy.Star strat ->
| Ast.Star strat ->
begin
match clean (loop instance strat) with
| Libgrew_types.Empty -> Libgrew_types.Leaf instance.Instance.graph
| Libgrew_types.Local_normal_form _ -> Log.bug "dont know if 'Local_normal_form' in star should happen or not ???"; exit 1
| rd -> apply_leaf (Strategy.Star strat) rd
| rd -> apply_leaf (Ast.Star strat) rd
end
in
loop instance (strategy.Strategy.def)
loop instance (strategy.Ast.strat_def)
(* ---------------------------------------------------------------------------------------------------- *)
let rule_iter fct grs =
......
......@@ -324,10 +324,10 @@ module Html_doc = struct
wnl " <center><h1>List of sequences</h1></center>";
List.iter
(fun ast_seq ->
wnl "<h6>%s</h6>" ast_seq.Strategy.name;
List.iter (fun l -> wnl "<p>%s</p>" (doc_to_html l)) ast_seq.Strategy.doc;
wnl "<h6>%s</h6>" ast_seq.Ast.strat_name;
List.iter (fun l -> wnl "<p>%s</p>" (doc_to_html l)) ast_seq.Ast.strat_doc;
wnl "<div class=\"code\">";
wnl "%s" (Strategy.to_string ast_seq.Strategy.def);
wnl "%s" (Ast.strat_def_to_string ast_seq.Ast.strat_def);
wnl "</div>";
) ast.Ast.strategies;
......
......@@ -155,11 +155,11 @@ module Parser = struct
with Sys_error msg -> Error.parse "[Grew_loader.Parser.pattern] %s" msg
(* ------------------------------------------------------------------------------------------*)
let strategy desc =
let strat_def desc =
try
Global.init "Not a file";
let lexbuf = Lexing.from_string desc in
let strategy = parse_handle "Not a file" (Grew_parser.strategy Grew_lexer.global) lexbuf in
let strategy = parse_handle "Not a file" (Grew_parser.strat_def Grew_lexer.global) lexbuf in
strategy
with Sys_error msg -> Error.parse "[Grew_loader.Parser.strategy] %s" msg
......
......@@ -32,5 +32,5 @@ module Parser : sig
val pattern: string -> Ast.pattern
val strategy: string -> Strategy.def
val strat_def: string -> Ast.strat_def
end
\ No newline at end of file
......@@ -118,7 +118,7 @@ let localize t = (t,get_loc ())
%start <Grew_ast.Ast.module_or_include list> included
%start <Grew_ast.Ast.pattern> pattern
%start <Grew_ast.Ast.domain> domain
%start <Grew_types.Strategy.def> strategy
%start <Grew_ast.Ast.strat_def> strat_def
/* parsing of the string representation of the constituent representation of Sequoia */
/* EX: "( (SENT (NP (NC Amélioration) (PP (P de) (NP (DET la) (NC sécurité))))))" */
......@@ -692,34 +692,34 @@ sequences:
sequence:
/* seq_name { ant; p7_to_p7p-mc} */
| doc = option(COMMENT) id_loc=simple_id_with_loc mod_names=delimited(LACC,separated_list_final_opt(SEMIC,simple_id),RACC)
{ let (name,loc) = id_loc in
{ let (strat_name,strat_loc) = id_loc in
{
Strategy.name;
def = Strategy.Sequence mod_names;
doc = begin match doc with Some d -> d | None -> [] end;
loc;
Ast.strat_name;
strat_def = Ast.Sequence mod_names;
strat_doc = begin match doc with Some d -> d | None -> [] end;
strat_loc;
}
}
/* strat = <>(M1+M2)* */
| doc = option(COMMENT) id_loc=simple_id_with_loc EQUAL def=strat_def
{ let (name,loc) = id_loc in
| doc = option(COMMENT) id_loc=simple_id_with_loc EQUAL strat_def=strat_def_rec
{ let (strat_name,strat_loc) = id_loc in
{
Strategy.name;
def;
doc = begin match doc with Some d -> d | None -> [] end;
loc;
Ast.strat_name;
strat_def;
strat_doc = begin match doc with Some d -> d | None -> [] end;
strat_loc;
}
}
strat_def:
| m=simple_id { Strategy.Ref m }
| LPAREN s=strat_def RPAREN { s }
| s=strat_def STAR { Strategy.Star (s) }
| s1=strat_def PLUS s2=strat_def { Strategy.Plus [s1; s2] }
| s1=strat_def SEMIC s2=strat_def { Strategy.Seq [s1; s2] }
| DISEQUAL s=strat_def { Strategy.Diamond s }
strat_def_rec:
| m=simple_id { Ast.Ref m }
| LPAREN s=strat_def_rec RPAREN { s }
| s=strat_def_rec STAR { Ast.Star (s) }
| s1=strat_def_rec PLUS s2=strat_def_rec { Ast.Plus [s1; s2] }
| s1=strat_def_rec SEMIC s2=strat_def_rec { Ast.Seq [s1; s2] }
| DISEQUAL s=strat_def_rec { Ast.Diamond s }
strategy: s = strat_def EOF { s }
strat_def: s = strat_def_rec EOF { s }
/*=============================================================================================*/
/* ISOLATED PATTERN (grep mode) */
......
......@@ -443,49 +443,3 @@ module Concat_item = struct
| String of string
end (* module Concat_item *)
(* ================================================================================ *)
module Strategy = struct
type def =
| Ref of string
| Seq of def list (* /!\ The list must not be empty *)
| Plus of def list (* /!\ The list must not be empty *)
| Star of def
| Diamond of def
| Sequence of string list (* compatibility mode with old code *)
type t = {
name:string;
def:def;
doc:string list;
loc:Loc.t;
}
let rec to_string = function
| Ref m -> m
| Seq l -> "[" ^ (String.concat "; " (List.map to_string l)) ^ "]"
| Plus l -> "[" ^ (String.concat "+" (List.map to_string l)) ^ "]"
| Star s -> "[" ^ (to_string s) ^"]" ^ "*"
| Diamond s -> "◇" ^ "[" ^(to_string s)^"]"
| Sequence names -> "{" ^ (String.concat ";" names) ^ "}"
(* invariant: Seq list and Plus list are not empty in the input and so not empty in the output *)
let rec flatten = function
| Sequence l -> Sequence l
| Ref m -> Ref m
| Star s -> Star (flatten s)
| Diamond s -> Diamond (flatten s)
| Seq l ->
let fl = List.map flatten l in
let rec loop = function
| [] -> []
| (Seq l) :: tail -> l @ (loop tail)
| x :: tail -> x :: (loop tail)
in Seq (loop fl)
| Plus l ->
let fl = List.map flatten l in
let rec loop = function
| [] -> []
| (Plus l) :: tail -> l @ (loop tail)
| x :: tail -> x :: (loop tail)
in Plus (loop fl)
end (* module Strategy *)
......@@ -177,33 +177,3 @@ module Concat_item : sig
| String of string
end (* module Concat_item *)
(* ================================================================================ *)
module Strategy : sig
(* recursive definition of strategies *)
type def =
| Ref of string (* reference to a module name or to another strategy *)
| Seq of def list (* a sequence of strategies to apply one after the other *)
| Plus of def list (* a set of strategies to apply in parallel *)
| Star of def (* a strategy to apply iteratively *)
| Diamond of def (* pick one normal form a the given strategy *)
(* /!\ The list must not be empty in the Seq or Plus constructor *)
| Sequence of string list (* compatibility mode with old code *)
(* string dump of a strat *)
val to_string : def -> string
(* build an equivalent strategies where embedded Seq in Seq (resp Plus in Plus) are flattened *)
val flatten : def -> def
(* a strategy is given by its descrition in the grs file and the 4 fields: *)
type t = {
name:string; (* a unique name of the stratgy *)
def:def; (* the definition itself *)
doc:string list; (* lines of docs (if any in the GRS file) *)
loc:Loc.t; (* the location of the [name] of the strategy *)
}
end (* module Strategy *)
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