author  skalberg 
Sun, 13 Feb 2005 17:15:14 +0100  
changeset 15531  08c8dad8e399 
parent 14981  e73f8140af78 
child 15570  8d8c70b41bab 
permissions  rwrr 
7765
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

1 
(* Title: Pure/Thy/thm_deps.ML 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

2 
ID: $Id$ 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

3 
Author: Stefan Berghofer, TU Muenchen 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

4 

fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

5 
Visualize dependencies of theorems. 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

6 
*) 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

7 

7785
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

8 
signature BASIC_THM_DEPS = 
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

9 
sig 
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

10 
val thm_deps : thm list > unit 
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

11 
end; 
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

12 

7765
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

13 
signature THM_DEPS = 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

14 
sig 
7785
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

15 
include BASIC_THM_DEPS 
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

16 
val enable : unit > unit 
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

17 
val disable : unit > unit 
7765
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

18 
end; 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

19 

fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

20 
structure ThmDeps : THM_DEPS = 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

21 
struct 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

22 

11530  23 
open Proofterm; 
7765
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

24 

11543
d61b913431c5
renamed `keep_derivs' to `proofs', and made an integer;
wenzelm
parents:
11530
diff
changeset

25 
fun enable () = if ! proofs = 0 then proofs := 1 else (); 
d61b913431c5
renamed `keep_derivs' to `proofs', and made an integer;
wenzelm
parents:
11530
diff
changeset

26 
fun disable () = proofs := 0; 
7765
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

27 

11530  28 
fun dest_thm_axm (PThm (nt, prf, _, _)) = (nt, prf) 
29 
 dest_thm_axm (PAxm (n, _, _)) = ((n ^ " (Ax)", []), MinProof []) 

30 
 dest_thm_axm _ = (("", []), MinProof []); 

7765
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

31 

11530  32 
fun make_deps_graph (p, AbsP (_, _, prf)) = make_deps_graph (p, prf) 
33 
 make_deps_graph (p, Abst (_, _, prf)) = make_deps_graph (p, prf) 

11612  34 
 make_deps_graph (p, prf1 %% prf2) = 
11530  35 
make_deps_graph (make_deps_graph (p, prf1), prf2) 
11612  36 
 make_deps_graph (p, prf % _) = make_deps_graph (p, prf) 
11530  37 
 make_deps_graph (p, MinProof prfs) = foldl make_deps_graph (p, prfs) 
38 
 make_deps_graph (p as (gra, parents), prf) = 

39 
let val ((name, tags), prf') = dest_thm_axm prf 

40 
in 

41 
if name <> "" andalso not (Drule.has_internal tags) then 

42 
if is_none (Symtab.lookup (gra, name)) then 

43 
let 

44 
val (gra', parents') = make_deps_graph ((gra, []), prf'); 

45 
val prefx = #1 (Library.split_last (NameSpace.unpack name)); 

46 
val session = 

47 
(case prefx of 

48 
(x :: _) => 

49 
(case ThyInfo.lookup_theory x of 

15531  50 
SOME thy => 
11530  51 
let val name = #name (Present.get_info thy) 
52 
in if name = "" then [] else [name] end 

15531  53 
 NONE => []) 
11530  54 
 _ => ["global"]); 
55 
in 

12239
ee360f910ec8
Now handles different theorems with same name more gracefully.
berghofe
parents:
11819
diff
changeset

56 
if name mem parents' then (gra', parents union parents') 
ee360f910ec8
Now handles different theorems with same name more gracefully.
berghofe
parents:
11819
diff
changeset

57 
else (Symtab.update ((name, 
11530  58 
{name = Sign.base_name name, ID = name, 
59 
dir = space_implode "/" (session @ prefx), 

60 
unfold = false, path = "", parents = parents'}), gra'), 

61 
name ins parents) 

62 
end 

63 
else (gra, name ins parents) 

64 
else 

65 
make_deps_graph ((gra, parents), prf') 

66 
end; 

7765
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

67 

fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

68 
fun thm_deps thms = 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

69 
let 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

70 
val _ = writeln "Generating graph ..."; 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

71 
val gra = map snd (Symtab.dest (fst (foldl make_deps_graph ((Symtab.empty, []), 
13530  72 
map Thm.proof_of thms)))); 
7765
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

73 
val path = File.tmp_path (Path.unpack "theorems.graph"); 
9450  74 
val _ = Present.write_graph gra path; 
7853  75 
val _ = system ("$ISATOOL browser d " ^ Path.pack (Path.expand path) ^ " &"); 
7765
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

76 
in () end; 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

77 

fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

78 
end; 
fa28bac7903c
New function thm_deps for visualizing dependencies of theorems.
berghofe
parents:
diff
changeset

79 

7785
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

80 
structure BasicThmDeps : BASIC_THM_DEPS = ThmDeps; 
c06825c396e8
Added functions for enabling and disabling derivations.
berghofe
parents:
7783
diff
changeset

81 
open BasicThmDeps; 