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 @@ ...@@ -6,7 +6,7 @@
(require 'generic-x) ;;pour Emacs OK, mais semble ne pas marcher avec XEmacs (require 'generic-x) ;;pour Emacs OK, mais semble ne pas marcher avec XEmacs
(define-generic-mode 'grew-mode (define-generic-mode 'grew-mode
'("%");;comments '("%");;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 ;; ("class\\s (\*\*)* +\\(\\sw[a-zA-Z0-9_.-]*\\)" 1 'font-lock-type-face);noms de classes
;; ("\?[a-zA-Z0-9]+" . font-lock-variable-name-face) ;; ("\?[a-zA-Z0-9]+" . font-lock-variable-name-face)
......
...@@ -75,42 +75,6 @@ module Ast = struct ...@@ -75,42 +75,6 @@ module Ast = struct
| [Str.Text base; Str.Delim "."; Str.Text fn] -> (base, Some fn) | [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 | _ -> 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 = type feature_kind =
...@@ -225,22 +189,21 @@ module Ast = struct ...@@ -225,22 +189,21 @@ module Ast = struct
| Param_item of string | Param_item of string
type u_command = 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 | 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 *) (* 4 args: source, target, labels, flag true iff negative cst *)
| Shift_in of (command_node_ident * command_node_ident * edge_label_cst) | Shift_in of (Id.name * Id.name * edge_label_cst)
| Shift_out of (command_node_ident * command_node_ident * edge_label_cst) | Shift_out of (Id.name * Id.name * edge_label_cst)
| Shift_edge of (command_node_ident * command_node_ident * edge_label_cst) | Shift_edge of (Id.name * Id.name * edge_label_cst)
| Merge_node of (command_node_ident * command_node_ident) | Merge_node of (Id.name * Id.name)
| New_neighbour of (Id.name * command_node_ident * edge_label) | New_neighbour of (Id.name * Id.name * edge_label)
| Del_node of command_node_ident | Del_node of Id.name
| Activate of command_node_ident
| Del_feat of command_feature_ident | Del_feat of feature_ident
| Update_feat of command_feature_ident * concat_item list | Update_feat of feature_ident * concat_item list
type command = u_command * Loc.t type command = u_command * Loc.t
(* the [rule] type is used for 3 kinds of module items: (* the [rule] type is used for 3 kinds of module items:
...@@ -261,7 +224,6 @@ module Ast = struct ...@@ -261,7 +224,6 @@ module Ast = struct
type modul = { type modul = {
module_id:Id.name; module_id:Id.name;
local_labels: (string * string list) list; local_labels: (string * string list) list;
suffixes: string list;
rules: rule list; rules: rule list;
confluent: bool; confluent: bool;
module_doc:string list; module_doc:string list;
......
...@@ -44,22 +44,6 @@ module Ast : sig ...@@ -44,22 +44,6 @@ module Ast : sig
type simple_or_feature_ident = Id.name * feature_name option type simple_or_feature_ident = Id.name * feature_name option
val parse_simple_or_feature_ident: string -> simple_or_feature_ident 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 = type feature_kind =
| Equality of feature_value list | Equality of feature_value list
...@@ -128,22 +112,21 @@ module Ast : sig ...@@ -128,22 +112,21 @@ module Ast : sig
| Param_item of string | Param_item of string
type u_command = 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 | 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 *) (* 4 args: source, target, labels, flag true iff negative cst *)
| Shift_in of (command_node_ident * command_node_ident * edge_label_cst) | Shift_in of (Id.name * Id.name * edge_label_cst)
| Shift_out of (command_node_ident * command_node_ident * edge_label_cst) | Shift_out of (Id.name * Id.name * edge_label_cst)
| Shift_edge of (command_node_ident * command_node_ident * edge_label_cst) | Shift_edge of (Id.name * Id.name * edge_label_cst)
| Merge_node of (command_node_ident * command_node_ident) | Merge_node of (Id.name * Id.name)
| New_neighbour of (Id.name * command_node_ident * edge_label) | New_neighbour of (Id.name * Id.name * edge_label)
| Del_node of command_node_ident | Del_node of Id.name
| Activate of command_node_ident
| Del_feat of command_feature_ident | Del_feat of feature_ident
| Update_feat of command_feature_ident * concat_item list | Update_feat of feature_ident * concat_item list
type command = u_command * Loc.t type command = u_command * Loc.t
type rule = { type rule = {
...@@ -159,7 +142,6 @@ module Ast : sig ...@@ -159,7 +142,6 @@ module Ast : sig
type modul = { type modul = {
module_id:Id.name; module_id:Id.name;
local_labels: (string * string list) list; local_labels: (string * string list) list;
suffixes: string list;
rules: rule list; rules: rule list;
confluent: bool; confluent: bool;
module_doc:string list; module_doc:string list;
......
...@@ -23,7 +23,6 @@ module Command = struct ...@@ -23,7 +23,6 @@ module Command = struct
type command_node = (* a command node is either: *) type command_node = (* a command node is either: *)
| Pat of Pid.t (* a node identified in the pattern *) | Pat of Pid.t (* a node identified in the pattern *)
| New of string (* a node introduced by a new_neighbour *) (* TODO: remove *) | 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 *) (* [item] is a element of the RHS of an update_feat command *)
type item = type item =
...@@ -45,8 +44,6 @@ module Command = struct ...@@ -45,8 +44,6 @@ module Command = struct
| SHIFT_IN of (command_node * command_node * Label_cst.t) | SHIFT_IN of (command_node * command_node * Label_cst.t)
| SHIFT_OUT 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) | 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 *) type t = p * Loc.t (* remember command location to be able to localize a command failure *)
...@@ -63,27 +60,19 @@ module Command = struct ...@@ -63,27 +60,19 @@ module Command = struct
| H_SHIFT_IN of (Gid.t * Gid.t) | H_SHIFT_IN of (Gid.t * Gid.t)
| H_SHIFT_OUT of (Gid.t * Gid.t) | H_SHIFT_OUT of (Gid.t * Gid.t)
| H_MERGE_NODE 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" *) (* kai stands for "known act ident", kei for "known edge ident" *)
let pid_of_act_id loc = function let pid_of_act_id loc node_name =
| Ast.Sharp (node_name, n) -> Act (Pid.Pos (Id.build ~loc node_name table), n)
| Ast.No_sharp (node_name) ->
try (* TODO: remove with activate *) try (* TODO: remove with activate *)
Pat (Pid.Pos (Id.build ~loc node_name table)) Pat (Pid.Pos (Id.build ~loc node_name table))
with _ -> New node_name in with _ -> New node_name in
let pid_of_node_id loc node_id = Pat (Pid.Pos (Id.build ~loc node_id table)) 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 = 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 then Error.build ~loc "Unbound node identifier \"%s\"" node_id in
(* check that the edge_id is defined in the pattern *) (* check that the edge_id is defined in the pattern *)
...@@ -93,8 +82,8 @@ module Command = struct ...@@ -93,8 +82,8 @@ module Command = struct
match ast_command with match ast_command with
| (Ast.Del_edge_expl (act_i, act_j, lab), loc) -> | (Ast.Del_edge_expl (act_i, act_j, lab), loc) ->
check_act_id loc act_i kai; check_node_id loc act_i kai;
check_act_id loc act_j kai; check_node_id loc act_j kai;
let edge = G_edge.make ~loc label_domain ~locals lab in 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)) ((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 ...@@ -103,34 +92,34 @@ module Command = struct
(DEL_EDGE_NAME id, loc), (kai, List_.rm id kei) (DEL_EDGE_NAME id, loc), (kai, List_.rm id kei)
| (Ast.Add_edge (act_i, act_j, lab), loc) -> | (Ast.Add_edge (act_i, act_j, lab), loc) ->
check_act_id loc act_i kai; check_node_id loc act_i kai;
check_act_id loc act_j kai; check_node_id loc act_j kai;
let edge = G_edge.make ~loc label_domain ~locals lab in 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)) ((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) -> | (Ast.Shift_edge (act_i, act_j, label_cst), loc) ->
check_act_id loc act_i kai; check_node_id loc act_i kai;
check_act_id loc act_j 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)) ((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) -> | (Ast.Shift_in (act_i, act_j, label_cst), loc) ->
check_act_id loc act_i kai; check_node_id loc act_i kai;
check_act_id loc act_j 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)) ((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) -> | (Ast.Shift_out (act_i, act_j, label_cst), loc) ->
check_act_id loc act_i kai; check_node_id loc act_i kai;
check_act_id loc act_j 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)) ((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) -> | (Ast.Merge_node (act_i, act_j), loc) ->
check_act_id loc act_i kai; check_node_id loc act_i kai;
check_act_id loc act_j 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)) ((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) -> | (Ast.New_neighbour (new_id, ancestor, label), loc) ->
check_act_id loc ancestor kai; check_node_id loc ancestor kai;
if List.mem (Ast.No_sharp new_id) kai if List.mem new_id kai
then Error.build ~loc "Node identifier \"%s\" is already used" new_id; then Error.build ~loc "Node identifier \"%s\" is already used" new_id;
let edge = G_edge.make ~loc label_domain ~locals label in let edge = G_edge.make ~loc label_domain ~locals label in
...@@ -140,40 +129,30 @@ module Command = struct ...@@ -140,40 +129,30 @@ module Command = struct
(NEW_NEIGHBOUR (NEW_NEIGHBOUR
(new_id, (new_id,
edge, edge,
Pid.Pos (Id.build ~loc (Ast.base_command_node_ident ancestor) table) Pid.Pos (Id.build ~loc ancestor table)
), loc), ), loc),
((Ast.No_sharp new_id)::kai, kei) (new_id::kai, kei)
) )
with not_found -> with not_found ->
Log.fcritical "[GRS] tries to build a command New_neighbour (%s) on node %s which is not in the pattern %s" 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) (G_edge.to_string label_domain edge)
(Ast.base_command_node_ident ancestor) ancestor
(Loc.to_string loc) (Loc.to_string loc)
end 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) -> | (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)) ((DEL_NODE (pid_of_act_id loc act_n), loc), (List_.rm act_n kai, kei))
| (Ast.Del_feat (act_id, feat_name), loc) -> | (Ast.Del_feat (act_id, feat_name), loc) ->
if feat_name = "position" if feat_name = "position"
then Error.build ~loc "Illegal del_feat command: the 'position' feature cannot be deleted"; 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; Domain.check_feature_name ~loc domain feat_name;
((DEL_FEAT (pid_of_act_id loc act_id, feat_name), loc), (kai, kei)) ((DEL_FEAT (pid_of_act_id loc act_id, feat_name), loc), (kai, kei))
| (Ast.Update_feat ((act_id, feat_name), ast_items), loc) -> | (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 let items = List.map
(function (function
| Ast.Qfn_item (node_id,feature_name) -> | Ast.Qfn_item (node_id,feature_name) ->
......
...@@ -19,7 +19,6 @@ module Command : sig ...@@ -19,7 +19,6 @@ module Command : sig
type command_node = (* a command node is either: *) type command_node = (* a command node is either: *)
| Pat of Pid.t (* a node identified in the pattern *) | Pat of Pid.t (* a node identified in the pattern *)
| New of string (* a node introduced by a new_neighbour *) | New of string (* a node introduced by a new_neighbour *)
| Act of Pid.t * string (* a node introduced by a activate *)
type item = type item =
| Feat of (command_node * string) | Feat of (command_node * string)
...@@ -39,8 +38,6 @@ module Command : sig ...@@ -39,8 +38,6 @@ module Command : sig
| SHIFT_IN of (command_node * command_node * Label_cst.t) | SHIFT_IN of (command_node * command_node * Label_cst.t)
| SHIFT_OUT 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) | MERGE_NODE of (command_node * command_node)
| ACT_NODE of command_node
type t = (p * Loc.t) type t = (p * Loc.t)
type h = type h =
...@@ -55,16 +52,14 @@ module Command : sig ...@@ -55,16 +52,14 @@ module Command : sig
| H_SHIFT_IN of (Gid.t * Gid.t) | H_SHIFT_IN of (Gid.t * Gid.t)
| H_SHIFT_OUT of (Gid.t * Gid.t) | H_SHIFT_OUT of (Gid.t * Gid.t)
| H_MERGE_NODE of (Gid.t * Gid.t) | H_MERGE_NODE of (Gid.t * Gid.t)
| H_ACT_NODE of (Gid.t * string)
val build: val build:
Domain.t -> Domain.t ->
Domain.t -> Domain.t ->
?param: (string list * string list) -> ?param: (string list * string list) ->
(Ast.command_node_ident list * string list) -> (Id.name list * string list) ->
Id.table -> Id.table ->
Label_domain.decl array -> Label_domain.decl array ->
suffix list ->
Ast.command -> Ast.command ->
t * (Ast.command_node_ident list * string list) t * (Id.name list * string list)
end (* module Command *) end (* module Command *)
...@@ -236,7 +236,6 @@ module G_graph = struct ...@@ -236,7 +236,6 @@ module G_graph = struct
match key with match key with
| Gid.Old n -> (n, mapping) | Gid.Old n -> (n, mapping)
| Gid.New _ -> (max_binding, mapping) | Gid.New _ -> (max_binding, mapping)
| Gid.Act (n,suffix) -> (max_binding+1, (key, (Gid.Old (max_binding+1)))::mapping)
) t.map (0, []) in ) t.map (0, []) in
rename mapping t rename mapping t
...@@ -489,19 +488,6 @@ module G_graph = struct ...@@ -489,19 +488,6 @@ module G_graph = struct
) graph.map Gid_map.empty ) 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 add_neighbour loc domain graph node_id label =
let index = match node_id with let index = match node_id with
...@@ -510,7 +496,7 @@ module G_graph = struct ...@@ -510,7 +496,7 @@ module G_graph = struct
| Some label_int -> Gid.New (id, label_int) | Some label_int -> Gid.New (id, label_int)
| None -> Error.run ~loc "[Graph.add_neighbour] try to add neighbour with a local label" | 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 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); 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 ...@@ -136,7 +136,6 @@ module G_graph: sig
val del_node: t -> Gid.t -> t val del_node: t -> Gid.t -> t
val add_neighbour: Loc.t -> Domain.t -> t -> Gid.t -> G_edge.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 val merge_node: Loc.t -> Domain.t -> t -> Gid.t -> Gid.t -> t option
......
...@@ -147,7 +147,6 @@ module Modul = struct ...@@ -147,7 +147,6 @@ module Modul = struct
type t = { type t = {
name: string; name: string;
local_labels: (string * string list) array; local_labels: (string * string list) array;
suffixes: string list;
rules: Rule.t list; rules: Rule.t list;
filters: Rule.t list; filters: Rule.t list;
confluent: bool; confluent: bool;
...@@ -166,14 +165,12 @@ module Modul = struct ...@@ -166,14 +165,12 @@ module Modul = struct
let build domain ast_module = let build domain ast_module =
let locals = Array.of_list ast_module.Ast.local_labels in let locals = Array.of_list ast_module.Ast.local_labels in
Array.sort compare locals; Array.sort compare locals;
let suffixes = ast_module.Ast.suffixes in let rules_or_filters = List.map (Rule.build domain ~locals ast_module.Ast.mod_dir) ast_module.Ast.rules in
let rules_or_filters = List.map (Rule.build domain ~locals suffixes ast_module.Ast.mod_dir) ast_module.Ast.rules in
let (filters, rules) = List.partition Rule.is_filter rules_or_filters in let (filters, rules) = List.partition Rule.is_filter rules_or_filters in
let modul = let modul =
{ {
name = ast_module.Ast.module_id; name = ast_module.Ast.module_id;
local_labels = locals; local_labels = locals;
suffixes;
rules; rules;
filters; filters;
confluent = ast_module.Ast.confluent; confluent = ast_module.Ast.confluent;
......
...@@ -68,7 +68,6 @@ module Modul: sig ...@@ -68,7 +68,6 @@ module Modul: sig
type t = { type t = {
name: string; name: string;
local_labels: (string * string list) array; local_labels: (string * string list) array;
suffixes: string list;
rules: Rule.t list; rules: Rule.t list;
filters: Rule.t list; filters: Rule.t list;
confluent: bool; confluent: bool;
......
...@@ -51,40 +51,39 @@ module Html_doc = struct ...@@ -51,40 +51,39 @@ module Html_doc = struct
if li_html then bprintf buff "<li>"; if li_html then bprintf buff "<li>";
(match u_command with (match u_command with
| Ast.Del_edge_expl (n1,n2,label) -> | 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.Del_edge_name name -> bprintf buff "del_edge %s" name
| Ast.Add_edge (n1,n2,label) -> | 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)) -> | 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)) -> | 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)) -> | 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)) -> | 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)) -> | 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)) -> | 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)) -> | 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)) -> | 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)) -> | 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.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 (Ast.dump_command_node_ident n2) | Ast.New_neighbour (n1,n2,label) -> bprintf buff "add_node %s: <-[%s]- %s" n1 label 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" act_id
| Ast.Del_node act_id -> bprintf buff "del_node %s" (Ast.dump_command_node_ident act_id)
| Ast.Update_feat ((act_id, feat_name),item_list) -> | 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) -> | 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" if li_html then bprintf buff "</li>\n" else bprintf buff ";\n"
......
...@@ -19,14 +19,6 @@ ...@@ -19,14 +19,6 @@
let escaped = ref false 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 split_comment com =
let raw = Str.split (Str.regexp "\n") com in let raw = Str.split (Str.regexp "\n") com in
List.filter (fun l -> not (Str.string_match (Str.regexp "[ \t]*$") l 0)) raw List.filter (fun l -> not (Str.string_match (Str.regexp "[ \t]*$") l 0)) raw
...@@ -45,16 +37,15 @@ let letter = ['a'-'z' 'A'-'Z'] ...@@ -45,16 +37,15 @@ let letter = ['a'-'z' 'A'-'Z']
for basic ident construction and for basic ident construction and
- dot '.' - dot '.'
- colon ':' - colon ':'
- sharp '#'
- star '*' - 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 = let label_ident =
(letter | '_' | '-' | '.' | '*') (letter | digit | '_' | '\'' | '-' | '.' | ':' | '*')* (letter | '_' | '-' | '.' | '*') (letter | digit | '_' | '\'' | '-' | '.' | ':' | '*')*
let general_ident = let general_ident =