Commit 1d0c92fc authored by bguillaum's avatar bguillaum

remove activate/suffixes

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8961 7838e531-6607-4d57-9587-6c381814729c
parent 613ef276
......@@ -6,7 +6,7 @@
(require 'generic-x) ;;pour Emacs OK, mais semble ne pas marcher avec XEmacs
(define-generic-mode 'grew-mode
'("%");;comments
'("features" "module" "rule" "lex_rule" "match" "without" "labels" "sequences" "commands" "graph" "confluent" "include" "filter" "suffixes");;keywords
'("features" "module" "rule" "match" "without" "labels" "sequences" "commands" "graph" "confluent" "include" "filter");;keywords
'(
;; ("class\\s (\*\*)* +\\(\\sw[a-zA-Z0-9_.-]*\\)" 1 'font-lock-type-face);noms de classes
;; ("\?[a-zA-Z0-9]+" . font-lock-variable-name-face)
......
......@@ -75,42 +75,6 @@ module Ast = struct
| [Str.Text base; Str.Delim "."; Str.Text fn] -> (base, Some fn)
| _ -> Error.build "The identifier '%s' must be a feature identifier (with at most one '.' symbol, like \"V\" or \"V.cat\" for instance)" s
(* ---------------------------------------------------------------------- *)
(* command_node_id: V, V#alpha *)
type command_node_ident =
| No_sharp of Id.name
| Sharp of Id.name * string
let parse_command_node_ident s =
check_special "feature ident" ["#"] s;
match Str.full_split (Str.regexp "#") s with
| [Str.Text base; Str.Delim "#"; Str.Text ext] -> Sharp (base, ext)
| [Str.Text base] -> No_sharp base
| _ -> Error.build "The identifier '%s' must be a command node identifier (with at most one '#' symbol)" s
let dump_command_node_ident = function
| No_sharp x -> x
| Sharp (x,y) -> x ^ "#" ^ y
let base_command_node_ident = function
| No_sharp x -> x
| Sharp (x,y) -> x
(* ---------------------------------------------------------------------- *)
(* command_feature_ident: V.cat, V#alpha.cat *)
type command_feature_ident = command_node_ident * feature_name
let parse_command_feature_ident s =
check_special "feature ident" ["."; "#"] s;
match Str.full_split (Str.regexp "#\\|\\.") s with
| [Str.Text base; Str.Delim "#"; Str.Text ext; Str.Delim "."; Str.Text feature_name] -> (Sharp (base, ext), feature_name)
| [Str.Text base; Str.Delim "."; Str.Text feature_name] -> (No_sharp base, feature_name)
| _ -> Error.build "The identifier '%s' must be a command feature identifier (with exactly one '.' symbol and at most one '#' symbol in the left part)" s
let dump_command_feature_ident = function
| (No_sharp base, feature_name) -> sprintf "%s.%s" base feature_name
| (Sharp (base,ext), feature_name) -> sprintf "%s#%s.%s" base ext feature_name
(* ---------------------------------------------------------------------- *)
type feature_kind =
......@@ -225,22 +189,21 @@ module Ast = struct
| Param_item of string
type u_command =
| Del_edge_expl of (command_node_ident * command_node_ident * edge_label)
| Del_edge_expl of (Id.name * Id.name * edge_label)
| Del_edge_name of string
| Add_edge of (command_node_ident * command_node_ident * edge_label)
| Add_edge of (Id.name * Id.name * edge_label)
(* 4 args: source, target, labels, flag true iff negative cst *)
| Shift_in of (command_node_ident * command_node_ident * edge_label_cst)
| Shift_out of (command_node_ident * command_node_ident * edge_label_cst)
| Shift_edge of (command_node_ident * command_node_ident * edge_label_cst)
| Shift_in of (Id.name * Id.name * edge_label_cst)
| Shift_out of (Id.name * Id.name * edge_label_cst)
| Shift_edge of (Id.name * Id.name * edge_label_cst)
| Merge_node of (command_node_ident * command_node_ident)
| New_neighbour of (Id.name * command_node_ident * edge_label)
| Del_node of command_node_ident
| Activate of command_node_ident
| Merge_node of (Id.name * Id.name)
| New_neighbour of (Id.name * Id.name * edge_label)
| Del_node of Id.name
| Del_feat of command_feature_ident
| Update_feat of command_feature_ident * concat_item list
| Del_feat of feature_ident
| Update_feat of feature_ident * concat_item list
type command = u_command * Loc.t
(* the [rule] type is used for 3 kinds of module items:
......@@ -261,7 +224,6 @@ module Ast = struct
type modul = {
module_id:Id.name;
local_labels: (string * string list) list;
suffixes: string list;
rules: rule list;
confluent: bool;
module_doc:string list;
......
......@@ -44,22 +44,6 @@ module Ast : sig
type simple_or_feature_ident = Id.name * feature_name option
val parse_simple_or_feature_ident: string -> simple_or_feature_ident
(* ---------------------------------------------------------------------- *)
(* command_node_ident: V, V#alpha, V.cat, V#alpha.cat, p_obj.loc *)
type command_node_ident =
| No_sharp of string
| Sharp of string * string
val parse_command_node_ident: string -> command_node_ident
val dump_command_node_ident: command_node_ident -> string
val base_command_node_ident: command_node_ident -> string
(* ---------------------------------------------------------------------- *)
(* command_feature_ident: V.cat, V#alpha.cat *)
type command_feature_ident = command_node_ident * feature_name
val parse_command_feature_ident: string -> command_feature_ident
val dump_command_feature_ident: command_feature_ident -> string
(* ---------------------------------------------------------------------- *)
type feature_kind =
| Equality of feature_value list
......@@ -128,22 +112,21 @@ module Ast : sig
| Param_item of string
type u_command =
| Del_edge_expl of (command_node_ident * command_node_ident * edge_label)
| Del_edge_expl of (Id.name * Id.name * edge_label)
| Del_edge_name of string
| Add_edge of (command_node_ident * command_node_ident * edge_label)
| Add_edge of (Id.name * Id.name * edge_label)
(* 4 args: source, target, labels, flag true iff negative cst *)
| Shift_in of (command_node_ident * command_node_ident * edge_label_cst)
| Shift_out of (command_node_ident * command_node_ident * edge_label_cst)
| Shift_edge of (command_node_ident * command_node_ident * edge_label_cst)
| Shift_in of (Id.name * Id.name * edge_label_cst)
| Shift_out of (Id.name * Id.name * edge_label_cst)
| Shift_edge of (Id.name * Id.name * edge_label_cst)
| Merge_node of (command_node_ident * command_node_ident)
| New_neighbour of (Id.name * command_node_ident * edge_label)
| Del_node of command_node_ident
| Activate of command_node_ident
| Merge_node of (Id.name * Id.name)
| New_neighbour of (Id.name * Id.name * edge_label)
| Del_node of Id.name
| Del_feat of command_feature_ident
| Update_feat of command_feature_ident * concat_item list
| Del_feat of feature_ident
| Update_feat of feature_ident * concat_item list
type command = u_command * Loc.t
type rule = {
......@@ -159,7 +142,6 @@ module Ast : sig
type modul = {
module_id:Id.name;
local_labels: (string * string list) list;
suffixes: string list;
rules: rule list;
confluent: bool;
module_doc:string list;
......
......@@ -23,7 +23,6 @@ module Command = struct
type command_node = (* a command node is either: *)
| Pat of Pid.t (* a node identified in the pattern *)
| New of string (* a node introduced by a new_neighbour *) (* TODO: remove *)
| Act of Pid.t * string (* a node introduced by an activate *)
(* [item] is a element of the RHS of an update_feat command *)
type item =
......@@ -45,8 +44,6 @@ module Command = struct
| SHIFT_IN of (command_node * command_node * Label_cst.t)
| SHIFT_OUT of (command_node * command_node * Label_cst.t)
| MERGE_NODE of (command_node * command_node)
| ACT_NODE of command_node
type t = p * Loc.t (* remember command location to be able to localize a command failure *)
......@@ -63,27 +60,19 @@ module Command = struct
| H_SHIFT_IN of (Gid.t * Gid.t)
| H_SHIFT_OUT of (Gid.t * Gid.t)
| H_MERGE_NODE of (Gid.t * Gid.t)
| H_ACT_NODE of (Gid.t * string)
let build domain label_domain ?param (kai, kei) table locals suffixes ast_command =
let build domain label_domain ?param (kai, kei) table locals ast_command =
(* kai stands for "known act ident", kei for "known edge ident" *)
let pid_of_act_id loc = function
| Ast.Sharp (node_name, n) -> Act (Pid.Pos (Id.build ~loc node_name table), n)
| Ast.No_sharp (node_name) ->
let pid_of_act_id loc node_name =
try (* TODO: remove with activate *)
Pat (Pid.Pos (Id.build ~loc node_name table))
with _ -> New node_name in
let pid_of_node_id loc node_id = Pat (Pid.Pos (Id.build ~loc node_id table)) in
(* check that an act_id is well-defined earlier *)
let check_act_id loc act_id kai =
if not (List.mem act_id kai)
then Error.build ~loc "Unbound node identifier \"%s\"" (Ast.dump_command_node_ident act_id) in
let check_node_id loc node_id kai =
if not (List.mem (Ast.No_sharp node_id) kai)
if not (List.mem node_id kai)
then Error.build ~loc "Unbound node identifier \"%s\"" node_id in
(* check that the edge_id is defined in the pattern *)
......@@ -93,8 +82,8 @@ module Command = struct
match ast_command with
| (Ast.Del_edge_expl (act_i, act_j, lab), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
check_node_id loc act_i kai;
check_node_id loc act_j kai;
let edge = G_edge.make ~loc label_domain ~locals lab in
((DEL_EDGE_EXPL (pid_of_act_id loc act_i, pid_of_act_id loc act_j, edge), loc), (kai, kei))
......@@ -103,34 +92,34 @@ module Command = struct
(DEL_EDGE_NAME id, loc), (kai, List_.rm id kei)
| (Ast.Add_edge (act_i, act_j, lab), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
check_node_id loc act_i kai;
check_node_id loc act_j kai;
let edge = G_edge.make ~loc label_domain ~locals lab in
((ADD_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, edge), loc), (kai, kei))
| (Ast.Shift_edge (act_i, act_j, label_cst), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
check_node_id loc act_i kai;
check_node_id loc act_j kai;
((SHIFT_EDGE (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build ~loc label_domain ~locals label_cst), loc), (kai, kei))
| (Ast.Shift_in (act_i, act_j, label_cst), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
check_node_id loc act_i kai;
check_node_id loc act_j kai;
((SHIFT_IN (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build label_domain ~loc ~locals label_cst), loc), (kai, kei))
| (Ast.Shift_out (act_i, act_j, label_cst), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
check_node_id loc act_i kai;
check_node_id loc act_j kai;
((SHIFT_OUT (pid_of_act_id loc act_i, pid_of_act_id loc act_j, Label_cst.build label_domain ~loc ~locals label_cst), loc), (kai, kei))
| (Ast.Merge_node (act_i, act_j), loc) ->
check_act_id loc act_i kai;
check_act_id loc act_j kai;
check_node_id loc act_i kai;
check_node_id loc act_j kai;
((MERGE_NODE (pid_of_act_id loc act_i, pid_of_act_id loc act_j), loc), (List_.rm act_i kai, kei))
| (Ast.New_neighbour (new_id, ancestor, label), loc) ->
check_act_id loc ancestor kai;
if List.mem (Ast.No_sharp new_id) kai
check_node_id loc ancestor kai;
if List.mem new_id kai
then Error.build ~loc "Node identifier \"%s\" is already used" new_id;
let edge = G_edge.make ~loc label_domain ~locals label in
......@@ -140,40 +129,30 @@ module Command = struct
(NEW_NEIGHBOUR
(new_id,
edge,
Pid.Pos (Id.build ~loc (Ast.base_command_node_ident ancestor) table)
Pid.Pos (Id.build ~loc ancestor table)
), loc),
((Ast.No_sharp new_id)::kai, kei)
(new_id::kai, kei)
)
with not_found ->
Log.fcritical "[GRS] tries to build a command New_neighbour (%s) on node %s which is not in the pattern %s"
(G_edge.to_string label_domain edge)
(Ast.base_command_node_ident ancestor)
ancestor
(Loc.to_string loc)
end
| (Ast.Activate act_n, loc) ->
begin
match act_n with
| Ast.No_sharp _ -> Error.build ~loc "Cannot activate a pattern node"
| Ast.Sharp (src, suffix) ->
check_act_id loc (Ast.No_sharp src) kai;
if not (List.mem suffix suffixes) then Error.build ~loc "Undefined suffix \"%s\"" suffix;
((ACT_NODE (pid_of_act_id loc act_n), loc), (act_n :: kai, kei))
end
| (Ast.Del_node act_n, loc) ->
check_act_id loc act_n kai;
check_node_id loc act_n kai;
((DEL_NODE (pid_of_act_id loc act_n), loc), (List_.rm act_n kai, kei))
| (Ast.Del_feat (act_id, feat_name), loc) ->
if feat_name = "position"
then Error.build ~loc "Illegal del_feat command: the 'position' feature cannot be deleted";
check_act_id loc act_id kai;
check_node_id loc act_id kai;
Domain.check_feature_name ~loc domain feat_name;
((DEL_FEAT (pid_of_act_id loc act_id, feat_name), loc), (kai, kei))
| (Ast.Update_feat ((act_id, feat_name), ast_items), loc) ->
check_act_id loc act_id kai;
check_node_id loc act_id kai;
let items = List.map
(function
| Ast.Qfn_item (node_id,feature_name) ->
......
......@@ -19,7 +19,6 @@ module Command : sig
type command_node = (* a command node is either: *)
| Pat of Pid.t (* a node identified in the pattern *)
| New of string (* a node introduced by a new_neighbour *)
| Act of Pid.t * string (* a node introduced by a activate *)
type item =
| Feat of (command_node * string)
......@@ -39,8 +38,6 @@ module Command : sig
| SHIFT_IN of (command_node * command_node * Label_cst.t)
| SHIFT_OUT of (command_node * command_node * Label_cst.t)
| MERGE_NODE of (command_node * command_node)
| ACT_NODE of command_node
type t = (p * Loc.t)
type h =
......@@ -55,16 +52,14 @@ module Command : sig
| H_SHIFT_IN of (Gid.t * Gid.t)
| H_SHIFT_OUT of (Gid.t * Gid.t)
| H_MERGE_NODE of (Gid.t * Gid.t)
| H_ACT_NODE of (Gid.t * string)
val build:
Domain.t ->
Domain.t ->
?param: (string list * string list) ->
(Ast.command_node_ident list * string list) ->
(Id.name list * string list) ->
Id.table ->
Label_domain.decl array ->
suffix list ->
Ast.command ->
t * (Ast.command_node_ident list * string list)
t * (Id.name list * string list)
end (* module Command *)
......@@ -236,7 +236,6 @@ module G_graph = struct
match key with
| Gid.Old n -> (n, mapping)
| Gid.New _ -> (max_binding, mapping)
| Gid.Act (n,suffix) -> (max_binding+1, (key, (Gid.Old (max_binding+1)))::mapping)
) t.map (0, []) in
rename mapping t
......@@ -489,19 +488,6 @@ module G_graph = struct
) graph.map Gid_map.empty
}
(* -------------------------------------------------------------------------------- *)
let activate loc node_id suffix graph =
let index = match node_id with
| Gid.Old id -> Gid.Act (id, suffix)
| _ -> Error.run ~loc "[Graph.activate] is possible only from a \"ground\" node" in
if Gid_map.mem index graph.map
then Error.run ~loc "[Graph.activate] try to activate twice the \"same\" node (with suffix '%s')" suffix;
let node = Gid_map.find node_id graph.map in
let new_map = Gid_map.add index (G_node.build_new node) graph.map in
(index, {graph with map = new_map})
(* -------------------------------------------------------------------------------- *)
let add_neighbour loc domain graph node_id label =
let index = match node_id with
......@@ -510,7 +496,7 @@ module G_graph = struct
| Some label_int -> Gid.New (id, label_int)
| None -> Error.run ~loc "[Graph.add_neighbour] try to add neighbour with a local label"
)
| Gid.New _ | Gid.Act _ -> Error.run ~loc "[Graph.add_neighbour] try to add neighbour node to a neighbour node" in
| Gid.New _ -> Error.run ~loc "[Graph.add_neighbour] try to add neighbour node to a neighbour node" in
if Gid_map.mem index graph.map
then Error.run ~loc "[Graph.add_neighbour] try to build twice the \"same\" neighbour node (with label '%s')" (Label.to_string domain label);
......
......@@ -136,7 +136,6 @@ module G_graph: sig
val del_node: t -> Gid.t -> t
val add_neighbour: Loc.t -> Domain.t -> t -> Gid.t -> G_edge.t -> (Gid.t * t)
val activate: Loc.t -> Gid.t -> string -> t -> (Gid.t * t)
val merge_node: Loc.t -> Domain.t -> t -> Gid.t -> Gid.t -> t option
......
......@@ -147,7 +147,6 @@ module Modul = struct
type t = {
name: string;
local_labels: (string * string list) array;
suffixes: string list;
rules: Rule.t list;
filters: Rule.t list;
confluent: bool;
......@@ -166,14 +165,12 @@ module Modul = struct
let build domain ast_module =
let locals = Array.of_list ast_module.Ast.local_labels in
Array.sort compare locals;
let suffixes = ast_module.Ast.suffixes in
let rules_or_filters = List.map (Rule.build domain ~locals suffixes ast_module.Ast.mod_dir) ast_module.Ast.rules in
let rules_or_filters = List.map (Rule.build domain ~locals ast_module.Ast.mod_dir) ast_module.Ast.rules in
let (filters, rules) = List.partition Rule.is_filter rules_or_filters in
let modul =
{
name = ast_module.Ast.module_id;
local_labels = locals;
suffixes;
rules;
filters;
confluent = ast_module.Ast.confluent;
......
......@@ -68,7 +68,6 @@ module Modul: sig
type t = {
name: string;
local_labels: (string * string list) array;
suffixes: string list;
rules: Rule.t list;
filters: Rule.t list;
confluent: bool;
......
......@@ -51,40 +51,39 @@ module Html_doc = struct
if li_html then bprintf buff "<li>";
(match u_command with
| Ast.Del_edge_expl (n1,n2,label) ->
bprintf buff "del_edge %s -[%s]-> %s" (Ast.dump_command_node_ident n1) label (Ast.dump_command_node_ident n2)
bprintf buff "del_edge %s -[%s]-> %s" n1 label n2
| Ast.Del_edge_name name -> bprintf buff "del_edge %s" name
| Ast.Add_edge (n1,n2,label) ->
bprintf buff "add_edge %s -[%s]-> %s" (Ast.dump_command_node_ident n1) label (Ast.dump_command_node_ident n2)
bprintf buff "add_edge %s -[%s]-> %s" n1 label n2
| Ast.Shift_in (n1,n2,([],true)) ->
bprintf buff "shift_in %s ==> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2)
bprintf buff "shift_in %s ==> %s" n1 n2
| Ast.Shift_in (n1,n2,(labels,false)) ->
bprintf buff "shift_in %s =[%s]=> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2) (List_.to_string (fun x->x) "|" labels)
bprintf buff "shift_in %s =[%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
| Ast.Shift_in (n1,n2,(labels,true)) ->
bprintf buff "shift_in %s =[^%s]=> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2) (List_.to_string (fun x->x) "|" labels)
bprintf buff "shift_in %s =[^%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
| Ast.Shift_out (n1,n2,([],true)) ->
bprintf buff "shift_out %s ==> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2)
bprintf buff "shift_out %s ==> %s" n1 n2
| Ast.Shift_out (n1,n2,(labels,false)) ->
bprintf buff "shift_out %s =[%s]=> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2) (List_.to_string (fun x->x) "|" labels)
bprintf buff "shift_out %s =[%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
| Ast.Shift_out (n1,n2,(labels,true)) ->
bprintf buff "shift_out %s =[^%s]=> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2) (List_.to_string (fun x->x) "|" labels)
bprintf buff "shift_out %s =[^%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
| Ast.Shift_edge (n1,n2,([],true)) ->
bprintf buff "shift %s ==> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2)
bprintf buff "shift %s ==> %s" n1 n2
| Ast.Shift_edge (n1,n2,(labels,false)) ->
bprintf buff "shift %s =[%s]=> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2) (List_.to_string (fun x->x) "|" labels)
bprintf buff "shift %s =[%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
| Ast.Shift_edge (n1,n2,(labels,true)) ->
bprintf buff "shift %s =[^%s]=> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2) (List_.to_string (fun x->x) "|" labels)
bprintf buff "shift %s =[^%s]=> %s" n1 n2 (List_.to_string (fun x->x) "|" labels)
| Ast.Merge_node (n1,n2) -> bprintf buff "merge %s ==> %s" (Ast.dump_command_node_ident n1) (Ast.dump_command_node_ident n2)
| Ast.New_neighbour (n1,n2,label) -> bprintf buff "add_node %s: <-[%s]- %s" n1 label (Ast.dump_command_node_ident n2)
| Ast.Activate act_id -> bprintf buff "activate %s" (Ast.dump_command_node_ident act_id)
| Ast.Del_node act_id -> bprintf buff "del_node %s" (Ast.dump_command_node_ident act_id)
| Ast.Merge_node (n1,n2) -> bprintf buff "merge %s ==> %s" n1 n2
| Ast.New_neighbour (n1,n2,label) -> bprintf buff "add_node %s: <-[%s]- %s" n1 label n2
| Ast.Del_node act_id -> bprintf buff "del_node %s" act_id
| Ast.Update_feat ((act_id, feat_name),item_list) ->
bprintf buff "%s.%s = %s" (Ast.dump_command_node_ident act_id) feat_name (List_.to_string string_of_concat_item " + " item_list)
bprintf buff "%s.%s = %s" act_id feat_name (List_.to_string string_of_concat_item " + " item_list)
| Ast.Del_feat (act_id, feat_name) ->
bprintf buff "del_feat %s.%s" (Ast.dump_command_node_ident act_id) feat_name
bprintf buff "del_feat %s.%s" act_id feat_name
);
if li_html then bprintf buff "</li>\n" else bprintf buff ";\n"
......
......@@ -19,14 +19,6 @@
let escaped = ref false
(* a general notion of "ident" is needed to cover all usages:
with or without '#', with several '.' (separator for feature names and usual symbol for labels...) *)
let parse_complex_ident string =
match Str.split (Str.regexp "#") string with
| [x] -> Ast.No_sharp x
| [x;y] -> Ast.Sharp (x,y)
| _ -> Error.build "\"%s\" is not a valid ident (more than one '#')" string
let split_comment com =
let raw = Str.split (Str.regexp "\n") com in
List.filter (fun l -> not (Str.string_match (Str.regexp "[ \t]*$") l 0)) raw
......@@ -45,16 +37,15 @@ let letter = ['a'-'z' 'A'-'Z']
for basic ident construction and
- dot '.'
- colon ':'
- sharp '#'
- star '*'
The first characted cannot be a digit, a sharp or a colon (to avoid confusion).
The first characted cannot be a digit, or a colon (to avoid confusion).
*)
let label_ident =
(letter | '_' | '-' | '.' | '*') (letter | digit | '_' | '\'' | '-' | '.' | ':' | '*')*
let general_ident =
(letter | '_' ) |
(letter | '_' | '.' ) (letter | digit | '_' | '\'' | '-' | '.' | '#')* (letter | digit | '_' | '\'' | '.')
(letter | '_' | '.' ) (letter | digit | '_' | '\'' | '-' | '.')* (letter | digit | '_' | '\'' | '.')
let hex = ['0'-'9' 'a'-'f' 'A'-'F']
let color = hex hex hex hex hex hex | hex hex hex
......@@ -165,7 +156,6 @@ and standard target = parse
| "feature" { FEATURE }
| "file" { FILE }
| "labels" { Global.label_flag := true; LABELS }
| "suffixes" { SUFFIXES }
| "match" { MATCH }
| "without" { WITHOUT }
| "commands" { COMMANDS }
......@@ -179,7 +169,6 @@ and standard target = parse
| "del_node" { DEL_NODE }
| "add_node" { ADD_NODE }
| "del_feat" { DEL_FEAT }
| "activate" { ACTIVATE }
| "module" { MODULE }
| "confluent" { CONFLUENT }
......
......@@ -75,8 +75,6 @@ let localize t = (t,get_loc ())
%token FEATURE /* feature */
%token FILE /* file */
%token LABELS /* labels */
%token SUFFIXES /* suffixes */
%token ACTIVATE /* activate */
%token MATCH /* match */
%token WITHOUT /* without */
%token COMMANDS /* commands */
......@@ -151,21 +149,12 @@ simple_id:
simple_id_with_loc:
| id=ID { localize (Ast.parse_simple_ident id) }
command_node_ident :
| id=ID { Ast.parse_command_node_ident id }
command_node_ident_with_loc :
| id=ID { localize (Ast.parse_command_node_ident id) }
feature_ident :
| id=ID { Ast.parse_feature_ident id }
feature_ident_with_loc :
| id=ID { localize (Ast.parse_feature_ident id) }
command_feature_ident_with_loc :
| id=ID { localize (Ast.parse_command_feature_ident id) }
feature_value:
| v=ID { v }
| v=STRING { v }
......@@ -299,11 +288,10 @@ included:
| x=list(module_or_include) EOF { x }
grew_module:
| doc=option(COMMENT) MODULE conf=boption(CONFLUENT) id_loc=simple_id_with_loc LACC l=option(labels) suff=option(suffixes) r=rules RACC
| doc=option(COMMENT) MODULE conf=boption(CONFLUENT) id_loc=simple_id_with_loc LACC l=option(labels) r=rules RACC
{
{ Ast.module_id = fst id_loc;
local_labels = (match l with None -> [] | Some x -> x);
suffixes = (match suff with None -> [] | Some x -> x);
rules = r;
confluent = conf;
module_doc = (match doc with Some d -> d | None -> []);
......@@ -312,12 +300,6 @@ grew_module:
}
}
suffixes:
(* "suffixes {a, b, c}" *)
| SUFFIXES x=delimited(LACC,separated_nonempty_list_final_opt(COMA,simple_id),RACC)
{ x }
/*=============================================================================================*/
/* RULES DEFINITION */
/*=============================================================================================*/
......@@ -555,85 +537,79 @@ command:
{ let (n,loc) = n_loc in (Ast.Del_edge_name n, loc) }
(* del_edge m -[x]-> n *)
| DEL_EDGE src_loc=command_node_ident_with_loc label=delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) tar=command_node_ident
| DEL_EDGE src_loc=simple_id_with_loc label=delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) tar=simple_id
{ let (src,loc) = src_loc in (Ast.Del_edge_expl (src, tar, label), loc) }
(* add_edge m -[x]-> n *)
| ADD_EDGE src_loc=command_node_ident_with_loc label=delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) tar=command_node_ident
| ADD_EDGE src_loc=simple_id_with_loc label=delimited(LTR_EDGE_LEFT,label_ident,LTR_EDGE_RIGHT) tar=simple_id
{ let (src,loc) = src_loc in (Ast.Add_edge (src, tar, label), loc) }
(* "shift_in m ==> n" *)
| SHIFT_IN src_loc=command_node_ident_with_loc ARROW tar=command_node_ident
| SHIFT_IN src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_in (src, tar, ([], true)), loc) }
(* "shift_in m =[x*|y]=> n" *)
| SHIFT_IN src_loc=command_node_ident_with_loc
| SHIFT_IN src_loc=simple_id_with_loc
labels=delimited(ARROW_LEFT,separated_nonempty_list(PIPE,pattern_label_ident),ARROW_RIGHT)
tar=command_node_ident
tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_in (src, tar, (labels, false)), loc) }
(* "shift_in m =[^x*|y]=> n" *)
| SHIFT_IN src_loc=command_node_ident_with_loc
| SHIFT_IN src_loc=simple_id_with_loc
labels=delimited(ARROW_LEFT_NEG,separated_nonempty_list(PIPE,pattern_label_ident),ARROW_RIGHT)
tar=command_node_ident
tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_in (src, tar, (labels, true)), loc) }
(* "shift_out m ==> n" *)
| SHIFT_OUT src_loc=command_node_ident_with_loc ARROW tar=command_node_ident
| SHIFT_OUT src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_out (src, tar, ([], true)), loc) }
(* "shift_out m =[x*|y]=> n" *)
| SHIFT_OUT src_loc=command_node_ident_with_loc
| SHIFT_OUT src_loc=simple_id_with_loc
labels=delimited(ARROW_LEFT,separated_nonempty_list(PIPE,pattern_label_ident),ARROW_RIGHT)
tar=command_node_ident
tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_out (src, tar, (labels, false)), loc) }
(* "shift_out m =[^x*|y]=> n" *)
| SHIFT_OUT src_loc=command_node_ident_with_loc
| SHIFT_OUT src_loc=simple_id_with_loc
labels=delimited(ARROW_LEFT_NEG,separated_nonempty_list(PIPE,pattern_label_ident),ARROW_RIGHT)
tar=command_node_ident
tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_out (src, tar, (labels, true)), loc) }
(* "shift m ==> n" *)
| SHIFT src_loc=command_node_ident_with_loc ARROW tar=command_node_ident
| SHIFT src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_edge (src, tar, ([], true)), loc) }
(* "shift m =[x*|y]=> n" *)
| SHIFT src_loc=command_node_ident_with_loc
| SHIFT src_loc=simple_id_with_loc
labels=delimited(ARROW_LEFT,separated_nonempty_list(PIPE,pattern_label_ident),ARROW_RIGHT)
tar=command_node_ident
tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_edge (src, tar, (labels, false)), loc) }
(* "shift m =[^x*|y]=> n" *)
| SHIFT src_loc=command_node_ident_with_loc
| SHIFT src_loc=simple_id_with_loc
labels=delimited(ARROW_LEFT_NEG,separated_nonempty_list(PIPE,pattern_label_ident),ARROW_RIGHT)
tar=command_node_ident
tar=simple_id
{ let (src,loc) = src_loc in (Ast.Shift_edge (src, tar, (labels, true)), loc) }
(* merge m ==> n *)
| MERGE src_loc=command_node_ident_with_loc ARROW tar=command_node_ident
| MERGE src_loc=simple_id_with_loc ARROW tar=simple_id
{ let (src,loc) = src_loc in (Ast.Merge_node (src, tar), loc) }
(* del_node n *)
| DEL_NODE ci_loc=command_node_ident_with_loc
| DEL_NODE ci_loc=simple_id_with_loc
{ let (ci,loc) = ci_loc in (Ast.Del_node (ci), loc) }
(* add_node n: <-[x]- m *)
| ADD_NODE new_ci_loc=simple_id_with_loc DDOT label=delimited(RTL_EDGE_LEFT,label_ident,RTL_EDGE_RIGHT) anc_ci=command_node_ident
| ADD_NODE new_ci_loc=simple_id_with_loc DDOT label=delimited(RTL_EDGE_LEFT,label_ident,RTL_EDGE_RIGHT) anc_ci=simple_id
{ let (new_ci,loc) = new_ci_loc in (Ast.New_neighbour (new_ci, anc_ci,label), loc) }
(* activate n#a *)
| ACTIVATE ci_loc= command_node_ident_with_loc
{ let (ci,loc) = ci_loc in (Ast.Activate ci, loc) }
(* del_feat m.cat *)
| DEL_FEAT com_fead_id_loc= command_feature_ident_with_loc
| DEL_FEAT com_fead_id_loc= feature_ident_with_loc
{ let (com_fead_id,loc) = com_fead_id_loc in (Ast.Del_feat com_fead_id, loc) }