Skip to content

GitLab

Commit cc101f3c authored by bguillaum's avatar bguillaum
Browse files

more consistent file nammig 

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6695 7838e531-6607-4d57-9587-6c381814729c
parent f3e6e5dc
Hide whitespace changes
Inline Side-by-side
Showing with 510 additions and 501 deletions
src/HTMLer/HTMLer.ml
View file @ cc101f3c
open Grew_ast
module HTMLer = struct
let index_text table = "
......@@ -71,7 +72,7 @@ let rule_page_text previous next rule m ast file = "
"<h6>Features domain</h6><code class=\"code\">"^
(let rec compute tab = match tab with
| [] -> ""
| h::t -> begin match h with Ast.Open a -> "<b>"^a^"</b> : *<br/>"^compute t | Ast.Closed (name,values) -> "<b>"^name^"</b> : "^(Ast.AST_HTML.feat_values_tab_to_html values)^"<br/>"^compute t; end;
| h::t -> begin match h with Ast.Open a -> "<b>"^a^"</b> : *<br/>"^compute t | Ast.Closed (name,values) -> "<b>"^name^"</b> : "^(AST_HTML.feat_values_tab_to_html values)^"<br/>"^compute t; end;
in compute ast.Ast.domain)
) else (
""
......@@ -120,9 +121,9 @@ let rule_page_text previous next rule m ast file = "
"<br/>
<br/><h6>Commands</h6>
<code class=code><pre>"^(Ast.AST_HTML.to_html_commands_pretty rule.Ast.commands)^"
<code class=code><pre>"^(AST_HTML.to_html_commands_pretty rule.Ast.commands)^"
</pre></code><br/><h6>Code</h6><pre>"^
(Ast.AST_HTML.to_html_rules [rule])^
(AST_HTML.to_html_rules [rule])^
"</pre><br/>
</body>
......@@ -208,7 +209,7 @@ let features_domain_text ast =
"<code class=\"code\">"^
(let rec compute tab = match tab with
| [] -> ""
| h::t -> begin match h with Ast.Open a -> "<b>"^a^"</b> : *<br/>"^compute t | Ast.Closed (name,values) -> "<b>"^name^"</b> : "^(Ast.AST_HTML.feat_values_tab_to_html values)^"<br/>"^compute t; end;
| h::t -> begin match h with Ast.Open a -> "<b>"^a^"</b> : *<br/>"^compute t | Ast.Closed (name,values) -> "<b>"^name^"</b> : "^(AST_HTML.feat_values_tab_to_html values)^"<br/>"^compute t; end;
in compute ast.Ast.domain)^
"</code>"^
"</body>
......
src/HTMLer/Makefile.in
View file @ cc101f3c
......@@ -4,9 +4,9 @@ byte: HTMLer.cmo
include ../../config/Makefile
HTMLer.cmx: HTMLer.ml ../ast.cmx
ocamlopt -c $(OPT_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -I .. ast.cmx HTMLer.ml
HTMLer.cmx: HTMLer.ml ../grew_ast.cmx
ocamlopt -c $(OPT_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -I .. grew_ast.cmx HTMLer.ml
HTMLer.cmo: HTMLer.ml ../ast.cmo
ocamlc -c $(BYTE_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -I .. ast.cmo HTMLer.ml
HTMLer.cmo: HTMLer.ml ../grew_ast.cmo
ocamlc -c $(BYTE_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -I .. grew_ast.cmo HTMLer.ml
src/Makefile.in
View file @ cc101f3c
FILES_DEP = utils ast grew_fs grew_edge grew_node graph grew_types command rule grs
FILES_DEP = grew_utils grew_ast grew_fs grew_edge grew_node grew_graph grew_types grew_command grew_rule grew_grs
FILES_ML = $(FILES_DEP:%=%.ml)
FILES_MLI = $(FILES_DEP:%=%.mli)
FILES_CMI = $(FILES_DEP:%=%.cmi)
......@@ -15,8 +15,8 @@ PARSER_CMX = $(PARSER_DEP:%=%.cmx)
.PHONY: parser HTMLer
all: utils.cmx ast.cmx parser HTMLer grew test
byte: utils.cmo ast.cmo parser.byte HTMLer.byte grew.byte test.byte
all: grew_utils.cmx grew_ast.cmx parser HTMLer grew test
byte: grew_utils.cmo grew_ast.cmo parser.byte HTMLer.byte grew.byte test.byte
include ../config/Makefile
......@@ -115,42 +115,42 @@ grew_core.cmx: $(GREW_CORE_CMX) parser_opt grew_core.cmi grew_core.ml
ocamlopt $(OPT_FLAGS) -c $(DEPENDS_DIR) $(GREW_CORE_CMX) grew_core.ml
################################################################################
###### utils.ml ##############################################################
UTILS_DEP =
UTILS_CMI = $(UTILS_DEP:%=%.cmi)
UTILS_CMO = $(UTILS_DEP:%=%.cmo)
UTILS_CMX = $(UTILS_DEP:%=%.cmx)
###### grew_utils.ml ##############################################################
GREW_UTILS_DEP =
GREW_UTILS_CMI = $(GREW_UTILS_DEP:%=%.cmi)
GREW_UTILS_CMO = $(GREW_UTILS_DEP:%=%.cmo)
GREW_UTILS_CMX = $(GREW_UTILS_DEP:%=%.cmx)
utils.cmi: $(UTILS_CMI) utils.mli
ocamlc -c utils.mli
grew_utils.cmi: $(GREW_UTILS_CMI) grew_utils.mli
ocamlc -c grew_utils.mli
utils.cmo: $(UTILS_CMO) utils.cmi utils.ml
ocamlc $(BYTE_FLAGS) -c $(DEPENDS_DIR) utils.ml
grew_utils.cmo: $(GREW_UTILS_CMO) grew_utils.cmi grew_utils.ml
ocamlc $(BYTE_FLAGS) -c $(DEPENDS_DIR) grew_utils.ml
utils.cmx: $(UTILS_CMX) utils.cmi utils.ml
ocamlopt $(OPT_FLAGS) -c $(DEPENDS_DIR) utils.ml
grew_utils.cmx: $(GREW_UTILS_CMX) grew_utils.cmi grew_utils.ml
ocamlopt $(OPT_FLAGS) -c $(DEPENDS_DIR) grew_utils.ml
################################################################################
###### ast.ml ##############################################################
AST_DEP = utils
AST_CMI = $(AST_DEP:%=%.cmi)
AST_CMO = $(AST_DEP:%=%.cmo)
AST_CMX = $(AST_DEP:%=%.cmx)
###### grew_ast.ml ##############################################################
GREW_AST_DEP = grew_utils
GREW_AST_CMI = $(GREW_AST_DEP:%=%.cmi)
GREW_AST_CMO = $(GREW_AST_DEP:%=%.cmo)
GREW_AST_CMX = $(GREW_AST_DEP:%=%.cmx)
ast.cmi: $(AST_CMI) ast.mli
ocamlc -c ast.mli
grew_ast.cmi: $(GREW_AST_CMI) grew_ast.mli
ocamlc -c grew_ast.mli
ast.cmo: $(AST_CMO) ast.cmi ast.ml
ocamlc $(BYTE_FLAGS) -c $(DEPENDS_DIR) ast.ml
grew_ast.cmo: $(GREW_AST_CMO) grew_ast.cmi grew_ast.ml
ocamlc $(BYTE_FLAGS) -c $(DEPENDS_DIR) grew_ast.ml
ast.cmx: $(AST_CMX) ast.cmi ast.ml
ocamlopt $(OPT_FLAGS) -c $(DEPENDS_DIR) ast.ml
grew_ast.cmx: $(GREW_AST_CMX) grew_ast.cmi grew_ast.ml
ocamlopt $(OPT_FLAGS) -c $(DEPENDS_DIR) grew_ast.ml
################################################################################
###### grew_fs.ml ##############################################################
GREW_FS_DEP = utils ast
GREW_FS_DEP = grew_utils grew_ast
GREW_FS_CMI = $(GREW_FS_DEP:%=%.cmi)
GREW_FS_CMO = $(GREW_FS_DEP:%=%.cmo)
GREW_FS_CMX = $(GREW_FS_DEP:%=%.cmx)
......@@ -167,7 +167,7 @@ grew_fs.cmx: $(GREW_FS_CMX) grew_fs.cmi grew_fs.ml
###### grew_edge.ml ##############################################################
GREW_EDGE_DEP = utils ast
GREW_EDGE_DEP = grew_utils grew_ast
GREW_EDGE_CMI = $(GREW_EDGE_DEP:%=%.cmi)
GREW_EDGE_CMO = $(GREW_EDGE_DEP:%=%.cmo)
GREW_EDGE_CMX = $(GREW_EDGE_DEP:%=%.cmx)
......@@ -184,7 +184,7 @@ grew_edge.cmx: $(GREW_EDGE_CMX) grew_edge.cmi grew_edge.ml
###### grew_node.ml ##############################################################
GREW_NODE_DEP = utils ast grew_fs grew_edge
GREW_NODE_DEP = grew_utils grew_ast grew_fs grew_edge
GREW_NODE_CMI = $(GREW_NODE_DEP:%=%.cmi)
GREW_NODE_CMO = $(GREW_NODE_DEP:%=%.cmo)
GREW_NODE_CMX = $(GREW_NODE_DEP:%=%.cmx)
......@@ -200,25 +200,25 @@ grew_node.cmx: $(GREW_NODE_CMX) grew_node.cmi grew_node.ml
################################################################################
###### graph.ml ##############################################################
GRAPH_DEP = utils ast command grew_edge grew_fs grew_node
GRAPH_CMI = $(GRAPH_DEP:%=%.cmi)
GRAPH_CMO = $(GRAPH_DEP:%=%.cmo)
GRAPH_CMX = $(GRAPH_DEP:%=%.cmx)
###### grew_graph.ml ##############################################################
GREW_GRAPH_DEP = grew_utils grew_ast grew_command grew_edge grew_fs grew_node
GREW_GRAPH_CMI = $(GREW_GRAPH_DEP:%=%.cmi)
GREW_GRAPH_CMO = $(GREW_GRAPH_DEP:%=%.cmo)
GREW_GRAPH_CMX = $(GREW_GRAPH_DEP:%=%.cmx)
graph.cmi: $(GRAPH_CMI) graph.mli
ocamlc -c graph.mli
grew_graph.cmi: $(GREW_GRAPH_CMI) grew_graph.mli
ocamlc -c grew_graph.mli
graph.cmo: $(GRAPH_CMO) graph.cmi graph.ml
ocamlc $(BYTE_FLAGS) -c $(DEPENDS_DIR) graph.ml
grew_graph.cmo: $(GREW_GRAPH_CMO) grew_graph.cmi grew_graph.ml
ocamlc $(BYTE_FLAGS) -c $(DEPENDS_DIR) grew_graph.ml
graph.cmx: $(GRAPH_CMX) graph.cmi graph.ml
ocamlopt $(OPT_FLAGS) -c $(DEPENDS_DIR) graph.ml
grew_graph.cmx: $(GREW_GRAPH_CMX) grew_graph.cmi grew_graph.ml
ocamlopt $(OPT_FLAGS) -c $(DEPENDS_DIR) grew_graph.ml
################################################################################
###### grew_types.ml ##############################################################
GREW_TYPES_DEP = graph
GREW_TYPES_DEP = grew_graph
GREW_TYPES_CMI = $(GREW_TYPES_DEP:%=%.cmi)
GREW_TYPES_CMO = $(GREW_TYPES_DEP:%=%.cmo)
GREW_TYPES_CMX = $(GREW_TYPES_DEP:%=%.cmx)
......@@ -234,77 +234,77 @@ grew_types.cmx: $(GREW_TYPES_CMX) grew_types.cmi grew_types.ml
################################################################################
###### command.ml ##############################################################
COMMAND_DEP = utils ast grew_edge grew_fs
COMMAND_CMI = $(COMMAND_DEP:%=%.cmi)
COMMAND_CMO = $(COMMAND_DEP:%=%.cmo)
COMMAND_CMX = $(COMMAND_DEP:%=%.cmx)
###### grew_command.ml ##############################################################
GREW_COMMAND_DEP = grew_utils grew_ast grew_edge grew_fs
GREW_COMMAND_CMI = $(GREW_COMMAND_DEP:%=%.cmi)
GREW_COMMAND_CMO = $(GREW_COMMAND_DEP:%=%.cmo)
GREW_COMMAND_CMX = $(GREW_COMMAND_DEP:%=%.cmx)
command.cmi: $(COMMAND_CMI) command.mli
ocamlc -c command.mli
grew_command.cmi: $(GREW_COMMAND_CMI) grew_command.mli
ocamlc -c grew_command.mli
command.cmo: $(COMMAND_CMO) command.cmi command.ml
ocamlc $(BYTE_FLAGS) -c $(DEPENDS_DIR) command.ml
grew_command.cmo: $(GREW_COMMAND_CMO) grew_command.cmi grew_command.ml
ocamlc $(BYTE_FLAGS) -c $(DEPENDS_DIR) grew_command.ml
command.cmx: $(COMMAND_CMX) command.cmi command.ml
ocamlopt $(OPT_FLAGS) -c $(DEPENDS_DIR) command.ml
grew_command.cmx: $(GREW_COMMAND_CMX) grew_command.cmi grew_command.ml
ocamlopt $(OPT_FLAGS) -c $(DEPENDS_DIR) grew_command.ml
################################################################################
###### rule.ml ##############################################################
RULE_DEP = utils ast command grew_edge grew_fs grew_node grew_types graph
RULE_CMI = $(RULE_DEP:%=%.cmi)
RULE_CMO = $(RULE_DEP:%=%.cmo)
RULE_CMX = $(RULE_DEP:%=%.cmx)
###### grew_rule.ml ##############################################################
GREW_RULE_DEP = grew_utils grew_ast grew_command grew_edge grew_fs grew_node grew_types grew_graph
GREW_RULE_CMI = $(GREW_RULE_DEP:%=%.cmi)
GREW_RULE_CMO = $(GREW_RULE_DEP:%=%.cmo)
GREW_RULE_CMX = $(GREW_RULE_DEP:%=%.cmx)
rule.cmi: $(RULE_CMI) rule.mli
grew_rule.cmi: $(GREW_RULE_CMI) grew_rule.mli
ifeq (@DEP2PICT@,no)
ocamlc -c -pp 'camlp4o pa_macro.cmo' rule.mli
ocamlc -c -pp 'camlp4o pa_macro.cmo' grew_rule.mli
else
ocamlc -c -pp 'camlp4o pa_macro.cmo -DDEP2PICT' rule.mli
ocamlc -c -pp 'camlp4o pa_macro.cmo -DDEP2PICT' grew_rule.mli
endif
rule.cmo: $(RULE_CMO) rule.cmi rule.ml
grew_rule.cmo: $(GREW_RULE_CMO) grew_rule.cmi grew_rule.ml
ifeq (@DEP2PICT@,no)
ocamlc -pp 'camlp4o pa_macro.cmo' $(BYTE_FLAGS) -c $(DEPENDS_DIR) rule.ml
ocamlc -pp 'camlp4o pa_macro.cmo' $(BYTE_FLAGS) -c $(DEPENDS_DIR) grew_rule.ml
else
ocamlc -pp 'camlp4o pa_macro.cmo -DDEP2PICT' $(BYTE_FLAGS) -c $(DEPENDS_DIR) $(DEP2PICT_BYTE) rule.ml
ocamlc -pp 'camlp4o pa_macro.cmo -DDEP2PICT' $(BYTE_FLAGS) -c $(DEPENDS_DIR) $(DEP2PICT_BYTE) grew_rule.ml
endif
rule.cmx: $(RULE_CMX) rule.cmi rule.ml
grew_rule.cmx: $(GREW_RULE_CMX) grew_rule.cmi grew_rule.ml
ifeq (@DEP2PICT@,no)
ocamlopt -pp 'camlp4o pa_macro.cmo' $(OPT_FLAGS) -c $(DEPENDS_DIR) rule.ml
ocamlopt -pp 'camlp4o pa_macro.cmo' $(OPT_FLAGS) -c $(DEPENDS_DIR) grew_rule.ml
else
ocamlopt -pp 'camlp4o pa_macro.cmo -DDEP2PICT' $(OPT_FLAGS) -c $(DEPENDS_DIR) $(DEP2PICT_OPT) rule.ml
ocamlopt -pp 'camlp4o pa_macro.cmo -DDEP2PICT' $(OPT_FLAGS) -c $(DEPENDS_DIR) $(DEP2PICT_OPT) grew_rule.ml
endif
################################################################################
###### grs.ml ##############################################################
GRS_DEP = utils grew_edge grew_types graph rule
GRS_CMI = $(GRS_DEP:%=%.cmi)
GRS_CMO = $(GRS_DEP:%=%.cmo)
GRS_CMX = $(GRS_DEP:%=%.cmx)
###### grew_grs.ml ##############################################################
GREW_GRS_DEP = grew_utils grew_edge grew_types grew_graph grew_rule
GREW_GRS_CMI = $(GREW_GRS_DEP:%=%.cmi)
GREW_GRS_CMO = $(GREW_GRS_DEP:%=%.cmo)
GREW_GRS_CMX = $(GREW_GRS_DEP:%=%.cmx)
grs.cmi: $(GRS_CMI) grs.mli
grew_grs.cmi: $(GREW_GRS_CMI) grew_grs.mli
ifeq (@DEP2PICT@,no)
ocamlc -c -pp 'camlp4o pa_macro.cmo' grs.mli
ocamlc -c -pp 'camlp4o pa_macro.cmo' grew_grs.mli
else
ocamlc -c -pp 'camlp4o pa_macro.cmo -DDEP2PICT' grs.mli
ocamlc -c -pp 'camlp4o pa_macro.cmo -DDEP2PICT' grew_grs.mli
endif
grs.cmo: $(GRS_CMO) grs.cmi grs.ml
grew_grs.cmo: $(GREW_GRS_CMO) grew_grs.cmi grew_grs.ml
ifeq (@DEP2PICT@,no)
ocamlc $(BYTE_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -c $(DEPENDS_DIR) grs.ml
ocamlc $(BYTE_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -c $(DEPENDS_DIR) grew_grs.ml
else
ocamlc $(BYTE_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\" -DDEP2PICT' -c $(DEPENDS_DIR) grs.ml
ocamlc $(BYTE_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\" -DDEP2PICT' -c $(DEPENDS_DIR) grew_grs.ml
endif
grs.cmx: $(GRS_CMX) grs.cmi grs.ml
grew_grs.cmx: $(GREW_GRS_CMX) grew_grs.cmi grew_grs.ml
ifeq (@DEP2PICT@,no)
ocamlopt $(OPT_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -c $(DEPENDS_DIR) grs.ml
ocamlopt $(OPT_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\"' -c $(DEPENDS_DIR) grew_grs.ml
else
ocamlopt $(OPT_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\" -DDEP2PICT' -c $(DEPENDS_DIR) grs.ml
ocamlopt $(OPT_FLAGS) -pp 'camlp4o pa_macro.cmo -DDATA_DIR=\"$(DATA_DIR)\" -DDEP2PICT' -c $(DEPENDS_DIR) grew_grs.ml
endif
################################################################################
......
src/ast.ml deleted 100644 → 0
View file @ f3e6e5dc
open Printf
open Log
open Utils
type feature_spec =
| Closed of string * string list (* (the name, the set of atomic values) *)
| Open of string (* the name *)
type domain = feature_spec list
type feature_kind = Equality | Disequality
type u_feature = {
kind: feature_kind;
name: string;
values: string list;
}
type feature = u_feature * Loc.t
(* qualified feature name "A.lemma" *)
type qfn = string * string
type u_node = {
node_id: Id.name;
position: int option;
fs: feature list;
}
type node = u_node * Loc.t
type u_edge = {
edge_id: Id.name option;
src: Id.name;
edge_labels: string list;
tar: Id.name;
negative: bool;
}
type edge = u_edge * Loc.t
type u_const =
| Start of Id.name * string list (* (source, labels) *)
| No_out of Id.name
| End of Id.name * string list (* (target, labels) *)
| No_in of Id.name
| Feature_eq of qfn * qfn
type const = u_const * Loc.t
type pattern = {
pat_nodes: node list;
pat_edges: edge list;
pat_const: const list;
}
type graph = {
nodes: (Id.name * node) list;
edge: edge list;
}
type concat_item =
| Qfn_item of (string * string)
| String_item of string
type u_command =
| Del_edge_expl of (Id.name * Id.name * string)
| Del_edge_name of string
| Add_edge of (Id.name * Id.name * string)
| Shift_in of (Id.name*Id.name)
| Shift_out of (Id.name*Id.name)
| Shift_edge of (Id.name*Id.name)
| Merge_node of (Id.name*Id.name)
| New_neighbour of (Id.name * Id.name * string)
| Del_node of Id.name
| Del_feat of qfn
| Update_feat of qfn * concat_item list
type command = u_command * Loc.t
type rule = {
rule_id:Id.name;
pos_pattern: pattern;
neg_patterns: pattern list;
commands: command list;
rule_doc:string;
rule_loc: Loc.t;
}
type modul = {
module_id:Id.name;
local_labels: (string * string option) list;
bad_labels: string list;
rules: rule list;
confluent: bool;
module_doc:string;
mod_loc:Loc.t;
}
type sequence = {
seq_name:string;
seq_mod:string list;
seq_doc:string;
seq_loc:Loc.t;
}
(**
a GRS: graph rewriting system
*)
type module_or_include =
| Modul of modul
| Includ of string
type grs_with_include = {
domain_wi: domain;
labels_wi: (string * string option) list; (* the list of global edge labels *)
modules_wi: module_or_include list;
sequences_wi: sequence list;
}
type grs = {
domain: domain;
labels: (string * string option) list;
modules: modul list;
sequences: sequence list;
}
type gr = {
nodes: node list;
edges: edge list;
}
module AST_HTML = struct
let feat_values_tab_to_html = List_.to_string (fun x->x) " | "
let string_of_concat_item = function
| Qfn_item (n,f) -> sprintf "%s.%s" n f
| String_item s -> sprintf "\"%s\"" s
let string_of_qfn (node, feat_name) = sprintf "%s.%s" node feat_name
let buff_html_command ?(li_html=false) buff (u_command,_) =
bprintf buff " ";
if li_html then bprintf buff "<li>";
(match u_command with
| Del_edge_expl (n1,n2,label) -> bprintf buff "del_edge %s -[%s]-> %s" n1 label n2
| Del_edge_name name -> bprintf buff "del_edge %s" name
| Add_edge (n1,n2,label) -> bprintf buff "add_edge %s -[%s]-> %s" n1 label n2
| Shift_in (n1,n2) -> bprintf buff "shift_in %s ==> %s" n1 n2
| Shift_out (n1,n2) -> bprintf buff "shift_out %s ==> %s" n1 n2
| Shift_edge (n1,n2) -> bprintf buff "shift %s ==> %s" n1 n2
| Merge_node (n1,n2) -> bprintf buff "merge %s ==> %s" n1 n2
| New_neighbour (n1,n2,label) -> bprintf buff "add_node %s: <-[%s]- %s \n" n1 label n2
| Del_node n -> bprintf buff "del_node %s" n
| Update_feat (qfn,item_list) -> bprintf buff "%s = %s" (string_of_qfn qfn) (List_.to_string string_of_concat_item " + " item_list)
| Del_feat qfn -> bprintf buff "del_feat %s" (string_of_qfn qfn));
if li_html then bprintf buff "</li>\n" else bprintf buff ";\n"
let to_html_commands_pretty = function
| [] -> ""
| commands ->
let buff = Buffer.create 32 in
bprintf buff "<ul>\n";
List.iter (buff_html_command ~li_html:true buff) commands;
bprintf buff "</ul>\n";
Buffer.contents buff
let buff_html_feature buff (u_feature,_) =
bprintf buff "%s %s %s"
u_feature.name
(match u_feature.kind with Equality -> "=" | Disequality -> "<>")
(List_.to_string (fun x->x) ", " u_feature.values)
let buff_html_node buff (u_node,_) =
bprintf buff " %s [" u_node.node_id;
List.iter (buff_html_feature buff) u_node.fs;
bprintf buff "];\n"
let buff_html_edge buff (u_edge,_) =
bprintf buff " ";
bprintf buff "%s" (match u_edge.edge_id with Some n -> n^": " | None -> "");
bprintf buff "%s -[%s%s]-> %s;\n"
u_edge.src
(if u_edge.negative then "^" else "")
(List_.to_string (fun x->x) "|" u_edge.edge_labels)
u_edge.tar
let buff_html_const buff (u_const,_) =
bprintf buff " ";
(match u_const with
| Start (id,labels) -> bprintf buff "%s -[%s]-> *" id (List_.to_string (fun x->x) "|" labels)
| No_out id -> bprintf buff "%s -> *" id
| End (id,labels) -> bprintf buff "* -[%s]-> %s" (List_.to_string (fun x->x) "|" labels) id
| No_in id -> bprintf buff "* -> %s" id
| Feature_eq (qfn_l, qfn_r) -> bprintf buff "%s = %s" (string_of_qfn qfn_l) (string_of_qfn qfn_r));
bprintf buff "\n"
let buff_html_pos_pattern buff pos_pattern =
bprintf buff " <font color=\"purple\">match</font> <b>{</b>\n";
List.iter (buff_html_node buff) pos_pattern.pat_nodes;
List.iter (buff_html_edge buff) pos_pattern.pat_edges;
List.iter (buff_html_const buff) pos_pattern.pat_const;
bprintf buff " <b>}</b>\n"
let buff_html_neg_pattern buff neg_pattern =
bprintf buff " <font color=\"purple\">without</font> <b>{</b>\n";
List.iter (buff_html_node buff) neg_pattern.pat_nodes;
List.iter (buff_html_edge buff) neg_pattern.pat_edges;
List.iter (buff_html_const buff) neg_pattern.pat_const;
bprintf buff " <b>}</b>\n"
let to_html_rules rules =
let buff = Buffer.create 32 in
List.iter
(fun rule ->
bprintf buff " <font color=\"purple\">rule</font> %s <b>{</b>\n" rule.rule_id;
(* the match part *)
buff_html_pos_pattern buff rule.pos_pattern;
(* the without parts *)
List.iter (buff_html_neg_pattern buff) rule.neg_patterns;
(* the commands part *)
bprintf buff " <font color=\"purple\">commands</font> <b>{</b>\n";
List.iter (buff_html_command buff) rule.commands;
bprintf buff " <b>}</b>\n";
bprintf buff " <b>}</b>\n";
) rules;
Buffer.contents buff
end
src/ast.mli deleted 100644 → 0
View file @ f3e6e5dc
open Utils
type feature_spec =
| Closed of string * string list (* (the name, the set of atomic values) *)
| Open of string (* the name *)
type domain = feature_spec list
type feature_kind = Equality | Disequality
type u_feature = {
kind: feature_kind;
name: string;
values: string list;
}
type feature = u_feature * Loc.t
(* qualified feature name "A.lemma" *)
type qfn = string * string
type u_node = {
node_id: Id.name;
position: int option;
fs: feature list;
}
type node = u_node * Loc.t
type u_edge = {
edge_id: Id.name option;
src: Id.name;
edge_labels: string list;
tar: Id.name;
negative: bool;
}
type edge = u_edge * Loc.t
type u_const =
| Start of Id.name * string list (* (source, labels) *)
| No_out of Id.name
| End of Id.name * string list (* (target, labels) *)
| No_in of Id.name
| Feature_eq of qfn * qfn
type const = u_const * Loc.t
type pattern = {
pat_nodes: node list;
pat_edges: edge list;
pat_const: const list;
}
type concat_item =
| Qfn_item of (string * string)
| String_item of string
type u_command =
| Del_edge_expl of (Id.name * Id.name * string)
| Del_edge_name of string
| Add_edge of (Id.name * Id.name * string)
| Shift_in of (Id.name*Id.name)
| Shift_out of (Id.name*Id.name)
| Shift_edge of (Id.name*Id.name)
| Merge_node of (Id.name*Id.name)
| New_neighbour of (Id.name * Id.name * string)
| Del_node of Id.name
| Del_feat of qfn
| Update_feat of qfn * concat_item list
type command = u_command * Loc.t