5 *) |
5 *) |
6 |
6 |
7 signature PARTIAL_FUNCTION = |
7 signature PARTIAL_FUNCTION = |
8 sig |
8 sig |
9 val setup: theory -> theory |
9 val setup: theory -> theory |
10 val init: string -> term -> term -> thm -> declaration |
10 val init: string -> term -> term -> thm -> thm option -> declaration |
11 |
11 |
12 val add_partial_function: string -> (binding * typ option * mixfix) list -> |
12 val add_partial_function: string -> (binding * typ option * mixfix) list -> |
13 Attrib.binding * term -> local_theory -> local_theory |
13 Attrib.binding * term -> local_theory -> local_theory |
14 |
14 |
15 val add_partial_function_cmd: string -> (binding * string option * mixfix) list -> |
15 val add_partial_function_cmd: string -> (binding * string option * mixfix) list -> |
20 structure Partial_Function: PARTIAL_FUNCTION = |
20 structure Partial_Function: PARTIAL_FUNCTION = |
21 struct |
21 struct |
22 |
22 |
23 (*** Context Data ***) |
23 (*** Context Data ***) |
24 |
24 |
|
25 datatype setup_data = Setup_Data of |
|
26 {fixp: term, |
|
27 mono: term, |
|
28 fixp_eq: thm, |
|
29 fixp_induct: thm option}; |
|
30 |
25 structure Modes = Generic_Data |
31 structure Modes = Generic_Data |
26 ( |
32 ( |
27 type T = ((term * term) * thm) Symtab.table; |
33 type T = setup_data Symtab.table; |
28 val empty = Symtab.empty; |
34 val empty = Symtab.empty; |
29 val extend = I; |
35 val extend = I; |
30 fun merge data = Symtab.merge (K true) data; |
36 fun merge data = Symtab.merge (K true) data; |
31 ) |
37 ) |
32 |
38 |
33 fun init mode fixp mono fixp_eq phi = |
39 fun init mode fixp mono fixp_eq fixp_induct phi = |
34 let |
40 let |
35 val term = Morphism.term phi; |
41 val term = Morphism.term phi; |
36 val data' = ((term fixp, term mono), Morphism.thm phi fixp_eq); |
42 val thm = Morphism.thm phi; |
|
43 val data' = Setup_Data |
|
44 {fixp=term fixp, mono=term mono, fixp_eq=thm fixp_eq, |
|
45 fixp_induct=Option.map thm fixp_induct}; |
37 in |
46 in |
38 Modes.map (Symtab.update (mode, data')) |
47 Modes.map (Symtab.update (mode, data')) |
39 end |
48 end |
40 |
49 |
41 val known_modes = Symtab.keys o Modes.get o Context.Proof; |
50 val known_modes = Symtab.keys o Modes.get o Context.Proof; |
154 |
163 |
155 (*** partial_function definition ***) |
164 (*** partial_function definition ***) |
156 |
165 |
157 fun gen_add_partial_function prep mode fixes_raw eqn_raw lthy = |
166 fun gen_add_partial_function prep mode fixes_raw eqn_raw lthy = |
158 let |
167 let |
159 val ((fixp, mono), fixp_eq) = the (lookup_mode lthy mode) |
168 val setup_data = the (lookup_mode lthy mode) |
160 handle Option.Option => error (cat_lines ["Unknown mode " ^ quote mode ^ ".", |
169 handle Option.Option => error (cat_lines ["Unknown mode " ^ quote mode ^ ".", |
161 "Known modes are " ^ commas_quote (known_modes lthy) ^ "."]); |
170 "Known modes are " ^ commas_quote (known_modes lthy) ^ "."]); |
|
171 val Setup_Data {fixp, mono, fixp_eq, fixp_induct} = setup_data; |
162 |
172 |
163 val ((fixes, [(eq_abinding, eqn)]), _) = prep fixes_raw [eqn_raw] lthy; |
173 val ((fixes, [(eq_abinding, eqn)]), _) = prep fixes_raw [eqn_raw] lthy; |
164 val ((_, plain_eqn), _) = Variable.focus eqn lthy; |
174 val ((_, plain_eqn), _) = Variable.focus eqn lthy; |
165 |
175 |
166 val ((f_binding, fT), mixfix) = the_single fixes; |
176 val ((f_binding, fT), mixfix) = the_single fixes; |