Commit ae3698c3 authored by bguillaum's avatar bguillaum

TMP_activate command

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@8440 7838e531-6607-4d57-9587-6c381814729c
parent 00d588ef
This diff is collapsed.
......@@ -15,8 +15,8 @@ open Grew_edge
(* ==================================================================================================== *)
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 *)
| 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 =
......@@ -37,8 +37,9 @@ module Command : sig
| SHIFT_IN of (command_node * command_node)
| SHIFT_OUT of (command_node * command_node)
| MERGE_NODE of (command_node * command_node)
| ACT_NODE of command_node
type t = (p * Loc.t)
type h =
| H_DEL_NODE of Gid.t
......@@ -52,6 +53,7 @@ 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:
?param: (string list * string list) ->
......
......@@ -449,6 +449,19 @@ module G_graph = struct
) graph.map Gid_map.empty
}
(* -------------------------------------------------------------------------------- *)
let activate loc node_id new_name graph =
let index = match node_id with
| Gid.Old id -> Gid.Act (id, new_name)
| _ -> 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 new_name '%s')" new_name;
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 graph node_id label =
let index = match node_id with
......
......@@ -50,7 +50,7 @@ module P_graph: sig
type extension = {
ext_map: P_node.t Pid_map.t; (* node description for new nodes and for edge "Old -> New" *)
old_map: P_node.t Pid_map.t; (* a partial map for new constraints on old nodes "Old [...]" *)
old_map: P_node.t Pid_map.t; (* a partial map for new constraints on old nodes "Old [...]" *)
}
(* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
......@@ -137,6 +137,7 @@ module G_graph: sig
val del_node: t -> Gid.t -> t
val add_neighbour: Loc.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 -> t -> Gid.t -> Gid.t -> t option
......
......@@ -82,6 +82,8 @@ module G_node = struct
let build_neighbour t = { empty with position = (get_position t) +. 0.01 }
let build_new t = { empty with position = (get_position t) +. 0.01 }
let position_comp n1 n2 = Pervasives.compare n1.position n2.position
let rename mapping n = {n with next = Massoc_gid.rename mapping n.next}
......
......@@ -53,6 +53,7 @@ module G_node: sig
val get_annot_info: t -> string option
val build_neighbour: t -> t
val build_new: t -> t
val rename: (Gid.t * Gid.t) list -> t -> t
end
......
......@@ -352,7 +352,7 @@ module Rule = struct
G_deco.edges = List.fold_left (fun acc (_,edge) -> edge::acc) matching.a_match matching.e_match;
}
let find cnode ?loc (matching, created_nodes) =
let find cnode ?loc (matching, (created_nodes,activated_nodes)) =
match cnode with
| Command.Pat pid ->
(try Pid_map.find pid matching.n_match
......@@ -360,7 +360,10 @@ module Rule = struct
| Command.New name ->
(try List.assoc name created_nodes
with Not_found -> Error.run ?loc "Identifier '%s' not found" name)
| Command.Act _ -> Log.critical "TODO: not yet implemented"
| Command.Act (pid, new_name) ->
(try List.assoc (pid, new_name) activated_nodes
with Not_found -> Error.run ?loc "Activated identifier with suffix '%s' not found" new_name)
let down_deco (matching,created_nodes) commands =
......@@ -566,8 +569,8 @@ module Rule = struct
exception Command_execution_fail
(** [apply_command instance matching created_nodes command] returns [(new_instance, new_created_nodes)] *)
let apply_command (command,loc) instance matching created_nodes =
let node_find cnode = find ~loc cnode (matching, created_nodes) in
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
match command with
| Command.ADD_EDGE (src_cn,tar_cn,edge) ->
......@@ -581,7 +584,7 @@ module Rule = struct
Instance.graph = new_graph;
history = List_.sort_insert (Command.H_ADD_EDGE (src_gid,tar_gid,edge)) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
| None ->
Error.run "ADD_EDGE: the edge '%s' already exists %s" (G_edge.to_string edge) (Loc.to_string loc)
......@@ -595,7 +598,7 @@ module Rule = struct
Instance.graph = G_graph.del_edge loc instance.Instance.graph src_gid edge tar_gid;
history = List_.sort_insert (Command.H_DEL_EDGE_EXPL (src_gid,tar_gid,edge)) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
| Command.DEL_EDGE_NAME edge_ident ->
......@@ -607,7 +610,7 @@ module Rule = struct
Instance.graph = G_graph.del_edge ~edge_ident loc instance.Instance.graph src_gid edge tar_gid;
history = List_.sort_insert (Command.H_DEL_EDGE_EXPL (src_gid,tar_gid,edge)) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
| Command.DEL_NODE node_cn ->
......@@ -617,7 +620,7 @@ module Rule = struct
Instance.graph = G_graph.del_node instance.Instance.graph node_gid;
history = List_.sort_insert (Command.H_DEL_NODE node_gid) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
| Command.MERGE_NODE (src_cn, tar_cn) ->
......@@ -630,7 +633,7 @@ module Rule = struct
Instance.graph = new_graph;
history = List_.sort_insert (Command.H_MERGE_NODE (src_gid,tar_gid)) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
| None -> raise Command_execution_fail
)
......@@ -658,7 +661,7 @@ module Rule = struct
Instance.graph = new_graph;
history = List_.sort_insert (Command.H_UPDATE_FEAT (tar_gid,tar_feat_name,new_feature_value)) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
| Command.DEL_FEAT (tar_cn,feat_name) ->
......@@ -668,7 +671,7 @@ module Rule = struct
Instance.graph = G_graph.del_feat instance.Instance.graph tar_gid feat_name;
history = List_.sort_insert (Command.H_DEL_FEAT (tar_gid,feat_name)) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
| Command.NEW_NEIGHBOUR (created_name,edge,base_pid) ->
......@@ -680,7 +683,18 @@ module Rule = struct
history = List_.sort_insert (Command.H_NEW_NEIGHBOUR (created_name,edge,new_gid)) instance.Instance.history;
activated_node = new_gid :: instance.Instance.activated_node;
},
(created_name,new_gid) :: created_nodes
((created_name,new_gid) :: created_nodes, activated_nodes)
)
| Command.ACT_NODE (Command.Act (pid, new_name)) ->
let node_gid = node_find (Command.Pat(pid)) in
let (new_gid, new_graph) = G_graph.activate loc node_gid new_name instance.Instance.graph in
(
{instance with
Instance.graph = new_graph;
history = List_.sort_insert (Command.H_ACT_NODE (node_gid,new_name)) instance.Instance.history
},
(created_nodes, ((pid, new_name), new_gid) :: activated_nodes)
)
| Command.SHIFT_IN (src_cn,tar_cn) ->
......@@ -691,7 +705,7 @@ module Rule = struct
Instance.graph = G_graph.shift_in loc instance.Instance.graph src_gid tar_gid;
history = List_.sort_insert (Command.H_SHIFT_IN (src_gid,tar_gid)) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
| Command.SHIFT_OUT (src_cn,tar_cn) ->
......@@ -702,7 +716,7 @@ module Rule = struct
Instance.graph = G_graph.shift_out loc instance.Instance.graph src_gid tar_gid;
history = List_.sort_insert (Command.H_SHIFT_OUT (src_gid,tar_gid)) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
| Command.SHIFT_EDGE (src_cn,tar_cn) ->
......@@ -713,7 +727,7 @@ module Rule = struct
Instance.graph = G_graph.shift_edges loc instance.Instance.graph src_gid tar_gid;
history = List_.sort_insert (Command.H_SHIFT_EDGE (src_gid,tar_gid)) instance.Instance.history
},
created_nodes
(created_nodes, activated_nodes)
)
(** [apply_rule instance matching rule] returns a new instance after the application of the rule
......@@ -735,7 +749,7 @@ module Rule = struct
(fun (instance, created_nodes) command ->
apply_command command instance matching created_nodes
)
(instance, [])
(instance, ([],[]))
rule.commands in
let rule_app = {
......
......@@ -169,17 +169,27 @@ module Gid = struct
type t =
| Old of int
| New of (int * int) (* identifier for "created nodes" *)
| Act of (int * string) (* identifier for "activated nodes" *)
(* a compare function which ensures that new nodes are at the "end" of the graph *)
let compare t1 t2 = match (t1,t2) with
| Old o1, Old o2 -> Pervasives.compare o1 o2
| Old _ , New _ -> -1
| New _, Old _ -> 1
| Old o1, Old o2 -> Pervasives.compare o1 o2
| New n1, New n2 -> Pervasives.compare n1 n2
| Old _ , Act _ -> -1
| Act _, Old _ -> 1
| Act n1, Act n2 -> Pervasives.compare n1 n2
| Act _ , New _ -> -1
| New _, Act _ -> 1
let to_string = function
| Old i -> sprintf "%d" i
| New (i,j) -> sprintf"%d__%d" i j
| Act (i,n) -> sprintf"%d#%s" i n
end (* module Gid *)
(* ================================================================================ *)
......
......@@ -83,6 +83,7 @@ module Gid : sig
type t =
| Old of int
| New of (int * int) (* identifier for "created nodes" *)
| Act of (int * string) (* identifier for "activated nodes" *)
val compare: t -> t -> int
......
......@@ -22,6 +22,7 @@
(* 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 =
printf "--parse_complex_ident-->%s<--\n%!" string;
match Str.split (Str.regexp "#") string with
| [x] -> Ast.No_sharp x
| [x;y] -> Ast.Sharp (x,y)
......@@ -118,6 +119,7 @@ and global = parse
| "del_node" { DEL_NODE }
| "add_node" { ADD_NODE }
| "del_feat" { DEL_FEAT }
| "activate" { ACTIVATE }
| "module" { MODULE }
| "confluent" { CONFLUENT }
......
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