--- a/src/Pure/Isar/obtain.ML Thu Sep 19 10:52:18 2019 +0200
+++ b/src/Pure/Isar/obtain.ML Thu Sep 19 15:09:12 2019 +0200
@@ -201,7 +201,7 @@
val ((_, thesis), thesis_ctxt) = obtain_thesis (Proof.context_of state);
- val ((vars, propss, binds, binds', _), params_ctxt) =
+ val ({vars, propss, binds, result_binds, ...}, params_ctxt) =
prep_stmt (raw_decls @ raw_fixes) (raw_prems @ map #2 raw_concls) thesis_ctxt;
val (decls, fixes) = chop (length raw_decls) vars ||> map #2;
val (premss, conclss) = chop (length raw_prems) propss;
@@ -230,7 +230,7 @@
[((that_binding, [Context_Rules.intro_query NONE]), [(that_prop, [])])]
[(Binding.empty_atts, [(thesis, [])])] int
|-> Proof.refine_insert
- |> Proof.map_context (fold Variable.bind_term binds')
+ |> Proof.map_context (fold Variable.bind_term result_binds)
end;
in
--- a/src/Pure/Isar/proof.ML Thu Sep 19 10:52:18 2019 +0200
+++ b/src/Pure/Isar/proof.ML Thu Sep 19 15:09:12 2019 +0200
@@ -645,8 +645,8 @@
val ctxt = context_of state;
val bindings = map (apsnd (map (prep_att ctxt)) o fst) raw_concls;
- val ((params, prems_propss, concl_propss, result_binds, text), _) =
- prep_statement raw_fixes raw_prems (map snd raw_concls) ctxt;
+ val {fixes = params, assumes = prems_propss, shows = concl_propss, result_binds, text, ...} =
+ #1 (prep_statement raw_fixes raw_prems (map snd raw_concls) ctxt);
val propss = (map o map) (Logic.close_prop params (flat prems_propss)) concl_propss;
in
state
@@ -812,7 +812,7 @@
val ctxt = context_of state;
(*vars*)
- val ((vars, propss, _, binds', _), vars_ctxt) =
+ val ({vars, propss, result_binds, ...}, vars_ctxt) =
prep_stmt (raw_decls @ raw_fixes) (map snd raw_defs) ctxt;
val (decls, fixes) = chop (length raw_decls) vars;
val show_term = Syntax.string_of_term vars_ctxt;
@@ -846,7 +846,7 @@
raw_defs def_thmss;
in
state
- |> map_context (K defs_ctxt #> fold Variable.bind_term binds')
+ |> map_context (K defs_ctxt #> fold Variable.bind_term result_binds)
|> note_thmss notes
end;
@@ -1057,11 +1057,10 @@
(if strict_asm then Assumption.assume_export else Assumption.presume_export);
(*params*)
- val ((params, assumes_propss, shows_propss, result_binds, text), params_ctxt) = ctxt
+ val ({fixes = params, assumes = assumes_propss, shows = shows_propss,
+ result_binds, result_text, text}, params_ctxt) = ctxt
|> prep_statement raw_fixes (map snd raw_assumes) (map snd raw_shows);
- val result_text = singleton (Variable.export_terms params_ctxt ctxt) text;
-
(*prems*)
val (assumes_bindings, shows_bindings) =
apply2 (map (apsnd (map (prep_att ctxt)) o fst)) (raw_assumes, raw_shows);
--- a/src/Pure/Isar/proof_context.ML Thu Sep 19 10:52:18 2019 +0200
+++ b/src/Pure/Isar/proof_context.ML Thu Sep 19 15:09:12 2019 +0200
@@ -169,22 +169,28 @@
val generic_add_abbrev: string -> binding * term -> Context.generic ->
(term * term) * Context.generic
val generic_revert_abbrev: string -> string -> Context.generic -> Context.generic
- val cert_stmt:
- (binding * typ option * mixfix) list -> (term * term list) list list -> Proof.context ->
- (((binding * typ option * mixfix) * (string * term)) list * term list list *
- (indexname * term) list * (indexname * term) list * term) * Proof.context
- val read_stmt:
- (binding * string option * mixfix) list -> (string * string list) list list -> Proof.context ->
- (((binding * typ option * mixfix) * (string * term)) list * term list list *
- (indexname * term) list * (indexname * term) list * term) * Proof.context
+ type stmt =
+ {vars: ((binding * typ option * mixfix) * (string * term)) list,
+ propss: term list list,
+ binds: (indexname * term) list,
+ result_binds: (indexname * term) list}
+ val cert_stmt: (binding * typ option * mixfix) list -> (term * term list) list list ->
+ Proof.context -> stmt * Proof.context
+ val read_stmt: (binding * string option * mixfix) list -> (string * string list) list list ->
+ Proof.context -> stmt * Proof.context
+ type statement =
+ {fixes: (string * term) list,
+ assumes: term list list,
+ shows: term list list,
+ result_binds: (indexname * term option) list,
+ text: term,
+ result_text: term}
val cert_statement: (binding * typ option * mixfix) list ->
(term * term list) list list -> (term * term list) list list -> Proof.context ->
- ((string * term) list * term list list * term list list * (indexname * term option) list * term) *
- Proof.context
+ statement * Proof.context
val read_statement: (binding * string option * mixfix) list ->
(string * string list) list list -> (string * string list) list list -> Proof.context ->
- ((string * term) list * term list list * term list list * (indexname * term option) list * term) *
- Proof.context
+ statement * Proof.context
val print_syntax: Proof.context -> unit
val print_abbrevs: bool -> Proof.context -> unit
val pretty_term_bindings: Proof.context -> Pretty.T list
@@ -1334,6 +1340,20 @@
(* structured statements *)
+type stmt =
+ {vars: ((binding * typ option * mixfix) * (string * term)) list,
+ propss: term list list,
+ binds: (indexname * term) list,
+ result_binds: (indexname * term) list};
+
+type statement =
+ {fixes: (string * term) list,
+ assumes: term list list,
+ shows: term list list,
+ result_binds: (indexname * term option) list,
+ text: term,
+ result_text: term};
+
local
fun export_binds ctxt' ctxt params binds =
@@ -1362,25 +1382,36 @@
|> export_binds params_ctxt ctxt params
|> map (apsnd the);
- val text' = Logic.close_prop params [] (Logic.mk_conjunction_list (flat propss));
-
val _ = Variable.warn_extra_tfrees fixes_ctxt params_ctxt;
- in ((vars' ~~ params, propss, binds, binds', text'), params_ctxt) end;
+ val result : stmt =
+ {vars = vars' ~~ params, propss = propss, binds = binds, result_binds = binds'};
+ in (result, params_ctxt) end;
fun prep_statement prep_var prep_propp raw_fixes raw_assumes raw_shows ctxt =
let
- val ((fixes, (assumes, shows), binds, text'), ctxt') = ctxt
+ val ((fixes, (assumes, shows), binds), ctxt') = ctxt
|> prep_stmt prep_var prep_propp raw_fixes (raw_assumes @ raw_shows)
- |-> (fn (vars, propss, binds, _, text') =>
+ |-> (fn {vars, propss, binds, ...} =>
fold Variable.bind_term binds #>
- pair (map #2 vars, chop (length raw_assumes) propss, binds, text'));
+ pair (map #2 vars, chop (length raw_assumes) propss, binds));
val binds' =
(Auto_Bind.facts ctxt' (flat shows) @
(case try List.last (flat shows) of
NONE => []
| SOME prop => map (apsnd (SOME o Auto_Bind.abs_params prop)) binds))
|> export_binds ctxt' ctxt fixes;
- in ((fixes, assumes, shows, binds', text'), ctxt') end;
+
+ val text = Logic.close_prop fixes (flat assumes) (Logic.mk_conjunction_list (flat shows));
+ val text' = singleton (Variable.export_terms ctxt' ctxt) text;
+
+ val result : statement =
+ {fixes = fixes,
+ assumes = assumes,
+ shows = shows,
+ result_binds = binds',
+ text = text,
+ result_text = text'};
+ in (result, ctxt') end;
in
--- a/src/Pure/Isar/specification.ML Thu Sep 19 10:52:18 2019 +0200
+++ b/src/Pure/Isar/specification.ML Thu Sep 19 15:09:12 2019 +0200
@@ -204,7 +204,7 @@
fun gen_axioms prep_stmt prep_att raw_decls raw_fixes raw_prems raw_concls thy =
let
(*specification*)
- val ((vars, [prems, concls], _, _, _), vars_ctxt) =
+ val ({vars, propss = [prems, concls], ...}, vars_ctxt) =
Proof_Context.init_global thy
|> prep_stmt (raw_decls @ raw_fixes) ((map o map) (rpair []) [raw_prems, map snd raw_concls]);
val (decls, fixes) = chop (length raw_decls) vars;