Commit b844a987 authored by bguillaum's avatar bguillaum

fix htmj and dot output

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/semagramme/libcaml-grew/trunk@6876 7838e531-6607-4d57-9587-6c381814729c
parent ec7bb6fb
......@@ -67,7 +67,8 @@ let rule_page_text previous next rule m ast file = "
"</div>
<center><h1>Rule <a href=\""^m.Ast.module_id^".html\">"^m.Ast.module_id^"</a>.<div class=\"module_title\">"^rule.Ast.rule_id^"</div></h1></center>
<br/><br/><div id=doc>"^rule.Ast.rule_doc^"</div>"^
(* disable domain
(if (List.length ast.Ast.domain > 0) then (
"<h6>Features domain</h6><code class=\"code\">"^
(let rec compute tab = match tab with
......@@ -77,7 +78,9 @@ let rule_page_text previous next rule m ast file = "
) else (
""
))^"</code>"^
*)
(* disable Labels
"<br/><h6>Labels</h6>"^
(if (List.length ast.Ast.labels > 0) then (
"<div class=\"h7\">Inherited from global</div>
......@@ -118,10 +121,14 @@ let rule_page_text previous next rule m ast file = "
)^
"</code>"
) else ( ""))^
*)
(*
"<br/>
<br/><h6>Commands</h6>
<code class=code><pre>"^(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_HTML.to_html_rules [rule])^
"</pre><br/>
......
......@@ -182,16 +182,18 @@ module AST_HTML = struct
bprintf buff "</ul>\n";
Buffer.contents buff
let buff_html_feature buff (u_feature,_) =
bprintf buff "%s" u_feature.Ast.name;
let html_feature (u_feature,_) =
match u_feature.Ast.kind with
| Ast.Equality values -> bprintf buff " = %s" (List_.to_string (fun x->x) ", " values)
| Ast.Disequality values -> bprintf buff " <> %s" (List_.to_string (fun x->x) ", " values)
| Ast.Param index -> bprintf buff " = %s" index
| Ast.Equality values ->
sprintf "%s=%s" u_feature.Ast.name (List_.to_string (fun x->x) "|" values)
| Ast.Disequality values ->
sprintf "%s<>%s" u_feature.Ast.name (List_.to_string (fun x->x) "|" values)
| Ast.Param index ->
sprintf "%s=%s" u_feature.Ast.name index
let buff_html_node buff (u_node,_) =
bprintf buff " %s [" u_node.Ast.node_id;
List.iter (buff_html_feature buff) u_node.Ast.fs;
bprintf buff "%s" (String.concat ", " (List.map html_feature u_node.Ast.fs));
bprintf buff "];\n"
let buff_html_edge buff (u_edge,_) =
......@@ -222,7 +224,7 @@ module AST_HTML = struct
bprintf buff " <b>}</b>\n"
let buff_html_neg_pattern buff neg_pattern =
bprintf buff " <font color=\"purple\">without</font> <b>{</b>\n";
bprintf buff " <font color=\"purple\">without</font> <b>{</b>\n";
List.iter (buff_html_node buff) neg_pattern.Ast.pat_nodes;
List.iter (buff_html_edge buff) neg_pattern.Ast.pat_edges;
List.iter (buff_html_const buff) neg_pattern.Ast.pat_const;
......@@ -241,7 +243,7 @@ module AST_HTML = struct
List.iter (buff_html_neg_pattern buff) rule.Ast.neg_patterns;
(* the commands part *)
bprintf buff " <font color=\"purple\">commands</font> <b>{</b>\n";
bprintf buff " <font color=\"purple\">commands</font> <b>{</b>\n";
List.iter (buff_html_command buff) rule.Ast.commands;
bprintf buff " <b>}</b>\n";
......
......@@ -43,7 +43,12 @@ module G_feature = struct
(name, atom)
| _ -> Error.build "Illegal feature declaration in Graph (must be '=' and atomic)"
let to_string (feat_name, value) = sprintf "%s=%s" feat_name value
let to_string (feat_name, feat_val) = sprintf "%s=%s" feat_name feat_val
let to_dot (feat_name, feat_val) =
match Str.split (Str.regexp ":C:") feat_val with
| [] -> Error.bug "[G_feature.to_dot] feature value '%s'" feat_val
| fv::_ -> sprintf "%s=%s" feat_name fv
end
(* ==================================================================================================== *)
......@@ -143,8 +148,8 @@ module G_fs = struct
let to_dot ?main_feat t =
match get_main ?main_feat t with
| (None, _) -> List_.to_string G_feature.to_string "\\n" t
| (Some atom, sub) -> sprintf "%s|%s" atom (List_.to_string G_feature.to_string "\\n" sub)
| (None, _) -> List_.to_string G_feature.to_dot "\\n" t
| (Some atom, sub) -> sprintf "%s|%s" atom (List_.to_string G_feature.to_dot "\\n" sub)
let to_dep ?main_feat t =
let (main_opt, sub) = get_main ?main_feat t in
......
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