author | wenzelm |
Wed, 15 Nov 2006 20:50:22 +0100 | |
changeset 21391 | a8809f46bd7f |
parent 21319 | cf814e36f788 |
child 21588 | cd0dc678a205 |
permissions | -rw-r--r-- |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
1 |
(* Title: HOL/Tools/function_package/fundef_datatype.ML |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
2 |
ID: $Id$ |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
3 |
Author: Alexander Krauss, TU Muenchen |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
4 |
|
20344 | 5 |
A package for general recursive function definitions. |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
6 |
A tactic to prove completeness of datatype patterns. |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
7 |
*) |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
8 |
|
20344 | 9 |
signature FUNDEF_DATATYPE = |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
10 |
sig |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
11 |
val pat_complete_tac: int -> tactic |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
12 |
|
20523
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
13 |
val pat_completeness : method |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
14 |
val setup : theory -> theory |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
15 |
end |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
16 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
17 |
structure FundefDatatype : FUNDEF_DATATYPE = |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
18 |
struct |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
19 |
|
21051
c49467a9c1e1
Switched function package to use the new package for inductive predicates.
krauss
parents:
20999
diff
changeset
|
20 |
open FundefLib |
c49467a9c1e1
Switched function package to use the new package for inductive predicates.
krauss
parents:
20999
diff
changeset
|
21 |
open FundefCommon |
19770
be5c23ebe1eb
HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents:
19564
diff
changeset
|
22 |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
23 |
fun mk_argvar i T = Free ("_av" ^ (string_of_int i), T) |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
24 |
fun mk_patvar i T = Free ("_pv" ^ (string_of_int i), T) |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
25 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
26 |
fun inst_free var inst thm = |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
27 |
forall_elim inst (forall_intr var thm) |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
28 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
29 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
30 |
fun inst_case_thm thy x P thm = |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
31 |
let |
20344 | 32 |
val [Pv, xv] = term_vars (prop_of thm) |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
33 |
in |
20344 | 34 |
cterm_instantiate [(cterm_of thy xv, cterm_of thy x), (cterm_of thy Pv, cterm_of thy P)] thm |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
35 |
end |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
36 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
37 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
38 |
fun invent_vars constr i = |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
39 |
let |
20344 | 40 |
val Ts = binder_types (fastype_of constr) |
41 |
val j = i + length Ts |
|
42 |
val is = i upto (j - 1) |
|
43 |
val avs = map2 mk_argvar is Ts |
|
44 |
val pvs = map2 mk_patvar is Ts |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
45 |
in |
20344 | 46 |
(avs, pvs, j) |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
47 |
end |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
48 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
49 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
50 |
fun filter_pats thy cons pvars [] = [] |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
51 |
| filter_pats thy cons pvars (([], thm) :: pts) = raise Match |
20344 | 52 |
| filter_pats thy cons pvars ((pat :: pats, thm) :: pts) = |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
53 |
case pat of |
20344 | 54 |
Free _ => let val inst = list_comb (cons, pvars) |
55 |
in (inst :: pats, inst_free (cterm_of thy pat) (cterm_of thy inst) thm) |
|
56 |
:: (filter_pats thy cons pvars pts) end |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
57 |
| _ => if fst (strip_comb pat) = cons |
20344 | 58 |
then (pat :: pats, thm) :: (filter_pats thy cons pvars pts) |
59 |
else filter_pats thy cons pvars pts |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
60 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
61 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
62 |
fun inst_constrs_of thy (T as Type (name, _)) = |
20344 | 63 |
map (fn (Cn,CT) => Envir.subst_TVars (Sign.typ_match thy (body_type CT, T) Vartab.empty) (Const (Cn, CT))) |
64 |
(the (DatatypePackage.get_datatype_constrs thy name)) |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
65 |
| inst_constrs_of thy _ = raise Match |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
66 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
67 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
68 |
fun transform_pat thy avars c_assum ([] , thm) = raise Match |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
69 |
| transform_pat thy avars c_assum (pat :: pats, thm) = |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
70 |
let |
20344 | 71 |
val (_, subps) = strip_comb pat |
72 |
val eqs = map (cterm_of thy o HOLogic.mk_Trueprop o HOLogic.mk_eq) (avars ~~ subps) |
|
73 |
val a_eqs = map assume eqs |
|
74 |
val c_eq_pat = simplify (HOL_basic_ss addsimps a_eqs) c_assum |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
75 |
in |
20344 | 76 |
(subps @ pats, fold_rev implies_intr eqs |
77 |
(implies_elim thm c_eq_pat)) |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
78 |
end |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
79 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
80 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
81 |
exception COMPLETENESS |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
82 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
83 |
fun constr_case thy P idx (v :: vs) pats cons = |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
84 |
let |
20344 | 85 |
val (avars, pvars, newidx) = invent_vars cons idx |
86 |
val c_hyp = cterm_of thy (HOLogic.mk_Trueprop (HOLogic.mk_eq (v, list_comb (cons, avars)))) |
|
87 |
val c_assum = assume c_hyp |
|
88 |
val newpats = map (transform_pat thy avars c_assum) (filter_pats thy cons pvars pats) |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
89 |
in |
20344 | 90 |
o_alg thy P newidx (avars @ vs) newpats |
91 |
|> implies_intr c_hyp |
|
92 |
|> fold_rev (forall_intr o cterm_of thy) avars |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
93 |
end |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
94 |
| constr_case _ _ _ _ _ _ = raise Match |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
95 |
and o_alg thy P idx [] (([], Pthm) :: _) = Pthm |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
96 |
| o_alg thy P idx (v :: vs) [] = raise COMPLETENESS |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
97 |
| o_alg thy P idx (v :: vs) pts = |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
98 |
if forall (is_Free o hd o fst) pts (* Var case *) |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
99 |
then o_alg thy P idx vs (map (fn (pv :: pats, thm) => |
20344 | 100 |
(pats, refl RS (inst_free (cterm_of thy pv) (cterm_of thy v) thm))) pts) |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
101 |
else (* Cons case *) |
20344 | 102 |
let |
103 |
val T = fastype_of v |
|
104 |
val (tname, _) = dest_Type T |
|
105 |
val {exhaustion=case_thm, ...} = DatatypePackage.the_datatype thy tname |
|
106 |
val constrs = inst_constrs_of thy T |
|
107 |
val c_cases = map (constr_case thy P idx (v :: vs) pts) constrs |
|
108 |
in |
|
109 |
inst_case_thm thy v P case_thm |
|
110 |
|> fold (curry op COMP) c_cases |
|
111 |
end |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
112 |
| o_alg _ _ _ _ _ = raise Match |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
113 |
|
20344 | 114 |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
115 |
fun prove_completeness thy x P qss pats = |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
116 |
let |
20344 | 117 |
fun mk_assum qs pat = Logic.mk_implies (HOLogic.mk_Trueprop (HOLogic.mk_eq (x,pat)), |
118 |
HOLogic.mk_Trueprop P) |
|
119 |
|> fold_rev mk_forall qs |
|
120 |
|> cterm_of thy |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
121 |
|
20344 | 122 |
val hyps = map2 mk_assum qss pats |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
123 |
|
20344 | 124 |
fun inst_hyps hyp qs = fold (forall_elim o cterm_of thy) qs (assume hyp) |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
125 |
|
20344 | 126 |
val assums = map2 inst_hyps hyps qss |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
127 |
in |
20344 | 128 |
o_alg thy P 2 [x] (map2 (pair o single) pats assums) |
129 |
|> fold_rev implies_intr hyps |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
130 |
end |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
131 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
132 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
133 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
134 |
fun pat_complete_tac i thm = |
20344 | 135 |
let |
19922 | 136 |
val thy = theory_of_thm thm |
137 |
||
20344 | 138 |
val subgoal = nth (prems_of thm) (i - 1) (* FIXME SUBGOAL tactical *) |
19922 | 139 |
|
140 |
val ([P, x], subgf) = dest_all_all subgoal |
|
141 |
||
20344 | 142 |
val assums = Logic.strip_imp_prems subgf |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
143 |
|
20344 | 144 |
fun pat_of assum = |
145 |
let |
|
146 |
val (qs, imp) = dest_all_all assum |
|
147 |
in |
|
148 |
case Logic.dest_implies imp of |
|
149 |
(_ $ (_ $ _ $ pat), _) => (qs, pat) |
|
150 |
| _ => raise COMPLETENESS |
|
151 |
end |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
152 |
|
20344 | 153 |
val (qss, pats) = split_list (map pat_of assums) |
154 |
||
155 |
val complete_thm = prove_completeness thy x P qss pats |
|
19922 | 156 |
|> forall_intr (cterm_of thy x) |
157 |
|> forall_intr (cterm_of thy P) |
|
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
158 |
in |
20344 | 159 |
Seq.single (Drule.compose_single(complete_thm, i, thm)) |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
160 |
end |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
161 |
handle COMPLETENESS => Seq.empty |
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
162 |
|
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
163 |
|
20523
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
164 |
val pat_completeness = Method.SIMPLE_METHOD (pat_complete_tac 1) |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
165 |
|
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
166 |
val by_pat_completeness_simp = |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
167 |
Proof.global_terminal_proof |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
168 |
(Method.Basic (K pat_completeness), |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
169 |
SOME (Method.Source (Args.src (("simp_all", []), Position.none)))) |
20999 | 170 |
(* FIXME avoid dynamic scoping of method name! *) |
20523
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
171 |
|
21211
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
172 |
fun termination_by_lexicographic_order name = |
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
173 |
FundefPackage.setup_termination_proof (SOME name) |
21319
cf814e36f788
replaced "auto_term" by the simpler method "relation", which does not try
krauss
parents:
21240
diff
changeset
|
174 |
#> Proof.global_terminal_proof (Method.Basic LexicographicOrder.lexicographic_order, NONE) |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
175 |
|
20344 | 176 |
val setup = |
20523
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
177 |
Method.add_methods [("pat_completeness", Method.no_args pat_completeness, "Completeness prover for datatype patterns")] |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
178 |
|
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
179 |
|
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
180 |
|
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
181 |
|
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
182 |
local structure P = OuterParse and K = OuterKeyword in |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
183 |
|
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
184 |
|
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
185 |
fun or_list1 s = P.enum1 "|" s |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
186 |
val otherwise = P.$$$ "(" |-- P.$$$ "otherwise" --| P.$$$ ")" |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
187 |
val statement_ow = P.and_list1 (P.opt_thm_name ":" -- Scan.repeat1 (P.prop -- Scan.optional (otherwise >> K true) false)) |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
188 |
val statements_ow = or_list1 statement_ow |
19564
d3e2f532459a
First usable version of the new function definition package (HOL/function_packake/...).
krauss
parents:
diff
changeset
|
189 |
|
21211
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
190 |
|
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
191 |
fun fun_cmd fixes statements lthy = |
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
192 |
lthy |
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
193 |
|> FundefPackage.add_fundef fixes statements FundefCommon.fun_config |
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
194 |
||> by_pat_completeness_simp |
21240
8e75fb38522c
Made "termination by lexicographic_order" the default for "fun" definitions.
krauss
parents:
21211
diff
changeset
|
195 |
|-> termination_by_lexicographic_order |
21211
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
196 |
|
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
197 |
|
20523
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
198 |
val funP = |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
199 |
OuterSyntax.command "fun" "define general recursive functions (short version)" K.thy_decl |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
200 |
((P.opt_locale_target -- P.fixes --| P.$$$ "where" -- statements_ow) |
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
201 |
>> (fn ((target, fixes), statements) => |
21211
5370cfbf3070
Preparations for making "lexicographic_order" part of "fun"
krauss
parents:
21051
diff
changeset
|
202 |
(Toplevel.local_theory target (fun_cmd fixes statements)))); |
20523
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
203 |
|
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
204 |
val _ = OuterSyntax.add_parsers [funP]; |
20344 | 205 |
end |
20523
36a59e5d0039
Major update to function package, including new syntax and the (only theoretical)
krauss
parents:
20344
diff
changeset
|
206 |
|
20875 | 207 |
end |