6954
|
1 |
(* Title: Pure/Isar/local_defs.ML
|
|
2 |
ID: $Id$
|
|
3 |
Author: Markus Wenzel, TU Muenchen
|
|
4 |
|
|
5 |
Local definitions.
|
|
6 |
*)
|
|
7 |
|
|
8 |
signature LOCAL_DEFS =
|
|
9 |
sig
|
|
10 |
val def: string -> Proof.context attribute list
|
|
11 |
-> (string * string option) * (string * string list) -> Proof.state -> Proof.state
|
|
12 |
val def_i: string -> Proof.context attribute list
|
7667
|
13 |
-> (string * typ option) * (term * term list) -> Proof.state -> Proof.state
|
6954
|
14 |
end;
|
|
15 |
|
|
16 |
structure LocalDefs: LOCAL_DEFS =
|
|
17 |
struct
|
|
18 |
|
|
19 |
|
7502
|
20 |
val refl_tac = Tactic.rtac (Drule.standard (Drule.reflexive_thm RS Drule.triv_goal));
|
6954
|
21 |
|
|
22 |
|
7416
|
23 |
fun gen_def fix prep_term match_binds raw_name atts ((x, raw_T), (raw_rhs, raw_pats)) state =
|
6954
|
24 |
let
|
|
25 |
fun err msg = raise Proof.STATE ("Bad local def: " ^ msg, state);
|
|
26 |
|
7416
|
27 |
val state' = fix [([x], raw_T)] state;
|
6954
|
28 |
val ctxt' = Proof.context_of state';
|
|
29 |
|
7416
|
30 |
val name = if raw_name = "" then Thm.def_name x else raw_name;
|
6954
|
31 |
val rhs = prep_term ctxt' raw_rhs;
|
|
32 |
val T = Term.fastype_of rhs;
|
|
33 |
val lhs = ProofContext.cert_term ctxt' (Free (x, T));
|
|
34 |
val eq = Logic.mk_equals (lhs, rhs);
|
|
35 |
in
|
7667
|
36 |
if lhs mem Term.add_term_frees (rhs, []) then err "lhs occurs on rhs"
|
|
37 |
(* FIXME else if not (Term.term_tfrees rhs subset Term.typ_tfrees T) then
|
|
38 |
err "extra type variables on rhs" *)
|
6954
|
39 |
else ();
|
|
40 |
state'
|
|
41 |
|> match_binds [(raw_pats, raw_rhs)] (*note: raw_rhs prepared twice!*)
|
7271
|
42 |
|> Proof.assm_i (refl_tac, refl_tac) [(name, atts, [(eq, ([], []))])]
|
6954
|
43 |
end;
|
|
44 |
|
|
45 |
val def = gen_def Proof.fix ProofContext.read_term Proof.match_bind;
|
|
46 |
val def_i = gen_def Proof.fix_i ProofContext.cert_term Proof.match_bind_i;
|
|
47 |
|
|
48 |
|
|
49 |
end;
|