discontinued obsolete fork_mono to loosen some brakes -- NB: TTY interaction has Goal.future_proofs disabled due to missing Future.worker_task;
--- a/src/HOL/Nominal/nominal_datatype.ML Wed Sep 05 17:12:40 2012 +0200
+++ b/src/HOL/Nominal/nominal_datatype.ML Wed Sep 05 19:51:00 2012 +0200
@@ -527,7 +527,7 @@
|> Sign.map_naming Name_Space.conceal
|> Inductive.add_inductive_global
{quiet_mode = false, verbose = false, alt_name = Binding.name big_rep_name,
- coind = false, no_elim = true, no_ind = false, skip_mono = true, fork_mono = false}
+ coind = false, no_elim = true, no_ind = false, skip_mono = true}
(map (fn (s, T) => ((Binding.name s, T --> HOLogic.boolT), NoSyn))
(rep_set_names' ~~ recTs'))
[] (map (fn x => (Attrib.empty_binding, x)) intr_ts) []
@@ -1484,7 +1484,7 @@
|> Sign.map_naming Name_Space.conceal
|> Inductive.add_inductive_global
{quiet_mode = #quiet config, verbose = false, alt_name = Binding.name big_rec_name,
- coind = false, no_elim = false, no_ind = false, skip_mono = true, fork_mono = false}
+ coind = false, no_elim = false, no_ind = false, skip_mono = true}
(map (fn (s, T) => ((Binding.name s, T), NoSyn)) (rec_set_names' ~~ rec_set_Ts))
(map dest_Free rec_fns)
(map (fn x => (Attrib.empty_binding, x)) rec_intr_ts) []
--- a/src/HOL/Tools/Datatype/datatype.ML Wed Sep 05 17:12:40 2012 +0200
+++ b/src/HOL/Tools/Datatype/datatype.ML Wed Sep 05 19:51:00 2012 +0200
@@ -178,7 +178,7 @@
|> Sign.map_naming Name_Space.conceal
|> Inductive.add_inductive_global
{quiet_mode = #quiet config, verbose = false, alt_name = Binding.name big_rec_name,
- coind = false, no_elim = true, no_ind = false, skip_mono = true, fork_mono = false}
+ coind = false, no_elim = true, no_ind = false, skip_mono = true}
(map (fn s => ((Binding.name s, UnivT'), NoSyn)) rep_set_names') []
(map (fn x => (Attrib.empty_binding, x)) intr_ts) []
||> Sign.restore_naming thy1
--- a/src/HOL/Tools/Datatype/rep_datatype.ML Wed Sep 05 17:12:40 2012 +0200
+++ b/src/HOL/Tools/Datatype/rep_datatype.ML Wed Sep 05 19:51:00 2012 +0200
@@ -145,7 +145,7 @@
|> Sign.map_naming Name_Space.conceal
|> Inductive.add_inductive_global
{quiet_mode = #quiet config, verbose = false, alt_name = Binding.name big_rec_name',
- coind = false, no_elim = false, no_ind = true, skip_mono = true, fork_mono = false}
+ coind = false, no_elim = false, no_ind = true, skip_mono = true}
(map (fn (s, T) => ((Binding.name s, T), NoSyn)) (rec_set_names' ~~ rec_set_Ts))
(map dest_Free rec_fns)
(map (fn x => (Attrib.empty_binding, x)) rec_intr_ts) []
--- a/src/HOL/Tools/Function/function_core.ML Wed Sep 05 17:12:40 2012 +0200
+++ b/src/HOL/Tools/Function/function_core.ML Wed Sep 05 19:51:00 2012 +0200
@@ -439,8 +439,7 @@
coind = false,
no_elim = false,
no_ind = false,
- skip_mono = true,
- fork_mono = false}
+ skip_mono = true}
[binding] (* relation *)
[] (* no parameters *)
(map (fn t => (Attrib.empty_binding, t)) intrs) (* intro rules *)
--- a/src/HOL/Tools/inductive.ML Wed Sep 05 17:12:40 2012 +0200
+++ b/src/HOL/Tools/inductive.ML Wed Sep 05 19:51:00 2012 +0200
@@ -39,7 +39,7 @@
thm list list * local_theory
type inductive_flags =
{quiet_mode: bool, verbose: bool, alt_name: binding, coind: bool,
- no_elim: bool, no_ind: bool, skip_mono: bool, fork_mono: bool}
+ no_elim: bool, no_ind: bool, skip_mono: bool}
val add_inductive_i:
inductive_flags -> ((binding * typ) * mixfix) list ->
(string * typ) list -> (Attrib.binding * term) list -> thm list -> local_theory ->
@@ -358,10 +358,10 @@
(* prove monotonicity *)
-fun prove_mono quiet_mode skip_mono fork_mono predT fp_fun monos ctxt =
- (message (quiet_mode orelse skip_mono andalso !quick_and_dirty orelse fork_mono)
+fun prove_mono quiet_mode skip_mono predT fp_fun monos ctxt =
+ (message (quiet_mode orelse skip_mono andalso ! quick_and_dirty)
" Proving monotonicity ...";
- (if skip_mono then Skip_Proof.prove else if fork_mono then Goal.prove_future else Goal.prove) ctxt
+ (if skip_mono then Skip_Proof.prove else Goal.prove_future) ctxt
[] []
(HOLogic.mk_Trueprop
(Const (@{const_name Orderings.mono}, (predT --> predT) --> HOLogic.boolT) $ fp_fun))
@@ -746,8 +746,7 @@
(** specification of (co)inductive predicates **)
-fun mk_ind_def quiet_mode skip_mono fork_mono alt_name coind
- cs intr_ts monos params cnames_syn lthy =
+fun mk_ind_def quiet_mode skip_mono alt_name coind cs intr_ts monos params cnames_syn lthy =
let
val fp_name = if coind then @{const_name Inductive.gfp} else @{const_name Inductive.lfp};
@@ -841,7 +840,7 @@
val preds = (case cs of [_] => [rec_const] | _ => map #1 consts_defs);
val (_, lthy''') = Variable.add_fixes (map (fst o dest_Free) params) lthy'';
- val mono = prove_mono quiet_mode skip_mono fork_mono predT fp_fun monos lthy''';
+ val mono = prove_mono quiet_mode skip_mono predT fp_fun monos lthy''';
val (_, lthy'''') =
Local_Theory.note (apfst Binding.conceal Attrib.empty_binding,
Proof_Context.export lthy''' lthy'' [mono]) lthy'';
@@ -912,7 +911,7 @@
type inductive_flags =
{quiet_mode: bool, verbose: bool, alt_name: binding, coind: bool,
- no_elim: bool, no_ind: bool, skip_mono: bool, fork_mono: bool};
+ no_elim: bool, no_ind: bool, skip_mono: bool};
type add_ind_def =
inductive_flags ->
@@ -920,7 +919,7 @@
term list -> (binding * mixfix) list ->
local_theory -> inductive_result * local_theory;
-fun add_ind_def {quiet_mode, verbose, alt_name, coind, no_elim, no_ind, skip_mono, fork_mono}
+fun add_ind_def {quiet_mode, verbose, alt_name, coind, no_elim, no_ind, skip_mono}
cs intros monos params cnames_syn lthy =
let
val _ = null cnames_syn andalso error "No inductive predicates given";
@@ -933,7 +932,7 @@
apfst split_list (split_list (map (check_rule lthy cs params) intros));
val (lthy1, lthy2, rec_name, mono, fp_def, rec_preds_defs, rec_const, preds,
- argTs, bs, xs) = mk_ind_def quiet_mode skip_mono fork_mono alt_name coind cs intr_ts
+ argTs, bs, xs) = mk_ind_def quiet_mode skip_mono alt_name coind cs intr_ts
monos params cnames_syn lthy;
val (intrs, unfold) = prove_intrs quiet_mode coind mono fp_def (length bs + length xs)
@@ -983,7 +982,7 @@
(* external interfaces *)
fun gen_add_inductive_i mk_def
- (flags as {quiet_mode, verbose, alt_name, coind, no_elim, no_ind, skip_mono, fork_mono})
+ (flags as {quiet_mode, verbose, alt_name, coind, no_elim, no_ind, skip_mono})
cnames_syn pnames spec monos lthy =
let
val thy = Proof_Context.theory_of lthy;
@@ -1047,8 +1046,9 @@
|> Specification.read_spec (cnames_syn @ pnames_syn) intro_srcs;
val (cs, ps) = chop (length cnames_syn) vars;
val monos = Attrib.eval_thms lthy raw_monos;
- val flags = {quiet_mode = false, verbose = verbose, alt_name = Binding.empty,
- coind = coind, no_elim = false, no_ind = false, skip_mono = false, fork_mono = not int};
+ val flags =
+ {quiet_mode = false, verbose = verbose, alt_name = Binding.empty,
+ coind = coind, no_elim = false, no_ind = false, skip_mono = false};
in
lthy
|> gen_add_inductive_i mk_def flags cs (map (apfst Binding.name_of o fst) ps) intrs monos
--- a/src/HOL/Tools/inductive_realizer.ML Wed Sep 05 17:12:40 2012 +0200
+++ b/src/HOL/Tools/inductive_realizer.ML Wed Sep 05 19:51:00 2012 +0200
@@ -355,7 +355,7 @@
val (ind_info, thy3') = thy2 |>
Inductive.add_inductive_global
{quiet_mode = false, verbose = false, alt_name = Binding.empty, coind = false,
- no_elim = false, no_ind = false, skip_mono = false, fork_mono = false}
+ no_elim = false, no_ind = false, skip_mono = false}
rlzpreds rlzparams (map (fn (rintr, intr) =>
((Binding.name (Long_Name.base_name (name_of_thm intr)), []),
subst_atomic rlzpreds' (Logic.unvarify_global rintr)))
--- a/src/HOL/Tools/inductive_set.ML Wed Sep 05 17:12:40 2012 +0200
+++ b/src/HOL/Tools/inductive_set.ML Wed Sep 05 19:51:00 2012 +0200
@@ -417,7 +417,7 @@
(**** definition of inductive sets ****)
fun add_ind_set_def
- {quiet_mode, verbose, alt_name, coind, no_elim, no_ind, skip_mono, fork_mono}
+ {quiet_mode, verbose, alt_name, coind, no_elim, no_ind, skip_mono}
cs intros monos params cnames_syn lthy =
let
val thy = Proof_Context.theory_of lthy;
@@ -490,8 +490,7 @@
val ({preds, intrs, elims, raw_induct, eqs, ...}, lthy1) =
Inductive.add_ind_def
{quiet_mode = quiet_mode, verbose = verbose, alt_name = Binding.empty,
- coind = coind, no_elim = no_elim, no_ind = no_ind,
- skip_mono = skip_mono, fork_mono = fork_mono}
+ coind = coind, no_elim = no_elim, no_ind = no_ind, skip_mono = skip_mono}
cs' intros' monos' params1 cnames_syn' lthy;
(* define inductive sets using previously defined predicates *)