47412
|
1 |
(* Title: HOL/TPTP/TPTP_Parser/tptp_to_dot.ML
|
|
2 |
Author: Nik Sultana, Cambridge University Computer Laboratory
|
|
3 |
|
|
4 |
Translates parsed TPTP proofs into DOT format. This can then be processed
|
|
5 |
by an accompanying script to translate the proofs into other formats.
|
|
6 |
*)
|
|
7 |
|
|
8 |
signature TPTP_TO_DOT =
|
|
9 |
sig
|
|
10 |
(*DOT-drawing function, works directly on parsed TPTP*)
|
|
11 |
val tptp_dot_node : bool -> bool -> TPTP_Syntax.tptp_line -> string
|
|
12 |
|
|
13 |
(*Parse a (LEO-II+E) proof and produce a DOT file*)
|
|
14 |
val write_proof_dot : string -> string -> unit
|
|
15 |
end
|
|
16 |
|
|
17 |
structure TPTP_To_Dot : TPTP_TO_DOT =
|
|
18 |
struct
|
|
19 |
|
|
20 |
open TPTP_Syntax
|
|
21 |
|
|
22 |
(*Draw an arc between two nodes*)
|
|
23 |
fun dot_arc reverse (src, label) target =
|
|
24 |
"\"" ^ (if reverse then target else src) ^
|
|
25 |
"\" -> \"" ^ (if reverse then src else target) ^
|
|
26 |
"\" " ^ (case label of
|
|
27 |
NONE => ""
|
|
28 |
| SOME label => "[label=\"" ^ label ^ "\"];") ^ "\n"
|
|
29 |
|
|
30 |
(*Node shapes indicate the role of the related clauses.*)
|
|
31 |
exception NO_ROLE_SHAPE
|
|
32 |
fun the_role_shape role =
|
|
33 |
case role of
|
|
34 |
Role_Axiom => "triangle"
|
|
35 |
| Role_Hypothesis => "???"
|
|
36 |
| Role_Definition => raise NO_ROLE_SHAPE
|
|
37 |
| Role_Assumption => "???"
|
|
38 |
| Role_Lemma => "???"
|
|
39 |
| Role_Theorem => "???"
|
|
40 |
| Role_Conjecture => "house"
|
|
41 |
| Role_Negated_Conjecture => "invhouse"
|
|
42 |
| Role_Plain => "circle"
|
|
43 |
| Role_Fi_Domain => raise NO_ROLE_SHAPE
|
|
44 |
| Role_Fi_Functors => raise NO_ROLE_SHAPE
|
|
45 |
| Role_Fi_Predicates => raise NO_ROLE_SHAPE
|
|
46 |
| Role_Type => raise NO_ROLE_SHAPE
|
|
47 |
| Role_Unknown => raise NO_ROLE_SHAPE
|
|
48 |
|
|
49 |
fun have_role_shape role =
|
|
50 |
(the_role_shape role; true)
|
|
51 |
handle NO_ROLE_SHAPE => false
|
|
52 |
| exc => raise exc
|
|
53 |
|
|
54 |
(*Different styles are applied to nodes relating to clauses written in
|
|
55 |
difference languages.*)
|
|
56 |
exception NO_LANG_STYLE
|
|
57 |
fun the_lang_style lang =
|
|
58 |
case lang of
|
|
59 |
CNF => "dotted"
|
|
60 |
| FOF => "dashed"
|
|
61 |
| THF => "filled"
|
|
62 |
| _ => raise NO_LANG_STYLE
|
|
63 |
|
|
64 |
(*Does the formula just consist of "$false"?*)
|
|
65 |
fun is_last_line CNF (Pred (Interpreted_Logic False, [])) = true
|
|
66 |
| is_last_line THF (Atom (THF_Atom_term
|
|
67 |
(Term_Func (Interpreted_Logic False, [])))) = true
|
|
68 |
| is_last_line _ _ = false
|
|
69 |
|
|
70 |
fun tptp_dot_node with_label reverse_arrows
|
|
71 |
(Annotated_Formula (_, lang, n, role, fmla_tptp, annot)) =
|
|
72 |
(*don't expect to find 'Include' in proofs*)
|
|
73 |
if have_role_shape role
|
|
74 |
then
|
|
75 |
"\"" ^ n ^
|
|
76 |
"\" [shape=\"" ^
|
|
77 |
(if is_last_line lang fmla_tptp then "doublecircle"
|
|
78 |
else the_role_shape role) ^
|
|
79 |
"\", style=\"" ^ the_lang_style lang ^
|
|
80 |
"\", label=\"" ^ n ^ "\"];\n" ^
|
|
81 |
(case TPTP_Proof.extract_inference_info annot of
|
|
82 |
NONE => ""
|
|
83 |
| SOME (rule, ids) =>
|
|
84 |
map (dot_arc reverse_arrows
|
|
85 |
(n, if with_label then SOME rule else NONE)) ids
|
47426
|
86 |
|> implode)
|
47412
|
87 |
else ""
|
|
88 |
|
|
89 |
(*FIXME add opts to label arcs etc*)
|
|
90 |
fun write_proof_dot input_file output_file =
|
|
91 |
let
|
|
92 |
(*rankdir=\"LR\";\n*)
|
|
93 |
val defaults =
|
|
94 |
"node[fixedsize=true];\n" ^
|
|
95 |
"node[width=.5];\n" ^
|
|
96 |
"node[shape=plaintext];\n" ^
|
|
97 |
"node[fillcolor=lightgray];\n" ^
|
|
98 |
"node[fontsize=40];\n" ^
|
|
99 |
"edge[dir=none];\n"
|
|
100 |
in
|
|
101 |
TPTP_Parser.parse_file input_file
|
|
102 |
|> map (tptp_dot_node false true)
|
47426
|
103 |
|> implode
|
47412
|
104 |
|> (fn str => "digraph ProofGraph {\n" ^ defaults ^ str ^ "}")
|
|
105 |
|> File.write (Path.explode output_file)
|
|
106 |
end
|
|
107 |
|
|
108 |
end
|