author | wenzelm |
Thu, 23 Oct 1997 12:43:07 +0200 | |
changeset 3976 | 1030dd79720b |
parent 3631 | 88a279998f90 |
child 3999 | 86c5bda38e9f |
permissions | -rw-r--r-- |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
1 |
(* Title: Pure/Thy/thm_database.ML |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
2 |
ID: $Id$ |
1221 | 3 |
Author: Carsten Clasohm and Tobias Nipkow |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
4 |
Copyright 1995 TU Muenchen |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
5 |
*) |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
6 |
|
3627 | 7 |
datatype thm_db = |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
8 |
ThmDB of {count: int, |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
9 |
thy_idx: (Sign.sg * (string list * int list)) list, |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
10 |
const_idx: ((int * (string * thm)) list) Symtab.table}; |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
11 |
(*count: number of theorems in database (used as unique ID for next thm) |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
12 |
thy_idx: constants and IDs of theorems |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
13 |
indexed by the theory's signature they belong to |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
14 |
const_idx: named theorems tagged by numbers and |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
15 |
indexed by the constants they contain*) |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
16 |
|
3627 | 17 |
signature THM_DATABASE = |
1512 | 18 |
sig |
3627 | 19 |
val thm_db: thm_db ref |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
20 |
val store_thm_db: string * thm -> thm |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
21 |
val delete_thm_db: theory -> unit |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
22 |
val thms_containing: string list -> (string * thm) list |
1221 | 23 |
val findI: int -> (string * thm)list |
24 |
val findEs: int -> (string * thm)list |
|
25 |
val findE: int -> int -> (string * thm)list |
|
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
26 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
27 |
val store_thm : string * thm -> thm |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
28 |
val bind_thm : string * thm -> unit |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
29 |
val qed : string -> unit |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
30 |
val qed_thm : thm ref |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
31 |
val qed_goal : string -> theory -> string |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
32 |
-> (thm list -> tactic list) -> unit |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
33 |
val qed_goalw : string -> theory -> thm list -> string |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
34 |
-> (thm list -> tactic list) -> unit |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
35 |
val get_thm : theory -> string -> thm |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
36 |
val thms_of : theory -> (string * thm) list |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
37 |
val delete_thms : string -> unit |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
38 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
39 |
val print_theory : theory -> unit |
1512 | 40 |
end; |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
41 |
|
3627 | 42 |
structure ThmDatabase: THM_DATABASE = |
1221 | 43 |
struct |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
44 |
|
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
45 |
open ThyInfo BrowserInfo; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
46 |
|
1221 | 47 |
(*** ignore and top_const could be turned into functor-parameters, but are |
48 |
currently identical for all object logics ***) |
|
49 |
||
50 |
(* Constants not to be used for theorem indexing *) |
|
51 |
val ignore = ["Trueprop", "all", "==>", "=="]; |
|
52 |
||
53 |
(* top_const: main constant, ignoring Trueprop *) |
|
54 |
fun top_const (_ $ t) = (case head_of t of Const(c,_) => Some c |
|
1749 | 55 |
| _ => None) |
56 |
| top_const _ = None; |
|
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
57 |
|
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
58 |
(*Symtab which associates a constant with a list of theorems that contain the |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
59 |
constant (theorems are tagged with numbers)*) |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
60 |
val thm_db = ref (ThmDB |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
61 |
{count = 0, thy_idx = []:(Sign.sg * (string list * int list)) list, |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
62 |
const_idx = Symtab.make ([]:(string * ((int * (string * thm)) list)) list)}); |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
63 |
|
1272 | 64 |
(*List all relevant constants a term contains*) |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
65 |
fun list_consts t = |
1136
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
66 |
let fun consts (Const (c, _)) = if c mem ignore then [] else [c] |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
67 |
| consts (Free _) = [] |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
68 |
| consts (Var _) = [] |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
69 |
| consts (Bound _) = [] |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
70 |
| consts (Abs (_, _, t)) = consts t |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
71 |
| consts (t1$t2) = (consts t1) union (consts t2); |
1136
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
72 |
in distinct (consts t) end; |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
73 |
|
1272 | 74 |
(*Store a theorem in database*) |
1236
b54d51df9065
added check for duplicate theorems in theorem database;
clasohm
parents:
1230
diff
changeset
|
75 |
fun store_thm_db (named_thm as (name, thm)) = |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
76 |
let val {prop, hyps, sign, ...} = rep_thm thm; |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
77 |
|
1136
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
78 |
val consts = distinct (flat (map list_consts (prop :: hyps))); |
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
79 |
|
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
80 |
val ThmDB {count, thy_idx, const_idx} = !thm_db; |
1141
a94c0ab9a3ed
commented thms_unifying_with out; placed thm_db into signature again;
clasohm
parents:
1137
diff
changeset
|
81 |
|
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
82 |
fun update_thys [] = [(sign, (consts, [count]))] |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
83 |
| update_thys ((thy as (thy_sign, (thy_consts, thy_nums))) :: ts) = |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
84 |
if Sign.eq_sg (sign, thy_sign) then |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
85 |
(thy_sign, (thy_consts union consts, count :: thy_nums)) :: ts |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
86 |
else thy :: update_thys ts; |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
87 |
|
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
88 |
val tagged_thm = (count, named_thm); |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
89 |
|
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
90 |
fun update_db _ [] result = Some result |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
91 |
| update_db checked (c :: cs) result = |
1236
b54d51df9065
added check for duplicate theorems in theorem database;
clasohm
parents:
1230
diff
changeset
|
92 |
let |
b54d51df9065
added check for duplicate theorems in theorem database;
clasohm
parents:
1230
diff
changeset
|
93 |
val old_thms = Symtab.lookup_multi (result, c); |
b54d51df9065
added check for duplicate theorems in theorem database;
clasohm
parents:
1230
diff
changeset
|
94 |
|
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
95 |
val duplicate = |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
96 |
if checked then false |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
97 |
else case find_first (fn (_, (n, _)) => n = name) old_thms of |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
98 |
Some (_, (_, t)) => eq_thm (t, thm) |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
99 |
| None => false |
1308 | 100 |
in if duplicate then None |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
101 |
else update_db true |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
102 |
cs (Symtab.update ((c, tagged_thm :: old_thms), result)) |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
103 |
end; |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
104 |
|
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
105 |
val const_idx' = update_db false consts const_idx; |
1580
e3fd931e6095
Added some functions which allow redirection of Isabelle's output
berghofe
parents:
1512
diff
changeset
|
106 |
in if consts = [] then warning ("Theorem " ^ name ^ |
1136
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
107 |
" cannot be stored in ThmDB\n\t because it \ |
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
108 |
\contains no or only ignored constants.") |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
109 |
else if is_some const_idx' then |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
110 |
thm_db := ThmDB {count = count+1, thy_idx = update_thys thy_idx, |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
111 |
const_idx = the const_idx'} |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
112 |
else (); |
1236
b54d51df9065
added check for duplicate theorems in theorem database;
clasohm
parents:
1230
diff
changeset
|
113 |
thm |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
114 |
end; |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
115 |
|
1272 | 116 |
(*Remove all theorems with given signature from database*) |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
117 |
fun delete_thm_db thy = |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
118 |
let |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
119 |
val sign = sign_of thy; |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
120 |
|
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
121 |
val ThmDB {count, thy_idx, const_idx} = !thm_db; |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
122 |
|
1272 | 123 |
(*Remove theory from thy_idx and get the data associated with it*) |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
124 |
fun update_thys [] result = (result, [], []) |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
125 |
| update_thys ((thy as (thy_sign, (thy_consts, thy_nums))) :: ts) |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
126 |
result = |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
127 |
if Sign.eq_sg (sign, thy_sign) then |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
128 |
(result @ ts, thy_consts, thy_nums) |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
129 |
else update_thys ts (thy :: result); |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
130 |
|
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
131 |
val (thy_idx', thy_consts, thy_nums) = update_thys thy_idx []; |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
132 |
|
1272 | 133 |
(*Remove all theorems belonging to a theory*) |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
134 |
fun update_db [] result = result |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
135 |
| update_db (c :: cs) result = |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
136 |
let val thms' = filter_out (fn (num, _) => num mem thy_nums) |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
137 |
(Symtab.lookup_multi (result, c)); |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
138 |
in update_db cs (Symtab.update ((c, thms'), result)) end; |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
139 |
in thm_db := ThmDB {count = count, thy_idx = thy_idx', |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
140 |
const_idx = update_db thy_consts const_idx} |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
141 |
end; |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
142 |
|
1272 | 143 |
(*Intersection of two theorem lists with descending tags*) |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
144 |
infix desc_inter; |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
145 |
fun ([] : (int*'a) list) desc_inter (ys : (int*'a) list) = [] |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
146 |
| xs desc_inter [] = [] |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
147 |
| (xss as ((x as (xi,_)) :: xs)) desc_inter (yss as ((yi,_) :: ys)) = |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
148 |
if xi = yi then x :: (xs desc_inter ys) |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
149 |
else if xi > yi then xs desc_inter yss |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
150 |
else xss desc_inter ys; |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
151 |
|
1272 | 152 |
(*Get all theorems from database that contain a list of constants*) |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
153 |
fun thms_containing constants = |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
154 |
let fun collect [] _ result = map snd result |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
155 |
| collect (c :: cs) first result = |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
156 |
let val ThmDB {const_idx, ...} = !thm_db; |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
157 |
|
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
158 |
val new_thms = Symtab.lookup_multi (const_idx, c); |
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
159 |
in collect cs false (if first then new_thms |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
160 |
else (result desc_inter new_thms)) |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
161 |
end; |
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
162 |
|
1134 | 163 |
val look_for = constants \\ ignore; |
164 |
in if null look_for then |
|
1136
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
165 |
error ("No or only ignored constants were specified for theorem \ |
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
166 |
\database search:\n " ^ commas (map quote ignore)) |
1134 | 167 |
else (); |
168 |
collect look_for true [] end; |
|
1136
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
169 |
|
1221 | 170 |
val intro_const = top_const o concl_of; |
171 |
||
172 |
fun elim_const thm = case prems_of thm of [] => None | p::_ => top_const(p); |
|
173 |
||
174 |
(* In case faster access is necessary, the thm db should provide special |
|
175 |
functions |
|
176 |
||
177 |
index_intros, index_elims: string -> (string * thm) list |
|
178 |
||
179 |
where thm [| A1 ; ...; An |] ==> B is returned by |
|
180 |
- index_intros c if B is of the form c t1 ... tn |
|
181 |
- index_elims c if A1 is of the form c t1 ... tn |
|
182 |
*) |
|
183 |
||
184 |
(* could be provided by thm db *) |
|
185 |
fun index_intros c = |
|
186 |
let fun topc(_,thm) = intro_const thm = Some(c); |
|
187 |
val named_thms = thms_containing [c] |
|
188 |
in filter topc named_thms end; |
|
189 |
||
190 |
(* could be provided by thm db *) |
|
191 |
fun index_elims c = |
|
192 |
let fun topc(_,thm) = elim_const thm = Some(c); |
|
193 |
val named_thms = thms_containing [c] |
|
194 |
in filter topc named_thms end; |
|
195 |
||
196 |
(*assume that parameters have unique names*) |
|
197 |
fun goal_params i = |
|
198 |
let val gi = getgoal i |
|
199 |
val frees = map Free (Logic.strip_params gi) |
|
200 |
in (gi,frees) end; |
|
201 |
||
202 |
fun concl_of_goal i = |
|
203 |
let val (gi,frees) = goal_params i |
|
204 |
val B = Logic.strip_assums_concl gi |
|
205 |
in subst_bounds(frees,B) end; |
|
206 |
||
207 |
fun prems_of_goal i = |
|
208 |
let val (gi,frees) = goal_params i |
|
209 |
val As = Logic.strip_assums_hyp gi |
|
210 |
in map (fn A => subst_bounds(frees,A)) As end; |
|
211 |
||
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
212 |
fun select_match(obj, signobj, named_thms, extract) = |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
213 |
let fun matches(prop, tsig) = |
1221 | 214 |
case extract prop of |
215 |
None => false |
|
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
216 |
| Some pat => Pattern.matches tsig (pat, obj); |
1221 | 217 |
|
1654
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
218 |
fun substsize(prop, tsig) = |
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
219 |
let val Some pat = extract prop |
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
220 |
val (_,subst) = Pattern.match tsig (pat,obj) |
2150 | 221 |
in foldl op+ |
222 |
(0, map (fn (_,t) => size_of_term t) subst) |
|
223 |
end |
|
1654
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
224 |
|
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
225 |
fun thm_order ((p0:int,s0:int,_),(p1,s1,_)) = |
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
226 |
(((p0=0 andalso p1=0) orelse (p0<>0 andalso p1<>0)) andalso s0<=s1) |
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
227 |
orelse (p0=0 andalso p1<>0) |
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
228 |
|
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
229 |
fun select((p as (_,thm))::named_thms, sels) = |
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
230 |
let val {prop, sign, ...} = rep_thm thm |
1221 | 231 |
in select(named_thms, |
1262
8f40ff1299d8
added removal of theorems if theory is to be reloaded; changed functions for
clasohm
parents:
1245
diff
changeset
|
232 |
if Sign.subsig(sign, signobj) andalso |
1230 | 233 |
matches(prop,#tsig(Sign.rep_sg signobj)) |
1654
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
234 |
then |
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
235 |
(nprems_of thm,substsize(prop,#tsig(Sign.rep_sg signobj)),p)::sels |
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
236 |
else sels) |
1136
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
237 |
end |
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
238 |
| select([],sels) = sels |
1221 | 239 |
|
1654
faa643c33ee6
select_match now sorts list of matching theorems according to the
berghofe
parents:
1580
diff
changeset
|
240 |
in map (fn (_,_,t) => t) (sort thm_order (select(named_thms, []))) end; |
1221 | 241 |
|
242 |
fun find_matching(prop,sign,index,extract) = |
|
243 |
(case top_const prop of |
|
244 |
Some c => select_match(prop,sign,index c,extract) |
|
245 |
| _ => []); |
|
246 |
||
247 |
fun find_intros(prop,sign) = |
|
248 |
find_matching(prop,sign,index_intros,Some o Logic.strip_imp_concl); |
|
1136
3910c96551d1
fixed bug in thms_containing; changed error/warning messages;
clasohm
parents:
1134
diff
changeset
|
249 |
|
1221 | 250 |
fun find_elims sign prop = |
251 |
let fun major prop = case Logic.strip_imp_prems prop of |
|
252 |
[] => None | p::_ => Some p |
|
253 |
in find_matching(prop,sign,index_elims,major) end; |
|
254 |
||
255 |
fun findI i = find_intros(concl_of_goal i,#sign(rep_thm(topthm()))); |
|
256 |
||
257 |
fun findEs i = |
|
1230 | 258 |
let fun eq_nth((n1,th1),(n2,th2)) = n1=n2 andalso eq_thm(th1,th2); |
259 |
val sign = #sign(rep_thm(topthm())) |
|
260 |
val thmss = map (find_elims sign) (prems_of_goal i) |
|
261 |
in foldl (gen_union eq_nth) ([],thmss) end; |
|
1221 | 262 |
|
263 |
fun findE i j = |
|
264 |
let val sign = #sign(rep_thm(topthm())) |
|
265 |
in find_elims sign (nth_elem(j-1, prems_of_goal i)) end; |
|
266 |
||
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
267 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
268 |
(*** Store and retrieve theorems ***) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
269 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
270 |
(** Store theorems **) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
271 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
272 |
(*Store a theorem in the thy_info of its theory, |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
273 |
and in the theory's HTML file*) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
274 |
fun store_thm (name, thm) = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
275 |
let |
3976 | 276 |
val (thy_name, {path, children, parents, thy_time, ml_time, |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
277 |
theory, thms, methods, data}) = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
278 |
thyinfo_of_sign (#sign (rep_thm thm)) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
279 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
280 |
val (thms', duplicate) = (Symtab.update_new ((name, thm), thms), false) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
281 |
handle Symtab.DUPLICATE s => |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
282 |
(if eq_thm (the (Symtab.lookup (thms, name)), thm) then |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
283 |
(warning ("Theory database already contains copy of\ |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
284 |
\ theorem " ^ quote name); |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
285 |
(thms, true)) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
286 |
else error ("Duplicate theorem name " ^ quote s |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
287 |
^ " used in theory database")); |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
288 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
289 |
(*Label this theorem*) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
290 |
val thm' = Thm.name_thm (name, thm) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
291 |
in |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
292 |
loaded_thys := Symtab.update |
3976 | 293 |
((thy_name, {path = path, children = children, parents = parents, |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
294 |
thy_time = thy_time, ml_time = ml_time, |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
295 |
theory = theory, thms = thms', |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
296 |
methods = methods, data = data}), |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
297 |
!loaded_thys); |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
298 |
thm_to_html thm name; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
299 |
if duplicate then thm' else store_thm_db (name, thm') |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
300 |
end; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
301 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
302 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
303 |
(*Store result of proof in loaded_thys and as ML value*) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
304 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
305 |
val qed_thm = ref flexpair_def(*dummy*); |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
306 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
307 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
308 |
fun bind_thm (name, thm) = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
309 |
(qed_thm := store_thm (name, (standard thm)); |
3631 | 310 |
use_strings ["val " ^ name ^ " = !qed_thm;"]); |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
311 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
312 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
313 |
fun qed name = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
314 |
(qed_thm := store_thm (name, result ()); |
3631 | 315 |
use_strings ["val " ^ name ^ " = !qed_thm;"]); |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
316 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
317 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
318 |
fun qed_goal name thy agoal tacsf = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
319 |
(qed_thm := store_thm (name, prove_goal thy agoal tacsf); |
3631 | 320 |
use_strings ["val " ^ name ^ " = !qed_thm;"]); |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
321 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
322 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
323 |
fun qed_goalw name thy rths agoal tacsf = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
324 |
(qed_thm := store_thm (name, prove_goalw thy rths agoal tacsf); |
3631 | 325 |
use_strings ["val " ^ name ^ " = !qed_thm;"]); |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
326 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
327 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
328 |
(** Retrieve theorems **) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
329 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
330 |
(*Get all theorems belonging to a given theory*) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
331 |
fun thmtab_of_thy thy = |
3976 | 332 |
let val (_, {thms, ...}) = thyinfo_of_sign (sign_of thy); |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
333 |
in thms end; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
334 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
335 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
336 |
fun thmtab_of_name name = |
3976 | 337 |
let val {thms, ...} = the (get_thyinfo name); |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
338 |
in thms end; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
339 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
340 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
341 |
(*Get a stored theorem specified by theory and name. *) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
342 |
fun get_thm thy name = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
343 |
let fun get [] [] searched = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
344 |
raise THEORY ("get_thm: no theorem " ^ quote name, [thy]) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
345 |
| get [] ng searched = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
346 |
get (ng \\ searched) [] searched |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
347 |
| get (t::ts) ng searched = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
348 |
(case Symtab.lookup (thmtab_of_name t, name) of |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
349 |
Some thm => thm |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
350 |
| None => get ts (ng union (parents_of_name t)) (t::searched)); |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
351 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
352 |
val (tname, _) = thyinfo_of_sign (sign_of thy); |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
353 |
in get [tname] [] [] end; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
354 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
355 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
356 |
(*Get stored theorems of a theory (original derivations) *) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
357 |
val thms_of = Symtab.dest o thmtab_of_thy; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
358 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
359 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
360 |
(*Remove theorems associated with a theory from theory and theorem database*) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
361 |
fun delete_thms tname = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
362 |
let |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
363 |
val tinfo = case get_thyinfo tname of |
3976 | 364 |
Some ({path, children, parents, thy_time, ml_time, theory, |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
365 |
methods, data, ...}) => |
3976 | 366 |
{path = path, children = children, parents = parents, |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
367 |
thy_time = thy_time, ml_time = ml_time, |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
368 |
theory = theory, thms = Symtab.null, |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
369 |
methods = methods, data = data} |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
370 |
| None => error ("Theory " ^ tname ^ " not stored by loader"); |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
371 |
|
3976 | 372 |
val {theory, ...} = tinfo; |
3601
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
373 |
in loaded_thys := Symtab.update ((tname, tinfo), !loaded_thys); |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
374 |
case theory of |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
375 |
Some t => delete_thm_db t |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
376 |
| None => () |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
377 |
end; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
378 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
379 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
380 |
(*** Print theory ***) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
381 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
382 |
fun print_thms thy = |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
383 |
let |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
384 |
val thms = thms_of thy; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
385 |
fun prt_thm (s, th) = Pretty.block [Pretty.str (s ^ ":"), Pretty.brk 1, |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
386 |
Pretty.quote (pretty_thm th)]; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
387 |
in |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
388 |
Pretty.writeln (Pretty.big_list "stored theorems:" (map prt_thm thms)) |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
389 |
end; |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
390 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
391 |
|
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
392 |
fun print_theory thy = (Display.print_theory thy; print_thms thy); |
43c7912aac8d
Moved "qed" - functions etc. from thy_read.ML to thm_database.ML.
berghofe
parents:
2150
diff
changeset
|
393 |
|
1132
dfb29abcf3c2
added theorem database which contains axioms and theorems indexed by the
clasohm
parents:
diff
changeset
|
394 |
end; |