15 val show_hyps: bool ref |
15 val show_hyps: bool ref |
16 val pretty_thm: thm -> Pretty.T |
16 val pretty_thm: thm -> Pretty.T |
17 val verbose: bool ref |
17 val verbose: bool ref |
18 val print_binds: context -> unit |
18 val print_binds: context -> unit |
19 val print_thms: context -> unit |
19 val print_thms: context -> unit |
|
20 val strings_of_prems: context -> string list |
20 val strings_of_context: context -> string list |
21 val strings_of_context: context -> string list |
21 val print_proof_data: theory -> unit |
22 val print_proof_data: theory -> unit |
22 val init: theory -> context |
23 val init: theory -> context |
23 val read_typ: context -> string -> typ |
24 val read_typ: context -> string -> typ |
24 val cert_typ: context -> typ -> typ |
25 val cert_typ: context -> typ -> typ |
110 |
111 |
111 |
112 |
112 (** print context information **) |
113 (** print context information **) |
113 |
114 |
114 val show_hyps = ref false; |
115 val show_hyps = ref false; |
115 fun pretty_thm th = setmp Display.show_hyps (! show_hyps) Display.pretty_thm th; |
116 |
|
117 fun pretty_thm thm = |
|
118 if ! show_hyps then setmp Display.show_hyps true Display.pretty_thm_no_quote thm |
|
119 else Display.pretty_cterm (#prop (Thm.crep_thm thm)); |
116 |
120 |
117 val verbose = ref false; |
121 val verbose = ref false; |
118 fun verb f x = if ! verbose then f x else []; |
122 fun verb f x = if ! verbose then f x else []; |
119 val verb_string = verb (Library.single o Pretty.string_of); |
123 val verb_string = verb (Library.single o Pretty.string_of); |
120 |
124 |
128 end; |
132 end; |
129 |
133 |
130 |
134 |
131 (* term bindings *) |
135 (* term bindings *) |
132 |
136 |
133 fun strings_of_binds (Context {thy, binds, ...}) = |
137 fun strings_of_binds (ctxt as Context {binds, ...}) = |
134 let |
138 let |
135 val prt_term = Sign.pretty_term (Theory.sign_of thy); |
139 val prt_term = Sign.pretty_term (sign_of ctxt); |
136 fun pretty_bind (xi, (t, T)) = prt_term (Logic.mk_equals (Var (xi, T), t)); |
140 fun pretty_bind (xi, (t, T)) = prt_term (Logic.mk_equals (Var (xi, T), t)); |
137 in |
141 in |
138 if Vartab.is_empty binds andalso not (! verbose) then [] |
142 if Vartab.is_empty binds andalso not (! verbose) then [] |
139 else [Pretty.string_of (Pretty.big_list "Term bindings:" |
143 else [Pretty.string_of (Pretty.big_list "term bindings:" |
140 (map pretty_bind (Vartab.dest binds)))] |
144 (map pretty_bind (Vartab.dest binds)))] |
141 end; |
145 end; |
142 |
146 |
143 val print_binds = seq writeln o strings_of_binds; |
147 val print_binds = seq writeln o strings_of_binds; |
144 |
148 |
145 |
149 |
146 (* local theorems *) |
150 (* local theorems *) |
147 |
151 |
148 fun strings_of_thms (Context {thms, ...}) = |
152 fun strings_of_thms (Context {thms, ...}) = |
149 strings_of_items pretty_thm "Local theorems:" (Symtab.dest thms); |
153 strings_of_items pretty_thm "local theorems:" (Symtab.dest thms); |
150 |
154 |
151 val print_thms = seq writeln o strings_of_thms; |
155 val print_thms = seq writeln o strings_of_thms; |
152 |
156 |
153 |
157 |
154 (* main context *) |
158 (* main context *) |
155 |
159 |
156 fun strings_of_context (ctxt as Context {thy, data = _, asms = (_, (fixes, _)), binds = _, |
160 fun strings_of_prems ctxt = |
157 thms = _, defs = (types, sorts, maxidx, used)}) = |
161 (case prems_of ctxt of |
158 let |
162 [] => [] |
159 val sign = Theory.sign_of thy; |
163 | prems => [Pretty.string_of (Pretty.big_list "prems:" (map pretty_thm prems))]); |
160 val prems = prems_of ctxt; |
164 |
|
165 fun strings_of_context (ctxt as Context {asms = (_, (fixes, _)), |
|
166 defs = (types, sorts, maxidx, used), ...}) = |
|
167 let |
|
168 val sign = sign_of ctxt; |
161 |
169 |
162 val prt_term = Sign.pretty_term sign; |
170 val prt_term = Sign.pretty_term sign; |
163 val prt_typ = Sign.pretty_typ sign; |
171 val prt_typ = Sign.pretty_typ sign; |
164 val prt_sort = Sign.pretty_sort sign; |
172 val prt_sort = Sign.pretty_sort sign; |
165 |
173 |
166 (*theory*) |
174 (*theory*) |
167 val pretty_thy = Pretty.block [Pretty.str "Theory:", Pretty.brk 1, Sign.pretty_sg sign]; |
175 val pretty_thy = Pretty.block [Pretty.str "Theory:", Pretty.brk 1, Sign.pretty_sg sign]; |
168 |
176 |
169 (*fixes*) |
177 (*fixes*) |
170 fun prt_fixes xs = Pretty.block (Pretty.str "Fixed variables:" :: Pretty.brk 1 :: |
178 fun prt_fixes xs = Pretty.block (Pretty.str "fixed variables:" :: Pretty.brk 1 :: |
171 Pretty.commas (map (fn (x, x') => Pretty.str (x ^ " = " ^ x')) xs)); |
179 Pretty.commas (map (fn (x, x') => Pretty.str (x ^ " = " ^ x')) xs)); |
172 |
180 |
173 |
181 |
174 (* defaults *) |
182 (* defaults *) |
175 |
183 |
184 |
192 |
185 val prt_defT = prt_atom prt_var prt_typ; |
193 val prt_defT = prt_atom prt_var prt_typ; |
186 val prt_defS = prt_atom prt_varT prt_sort; |
194 val prt_defS = prt_atom prt_varT prt_sort; |
187 in |
195 in |
188 verb_string pretty_thy @ |
196 verb_string pretty_thy @ |
189 (if null fixes andalso not (! verbose) then [] |
197 (if null fixes then [] else [Pretty.string_of (prt_fixes (rev fixes))]) @ |
190 else [Pretty.string_of (prt_fixes (rev fixes))]) @ |
198 strings_of_prems ctxt @ |
191 (if null prems andalso not (! verbose) then [] |
|
192 else [Pretty.string_of (Pretty.big_list "Assumptions:" |
|
193 (map (prt_term o #prop o Thm.rep_thm) prems))]) @ |
|
194 verb strings_of_binds ctxt @ |
199 verb strings_of_binds ctxt @ |
195 verb strings_of_thms ctxt @ |
200 verb strings_of_thms ctxt @ |
196 verb_string (Pretty.big_list "Type constraints:" (map prt_defT (Vartab.dest types))) @ |
201 verb_string (Pretty.big_list "type constraints:" (map prt_defT (Vartab.dest types))) @ |
197 verb_string (Pretty.big_list "Default sorts:" (map prt_defS (Vartab.dest sorts))) @ |
202 verb_string (Pretty.big_list "default sorts:" (map prt_defS (Vartab.dest sorts))) @ |
198 verb_string (Pretty.str ("Maxidx: " ^ string_of_int maxidx)) @ |
203 verb_string (Pretty.str ("maxidx: " ^ string_of_int maxidx)) @ |
199 verb_string (Pretty.strs ("Used type variable names:" :: used)) |
204 verb_string (Pretty.strs ("used type variable names:" :: used)) |
200 end; |
205 end; |
201 |
206 |
202 |
207 |
203 |
208 |
204 (** user data **) |
209 (** user data **) |
296 |
301 |
297 |
302 |
298 (** prepare types **) |
303 (** prepare types **) |
299 |
304 |
300 fun read_typ (ctxt as Context {defs = (_, sorts, _, _), ...}) s = |
305 fun read_typ (ctxt as Context {defs = (_, sorts, _, _), ...}) s = |
301 let |
306 let fun def_sort xi = Vartab.lookup (sorts, xi) in |
302 val sign = sign_of ctxt; |
307 transform_error (Sign.read_typ (sign_of ctxt, def_sort)) s |
303 fun def_sort xi = Vartab.lookup (sorts, xi); |
|
304 in |
|
305 transform_error (Sign.read_typ (sign, def_sort)) s |
|
306 handle ERROR_MESSAGE msg => raise CONTEXT (msg, ctxt) |
308 handle ERROR_MESSAGE msg => raise CONTEXT (msg, ctxt) |
307 end; |
309 end; |
308 |
310 |
309 fun cert_typ ctxt raw_T = |
311 fun cert_typ ctxt raw_T = |
310 Sign.certify_typ (sign_of ctxt) raw_T |
312 Sign.certify_typ (sign_of ctxt) raw_T |
423 |
425 |
424 (* read terms *) |
426 (* read terms *) |
425 |
427 |
426 fun gen_read read app is_pat (ctxt as Context {binds, defs = (types, sorts, _, used), ...}) s = |
428 fun gen_read read app is_pat (ctxt as Context {binds, defs = (types, sorts, _, used), ...}) s = |
427 let |
429 let |
428 val sign = sign_of ctxt; |
|
429 |
|
430 fun def_type xi = |
430 fun def_type xi = |
431 (case Vartab.lookup (types, xi) of |
431 (case Vartab.lookup (types, xi) of |
432 None => if is_pat then None else apsome #2 (Vartab.lookup (binds, xi)) |
432 None => if is_pat then None else apsome #2 (Vartab.lookup (binds, xi)) |
433 | some => some); |
433 | some => some); |
434 |
434 |
435 fun def_sort xi = Vartab.lookup (sorts, xi); |
435 fun def_sort xi = Vartab.lookup (sorts, xi); |
436 in |
436 in |
437 (transform_error (read sign (def_type, def_sort, used)) s |
437 (transform_error (read (sign_of ctxt) (def_type, def_sort, used)) s |
438 handle TERM (msg, _) => raise CONTEXT (msg, ctxt) |
438 handle TERM (msg, _) => raise CONTEXT (msg, ctxt) |
439 | ERROR_MESSAGE msg => raise CONTEXT (msg, ctxt)) |
439 | ERROR_MESSAGE msg => raise CONTEXT (msg, ctxt)) |
440 |> app (intern_skolem ctxt true) |
440 |> app (intern_skolem ctxt true) |
441 |> app (if is_pat then I else norm_term ctxt) |
441 |> app (if is_pat then I else norm_term ctxt) |
442 |> app (if is_pat then prepare_dummies else (reject_dummies ctxt)) |
442 |> app (if is_pat then prepare_dummies else (reject_dummies ctxt)) |
640 local |
640 local |
641 |
641 |
642 fun gen_assm prepp tac (ctxt, (name, attrs, raw_prop_pats)) = |
642 fun gen_assm prepp tac (ctxt, (name, attrs, raw_prop_pats)) = |
643 let |
643 let |
644 val (ctxt', props) = foldl_map prepp (ctxt, raw_prop_pats); |
644 val (ctxt', props) = foldl_map prepp (ctxt, raw_prop_pats); |
645 val sign = sign_of ctxt'; |
|
646 val Context {defs = (_, _, maxidx, _), ...} = ctxt'; |
645 val Context {defs = (_, _, maxidx, _), ...} = ctxt'; |
647 |
646 |
648 val cprops = map (Thm.cterm_of sign) props; |
647 val cprops = map (Thm.cterm_of (sign_of ctxt')) props; |
649 val cprops_tac = map (rpair tac) cprops; |
648 val cprops_tac = map (rpair tac) cprops; |
650 val asms = map (Drule.forall_elim_vars (maxidx + 1) o Drule.assume_goal) cprops; |
649 val asms = map (Drule.forall_elim_vars (maxidx + 1) o Drule.assume_goal) cprops; |
651 |
650 |
652 val ths = map (fn th => ([th], [])) asms; |
651 val ths = map (fn th => ([th], [])) asms; |
653 val (ctxt'', (_, thms)) = |
652 val (ctxt'', (_, thms)) = |