src/Pure/thm.ML
author wenzelm
Wed, 12 Mar 2025 11:39:00 +0100
changeset 82265 4b875a4c83b0
parent 82123 c30b6eff8fa1
child 82809 b908d50f42d4
permissions -rw-r--r--
update for release;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
     1
(*  Title:      Pure/thm.ML
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
     2
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
29269
5c25a2012975 moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents: 29003
diff changeset
     3
    Author:     Makarius
229
4002c4cd450c Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents: 225
diff changeset
     4
16425
2427be27cc60 accomodate identification of type Sign.sg and theory;
wenzelm
parents: 16352
diff changeset
     5
The very core of Isabelle's Meta Logic: certified types and terms,
59589
6020e3dec7b5 removed unused;
wenzelm
parents: 59586
diff changeset
     6
derivations, theorems, inference rules (including lifting and
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
     7
resolution), oracles.
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     8
*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
     9
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
    10
infix 0 RS RSN;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
    11
6089
4d2d5556b4f9 signature BASIC_THM;
wenzelm
parents: 5624
diff changeset
    12
signature BASIC_THM =
59589
6020e3dec7b5 removed unused;
wenzelm
parents: 59586
diff changeset
    13
sig
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    14
  type ctyp
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    15
  type cterm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    16
  exception CTERM of string * cterm list
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    17
  type thm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    18
  type conv = cterm -> thm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    19
  exception THM of string * int * thm list
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
    20
  val RSN: thm * (int * thm) -> thm
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
    21
  val RS: thm * thm -> thm
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    22
end;
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    23
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    24
signature THM =
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    25
sig
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    26
  include BASIC_THM
1160
8845eb5f0e5e added add_trrules_i;
wenzelm
parents: 1065
diff changeset
    27
  (*certified types*)
16425
2427be27cc60 accomodate identification of type Sign.sg and theory;
wenzelm
parents: 16352
diff changeset
    28
  val typ_of: ctyp -> typ
59621
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
    29
  val global_ctyp_of: theory -> typ -> ctyp
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
    30
  val ctyp_of: Proof.context -> typ -> ctyp
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    31
  val dest_ctyp: ctyp -> ctyp list
70159
57503fe1b0ff tuned signature;
wenzelm
parents: 70156
diff changeset
    32
  val dest_ctypN: int -> ctyp -> ctyp
70156
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
    33
  val make_ctyp: ctyp -> ctyp list -> ctyp
81958
87cc86357dc2 proper treatment of variables with the same name, but different sorts/types: this routinely happens in HOL Light (see also 0e2f019477e2), as well as theory "HOL-Algebra.Algebraic_Closure_Type" (line 77);
wenzelm
parents: 81952
diff changeset
    34
  val maxidx_of_ctyp: ctyp -> int
1160
8845eb5f0e5e added add_trrules_i;
wenzelm
parents: 1065
diff changeset
    35
  (*certified terms*)
16425
2427be27cc60 accomodate identification of type Sign.sg and theory;
wenzelm
parents: 16352
diff changeset
    36
  val term_of: cterm -> term
59586
ddf6deaadfe8 clarified signature;
wenzelm
parents: 59582
diff changeset
    37
  val typ_of_cterm: cterm -> typ
ddf6deaadfe8 clarified signature;
wenzelm
parents: 59582
diff changeset
    38
  val ctyp_of_cterm: cterm -> ctyp
ddf6deaadfe8 clarified signature;
wenzelm
parents: 59582
diff changeset
    39
  val maxidx_of_cterm: cterm -> int
59621
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
    40
  val global_cterm_of: theory -> term -> cterm
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
    41
  val cterm_of: Proof.context -> term -> cterm
59969
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
    42
  val renamed_term: term -> cterm -> cterm
74270
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
    43
  val fast_term_ord: cterm ord
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
    44
  val term_ord: cterm ord
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    45
  val dest_comb: cterm -> cterm * cterm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    46
  val dest_fun: cterm -> cterm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    47
  val dest_arg: cterm -> cterm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    48
  val dest_fun2: cterm -> cterm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    49
  val dest_arg1: cterm -> cterm
74525
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
    50
  val dest_abs_fresh: string -> cterm -> cterm * cterm
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
    51
  val dest_abs_global: cterm -> cterm * cterm
60952
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
    52
  val rename_tvar: indexname -> ctyp -> ctyp
81855
a001d14f150c more direct Thm.free: avoid re-certification;
wenzelm
parents: 81540
diff changeset
    53
  val free: string * ctyp -> cterm
60951
b70c4db3874f produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60949
diff changeset
    54
  val var: indexname * ctyp -> cterm
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    55
  val apply: cterm -> cterm -> cterm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    56
  val lambda_name: string * cterm -> cterm -> cterm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    57
  val lambda: cterm -> cterm -> cterm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    58
  val adjust_maxidx_cterm: int -> cterm -> cterm
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    59
  val incr_indexes_cterm: int -> cterm -> cterm
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
    60
  val match: cterm * cterm -> ctyp TVars.table * cterm Vars.table
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
    61
  val first_order_match: cterm * cterm -> ctyp TVars.table * cterm Vars.table
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
    62
  (*theorems*)
74241
eb265f54e3ce more efficient operations: traverse hyps only when required;
wenzelm
parents: 74235
diff changeset
    63
  val fold_terms: {hyps: bool} -> (term -> 'a -> 'a) -> thm -> 'a -> 'a
81959
fae61f1c8113 minor performance tuning: more fine-grained guard to skip irrelevant items;
wenzelm
parents: 81958
diff changeset
    64
  val fold_atomic_ctyps: {hyps: bool} ->
fae61f1c8113 minor performance tuning: more fine-grained guard to skip irrelevant items;
wenzelm
parents: 81958
diff changeset
    65
    ('a -> typ -> bool) -> (ctyp -> 'a -> 'a) -> thm -> 'a -> 'a
fae61f1c8113 minor performance tuning: more fine-grained guard to skip irrelevant items;
wenzelm
parents: 81958
diff changeset
    66
  val fold_atomic_cterms: {hyps: bool} ->
fae61f1c8113 minor performance tuning: more fine-grained guard to skip irrelevant items;
wenzelm
parents: 81958
diff changeset
    67
    ('a -> term -> bool) -> (cterm -> 'a -> 'a) -> thm -> 'a -> 'a
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    68
  val terms_of_tpairs: (term * term) list -> term list
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    69
  val full_prop_of: thm -> term
65458
cf504b7a7aa7 tuned signature;
wenzelm
parents: 64981
diff changeset
    70
  val theory_id: thm -> Context.theory_id
77889
5db014c36f42 clarified signature: explicitly distinguish theory_base_name vs. theory_long_name;
wenzelm
parents: 77877
diff changeset
    71
  val theory_name: {long: bool} -> thm -> string
5db014c36f42 clarified signature: explicitly distinguish theory_base_name vs. theory_long_name;
wenzelm
parents: 77877
diff changeset
    72
  val theory_long_name: thm -> string
5db014c36f42 clarified signature: explicitly distinguish theory_base_name vs. theory_long_name;
wenzelm
parents: 77877
diff changeset
    73
  val theory_base_name: thm -> string
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    74
  val maxidx_of: thm -> int
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    75
  val maxidx_thm: thm -> int -> int
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
    76
  val shyps_of: thm -> sort Ord_List.T
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
    77
  val hyps_of: thm -> term list
16425
2427be27cc60 accomodate identification of type Sign.sg and theory;
wenzelm
parents: 16352
diff changeset
    78
  val prop_of: thm -> term
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    79
  val tpairs_of: thm -> (term * term) list
16656
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
    80
  val concl_of: thm -> term
16425
2427be27cc60 accomodate identification of type Sign.sg and theory;
wenzelm
parents: 16352
diff changeset
    81
  val prems_of: thm -> term list
81952
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
    82
  val take_prems_of: int -> thm -> term list
16425
2427be27cc60 accomodate identification of type Sign.sg and theory;
wenzelm
parents: 16352
diff changeset
    83
  val nprems_of: thm -> int
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    84
  val no_prems: thm -> bool
81952
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
    85
  val prem_of: thm -> int -> term
59582
0fbed69ff081 tuned signature -- prefer qualified names;
wenzelm
parents: 59058
diff changeset
    86
  val major_prem_of: thm -> term
16425
2427be27cc60 accomodate identification of type Sign.sg and theory;
wenzelm
parents: 16352
diff changeset
    87
  val cprop_of: thm -> cterm
18145
6757627acf59 renamed Thm.cgoal_of to Thm.cprem_of;
wenzelm
parents: 18127
diff changeset
    88
  val cprem_of: thm -> int -> cterm
69101
991a3feaf270 more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents: 68692
diff changeset
    89
  val cconcl_of: thm -> cterm
991a3feaf270 more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents: 68692
diff changeset
    90
  val cprems_of: thm -> cterm list
81952
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
    91
  val take_cprems_of: int -> thm -> cterm list
60949
ccbf9379e355 added Thm.chyps_of;
wenzelm
parents: 60948
diff changeset
    92
  val chyps_of: thm -> cterm list
74270
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
    93
  val thm_ord: thm ord
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
    94
  exception CONTEXT of string * ctyp list * cterm list * thm list * Context.generic option
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
    95
  val theory_of_cterm: cterm -> theory
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
    96
  val theory_of_thm: thm -> theory
67697
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
    97
  val trim_context_ctyp: ctyp -> ctyp
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
    98
  val trim_context_cterm: cterm -> cterm
70156
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
    99
  val transfer_ctyp: theory -> ctyp -> ctyp
78135
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   100
  val transfer_ctyp': Proof.context -> ctyp -> ctyp
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   101
  val transfer_ctyp'': Context.generic -> ctyp -> ctyp
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   102
  val transfer_cterm: theory -> cterm -> cterm
78135
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   103
  val transfer_cterm': Proof.context -> cterm -> cterm
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   104
  val transfer_cterm'': Context.generic -> cterm -> cterm
38709
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   105
  val transfer: theory -> thm -> thm
67649
1e1782c1aedf tuned signature;
wenzelm
parents: 67331
diff changeset
   106
  val transfer': Proof.context -> thm -> thm
1e1782c1aedf tuned signature;
wenzelm
parents: 67331
diff changeset
   107
  val transfer'': Context.generic -> thm -> thm
70310
c82f59c47aaf clarified transfer_morphism: implicit join_certificate, e.g. relevant for complex cascades of morphisms such as class locale interpretation;
wenzelm
parents: 70159
diff changeset
   108
  val join_transfer: theory -> thm -> thm
70313
9c19e15c8548 more structural integrity;
wenzelm
parents: 70310
diff changeset
   109
  val join_transfer_context: Proof.context * thm -> Proof.context * thm
59969
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
   110
  val renamed_prop: term -> thm -> thm
38709
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   111
  val weaken: cterm -> thm -> thm
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   112
  val weaken_sorts: sort list -> cterm -> cterm
44333
cc53ce50f738 reverted to join_bodies/join_proofs based on fold_body_thms to regain performance (escpecially of HOL-Proofs) -- see also aa9c1e9ef2ce and 4e2abb045eac;
wenzelm
parents: 44331
diff changeset
   113
  val proof_bodies_of: thm list -> proof_body list
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   114
  val proof_body_of: thm -> proof_body
79430
2e834ee3b348 tuned signature;
wenzelm
parents: 79425
diff changeset
   115
  val zproof_of: thm -> zproof
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   116
  val proof_of: thm -> proof
71088
4b45d592ce29 clarified modules;
wenzelm
parents: 71018
diff changeset
   117
  val reconstruct_proof_of: thm -> Proofterm.proof
66168
fcd09fc36d7f consolidate proofs more simultaneously;
wenzelm
parents: 65458
diff changeset
   118
  val consolidate: thm list -> unit
71011
2c96e48027eb clarified modules;
wenzelm
parents: 70923
diff changeset
   119
  val expose_proofs: theory -> thm list -> unit
71017
c85efa2be619 expose derivations more thoroughly, notably for locale/class reasoning;
wenzelm
parents: 71012
diff changeset
   120
  val expose_proof: theory -> thm -> unit
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   121
  val future: thm future -> cterm -> thm
77866
3bd1aa2f3517 backout 61f652dd955a;
wenzelm
parents: 77864
diff changeset
   122
  val thm_deps: thm -> Proofterm.thm Ord_List.T
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   123
  val extra_shyps: thm -> sort list
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
   124
  val strip_shyps: thm -> thm
64568
a504a3dec35a more careful derivation_closed / close_derivation;
wenzelm
parents: 63858
diff changeset
   125
  val derivation_closed: thm -> bool
80295
8a9588ffc133 more accurate Thm_Name.T for PThm / Thm.name_derivation / Thm.derivation_name;
wenzelm
parents: 80289
diff changeset
   126
  val derivation_name: thm -> Thm_Name.T
70554
10d41bf28b92 clarified signature;
wenzelm
parents: 70551
diff changeset
   127
  val derivation_id: thm -> Proofterm.thm_id option
80590
505f97165f52 clarified thm_header command_pos vs. thm_pos;
wenzelm
parents: 80579
diff changeset
   128
  val raw_derivation_name: thm -> Thm_Name.P
505f97165f52 clarified thm_header command_pos vs. thm_pos;
wenzelm
parents: 80579
diff changeset
   129
  val expand_name: thm -> Proofterm.thm_header -> Thm_Name.P option
80295
8a9588ffc133 more accurate Thm_Name.T for PThm / Thm.name_derivation / Thm.derivation_name;
wenzelm
parents: 80289
diff changeset
   130
  val name_derivation: Thm_Name.P -> thm -> thm
70494
41108e3e9ca5 formal position for PThm nodes;
wenzelm
parents: 70482
diff changeset
   131
  val close_derivation: Position.T -> thm -> thm
70480
1a1b7d7f24bb explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents: 70475
diff changeset
   132
  val trim_context: thm -> thm
28675
fb68c0767004 renamed get_axiom_i to axiom, removed obsolete get_axiom;
wenzelm
parents: 28648
diff changeset
   133
  val axiom: theory -> string -> thm
70923
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   134
  val all_axioms_of: theory -> (string * thm) list
28017
4919bd124a58 type Properties.T;
wenzelm
parents: 27336
diff changeset
   135
  val get_tags: thm -> Properties.T
4919bd124a58 type Properties.T;
wenzelm
parents: 27336
diff changeset
   136
  val map_tags: (Properties.T -> Properties.T) -> thm -> thm
23781
ab793a6ddf9f Added function norm_proof for normalizing the proof term
berghofe
parents: 23657
diff changeset
   137
  val norm_proof: thm -> thm
20261
af51389aa756 adjust_maxidx: pass explicit lower bound;
wenzelm
parents: 20071
diff changeset
   138
  val adjust_maxidx_thm: int -> thm -> thm
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   139
  (*type classes*)
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   140
  val the_classrel: theory -> class * class -> thm
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   141
  val the_arity: theory -> string * sort list * class -> thm
79425
0875c87b4a4b clarified signature;
wenzelm
parents: 79418
diff changeset
   142
  val sorts_zproof: theory -> ZTerm.sorts_proof
79405
f4fdf5eebcac pro-forma support for ZTerm.sorts_zproof;
wenzelm
parents: 79404
diff changeset
   143
  val sorts_proof: theory -> Proofterm.sorts_proof
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   144
  (*oracles*)
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   145
  val add_oracle: binding * ('a -> cterm) -> theory -> (string * ('a -> thm)) * theory
70560
7714971a58b5 added command 'thm_oracles';
wenzelm
parents: 70558
diff changeset
   146
  val oracle_space: theory -> Name_Space.T
7714971a58b5 added command 'thm_oracles';
wenzelm
parents: 70558
diff changeset
   147
  val pretty_oracle: Proof.context -> string -> Pretty.T
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   148
  val extern_oracles: bool -> Proof.context -> (Markup.T * xstring) list
70565
d0b75c59beca added ML antiquotation @{oracle_name};
wenzelm
parents: 70564
diff changeset
   149
  val check_oracle: Proof.context -> xstring * Position.T -> string
59589
6020e3dec7b5 removed unused;
wenzelm
parents: 59586
diff changeset
   150
  (*inference rules*)
81938
d25181c1807a clarified exceptions;
wenzelm
parents: 81855
diff changeset
   151
  val assume: cterm -> thm  (*exception THM*)
d25181c1807a clarified exceptions;
wenzelm
parents: 81855
diff changeset
   152
  val assume_cterm: cterm -> thm  (*exception CTERM*)
38709
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   153
  val implies_intr: cterm -> thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   154
  val implies_elim: thm -> thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   155
  val forall_intr: cterm -> thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   156
  val forall_elim: cterm -> thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   157
  val reflexive: cterm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   158
  val symmetric: thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   159
  val transitive: thm -> thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   160
  val beta_conversion: bool -> conv
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   161
  val eta_conversion: conv
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   162
  val eta_long_conversion: conv
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   163
  val abstract_rule: string -> cterm -> thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   164
  val combination: thm -> thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   165
  val equal_intr: thm -> thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   166
  val equal_elim: thm -> thm -> thm
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   167
  val solve_constraints: thm -> thm
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
   168
  val flexflex_rule: Proof.context option -> thm -> thm Seq.seq
74266
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
   169
  val generalize: Names.set * Names.set -> int -> thm -> thm
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
   170
  val generalize_cterm: Names.set * Names.set -> int -> cterm -> cterm
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
   171
  val generalize_ctyp: Names.set -> int -> ctyp -> ctyp
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
   172
  val instantiate: ctyp TVars.table * cterm Vars.table -> thm -> thm
74577
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
   173
  val instantiate_beta: ctyp TVars.table * cterm Vars.table -> thm -> thm
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
   174
  val instantiate_cterm: ctyp TVars.table * cterm Vars.table -> cterm -> cterm
74577
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
   175
  val instantiate_beta_cterm: ctyp TVars.table * cterm Vars.table -> cterm -> cterm
38709
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   176
  val trivial: cterm -> thm
36330
0584e203960e renamed Drule.unconstrainTs to Thm.unconstrain_allTs to accomdate the version by krauss/schropp;
wenzelm
parents: 35986
diff changeset
   177
  val of_class: ctyp * class -> thm
36768
46be86127972 just one version of Thm.unconstrainT, which affects all variables;
wenzelm
parents: 36744
diff changeset
   178
  val unconstrainT: thm -> thm
79134
5f0bbed1c606 misc tuning and clarification;
wenzelm
parents: 79133
diff changeset
   179
  val varifyT_global': TFrees.set -> thm -> ((string * sort) * (indexname * sort)) list * thm
38709
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   180
  val varifyT_global: thm -> thm
36615
88756a5a92fc renamed Thm.freezeT to Thm.legacy_freezeT -- it is based on Type.legacy_freeze;
wenzelm
parents: 36614
diff changeset
   181
  val legacy_freezeT: thm -> thm
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   182
  val plain_prop_of: thm -> term
79365
b5853d438dbe more operations;
wenzelm
parents: 79364
diff changeset
   183
  val get_zproof_serials: theory -> serial list
79431
236d866ead4e tuned signature;
wenzelm
parents: 79430
diff changeset
   184
  val get_zproof: theory -> serial ->
80289
40a6a6ac1669 tuned signature;
wenzelm
parents: 79474
diff changeset
   185
    {name: Thm_Name.P, thm: thm, zboxes: ZTerm.zboxes, zproof: zproof} option
40a6a6ac1669 tuned signature;
wenzelm
parents: 79474
diff changeset
   186
  val store_zproof: Thm_Name.P -> thm -> theory -> thm * theory
59969
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
   187
  val dest_state: thm * int -> (term * term) list * term list * term * term
38709
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   188
  val lift_rule: cterm -> thm -> thm
04414091f3b5 structure Thm: less pervasive names;
wenzelm
parents: 37309
diff changeset
   189
  val incr_indexes: int -> thm -> thm
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
   190
  val assumption: Proof.context option -> int -> thm -> thm Seq.seq
31945
d5f186aa0bed structure Thm: less pervasive names;
wenzelm
parents: 31944
diff changeset
   191
  val eq_assumption: int -> thm -> thm
d5f186aa0bed structure Thm: less pervasive names;
wenzelm
parents: 31944
diff changeset
   192
  val rotate_rule: int -> int -> thm -> thm
d5f186aa0bed structure Thm: less pervasive names;
wenzelm
parents: 31944
diff changeset
   193
  val permute_prems: int -> int -> thm -> thm
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
   194
  val bicompose: Proof.context option -> {flatten: bool, match: bool, incremented: bool} ->
52223
5bb6ae8acb87 tuned signature -- more explicit flags for low-level Thm.bicompose;
wenzelm
parents: 52222
diff changeset
   195
    bool * thm * int -> int -> thm -> thm Seq.seq
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
   196
  val biresolution: Proof.context option -> bool -> (bool * thm) list -> int -> thm -> thm Seq.seq
77891
f4cd6e3b5075 prefer theory_long_name in data;
wenzelm
parents: 77889
diff changeset
   197
  val theory_names_of_arity: {long: bool} -> theory -> string * class -> string list
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   198
  val add_classrel: thm -> theory -> theory
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   199
  val add_arity: thm -> theory -> theory
6089
4d2d5556b4f9 signature BASIC_THM;
wenzelm
parents: 5624
diff changeset
   200
end;
4d2d5556b4f9 signature BASIC_THM;
wenzelm
parents: 5624
diff changeset
   201
32590
95f4f08f950f replaced opaque signature matching by plain old abstype (again, cf. ac4498f95d1c) -- this recovers pretty printing in SML/NJ and Poly/ML 5.3;
wenzelm
parents: 32198
diff changeset
   202
structure Thm: THM =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   203
struct
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   204
387
69f4356d915d new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents: 309
diff changeset
   205
(*** Certified terms and types ***)
69f4356d915d new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents: 309
diff changeset
   206
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   207
(** certified types **)
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   208
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   209
datatype ctyp = Ctyp of {cert: Context.certificate, T: typ, maxidx: int, sorts: sort Ord_List.T};
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   210
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   211
fun typ_of (Ctyp {T, ...}) = T;
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   212
81958
87cc86357dc2 proper treatment of variables with the same name, but different sorts/types: this routinely happens in HOL Light (see also 0e2f019477e2), as well as theory "HOL-Algebra.Algebraic_Closure_Type" (line 77);
wenzelm
parents: 81952
diff changeset
   213
fun maxidx_of_ctyp (Ctyp {maxidx, ...}) = maxidx;
87cc86357dc2 proper treatment of variables with the same name, but different sorts/types: this routinely happens in HOL Light (see also 0e2f019477e2), as well as theory "HOL-Algebra.Algebraic_Closure_Type" (line 77);
wenzelm
parents: 81952
diff changeset
   214
59621
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
   215
fun global_ctyp_of thy raw_T =
24143
90a9a6fe0d01 replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents: 23781
diff changeset
   216
  let
90a9a6fe0d01 replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents: 23781
diff changeset
   217
    val T = Sign.certify_typ thy raw_T;
90a9a6fe0d01 replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents: 23781
diff changeset
   218
    val maxidx = Term.maxidx_of_typ T;
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   219
    val sorts = Sorts.insert_typ T [];
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   220
  in Ctyp {cert = Context.Certificate thy, T = T, maxidx = maxidx, sorts = sorts} end;
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   221
59621
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
   222
val ctyp_of = global_ctyp_of o Proof_Context.theory_of;
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
   223
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   224
fun dest_ctyp (Ctyp {cert, T = Type (_, Ts), maxidx, sorts}) =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   225
      map (fn T => Ctyp {cert = cert, T = T, maxidx = maxidx, sorts = sorts}) Ts
16679
abd1461fa288 dest_ctyp: raise exception for non-constructor;
wenzelm
parents: 16656
diff changeset
   226
  | dest_ctyp cT = raise TYPE ("dest_ctyp", [typ_of cT], []);
15087
666f89fbb860 - optimized nodup_vars check in capply
berghofe
parents: 14828
diff changeset
   227
70159
57503fe1b0ff tuned signature;
wenzelm
parents: 70156
diff changeset
   228
fun dest_ctypN n (Ctyp {cert, T, maxidx, sorts}) =
57503fe1b0ff tuned signature;
wenzelm
parents: 70156
diff changeset
   229
  let fun err () = raise TYPE ("dest_ctypN", [T], []) in
70153
8a23083ac011 prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents: 70150
diff changeset
   230
    (case T of
8a23083ac011 prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents: 70150
diff changeset
   231
      Type (_, Ts) =>
70159
57503fe1b0ff tuned signature;
wenzelm
parents: 70156
diff changeset
   232
        Ctyp {cert = cert, T = nth Ts n handle General.Subscript => err (),
70153
8a23083ac011 prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents: 70150
diff changeset
   233
          maxidx = maxidx, sorts = sorts}
8a23083ac011 prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents: 70150
diff changeset
   234
    | _ => err ())
8a23083ac011 prefer exception TYPE, e.g. when used within conversion;
wenzelm
parents: 70150
diff changeset
   235
  end;
70150
cf408ea5f505 tuned signature -- more ctyp operations;
wenzelm
parents: 69101
diff changeset
   236
70156
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   237
fun join_certificate_ctyp (Ctyp {cert, ...}) cert0 = Context.join_certificate (cert0, cert);
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   238
fun union_sorts_ctyp (Ctyp {sorts, ...}) sorts0 = Sorts.union sorts0 sorts;
70156
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   239
fun maxidx_ctyp (Ctyp {maxidx, ...}) maxidx0 = Int.max (maxidx0, maxidx);
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   240
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   241
fun make_ctyp (Ctyp {cert, T, maxidx = _, sorts = _}) cargs =
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   242
  let
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   243
    val As = map typ_of cargs;
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   244
    fun err () = raise TYPE ("make_ctyp", T :: As, []);
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   245
  in
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   246
    (case T of
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   247
      Type (a, args) =>
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   248
        Ctyp {
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   249
          cert = fold join_certificate_ctyp cargs cert,
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   250
          maxidx = fold maxidx_ctyp cargs ~1,
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   251
          sorts = fold union_sorts_ctyp cargs [],
70156
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   252
          T = if length args = length cargs then Type (a, As) else err ()}
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   253
    | _ => err ())
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   254
  end;
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   255
229
4002c4cd450c Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents: 225
diff changeset
   256
4002c4cd450c Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents: 225
diff changeset
   257
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   258
(** certified terms **)
229
4002c4cd450c Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents: 225
diff changeset
   259
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   260
(*certified terms with checked typ, maxidx, and sorts*)
70453
492cb3aaa562 simplified module structure: back to plain datatype (see 95f4f08f950f and 70019ab5e57f);
wenzelm
parents: 70404
diff changeset
   261
datatype cterm =
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   262
  Cterm of {cert: Context.certificate, t: term, T: typ, maxidx: int, sorts: sort Ord_List.T};
16425
2427be27cc60 accomodate identification of type Sign.sg and theory;
wenzelm
parents: 16352
diff changeset
   263
22584
d0f0f37ec346 improved exception CTERM;
wenzelm
parents: 22573
diff changeset
   264
exception CTERM of string * cterm list;
16679
abd1461fa288 dest_ctyp: raise exception for non-constructor;
wenzelm
parents: 16656
diff changeset
   265
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   266
fun term_of (Cterm {t, ...}) = t;
229
4002c4cd450c Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents: 225
diff changeset
   267
59586
ddf6deaadfe8 clarified signature;
wenzelm
parents: 59582
diff changeset
   268
fun typ_of_cterm (Cterm {T, ...}) = T;
ddf6deaadfe8 clarified signature;
wenzelm
parents: 59582
diff changeset
   269
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   270
fun ctyp_of_cterm (Cterm {cert, T, maxidx, sorts, ...}) =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   271
  Ctyp {cert = cert, T = T, maxidx = maxidx, sorts = sorts};
2671
510d94c71dda Introduction of rotate_rule
paulson
parents: 2626
diff changeset
   272
59586
ddf6deaadfe8 clarified signature;
wenzelm
parents: 59582
diff changeset
   273
fun maxidx_of_cterm (Cterm {maxidx, ...}) = maxidx;
ddf6deaadfe8 clarified signature;
wenzelm
parents: 59582
diff changeset
   274
59621
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
   275
fun global_cterm_of thy tm =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   276
  let
79454
6b6e9af552f5 clarified signature: avoid redundant Term.maxidx_of_term;
wenzelm
parents: 79431
diff changeset
   277
    val (t, T) = Sign.certify_term thy tm;
6b6e9af552f5 clarified signature: avoid redundant Term.maxidx_of_term;
wenzelm
parents: 79431
diff changeset
   278
    val maxidx = Term.maxidx_of_term t;
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   279
    val sorts = Sorts.insert_term t [];
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   280
  in Cterm {cert = Context.Certificate thy, t = t, T = T, maxidx = maxidx, sorts = sorts} end;
229
4002c4cd450c Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents: 225
diff changeset
   281
59621
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
   282
val cterm_of = global_cterm_of o Proof_Context.theory_of;
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
   283
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   284
fun join_certificate0 (Cterm {cert = cert1, ...}, Cterm {cert = cert2, ...}) =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   285
  Context.join_certificate (cert1, cert2);
60315
c08adefc98ea more explicit context;
wenzelm
parents: 59969
diff changeset
   286
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   287
fun renamed_term t' (Cterm {cert, t, T, maxidx, sorts}) =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   288
  if t aconv t' then Cterm {cert = cert, t = t', T = T, maxidx = maxidx, sorts = sorts}
59969
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
   289
  else raise TERM ("renamed_term: terms disagree", [t, t']);
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
   290
74270
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
   291
val fast_term_ord = Term_Ord.fast_term_ord o apply2 term_of;
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
   292
val term_ord = Term_Ord.term_ord o apply2 term_of;
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
   293
20580
6fb75df09253 added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents: 20548
diff changeset
   294
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   295
(* destructors *)
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   296
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   297
fun dest_comb (Cterm {t = c $ a, T, cert, maxidx, sorts}) =
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   298
      let val A = Term.argument_type_of c 0 in
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   299
        (Cterm {t = c, T = A --> T, cert = cert, maxidx = maxidx, sorts = sorts},
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   300
         Cterm {t = a, T = A, cert = cert, maxidx = maxidx, sorts = sorts})
1493
e936723cb94d added dest_comb, dest_abs and mk_prop for manipulating cterms
clasohm
parents: 1460
diff changeset
   301
      end
22584
d0f0f37ec346 improved exception CTERM;
wenzelm
parents: 22573
diff changeset
   302
  | dest_comb ct = raise CTERM ("dest_comb", [ct]);
1493
e936723cb94d added dest_comb, dest_abs and mk_prop for manipulating cterms
clasohm
parents: 1460
diff changeset
   303
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   304
fun dest_fun (Cterm {t = c $ _, T, cert, maxidx, sorts}) =
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   305
      let val A = Term.argument_type_of c 0
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   306
      in Cterm {t = c, T = A --> T, cert = cert, maxidx = maxidx, sorts = sorts} end
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   307
  | dest_fun ct = raise CTERM ("dest_fun", [ct]);
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   308
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   309
fun dest_arg (Cterm {t = c $ a, T = _, cert, maxidx, sorts}) =
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   310
      let val A = Term.argument_type_of c 0
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   311
      in Cterm {t = a, T = A, cert = cert, maxidx = maxidx, sorts = sorts} end
22584
d0f0f37ec346 improved exception CTERM;
wenzelm
parents: 22573
diff changeset
   312
  | dest_arg ct = raise CTERM ("dest_arg", [ct]);
20580
6fb75df09253 added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents: 20548
diff changeset
   313
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   314
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   315
fun dest_fun2 (Cterm {t = c $ _ $ _, T, cert, maxidx, sorts}) =
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   316
      let
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   317
        val A = Term.argument_type_of c 0;
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   318
        val B = Term.argument_type_of c 1;
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   319
      in Cterm {t = c, T = A --> B --> T, cert = cert, maxidx = maxidx, sorts = sorts} end
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   320
  | dest_fun2 ct = raise CTERM ("dest_fun2", [ct]);
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   321
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   322
fun dest_arg1 (Cterm {t = c $ a $ _, T = _, cert, maxidx, sorts}) =
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   323
      let val A = Term.argument_type_of c 0
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   324
      in Cterm {t = a, T = A, cert = cert, maxidx = maxidx, sorts = sorts} end
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   325
  | dest_arg1 ct = raise CTERM ("dest_arg1", [ct]);
20673
27738ccd0700 added dest_binop;
wenzelm
parents: 20580
diff changeset
   326
74525
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   327
fun gen_dest_abs dest ct =
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   328
  (case ct of
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   329
    Cterm {t = t as Abs _, T = Type ("fun", [_, U]), cert, maxidx, sorts} =>
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   330
      let
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   331
        val ((x', T), t') = dest t;
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   332
        val v = Cterm {t = Free (x', T), T = T, cert = cert, maxidx = maxidx, sorts = sorts};
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   333
        val body = Cterm {t = t', T = U, cert = cert, maxidx = maxidx, sorts = sorts};
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   334
      in (v, body) end
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   335
  | _ => raise CTERM ("dest_abs", [ct]));
74518
de4f151c2a34 clarified signature;
wenzelm
parents: 74509
diff changeset
   336
74525
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   337
val dest_abs_fresh = gen_dest_abs o Term.dest_abs_fresh;
c960bfcb91db discontinued Term.dest_abs / Logic.dest_all, which are officially superseded by Variable.dest_abs etc., but there are also Term.dest_abs_global to recover existing tools easily;
wenzelm
parents: 74518
diff changeset
   338
val dest_abs_global = gen_dest_abs Term.dest_abs_global;
1493
e936723cb94d added dest_comb, dest_abs and mk_prop for manipulating cterms
clasohm
parents: 1460
diff changeset
   339
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   340
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   341
(* constructors *)
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   342
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   343
fun rename_tvar (a, i) (Ctyp {cert, T, maxidx, sorts}) =
60952
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
   344
  let
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
   345
    val S =
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
   346
      (case T of
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
   347
        TFree (_, S) => S
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
   348
      | TVar (_, S) => S
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
   349
      | _ => raise TYPE ("rename_tvar: no variable", [T], []));
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
   350
    val _ = if i < 0 then raise TYPE ("rename_tvar: bad index", [TVar ((a, i), S)], []) else ();
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   351
  in Ctyp {cert = cert, T = TVar ((a, i), S), maxidx = Int.max (i, maxidx), sorts = sorts} end;
60952
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
   352
81855
a001d14f150c more direct Thm.free: avoid re-certification;
wenzelm
parents: 81540
diff changeset
   353
fun free (x, Ctyp {cert, T, maxidx, sorts}) =
a001d14f150c more direct Thm.free: avoid re-certification;
wenzelm
parents: 81540
diff changeset
   354
  Cterm {cert = cert, t = Free (x, T), T = T, maxidx = maxidx, sorts = sorts};
a001d14f150c more direct Thm.free: avoid re-certification;
wenzelm
parents: 81540
diff changeset
   355
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   356
fun var ((x, i), Ctyp {cert, T, maxidx, sorts}) =
60951
b70c4db3874f produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60949
diff changeset
   357
  if i < 0 then raise TERM ("var: bad index", [Var ((x, i), T)])
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   358
  else Cterm {cert = cert, t = Var ((x, i), T), T = T, maxidx = Int.max (i, maxidx), sorts = sorts};
60951
b70c4db3874f produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60949
diff changeset
   359
46497
89ccf66aa73d renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents: 46475
diff changeset
   360
fun apply
16656
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
   361
  (cf as Cterm {t = f, T = Type ("fun", [dty, rty]), maxidx = maxidx1, sorts = sorts1, ...})
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
   362
  (cx as Cterm {t = x, T, maxidx = maxidx2, sorts = sorts2, ...}) =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   363
    if T = dty then
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   364
      Cterm {cert = join_certificate0 (cf, cx),
16656
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
   365
        t = f $ x,
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
   366
        T = rty,
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
   367
        maxidx = Int.max (maxidx1, maxidx2),
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   368
        sorts = Sorts.union sorts1 sorts2}
46497
89ccf66aa73d renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents: 46475
diff changeset
   369
      else raise CTERM ("apply: types don't agree", [cf, cx])
89ccf66aa73d renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents: 46475
diff changeset
   370
  | apply cf cx = raise CTERM ("apply: first arg is not a function", [cf, cx]);
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
   371
46497
89ccf66aa73d renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents: 46475
diff changeset
   372
fun lambda_name
32198
9bdd47909ea8 lambda/cabs/all: named variants;
wenzelm
parents: 32104
diff changeset
   373
  (x, ct1 as Cterm {t = t1, T = T1, maxidx = maxidx1, sorts = sorts1, ...})
16656
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
   374
  (ct2 as Cterm {t = t2, T = T2, maxidx = maxidx2, sorts = sorts2, ...}) =
32198
9bdd47909ea8 lambda/cabs/all: named variants;
wenzelm
parents: 32104
diff changeset
   375
    let val t = Term.lambda_name (x, t1) t2 in
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   376
      Cterm {cert = join_certificate0 (ct1, ct2),
16656
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
   377
        t = t, T = T1 --> T2,
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
   378
        maxidx = Int.max (maxidx1, maxidx2),
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   379
        sorts = Sorts.union sorts1 sorts2}
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   380
    end;
229
4002c4cd450c Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents: 225
diff changeset
   381
46497
89ccf66aa73d renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents: 46475
diff changeset
   382
fun lambda t u = lambda_name ("", t) u;
32198
9bdd47909ea8 lambda/cabs/all: named variants;
wenzelm
parents: 32104
diff changeset
   383
20580
6fb75df09253 added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents: 20548
diff changeset
   384
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   385
(* indexes *)
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   386
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   387
fun adjust_maxidx_cterm i (ct as Cterm {cert, t, T, maxidx, sorts}) =
20580
6fb75df09253 added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents: 20548
diff changeset
   388
  if maxidx = i then ct
6fb75df09253 added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents: 20548
diff changeset
   389
  else if maxidx < i then
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   390
    Cterm {maxidx = i, cert = cert, t = t, T = T, sorts = sorts}
20580
6fb75df09253 added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents: 20548
diff changeset
   391
  else
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   392
    Cterm {maxidx = Int.max (maxidx_of_term t, i), cert = cert, t = t, T = T, sorts = sorts};
20580
6fb75df09253 added dest_arg, i.e. a tuned version of #2 o dest_comb;
wenzelm
parents: 20548
diff changeset
   393
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   394
fun incr_indexes_cterm i (ct as Cterm {cert, t, T, maxidx, sorts}) =
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   395
  if i < 0 then raise CTERM ("negative increment", [ct])
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   396
  else if i = 0 then ct
79232
99bc2dd45111 more general Logic.incr_indexes_operation;
wenzelm
parents: 79227
diff changeset
   397
  else Cterm {cert = cert, t = Logic.incr_indexes ([], i) t,
22909
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   398
    T = Logic.incr_tvar i T, maxidx = maxidx + i, sorts = sorts};
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   399
7de3b0ac4189 added dest_fun/fun2/arg1;
wenzelm
parents: 22685
diff changeset
   400
2509
0a7169d89b7a added termless parameter;
wenzelm
parents: 2386
diff changeset
   401
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   402
(*** Derivations and Theorems ***)
229
4002c4cd450c Pure: MAJOR CHANGE. Moved ML types ctyp and cterm and their associated
lcp
parents: 225
diff changeset
   403
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   404
(* sort constraints *)
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   405
70480
1a1b7d7f24bb explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents: 70475
diff changeset
   406
type constraint = {theory: theory, typ: typ, sort: sort};
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   407
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   408
local
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   409
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   410
val constraint_ord : constraint ord =
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   411
  Context.theory_id_ord o apply2 (Context.theory_id o #theory)
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   412
  ||| Term_Ord.typ_ord o apply2 #typ
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   413
  ||| Term_Ord.sort_ord o apply2 #sort;
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   414
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   415
val smash_atyps =
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   416
  map_atyps (fn TVar (_, S) => Term.aT S | TFree (_, S) => Term.aT S | T => T);
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   417
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   418
in
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   419
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   420
val union_constraints = Ord_List.union constraint_ord;
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   421
79304
wenzelm
parents: 79279
diff changeset
   422
fun insert_constraints _ (_, []) = I
wenzelm
parents: 79279
diff changeset
   423
  | insert_constraints thy (T, S) =
wenzelm
parents: 79279
diff changeset
   424
      let
wenzelm
parents: 79279
diff changeset
   425
        val ignored =
wenzelm
parents: 79279
diff changeset
   426
          (case T of
wenzelm
parents: 79279
diff changeset
   427
            TFree (_, S') => S = S'
wenzelm
parents: 79279
diff changeset
   428
          | TVar (_, S') => S = S'
wenzelm
parents: 79279
diff changeset
   429
          | _ => false);
wenzelm
parents: 79279
diff changeset
   430
      in
wenzelm
parents: 79279
diff changeset
   431
        if ignored then I
wenzelm
parents: 79279
diff changeset
   432
        else Ord_List.insert constraint_ord {theory = thy, typ = smash_atyps T, sort = S}
wenzelm
parents: 79279
diff changeset
   433
      end;
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   434
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   435
fun insert_constraints_env thy env =
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   436
  let
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   437
    val tyenv = Envir.type_env env;
79305
wenzelm
parents: 79304
diff changeset
   438
    val normT = Envir.norm_type tyenv;
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   439
    fun insert ([], _) = I
79305
wenzelm
parents: 79304
diff changeset
   440
      | insert (S, T) = insert_constraints thy (normT T, S);
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   441
  in tyenv |> Vartab.fold (insert o #2) end;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   442
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   443
end;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   444
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   445
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   446
(* datatype thm *)
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   447
70453
492cb3aaa562 simplified module structure: back to plain datatype (see 95f4f08f950f and 70019ab5e57f);
wenzelm
parents: 70404
diff changeset
   448
datatype thm = Thm of
40124
fc77d3211f71 recovered some odd two-dimensional layout;
wenzelm
parents: 39687
diff changeset
   449
 deriv *                        (*derivation*)
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   450
 {cert: Context.certificate,    (*background theory certificate*)
40124
fc77d3211f71 recovered some odd two-dimensional layout;
wenzelm
parents: 39687
diff changeset
   451
  tags: Properties.T,           (*additional annotations/comments*)
fc77d3211f71 recovered some odd two-dimensional layout;
wenzelm
parents: 39687
diff changeset
   452
  maxidx: int,                  (*maximum index of any Var or TVar*)
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   453
  constraints: constraint Ord_List.T,  (*implicit proof obligations for sort constraints*)
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   454
  shyps: sort Ord_List.T,       (*sort hypotheses*)
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   455
  hyps: term Ord_List.T,        (*hypotheses*)
40124
fc77d3211f71 recovered some odd two-dimensional layout;
wenzelm
parents: 39687
diff changeset
   456
  tpairs: (term * term) list,   (*flex-flex pairs*)
fc77d3211f71 recovered some odd two-dimensional layout;
wenzelm
parents: 39687
diff changeset
   457
  prop: term}                   (*conclusion*)
28624
d983515e5cdf added weaken_sorts;
wenzelm
parents: 28446
diff changeset
   458
and deriv = Deriv of
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
   459
 {promises: (serial * thm future) Ord_List.T,
70453
492cb3aaa562 simplified module structure: back to plain datatype (see 95f4f08f950f and 70019ab5e57f);
wenzelm
parents: 70404
diff changeset
   460
  body: Proofterm.proof_body};
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   461
23601
3a40294140f0 added type conv;
wenzelm
parents: 23493
diff changeset
   462
type conv = cterm -> thm;
3a40294140f0 added type conv;
wenzelm
parents: 23493
diff changeset
   463
16725
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
   464
(*errors involving theorems*)
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
   465
exception THM of string * int * thm list;
13658
c9ad3e64ddcf Changed handling of flex-flex constraints: now stored in separate
berghofe
parents: 13642
diff changeset
   466
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   467
fun rep_thm (Thm (_, args)) = args;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   468
74241
eb265f54e3ce more efficient operations: traverse hyps only when required;
wenzelm
parents: 74235
diff changeset
   469
fun fold_terms h f (Thm (_, {tpairs, prop, hyps, ...})) =
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   470
  fold (fn (t, u) => f t #> f u) tpairs #> f prop #> #hyps h ? fold f hyps;
31947
7daee3bed3af clarified strip_shyps: proper type witnesses for present sorts;
wenzelm
parents: 31945
diff changeset
   471
74244
12dac3698efd clarified signature;
wenzelm
parents: 74241
diff changeset
   472
fun fold_atomic_ctyps h g f (th as Thm (_, {cert, maxidx, shyps, ...})) =
81959
fae61f1c8113 minor performance tuning: more fine-grained guard to skip irrelevant items;
wenzelm
parents: 81958
diff changeset
   473
  let
fae61f1c8113 minor performance tuning: more fine-grained guard to skip irrelevant items;
wenzelm
parents: 81958
diff changeset
   474
    fun ctyp T = Ctyp {cert = cert, T = T, maxidx = maxidx, sorts = shyps};
fae61f1c8113 minor performance tuning: more fine-grained guard to skip irrelevant items;
wenzelm
parents: 81958
diff changeset
   475
    fun apply T a = if g a T then f (ctyp T) a else a;
fae61f1c8113 minor performance tuning: more fine-grained guard to skip irrelevant items;
wenzelm
parents: 81958
diff changeset
   476
  in (fold_terms h o fold_types o fold_atyps) apply th end;
60952
762cb38a3147 produce certified vars without access to theory_of_thm, and without context;
wenzelm
parents: 60951
diff changeset
   477
74244
12dac3698efd clarified signature;
wenzelm
parents: 74241
diff changeset
   478
fun fold_atomic_cterms h g f (th as Thm (_, {cert, maxidx, shyps, ...})) =
12dac3698efd clarified signature;
wenzelm
parents: 74241
diff changeset
   479
  let
12dac3698efd clarified signature;
wenzelm
parents: 74241
diff changeset
   480
    fun cterm t T = Cterm {cert = cert, t = t, T = T, maxidx = maxidx, sorts = shyps};
81959
fae61f1c8113 minor performance tuning: more fine-grained guard to skip irrelevant items;
wenzelm
parents: 81958
diff changeset
   481
    fun apply t T a = if g a t then f (cterm t T) a else a;
74244
12dac3698efd clarified signature;
wenzelm
parents: 74241
diff changeset
   482
  in
74241
eb265f54e3ce more efficient operations: traverse hyps only when required;
wenzelm
parents: 74235
diff changeset
   483
    (fold_terms h o fold_aterms)
74244
12dac3698efd clarified signature;
wenzelm
parents: 74241
diff changeset
   484
      (fn t as Const (_, T) => apply t T
12dac3698efd clarified signature;
wenzelm
parents: 74241
diff changeset
   485
        | t as Free (_, T) => apply t T
12dac3698efd clarified signature;
wenzelm
parents: 74241
diff changeset
   486
        | t as Var (_, T) => apply t T
60818
5e11a6e2b044 more direct access to atomic cterms;
wenzelm
parents: 60642
diff changeset
   487
        | _ => I) th
5e11a6e2b044 more direct access to atomic cterms;
wenzelm
parents: 60642
diff changeset
   488
  end;
5e11a6e2b044 more direct access to atomic cterms;
wenzelm
parents: 60642
diff changeset
   489
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   490
16725
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
   491
fun terms_of_tpairs tpairs = fold_rev (fn (t, u) => cons t o cons u) tpairs [];
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
   492
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
   493
fun eq_tpairs ((t, u), (t', u')) = t aconv t' andalso u aconv u';
18944
7d2ed9063477 union_tpairs: Library.merge;
wenzelm
parents: 18733
diff changeset
   494
fun union_tpairs ts us = Library.merge eq_tpairs (ts, us);
16884
1678a796b6b2 tuned instantiate (avoid subst_atomic, subst_atomic_types);
wenzelm
parents: 16847
diff changeset
   495
val maxidx_tpairs = fold (fn (t, u) => Term.maxidx_term t #> Term.maxidx_term u);
16725
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
   496
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
   497
fun attach_tpairs tpairs prop =
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
   498
  Logic.list_implies (map Logic.mk_equals tpairs, prop);
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
   499
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   500
fun full_prop_of (Thm (_, {tpairs, prop, ...})) = attach_tpairs tpairs prop;
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   501
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   502
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   503
val union_hyps = Ord_List.union Term_Ord.fast_term_ord;
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   504
val insert_hyps = Ord_List.insert Term_Ord.fast_term_ord;
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   505
val remove_hyps = Ord_List.remove Term_Ord.fast_term_ord;
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   506
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   507
fun join_certificate1 (Cterm {cert = cert1, ...}, Thm (_, {cert = cert2, ...})) =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   508
  Context.join_certificate (cert1, cert2);
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   509
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   510
fun join_certificate2 (Thm (_, {cert = cert1, ...}), Thm (_, {cert = cert2, ...})) =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   511
  Context.join_certificate (cert1, cert2);
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   512
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   513
22365
ce62a5f6954c moved some non-kernel material to more_thm.ML;
wenzelm
parents: 22237
diff changeset
   514
(* basic components *)
16135
c66545fe72bf added eq_thms;
wenzelm
parents: 16024
diff changeset
   515
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   516
val cert_of = #cert o rep_thm;
65458
cf504b7a7aa7 tuned signature;
wenzelm
parents: 64981
diff changeset
   517
val theory_id = Context.certificate_theory_id o cert_of;
77889
5db014c36f42 clarified signature: explicitly distinguish theory_base_name vs. theory_long_name;
wenzelm
parents: 77877
diff changeset
   518
5db014c36f42 clarified signature: explicitly distinguish theory_base_name vs. theory_long_name;
wenzelm
parents: 77877
diff changeset
   519
fun theory_name long = Context.theory_id_name long o theory_id;
5db014c36f42 clarified signature: explicitly distinguish theory_base_name vs. theory_long_name;
wenzelm
parents: 77877
diff changeset
   520
val theory_long_name = theory_name {long = true};
5db014c36f42 clarified signature: explicitly distinguish theory_base_name vs. theory_long_name;
wenzelm
parents: 77877
diff changeset
   521
val theory_base_name = theory_name {long = false};
61050
3bc7dcc565dc clarified exceptions;
wenzelm
parents: 61048
diff changeset
   522
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   523
val maxidx_of = #maxidx o rep_thm;
19910
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
   524
fun maxidx_thm th i = Int.max (maxidx_of th, i);
61039
80f40d89dab6 tuned signature;
wenzelm
parents: 60952
diff changeset
   525
val shyps_of = #shyps o rep_thm;
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   526
val hyps_of = #hyps o rep_thm;
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   527
val prop_of = #prop o rep_thm;
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   528
val tpairs_of = #tpairs o rep_thm;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   529
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   530
val concl_of = Logic.strip_imp_concl o prop_of;
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   531
val prems_of = Logic.strip_imp_prems o prop_of;
81952
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
   532
fun take_prems_of n = Logic.take_imp_prems n o prop_of;
21576
8c11b1ce2f05 simplified Logic.count_prems;
wenzelm
parents: 21437
diff changeset
   533
val nprems_of = Logic.count_prems o prop_of;
74509
f24ade4ff3cc clarified signature;
wenzelm
parents: 74282
diff changeset
   534
val no_prems = Logic.no_prems o prop_of;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   535
81952
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
   536
fun prem_of th i =
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
   537
  Logic.nth_prem (i, prop_of th) handle TERM _ => raise THM ("prem_of", i, [th]);
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
   538
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   539
fun major_prem_of th =
81952
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
   540
  (case take_prems_of 1 th of
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   541
    prem :: _ => Logic.strip_assums_concl prem
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   542
  | [] => raise THM ("major_prem_of: rule with no premises", 0, [th]));
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   543
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   544
fun cprop_of (Thm (_, {cert, maxidx, shyps, prop, ...})) =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   545
  Cterm {cert = cert, maxidx = maxidx, T = propT, t = prop, sorts = shyps};
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
   546
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   547
fun cprem_of (th as Thm (_, {cert, maxidx, shyps, prop, ...})) i =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   548
  Cterm {cert = cert, maxidx = maxidx, T = propT, sorts = shyps,
18145
6757627acf59 renamed Thm.cgoal_of to Thm.cprem_of;
wenzelm
parents: 18127
diff changeset
   549
    t = Logic.nth_prem (i, prop) handle TERM _ => raise THM ("cprem_of", i, [th])};
18035
eaae44affc9e added cgoal_of;
wenzelm
parents: 17868
diff changeset
   550
69101
991a3feaf270 more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents: 68692
diff changeset
   551
fun cconcl_of (th as Thm (_, {cert, maxidx, shyps, ...})) =
991a3feaf270 more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents: 68692
diff changeset
   552
  Cterm {cert = cert, maxidx = maxidx, T = propT, sorts = shyps, t = concl_of th};
991a3feaf270 more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents: 68692
diff changeset
   553
991a3feaf270 more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents: 68692
diff changeset
   554
fun cprems_of (th as Thm (_, {cert, maxidx, shyps, ...})) =
991a3feaf270 more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents: 68692
diff changeset
   555
  map (fn t => Cterm {cert = cert, maxidx = maxidx, T = propT, sorts = shyps, t = t})
991a3feaf270 more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents: 68692
diff changeset
   556
    (prems_of th);
991a3feaf270 more direct implementation of distinct_subgoals_tac -- potentially more efficient;
wenzelm
parents: 68692
diff changeset
   557
81952
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
   558
fun take_cprems_of n (th as Thm (_, {cert, maxidx, shyps, ...})) =
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
   559
  map (fn t => Cterm {cert = cert, maxidx = maxidx, T = propT, sorts = shyps, t = t})
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
   560
    (take_prems_of n th);
4652c6b36ee8 tuned signature: more explicit operations;
wenzelm
parents: 81938
diff changeset
   561
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   562
fun chyps_of (Thm (_, {cert, shyps, hyps, ...})) =
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   563
  map (fn t => Cterm {cert = cert, maxidx = ~1, T = propT, sorts = shyps, t = t}) hyps;
60949
ccbf9379e355 added Thm.chyps_of;
wenzelm
parents: 60948
diff changeset
   564
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   565
74270
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
   566
(* thm order: ignores theory context! *)
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
   567
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
   568
val thm_ord =
74645
30eba7f9a8e9 minor performance tuning;
wenzelm
parents: 74577
diff changeset
   569
  pointer_eq_ord
77870
92fd8bed5480 tuned whitespace;
wenzelm
parents: 77869
diff changeset
   570
    (Term_Ord.fast_term_ord o apply2 prop_of
92fd8bed5480 tuned whitespace;
wenzelm
parents: 77869
diff changeset
   571
      ||| list_ord (prod_ord Term_Ord.fast_term_ord Term_Ord.fast_term_ord) o apply2 tpairs_of
92fd8bed5480 tuned whitespace;
wenzelm
parents: 77869
diff changeset
   572
      ||| list_ord Term_Ord.fast_term_ord o apply2 hyps_of
92fd8bed5480 tuned whitespace;
wenzelm
parents: 77869
diff changeset
   573
      ||| list_ord Term_Ord.sort_ord o apply2 shyps_of);
74270
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
   574
ad2899cdd528 clarified modules;
wenzelm
parents: 74266
diff changeset
   575
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   576
(* implicit theory context *)
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   577
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   578
exception CONTEXT of string * ctyp list * cterm list * thm list * Context.generic option;
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   579
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   580
fun theory_of_cterm (ct as Cterm {cert, ...}) =
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   581
  Context.certificate_theory cert
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   582
    handle ERROR msg => raise CONTEXT (msg, [], [ct], [], NONE);
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   583
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   584
fun theory_of_thm th =
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   585
  Context.certificate_theory (cert_of th)
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   586
    handle ERROR msg => raise CONTEXT (msg, [], [], [th], NONE);
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   587
67697
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
   588
fun trim_context_ctyp cT =
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
   589
  (case cT of
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
   590
    Ctyp {cert = Context.Certificate_Id _, ...} => cT
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
   591
  | Ctyp {cert = Context.Certificate thy, T, maxidx, sorts} =>
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
   592
      Ctyp {cert = Context.Certificate_Id (Context.theory_id thy),
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
   593
        T = T, maxidx = maxidx, sorts = sorts});
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
   594
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   595
fun trim_context_cterm ct =
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   596
  (case ct of
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   597
    Cterm {cert = Context.Certificate_Id _, ...} => ct
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   598
  | Cterm {cert = Context.Certificate thy, t, T, maxidx, sorts} =>
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   599
      Cterm {cert = Context.Certificate_Id (Context.theory_id thy),
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   600
        t = t, T = T, maxidx = maxidx, sorts = sorts});
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   601
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   602
fun trim_context_thm th =
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   603
  (case th of
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   604
    Thm (_, {constraints = _ :: _, ...}) =>
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   605
      raise THM ("trim_context: pending sort constraints", 0, [th])
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   606
  | Thm (_, {cert = Context.Certificate_Id _, ...}) => th
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   607
  | Thm (der,
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   608
      {cert = Context.Certificate thy, tags, maxidx, constraints = [], shyps, hyps,
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   609
        tpairs, prop}) =>
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   610
      Thm (der,
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   611
       {cert = Context.Certificate_Id (Context.theory_id thy),
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   612
        tags = tags, maxidx = maxidx, constraints = [], shyps = shyps, hyps = hyps,
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   613
        tpairs = tpairs, prop = prop}));
61048
408ff2390530 trim context for persistent storage;
wenzelm
parents: 61047
diff changeset
   614
70156
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   615
fun transfer_ctyp thy' cT =
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   616
  let
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   617
    val Ctyp {cert, T, maxidx, sorts} = cT;
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   618
    val _ =
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   619
      Context.subthy_id (Context.certificate_theory_id cert, Context.theory_id thy') orelse
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   620
        raise CONTEXT ("Cannot transfer: not a super theory", [cT], [], [],
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   621
          SOME (Context.Theory thy'));
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   622
    val cert' = Context.join_certificate (Context.Certificate thy', cert);
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   623
  in
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   624
    if Context.eq_certificate (cert, cert') then cT
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   625
    else Ctyp {cert = cert', T = T, maxidx = maxidx, sorts = sorts}
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   626
  end;
5d8833499c4a more ctyp operations;
wenzelm
parents: 70153
diff changeset
   627
78135
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   628
val transfer_ctyp' = transfer_ctyp o Proof_Context.theory_of;
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   629
val transfer_ctyp'' = transfer_ctyp o Context.theory_of;
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   630
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   631
fun transfer_cterm thy' ct =
3895
b2463861c86a added transfer: theory -> thm -> thm;
wenzelm
parents: 3893
diff changeset
   632
  let
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   633
    val Cterm {cert, t, T, maxidx, sorts} = ct;
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   634
    val _ =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   635
      Context.subthy_id (Context.certificate_theory_id cert, Context.theory_id thy') orelse
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   636
        raise CONTEXT ("Cannot transfer: not a super theory", [], [ct], [],
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   637
          SOME (Context.Theory thy'));
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   638
    val cert' = Context.join_certificate (Context.Certificate thy', cert);
3895
b2463861c86a added transfer: theory -> thm -> thm;
wenzelm
parents: 3893
diff changeset
   639
  in
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   640
    if Context.eq_certificate (cert, cert') then ct
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   641
    else Cterm {cert = cert', t = t, T = T, maxidx = maxidx, sorts = sorts}
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   642
  end;
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   643
78135
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   644
val transfer_cterm' = transfer_cterm o Proof_Context.theory_of;
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   645
val transfer_cterm'' = transfer_cterm o Context.theory_of;
db2a6f9aaa77 tuned signature: more operations;
wenzelm
parents: 78033
diff changeset
   646
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   647
fun transfer thy' th =
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   648
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   649
    val Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop}) = th;
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   650
    val _ =
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   651
      Context.subthy_id (Context.certificate_theory_id cert, Context.theory_id thy') orelse
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   652
        raise CONTEXT ("Cannot transfer: not a super theory", [], [], [th],
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   653
          SOME (Context.Theory thy'));
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   654
    val cert' = Context.join_certificate (Context.Certificate thy', cert);
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   655
  in
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   656
    if Context.eq_certificate (cert, cert') then th
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   657
    else
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   658
      Thm (der,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   659
       {cert = cert',
21646
c07b5b0e8492 thm/prf: separate official name vs. additional tags;
wenzelm
parents: 21576
diff changeset
   660
        tags = tags,
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   661
        maxidx = maxidx,
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   662
        constraints = constraints,
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   663
        shyps = shyps,
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   664
        hyps = hyps,
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   665
        tpairs = tpairs,
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   666
        prop = prop})
3895
b2463861c86a added transfer: theory -> thm -> thm;
wenzelm
parents: 3893
diff changeset
   667
  end;
387
69f4356d915d new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents: 309
diff changeset
   668
67649
1e1782c1aedf tuned signature;
wenzelm
parents: 67331
diff changeset
   669
val transfer' = transfer o Proof_Context.theory_of;
1e1782c1aedf tuned signature;
wenzelm
parents: 67331
diff changeset
   670
val transfer'' = transfer o Context.theory_of;
1e1782c1aedf tuned signature;
wenzelm
parents: 67331
diff changeset
   671
70310
c82f59c47aaf clarified transfer_morphism: implicit join_certificate, e.g. relevant for complex cascades of morphisms such as class locale interpretation;
wenzelm
parents: 70159
diff changeset
   672
fun join_transfer thy th =
71553
cf2406e654cf more robust: proper transfer if Context.eq_thy_id;
wenzelm
parents: 71530
diff changeset
   673
  (Context.subthy_id (theory_id th, Context.theory_id thy) ? transfer thy) th;
70310
c82f59c47aaf clarified transfer_morphism: implicit join_certificate, e.g. relevant for complex cascades of morphisms such as class locale interpretation;
wenzelm
parents: 70159
diff changeset
   674
70313
9c19e15c8548 more structural integrity;
wenzelm
parents: 70310
diff changeset
   675
fun join_transfer_context (ctxt, th) =
71177
71467e35fc3c more structural integrity;
wenzelm
parents: 71088
diff changeset
   676
  if Context.subthy_id (theory_id th, Context.theory_id (Proof_Context.theory_of ctxt))
71467e35fc3c more structural integrity;
wenzelm
parents: 71088
diff changeset
   677
  then (ctxt, transfer' ctxt th)
71467e35fc3c more structural integrity;
wenzelm
parents: 71088
diff changeset
   678
  else (Context.raw_transfer (theory_of_thm th) ctxt, th);
70313
9c19e15c8548 more structural integrity;
wenzelm
parents: 70310
diff changeset
   679
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   680
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   681
(* matching *)
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   682
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   683
local
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   684
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   685
fun gen_match match
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   686
    (ct1 as Cterm {t = t1, sorts = sorts1, ...},
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   687
     ct2 as Cterm {t = t2, sorts = sorts2, maxidx = maxidx2, ...}) =
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   688
  let
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   689
    val cert = join_certificate0 (ct1, ct2);
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   690
    val thy = Context.certificate_theory cert
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   691
      handle ERROR msg => raise CONTEXT (msg, [], [ct1, ct2], [], NONE);
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   692
    val (Tinsts, tinsts) = match thy (t1, t2) (Vartab.empty, Vartab.empty);
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   693
    val sorts = Sorts.union sorts1 sorts2;
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   694
    fun mk_cTinst ((a, i), (S, T)) =
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   695
      (((a, i), S), Ctyp {T = T, cert = cert, maxidx = maxidx2, sorts = sorts});
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   696
    fun mk_ctinst ((x, i), (U, t)) =
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   697
      let val T = Envir.subst_type Tinsts U in
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   698
        (((x, i), T), Cterm {t = t, T = T, cert = cert, maxidx = maxidx2, sorts = sorts})
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   699
      end;
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
   700
  in
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
   701
    (TVars.build (Vartab.fold (TVars.add o mk_cTinst) Tinsts),
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
   702
     Vars.build (Vartab.fold (Vars.add o mk_ctinst) tinsts))
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
   703
  end;
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   704
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   705
in
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   706
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   707
val match = gen_match Pattern.match;
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   708
val first_order_match = gen_match Pattern.first_order_match;
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   709
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   710
end;
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   711
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   712
59969
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
   713
(*implicit alpha-conversion*)
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   714
fun renamed_prop prop' (Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop})) =
59969
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
   715
  if prop aconv prop' then
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   716
    Thm (der, {cert = cert, tags = tags, maxidx = maxidx, constraints = constraints, shyps = shyps,
59969
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
   717
      hyps = hyps, tpairs = tpairs, prop = prop'})
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
   718
  else raise TERM ("renamed_prop: props disagree", [prop, prop']);
bcccad156236 explicitly checked alpha conversion -- actual renaming happens outside kernel;
wenzelm
parents: 59917
diff changeset
   719
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   720
fun make_context ths NONE cert =
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   721
      (Context.Theory (Context.certificate_theory cert)
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   722
        handle ERROR msg => raise CONTEXT (msg, [], [], ths, NONE))
61045
c7a7f063704a clarified exceptions: avoid interference of formal context failure with regular rule application failure (which is routinely handled in user-space);
wenzelm
parents: 61044
diff changeset
   723
  | make_context ths (SOME ctxt) cert =
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   724
      let
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   725
        val thy_id = Context.certificate_theory_id cert;
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   726
        val thy_id' = Context.theory_id (Proof_Context.theory_of ctxt);
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   727
      in
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   728
        if Context.subthy_id (thy_id, thy_id') then Context.Proof ctxt
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
   729
        else raise CONTEXT ("Bad context", [], [], ths, SOME (Context.Proof ctxt))
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   730
      end;
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
   731
64981
ea6199b23dfa proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents: 64574
diff changeset
   732
fun make_context_certificate ths opt_ctxt cert =
ea6199b23dfa proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents: 64574
diff changeset
   733
  let
ea6199b23dfa proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents: 64574
diff changeset
   734
    val context = make_context ths opt_ctxt cert;
ea6199b23dfa proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents: 64574
diff changeset
   735
    val cert' = Context.Certificate (Context.theory_of context);
ea6199b23dfa proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents: 64574
diff changeset
   736
  in (context, cert') end;
ea6199b23dfa proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents: 64574
diff changeset
   737
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   738
(*explicit weakening: maps |- B to A |- B*)
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   739
fun weaken raw_ct th =
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   740
  let
20261
af51389aa756 adjust_maxidx: pass explicit lower bound;
wenzelm
parents: 20071
diff changeset
   741
    val ct as Cterm {t = A, T, sorts, maxidx = maxidxA, ...} = adjust_maxidx_cterm ~1 raw_ct;
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   742
    val Thm (der, {tags, maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = th;
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   743
  in
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   744
    if T <> propT then
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   745
      raise THM ("weaken: assumptions must have type prop", 0, [])
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   746
    else if maxidxA <> ~1 then
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   747
      raise THM ("weaken: assumptions may not contain schematic variables", maxidxA, [])
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   748
    else
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   749
      Thm (der,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   750
       {cert = join_certificate1 (ct, th),
21646
c07b5b0e8492 thm/prf: separate official name vs. additional tags;
wenzelm
parents: 21576
diff changeset
   751
        tags = tags,
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   752
        maxidx = maxidx,
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   753
        constraints = constraints,
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   754
        shyps = Sorts.union sorts shyps,
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   755
        hyps = insert_hyps A hyps,
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   756
        tpairs = tpairs,
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   757
        prop = prop})
16945
5d3ae25673a8 added weaken, adjust_maxidx_thm;
wenzelm
parents: 16884
diff changeset
   758
  end;
16656
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
   759
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   760
fun weaken_sorts raw_sorts ct =
28624
d983515e5cdf added weaken_sorts;
wenzelm
parents: 28446
diff changeset
   761
  let
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   762
    val Cterm {cert, t, T, maxidx, sorts} = ct;
61050
3bc7dcc565dc clarified exceptions;
wenzelm
parents: 61048
diff changeset
   763
    val thy = theory_of_cterm ct;
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   764
    val more_sorts = Sorts.make (map (Sign.certify_sort thy) raw_sorts);
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   765
    val sorts' = Sorts.union sorts more_sorts;
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   766
  in Cterm {cert = cert, t = t, T = T, maxidx = maxidx, sorts = sorts'} end;
28624
d983515e5cdf added weaken_sorts;
wenzelm
parents: 28446
diff changeset
   767
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   768
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   769
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   770
(** derivations and promised proofs **)
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   771
79262
64c655e8e8bf clarified modules;
wenzelm
parents: 79261
diff changeset
   772
fun make_deriv0 promises body = Deriv {promises = promises, body = body};
64c655e8e8bf clarified modules;
wenzelm
parents: 79261
diff changeset
   773
79220
f9d972b464c1 clarified signature: fewer tuples;
wenzelm
parents: 79219
diff changeset
   774
fun make_deriv promises oracles thms zboxes zproof proof =
79262
64c655e8e8bf clarified modules;
wenzelm
parents: 79261
diff changeset
   775
  make_deriv0 promises
64c655e8e8bf clarified modules;
wenzelm
parents: 79261
diff changeset
   776
    (PBody {oracles = oracles, thms = thms, zboxes = zboxes, zproof = zproof, proof = proof});
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   777
80560
960b866b1117 tuned signature;
wenzelm
parents: 80295
diff changeset
   778
val empty_deriv = make_deriv [] [] [] [] ZNop MinProof;
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   779
28330
7e803c392342 added dest_deriv, removed external type deriv;
wenzelm
parents: 28321
diff changeset
   780
28354
c5fe7372ae4e explicit type OrdList.T;
wenzelm
parents: 28330
diff changeset
   781
(* inference rules *)
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   782
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
   783
val promise_ord: (serial * thm future) ord = fn ((i, _), (j, _)) => int_ord (j, i);
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
   784
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   785
fun deriv_rule2 zproof proof
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   786
    (Deriv {promises = ps1, body = PBody body1})
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   787
    (Deriv {promises = ps2, body = PBody body2}) =
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   788
  let
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   789
    val ps' = Ord_List.union promise_ord ps1 ps2;
79114
686b7b14d041 clarified proof_body: cover zboxes from zproof;
wenzelm
parents: 79113
diff changeset
   790
79220
f9d972b464c1 clarified signature: fewer tuples;
wenzelm
parents: 79219
diff changeset
   791
    val {oracles = oracles1, thms = thms1, zboxes = zboxes1, zproof = zprf1, proof = prf1} = body1;
f9d972b464c1 clarified signature: fewer tuples;
wenzelm
parents: 79219
diff changeset
   792
    val {oracles = oracles2, thms = thms2, zboxes = zboxes2, zproof = zprf2, proof = prf2} = body2;
79114
686b7b14d041 clarified proof_body: cover zboxes from zproof;
wenzelm
parents: 79113
diff changeset
   793
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   794
    val oracles' = Proofterm.union_oracles oracles1 oracles2;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   795
    val thms' = Proofterm.union_thms thms1 thms2;
79263
bf2e724ff57e clarified signature;
wenzelm
parents: 79262
diff changeset
   796
    val zboxes' = ZTerm.union_zboxes zboxes1 zboxes2;
79219
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
   797
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
   798
    val proofs = Proofterm.get_proofs_level ();
80560
960b866b1117 tuned signature;
wenzelm
parents: 80295
diff changeset
   799
    val zproof' = if Proofterm.zproof_enabled proofs then zproof zprf1 zprf2 else ZNop;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   800
    val proof' = if Proofterm.proof_enabled proofs then proof prf1 prf2 else MinProof;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   801
  in make_deriv ps' oracles' thms' zboxes' zproof' proof' end;
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   802
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   803
fun deriv_rule1 zproof proof = deriv_rule2 (K zproof) (K proof) empty_deriv;
70812
3ae7949ef059 tuned -- allow slightly more expensive atomic proofs;
wenzelm
parents: 70603
diff changeset
   804
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   805
fun deriv_rule0 zproof proof =
79219
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
   806
  let val proofs = Proofterm.get_proofs_level () in
79113
5109e4b2a292 pro-forma support for optional zproof: no proper content yet;
wenzelm
parents: 78135
diff changeset
   807
    if Proofterm.proof_enabled proofs orelse Proofterm.zproof_enabled proofs then
79279
d9a7ee1bd070 minor performance tuning: more concise union;
wenzelm
parents: 79273
diff changeset
   808
      deriv_rule1 I I (make_deriv [] [] [] []
80560
960b866b1117 tuned signature;
wenzelm
parents: 80295
diff changeset
   809
       (if Proofterm.zproof_enabled proofs then zproof () else ZNop)
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   810
       (if Proofterm.proof_enabled proofs then proof () else MinProof))
79113
5109e4b2a292 pro-forma support for optional zproof: no proper content yet;
wenzelm
parents: 78135
diff changeset
   811
    else empty_deriv
5109e4b2a292 pro-forma support for optional zproof: no proper content yet;
wenzelm
parents: 78135
diff changeset
   812
  end;
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   813
1238
289c573327f0 considerably tuned shyps handling;
wenzelm
parents: 1229
diff changeset
   814
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   815
(* fulfilled proofs *)
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   816
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
   817
fun raw_promises_of (Thm (Deriv {promises, ...}, _)) = promises;
44331
aa9c1e9ef2ce clarified fulfill_norm_proof: no join_thms yet;
wenzelm
parents: 44330
diff changeset
   818
aa9c1e9ef2ce clarified fulfill_norm_proof: no join_thms yet;
wenzelm
parents: 44330
diff changeset
   819
fun join_promises [] = ()
aa9c1e9ef2ce clarified fulfill_norm_proof: no join_thms yet;
wenzelm
parents: 44330
diff changeset
   820
  | join_promises promises = join_promises_of (Future.joins (map snd promises))
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
   821
and join_promises_of thms = join_promises (Ord_List.make promise_ord (maps raw_promises_of thms));
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   822
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   823
fun fulfill_body (th as Thm (Deriv {promises, body}, _)) =
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
   824
  let val fulfilled_promises = map #1 promises ~~ map fulfill_body (Future.joins (map #2 promises))
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
   825
  in Proofterm.fulfill_norm_proof (theory_of_thm th) fulfilled_promises body end;
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   826
64574
1134e4d5e5b7 consolidate nested thms with persistent result, for improved performance;
wenzelm
parents: 64573
diff changeset
   827
fun proof_bodies_of thms = (join_promises_of thms; map fulfill_body thms);
44333
cc53ce50f738 reverted to join_bodies/join_proofs based on fold_body_thms to regain performance (escpecially of HOL-Proofs) -- see also aa9c1e9ef2ce and 4e2abb045eac;
wenzelm
parents: 44331
diff changeset
   828
val proof_body_of = singleton proof_bodies_of;
79405
f4fdf5eebcac pro-forma support for ZTerm.sorts_zproof;
wenzelm
parents: 79404
diff changeset
   829
f4fdf5eebcac pro-forma support for ZTerm.sorts_zproof;
wenzelm
parents: 79404
diff changeset
   830
val zproof_of = Proofterm.zproof_of o proof_body_of;
44331
aa9c1e9ef2ce clarified fulfill_norm_proof: no join_thms yet;
wenzelm
parents: 44330
diff changeset
   831
val proof_of = Proofterm.proof_of o proof_body_of;
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   832
71088
4b45d592ce29 clarified modules;
wenzelm
parents: 71018
diff changeset
   833
fun reconstruct_proof_of thm =
4b45d592ce29 clarified modules;
wenzelm
parents: 71018
diff changeset
   834
  Proofterm.reconstruct_proof (theory_of_thm thm) (prop_of thm) (proof_of thm);
4b45d592ce29 clarified modules;
wenzelm
parents: 71018
diff changeset
   835
66168
fcd09fc36d7f consolidate proofs more simultaneously;
wenzelm
parents: 65458
diff changeset
   836
val consolidate = ignore o proof_bodies_of;
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   837
71011
2c96e48027eb clarified modules;
wenzelm
parents: 70923
diff changeset
   838
fun expose_proofs thy thms =
2c96e48027eb clarified modules;
wenzelm
parents: 70923
diff changeset
   839
  if Proofterm.export_proof_boxes_required thy then
71018
d32ed8927a42 more robust expose_proofs corresponding to register_proofs/consolidate_theory;
wenzelm
parents: 71017
diff changeset
   840
    Proofterm.export_proof_boxes (proof_bodies_of (map (transfer thy) thms))
71011
2c96e48027eb clarified modules;
wenzelm
parents: 70923
diff changeset
   841
  else ();
2c96e48027eb clarified modules;
wenzelm
parents: 70923
diff changeset
   842
71017
c85efa2be619 expose derivations more thoroughly, notably for locale/class reasoning;
wenzelm
parents: 71012
diff changeset
   843
fun expose_proof thy = expose_proofs thy o single;
c85efa2be619 expose derivations more thoroughly, notably for locale/class reasoning;
wenzelm
parents: 71012
diff changeset
   844
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   845
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   846
(* future rule *)
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   847
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   848
fun future_result i orig_cert orig_shyps orig_prop thm =
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   849
  let
36613
f3157c288aca simplified primitive Thm.future: more direct theory check, do not hardwire strip_shyps here;
wenzelm
parents: 36330
diff changeset
   850
    fun err msg = raise THM ("future_result: " ^ msg, 0, [thm]);
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   851
    val Thm (Deriv {promises, ...}, {cert, constraints, shyps, hyps, tpairs, prop, ...}) = thm;
36613
f3157c288aca simplified primitive Thm.future: more direct theory check, do not hardwire strip_shyps here;
wenzelm
parents: 36330
diff changeset
   852
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   853
    val _ = Context.eq_certificate (cert, orig_cert) orelse err "bad theory";
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   854
    val _ = prop aconv orig_prop orelse err "bad prop";
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   855
    val _ = null constraints orelse err "bad sort constraints";
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   856
    val _ = null tpairs orelse err "bad flex-flex constraints";
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   857
    val _ = null hyps orelse err "bad hyps";
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   858
    val _ = Sorts.subset (shyps, orig_shyps) orelse err "bad shyps";
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
   859
    val _ = forall (fn (j, _) => i <> j) promises orelse err "bad dependencies";
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
   860
    val _ = join_promises promises;
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   861
  in thm end;
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   862
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   863
fun future future_thm ct =
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   864
  let
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   865
    val Cterm {cert = cert, t = prop, T, maxidx, sorts} = ct;
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   866
    val _ = T <> propT andalso raise CTERM ("future: prop expected", [ct]);
70398
725438ceae7c proof terms are always constructed sequentially;
wenzelm
parents: 70313
diff changeset
   867
    val _ =
79113
5109e4b2a292 pro-forma support for optional zproof: no proper content yet;
wenzelm
parents: 78135
diff changeset
   868
      if Proofterm.any_proofs_enabled ()
70398
725438ceae7c proof terms are always constructed sequentially;
wenzelm
parents: 70313
diff changeset
   869
      then raise CTERM ("future: proof terms enabled", [ct]) else ();
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   870
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   871
    val i = serial ();
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   872
    val future = future_thm |> Future.map (future_result i cert sorts prop);
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   873
  in
80560
960b866b1117 tuned signature;
wenzelm
parents: 80295
diff changeset
   874
    Thm (make_deriv [(i, future)] [] [] [] ZNop MinProof,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   875
     {cert = cert,
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   876
      tags = [],
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   877
      maxidx = maxidx,
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   878
      constraints = [],
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   879
      shyps = sorts,
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
   880
      hyps = [],
32725
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   881
      tpairs = [],
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   882
      prop = prop})
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   883
  end;
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   884
57e29093ecfb tuned internal source structure;
wenzelm
parents: 32590
diff changeset
   885
1238
289c573327f0 considerably tuned shyps handling;
wenzelm
parents: 1229
diff changeset
   886
1529
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
   887
(** Axioms **)
387
69f4356d915d new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents: 309
diff changeset
   888
70923
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   889
fun axiom thy name =
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   890
  (case Name_Space.lookup (Theory.axiom_table thy) name of
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   891
    SOME prop =>
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   892
      let
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   893
        fun zproof () = ZTerm.axiom_proof thy name prop;
79410
719563e4816a tuned signature;
wenzelm
parents: 79409
diff changeset
   894
        fun proof () = Proofterm.axiom_proof name prop;
70923
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   895
        val cert = Context.Certificate thy;
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   896
        val maxidx = maxidx_of_term prop;
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
   897
        val shyps = Sorts.insert_term prop [];
70923
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   898
      in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   899
        Thm (deriv_rule0 zproof proof,
70923
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   900
          {cert = cert, tags = [], maxidx = maxidx,
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
   901
            constraints = [], shyps = shyps, hyps = [], tpairs = [], prop = prop})
70923
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   902
      end
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   903
  | NONE => raise THEORY ("No axiom " ^ quote name, [thy]));
387
69f4356d915d new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents: 309
diff changeset
   904
70923
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   905
fun all_axioms_of thy =
98d9b78b7f47 clarified axiom_table: uniform space (e.g. like consts), e.g. relevant for export of HOL-ex.Join_Theory;
wenzelm
parents: 70915
diff changeset
   906
  map (fn (name, _) => (name, axiom thy name)) (Theory.all_axioms_of thy);
776
df8f91c0e57c improved axioms_of: returns thms as the manual says;
wenzelm
parents: 721
diff changeset
   907
6089
4d2d5556b4f9 signature BASIC_THM;
wenzelm
parents: 5624
diff changeset
   908
28804
5d3b1df16353 refined notion of derivation, consiting of promises and proof_body;
wenzelm
parents: 28675
diff changeset
   909
(* tags *)
6089
4d2d5556b4f9 signature BASIC_THM;
wenzelm
parents: 5624
diff changeset
   910
21646
c07b5b0e8492 thm/prf: separate official name vs. additional tags;
wenzelm
parents: 21576
diff changeset
   911
val get_tags = #tags o rep_thm;
6089
4d2d5556b4f9 signature BASIC_THM;
wenzelm
parents: 5624
diff changeset
   912
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   913
fun map_tags f (Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop})) =
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   914
  Thm (der, {cert = cert, tags = f tags, maxidx = maxidx, constraints = constraints,
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   915
    shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop});
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   916
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
   917
43795
ca5896a836ba recovered some runtime sharing from d6b6c74a8bcf, without the global memory bottleneck;
wenzelm
parents: 43761
diff changeset
   918
(* technical adjustments *)
ca5896a836ba recovered some runtime sharing from d6b6c74a8bcf, without the global memory bottleneck;
wenzelm
parents: 43761
diff changeset
   919
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   920
fun norm_proof (th as Thm (der, args)) =
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
   921
  Thm (deriv_rule1 I (Proofterm.rew_proof (theory_of_thm th)) der, args);
23781
ab793a6ddf9f Added function norm_proof for normalizing the proof term
berghofe
parents: 23657
diff changeset
   922
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   923
fun adjust_maxidx_thm i
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   924
    (th as Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop})) =
20261
af51389aa756 adjust_maxidx: pass explicit lower bound;
wenzelm
parents: 20071
diff changeset
   925
  if maxidx = i then th
af51389aa756 adjust_maxidx: pass explicit lower bound;
wenzelm
parents: 20071
diff changeset
   926
  else if maxidx < i then
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   927
    Thm (der, {maxidx = i, cert = cert, tags = tags, constraints = constraints, shyps = shyps,
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
   928
      hyps = hyps, tpairs = tpairs, prop = prop})
20261
af51389aa756 adjust_maxidx: pass explicit lower bound;
wenzelm
parents: 20071
diff changeset
   929
  else
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
   930
    Thm (der, {maxidx = Int.max (maxidx_tpairs tpairs (maxidx_of_term prop), i),
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   931
      cert = cert, tags = tags, constraints = constraints, shyps = shyps,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
   932
      hyps = hyps, tpairs = tpairs, prop = prop});
564
eec3a9222b50 added inferT_axm;
wenzelm
parents: 480
diff changeset
   933
387
69f4356d915d new datatype theory, supports 'draft theories' and incremental extension:
wenzelm
parents: 309
diff changeset
   934
2509
0a7169d89b7a added termless parameter;
wenzelm
parents: 2386
diff changeset
   935
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   936
(*** Theory data ***)
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   937
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   938
(* type classes *)
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   939
70465
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
   940
structure Aritytab =
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
   941
  Table(
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
   942
    type key = string * sort list * class;
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
   943
    val ord =
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
   944
      fast_string_ord o apply2 #1
73860
dfac078e5444 tuned signature (see 2d6a489adb01);
wenzelm
parents: 71777
diff changeset
   945
      ||| fast_string_ord o apply2 #3
dfac078e5444 tuned signature (see 2d6a489adb01);
wenzelm
parents: 71777
diff changeset
   946
      ||| list_ord Term_Ord.sort_ord o apply2 #2;
70465
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
   947
  );
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
   948
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   949
datatype classes = Classes of
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   950
 {classrels: thm Symreltab.table,
70475
98b6da301e13 backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents: 70472
diff changeset
   951
  arities: (thm * string * serial) Aritytab.table};
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   952
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   953
fun make_classes (classrels, arities) = Classes {classrels = classrels, arities = arities};
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   954
70465
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
   955
val empty_classes = make_classes (Symreltab.empty, Aritytab.empty);
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   956
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   957
(*see Theory.at_begin hook for transitive closure of classrels and arity completion*)
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   958
fun merge_classes
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   959
   (Classes {classrels = classrels1, arities = arities1},
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   960
    Classes {classrels = classrels2, arities = arities2}) =
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   961
  let
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   962
    val classrels' = Symreltab.merge (K true) (classrels1, classrels2);
70465
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
   963
    val arities' = Aritytab.merge (K true) (arities1, arities2);
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   964
  in make_classes (classrels', arities') end;
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   965
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   966
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   967
(* data *)
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   968
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   969
structure Data = Theory_Data
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   970
(
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   971
  type T =
80289
40a6a6ac1669 tuned signature;
wenzelm
parents: 79474
diff changeset
   972
    {name: Thm_Name.P, thm: thm} Inttab.table *  (*stored zproof thms*)
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   973
    unit Name_Space.table *  (*oracles: authentic derivation names*)
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   974
    classes;  (*type classes within the logic*)
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   975
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   976
  val empty : T = (Inttab.empty, Name_Space.empty_table Markup.oracleN, empty_classes);
79330
d300a8f02b84 clarified zproof storage: per-theory table in anticipation of session exports;
wenzelm
parents: 79329
diff changeset
   977
  fun merge ((_, oracles1, sorts1), (_, oracles2, sorts2)) : T =
d300a8f02b84 clarified zproof storage: per-theory table in anticipation of session exports;
wenzelm
parents: 79329
diff changeset
   978
   (Inttab.empty,
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   979
    Name_Space.merge_tables (oracles1, oracles2),
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   980
    merge_classes (sorts1, sorts2));
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   981
);
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
   982
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   983
val get_zproofs = #1 o Data.get;
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   984
fun map_zproofs f = Data.map (fn (a, b, c) => (f a, b, c));
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
   985
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   986
val get_oracles = #2 o Data.get;
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   987
fun map_oracles f = Data.map (fn (a, b, c) => (a, f b, c));
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   988
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   989
val get_classes = (fn (_, _, Classes args) => args) o Data.get;
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   990
val get_classrels = #classrels o get_classes;
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   991
val get_arities = #arities o get_classes;
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   992
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   993
fun map_classes f =
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   994
  Data.map (fn (a, b, Classes {classrels, arities}) =>
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
   995
    (a, b, make_classes (f (classrels, arities))));
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   996
fun map_classrels f = map_classes (fn (classrels, arities) => (f classrels, arities));
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   997
fun map_arities f = map_classes (fn (classrels, arities) => (classrels, f arities));
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
   998
79330
d300a8f02b84 clarified zproof storage: per-theory table in anticipation of session exports;
wenzelm
parents: 79329
diff changeset
   999
val _ =
d300a8f02b84 clarified zproof storage: per-theory table in anticipation of session exports;
wenzelm
parents: 79329
diff changeset
  1000
  (Theory.setup o Theory.at_begin) (fn thy =>
d300a8f02b84 clarified zproof storage: per-theory table in anticipation of session exports;
wenzelm
parents: 79329
diff changeset
  1001
    if Inttab.is_empty (get_zproofs thy) then NONE
d300a8f02b84 clarified zproof storage: per-theory table in anticipation of session exports;
wenzelm
parents: 79329
diff changeset
  1002
    else SOME (map_zproofs (K Inttab.empty) thy));
d300a8f02b84 clarified zproof storage: per-theory table in anticipation of session exports;
wenzelm
parents: 79329
diff changeset
  1003
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1004
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1005
(* type classes *)
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1006
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1007
fun the_classrel thy (c1, c2) =
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1008
  (case Symreltab.lookup (get_classrels thy) (c1, c2) of
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1009
    SOME thm => transfer thy thm
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1010
  | NONE => error ("Unproven class relation " ^
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1011
      Syntax.string_of_classrel (Proof_Context.init_global thy) [c1, c2]));
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1012
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1013
fun the_arity thy (a, Ss, c) =
70465
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
  1014
  (case Aritytab.lookup (get_arities thy) (a, Ss, c) of
70475
98b6da301e13 backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents: 70472
diff changeset
  1015
    SOME (thm, _, _) => transfer thy thm
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1016
  | NONE => error ("Unproven type arity " ^
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1017
      Syntax.string_of_arity (Proof_Context.init_global thy) (a, Ss, [c])));
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1018
79405
f4fdf5eebcac pro-forma support for ZTerm.sorts_zproof;
wenzelm
parents: 79404
diff changeset
  1019
fun sorts_zproof thy = (zproof_of o the_classrel thy, zproof_of o the_arity thy);
f4fdf5eebcac pro-forma support for ZTerm.sorts_zproof;
wenzelm
parents: 79404
diff changeset
  1020
fun sorts_proof thy = (proof_of o the_classrel thy, proof_of o the_arity thy);
70457
wenzelm
parents: 70456
diff changeset
  1021
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1022
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1023
(* solve sort constraints by pro-forma proof *)
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1024
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1025
local
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1026
79306
816472c38979 clarified pro-forma proof: no zboxes here (partially revert 686b7b14d041);
wenzelm
parents: 79305
diff changeset
  1027
fun union_digest (oracles1, thms1) (oracles2, thms2) =
816472c38979 clarified pro-forma proof: no zboxes here (partially revert 686b7b14d041);
wenzelm
parents: 79305
diff changeset
  1028
  (Proofterm.union_oracles oracles1 oracles2, Proofterm.union_thms thms1 thms2);
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1029
79306
816472c38979 clarified pro-forma proof: no zboxes here (partially revert 686b7b14d041);
wenzelm
parents: 79305
diff changeset
  1030
fun thm_digest (Thm (Deriv {body = PBody {oracles, thms, ...}, ...}, _)) = (oracles, thms);
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1031
70480
1a1b7d7f24bb explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents: 70475
diff changeset
  1032
fun constraint_digest ({theory = thy, typ, sort, ...}: constraint) =
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1033
  Sorts.of_sort_derivation (Sign.classes_of thy)
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1034
   {class_relation = fn _ => fn _ => fn (digest, c1) => fn c2 =>
79306
816472c38979 clarified pro-forma proof: no zboxes here (partially revert 686b7b14d041);
wenzelm
parents: 79305
diff changeset
  1035
      if c1 = c2 then ([], []) else union_digest digest (thm_digest (the_classrel thy (c1, c2))),
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1036
    type_constructor = fn (a, _) => fn dom => fn c =>
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1037
      let val arity_digest = thm_digest (the_arity thy (a, (map o map) #2 dom, c))
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1038
      in (fold o fold) (union_digest o #1) dom arity_digest end,
79306
816472c38979 clarified pro-forma proof: no zboxes here (partially revert 686b7b14d041);
wenzelm
parents: 79305
diff changeset
  1039
    type_variable = fn T => map (pair ([], [])) (Type.sort_of_atyp T)}
70480
1a1b7d7f24bb explicit check of left-over constraints from different theory, e.g. due to lack of Thm.trim_context;
wenzelm
parents: 70475
diff changeset
  1040
   (typ, sort);
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1041
79308
c9f253e91257 more robust: avoid assumption about Context.certificate_theory;
wenzelm
parents: 79307
diff changeset
  1042
fun bad_constraint_theory cert ({theory = thy, ...}: constraint) =
c9f253e91257 more robust: avoid assumption about Context.certificate_theory;
wenzelm
parents: 79307
diff changeset
  1043
  if Context.eq_thy_id (Context.certificate_theory_id cert, Context.theory_id thy)
c9f253e91257 more robust: avoid assumption about Context.certificate_theory;
wenzelm
parents: 79307
diff changeset
  1044
  then NONE else SOME thy;
c9f253e91257 more robust: avoid assumption about Context.certificate_theory;
wenzelm
parents: 79307
diff changeset
  1045
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1046
in
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1047
79308
c9f253e91257 more robust: avoid assumption about Context.certificate_theory;
wenzelm
parents: 79307
diff changeset
  1048
fun solve_constraints (thm as Thm (der, args)) =
79309
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1049
  let
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1050
    val {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop} = args;
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1051
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1052
    val bad_thys = map_filter (bad_constraint_theory cert) constraints;
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1053
    val _ =
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1054
      if null bad_thys then ()
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1055
      else
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1056
        raise THEORY ("solve_constraints: bad theories for theorem\n" ^
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1057
          Syntax.string_of_term_global (hd bad_thys) (prop_of thm), bad_thys);
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1058
79309
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1059
    val Deriv {promises, body = PBody {oracles, thms, zboxes, zproof, proof}} = der;
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1060
    val (oracles', thms') = (oracles, thms)
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1061
      |> fold (fold union_digest o constraint_digest) constraints;
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1062
    val zproof' = ZTerm.beta_norm_prooft zproof;
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1063
  in
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1064
    Thm (make_deriv promises oracles' thms' zboxes zproof' proof,
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1065
      {constraints = [], cert = cert, tags = tags, maxidx = maxidx,
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1066
        shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop})
cf8ccfec5059 more normalization: re-use Thm.solve_constraints as important checkpoint for results, notably Global_Theory.name_thm;
wenzelm
parents: 79308
diff changeset
  1067
  end;
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1068
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1069
end;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1070
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1071
(*Dangling sort constraints of a thm*)
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1072
fun extra_shyps (th as Thm (_, {shyps, ...})) =
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1073
  Sorts.subtract (fold_terms {hyps = true} Sorts.insert_term th []) shyps;
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1074
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1075
(*Remove extra sorts that are witnessed by type signature information*)
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1076
fun strip_shyps thm =
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1077
  (case thm of
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1078
    Thm (_, {shyps = [], ...}) => thm
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1079
  | Thm (der, {cert, tags, maxidx, constraints, shyps, hyps, tpairs, prop}) =>
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1080
      let
79387
25fa3bc05a51 clarified modules;
wenzelm
parents: 79386
diff changeset
  1081
        val Deriv {promises, body = PBody {oracles, thms, zboxes, zproof, proof}} = der;
25fa3bc05a51 clarified modules;
wenzelm
parents: 79386
diff changeset
  1082
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1083
        val thy = theory_of_thm thm;
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1084
        val algebra = Sign.classes_of thy;
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1085
        val le = Sorts.sort_le algebra;
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1086
        fun lt (S1, S2) = le (S1, S2) andalso not (le (S2, S1));
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1087
        fun rel (S1, S2) = if S1 = S2 then [] else [(Term.aT S1, S2)];
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1088
79413
9495bd0112d7 clarified signature;
wenzelm
parents: 79410
diff changeset
  1089
        val present_set = Types.build (thm |> fold_terms {hyps = true} Types.add_atyps);
79397
0596c28860f9 clarified signature;
wenzelm
parents: 79396
diff changeset
  1090
        val {present, extra} = Logic.present_sorts shyps present_set;
0596c28860f9 clarified signature;
wenzelm
parents: 79396
diff changeset
  1091
79394
2ff5ffd8731b clarified signature;
wenzelm
parents: 79389
diff changeset
  1092
        val (witnessed, non_witnessed) =
2ff5ffd8731b clarified signature;
wenzelm
parents: 79389
diff changeset
  1093
          Sign.witness_sorts thy present extra ||> map (`(Sorts.minimize_sort algebra));
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1094
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1095
        val extra' =
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1096
          non_witnessed |> map_filter (fn (S, _) =>
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1097
            if non_witnessed |> exists (fn (S', _) => lt (S', S)) then NONE else SOME S)
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1098
          |> Sorts.make;
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1099
79396
wenzelm
parents: 79394
diff changeset
  1100
        val non_witnessed_constraints =
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1101
          non_witnessed |> maps (fn (S1, S2) =>
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1102
            let val S0 = the (find_first (fn S => le (S, S1)) extra')
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1103
            in rel (S0, S1) @ rel (S1, S2) end);
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1104
79396
wenzelm
parents: 79394
diff changeset
  1105
        val constraints' = constraints
wenzelm
parents: 79394
diff changeset
  1106
          |> fold (insert_constraints thy) witnessed
wenzelm
parents: 79394
diff changeset
  1107
          |> fold (insert_constraints thy) non_witnessed_constraints;
wenzelm
parents: 79394
diff changeset
  1108
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1109
        val shyps' = fold (Sorts.insert_sort o #2) present extra';
79224
wenzelm
parents: 79221
diff changeset
  1110
79398
a9fb2bc71435 tuned names;
wenzelm
parents: 79397
diff changeset
  1111
        val types = present @ witnessed @ map (`Logic.dummy_tfree) extra';
79401
6e6f76c5dd96 tuned names (again);
wenzelm
parents: 79398
diff changeset
  1112
        fun get_type S = types |> get_first (fn (T', S') => if le (S', S) then SOME T' else NONE);
79402
6bcb7131142d minor performance tuning: proper Same.operation;
wenzelm
parents: 79401
diff changeset
  1113
        val map_atyp =
6bcb7131142d minor performance tuning: proper Same.operation;
wenzelm
parents: 79401
diff changeset
  1114
          Same.function_eq (op =) (fn T =>
6bcb7131142d minor performance tuning: proper Same.operation;
wenzelm
parents: 79401
diff changeset
  1115
            if Types.defined present_set T then raise Same.SAME
6bcb7131142d minor performance tuning: proper Same.operation;
wenzelm
parents: 79401
diff changeset
  1116
            else
6bcb7131142d minor performance tuning: proper Same.operation;
wenzelm
parents: 79401
diff changeset
  1117
              (case get_type (Type.sort_of_atyp T) of
6bcb7131142d minor performance tuning: proper Same.operation;
wenzelm
parents: 79401
diff changeset
  1118
                SOME T' => T'
6bcb7131142d minor performance tuning: proper Same.operation;
wenzelm
parents: 79401
diff changeset
  1119
              | NONE => raise Fail "strip_shyps: bad type variable in proof term"));
79398
a9fb2bc71435 tuned names;
wenzelm
parents: 79397
diff changeset
  1120
        val map_ztyp =
81540
58073f3d748a tuned signature;
wenzelm
parents: 81507
diff changeset
  1121
          ZTypes.apply_unsynchronized_cache
58073f3d748a tuned signature;
wenzelm
parents: 81507
diff changeset
  1122
            (ZTerm.subst_type_same (ZTerm.ztyp_of o map_atyp o ZTerm.typ_of o ZTVar));
79398
a9fb2bc71435 tuned names;
wenzelm
parents: 79397
diff changeset
  1123
79474
c39aed404ffc more uniform treatment of "hyps" within zproof;
wenzelm
parents: 79454
diff changeset
  1124
        val zproof' = ZTerm.map_proof_types {hyps = true} map_ztyp zproof;
79409
e1895596e1b9 minor performance tuning: proper Same.operation;
wenzelm
parents: 79405
diff changeset
  1125
        val proof' = Proofterm.map_proof_types (Term.map_atyps_same map_atyp) proof;
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1126
      in
79389
10925576fbb4 more zproofs;
wenzelm
parents: 79387
diff changeset
  1127
        Thm (make_deriv promises oracles thms zboxes zproof' proof',
71527
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1128
         {cert = cert, tags = tags, maxidx = maxidx, constraints = constraints',
4d412964a61a tuned signature;
wenzelm
parents: 71465
diff changeset
  1129
          shyps = shyps', hyps = hyps, tpairs = tpairs, prop = prop})
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1130
      end)
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1131
  |> solve_constraints;
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1132
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1133
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1134
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1135
(*** Closed theorems with official name ***)
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1136
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1137
(*non-deterministic, depends on unknown promises*)
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1138
fun derivation_closed (Thm (Deriv {body, ...}, _)) =
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1139
  Proofterm.compact_proof (Proofterm.proof_of body);
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1140
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1141
(*non-deterministic, depends on unknown promises*)
70543
33749040b6f8 clarified derivation_name vs. raw_derivation_name;
wenzelm
parents: 70517
diff changeset
  1142
fun raw_derivation_name (Thm (Deriv {body, ...}, {shyps, hyps, prop, ...})) =
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1143
  Proofterm.get_approximative_name shyps hyps prop (Proofterm.proof_of body);
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1144
70915
bd4d37edfee4 clarified expand_proof/expand_name: allow more detailed control via thm_header;
wenzelm
parents: 70908
diff changeset
  1145
fun expand_name (Thm (Deriv {body, ...}, {shyps, hyps, prop, ...})) =
bd4d37edfee4 clarified expand_proof/expand_name: allow more detailed control via thm_header;
wenzelm
parents: 70908
diff changeset
  1146
  let
bd4d37edfee4 clarified expand_proof/expand_name: allow more detailed control via thm_header;
wenzelm
parents: 70908
diff changeset
  1147
    val self_id =
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1148
      (case Proofterm.get_identity shyps hyps prop (Proofterm.proof_of body) of
70915
bd4d37edfee4 clarified expand_proof/expand_name: allow more detailed control via thm_header;
wenzelm
parents: 70908
diff changeset
  1149
        NONE => K false
bd4d37edfee4 clarified expand_proof/expand_name: allow more detailed control via thm_header;
wenzelm
parents: 70908
diff changeset
  1150
      | SOME {serial, ...} => fn (header: Proofterm.thm_header) => serial = #serial header);
80295
8a9588ffc133 more accurate Thm_Name.T for PThm / Thm.name_derivation / Thm.derivation_name;
wenzelm
parents: 80289
diff changeset
  1151
    fun expand header =
80590
505f97165f52 clarified thm_header command_pos vs. thm_pos;
wenzelm
parents: 80579
diff changeset
  1152
      if self_id header orelse Thm_Name.is_empty (#1 (#thm_name header))
505f97165f52 clarified thm_header command_pos vs. thm_pos;
wenzelm
parents: 80579
diff changeset
  1153
      then SOME Thm_Name.none else NONE;
70915
bd4d37edfee4 clarified expand_proof/expand_name: allow more detailed control via thm_header;
wenzelm
parents: 70908
diff changeset
  1154
  in expand end;
bd4d37edfee4 clarified expand_proof/expand_name: allow more detailed control via thm_header;
wenzelm
parents: 70908
diff changeset
  1155
70543
33749040b6f8 clarified derivation_name vs. raw_derivation_name;
wenzelm
parents: 70517
diff changeset
  1156
(*deterministic name of finished proof*)
33749040b6f8 clarified derivation_name vs. raw_derivation_name;
wenzelm
parents: 70517
diff changeset
  1157
fun derivation_name (thm as Thm (_, {shyps, hyps, prop, ...})) =
80590
505f97165f52 clarified thm_header command_pos vs. thm_pos;
wenzelm
parents: 80579
diff changeset
  1158
  #1 (Proofterm.get_approximative_name shyps hyps prop (proof_of thm));
70543
33749040b6f8 clarified derivation_name vs. raw_derivation_name;
wenzelm
parents: 70517
diff changeset
  1159
70595
2ae7e33c950f clarified thm_id vs. thm_node/thm: retain theory_name;
wenzelm
parents: 70593
diff changeset
  1160
(*identified PThm node*)
70551
9e87e978be5e clarified identity of PThm nodes: do not reuse old id after renaming -- enforce uniqueness of substructures;
wenzelm
parents: 70543
diff changeset
  1161
fun derivation_id (thm as Thm (_, {shyps, hyps, prop, ...})) =
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1162
  Proofterm.get_id shyps hyps prop (proof_of thm);
70551
9e87e978be5e clarified identity of PThm nodes: do not reuse old id after renaming -- enforce uniqueness of substructures;
wenzelm
parents: 70543
diff changeset
  1163
70595
2ae7e33c950f clarified thm_id vs. thm_node/thm: retain theory_name;
wenzelm
parents: 70593
diff changeset
  1164
(*dependencies of PThm node*)
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
  1165
fun thm_deps (thm as Thm (Deriv {promises = [], body = PBody {thms, ...}, ...}, _)) =
77866
3bd1aa2f3517 backout 61f652dd955a;
wenzelm
parents: 77864
diff changeset
  1166
      (case (derivation_id thm, thms) of
3bd1aa2f3517 backout 61f652dd955a;
wenzelm
parents: 77864
diff changeset
  1167
        (SOME {serial = i, ...}, [(j, thm_node)]) =>
3bd1aa2f3517 backout 61f652dd955a;
wenzelm
parents: 77864
diff changeset
  1168
          if i = j then Proofterm.thm_node_thms thm_node else thms
3bd1aa2f3517 backout 61f652dd955a;
wenzelm
parents: 77864
diff changeset
  1169
      | _ => thms)
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
  1170
  | thm_deps thm = raise THM ("thm_deps: bad promises", 0, [thm]);
70595
2ae7e33c950f clarified thm_id vs. thm_node/thm: retain theory_name;
wenzelm
parents: 70593
diff changeset
  1171
70494
41108e3e9ca5 formal position for PThm nodes;
wenzelm
parents: 70482
diff changeset
  1172
fun name_derivation name_pos =
71530
046cf49162a3 more thorough strip_shyps for proof boxes (but types are usually stripped and reconstructed later);
wenzelm
parents: 71527
diff changeset
  1173
  strip_shyps #> (fn thm as Thm (der, args) =>
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1174
    let
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1175
      val thy = theory_of_thm thm;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1176
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1177
      val Deriv {promises, body} = der;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1178
      val {shyps, hyps, prop, tpairs, ...} = args;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1179
70517
9a9003b5c0c1 more robust -- notably for metis, which tends to accumulate tpairs;
wenzelm
parents: 70503
diff changeset
  1180
      val _ = null tpairs orelse raise THM ("name_derivation: bad flex-flex constraints", 0, [thm]);
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1181
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
  1182
      val ps = map (apsnd (Future.map fulfill_body)) promises;
79425
0875c87b4a4b clarified signature;
wenzelm
parents: 79418
diff changeset
  1183
      val body' = Proofterm.thm_proof thy (sorts_proof thy) name_pos shyps hyps prop ps body;
79262
64c655e8e8bf clarified modules;
wenzelm
parents: 79261
diff changeset
  1184
    in Thm (make_deriv0 [] body', args) end);
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  1185
70494
41108e3e9ca5 formal position for PThm nodes;
wenzelm
parents: 70482
diff changeset
  1186
fun close_derivation pos =
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1187
  solve_constraints #> (fn thm =>
70517
9a9003b5c0c1 more robust -- notably for metis, which tends to accumulate tpairs;
wenzelm
parents: 70503
diff changeset
  1188
    if not (null (tpairs_of thm)) orelse derivation_closed thm then thm
80295
8a9588ffc133 more accurate Thm_Name.T for PThm / Thm.name_derivation / Thm.derivation_name;
wenzelm
parents: 80289
diff changeset
  1189
    else name_derivation (Thm_Name.empty, pos) thm);
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1190
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1191
val trim_context = solve_constraints #> trim_context_thm;
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1192
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1193
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1194
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1195
(*** Oracles ***)
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1196
79322
f321ab14dd94 tuned names;
wenzelm
parents: 79321
diff changeset
  1197
fun add_oracle (b, oracle_fn) thy1 =
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1198
  let
79322
f321ab14dd94 tuned names;
wenzelm
parents: 79321
diff changeset
  1199
    val (name, oracles') = Name_Space.define (Context.Theory thy1) true (b, ()) (get_oracles thy1);
f321ab14dd94 tuned names;
wenzelm
parents: 79321
diff changeset
  1200
    val thy2 = map_oracles (K oracles') thy1;
79323
3bbe31b35f5b clarified context: avoid capture of thy2 within closure;
wenzelm
parents: 79322
diff changeset
  1201
    val cert2 = Context.Certificate_Id (Context.theory_id thy2);
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1202
    fun invoke_oracle arg =
79323
3bbe31b35f5b clarified context: avoid capture of thy2 within closure;
wenzelm
parents: 79322
diff changeset
  1203
      let val ct as Cterm {cert = cert3, t = prop, T, maxidx, sorts} = oracle_fn arg in
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1204
        if T <> propT then
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1205
          raise THM ("Oracle's result must have type prop: " ^ name, 0, [])
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1206
        else
70834
614ca81fa28e clarified oracle_proof;
wenzelm
parents: 70827
diff changeset
  1207
          let
79323
3bbe31b35f5b clarified context: avoid capture of thy2 within closure;
wenzelm
parents: 79322
diff changeset
  1208
            val cert = Context.join_certificate (cert2, cert3);
79219
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1209
            val proofs = Proofterm.get_proofs_level ();
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1210
            val oracle =
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1211
              if Proofterm.oracle_enabled proofs
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1212
              then ((name, Position.thread_data ()), SOME prop)
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1213
              else ((name, Position.none), NONE);
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1214
            val proof =
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1215
              if Proofterm.proof_enabled proofs
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1216
              then Proofterm.oracle_proof name prop
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1217
              else MinProof;
8b371e684acf clarified signature: more explicit get_proofs_level with bounds check;
wenzelm
parents: 79212
diff changeset
  1218
            val zproof =
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1219
              if Proofterm.zproof_enabled proofs then
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1220
                let
79322
f321ab14dd94 tuned names;
wenzelm
parents: 79321
diff changeset
  1221
                  val thy = Context.certificate_theory cert handle ERROR msg =>
79323
3bbe31b35f5b clarified context: avoid capture of thy2 within closure;
wenzelm
parents: 79322
diff changeset
  1222
                    raise CONTEXT (msg, [], [ct], [], NONE);
79322
f321ab14dd94 tuned names;
wenzelm
parents: 79321
diff changeset
  1223
                in ZTerm.oracle_proof thy name prop end
80560
960b866b1117 tuned signature;
wenzelm
parents: 80295
diff changeset
  1224
              else ZNop;
70834
614ca81fa28e clarified oracle_proof;
wenzelm
parents: 70827
diff changeset
  1225
          in
79279
d9a7ee1bd070 minor performance tuning: more concise union;
wenzelm
parents: 79273
diff changeset
  1226
            Thm (make_deriv [] [oracle] [] [] zproof proof,
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1227
             {cert = cert,
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1228
              tags = [],
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1229
              maxidx = maxidx,
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
  1230
              constraints = [],
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1231
              shyps = sorts,
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1232
              hyps = [],
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1233
              tpairs = [],
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1234
              prop = prop})
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1235
          end
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1236
      end;
79322
f321ab14dd94 tuned names;
wenzelm
parents: 79321
diff changeset
  1237
  in ((name, invoke_oracle), thy2) end;
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1238
70560
7714971a58b5 added command 'thm_oracles';
wenzelm
parents: 70558
diff changeset
  1239
val oracle_space = Name_Space.space_of_table o get_oracles;
7714971a58b5 added command 'thm_oracles';
wenzelm
parents: 70558
diff changeset
  1240
7714971a58b5 added command 'thm_oracles';
wenzelm
parents: 70558
diff changeset
  1241
fun pretty_oracle ctxt =
7714971a58b5 added command 'thm_oracles';
wenzelm
parents: 70558
diff changeset
  1242
  Name_Space.pretty ctxt (oracle_space (Proof_Context.theory_of ctxt));
7714971a58b5 added command 'thm_oracles';
wenzelm
parents: 70558
diff changeset
  1243
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1244
fun extern_oracles verbose ctxt =
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1245
  map #1 (Name_Space.markup_table verbose ctxt (get_oracles (Proof_Context.theory_of ctxt)));
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1246
70565
d0b75c59beca added ML antiquotation @{oracle_name};
wenzelm
parents: 70564
diff changeset
  1247
fun check_oracle ctxt =
d0b75c59beca added ML antiquotation @{oracle_name};
wenzelm
parents: 70564
diff changeset
  1248
  Name_Space.check (Context.Proof ctxt) (get_oracles (Proof_Context.theory_of ctxt)) #> #1;
d0b75c59beca added ML antiquotation @{oracle_name};
wenzelm
parents: 70564
diff changeset
  1249
70454
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1250
fa933b98d64d clarified module structure;
wenzelm
parents: 70453
diff changeset
  1251
1529
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1252
(*** Meta rules ***)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1253
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1254
(** primitive rules **)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1255
16656
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
  1256
(*The assumption rule A |- A*)
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1257
fun assume raw_ct =
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1258
  let val ct as Cterm {cert, t = prop, T, maxidx, sorts} = adjust_maxidx_cterm ~1 raw_ct in
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1259
    if T <> propT then
19230
3342e7554b77 Shortened the exception messages from assume.
mengj
parents: 19012
diff changeset
  1260
      raise THM ("assume: prop", 0, [])
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1261
    else if maxidx <> ~1 then
19230
3342e7554b77 Shortened the exception messages from assume.
mengj
parents: 19012
diff changeset
  1262
      raise THM ("assume: variables", maxidx, [])
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1263
    else
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1264
      let
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1265
        fun zproof () =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1266
          let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1267
            val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1268
              raise CONTEXT (msg, [], [ct], [], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1269
          in ZTerm.assume_proof thy prop end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1270
        fun proof () = Proofterm.Hyp prop;
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1271
      in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1272
        Thm (deriv_rule0 zproof proof,
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1273
         {cert = cert,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1274
          tags = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1275
          maxidx = ~1,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1276
          constraints = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1277
          shyps = sorts,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1278
          hyps = [prop],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1279
          tpairs = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1280
          prop = prop})
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1281
      end
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1282
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1283
81938
d25181c1807a clarified exceptions;
wenzelm
parents: 81855
diff changeset
  1284
fun assume_cterm A = assume A
d25181c1807a clarified exceptions;
wenzelm
parents: 81855
diff changeset
  1285
  handle THM (msg, _, _) => raise CTERM (msg, [A]);
d25181c1807a clarified exceptions;
wenzelm
parents: 81855
diff changeset
  1286
d25181c1807a clarified exceptions;
wenzelm
parents: 81855
diff changeset
  1287
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1288
(*Implication introduction
3529
31186470665f tuned warning;
wenzelm
parents: 3410
diff changeset
  1289
    [A]
31186470665f tuned warning;
wenzelm
parents: 3410
diff changeset
  1290
     :
31186470665f tuned warning;
wenzelm
parents: 3410
diff changeset
  1291
     B
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1292
  -------
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1293
  A \<Longrightarrow> B
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1294
*)
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1295
fun implies_intr
68691
wenzelm
parents: 67721
diff changeset
  1296
    (ct as Cterm {t = A, T, maxidx = maxidx1, sorts, ...})
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1297
    (th as Thm (der, {maxidx = maxidx2, hyps, constraints, shyps, tpairs, prop, ...})) =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1298
  if T <> propT then
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1299
    raise THM ("implies_intr: assumptions must have type prop", 0, [th])
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1300
  else
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1301
    let
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1302
      val cert = join_certificate1 (ct, th);
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1303
      fun zproof p =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1304
        let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1305
          val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1306
            raise CONTEXT (msg, [], [ct], [th], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1307
        in ZTerm.implies_intr_proof thy A p end
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1308
      fun proof p = Proofterm.implies_intr_proof A p;
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1309
    in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1310
      Thm (deriv_rule1 zproof proof der,
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1311
       {cert = cert,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1312
        tags = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1313
        maxidx = Int.max (maxidx1, maxidx2),
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1314
        constraints = constraints,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1315
        shyps = Sorts.union sorts shyps,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1316
        hyps = remove_hyps A hyps,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1317
        tpairs = tpairs,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1318
        prop = Logic.mk_implies (A, prop)})
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1319
    end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1320
1529
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1321
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1322
(*Implication elimination
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1323
  A \<Longrightarrow> B    A
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1324
  ------------
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1325
        B
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1326
*)
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1327
fun implies_elim thAB thA =
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1328
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1329
    val Thm (derA,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1330
      {maxidx = maxidx1, hyps = hypsA, constraints = constraintsA, shyps = shypsA,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1331
        tpairs = tpairsA, prop = propA, ...}) = thA
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1332
    and Thm (der, {maxidx = maxidx2, hyps, constraints, shyps, tpairs, prop, ...}) = thAB;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1333
    fun err () = raise THM ("implies_elim: major premise", 0, [thAB, thA]);
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1334
  in
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1335
    (case prop of
56245
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  1336
      Const ("Pure.imp", _) $ A $ B =>
20512
a041c2afb52e ctyp: maintain maxidx;
wenzelm
parents: 20348
diff changeset
  1337
        if A aconv propA then
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1338
          Thm (deriv_rule2 (curry ZAppp) (curry Proofterm.%%) der derA,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
  1339
           {cert = join_certificate2 (thAB, thA),
21646
c07b5b0e8492 thm/prf: separate official name vs. additional tags;
wenzelm
parents: 21576
diff changeset
  1340
            tags = [],
68691
wenzelm
parents: 67721
diff changeset
  1341
            maxidx = Int.max (maxidx1, maxidx2),
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
  1342
            constraints = union_constraints constraintsA constraints,
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1343
            shyps = Sorts.union shypsA shyps,
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1344
            hyps = union_hyps hypsA hyps,
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1345
            tpairs = union_tpairs tpairsA tpairs,
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  1346
            prop = B})
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1347
        else err ()
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1348
    | _ => err ())
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1349
  end;
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  1350
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1351
(*Forall introduction.  The Free or Var x must not be free in the hypotheses.
16656
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
  1352
    [x]
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
  1353
     :
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
  1354
     A
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
  1355
  ------
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1356
  \<And>x. A
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1357
*)
77807
wenzelm
parents: 77806
diff changeset
  1358
fun occs x ts tpairs =
wenzelm
parents: 77806
diff changeset
  1359
  let fun occs t = Logic.occs (x, t)
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1360
  in exists occs ts orelse exists (occs o fst) tpairs orelse exists (occs o snd) tpairs end;
77807
wenzelm
parents: 77806
diff changeset
  1361
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1362
fun forall_intr
68692
0c568ec56f37 proper maxidx: if x does not occur in A, its maxidx could get lost;
wenzelm
parents: 68691
diff changeset
  1363
    (ct as Cterm {maxidx = maxidx1, t = x, T, sorts, ...})
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1364
    (th as Thm (der, {maxidx = maxidx2, constraints, shyps, hyps, tpairs, prop, ...})) =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1365
  let
77807
wenzelm
parents: 77806
diff changeset
  1366
    fun check_result a ts =
wenzelm
parents: 77806
diff changeset
  1367
      if occs x ts tpairs then
21798
a1399df6ecf3 tuned error messages;
wenzelm
parents: 21646
diff changeset
  1368
        raise THM ("forall_intr: variable " ^ quote a ^ " free in assumptions", 0, [th])
77807
wenzelm
parents: 77806
diff changeset
  1369
      else
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1370
        let
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1371
          val cert = join_certificate1 (ct, th);
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1372
          fun zproof p =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1373
            let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1374
              val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1375
                raise CONTEXT (msg, [], [ct], [th], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1376
            in ZTerm.forall_intr_proof thy T (a, x) p end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1377
          fun proof p = Proofterm.forall_intr_proof (a, x) NONE p;
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1378
        in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1379
          Thm (deriv_rule1 zproof proof der,
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1380
           {cert = cert,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1381
            tags = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1382
            maxidx = Int.max (maxidx1, maxidx2),
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1383
            constraints = constraints,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1384
            shyps = Sorts.union sorts shyps,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1385
            hyps = hyps,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1386
            tpairs = tpairs,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1387
            prop = Logic.all_const T $ Abs (a, T, abstract_over (x, prop))})
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1388
        end;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1389
  in
52788
da1fdbfebd39 type theory is purely value-oriented;
wenzelm
parents: 52709
diff changeset
  1390
    (case x of
77807
wenzelm
parents: 77806
diff changeset
  1391
      Free (a, _) => check_result a hyps
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1392
    | Var ((a, _), _) => check_result a []
52788
da1fdbfebd39 type theory is purely value-oriented;
wenzelm
parents: 52709
diff changeset
  1393
    | _ => raise THM ("forall_intr: not a variable", 0, [th]))
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1394
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1395
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1396
(*Forall elimination
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1397
  \<And>x. A
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1398
  ------
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1399
  A[t/x]
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1400
*)
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1401
fun forall_elim
68691
wenzelm
parents: 67721
diff changeset
  1402
    (ct as Cterm {t, T, maxidx = maxidx1, sorts, ...})
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1403
    (th as Thm (der, {maxidx = maxidx2, constraints, shyps, hyps, tpairs, prop, ...})) =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1404
  (case prop of
56245
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  1405
    Const ("Pure.all", Type ("fun", [Type ("fun", [qary, _]), _])) $ A =>
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1406
      if T <> qary then
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1407
        raise THM ("forall_elim: type mismatch", 0, [th])
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1408
      else
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1409
        let
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1410
          val cert = join_certificate1 (ct, th);
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1411
          fun zproof p =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1412
            let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1413
              val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1414
                raise CONTEXT (msg, [], [ct], [th], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1415
            in ZTerm.forall_elim_proof thy t p end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1416
          fun proof p = p % SOME t;
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1417
        in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1418
          Thm (deriv_rule1 zproof proof der,
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1419
           {cert = cert,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1420
            tags = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1421
            maxidx = Int.max (maxidx1, maxidx2),
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1422
            constraints = constraints,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1423
            shyps = Sorts.union sorts shyps,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1424
            hyps = hyps,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1425
            tpairs = tpairs,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1426
            prop = Term.betapply (A, t)})
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1427
        end
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1428
  | _ => raise THM ("forall_elim: not quantified", 0, [th]));
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1429
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1430
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1431
(* Equality *)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1432
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1433
(*Reflexivity
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1434
  t \<equiv> t
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1435
*)
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1436
fun reflexive (ct as Cterm {cert, t, T, maxidx, sorts}) =
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1437
  let
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1438
    fun zproof () =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1439
      let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1440
        val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1441
          raise CONTEXT (msg, [], [ct], [], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1442
      in ZTerm.reflexive_proof thy T t end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1443
    fun proof () = Proofterm.reflexive_proof;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1444
  in
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1445
    Thm (deriv_rule0 zproof proof,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1446
     {cert = cert,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1447
      tags = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1448
      maxidx = maxidx,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1449
      constraints = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1450
      shyps = sorts,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1451
      hyps = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1452
      tpairs = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1453
      prop = Logic.mk_equals (t, t)})
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1454
  end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1455
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1456
(*Symmetry
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1457
  t \<equiv> u
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1458
  ------
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1459
  u \<equiv> t
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1460
*)
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1461
fun symmetric (th as Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...})) =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1462
  (case prop of
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1463
    (eq as Const ("Pure.eq", Type ("fun", [T, _]))) $ t $ u =>
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1464
      let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1465
        fun zproof p =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1466
          let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1467
            val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1468
              raise CONTEXT (msg, [], [], [th], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1469
          in ZTerm.symmetric_proof thy T t u p end;
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1470
      in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1471
        Thm (deriv_rule1 zproof Proofterm.symmetric_proof der,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1472
         {cert = cert,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1473
          tags = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1474
          maxidx = maxidx,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1475
          constraints = constraints,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1476
          shyps = shyps,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1477
          hyps = hyps,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1478
          tpairs = tpairs,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1479
          prop = eq $ u $ t})
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1480
      end
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1481
    | _ => raise THM ("symmetric", 0, [th]));
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1482
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1483
(*Transitivity
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1484
  t1 \<equiv> u    u \<equiv> t2
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1485
  ------------------
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1486
       t1 \<equiv> t2
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1487
*)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1488
fun transitive th1 th2 =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1489
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1490
    val Thm (der1, {maxidx = maxidx1, hyps = hyps1, constraints = constraints1, shyps = shyps1,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1491
        tpairs = tpairs1, prop = prop1, ...}) = th1
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1492
    and Thm (der2, {maxidx = maxidx2, hyps = hyps2, constraints = constraints2, shyps = shyps2,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1493
        tpairs = tpairs2, prop = prop2, ...}) = th2;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1494
    fun err msg = raise THM ("transitive: " ^ msg, 0, [th1, th2]);
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1495
  in
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1496
    case (prop1, prop2) of
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1497
      ((eq as Const ("Pure.eq", Type (_, [T, _]))) $ t1 $ u, Const ("Pure.eq", _) $ u' $ t2) =>
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1498
        if not (u aconv u') then err "middle term"
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1499
        else
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1500
          let
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1501
            val cert = join_certificate2 (th1, th2);
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1502
            fun zproof p q =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1503
              let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1504
                val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1505
                  raise CONTEXT (msg, [], [], [th1, th2], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1506
              in ZTerm.transitive_proof thy T t1 u t2 p q end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1507
            fun proof p = Proofterm.transitive_proof T u p;
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1508
          in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1509
            Thm (deriv_rule2 zproof proof der1 der2,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1510
             {cert = cert,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1511
              tags = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1512
              maxidx = Int.max (maxidx1, maxidx2),
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1513
              constraints = union_constraints constraints1 constraints2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1514
              shyps = Sorts.union shyps1 shyps2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1515
              hyps = union_hyps hyps1 hyps2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1516
              tpairs = union_tpairs tpairs1 tpairs2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1517
              prop = eq $ t1 $ t2})
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1518
          end
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1519
     | _ => err "premises"
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1520
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1521
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1522
(*Beta-conversion
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1523
  (\<lambda>x. t) u \<equiv> t[u/x]
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1524
  fully beta-reduces the term if full = true
10416
5b33e732e459 - Moved rewriting functions to meta_simplifier.ML
berghofe
parents: 10348
diff changeset
  1525
*)
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1526
fun beta_conversion full (ct as Cterm {cert, t, T, maxidx, sorts}) =
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1527
  let
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1528
    val t' =
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1529
      if full then Envir.beta_norm t
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1530
      else
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1531
        (case t of Abs (_, _, bodt) $ u => subst_bound (u, bodt)
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1532
        | _ => raise THM ("beta_conversion: not a redex", 0, []));
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1533
    fun zproof () =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1534
      let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1535
        val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1536
          raise CONTEXT (msg, [], [ct], [], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1537
      in ZTerm.reflexive_proof thy T t end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1538
    fun proof () = Proofterm.reflexive_proof;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1539
  in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1540
    Thm (deriv_rule0 zproof proof,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
  1541
     {cert = cert,
21646
c07b5b0e8492 thm/prf: separate official name vs. additional tags;
wenzelm
parents: 21576
diff changeset
  1542
      tags = [],
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1543
      maxidx = maxidx,
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
  1544
      constraints = [],
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1545
      shyps = sorts,
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1546
      hyps = [],
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1547
      tpairs = [],
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  1548
      prop = Logic.mk_equals (t, t')})
10416
5b33e732e459 - Moved rewriting functions to meta_simplifier.ML
berghofe
parents: 10348
diff changeset
  1549
  end;
5b33e732e459 - Moved rewriting functions to meta_simplifier.ML
berghofe
parents: 10348
diff changeset
  1550
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1551
fun eta_conversion (ct as Cterm {cert, t, T, maxidx, sorts}) =
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1552
  let
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1553
    fun zproof () =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1554
      let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1555
        val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1556
          raise CONTEXT (msg, [], [ct], [], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1557
      in ZTerm.reflexive_proof thy T t end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1558
    fun proof () = Proofterm.reflexive_proof;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1559
  in
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1560
    Thm (deriv_rule0 zproof proof,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1561
     {cert = cert,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1562
      tags = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1563
      maxidx = maxidx,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1564
      constraints = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1565
      shyps = sorts,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1566
      hyps = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1567
      tpairs = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1568
      prop = Logic.mk_equals (t, Envir.eta_contract t)})
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1569
  end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1570
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1571
fun eta_long_conversion (ct as Cterm {cert, t, T, maxidx, sorts}) =
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1572
  let
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1573
    fun zproof () =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1574
      let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1575
        val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1576
          raise CONTEXT (msg, [], [ct], [], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1577
      in ZTerm.reflexive_proof thy T t end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1578
    fun proof () = Proofterm.reflexive_proof;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1579
  in
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1580
    Thm (deriv_rule0 zproof proof,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1581
     {cert = cert,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1582
      tags = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1583
      maxidx = maxidx,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1584
      constraints = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1585
      shyps = sorts,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1586
      hyps = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1587
      tpairs = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1588
      prop = Logic.mk_equals (t, Envir.eta_long [] t)})
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1589
  end;
23493
a056eefb76e5 added eta_long_conversion;
wenzelm
parents: 23296
diff changeset
  1590
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1591
(*The abstraction rule.  The Free or Var x must not be free in the hypotheses.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1592
  The bound variable will be named "a" (since x will be something like x320)
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1593
      t \<equiv> u
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1594
  --------------
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1595
  \<lambda>x. t \<equiv> \<lambda>x. u
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1596
*)
77807
wenzelm
parents: 77806
diff changeset
  1597
fun abstract_rule b
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1598
    (ct as Cterm {t = x, T, sorts, ...})
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1599
    (th as Thm (der, {cert, maxidx, hyps, constraints, shyps, tpairs, prop, ...})) =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1600
  let
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1601
    val (U, t, u) =
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1602
      (case prop of
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1603
        Const ("Pure.eq", Type ("fun", [U, _])) $ t $ u => (U, t, u)
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1604
      | _ => raise THM ("abstract_rule: premise not an equality", 0, [th]));
77807
wenzelm
parents: 77806
diff changeset
  1605
    fun check_result a ts =
wenzelm
parents: 77806
diff changeset
  1606
      if occs x ts tpairs then
21798
a1399df6ecf3 tuned error messages;
wenzelm
parents: 21646
diff changeset
  1607
        raise THM ("abstract_rule: variable " ^ quote a ^ " free in assumptions", 0, [th])
77807
wenzelm
parents: 77806
diff changeset
  1608
      else
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1609
        let
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1610
          val f = Abs (b, T, abstract_over (x, t));
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1611
          val g = Abs (b, T, abstract_over (x, u));
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1612
          fun zproof p =
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1613
            let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1614
              val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1615
                raise CONTEXT (msg, [], [ct], [th], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1616
            in ZTerm.abstract_rule_proof thy T U (b, x) f g p end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1617
          fun proof p = Proofterm.abstract_rule_proof (b, x) p
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1618
        in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1619
          Thm (deriv_rule1 zproof proof der,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1620
           {cert = cert,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1621
            tags = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1622
            maxidx = maxidx,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1623
            constraints = constraints,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1624
            shyps = Sorts.union sorts shyps,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1625
            hyps = hyps,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1626
            tpairs = tpairs,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1627
            prop = Logic.mk_equals (f, g)})
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1628
        end;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1629
  in
52788
da1fdbfebd39 type theory is purely value-oriented;
wenzelm
parents: 52709
diff changeset
  1630
    (case x of
77807
wenzelm
parents: 77806
diff changeset
  1631
      Free (a, _) => check_result a hyps
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1632
    | Var ((a, _), _) => check_result a []
52788
da1fdbfebd39 type theory is purely value-oriented;
wenzelm
parents: 52709
diff changeset
  1633
    | _ => raise THM ("abstract_rule: not a variable", 0, [th]))
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1634
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1635
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1636
(*The combination rule
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1637
  f \<equiv> g  t \<equiv> u
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1638
  -------------
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1639
    f t \<equiv> g u
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1640
*)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1641
fun combination th1 th2 =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1642
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1643
    val Thm (der1, {maxidx = maxidx1, constraints = constraints1, shyps = shyps1,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1644
        hyps = hyps1, tpairs = tpairs1, prop = prop1, ...}) = th1
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1645
    and Thm (der2, {maxidx = maxidx2, constraints = constraints2, shyps = shyps2,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1646
        hyps = hyps2, tpairs = tpairs2, prop = prop2, ...}) = th2;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1647
  in
52788
da1fdbfebd39 type theory is purely value-oriented;
wenzelm
parents: 52709
diff changeset
  1648
    (case (prop1, prop2) of
56245
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  1649
      (Const ("Pure.eq", Type ("fun", [fT, _])) $ f $ g,
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  1650
       Const ("Pure.eq", Type ("fun", [tT, _])) $ t $ u) =>
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1651
        let
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1652
          val U =
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1653
            (case fT of
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1654
              Type ("fun", [T1, U]) =>
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1655
                if T1 = tT then U
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1656
                else raise THM ("combination: types", 0, [th1, th2])
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1657
            | _ => raise THM ("combination: not function type", 0, [th1, th2]));
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1658
          val cert = join_certificate2 (th1, th2);
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1659
          fun zproof p q =
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1660
            let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1661
              val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1662
                raise CONTEXT (msg, [], [], [th1, th2], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1663
            in ZTerm.combination_proof thy fT U f g t u p q end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1664
          fun proof p q = Proofterm.combination_proof f g t u p q;
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1665
        in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1666
          Thm (deriv_rule2 zproof proof der1 der2,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1667
           {cert = cert,
21646
c07b5b0e8492 thm/prf: separate official name vs. additional tags;
wenzelm
parents: 21576
diff changeset
  1668
            tags = [],
68691
wenzelm
parents: 67721
diff changeset
  1669
            maxidx = Int.max (maxidx1, maxidx2),
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
  1670
            constraints = union_constraints constraints1 constraints2,
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1671
            shyps = Sorts.union shyps1 shyps2,
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1672
            hyps = union_hyps hyps1 hyps2,
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1673
            tpairs = union_tpairs tpairs1 tpairs2,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1674
            prop = Logic.mk_equals (f $ t, g $ u)})
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1675
        end
52788
da1fdbfebd39 type theory is purely value-oriented;
wenzelm
parents: 52709
diff changeset
  1676
     | _ => raise THM ("combination: premises", 0, [th1, th2]))
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1677
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1678
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1679
(*Equality introduction
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1680
  A \<Longrightarrow> B  B \<Longrightarrow> A
3529
31186470665f tuned warning;
wenzelm
parents: 3410
diff changeset
  1681
  ----------------
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1682
       A \<equiv> B
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1683
*)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1684
fun equal_intr th1 th2 =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1685
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1686
    val Thm (der1, {maxidx = maxidx1, constraints = constraints1, shyps = shyps1,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1687
      hyps = hyps1, tpairs = tpairs1, prop = prop1, ...}) = th1
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1688
    and Thm (der2, {maxidx = maxidx2, constraints = constraints2, shyps = shyps2,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1689
      hyps = hyps2, tpairs = tpairs2, prop = prop2, ...}) = th2;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1690
    fun err msg = raise THM ("equal_intr: " ^ msg, 0, [th1, th2]);
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1691
  in
52788
da1fdbfebd39 type theory is purely value-oriented;
wenzelm
parents: 52709
diff changeset
  1692
    (case (prop1, prop2) of
56245
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  1693
      (Const("Pure.imp", _) $ A $ B, Const("Pure.imp", _) $ B' $ A') =>
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1694
        if A aconv A' andalso B aconv B' then
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1695
          let
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1696
            val cert = join_certificate2 (th1, th2);
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1697
            fun proof p q = Proofterm.equal_intr_proof A B p q;
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1698
            fun zproof p q =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1699
              let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1700
                val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1701
                  raise CONTEXT (msg, [], [], [th1, th2], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1702
              in ZTerm.equal_intr_proof thy A B p q end;
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1703
          in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1704
            Thm (deriv_rule2 zproof proof der1 der2,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1705
             {cert = cert,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1706
              tags = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1707
              maxidx = Int.max (maxidx1, maxidx2),
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1708
              constraints = union_constraints constraints1 constraints2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1709
              shyps = Sorts.union shyps1 shyps2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1710
              hyps = union_hyps hyps1 hyps2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1711
              tpairs = union_tpairs tpairs1 tpairs2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1712
              prop = Logic.mk_equals (A, B)})
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1713
          end
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1714
        else err "not equal"
52788
da1fdbfebd39 type theory is purely value-oriented;
wenzelm
parents: 52709
diff changeset
  1715
    | _ =>  err "premises")
1529
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1716
  end;
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1717
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1718
(*The equal propositions rule
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1719
  A \<equiv> B  A
1529
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1720
  ---------
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1721
      B
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1722
*)
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1723
fun equal_elim th1 th2 =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1724
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1725
    val Thm (der1, {maxidx = maxidx1, constraints = constraints1, shyps = shyps1,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1726
      hyps = hyps1, tpairs = tpairs1, prop = prop1, ...}) = th1
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1727
    and Thm (der2, {maxidx = maxidx2, constraints = constraints2, shyps = shyps2,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1728
      hyps = hyps2, tpairs = tpairs2, prop = prop2, ...}) = th2;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1729
    fun err msg = raise THM ("equal_elim: " ^ msg, 0, [th1, th2]);
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1730
  in
52788
da1fdbfebd39 type theory is purely value-oriented;
wenzelm
parents: 52709
diff changeset
  1731
    (case prop1 of
56245
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  1732
      Const ("Pure.eq", _) $ A $ B =>
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1733
        if prop2 aconv A then
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1734
          let
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1735
            val cert = join_certificate2 (th1, th2);
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1736
            fun proof p q = Proofterm.equal_elim_proof A B p q;
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1737
            fun zproof p q =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1738
              let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1739
                val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1740
                  raise CONTEXT (msg, [], [], [th1, th2], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1741
              in ZTerm.equal_elim_proof thy A B p q end;
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1742
          in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1743
            Thm (deriv_rule2 zproof proof der1 der2,
79124
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1744
             {cert = cert,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1745
              tags = [],
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1746
              maxidx = Int.max (maxidx1, maxidx2),
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1747
              constraints = union_constraints constraints1 constraints2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1748
              shyps = Sorts.union shyps1 shyps2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1749
              hyps = union_hyps hyps1 hyps2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1750
              tpairs = union_tpairs tpairs1 tpairs2,
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1751
              prop = B})
89d4a8f52738 more zproofs;
wenzelm
parents: 79119
diff changeset
  1752
          end
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1753
        else err "not equal"
52789
wenzelm
parents: 52788
diff changeset
  1754
     | _ =>  err "major premise")
1529
09d9ad015269 Addition of proof objects
paulson
parents: 1517
diff changeset
  1755
  end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1756
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1757
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1758
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1759
(**** Derived rules ****)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1760
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1761
(*Smash unifies the list of term pairs leaving no flex-flex pairs.
24143
90a9a6fe0d01 replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents: 23781
diff changeset
  1762
  Instantiates the theorem and deletes trivial tpairs.  Resulting
90a9a6fe0d01 replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents: 23781
diff changeset
  1763
  sequence may contain multiple elements if the tpairs are not all
90a9a6fe0d01 replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents: 23781
diff changeset
  1764
  flex-flex.*)
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1765
fun flexflex_rule opt_ctxt =
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1766
  solve_constraints #> (fn th =>
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1767
    let
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1768
      val Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = th;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1769
      val (context, cert') = make_context_certificate [th] opt_ctxt cert;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1770
    in
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1771
      Unify.smash_unifiers context tpairs (Envir.empty maxidx)
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1772
      |> Seq.map (fn env =>
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1773
          if Envir.is_empty env then th
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1774
          else
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1775
            let
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1776
              val tpairs' = tpairs |> map (apply2 (Envir.norm_term env))
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1777
                (*remove trivial tpairs, of the form t \<equiv> t*)
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1778
                |> filter_out (op aconv);
79206
wenzelm
parents: 79164
diff changeset
  1779
              val prop' = Envir.norm_term env prop;
78033
9c18535a9fcd proper exception CONTEXT for Context.certificate_theory;
wenzelm
parents: 77966
diff changeset
  1780
              val thy' = Context.certificate_theory cert' handle ERROR msg =>
9c18535a9fcd proper exception CONTEXT for Context.certificate_theory;
wenzelm
parents: 77966
diff changeset
  1781
                raise CONTEXT (msg, [], [], [th], Option.map Context.Proof opt_ctxt);
79207
f991d3003ec8 more zproofs;
wenzelm
parents: 79206
diff changeset
  1782
79270
90c5aadcc4b2 more robust norm_proof: turn env into instantiation, based on visible statement;
wenzelm
parents: 79263
diff changeset
  1783
              fun zproof p = ZTerm.norm_proof thy' env [full_prop_of th] p;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1784
              fun proof p = Proofterm.norm_proof_remove_types env p;
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1785
            in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1786
              Thm (deriv_rule1 zproof proof der,
79206
wenzelm
parents: 79164
diff changeset
  1787
               {cert = cert',
wenzelm
parents: 79164
diff changeset
  1788
                tags = [],
wenzelm
parents: 79164
diff changeset
  1789
                maxidx = maxidx_tpairs tpairs' (maxidx_of_term prop'),
wenzelm
parents: 79164
diff changeset
  1790
                constraints = insert_constraints_env thy' env constraints,
wenzelm
parents: 79164
diff changeset
  1791
                shyps = Envir.insert_sorts env shyps,
wenzelm
parents: 79164
diff changeset
  1792
                hyps = hyps,
wenzelm
parents: 79164
diff changeset
  1793
                tpairs = tpairs',
wenzelm
parents: 79164
diff changeset
  1794
                prop = prop'})
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1795
            end)
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1796
    end);
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1797
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1798
19910
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1799
(*Generalization of fixed variables
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1800
           A
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1801
  --------------------
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1802
  A[?'a/'a, ?x/x, ...]
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1803
*)
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1804
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1805
fun generalize (tfrees, frees) idx th =
74266
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
  1806
  if Names.is_empty tfrees andalso Names.is_empty frees then th
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1807
  else
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1808
    let
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1809
      val Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = th;
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1810
      val _ = idx <= maxidx andalso raise THM ("generalize: bad index", idx, [th]);
19910
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1811
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1812
      val bad_type =
74266
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
  1813
        if Names.is_empty tfrees then K false
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
  1814
        else Term.exists_subtype (fn TFree (a, _) => Names.defined tfrees a | _ => false);
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
  1815
      fun bad_term (Free (x, T)) = bad_type T orelse Names.defined frees x
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1816
        | bad_term (Var (_, T)) = bad_type T
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1817
        | bad_term (Const (_, T)) = bad_type T
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1818
        | bad_term (Abs (_, T, t)) = bad_type T orelse bad_term t
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1819
        | bad_term (t $ u) = bad_term t orelse bad_term u
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1820
        | bad_term (Bound _) = false;
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  1821
      val _ = exists bad_term hyps andalso
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1822
        raise THM ("generalize: variable free in assumptions", 0, [th]);
19910
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1823
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1824
      val generalize = Term_Subst.generalize (tfrees, frees) idx;
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1825
      val prop' = generalize prop;
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1826
      val tpairs' = map (apply2 generalize) tpairs;
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1827
      val maxidx' = maxidx_tpairs tpairs' (maxidx_of_term prop');
79133
cfe995369655 more zproofs;
wenzelm
parents: 79128
diff changeset
  1828
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1829
      val zproof = ZTerm.generalize_proof (tfrees, frees) idx;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1830
      val proof = Proofterm.generalize_proof (tfrees, frees) idx prop;
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1831
    in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1832
      Thm (deriv_rule1 zproof proof der,
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1833
       {cert = cert,
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1834
        tags = [],
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1835
        maxidx = maxidx',
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1836
        constraints = constraints,
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1837
        shyps = shyps,
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1838
        hyps = hyps,
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1839
        tpairs = tpairs',
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1840
        prop = prop'})
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1841
    end;
19910
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1842
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1843
fun generalize_cterm (tfrees, frees) idx (ct as Cterm {cert, t, T, maxidx, sorts}) =
74266
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
  1844
  if Names.is_empty tfrees andalso Names.is_empty frees then ct
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1845
  else if idx <= maxidx then raise CTERM ("generalize_cterm: bad index", [ct])
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1846
  else
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1847
    Cterm {cert = cert, sorts = sorts,
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1848
      T = Term_Subst.generalizeT tfrees idx T,
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1849
      t = Term_Subst.generalize (tfrees, frees) idx t,
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1850
      maxidx = Int.max (maxidx, idx)};
67697
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
  1851
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1852
fun generalize_ctyp tfrees idx (cT as Ctyp {cert, T, maxidx, sorts}) =
74266
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
  1853
  if Names.is_empty tfrees then cT
74200
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1854
  else if idx <= maxidx then raise CTERM ("generalize_ctyp: bad index", [])
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1855
  else
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1856
    Ctyp {cert = cert, sorts = sorts,
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1857
      T = Term_Subst.generalizeT tfrees idx T,
17090e27aae9 more scalable data structure (but: rarely used with > 5 arguments);
wenzelm
parents: 74112
diff changeset
  1858
      maxidx = Int.max (maxidx, idx)};
67697
58f951ce71c8 more operations for ctyp, cterm;
wenzelm
parents: 67649
diff changeset
  1859
19910
2b4a222fef3c added generalize rule;
wenzelm
parents: 19881
diff changeset
  1860
22584
d0f0f37ec346 improved exception CTERM;
wenzelm
parents: 22573
diff changeset
  1861
(*Instantiation of schematic variables
16656
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
  1862
           A
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
  1863
  --------------------
18b0cb22057d ctyp: added 'sorts' field;
wenzelm
parents: 16601
diff changeset
  1864
  A[t1/v1, ..., tn/vn]
1220
3b0b8408fc5f MAJOR changes:
wenzelm
parents: 1195
diff changeset
  1865
*)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1866
6928
9b4cd97b459d improved error msgs of instantiate;
wenzelm
parents: 6899
diff changeset
  1867
local
9b4cd97b459d improved error msgs of instantiate;
wenzelm
parents: 6899
diff changeset
  1868
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1869
fun add_cert cert_of (_, c) cert = Context.join_certificate (cert, cert_of c);
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1870
val add_instT_cert = add_cert (fn Ctyp {cert, ...} => cert);
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1871
val add_inst_cert = add_cert (fn Cterm {cert, ...} => cert);
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1872
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  1873
fun add_sorts sorts_of (_, c) sorts = Sorts.union (sorts_of c) sorts;
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1874
val add_instT_sorts = add_sorts (fn Ctyp {sorts, ...} => sorts);
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1875
val add_inst_sorts = add_sorts (fn Cterm {sorts, ...} => sorts);
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1876
77804
wenzelm
parents: 77803
diff changeset
  1877
fun make_instT thy (_: indexname, S) (Ctyp {T = U, maxidx, ...}) =
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1878
  if Sign.of_sort thy (U, S) then (U, maxidx)
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1879
  else raise TYPE ("Type not of sort " ^ Syntax.string_of_sort_global thy S, [U], []);
15797
a63605582573 - Eliminated nodup_vars check.
berghofe
parents: 15672
diff changeset
  1880
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1881
fun make_inst thy (v as (_, T)) (Cterm {t = u, T = U, maxidx, ...}) =
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1882
  if T = U then (u, maxidx)
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1883
  else
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1884
    let
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1885
      fun pretty_typing t ty =
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1886
        Pretty.block [Syntax.pretty_term_global thy t, Pretty.str " ::",
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1887
          Pretty.brk 1, Syntax.pretty_typ_global thy ty];
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1888
      val msg =
82123
c30b6eff8fa1 tuned message;
wenzelm
parents: 81959
diff changeset
  1889
        Pretty.string_of (Pretty.big_list "instantiate: type conflict"
c30b6eff8fa1 tuned message;
wenzelm
parents: 81959
diff changeset
  1890
         [Pretty.item [pretty_typing (Var v) T],
c30b6eff8fa1 tuned message;
wenzelm
parents: 81959
diff changeset
  1891
          Pretty.item [pretty_typing u U]]);
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1892
    in raise TYPE (msg, [T, U], [Var v, u]) end;
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1893
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1894
fun prep_insts (instT, inst) (cert, sorts) =
6928
9b4cd97b459d improved error msgs of instantiate;
wenzelm
parents: 6899
diff changeset
  1895
  let
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1896
    val cert' = cert
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1897
      |> TVars.fold add_instT_cert instT
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1898
      |> Vars.fold add_inst_cert inst;
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1899
    val thy' =
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1900
      Context.certificate_theory cert' handle ERROR msg =>
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1901
        raise CONTEXT (msg, TVars.dest instT |> map #2, Vars.dest inst |> map #2, [], NONE);
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1902
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1903
    val sorts' = sorts
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1904
      |> TVars.fold add_instT_sorts instT
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1905
      |> Vars.fold add_inst_sorts inst;
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1906
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1907
    val instT' = TVars.map (make_instT thy') instT;
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1908
    val inst' = Vars.map (make_inst thy') inst;
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1909
  in ((instT', inst'), (cert', sorts')) end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1910
6928
9b4cd97b459d improved error msgs of instantiate;
wenzelm
parents: 6899
diff changeset
  1911
in
9b4cd97b459d improved error msgs of instantiate;
wenzelm
parents: 6899
diff changeset
  1912
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1913
(*Left-to-right replacements: ctpairs = [..., (vi, ti), ...].
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1914
  Instantiates distinct Vars by terms of same type.
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1915
  Does NOT normalize the resulting theorem!*)
74577
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1916
fun gen_instantiate inst_fn (instT, inst) th =
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1917
  if TVars.is_empty instT andalso Vars.is_empty inst then th
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1918
  else
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1919
    let
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1920
      val Thm (der, {cert, hyps, constraints, shyps, tpairs, prop, ...}) = th;
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1921
      val ((instT', inst'), (cert', shyps')) = prep_insts (instT, inst) (cert, shyps)
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1922
        handle CONTEXT (msg, cTs, cts, ths, context) =>
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1923
          raise CONTEXT (msg, cTs, cts, th :: ths, context);
74219
1d25be2353e1 minor performance tuning: fewer allocations;
wenzelm
parents: 74200
diff changeset
  1924
74577
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1925
      val subst = inst_fn (instT', inst');
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1926
      val (prop', maxidx1) = subst prop ~1;
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1927
      val (tpairs', maxidx') =
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1928
        fold_map (fn (t, u) => fn i => subst t i ||>> subst u) tpairs maxidx1;
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  1929
78033
9c18535a9fcd proper exception CONTEXT for Context.certificate_theory;
wenzelm
parents: 77966
diff changeset
  1930
      val thy' = Context.certificate_theory cert'
9c18535a9fcd proper exception CONTEXT for Context.certificate_theory;
wenzelm
parents: 77966
diff changeset
  1931
        handle ERROR msg => raise CONTEXT (msg, [], [], [th], NONE);
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1932
      val constraints' =
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1933
        TVars.fold (fn ((_, S), (T, _)) => insert_constraints thy' (T, S))
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1934
          instT' constraints;
79149
810679c5ed3c more zproofs;
wenzelm
parents: 79135
diff changeset
  1935
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1936
      fun zproof p =
79149
810679c5ed3c more zproofs;
wenzelm
parents: 79135
diff changeset
  1937
        ZTerm.instantiate_proof thy'
810679c5ed3c more zproofs;
wenzelm
parents: 79135
diff changeset
  1938
          (TVars.fold (fn (v, (T, _)) => cons (v, T)) instT' [],
810679c5ed3c more zproofs;
wenzelm
parents: 79135
diff changeset
  1939
           Vars.fold (fn (v, (t, _)) => cons (v, t)) inst' []) p;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1940
      fun proof p =
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1941
        Proofterm.instantiate (TVars.map (K #1) instT', Vars.map (K #1) inst') p;
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1942
    in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1943
      Thm (deriv_rule1 zproof proof der,
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1944
       {cert = cert',
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1945
        tags = [],
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1946
        maxidx = maxidx',
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1947
        constraints = constraints',
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1948
        shyps = shyps',
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1949
        hyps = hyps,
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1950
        tpairs = tpairs',
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1951
        prop = prop'})
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1952
      |> solve_constraints
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1953
    end
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1954
    handle TYPE (msg, _, _) => raise THM (msg, 0, [th]);
6928
9b4cd97b459d improved error msgs of instantiate;
wenzelm
parents: 6899
diff changeset
  1955
74577
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1956
val instantiate = gen_instantiate Term_Subst.instantiate_maxidx;
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1957
val instantiate_beta = gen_instantiate Term_Subst.instantiate_beta_maxidx;
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1958
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1959
fun gen_instantiate_cterm inst_fn (instT, inst) ct =
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1960
  if TVars.is_empty instT andalso Vars.is_empty inst then ct
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1961
  else
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1962
    let
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1963
      val Cterm {cert, t, T, sorts, ...} = ct;
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1964
      val ((instT', inst'), (cert', sorts')) = prep_insts (instT, inst) (cert, sorts);
74577
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1965
      val subst = inst_fn (instT', inst');
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1966
      val substT = Term_Subst.instantiateT_maxidx instT';
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1967
      val (t', maxidx1) = subst t ~1;
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1968
      val (T', maxidx') = substT T maxidx1;
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1969
    in Cterm {cert = cert', t = t', T = T', sorts = sorts', maxidx = maxidx'} end
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  1970
    handle TYPE (msg, _, _) => raise CTERM (msg, [ct]);
22584
d0f0f37ec346 improved exception CTERM;
wenzelm
parents: 22573
diff changeset
  1971
74577
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1972
val instantiate_cterm = gen_instantiate_cterm Term_Subst.instantiate_maxidx;
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1973
val instantiate_beta_cterm = gen_instantiate_cterm Term_Subst.instantiate_beta_maxidx;
d4829a7333e2 clarified instantiation: local beta reduction after substitution, as for Envir.expand_term_defs;
wenzelm
parents: 74561
diff changeset
  1974
6928
9b4cd97b459d improved error msgs of instantiate;
wenzelm
parents: 6899
diff changeset
  1975
end;
9b4cd97b459d improved error msgs of instantiate;
wenzelm
parents: 6899
diff changeset
  1976
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  1977
67721
5348bea4accd eliminated ASCII syntax from Pure bootstrap;
wenzelm
parents: 67697
diff changeset
  1978
(*The trivial implication A \<Longrightarrow> A, justified by assume and forall rules.
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1979
  A can contain Vars, not so for assume!*)
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1980
fun trivial (ct as Cterm {cert, t = A, T, maxidx, sorts}) =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1981
  if T <> propT then
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1982
    raise THM ("trivial: the term must have type prop", 0, [])
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  1983
  else
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1984
    let
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1985
      fun zproof () =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1986
        let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1987
          val thy = Context.certificate_theory cert handle ERROR msg =>
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1988
            raise CONTEXT (msg, [], [ct], [], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  1989
        in ZTerm.trivial_proof thy A end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1990
      fun proof () = Proofterm.trivial_proof;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1991
    in
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  1992
      Thm (deriv_rule0 zproof proof,
79119
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1993
       {cert = cert,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1994
        tags = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1995
        maxidx = maxidx,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1996
        constraints = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1997
        shyps = sorts,
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1998
        hyps = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  1999
        tpairs = [],
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  2000
        prop = Logic.mk_implies (A, A)})
cf29db6c95e1 more zterm operations;
wenzelm
parents: 79114
diff changeset
  2001
    end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2002
31944
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2003
(*Axiom-scheme reflecting signature contents
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2004
        T :: c
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2005
  -------------------
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2006
  OFCLASS(T, c_class)
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2007
*)
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2008
fun of_class (cT, raw_c) =
24143
90a9a6fe0d01 replaced Theory.self_ref by Theory.check_thy, which now produces a checked ref;
wenzelm
parents: 23781
diff changeset
  2009
  let
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
  2010
    val Ctyp {cert, T, ...} = cT;
61051
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
  2011
    val thy = Context.certificate_theory cert
310cf33d5481 clarified exceptions;
wenzelm
parents: 61050
diff changeset
  2012
      handle ERROR msg => raise CONTEXT (msg, [cT], [], [], NONE);
31903
c5221dbc40f6 added pro-forma proof constructor Inclass;
wenzelm
parents: 30717
diff changeset
  2013
    val c = Sign.certify_class thy raw_c;
59621
291934bac95e Thm.cterm_of and Thm.ctyp_of operate on local context;
wenzelm
parents: 59591
diff changeset
  2014
    val Cterm {t = prop, maxidx, sorts, ...} = global_cterm_of thy (Logic.mk_of_class (T, c));
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2015
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2016
    fun zproof () = ZTerm.of_class_proof (T, c);
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2017
    fun proof () = Proofterm.PClass (T, c);
399
86cc2b98f9e0 added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents: 387
diff changeset
  2018
  in
31944
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2019
    if Sign.of_sort thy (T, [c]) then
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2020
      Thm (deriv_rule0 zproof proof,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
  2021
       {cert = cert,
31944
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2022
        tags = [],
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2023
        maxidx = maxidx,
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
  2024
        constraints = insert_constraints thy (T, [c]) [],
31944
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2025
        shyps = sorts,
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  2026
        hyps = [],
31944
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2027
        tpairs = [],
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2028
        prop = prop})
c8a35979a5bc clarified Thm.of_class/of_sort/class_triv;
wenzelm
parents: 31943
diff changeset
  2029
    else raise THM ("of_class: type not of class " ^ Syntax.string_of_sort_global thy [c], 0, [])
70482
d4b5139eea34 more robust and convenient treatment of implicit context;
wenzelm
parents: 70480
diff changeset
  2030
  end |> solve_constraints;
399
86cc2b98f9e0 added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents: 387
diff changeset
  2031
79404
cb19148c0b95 tuned comments;
wenzelm
parents: 79402
diff changeset
  2032
(*Sort constraints within the logic*)
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2033
val unconstrainT =
71530
046cf49162a3 more thorough strip_shyps for proof boxes (but types are usually stripped and reconstructed later);
wenzelm
parents: 71527
diff changeset
  2034
  strip_shyps #> (fn thm as Thm (der, args) =>
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2035
    let
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2036
      val Deriv {promises, body} = der;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2037
      val {cert, shyps, hyps, tpairs, prop, ...} = args;
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2038
      val thy = theory_of_thm thm;
36883
4ed0d72def50 added Proofterm.unconstrain_thm_proof for Thm.unconstrainT -- loosely based on the version by krauss/schropp;
wenzelm
parents: 36882
diff changeset
  2039
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2040
      fun err msg = raise THM ("unconstrainT: " ^ msg, 0, [thm]);
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  2041
      val _ = null hyps orelse err "bad hyps";
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2042
      val _ = null tpairs orelse err "bad flex-flex constraints";
74235
dbaed92fd8af tuned signature;
wenzelm
parents: 74234
diff changeset
  2043
      val tfrees = build_rev (Term.add_tfree_names prop);
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2044
      val _ = null tfrees orelse err ("illegal free type variables " ^ commas_quote tfrees);
36769
b6b88bf695b3 Thm.unconstrainT based on Logic.unconstrainT -- no proofterm yet;
wenzelm
parents: 36768
diff changeset
  2045
77873
864c7c684651 backout b6aa5eac0a1a;
wenzelm
parents: 77871
diff changeset
  2046
      val ps = map (apsnd (Future.map fulfill_body)) promises;
79425
0875c87b4a4b clarified signature;
wenzelm
parents: 79418
diff changeset
  2047
      val (prop', body') = Proofterm.unconstrain_thm_proof thy (sorts_proof thy) shyps prop ps body;
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2048
    in
79262
64c655e8e8bf clarified modules;
wenzelm
parents: 79261
diff changeset
  2049
      Thm (make_deriv0 [] body',
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2050
       {cert = cert,
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2051
        tags = [],
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2052
        maxidx = maxidx_of_term prop',
77868
6ea0030b9ee9 Backed out changeset f34d11942ac1
wenzelm
parents: 77867
diff changeset
  2053
        constraints = [],
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  2054
        shyps = [[]],  (*potentially redundant*)
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  2055
        hyps = [],
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2056
        tpairs = [],
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2057
        prop = prop'})
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2058
    end);
399
86cc2b98f9e0 added class_triv: theory -> class -> thm (for axclasses);
wenzelm
parents: 387
diff changeset
  2059
63611
fb63942e470e tuned whitespace;
wenzelm
parents: 61053
diff changeset
  2060
(*Replace all TFrees not fixed or in the hyps by new TVars*)
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2061
fun varifyT_global' fixed (Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...})) =
12500
0a6667d65e9b varifyT' returns newly introduces variables;
wenzelm
parents: 11692
diff changeset
  2062
  let
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  2063
    val tfrees = fold TFrees.add_tfrees hyps fixed;
13658
c9ad3e64ddcf Changed handling of flex-flex constraints: now stored in separate
berghofe
parents: 13642
diff changeset
  2064
    val prop1 = attach_tpairs tpairs prop;
35845
e5980f0ad025 renamed varify/unvarify operations to varify_global/unvarify_global to emphasize that these only work in a global situation;
wenzelm
parents: 35408
diff changeset
  2065
    val (al, prop2) = Type.varify_global tfrees prop1;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2066
    val (ts, prop3) = Logic.strip_prems (length tpairs, [], prop2);
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2067
    fun zproof p = ZTerm.varifyT_proof al p;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2068
    fun proof p = Proofterm.varifyT_proof al p;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2069
  in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2070
    (al, Thm (deriv_rule1 zproof proof der,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
  2071
     {cert = cert,
21646
c07b5b0e8492 thm/prf: separate official name vs. additional tags;
wenzelm
parents: 21576
diff changeset
  2072
      tags = [],
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2073
      maxidx = Int.max (0, maxidx),
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2074
      constraints = constraints,
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2075
      shyps = shyps,
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2076
      hyps = hyps,
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2077
      tpairs = rev (map Logic.dest_equals ts),
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2078
      prop = prop3}))
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2079
  end;
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2080
74266
612b7e0d6721 clarified signature;
wenzelm
parents: 74244
diff changeset
  2081
val varifyT_global = #2 o varifyT_global' TFrees.empty;
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2082
63611
fb63942e470e tuned whitespace;
wenzelm
parents: 61053
diff changeset
  2083
(*Replace all TVars by TFrees that are often new*)
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2084
fun legacy_freezeT (Thm (der, {cert, constraints, shyps, hyps, tpairs, prop, ...})) =
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2085
  let
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2086
    val prop1 = attach_tpairs tpairs prop;
33832
cff42395c246 explicitly mark some legacy freeze operations;
wenzelm
parents: 33722
diff changeset
  2087
    val prop2 = Type.legacy_freeze prop1;
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2088
    val (ts, prop3) = Logic.strip_prems (length tpairs, [], prop2);
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2089
    fun zproof p = ZTerm.legacy_freezeT_proof prop1 p;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2090
    fun proof p = Proofterm.legacy_freezeT prop1 p;
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2091
  in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2092
    Thm (deriv_rule1 zproof proof der,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
  2093
     {cert = cert,
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2094
      tags = [],
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2095
      maxidx = maxidx_of_term prop2,
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2096
      constraints = constraints,
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2097
      shyps = shyps,
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2098
      hyps = hyps,
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2099
      tpairs = rev (map Logic.dest_equals ts),
18127
9f03d8a9a81b Thm.varifyT': natural argument order;
wenzelm
parents: 18035
diff changeset
  2100
      prop = prop3})
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2101
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2102
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2103
fun plain_prop_of raw_thm =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2104
  let
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2105
    val thm = strip_shyps raw_thm;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2106
    fun err msg = raise THM ("plain_prop_of: " ^ msg, 0, [thm]);
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2107
  in
77863
760515c45864 revert b43ee37926a9 due to problems with AFP/PAPP_Impossibility;
wenzelm
parents: 77827
diff changeset
  2108
    if not (null (hyps_of thm)) then
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2109
      err "theorem may not contain hypotheses"
77869
1156aa9db7f5 backout 4a174bea55e2;
wenzelm
parents: 77868
diff changeset
  2110
    else if not (null (extra_shyps thm)) then
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2111
      err "theorem may not contain sort hypotheses"
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2112
    else if not (null (tpairs_of thm)) then
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2113
      err "theorem may not contain flex-flex pairs"
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2114
    else prop_of thm
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2115
  end;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2116
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2117
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2118
(* stored thms: zproof *)
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2119
79365
b5853d438dbe more operations;
wenzelm
parents: 79364
diff changeset
  2120
val get_zproof_serials = Inttab.keys o get_zproofs;
b5853d438dbe more operations;
wenzelm
parents: 79364
diff changeset
  2121
79364
fc45f5cfb025 proper Thm.transfer;
wenzelm
parents: 79363
diff changeset
  2122
fun get_zproof thy =
79431
236d866ead4e tuned signature;
wenzelm
parents: 79430
diff changeset
  2123
  Inttab.lookup (get_zproofs thy) #> Option.map (fn {name, thm} =>
236d866ead4e tuned signature;
wenzelm
parents: 79430
diff changeset
  2124
    let
236d866ead4e tuned signature;
wenzelm
parents: 79430
diff changeset
  2125
      val thm' = transfer thy thm;
236d866ead4e tuned signature;
wenzelm
parents: 79430
diff changeset
  2126
      val PBody {zboxes, zproof, ...} = proof_body_of thm';
236d866ead4e tuned signature;
wenzelm
parents: 79430
diff changeset
  2127
    in {name = name, thm = thm', zboxes = zboxes, zproof = zproof} end);
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2128
79335
6d167422bcb0 clarified signature;
wenzelm
parents: 79332
diff changeset
  2129
fun store_zproof name thm thy =
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2130
  let
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2131
    val Thm (Deriv {promises, body = PBody body}, args as {hyps, prop, ...}) = thm;
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2132
    val {oracles, thms, zboxes, zproof, proof} = body;
79362
2187de552bd4 clarified stored data: actual thm allows to replay zproofs in a modular manner;
wenzelm
parents: 79335
diff changeset
  2133
    fun deriv a b = make_deriv promises oracles thms a b proof;
2187de552bd4 clarified stored data: actual thm allows to replay zproofs in a modular manner;
wenzelm
parents: 79335
diff changeset
  2134
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2135
    val _ = null promises orelse
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2136
      raise THM ("store_zproof: theorem may not use promises", 0, [thm]);
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2137
79362
2187de552bd4 clarified stored data: actual thm allows to replay zproofs in a modular manner;
wenzelm
parents: 79335
diff changeset
  2138
    val ((i, (_, zproof1)), zproof2) = ZTerm.thm_proof thy name hyps prop zproof;
80560
960b866b1117 tuned signature;
wenzelm
parents: 80295
diff changeset
  2139
    val der1 = if Options.default_bool "prune_proofs" then deriv [] ZNop else deriv zboxes zproof1;
79362
2187de552bd4 clarified stored data: actual thm allows to replay zproofs in a modular manner;
wenzelm
parents: 79335
diff changeset
  2140
    val der2 = deriv [] zproof2;
79363
2c6f355e52bb proper Thm.trim_context;
wenzelm
parents: 79362
diff changeset
  2141
2c6f355e52bb proper Thm.trim_context;
wenzelm
parents: 79362
diff changeset
  2142
    val thm' = trim_context (Thm (der1, args));
2c6f355e52bb proper Thm.trim_context;
wenzelm
parents: 79362
diff changeset
  2143
    val thy' = thy |> (map_zproofs o Inttab.update) (i, {name = name, thm = thm'});
79362
2187de552bd4 clarified stored data: actual thm allows to replay zproofs in a modular manner;
wenzelm
parents: 79335
diff changeset
  2144
  in (Thm (der2, args), thy') end;
79313
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2145
3b03af5125de use strict Global_Theory.register_proofs as checkpoint for stored zproof, and thus reduce current zboxes;
wenzelm
parents: 79310
diff changeset
  2146
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2147
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2148
(*** Inference rules for tactics ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2149
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2150
(*Destruct proof state into constraints, other goals, goal(i), rest *)
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2151
fun dest_state (state as Thm (_, {prop,tpairs,...}), i) =
13658
c9ad3e64ddcf Changed handling of flex-flex constraints: now stored in separate
berghofe
parents: 13642
diff changeset
  2152
  (case  Logic.strip_prems(i, [], prop) of
c9ad3e64ddcf Changed handling of flex-flex constraints: now stored in separate
berghofe
parents: 13642
diff changeset
  2153
      (B::rBs, C) => (tpairs, rev rBs, B, C)
c9ad3e64ddcf Changed handling of flex-flex constraints: now stored in separate
berghofe
parents: 13642
diff changeset
  2154
    | _ => raise THM("dest_state", i, [state]))
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2155
  handle TERM _ => raise THM("dest_state", i, [state]);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2156
46255
6fae74ee591a removed obscure/outdated material;
wenzelm
parents: 46218
diff changeset
  2157
(*Prepare orule for resolution by lifting it over the parameters and
52487
48bc24467008 backout dedd7952a62c: static "proofs" value within theory prevents later inferencing with different configuration;
wenzelm
parents: 52470
diff changeset
  2158
assumptions of goal.*)
18035
eaae44affc9e added cgoal_of;
wenzelm
parents: 17868
diff changeset
  2159
fun lift_rule goal orule =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2160
  let
18035
eaae44affc9e added cgoal_of;
wenzelm
parents: 17868
diff changeset
  2161
    val Cterm {t = gprop, T, maxidx = gmax, sorts, ...} = goal;
eaae44affc9e added cgoal_of;
wenzelm
parents: 17868
diff changeset
  2162
    val inc = gmax + 1;
eaae44affc9e added cgoal_of;
wenzelm
parents: 17868
diff changeset
  2163
    val lift_abs = Logic.lift_abs inc gprop;
eaae44affc9e added cgoal_of;
wenzelm
parents: 17868
diff changeset
  2164
    val lift_all = Logic.lift_all inc gprop;
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2165
    val Thm (der, {maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = orule;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2166
    val (As, B) = Logic.strip_horn prop;
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2167
  in
18035
eaae44affc9e added cgoal_of;
wenzelm
parents: 17868
diff changeset
  2168
    if T <> propT then raise THM ("lift_rule: the term must have type prop", 0, [])
eaae44affc9e added cgoal_of;
wenzelm
parents: 17868
diff changeset
  2169
    else
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2170
      let
79237
f97fe7ad62a7 proper ZTerm.lift_proof (amending 4a1a25bdf81d);
wenzelm
parents: 79232
diff changeset
  2171
        val cert = join_certificate1 (goal, orule);
79227
a8db9ee24d5e clarified signature;
wenzelm
parents: 79224
diff changeset
  2172
        val prems = map lift_all As;
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2173
        fun zproof p =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2174
          let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2175
            val thy = Context.certificate_theory cert
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2176
              handle ERROR msg => raise CONTEXT (msg, [], [goal], [orule], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2177
          in ZTerm.lift_proof thy gprop inc prems p end;
79227
a8db9ee24d5e clarified signature;
wenzelm
parents: 79224
diff changeset
  2178
        fun proof p = Proofterm.lift_proof gprop inc prems p;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2179
      in
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2180
        Thm (deriv_rule1 zproof proof der,
79237
f97fe7ad62a7 proper ZTerm.lift_proof (amending 4a1a25bdf81d);
wenzelm
parents: 79232
diff changeset
  2181
         {cert = cert,
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2182
          tags = [],
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2183
          maxidx = maxidx + inc,
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2184
          constraints = constraints,
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2185
          shyps = Sorts.union shyps sorts,  (*sic!*)
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2186
          hyps = hyps,
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2187
          tpairs = map (apply2 lift_abs) tpairs,
79227
a8db9ee24d5e clarified signature;
wenzelm
parents: 79224
diff changeset
  2188
          prop = Logic.list_implies (prems, lift_all B)})
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2189
      end
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2190
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2191
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2192
fun incr_indexes i (thm as Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...})) =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2193
  if i < 0 then raise THM ("negative increment", 0, [thm])
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2194
  else if i = 0 then thm
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2195
  else
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2196
    let
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2197
      fun zproof p = ZTerm.incr_indexes_proof i p;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2198
      fun proof p = Proofterm.incr_indexes i p;
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2199
    in
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2200
      Thm (deriv_rule1 zproof proof der,
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2201
       {cert = cert,
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2202
        tags = [],
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2203
        maxidx = maxidx + i,
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2204
        constraints = constraints,
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2205
        shyps = shyps,
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2206
        hyps = hyps,
79232
99bc2dd45111 more general Logic.incr_indexes_operation;
wenzelm
parents: 79227
diff changeset
  2207
        tpairs = map (apply2 (Logic.incr_indexes ([], i))) tpairs,
99bc2dd45111 more general Logic.incr_indexes_operation;
wenzelm
parents: 79227
diff changeset
  2208
        prop = Logic.incr_indexes ([], i) prop})
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2209
    end;
10416
5b33e732e459 - Moved rewriting functions to meta_simplifier.ML
berghofe
parents: 10348
diff changeset
  2210
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2211
(*Solve subgoal Bi of proof state B1...Bn/C by assumption. *)
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2212
fun assumption opt_ctxt i state =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2213
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2214
    val Thm (der, {cert, maxidx, constraints, shyps, hyps, ...}) = state;
64981
ea6199b23dfa proper background certificate from make_context, which can be a super-theory of the direct join (amending d07464875dd4);
wenzelm
parents: 64574
diff changeset
  2215
    val (context, cert') = make_context_certificate [state] opt_ctxt cert;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2216
    val (tpairs, Bs, Bi, C) = dest_state (state, i);
32032
a6a6e8031c14 tuned/modernized Envir operations;
wenzelm
parents: 32027
diff changeset
  2217
    fun newth n (env, tpairs) =
70822
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2218
      let
78033
9c18535a9fcd proper exception CONTEXT for Context.certificate_theory;
wenzelm
parents: 77966
diff changeset
  2219
        val thy' = Context.certificate_theory cert' handle ERROR msg =>
9c18535a9fcd proper exception CONTEXT for Context.certificate_theory;
wenzelm
parents: 77966
diff changeset
  2220
          raise CONTEXT (msg, [], [], [state], Option.map Context.Proof opt_ctxt);
79209
wenzelm
parents: 79207
diff changeset
  2221
        val normt = Envir.norm_term env;
79270
90c5aadcc4b2 more robust norm_proof: turn env into instantiation, based on visible statement;
wenzelm
parents: 79263
diff changeset
  2222
        fun zproof p = ZTerm.assumption_proof thy' env Bs Bi n [full_prop_of state] p;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2223
        fun proof p =
79209
wenzelm
parents: 79207
diff changeset
  2224
          Proofterm.assumption_proof (map normt Bs) (normt Bi) n p
wenzelm
parents: 79207
diff changeset
  2225
          |> not (Envir.is_empty env) ? Proofterm.norm_proof_remove_types env;
70822
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2226
      in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2227
        Thm (deriv_rule1 zproof proof der,
70822
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2228
         {tags = [],
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2229
          maxidx = Envir.maxidx_of env,
78033
9c18535a9fcd proper exception CONTEXT for Context.certificate_theory;
wenzelm
parents: 77966
diff changeset
  2230
          constraints = insert_constraints_env thy' env constraints,
70822
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2231
          shyps = Envir.insert_sorts env shyps,
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2232
          hyps = hyps,
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2233
          tpairs = if Envir.is_empty env then tpairs else map (apply2 normt) tpairs,
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2234
          prop =
79209
wenzelm
parents: 79207
diff changeset
  2235
            if Envir.is_empty env
wenzelm
parents: 79207
diff changeset
  2236
            then Logic.list_implies (Bs, C) (*avoid wasted normalizations*)
70822
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2237
            else normt (Logic.list_implies (Bs, C)) (*normalize the new rule fully*),
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2238
          cert = cert'})
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2239
      end;
30554
73f8bd5f0af8 substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents: 30466
diff changeset
  2240
30556
7be15917f3fa eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents: 30554
diff changeset
  2241
    val (close, asms, concl) = Logic.assum_problems (~1, Bi);
7be15917f3fa eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents: 30554
diff changeset
  2242
    val concl' = close concl;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2243
    fun addprfs [] _ = Seq.empty
30556
7be15917f3fa eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents: 30554
diff changeset
  2244
      | addprfs (asm :: rest) n = Seq.make (fn () => Seq.pull
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2245
          (Seq.mapp (newth n)
30556
7be15917f3fa eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents: 30554
diff changeset
  2246
            (if Term.could_unify (asm, concl) then
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2247
              (Unify.unifiers (context, Envir.empty maxidx, (close asm, concl') :: tpairs))
30554
73f8bd5f0af8 substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents: 30466
diff changeset
  2248
             else Seq.empty)
73f8bd5f0af8 substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents: 30466
diff changeset
  2249
            (addprfs rest (n + 1))))
30556
7be15917f3fa eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents: 30554
diff changeset
  2250
  in addprfs asms 1 end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2251
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2252
(*Solve subgoal Bi of proof state B1...Bn/C by assumption.
51604
f83661733143 updated comment to 46b90bbc370d;
wenzelm
parents: 50301
diff changeset
  2253
  Checks if Bi's conclusion is alpha/eta-convertible to one of its assumptions*)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2254
fun eq_assumption i state =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2255
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2256
    val Thm (der, {cert, maxidx, constraints, shyps, hyps, ...}) = state;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2257
    val (tpairs, Bs, Bi, C) = dest_state (state, i);
30556
7be15917f3fa eq_assumption: slightly more efficient by checking (open) result of Logic.assum_problems directly;
wenzelm
parents: 30554
diff changeset
  2258
    val (_, asms, concl) = Logic.assum_problems (~1, Bi);
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2259
  in
52131
366fa32ee2a3 tuned signature;
wenzelm
parents: 51604
diff changeset
  2260
    (case find_index (fn asm => Envir.aeconv (asm, concl)) asms of
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2261
      ~1 => raise THM ("eq_assumption", 0, [state])
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2262
    | n =>
79211
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2263
        let
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2264
          fun zproof p =
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2265
            let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2266
              val thy = Context.certificate_theory cert
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2267
                handle ERROR msg => raise CONTEXT (msg, [], [], [state], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2268
            in ZTerm.assumption_proof thy Envir.init Bs Bi (n + 1) [] p end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2269
          fun proof p = Proofterm.assumption_proof Bs Bi (n + 1) p;
79211
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2270
        in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2271
          Thm (deriv_rule1 zproof proof der,
79211
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2272
           {cert = cert,
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2273
            tags = [],
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2274
            maxidx = maxidx,
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2275
            constraints = constraints,
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2276
            shyps = shyps,
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2277
            hyps = hyps,
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2278
            tpairs = tpairs,
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2279
            prop = Logic.list_implies (Bs, C)})
35ead2206eb1 more zproofs;
wenzelm
parents: 79209
diff changeset
  2280
        end)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2281
  end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2282
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2283
2671
510d94c71dda Introduction of rotate_rule
paulson
parents: 2626
diff changeset
  2284
(*For rotate_tac: fast rotation of assumptions of subgoal i*)
510d94c71dda Introduction of rotate_rule
paulson
parents: 2626
diff changeset
  2285
fun rotate_rule k i state =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2286
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2287
    val Thm (der, {cert, maxidx, constraints, shyps, hyps, ...}) = state;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2288
    val (tpairs, Bs, Bi, C) = dest_state (state, i);
46218
ecf6375e2abb renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents: 46217
diff changeset
  2289
    val params = Term.strip_all_vars Bi;
ecf6375e2abb renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents: 46217
diff changeset
  2290
    val rest = Term.strip_all_body Bi;
ecf6375e2abb renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents: 46217
diff changeset
  2291
    val asms = Logic.strip_imp_prems rest
ecf6375e2abb renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents: 46217
diff changeset
  2292
    val concl = Logic.strip_imp_concl rest;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2293
    val n = length asms;
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2294
    val m = if k < 0 then n + k else k;
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2295
    val Bi' =
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2296
      if 0 = m orelse m = n then Bi
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2297
      else if 0 < m andalso m < n then
19012
wenzelm
parents: 18969
diff changeset
  2298
        let val (ps, qs) = chop m asms
46218
ecf6375e2abb renamed Term.list_all to Logic.list_all, in accordance to HOLogic.list_all;
wenzelm
parents: 46217
diff changeset
  2299
        in Logic.list_all (params, Logic.list_implies (qs @ ps, concl)) end
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2300
      else raise THM ("rotate_rule", k, [state]);
79155
53288743c2f0 more zproofs;
wenzelm
parents: 79152
diff changeset
  2301
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2302
    fun zproof p =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2303
      let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2304
        val thy = Context.certificate_theory cert
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2305
          handle ERROR msg => raise CONTEXT (msg, [], [], [state], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2306
      in ZTerm.rotate_proof thy Bs Bi' params asms m p end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2307
    fun proof p = Proofterm.rotate_proof Bs Bi' params asms m p;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2308
  in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2309
    Thm (deriv_rule1 zproof proof der,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
  2310
     {cert = cert,
21646
c07b5b0e8492 thm/prf: separate official name vs. additional tags;
wenzelm
parents: 21576
diff changeset
  2311
      tags = [],
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2312
      maxidx = maxidx,
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2313
      constraints = constraints,
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2314
      shyps = shyps,
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2315
      hyps = hyps,
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2316
      tpairs = tpairs,
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2317
      prop = Logic.list_implies (Bs @ [Bi'], C)})
2671
510d94c71dda Introduction of rotate_rule
paulson
parents: 2626
diff changeset
  2318
  end;
510d94c71dda Introduction of rotate_rule
paulson
parents: 2626
diff changeset
  2319
510d94c71dda Introduction of rotate_rule
paulson
parents: 2626
diff changeset
  2320
7248
322151fe6f02 new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents: 7070
diff changeset
  2321
(*Rotates a rule's premises to the left by k, leaving the first j premises
322151fe6f02 new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents: 7070
diff changeset
  2322
  unchanged.  Does nothing if k=0 or if k equals n-j, where n is the
58837
e84d900cd287 eliminated aliases;
wenzelm
parents: 56245
diff changeset
  2323
  number of premises.  Useful with eresolve_tac and underlies defer_tac*)
7248
322151fe6f02 new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents: 7070
diff changeset
  2324
fun permute_prems j k rl =
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2325
  let
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2326
    val Thm (der, {cert, maxidx, constraints, shyps, hyps, tpairs, prop, ...}) = rl;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2327
    val prems = Logic.strip_imp_prems prop
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2328
    and concl = Logic.strip_imp_concl prop;
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2329
    val moved_prems = List.drop (prems, j)
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2330
    and fixed_prems = List.take (prems, j)
43278
1fbdcebb364b more robust exception pattern General.Subscript;
wenzelm
parents: 42425
diff changeset
  2331
      handle General.Subscript => raise THM ("permute_prems: j", j, [rl]);
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2332
    val n_j = length moved_prems;
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2333
    val m = if k < 0 then n_j + k else k;
70822
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2334
    val (prems', prop') =
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2335
      if 0 = m orelse m = n_j then (prems, prop)
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2336
      else if 0 < m andalso m < n_j then
70822
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2337
        let
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2338
          val (ps, qs) = chop m moved_prems;
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2339
          val prems' = fixed_prems @ qs @ ps;
22e2f5acc0b4 more accurate treatment of propositions within proof terms, but these are ultimately ignored for performance reasons;
wenzelm
parents: 70814
diff changeset
  2340
        in (prems', Logic.list_implies (prems', concl)) end
16725
597830f91930 added full_prop_of: includes tpairs;
wenzelm
parents: 16711
diff changeset
  2341
      else raise THM ("permute_prems: k", k, [rl]);
79155
53288743c2f0 more zproofs;
wenzelm
parents: 79152
diff changeset
  2342
79321
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2343
    fun zproof p =
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2344
      let
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2345
        val thy = Context.certificate_theory cert
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2346
          handle ERROR msg => raise CONTEXT (msg, [], [], [rl], NONE);
dbfe6d1fdfb6 more informative exceptions;
wenzelm
parents: 79313
diff changeset
  2347
      in ZTerm.permute_prems_proof thy prems' j m p end;
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2348
    fun proof p = Proofterm.permute_prems_proof prems' j m p;
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2349
  in
79221
582dfbe9980e clarified signature: fewer tuples;
wenzelm
parents: 79220
diff changeset
  2350
    Thm (deriv_rule1 zproof proof der,
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
  2351
     {cert = cert,
21646
c07b5b0e8492 thm/prf: separate official name vs. additional tags;
wenzelm
parents: 21576
diff changeset
  2352
      tags = [],
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2353
      maxidx = maxidx,
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2354
      constraints = constraints,
16601
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2355
      shyps = shyps,
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2356
      hyps = hyps,
ee8eefade568 more efficient treatment of shyps and hyps (use ordered lists);
wenzelm
parents: 16425
diff changeset
  2357
      tpairs = tpairs,
28321
9f4499bf9384 type thm: fully internal derivation, no longer exported;
wenzelm
parents: 28290
diff changeset
  2358
      prop = prop'})
7248
322151fe6f02 new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents: 7070
diff changeset
  2359
  end;
322151fe6f02 new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents: 7070
diff changeset
  2360
322151fe6f02 new primitive rule permute_prems to underlie defer_tac and rotate_prems
paulson
parents: 7070
diff changeset
  2361
44108
476a239d3e0e rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents: 43795
diff changeset
  2362
(* strip_apply f B A strips off all assumptions/parameters from A
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2363
   introduced by lifting over B, and applies f to remaining part of A*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2364
fun strip_apply f =
79258
479f31c4b367 tuned whitespace;
wenzelm
parents: 79257
diff changeset
  2365
  let
479f31c4b367 tuned whitespace;
wenzelm
parents: 79257
diff changeset
  2366
    fun strip ((c as Const ("Pure.imp", _)) $ _  $ B1)
479f31c4b367 tuned whitespace;
wenzelm
parents: 79257
diff changeset
  2367
                    (Const ("Pure.imp", _) $ A2 $ B2) = c $ A2 $ strip B1 B2
479f31c4b367 tuned whitespace;
wenzelm
parents: 79257
diff changeset
  2368
      | strip ((c as Const ("Pure.all", _)) $ Abs (_, _, t1))
479f31c4b367 tuned whitespace;
wenzelm
parents: 79257
diff changeset
  2369
                    (Const ("Pure.all", _) $ Abs (a, T, t2)) = c $ Abs (a, T, strip t1 t2)
479f31c4b367 tuned whitespace;
wenzelm
parents: 79257
diff changeset
  2370
      | strip _ A = f A
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2371
  in strip end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2372
56245
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2373
fun strip_lifted (Const ("Pure.imp", _) $ _ $ B1)
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2374
                 (Const ("Pure.imp", _) $ _ $ B2) = strip_lifted B1 B2
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2375
  | strip_lifted (Const ("Pure.all", _) $ Abs (_, _, t1))
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2376
                 (Const ("Pure.all", _) $ Abs (_, _, t2)) = strip_lifted t1 t2
44108
476a239d3e0e rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents: 43795
diff changeset
  2377
  | strip_lifted _ A = A;
476a239d3e0e rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents: 43795
diff changeset
  2378
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2379
(*Use the alist to rename all bound variables and some unknowns in a term
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2380
  dpairs = current disagreement pairs;  tpairs = permanent ones (flexflex);
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2381
  Preserves unknowns in tpairs and on lhs of dpairs. *)
79247
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2382
fun rename_bvs dpairs tpairs B As =
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2383
  let val al = fold_rev Term.match_bvars dpairs [] in
79254
54dc0b820834 minor performance tuning;
wenzelm
parents: 79253
diff changeset
  2384
    if null al then {vars = Symtab.empty, bounds = Symtab.empty}
79247
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2385
    else
20330
wenzelm
parents: 20289
diff changeset
  2386
      let
79246
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2387
        val add_var = fold_aterms (fn Var ((x, _), _) => Symset.insert x | _ => I);
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2388
        val unknowns =
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2389
          Symset.build
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2390
           (fold (add_var o fst) dpairs #>
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2391
            fold (fn (t, u) => add_var t #> add_var u) tpairs);
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2392
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2393
        (*unknowns appearing elsewhere be preserved!*)
79246
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2394
        val unknowns' = Symset.build (fold (add_var o strip_lifted B) As);
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2395
        val al' = al
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2396
          |> filter_out (fn (x, y) =>
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2397
             not (Symset.member unknowns' x) orelse
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2398
             Symset.member unknowns x orelse Symset.member unknowns y)
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2399
          |> distinct (eq_fst (op =));
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2400
        val unchanged = Symset.restrict (not o AList.defined (op =) al') unknowns';
79247
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2401
79256
4a97f2daf2c0 tuned comments (see also 476a239d3e0e and possibly 4b62e0cb3aa8);
wenzelm
parents: 79254
diff changeset
  2402
        (*avoid introducing name clashes between schematic variables*)
44108
476a239d3e0e rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents: 43795
diff changeset
  2403
        fun del_clashing clash xs _ [] qs =
476a239d3e0e rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents: 43795
diff changeset
  2404
              if clash then del_clashing false xs xs qs [] else qs
476a239d3e0e rename_bvs now avoids introducing name clashes between schematic variables
berghofe
parents: 43795
diff changeset
  2405
          | del_clashing clash xs ys ((p as (x, y)) :: ps) qs =
79246
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2406
              if Symset.member ys y
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2407
              then del_clashing true (Symset.insert x xs) (Symset.insert x ys) ps qs
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2408
              else del_clashing clash xs (Symset.insert y ys) ps (p :: qs);
46497
89ccf66aa73d renamed Thm.capply to Thm.apply, and Thm.cabs to Thm.lambda in conformance with similar operations in structure Term and Logic;
wenzelm
parents: 46475
diff changeset
  2409
        val al'' = del_clashing false unchanged unchanged al' [];
79246
a551cf8eca09 minor performance tuning: prefer Symset.T;
wenzelm
parents: 79241
diff changeset
  2410
79254
54dc0b820834 minor performance tuning;
wenzelm
parents: 79253
diff changeset
  2411
      in {vars = Symtab.make_distinct al'', bounds = Symtab.make_distinct al} end
79247
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2412
  end;
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2413
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2414
(*Function to rename bounds/unknowns in the argument, lifted over B*)
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2415
fun rename_bvars dpairs tpairs B As =
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2416
  let val {vars, bounds} = rename_bvs dpairs tpairs B As in
79254
54dc0b820834 minor performance tuning;
wenzelm
parents: 79253
diff changeset
  2417
    if Symtab.forall (op =) vars andalso Symtab.forall (op =) bounds then NONE
79247
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2418
    else
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2419
      let
79252
f1415f78f7a0 minor performance tuning: prefer Same.operation;
wenzelm
parents: 79251
diff changeset
  2420
        fun term (Var ((x, i), T)) =
79254
54dc0b820834 minor performance tuning;
wenzelm
parents: 79253
diff changeset
  2421
              let val y = perhaps (Symtab.lookup vars) x
79252
f1415f78f7a0 minor performance tuning: prefer Same.operation;
wenzelm
parents: 79251
diff changeset
  2422
              in if x = y then raise Same.SAME else Var ((y, i), T) end
f1415f78f7a0 minor performance tuning: prefer Same.operation;
wenzelm
parents: 79251
diff changeset
  2423
          | term (Abs (x, T, t)) =
79254
54dc0b820834 minor performance tuning;
wenzelm
parents: 79253
diff changeset
  2424
              let val y = perhaps (Symtab.lookup bounds) x
79252
f1415f78f7a0 minor performance tuning: prefer Same.operation;
wenzelm
parents: 79251
diff changeset
  2425
              in if x = y then Abs (x, T, term t) else Abs (y, T, Same.commit term t) end
f1415f78f7a0 minor performance tuning: prefer Same.operation;
wenzelm
parents: 79251
diff changeset
  2426
          | term (t $ u) = (term t $ Same.commit term u handle Same.SAME => t $ term u)
f1415f78f7a0 minor performance tuning: prefer Same.operation;
wenzelm
parents: 79251
diff changeset
  2427
          | term _ = raise Same.SAME;
79310
dc6b58da806e omit unclear / inaccurate renaming;
wenzelm
parents: 79309
diff changeset
  2428
      in SOME term end
79247
dc1681739247 misc tuning and clarification;
wenzelm
parents: 79246
diff changeset
  2429
  end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2430
70459
f0a445c5a82c maintain sort constraints from type instantiations, with pro-forma derivation to collect oracles/thms;
wenzelm
parents: 70458
diff changeset
  2431
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2432
(*** RESOLUTION ***)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2433
721
479832ff2d29 Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents: 678
diff changeset
  2434
(** Lifting optimizations **)
479832ff2d29 Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents: 678
diff changeset
  2435
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2436
(*strip off pairs of assumptions/parameters in parallel -- they are
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2437
  identical because of lifting*)
56245
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2438
fun strip_assums2 (Const("Pure.imp", _) $ _ $ B1,
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2439
                   Const("Pure.imp", _) $ _ $ B2) = strip_assums2 (B1,B2)
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2440
  | strip_assums2 (Const("Pure.all",_)$Abs(a,T,t1),
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2441
                   Const("Pure.all",_)$Abs(_,_,t2)) =
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2442
      let val (B1,B2) = strip_assums2 (t1,t2)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2443
      in  (Abs(a,T,B1), Abs(a,T,B2))  end
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2444
  | strip_assums2 BB = BB;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2445
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2446
721
479832ff2d29 Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents: 678
diff changeset
  2447
(*Faster normalization: skip assumptions that were lifted over*)
479832ff2d29 Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents: 678
diff changeset
  2448
fun norm_term_skip env 0 t = Envir.norm_term env t
56245
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2449
  | norm_term_skip env n (Const ("Pure.all", _) $ Abs (a, T, t)) =
32032
a6a6e8031c14 tuned/modernized Envir operations;
wenzelm
parents: 32027
diff changeset
  2450
      let
58946
3bf80312508e proper Envir.norm_type for result of Unify.unifiers (amending 479832ff2d29 from 20 years ago);
wenzelm
parents: 58837
diff changeset
  2451
        val T' = Envir.norm_type (Envir.type_env env) T
32032
a6a6e8031c14 tuned/modernized Envir operations;
wenzelm
parents: 32027
diff changeset
  2452
        (*Must instantiate types of parameters because they are flattened;
a6a6e8031c14 tuned/modernized Envir operations;
wenzelm
parents: 32027
diff changeset
  2453
          this could be a NEW parameter*)
46217
7b19666f0e3d renamed Term.all to Logic.all_const, in accordance to HOLogic.all_const;
wenzelm
parents: 45443
diff changeset
  2454
      in Logic.all_const T' $ Abs (a, T', norm_term_skip env n t) end
56245
84fc7dfa3cd4 more qualified names;
wenzelm
parents: 56052
diff changeset
  2455
  | norm_term_skip env n (Const ("Pure.imp", _) $ A $ B) =
32032
a6a6e8031c14 tuned/modernized Envir operations;
wenzelm
parents: 32027
diff changeset
  2456
      Logic.mk_implies (A, norm_term_skip env (n - 1) B)
32784
1a5dde5079ac eliminated redundant bindings;
wenzelm
parents: 32726
diff changeset
  2457
  | norm_term_skip _ _ _ = error "norm_term_skip: too few assumptions??";
721
479832ff2d29 Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents: 678
diff changeset
  2458
479832ff2d29 Pure/thm/norm_term_skip: new, for skipping normalization of the context
lcp
parents: 678
diff changeset
  2459
52222
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2460
(*unify types of schematic variables (non-lifted case)*)
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2461
fun unify_var_types context (th1, th2) env =
52222
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2462
  let
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2463
    fun unify_vars (T :: Us) = fold (fn U => Pattern.unify_types context (T, U)) Us
52222
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2464
      | unify_vars _ = I;
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2465
    val add_vars =
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2466
      full_prop_of #>
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2467
      fold_aterms (fn Var v => Vartab.insert_list (op =) v | _ => I);
74232
1091880266e5 clarified signature;
wenzelm
parents: 74220
diff changeset
  2468
    val vars = Vartab.build (add_vars th1 #> add_vars th2);
52222
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2469
  in SOME (Vartab.fold (unify_vars o #2) vars env) end
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2470
  handle Pattern.Unif => NONE;
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2471
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2472
(*Composition of object rule r=(A1...Am/B) with proof state s=(B1...Bn/C)
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2473
  Unifies B with Bi, replacing subgoal i    (1 <= i <= n)
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2474
  If match then forbid instantiations in proof state
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2475
  If lifted then shorten the dpair using strip_assums2.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2476
  If eres_flg then simultaneously proves A1 by assumption.
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2477
  nsubgoal is the number of new subgoals (written m above).
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2478
  Curried so that resolution calls dest_state only once.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2479
*)
79239
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2480
local exception COMPOSE in
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2481
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2482
fun bicompose_aux opt_ctxt {flatten, match, incremented} (state, (stpairs, Bs, Bi, C), lifted)
79239
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2483
    (eres_flg, orule, nsubgoal) =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2484
  let
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2485
    val Thm (sder, {maxidx=smax, constraints = constraints2, shyps = shyps2, hyps = hyps2, ...}) = state
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2486
    and Thm (rder, {maxidx=rmax, constraints = constraints1, shyps = shyps1, hyps = hyps1,
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2487
              tpairs = rtpairs, prop = rprop, ...}) = orule
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2488
    (*How many hyps to skip over during normalization*)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2489
    and nlift = Logic.count_prems (strip_all_body Bi) + (if eres_flg then ~1 else 0);
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2490
    val (context, cert) =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2491
      make_context_certificate [state, orule] opt_ctxt (join_certificate2 (state, orule));
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2492
    (*Add new theorem with prop = "\<lbrakk>Bs; As\<rbrakk> \<Longrightarrow> C" to thq*)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2493
    fun addth A (As, oldAs, rder', n) ((env, tpairs), thq) =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2494
      let
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2495
        val normt = Envir.norm_term env;
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2496
        (*perform minimal copying here by examining env*)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2497
        val (ntpairs, normp) =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2498
          if Envir.is_empty env then (tpairs, (Bs @ As, C))
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2499
          else
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2500
            let val ntps = map (apply2 normt) tpairs in
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2501
              if Envir.above env smax then
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2502
                (*no assignments in state; normalize the rule only*)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2503
                if lifted
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2504
                then (ntps, (Bs @ map (norm_term_skip env nlift) As, C))
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2505
                else (ntps, (Bs @ map normt As, C))
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2506
              else if match then raise COMPOSE
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2507
              else (*normalize the new rule fully*)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2508
                (ntps, (map normt (Bs @ As), normt C))
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2509
            end;
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2510
        val thy' = Context.certificate_theory cert handle ERROR msg =>
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2511
          raise CONTEXT (msg, [], [], [state, orule], Option.map Context.Proof opt_ctxt);
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2512
        val constraints' =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2513
          union_constraints constraints1 constraints2
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2514
          |> insert_constraints_env thy' env;
79261
2e6fcc331f10 more zproofs;
wenzelm
parents: 79260
diff changeset
  2515
        fun zproof p q =
79270
90c5aadcc4b2 more robust norm_proof: turn env into instantiation, based on visible statement;
wenzelm
parents: 79263
diff changeset
  2516
          ZTerm.bicompose_proof thy' env smax flatten Bs As A oldAs n (nlift + 1)
90c5aadcc4b2 more robust norm_proof: turn env into instantiation, based on visible statement;
wenzelm
parents: 79263
diff changeset
  2517
            [full_prop_of state, full_prop_of orule] p q;
79241
a49bdb686545 clarified modules;
wenzelm
parents: 79240
diff changeset
  2518
        fun proof p q =
a49bdb686545 clarified modules;
wenzelm
parents: 79240
diff changeset
  2519
          Proofterm.bicompose_proof env smax flatten Bs As A oldAs n (nlift + 1) p q;
79239
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2520
        val th =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2521
          Thm (deriv_rule2 zproof proof rder' sder,
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2522
           {tags = [],
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2523
            maxidx = Envir.maxidx_of env,
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2524
            constraints = constraints',
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2525
            shyps = Envir.insert_sorts env (Sorts.union shyps1 shyps2),
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2526
            hyps = union_hyps hyps1 hyps2,
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2527
            tpairs = ntpairs,
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2528
            prop = Logic.list_implies normp,
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2529
            cert = cert})
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2530
      in Seq.cons th thq end handle COMPOSE => thq;
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2531
    val (rAs, B) = Logic.strip_prems (nsubgoal, [], rprop)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2532
       handle TERM _ => raise THM("bicompose: rule", 0, [orule, state]);
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2533
    (*Modify assumptions, deleting n-th if n>0 for e-resolution*)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2534
    fun newAs (As0, n, dpairs, tpairs) =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2535
      let val (As1, rder') =
79253
wenzelm
parents: 79252
diff changeset
  2536
        if lifted then
79251
a32428d81fe5 clarified signature;
wenzelm
parents: 79247
diff changeset
  2537
          (case rename_bvars dpairs tpairs B As0 of
79310
dc6b58da806e omit unclear / inaccurate renaming;
wenzelm
parents: 79309
diff changeset
  2538
            SOME term =>
dc6b58da806e omit unclear / inaccurate renaming;
wenzelm
parents: 79309
diff changeset
  2539
              let fun proof p = Same.commit (Proofterm.map_proof_terms_same term I) p;
dc6b58da806e omit unclear / inaccurate renaming;
wenzelm
parents: 79309
diff changeset
  2540
              in (map (strip_apply (Same.commit term) B) As0, deriv_rule1 I proof rder) end
79253
wenzelm
parents: 79252
diff changeset
  2541
          | NONE => (As0, rder))
wenzelm
parents: 79252
diff changeset
  2542
        else (As0, rder);
79239
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2543
      in
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2544
        (if flatten then map (Logic.flatten_params n) As1 else As1, As1, rder', n)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2545
          handle TERM _ => raise THM("bicompose: 1st premise", 0, [orule])
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2546
      end;
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2547
    val BBi = if lifted then strip_assums2 (B, Bi) else (B, Bi);
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2548
    val dpairs = BBi :: (rtpairs @ stpairs);
30554
73f8bd5f0af8 substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents: 30466
diff changeset
  2549
79239
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2550
    (*elim-resolution: try each assumption in turn*)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2551
    fun eres _ [] = raise THM ("bicompose: no premises", 0, [orule, state])
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2552
      | eres env (A1 :: As) =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2553
          let
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2554
            val A = SOME A1;
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2555
            val (close, asms, concl) = Logic.assum_problems (nlift + 1, A1);
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2556
            val concl' = close concl;
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2557
            fun tryasms [] _ = Seq.empty
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2558
              | tryasms (asm :: rest) n =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2559
                  if Term.could_unify (asm, concl) then
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2560
                    let val asm' = close asm in
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2561
                      (case Seq.pull (Unify.unifiers (context, env, (asm', concl') :: dpairs)) of
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2562
                        NONE => tryasms rest (n + 1)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2563
                      | cell as SOME ((_, tpairs), _) =>
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2564
                          Seq.it_right (addth A (newAs (As, n, [BBi, (concl', asm')], tpairs)))
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2565
                            (Seq.make (fn () => cell),
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2566
                             Seq.make (fn () => Seq.pull (tryasms rest (n + 1)))))
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2567
                    end
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2568
                  else tryasms rest (n + 1);
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2569
          in tryasms asms 1 end;
30554
73f8bd5f0af8 substantial speedup of assumption and elim-resolution: Logic.assum_problems refrains from eager application of parameters, discriminate via Term.could_unify before invoking full unification (assumes terms in beta-normal form, as do higher term net operations anyway);
wenzelm
parents: 30466
diff changeset
  2570
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2571
     (*ordinary resolution*)
79239
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2572
    fun res env =
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2573
      (case Seq.pull (Unify.unifiers (context, env, dpairs)) of
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2574
        NONE => Seq.empty
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2575
      | cell as SOME ((_, tpairs), _) =>
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2576
          Seq.it_right (addth NONE (newAs (rev rAs, 0, [BBi], tpairs)))
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2577
            (Seq.make (fn () => cell), Seq.empty));
52222
0fa3b456a267 unify types of schematic variables in non-lifted case (i.e. "compose variants") -- allow schematic polymorphism, without revisiting HO-unification;
wenzelm
parents: 52131
diff changeset
  2578
79239
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2579
    val env0 = Envir.empty (Int.max (rmax, smax));
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2580
  in
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2581
    (case if incremented then SOME env0 else unify_var_types context (state, orule) env0 of
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2582
      NONE => Seq.empty
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2583
    | SOME env => if eres_flg then eres env (rev rAs) else res env)
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2584
  end;
1f59664dab51 tuned whitespace;
wenzelm
parents: 79238
diff changeset
  2585
7528
ee5f37e4f186 removed obsolete comment;
wenzelm
parents: 7323
diff changeset
  2586
end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2587
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2588
fun bicompose opt_ctxt flags arg i state =
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2589
  bicompose_aux opt_ctxt flags (state, dest_state (state,i), false) arg;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2590
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2591
(*Quick test whether rule is resolvable with the subgoal with hyps Hs
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2592
  and conclusion B.  If eres_flg then checks 1st premise of rule also*)
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2593
fun could_bires (Hs, B, eres_flg, rule) =
29269
5c25a2012975 moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents: 29003
diff changeset
  2594
    let fun could_reshyp (A1::_) = exists (fn H => Term.could_unify (A1, H)) Hs
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2595
          | could_reshyp [] = false;  (*no premise -- illegal*)
29269
5c25a2012975 moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents: 29003
diff changeset
  2596
    in  Term.could_unify(concl_of rule, B) andalso
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2597
        (not eres_flg  orelse  could_reshyp (prems_of rule))
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2598
    end;
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2599
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2600
(*Bi-resolution of a state with a list of (flag,rule) pairs.
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2601
  Puts the rule above:  rule/state.  Renames vars in the rules. *)
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2602
fun biresolution opt_ctxt match brules i state =
18035
eaae44affc9e added cgoal_of;
wenzelm
parents: 17868
diff changeset
  2603
    let val (stpairs, Bs, Bi, C) = dest_state(state,i);
18145
6757627acf59 renamed Thm.cgoal_of to Thm.cprem_of;
wenzelm
parents: 18127
diff changeset
  2604
        val lift = lift_rule (cprem_of state i);
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2605
        val B = Logic.strip_assums_concl Bi;
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2606
        val Hs = Logic.strip_assums_hyp Bi;
52223
5bb6ae8acb87 tuned signature -- more explicit flags for low-level Thm.bicompose;
wenzelm
parents: 52222
diff changeset
  2607
        val compose =
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2608
          bicompose_aux opt_ctxt {flatten = true, match = match, incremented = true}
52223
5bb6ae8acb87 tuned signature -- more explicit flags for low-level Thm.bicompose;
wenzelm
parents: 52222
diff changeset
  2609
            (state, (stpairs, Bs, Bi, C), true);
4270
957c887b89b5 changed Sequence interface (now Seq, in seq.ML);
wenzelm
parents: 4254
diff changeset
  2610
        fun res [] = Seq.empty
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2611
          | res ((eres_flg, rule)::brules) =
61044
b7af255dd200 more abstract theory certificate, which is not necessarily the full theory;
wenzelm
parents: 61042
diff changeset
  2612
              if Config.get_generic (make_context [state] opt_ctxt (cert_of state))
58950
d07464875dd4 optional proof context for unify operations, for the sake of proper local options;
wenzelm
parents: 58946
diff changeset
  2613
                  Pattern.unify_trace_failure orelse could_bires (Hs, B, eres_flg, rule)
4270
957c887b89b5 changed Sequence interface (now Seq, in seq.ML);
wenzelm
parents: 4254
diff changeset
  2614
              then Seq.make (*delay processing remainder till needed*)
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22365
diff changeset
  2615
                  (fn()=> SOME(compose (eres_flg, lift rule, nprems_of rule),
250
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2616
                               res brules))
9b5a069285ce extend_theory: changed type of "abbrs" arg;
wenzelm
parents: 242
diff changeset
  2617
              else res brules
4270
957c887b89b5 changed Sequence interface (now Seq, in seq.ML);
wenzelm
parents: 4254
diff changeset
  2618
    in  Seq.flat (res brules)  end;
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2619
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2620
(*Resolution: exactly one resolvent must be produced*)
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2621
fun tha RSN (i, thb) =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2622
  (case Seq.chop 2 (biresolution NONE false [(false, tha)] i thb) of
70472
cf66d2db97fe more robust and convenient treatment of implicit context;
wenzelm
parents: 70469
diff changeset
  2623
    ([th], _) => solve_constraints th
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2624
  | ([], _) => raise THM ("RSN: no unifiers", i, [tha, thb])
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2625
  | _ => raise THM ("RSN: multiple unifiers", i, [tha, thb]));
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2626
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2627
(*Resolution: P \<Longrightarrow> Q, Q \<Longrightarrow> R gives P \<Longrightarrow> R*)
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2628
fun tha RS thb = tha RSN (1,thb);
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2629
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2630
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2631
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  2632
(**** Type classes ****)
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2633
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2634
fun standard_tvars thm =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2635
  let
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2636
    val thy = theory_of_thm thm;
74235
dbaed92fd8af tuned signature;
wenzelm
parents: 74234
diff changeset
  2637
    val tvars = build_rev (Term.add_tvars (prop_of thm));
81507
08574da77b4a clarified signature: shorten common cases;
wenzelm
parents: 80690
diff changeset
  2638
    val names = Name.invent_global_types (length tvars);
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2639
    val tinst =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2640
      map2 (fn (ai, S) => fn b => ((ai, S), global_ctyp_of thy (TVar ((b, 0), S)))) tvars names;
74282
c2ee8d993d6a clarified signature: more scalable operations;
wenzelm
parents: 74270
diff changeset
  2641
  in instantiate (TVars.make tinst, Vars.empty) thm end
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2642
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2643
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2644
(* class relations *)
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2645
70457
wenzelm
parents: 70456
diff changeset
  2646
val is_classrel = Symreltab.defined o get_classrels;
wenzelm
parents: 70456
diff changeset
  2647
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2648
fun complete_classrels thy =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2649
  let
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2650
    fun complete (c, (_, (all_preds, all_succs))) (finished1, thy1) =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2651
      let
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2652
        fun compl c1 c2 (finished2, thy2) =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2653
          if is_classrel thy2 (c1, c2) then (finished2, thy2)
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2654
          else
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2655
            (false,
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2656
              thy2
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2657
              |> (map_classrels o Symreltab.update) ((c1, c2),
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2658
                (the_classrel thy2 (c1, c) RS the_classrel thy2 (c, c2))
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2659
                |> standard_tvars
71018
d32ed8927a42 more robust expose_proofs corresponding to register_proofs/consolidate_theory;
wenzelm
parents: 71017
diff changeset
  2660
                |> close_derivation \<^here>
d32ed8927a42 more robust expose_proofs corresponding to register_proofs/consolidate_theory;
wenzelm
parents: 71017
diff changeset
  2661
                |> tap (expose_proof thy2)
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2662
                |> trim_context));
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2663
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2664
        val proven = is_classrel thy1;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2665
        val preds = Graph.Keys.fold (fn c1 => proven (c1, c) ? cons c1) all_preds [];
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2666
        val succs = Graph.Keys.fold (fn c2 => proven (c, c2) ? cons c2) all_succs [];
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2667
      in
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2668
        fold_product compl preds succs (finished1, thy1)
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2669
      end;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2670
  in
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2671
    (case Graph.fold complete (Sorts.classes_of (Sign.classes_of thy)) (true, thy) of
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2672
      (true, _) => NONE
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2673
    | (_, thy') => SOME thy')
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2674
  end;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2675
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2676
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2677
(* type arities *)
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2678
77891
f4cd6e3b5075 prefer theory_long_name in data;
wenzelm
parents: 77889
diff changeset
  2679
fun theory_names_of_arity {long} thy (a, c) =
74234
4f2bd13edce3 clarified signature;
wenzelm
parents: 74233
diff changeset
  2680
  build (get_arities thy |> Aritytab.fold
4f2bd13edce3 clarified signature;
wenzelm
parents: 74233
diff changeset
  2681
    (fn ((a', _, c'), (_, name, ser)) => (a = a' andalso c = c') ? cons (name, ser)))
77891
f4cd6e3b5075 prefer theory_long_name in data;
wenzelm
parents: 77889
diff changeset
  2682
  |> sort (int_ord o apply2 #2) |> map (if long then #1 else Long_Name.base_name o #1);
70475
98b6da301e13 backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents: 70472
diff changeset
  2683
98b6da301e13 backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents: 70472
diff changeset
  2684
fun insert_arity_completions thy ((t, Ss, c), (th, thy_name, ser)) (finished, arities) =
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2685
  let
70461
wenzelm
parents: 70460
diff changeset
  2686
    val completions =
wenzelm
parents: 70460
diff changeset
  2687
      Sign.super_classes thy c |> map_filter (fn c1 =>
70465
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
  2688
        if Aritytab.defined arities (t, Ss, c1) then NONE
70461
wenzelm
parents: 70460
diff changeset
  2689
        else
wenzelm
parents: 70460
diff changeset
  2690
          let
wenzelm
parents: 70460
diff changeset
  2691
            val th1 =
wenzelm
parents: 70460
diff changeset
  2692
              (th RS the_classrel thy (c, c1))
wenzelm
parents: 70460
diff changeset
  2693
              |> standard_tvars
71018
d32ed8927a42 more robust expose_proofs corresponding to register_proofs/consolidate_theory;
wenzelm
parents: 71017
diff changeset
  2694
              |> close_derivation \<^here>
d32ed8927a42 more robust expose_proofs corresponding to register_proofs/consolidate_theory;
wenzelm
parents: 71017
diff changeset
  2695
              |> tap (expose_proof thy)
70461
wenzelm
parents: 70460
diff changeset
  2696
              |> trim_context;
70475
98b6da301e13 backed out changeset 1b8858f4c393: odd problems e.g. in CAVA_LTL_Modelchecker;
wenzelm
parents: 70472
diff changeset
  2697
          in SOME ((t, Ss, c1), (th1, thy_name, ser)) end);
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2698
    val finished' = finished andalso null completions;
70465
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
  2699
    val arities' = fold Aritytab.update completions arities;
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2700
  in (finished', arities') end;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2701
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2702
fun complete_arities thy =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2703
  let
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2704
    val arities = get_arities thy;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2705
    val (finished, arities') =
70465
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
  2706
      Aritytab.fold (insert_arity_completions thy) arities (true, get_arities thy);
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2707
  in
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2708
    if finished then NONE
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2709
    else SOME (map_arities (K arities') thy)
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2710
  end;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2711
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2712
val _ =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2713
  Theory.setup
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2714
   (Theory.at_begin complete_classrels #>
70458
9e2173eb23eb more direct proofs for type classes;
wenzelm
parents: 70457
diff changeset
  2715
    Theory.at_begin complete_arities);
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2716
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2717
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2718
(* primitive rules *)
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2719
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2720
fun add_classrel raw_th thy =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2721
  let
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2722
    val th = strip_shyps (transfer thy raw_th);
71017
c85efa2be619 expose derivations more thoroughly, notably for locale/class reasoning;
wenzelm
parents: 71012
diff changeset
  2723
    val th' = th |> unconstrainT |> tap (expose_proof thy) |> trim_context;
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2724
    val prop = plain_prop_of th;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2725
    val (c1, c2) = Logic.dest_classrel prop;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2726
  in
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2727
    thy
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2728
    |> Sign.primitive_classrel (c1, c2)
71017
c85efa2be619 expose derivations more thoroughly, notably for locale/class reasoning;
wenzelm
parents: 71012
diff changeset
  2729
    |> map_classrels (Symreltab.update ((c1, c2), th'))
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2730
    |> perhaps complete_classrels
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2731
    |> perhaps complete_arities
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2732
  end;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2733
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2734
fun add_arity raw_th thy =
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2735
  let
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2736
    val th = strip_shyps (transfer thy raw_th);
71017
c85efa2be619 expose derivations more thoroughly, notably for locale/class reasoning;
wenzelm
parents: 71012
diff changeset
  2737
    val th' = th |> unconstrainT |> tap (expose_proof thy) |> trim_context;
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2738
    val prop = plain_prop_of th;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2739
    val (t, Ss, c) = Logic.dest_arity prop;
77891
f4cd6e3b5075 prefer theory_long_name in data;
wenzelm
parents: 77889
diff changeset
  2740
    val ar = ((t, Ss, c), (th', Context.theory_long_name thy, serial ()));
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2741
  in
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2742
    thy
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2743
    |> Sign.primitive_arity (t, Ss, [c])
70465
2a9a0e0a7560 more efficient data structure;
wenzelm
parents: 70463
diff changeset
  2744
    |> map_arities (Aritytab.update ar #> curry (insert_arity_completions thy ar) true #> #2)
70456
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2745
  end;
c742527a25fe clarified modules: inference kernel maintains sort algebra within the logic;
wenzelm
parents: 70454
diff changeset
  2746
0
a5a9c433f639 Initial revision
clasohm
parents:
diff changeset
  2747
end;
1503
7dba648ee25c Elimination of fully-functorial style.
paulson
parents: 1495
diff changeset
  2748
32104
d1d98a02473e simultaneous join_proofs;
wenzelm
parents: 32094
diff changeset
  2749
structure Basic_Thm: BASIC_THM = Thm;
d1d98a02473e simultaneous join_proofs;
wenzelm
parents: 32094
diff changeset
  2750
open Basic_Thm;