src/Pure/Isar/locale.ML
author wenzelm
Thu, 22 Nov 2007 14:51:34 +0100
changeset 25456 6f79698f294d
parent 25357 6ea18fd11058
child 25619 e4d5cd384245
permissions -rw-r--r--
tuned;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
12014
035ab884b9e0 beginnings of new locales (not yet functional);
wenzelm
parents: 11896
diff changeset
     1
(*  Title:      Pure/Isar/locale.ML
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
     3
    Author:     Clemens Ballarin, TU Muenchen; Markus Wenzel, LMU/TU Muenchen
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
     4
12058
cc182b43dd55 fixes: optional typ;
wenzelm
parents: 12046
diff changeset
     5
Locales -- Isar proof contexts as meta-level predicates, with local
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
     6
syntax and implicit structures.
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
     7
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
     8
Draws basic ideas from Florian Kammueller's original version of
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
     9
locales, but uses the richer infrastructure of Isar instead of the raw
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
    10
meta-logic.  Furthermore, structured import of contexts (with merge
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
    11
and rename operations) are provided, as well as type-inference of the
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
    12
signature parts, and predicate definitions of the specification text.
14446
0bc2519e9990 *** empty log message ***
ballarin
parents: 14291
diff changeset
    13
17437
9deaf32c83be interpretation uses primitive goal interface
ballarin
parents: 17412
diff changeset
    14
Interpretation enables the reuse of theorems of locales in other
9deaf32c83be interpretation uses primitive goal interface
ballarin
parents: 17412
diff changeset
    15
contexts, namely those defined by theories, structured proofs and
9deaf32c83be interpretation uses primitive goal interface
ballarin
parents: 17412
diff changeset
    16
locales themselves.
9deaf32c83be interpretation uses primitive goal interface
ballarin
parents: 17412
diff changeset
    17
14446
0bc2519e9990 *** empty log message ***
ballarin
parents: 14291
diff changeset
    18
See also:
0bc2519e9990 *** empty log message ***
ballarin
parents: 14291
diff changeset
    19
0bc2519e9990 *** empty log message ***
ballarin
parents: 14291
diff changeset
    20
[1] Clemens Ballarin. Locales and Locale Expressions in Isabelle/Isar.
0bc2519e9990 *** empty log message ***
ballarin
parents: 14291
diff changeset
    21
    In Stefano Berardi et al., Types for Proofs and Programs: International
15099
6d8619440ea0 Some comments added.
ballarin
parents: 14981
diff changeset
    22
    Workshop, TYPES 2003, Torino, Italy, LNCS 3085, pages 34-50, 2004.
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
    23
[2] Clemens Ballarin. Interpretation of Locales in Isabelle: Managing
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
    24
    Dependencies between Locales. Technical Report TUM-I0607, Technische
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
    25
    Universitaet Muenchen, 2006.
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
    26
[3] Clemens Ballarin. Interpretation of Locales in Isabelle: Theories and
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
    27
    Proof Contexts. In J.M. Borwein and W.M. Farmer, MKM 2006, LNAI 4108,
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
    28
    pages 31-43, 2006.
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
    29
*)
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
    30
16169
b59202511b8a Locales: new element constrains, parameter renaming with syntax,
ballarin
parents: 16144
diff changeset
    31
(* TODO:
b59202511b8a Locales: new element constrains, parameter renaming with syntax,
ballarin
parents: 16144
diff changeset
    32
- beta-eta normalisation of interpretation parameters
b59202511b8a Locales: new element constrains, parameter renaming with syntax,
ballarin
parents: 16144
diff changeset
    33
- dangling type frees in locales
16620
2a7f46324218 Proper treatment of beta-redexes in witness theorems.
ballarin
parents: 16458
diff changeset
    34
- test subsumption of interpretations when merging theories
16169
b59202511b8a Locales: new element constrains, parameter renaming with syntax,
ballarin
parents: 16144
diff changeset
    35
*)
b59202511b8a Locales: new element constrains, parameter renaming with syntax,
ballarin
parents: 16144
diff changeset
    36
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
    37
signature LOCALE =
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
    38
sig
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
    39
  datatype expr =
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
    40
    Locale of string |
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
    41
    Rename of expr * (string * mixfix option) option list |
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
    42
    Merge of expr list
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
    43
  val empty: expr
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
    44
  datatype 'a element = Elem of 'a | Expr of expr
21035
326c15917a33 export map_elem;
wenzelm
parents: 21005
diff changeset
    45
  val map_elem: ('a -> 'b) -> 'a element -> 'b element
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
    46
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
    47
  val intern: theory -> xstring -> string
24751
dbb34a03af5a exported intern_expr
haftmann
parents: 24693
diff changeset
    48
  val intern_expr: theory -> expr -> expr
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
    49
  val extern: theory -> string -> xstring
19991
0c9650664d47 Locales no longer generate views. The following functions have changed
ballarin
parents: 19984
diff changeset
    50
  val init: string -> theory -> Proof.context
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
    51
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
    52
  (* The specification of a locale *)
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
    53
  val parameters_of: theory -> string ->
18917
77e18862990f refined signature of locale module
haftmann
parents: 18907
diff changeset
    54
    ((string * typ) * mixfix) list
19276
ac90764bb654 New interface function parameters_of_expr.
ballarin
parents: 19061
diff changeset
    55
  val parameters_of_expr: theory -> expr ->
ac90764bb654 New interface function parameters_of_expr.
ballarin
parents: 19061
diff changeset
    56
    ((string * typ) * mixfix) list
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
    57
  val local_asms_of: theory -> string ->
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
    58
    ((string * Attrib.src list) * term list) list
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
    59
  val global_asms_of: theory -> string ->
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
    60
    ((string * Attrib.src list) * term list) list
22523
19e4fd6ffcaa exported interface for intro rules
haftmann
parents: 22351
diff changeset
    61
  val intros: theory -> string ->
19e4fd6ffcaa exported interface for intro rules
haftmann
parents: 22351
diff changeset
    62
    thm list * thm list
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
    63
18899
a8e913c93578 theorem(_in_locale): Element.statement, Obtain.statement;
wenzelm
parents: 18890
diff changeset
    64
  (* Processing of locale statements *)
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
    65
  val read_context_statement: xstring option -> Element.context element list ->
19585
70a1ce3b23ae removed 'concl is' patterns;
wenzelm
parents: 19482
diff changeset
    66
    (string * string list) list list -> Proof.context ->
19991
0c9650664d47 Locales no longer generate views. The following functions have changed
ballarin
parents: 19984
diff changeset
    67
    string option * Proof.context * Proof.context * (term * term list) list list
21035
326c15917a33 export map_elem;
wenzelm
parents: 21005
diff changeset
    68
  val read_context_statement_i: string option -> Element.context element list ->
326c15917a33 export map_elem;
wenzelm
parents: 21005
diff changeset
    69
    (string * string list) list list -> Proof.context ->
326c15917a33 export map_elem;
wenzelm
parents: 21005
diff changeset
    70
    string option * Proof.context * Proof.context * (term * term list) list list
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
    71
  val cert_context_statement: string option -> Element.context_i element list ->
19585
70a1ce3b23ae removed 'concl is' patterns;
wenzelm
parents: 19482
diff changeset
    72
    (term * term list) list list -> Proof.context ->
19991
0c9650664d47 Locales no longer generate views. The following functions have changed
ballarin
parents: 19984
diff changeset
    73
    string option * Proof.context * Proof.context * (term * term list) list list
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
    74
  val read_expr: expr -> Element.context list -> Proof.context ->
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
    75
    Element.context_i list * Proof.context
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
    76
  val cert_expr: expr -> Element.context_i list -> Proof.context ->
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
    77
    Element.context_i list * Proof.context
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
    78
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
    79
  (* Diagnostic functions *)
12758
f6aceb9d4b8e print_locale: allow full body specification;
wenzelm
parents: 12730
diff changeset
    80
  val print_locales: theory -> unit
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
    81
  val print_locale: theory -> bool -> expr -> Element.context list -> unit
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
    82
  val print_registrations: bool -> string -> Proof.context -> unit
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
    83
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
    84
  val add_locale: string option -> bstring -> expr -> Element.context list -> theory
20965
75ffb934929d add_locale(_i): return actual result context;
wenzelm
parents: 20951
diff changeset
    85
    -> string * Proof.context
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
    86
  val add_locale_i: string option -> bstring -> expr -> Element.context_i list -> theory
20965
75ffb934929d add_locale(_i): return actual result context;
wenzelm
parents: 20951
diff changeset
    87
    -> string * Proof.context
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
    88
21225
bf0b1e62cf60 exported intro_locales_tac
schirmer
parents: 21035
diff changeset
    89
  (* Tactics *)
bf0b1e62cf60 exported intro_locales_tac
schirmer
parents: 21035
diff changeset
    90
  val intro_locales_tac: bool -> Proof.context -> thm list -> tactic
bf0b1e62cf60 exported intro_locales_tac
schirmer
parents: 21035
diff changeset
    91
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
    92
  (* Storing results *)
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
    93
  val add_thmss: string -> string ->
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
    94
    ((string * Attrib.src list) * (thm list * Attrib.src list) list) list ->
21582
ac6af184bfb0 simplified add_thmss;
wenzelm
parents: 21530
diff changeset
    95
    Proof.context -> Proof.context
24020
ed4d7abffee7 tuned signature;
wenzelm
parents: 24006
diff changeset
    96
  val add_type_syntax: string -> declaration -> Proof.context -> Proof.context
ed4d7abffee7 tuned signature;
wenzelm
parents: 24006
diff changeset
    97
  val add_term_syntax: string -> declaration -> Proof.context -> Proof.context
ed4d7abffee7 tuned signature;
wenzelm
parents: 24006
diff changeset
    98
  val add_declaration: string -> declaration -> Proof.context -> Proof.context
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
    99
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
   100
  val interpretation_i: (Proof.context -> Proof.context) ->
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   101
    (bool * string) * Attrib.src list -> expr ->
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   102
    term option list * ((bstring * Attrib.src list) * term) list ->
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
   103
    theory -> Proof.state
21005
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
   104
  val interpretation: (Proof.context -> Proof.context) ->
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   105
    (bool * string) * Attrib.src list -> expr ->
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   106
    string option list * ((bstring * Attrib.src list) * string) list ->
21005
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
   107
    theory -> Proof.state
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
   108
  val interpretation_in_locale: (Proof.context -> Proof.context) ->
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
   109
    xstring * expr -> theory -> Proof.state
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
   110
  val interpret_i: (Proof.state -> Proof.state Seq.seq) ->
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   111
    (bool * string) * Attrib.src list -> expr ->
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   112
    term option list * ((bstring * Attrib.src list) * term) list ->
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
   113
    bool -> Proof.state -> Proof.state
21005
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
   114
  val interpret: (Proof.state -> Proof.state Seq.seq) ->
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   115
    (bool * string) * Attrib.src list -> expr ->
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   116
    string option list * ((bstring * Attrib.src list) * string) list ->
21005
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
   117
    bool -> Proof.state -> Proof.state
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   118
end;
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
   119
12289
ec2dafd0a6a9 clarified locale operations (rename, merge);
wenzelm
parents: 12277
diff changeset
   120
structure Locale: LOCALE =
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   121
struct
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   122
23228
05fb9b2b16d7 added gen_merge_lists/merge_lists/merge_alists (legacy operations from library.ML);
wenzelm
parents: 23178
diff changeset
   123
(* legacy operations *)
05fb9b2b16d7 added gen_merge_lists/merge_lists/merge_alists (legacy operations from library.ML);
wenzelm
parents: 23178
diff changeset
   124
05fb9b2b16d7 added gen_merge_lists/merge_lists/merge_alists (legacy operations from library.ML);
wenzelm
parents: 23178
diff changeset
   125
fun gen_merge_lists _ xs [] = xs
05fb9b2b16d7 added gen_merge_lists/merge_lists/merge_alists (legacy operations from library.ML);
wenzelm
parents: 23178
diff changeset
   126
  | gen_merge_lists _ [] ys = ys
05fb9b2b16d7 added gen_merge_lists/merge_lists/merge_alists (legacy operations from library.ML);
wenzelm
parents: 23178
diff changeset
   127
  | gen_merge_lists eq xs ys = xs @ filter_out (member eq xs) ys;
05fb9b2b16d7 added gen_merge_lists/merge_lists/merge_alists (legacy operations from library.ML);
wenzelm
parents: 23178
diff changeset
   128
05fb9b2b16d7 added gen_merge_lists/merge_lists/merge_alists (legacy operations from library.ML);
wenzelm
parents: 23178
diff changeset
   129
fun merge_lists xs ys = gen_merge_lists (op =) xs ys;
05fb9b2b16d7 added gen_merge_lists/merge_lists/merge_alists (legacy operations from library.ML);
wenzelm
parents: 23178
diff changeset
   130
fun merge_alists xs = gen_merge_lists (eq_fst (op =)) xs;
05fb9b2b16d7 added gen_merge_lists/merge_lists/merge_alists (legacy operations from library.ML);
wenzelm
parents: 23178
diff changeset
   131
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   132
fun legacy_unvarifyT thm =
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   133
  let
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   134
    val cT = Thm.ctyp_of (Thm.theory_of_thm thm);
22700
5a699d278cfa Thm.fold_terms;
wenzelm
parents: 22678
diff changeset
   135
    val tvars = rev (Thm.fold_terms Term.add_tvars thm []);
20307
a44096c94b3c removed obsolete Drule.frees/vars_of etc.;
wenzelm
parents: 20243
diff changeset
   136
    val tfrees = map (fn ((x, _), S) => SOME (cT (TFree (x, S)))) tvars;
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   137
  in Drule.instantiate' tfrees [] thm end;
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   138
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   139
fun legacy_unvarify raw_thm =
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   140
  let
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   141
    val thm = legacy_unvarifyT raw_thm;
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   142
    val ct = Thm.cterm_of (Thm.theory_of_thm thm);
22700
5a699d278cfa Thm.fold_terms;
wenzelm
parents: 22678
diff changeset
   143
    val vars = rev (Thm.fold_terms Term.add_vars thm []);
20307
a44096c94b3c removed obsolete Drule.frees/vars_of etc.;
wenzelm
parents: 20243
diff changeset
   144
    val frees = map (fn ((x, _), T) => SOME (ct (Free (x, T)))) vars;
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   145
  in Drule.instantiate' [] frees thm end;
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
   146
20307
a44096c94b3c removed obsolete Drule.frees/vars_of etc.;
wenzelm
parents: 20243
diff changeset
   147
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   148
(** locale elements and expressions **)
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   149
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   150
datatype ctxt = datatype Element.ctxt;
17355
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
   151
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   152
datatype expr =
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   153
  Locale of string |
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
   154
  Rename of expr * (string * mixfix option) option list |
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   155
  Merge of expr list;
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   156
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   157
val empty = Merge [];
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   158
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   159
datatype 'a element =
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   160
  Elem of 'a | Expr of expr;
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   161
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   162
fun map_elem f (Elem e) = Elem (f e)
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   163
  | map_elem _ (Expr e) = Expr e;
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   164
24020
ed4d7abffee7 tuned signature;
wenzelm
parents: 24006
diff changeset
   165
type decl = declaration * stamp;
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
   166
12070
c72fe1edc9e7 proper treatment of local syntax;
wenzelm
parents: 12063
diff changeset
   167
type locale =
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   168
 {axiom: Element.witness list,
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
   169
    (* For locales that define predicates this is [A [A]], where A is the locale
20317
6e070b33e72b Updated comments.
ballarin
parents: 20307
diff changeset
   170
       specification.  Otherwise [].
6e070b33e72b Updated comments.
ballarin
parents: 20307
diff changeset
   171
       Only required to generate the right witnesses for locales with predicates. *)
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   172
  imports: expr,                                                     (*dynamic imports*)
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   173
  elems: (Element.context_i * stamp) list,
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   174
    (* Static content, neither Fixes nor Constrains elements *)
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
   175
  params: ((string * typ) * mixfix) list,                             (*all params*)
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   176
  lparams: string list,                                             (*local params*)
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   177
  decls: decl list * decl list,                    (*type/term_syntax declarations*)
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   178
  regs: ((string * string list) * Element.witness list) list,
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
   179
    (* Registrations: indentifiers and witnesses of locales interpreted in the locale. *)
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   180
  intros: thm list * thm list}
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   181
    (* Introduction rules: of delta predicate and locale predicate. *)
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   182
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
   183
(* CB: an internal (Int) locale element was either imported or included,
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
   184
   an external (Ext) element appears directly in the locale text. *)
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
   185
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
   186
datatype ('a, 'b) int_ext = Int of 'a | Ext of 'b;
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
   187
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
   188
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
   189
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   190
(** substitutions on Frees and Vars -- clone from element.ML **)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   191
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   192
(* instantiate types *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   193
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   194
fun var_instT_type env =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   195
  if Vartab.is_empty env then I
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   196
  else Term.map_type_tvar (fn (x, S) => the_default (TVar (x, S)) (Vartab.lookup env x));
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   197
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   198
fun var_instT_term env =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   199
  if Vartab.is_empty env then I
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   200
  else Term.map_types (var_instT_type env);
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   201
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   202
fun var_inst_term (envT, env) =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   203
  if Vartab.is_empty env then var_instT_term envT
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   204
  else
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   205
    let
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   206
      val instT = var_instT_type envT;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   207
      fun inst (Const (x, T)) = Const (x, instT T)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   208
        | inst (Free (x, T)) = Free(x, instT T)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   209
        | inst (Var (xi, T)) =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   210
            (case Vartab.lookup env xi of
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   211
              NONE => Var (xi, instT T)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   212
            | SOME t => t)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   213
        | inst (b as Bound _) = b
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   214
        | inst (Abs (x, T, t)) = Abs (x, instT T, inst t)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   215
        | inst (t $ u) = inst t $ inst u;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   216
    in Envir.beta_norm o inst end;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   217
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   218
16736
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
   219
(** management of registrations in theories and proof contexts **)
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   220
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   221
structure Registrations :
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   222
  sig
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   223
    type T
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   224
    val empty: T
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   225
    val join: T * T -> T
20069
77a6b62418bb Witness theorems of interpretations now transfered to current theory.
ballarin
parents: 20059
diff changeset
   226
    val dest: theory -> T ->
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   227
      (term list *
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   228
        (((bool * string) * Attrib.src list) *
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   229
         (Morphism.morphism * ((typ Vartab.table * typ list) * (term Vartab.table * term list))) *
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   230
         Element.witness list *
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   231
         thm Termtab.table)) list
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   232
    val test: theory -> T * term list -> bool
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   233
    val lookup: theory ->
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   234
      T * (term list * ((typ Vartab.table * typ list) * (term Vartab.table * term list))) ->
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   235
      (((bool * string) * Attrib.src list) *
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   236
        Element.witness list *
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   237
        thm Termtab.table) option
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   238
    val insert: theory -> term list -> ((bool * string) * Attrib.src list) ->
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   239
        (Morphism.morphism * ((typ Vartab.table * typ list) * (term Vartab.table * term list))) -> T ->
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
   240
      T * (term list * (((bool * string) * Attrib.src list) * Element.witness list)) list
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
   241
    val add_witness: term list -> Element.witness -> T -> T
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   242
    val add_equation: term list -> thm -> T -> T
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   243
  end =
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   244
struct
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   245
  (* A registration is indexed by parameter instantiation.  Its components are:
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   246
     - parameters and prefix
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   247
       (if the Boolean flag is set, only accesses containing the prefix are generated,
23418
c195f6f13769 balanced conjunctions;
wenzelm
parents: 23228
diff changeset
   248
        otherwise the prefix may be omitted when accessing theorems etc.)
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   249
     - pair of export and import morphisms, export maps content to its originating
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   250
       context, import is its inverse
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   251
     - theorems (actually witnesses) instantiating locale assumptions
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   252
     - theorems (equations) interpreting derived concepts and indexed by lhs.
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   253
     NB: index is exported while content is internalised.
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   254
  *)
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   255
  type T = (((bool * string) * Attrib.src list) *
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   256
            (Morphism.morphism * ((typ Vartab.table * typ list) * (term Vartab.table * term list))) *
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   257
            Element.witness list *
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   258
            thm Termtab.table) Termtab.table;
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   259
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   260
  val empty = Termtab.empty;
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   261
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   262
  (* term list represented as single term, for simultaneous matching *)
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   263
  fun termify ts =
18343
e36238ac5359 defines: beta/eta contract lhs;
wenzelm
parents: 18330
diff changeset
   264
    Term.list_comb (Const ("", map fastype_of ts ---> propT), ts);
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   265
  fun untermify t =
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   266
    let fun ut (Const _) ts = ts
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   267
          | ut (s $ t) ts = ut s (t::ts)
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   268
    in ut t [] end;
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   269
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   270
  (* joining of registrations:
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   271
     - prefix, attributes and morphisms of right theory;
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   272
     - witnesses are equal, no attempt to subsumption testing;
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   273
     - union of equalities, if conflicting (i.e. two eqns with equal lhs)
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   274
       eqn of right theory takes precedence *)
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   275
  fun join (r1, r2) = Termtab.join (fn _ => fn ((_, _, _, e1), (n, m, w, e2)) =>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   276
      (n, m, w, Termtab.join (fn _ => fn (_, e) => e) (e1, e2))) (r1, r2);
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   277
20069
77a6b62418bb Witness theorems of interpretations now transfered to current theory.
ballarin
parents: 20059
diff changeset
   278
  fun dest_transfer thy regs =
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   279
    Termtab.dest regs |> map (apsnd (fn (n, m, ws, es) =>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   280
      (n, m, map (Element.transfer_witness thy) ws, Termtab.map (transfer thy) es)));
20069
77a6b62418bb Witness theorems of interpretations now transfered to current theory.
ballarin
parents: 20059
diff changeset
   281
77a6b62418bb Witness theorems of interpretations now transfered to current theory.
ballarin
parents: 20059
diff changeset
   282
  fun dest thy regs = dest_transfer thy regs |> map (apfst untermify);
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   283
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   284
  (* registrations that subsume t *)
17203
29b2563f5c11 refer to theory instead of low-level tsig;
wenzelm
parents: 17142
diff changeset
   285
  fun subsumers thy t regs =
20069
77a6b62418bb Witness theorems of interpretations now transfered to current theory.
ballarin
parents: 20059
diff changeset
   286
    filter (fn (t', _) => Pattern.matches thy (t', t)) (dest_transfer thy regs);
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   287
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   288
  (* test if registration that subsumes the query is present *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   289
  fun test thy (regs, ts) =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   290
    not (null (subsumers thy (termify ts) regs));
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   291
      
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   292
  (* look up registration, pick one that subsumes the query *)
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   293
  fun lookup thy (regs, (ts, ((impT, _), (imp, _)))) =
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   294
    let
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   295
      val t = termify ts;
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
   296
      val subs = subsumers thy t regs;
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   297
    in
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   298
      (case subs of
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   299
        [] => NONE
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   300
      | ((t', ((prfx, atts), (exp', ((impT', domT'), (imp', dom'))), thms, eqns)) :: _) =>
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   301
          let
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
   302
            val (tinst, inst) = Pattern.match thy (t', t) (Vartab.empty, Vartab.empty);
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   303
            val tinst' = domT' |> map (fn (T as TFree (x, _)) =>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   304
                (x, T |> Morphism.typ exp' |> Envir.typ_subst_TVars tinst
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   305
                      |> var_instT_type impT)) |> Symtab.make;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   306
            val inst' = dom' |> map (fn (t as Free (x, _)) =>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   307
                (x, t |> Morphism.term exp' |> Envir.subst_vars (tinst, inst)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   308
                      |> var_inst_term (impT, imp))) |> Symtab.make;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   309
            val inst'_morph = Element.inst_morphism thy (tinst', inst');
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   310
          in SOME ((prfx, map (Args.morph_values inst'_morph) atts),
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   311
            map (Element.morph_witness inst'_morph) thms,
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   312
            Termtab.map (Morphism.thm inst'_morph) eqns)
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   313
          end)
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   314
    end;
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   315
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   316
  (* add registration if not subsumed by ones already present,
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   317
     additionally returns registrations that are strictly subsumed *)
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   318
  fun insert thy ts attn m regs =
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   319
    let
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   320
      val t = termify ts;
20069
77a6b62418bb Witness theorems of interpretations now transfered to current theory.
ballarin
parents: 20059
diff changeset
   321
      val subs = subsumers thy t regs ;
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   322
    in (case subs of
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   323
        [] => let
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   324
                val sups =
20069
77a6b62418bb Witness theorems of interpretations now transfered to current theory.
ballarin
parents: 20059
diff changeset
   325
                  filter (fn (t', _) => Pattern.matches thy (t, t')) (dest_transfer thy regs);
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   326
                val sups' = map (apfst untermify) sups |> map (fn (ts, (n, _, w, _)) => (ts, (n, w)))
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   327
              in (Termtab.update (t, (attn, m, [], Termtab.empty)) regs, sups') end
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   328
      | _ => (regs, []))
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   329
    end;
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   330
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   331
  fun gen_add f ts thm regs =
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   332
    let
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   333
      val t = termify ts;
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   334
    in
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   335
      Termtab.update (t, f thm (the (Termtab.lookup regs t))) regs
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   336
    end;
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   337
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   338
  (* add witness theorem to registration,
16169
b59202511b8a Locales: new element constrains, parameter renaming with syntax,
ballarin
parents: 16144
diff changeset
   339
     only if instantiation is exact, otherwise exception Option raised *)
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   340
  fun add_witness ts thm regs =
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   341
    gen_add (fn thm => fn (x, m, thms, eqns) => (x, m, thm::thms, eqns)) ts thm regs;
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   342
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   343
  (* add equation to registration, replaces previous equation with same lhs;
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   344
     only if instantiation is exact, otherwise exception Option raised;
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   345
     exception TERM raised if not a meta equality *)
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   346
  fun add_equation ts thm regs =
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   347
    gen_add (fn thm => fn (x, m, thms, eqns) =>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   348
      (x, m, thms, Termtab.update (thm |> prop_of |> Logic.dest_equals |> fst, thm) eqns))
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   349
      ts thm regs;
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   350
end;
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   351
16736
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
   352
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   353
(** theory data : locales **)
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   354
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   355
structure LocalesData = TheoryDataFun
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 22796
diff changeset
   356
(
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   357
  type T = NameSpace.T * locale Symtab.table;
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   358
    (* 1st entry: locale namespace,
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   359
       2nd entry: locales of the theory *)
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   360
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   361
  val empty = (NameSpace.empty, Symtab.empty);
12063
4c16bdee47d4 added add_locale(_i) and store_thm;
wenzelm
parents: 12058
diff changeset
   362
  val copy = I;
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
   363
  val extend = I;
12289
ec2dafd0a6a9 clarified locale operations (rename, merge);
wenzelm
parents: 12277
diff changeset
   364
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   365
  fun join_locales _
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   366
    ({axiom, imports, elems, params, lparams, decls = (decls1, decls2), regs, intros}: locale,
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   367
      {elems = elems', decls = (decls1', decls2'), regs = regs', ...}: locale) =
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   368
     {axiom = axiom,
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   369
      imports = imports,
17496
26535df536ae slight adaptions to library changes
haftmann
parents: 17485
diff changeset
   370
      elems = gen_merge_lists (eq_snd (op =)) elems elems',
16736
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
   371
      params = params,
19278
4d762b77d319 Internal restructuring: local parameters.
ballarin
parents: 19276
diff changeset
   372
      lparams = lparams,
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
   373
      decls =
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   374
       (Library.merge (eq_snd (op =)) (decls1, decls1'),
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   375
        Library.merge (eq_snd (op =)) (decls2, decls2')),
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   376
      regs = merge_alists regs regs',
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   377
      intros = intros};
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   378
  fun merge _ ((space1, locs1), (space2, locs2)) =
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   379
    (NameSpace.merge (space1, space2), Symtab.join join_locales (locs1, locs2));
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 22796
diff changeset
   380
);
15801
d2f5ca3c048d superceded by Pure.thy and CPure.thy;
wenzelm
parents: 15798
diff changeset
   381
d2f5ca3c048d superceded by Pure.thy and CPure.thy;
wenzelm
parents: 15798
diff changeset
   382
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   383
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   384
(** context data : registrations **)
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   385
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   386
structure RegistrationsData = GenericDataFun
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 22796
diff changeset
   387
(
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 22796
diff changeset
   388
  type T = Registrations.T Symtab.table;  (*registrations, indexed by locale name*)
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   389
  val empty = Symtab.empty;
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   390
  val extend = I;
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   391
  fun merge _ = Symtab.join (K Registrations.join);
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 22796
diff changeset
   392
);
12289
ec2dafd0a6a9 clarified locale operations (rename, merge);
wenzelm
parents: 12277
diff changeset
   393
12277
2b28d7dd91f5 improved ordering of evaluated elements;
wenzelm
parents: 12273
diff changeset
   394
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   395
(** access locales **)
12277
2b28d7dd91f5 improved ordering of evaluated elements;
wenzelm
parents: 12273
diff changeset
   396
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 22796
diff changeset
   397
fun print_locales thy =
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   398
  let val (space, locs) = LocalesData.get thy in
22846
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 22796
diff changeset
   399
    Pretty.strs ("locales:" :: map #1 (NameSpace.extern_table (space, locs)))
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 22796
diff changeset
   400
    |> Pretty.writeln
fb79144af9a3 simplified DataFun interfaces;
wenzelm
parents: 22796
diff changeset
   401
  end;
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   402
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   403
val intern = NameSpace.intern o #1 o LocalesData.get;
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   404
val extern = NameSpace.extern o #1 o LocalesData.get;
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   405
16144
e339119f4261 renamed cond_extern to extern;
wenzelm
parents: 16105
diff changeset
   406
fun declare_locale name thy =
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   407
  thy |> LocalesData.map (fn (space, locs) =>
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   408
    (Sign.declare_name thy name space, locs));
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   409
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   410
fun put_locale name loc =
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   411
  LocalesData.map (fn (space, locs) =>
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   412
    (space, Symtab.update (name, loc) locs));
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   413
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   414
fun get_locale thy name = Symtab.lookup (#2 (LocalesData.get thy)) name;
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   415
12014
035ab884b9e0 beginnings of new locales (not yet functional);
wenzelm
parents: 11896
diff changeset
   416
fun the_locale thy name =
035ab884b9e0 beginnings of new locales (not yet functional);
wenzelm
parents: 11896
diff changeset
   417
  (case get_locale thy name of
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15456
diff changeset
   418
    SOME loc => loc
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15456
diff changeset
   419
  | NONE => error ("Unknown locale " ^ quote name));
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   420
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
   421
fun change_locale name f thy =
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
   422
  let
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   423
    val {axiom, imports, elems, params, lparams, decls, regs, intros} =
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   424
        the_locale thy name;
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   425
    val (axiom', imports', elems', params', lparams', decls', regs', intros') =
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   426
      f (axiom, imports, elems, params, lparams, decls, regs, intros);
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
   427
  in
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   428
    put_locale name {axiom = axiom', imports = imports', elems = elems',
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
   429
      params = params', lparams = lparams', decls = decls', regs = regs',
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   430
      intros = intros'} thy
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
   431
  end;
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
   432
12046
a404358fd965 locale elements;
wenzelm
parents: 12014
diff changeset
   433
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   434
(* access registrations *)
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   435
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   436
(* retrieve registration from theory or context *)
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   437
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   438
fun get_registrations ctxt name =
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   439
  case Symtab.lookup (RegistrationsData.get ctxt) name of
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
   440
      NONE => []
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   441
    | SOME reg => Registrations.dest (Context.theory_of ctxt) reg;
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   442
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   443
fun get_global_registrations thy = get_registrations (Context.Theory thy);
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   444
fun get_local_registrations ctxt = get_registrations (Context.Proof ctxt);
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   445
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   446
25357
6ea18fd11058 avoid "import" as identifier, which is a keyword in Alice;
wenzelm
parents: 25286
diff changeset
   447
fun get_registration ctxt imprt (name, ps) =
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   448
  case Symtab.lookup (RegistrationsData.get ctxt) name of
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   449
      NONE => NONE
25357
6ea18fd11058 avoid "import" as identifier, which is a keyword in Alice;
wenzelm
parents: 25286
diff changeset
   450
    | SOME reg => Registrations.lookup (Context.theory_of ctxt) (reg, (ps, imprt));
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   451
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   452
fun get_global_registration thy = get_registration (Context.Theory thy);
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   453
fun get_local_registration ctxt = get_registration (Context.Proof ctxt);
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   454
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   455
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   456
fun test_registration ctxt (name, ps) =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   457
  case Symtab.lookup (RegistrationsData.get ctxt) name of
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   458
      NONE => false
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   459
    | SOME reg => Registrations.test (Context.theory_of ctxt) (reg, ps);
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   460
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   461
fun test_global_registration thy = test_registration (Context.Theory thy);
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   462
fun test_local_registration ctxt = test_registration (Context.Proof ctxt);
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   463
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   464
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   465
(* add registration to theory or context, ignored if subsumed *)
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   466
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   467
fun put_registration (name, ps) attn morphs ctxt =
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   468
  RegistrationsData.map (fn regs =>
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   469
    let
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   470
      val thy = Context.theory_of ctxt;
18343
e36238ac5359 defines: beta/eta contract lhs;
wenzelm
parents: 18330
diff changeset
   471
      val reg = the_default Registrations.empty (Symtab.lookup regs name);
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   472
      val (reg', sups) = Registrations.insert thy ps attn morphs reg;
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   473
      val _ = if not (null sups) then warning
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   474
                ("Subsumed interpretation(s) of locale " ^
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
   475
                 quote (extern thy name) ^
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   476
                 "\nwith the following prefix(es):" ^
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
   477
                  commas_quote (map (fn (_, (((_, s), _), _)) => s) sups))
15837
7a567dcd4cda Subsumption of locale interpretations.
ballarin
parents: 15801
diff changeset
   478
              else ();
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   479
    in Symtab.update (name, reg') regs end) ctxt;
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   480
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   481
fun put_global_registration id attn morphs =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   482
  Context.theory_map (put_registration id attn morphs);
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   483
fun put_local_registration id attn morphs =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   484
  Context.proof_map (put_registration id attn morphs);
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   485
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   486
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
   487
fun put_registration_in_locale name id =
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   488
  change_locale name (fn (axiom, imports, elems, params, lparams, decls, regs, intros) =>
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   489
    (axiom, imports, elems, params, lparams, decls, regs @ [(id, [])], intros));
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   490
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   491
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   492
(* add witness theorem to registration, ignored if registration not present *)
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   493
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
   494
fun add_witness (name, ps) thm =
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   495
  RegistrationsData.map (Symtab.map_entry name (Registrations.add_witness ps thm));
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   496
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   497
fun add_global_witness id thm = Context.theory_map (add_witness id thm);
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   498
fun add_local_witness id thm = Context.proof_map (add_witness id thm);
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   499
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   500
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
   501
fun add_witness_in_locale name id thm =
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   502
  change_locale name (fn (axiom, imports, elems, params, lparams, decls, regs, intros) =>
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   503
    let
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   504
      fun add (id', thms) =
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
   505
        if id = id' then (id', thm :: thms) else (id', thms);
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   506
    in (axiom, imports, elems, params, lparams, decls, map add regs, intros) end);
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   507
14215
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
   508
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   509
(* add equation to registration, ignored if registration not present *)
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   510
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   511
fun add_equation (name, ps) thm =
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   512
  RegistrationsData.map (Symtab.map_entry name (Registrations.add_equation ps thm));
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   513
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   514
fun add_global_equation id thm = Context.theory_map (add_equation id thm);
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   515
fun add_local_equation id thm = Context.proof_map (add_equation id thm);
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   516
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   517
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
   518
(* printing of registrations *)
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   519
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   520
fun print_registrations show_wits loc ctxt =
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   521
  let
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
   522
    val thy = ProofContext.theory_of ctxt;
24920
2a45e400fdad generic Syntax.pretty/string_of operations;
wenzelm
parents: 24787
diff changeset
   523
    val prt_term = Pretty.quote o Syntax.pretty_term ctxt;
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   524
    fun prt_term' t = if !show_types
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   525
          then Pretty.block [prt_term t, Pretty.brk 1, Pretty.str "::",
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   526
            Pretty.brk 1, (Pretty.quote o Syntax.pretty_typ ctxt) (type_of t)]
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   527
          else prt_term t;
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   528
    val prt_thm = prt_term o prop_of;
17096
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
   529
    fun prt_inst ts =
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
   530
        Pretty.enclose "(" ")" (Pretty.breaks (map prt_term' ts));
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   531
    fun prt_attn ((false, prfx), atts) =
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   532
        Pretty.breaks (Pretty.str prfx :: Pretty.str "(optional)" ::
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   533
          Attrib.pretty_attribs ctxt atts)
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   534
      | prt_attn ((true, prfx), atts) =
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   535
        Pretty.breaks (Pretty.str prfx :: Attrib.pretty_attribs ctxt atts);
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   536
    fun prt_eqns [] = Pretty.str "no equations."
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   537
      | prt_eqns eqns = Pretty.block (Pretty.str "equations:" :: Pretty.brk 1 ::
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
   538
          Pretty.breaks (map prt_thm eqns));
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   539
    fun prt_core ts eqns =
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   540
          [prt_inst ts, Pretty.fbrk, prt_eqns (Termtab.dest eqns |> map snd)];
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   541
    fun prt_witns [] = Pretty.str "no witnesses."
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   542
      | prt_witns witns = Pretty.block (Pretty.str "witnesses:" :: Pretty.brk 1 ::
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   543
          Pretty.breaks (map (Element.pretty_witness ctxt) witns))
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   544
    fun prt_reg (ts, (((_, ""), []), _, witns, eqns)) =
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
   545
        if show_wits
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   546
          then Pretty.block (prt_core ts eqns @ [Pretty.fbrk, prt_witns witns])
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   547
          else Pretty.block (prt_core ts eqns)
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   548
      | prt_reg (ts, (attn, _, witns, eqns)) =
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
   549
        if show_wits
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   550
          then Pretty.block ((prt_attn attn @ [Pretty.str ":", Pretty.brk 1] @
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   551
            prt_core ts eqns @ [Pretty.fbrk, prt_witns witns]))
17096
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
   552
          else Pretty.block ((prt_attn attn @
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
   553
            [Pretty.str ":", Pretty.brk 1] @ prt_core ts eqns));
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
   554
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
   555
    val loc_int = intern thy loc;
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   556
    val regs = RegistrationsData.get (Context.Proof ctxt);
17412
e26cb20ef0cc TableFun/Symtab: curried lookup and update;
wenzelm
parents: 17384
diff changeset
   557
    val loc_regs = Symtab.lookup regs loc_int;
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   558
  in
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   559
    (case loc_regs of
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   560
        NONE => Pretty.str ("no interpretations")
15763
b901a127ac73 Interpretation supports statically scoped attributes; documentation.
ballarin
parents: 15749
diff changeset
   561
      | SOME r => let
20069
77a6b62418bb Witness theorems of interpretations now transfered to current theory.
ballarin
parents: 20059
diff changeset
   562
            val r' = Registrations.dest thy r;
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
   563
            val r'' = Library.sort_wrt (fn (_, (((_, prfx), _), _, _, _)) => prfx) r';
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
   564
          in Pretty.big_list ("interpretations:") (map prt_reg r'') end)
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   565
    |> Pretty.writeln
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   566
  end;
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   567
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   568
12277
2b28d7dd91f5 improved ordering of evaluated elements;
wenzelm
parents: 12273
diff changeset
   569
(* diagnostics *)
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   570
12277
2b28d7dd91f5 improved ordering of evaluated elements;
wenzelm
parents: 12273
diff changeset
   571
fun err_in_locale ctxt msg ids =
2b28d7dd91f5 improved ordering of evaluated elements;
wenzelm
parents: 12273
diff changeset
   572
  let
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
   573
    val thy = ProofContext.theory_of ctxt;
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   574
    fun prt_id (name, parms) =
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
   575
      [Pretty.block (Pretty.breaks (map Pretty.str (extern thy name :: parms)))];
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   576
    val prt_ids = flat (separate [Pretty.str " +", Pretty.brk 1] (map prt_id ids));
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   577
    val err_msg =
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   578
      if forall (equal "" o #1) ids then msg
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   579
      else msg ^ "\n" ^ Pretty.string_of (Pretty.block
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   580
        (Pretty.str "The error(s) above occurred in locale:" :: Pretty.brk 1 :: prt_ids));
18678
dd0c569fa43d sane ERROR handling;
wenzelm
parents: 18671
diff changeset
   581
  in error err_msg end;
12063
4c16bdee47d4 added add_locale(_i) and store_thm;
wenzelm
parents: 12058
diff changeset
   582
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   583
fun err_in_locale' ctxt msg ids' = err_in_locale ctxt msg (map fst ids');
12277
2b28d7dd91f5 improved ordering of evaluated elements;
wenzelm
parents: 12273
diff changeset
   584
2b28d7dd91f5 improved ordering of evaluated elements;
wenzelm
parents: 12273
diff changeset
   585
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   586
fun pretty_ren NONE = Pretty.str "_"
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   587
  | pretty_ren (SOME (x, NONE)) = Pretty.str x
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   588
  | pretty_ren (SOME (x, SOME syn)) =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   589
      Pretty.block [Pretty.str x, Pretty.brk 1, Syntax.pretty_mixfix syn];
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   590
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   591
fun pretty_expr thy (Locale name) = Pretty.str (extern thy name)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   592
  | pretty_expr thy (Rename (expr, xs)) =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   593
      Pretty.block [pretty_expr thy expr, Pretty.brk 1, Pretty.block (map pretty_ren xs |> Pretty.breaks)]
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   594
  | pretty_expr thy (Merge es) =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   595
      Pretty.separate "+" (map (pretty_expr thy) es) |> Pretty.block;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   596
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   597
fun err_in_expr _ msg (Merge []) = error msg
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   598
  | err_in_expr ctxt msg expr =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   599
    error (msg ^ "\n" ^ Pretty.string_of (Pretty.block
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   600
      [Pretty.str "The error(s) above occured in locale expression:", Pretty.brk 1,
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   601
       pretty_expr (ProofContext.theory_of ctxt) expr]));
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   602
12046
a404358fd965 locale elements;
wenzelm
parents: 12014
diff changeset
   603
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   604
(** structured contexts: rename + merge + implicit type instantiation **)
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   605
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   606
(* parameter types *)
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   607
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   608
fun frozen_tvars ctxt Ts =
19914
fde2b5c0b42b Variable.importT_inst;
wenzelm
parents: 19900
diff changeset
   609
  #1 (Variable.importT_inst (map Logic.mk_type Ts) ctxt)
19900
21a99d88d925 ProofContext: moved variable operations to struct Variable;
wenzelm
parents: 19873
diff changeset
   610
  |> map (fn ((xi, S), T) => (xi, (S, T)));
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   611
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   612
fun unify_frozen ctxt maxidx Ts Us =
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   613
  let
18343
e36238ac5359 defines: beta/eta contract lhs;
wenzelm
parents: 18330
diff changeset
   614
    fun paramify NONE i = (NONE, i)
e36238ac5359 defines: beta/eta contract lhs;
wenzelm
parents: 18330
diff changeset
   615
      | paramify (SOME T) i = apfst SOME (TypeInfer.paramify_dummies T i);
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   616
18343
e36238ac5359 defines: beta/eta contract lhs;
wenzelm
parents: 18330
diff changeset
   617
    val (Ts', maxidx') = fold_map paramify Ts maxidx;
e36238ac5359 defines: beta/eta contract lhs;
wenzelm
parents: 18330
diff changeset
   618
    val (Us', maxidx'') = fold_map paramify Us maxidx';
16947
c6a90f04924e Sign.typ_unify;
wenzelm
parents: 16861
diff changeset
   619
    val thy = ProofContext.theory_of ctxt;
14215
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
   620
18190
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
   621
    fun unify (SOME T, SOME U) env = (Sign.typ_unify thy (U, T) env
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
   622
          handle Type.TUNIFY => raise TYPE ("unify_frozen: failed to unify types", [U, T], []))
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
   623
      | unify _ env = env;
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
   624
    val (unifier, _) = fold unify (Ts' ~~ Us') (Vartab.empty, maxidx'');
15570
8d8c70b41bab Move towards standard functions.
skalberg
parents: 15531
diff changeset
   625
    val Vs = map (Option.map (Envir.norm_type unifier)) Us';
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   626
    val unifier' = Vartab.extend (unifier, frozen_tvars ctxt (map_filter I Vs));
15570
8d8c70b41bab Move towards standard functions.
skalberg
parents: 15531
diff changeset
   627
  in map (Option.map (Envir.norm_type unifier')) Vs end;
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   628
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   629
fun params_of elemss =
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   630
  distinct (eq_fst (op = : string * string -> bool)) (maps (snd o fst) elemss);
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   631
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   632
fun params_of' elemss =
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   633
  distinct (eq_fst (op = : string * string -> bool)) (maps (snd o fst o fst) elemss);
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   634
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   635
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   636
fun params_prefix params = space_implode "_" params;
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
   637
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
   638
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
   639
(* CB: param_types has the following type:
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15456
diff changeset
   640
  ('a * 'b option) list -> ('a * 'b) list *)
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   641
fun param_types ps = map_filter (fn (_, NONE) => NONE | (x, SOME T) => SOME (x, T)) ps;
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   642
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   643
19932
63bd0eeb4e0d fixed sml/nj value restriction problem
haftmann
parents: 19931
diff changeset
   644
fun merge_syntax ctxt ids ss = Symtab.merge (op = : mixfix * mixfix -> bool) ss
23655
d2d1138e0ddc replaced exception TableFun/GraphFun.DUPS by TableFun/GraphFun.DUP;
wenzelm
parents: 23591
diff changeset
   645
  handle Symtab.DUP x => err_in_locale ctxt
d2d1138e0ddc replaced exception TableFun/GraphFun.DUPS by TableFun/GraphFun.DUP;
wenzelm
parents: 23591
diff changeset
   646
    ("Conflicting syntax for parameter: " ^ quote x) (map fst ids);
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
   647
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
   648
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   649
(* Distinction of assumed vs. derived identifiers.
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   650
   The former may have axioms relating assumptions of the context to
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   651
   assumptions of the specification fragment (for locales with
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
   652
   predicates).  The latter have witnesses relating assumptions of the
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   653
   specification fragment to assumptions of other (assumed) specification
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   654
   fragments. *)
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   655
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   656
datatype 'a mode = Assumed of 'a | Derived of 'a;
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   657
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   658
fun map_mode f (Assumed x) = Assumed (f x)
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   659
  | map_mode f (Derived x) = Derived (f x);
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   660
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
   661
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   662
(* flatten expressions *)
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
   663
12510
172d18ec3b54 proper treatment of internal parameters;
wenzelm
parents: 12502
diff changeset
   664
local
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   665
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   666
fun unify_parms ctxt fixed_parms raw_parmss =
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   667
  let
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
   668
    val thy = ProofContext.theory_of ctxt;
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   669
    val maxidx = length raw_parmss;
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   670
    val idx_parmss = (0 upto maxidx - 1) ~~ raw_parmss;
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   671
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   672
    fun varify i = Term.map_type_tfree (fn (a, S) => TVar ((a, i), S));
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   673
    fun varify_parms (i, ps) = map (apsnd (varify i)) (param_types ps);
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   674
    val parms = fixed_parms @ maps varify_parms idx_parmss;
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   675
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   676
    fun unify T U envir = Sign.typ_unify thy (U, T) envir
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   677
      handle Type.TUNIFY =>
23418
c195f6f13769 balanced conjunctions;
wenzelm
parents: 23228
diff changeset
   678
        let
22339
0dc6b45e5662 more precise error message in parameter unification
schirmer
parents: 22300
diff changeset
   679
          val T' = Envir.norm_type (fst envir) T;
0dc6b45e5662 more precise error message in parameter unification
schirmer
parents: 22300
diff changeset
   680
          val U' = Envir.norm_type (fst envir) U;
23418
c195f6f13769 balanced conjunctions;
wenzelm
parents: 23228
diff changeset
   681
          val prt = Sign.string_of_typ thy;
22339
0dc6b45e5662 more precise error message in parameter unification
schirmer
parents: 22300
diff changeset
   682
        in
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   683
          raise TYPE ("unify_parms: failed to unify types " ^
22339
0dc6b45e5662 more precise error message in parameter unification
schirmer
parents: 22300
diff changeset
   684
            prt U' ^ " and " ^ prt T', [U', T'], [])
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   685
        end;
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   686
    fun unify_list (T :: Us) = fold (unify T) Us
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   687
      | unify_list [] = I;
18952
0388d0b0f3d5 TableFun: renamed xxx_multi to xxx_list;
wenzelm
parents: 18917
diff changeset
   688
    val (unifier, _) = fold unify_list (map #2 (Symtab.dest (Symtab.make_list parms)))
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   689
      (Vartab.empty, maxidx);
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   690
19061
ffbbac0261c9 removed distinct, renamed gen_distinct to distinct;
wenzelm
parents: 19025
diff changeset
   691
    val parms' = map (apsnd (Envir.norm_type unifier)) (distinct (eq_fst (op =)) parms);
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   692
    val unifier' = Vartab.extend (unifier, frozen_tvars ctxt (map #2 parms'));
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   693
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   694
    fun inst_parms (i, ps) =
23178
07ba6b58b3d2 simplified/unified list fold;
wenzelm
parents: 22846
diff changeset
   695
      List.foldr Term.add_typ_tfrees [] (map_filter snd ps)
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   696
      |> map_filter (fn (a, S) =>
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   697
          let val T = Envir.norm_type unifier' (TVar ((a, i), S))
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   698
          in if T = TFree (a, S) then NONE else SOME (a, T) end)
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   699
      |> Symtab.make;
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   700
  in map inst_parms idx_parmss end;
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   701
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   702
in
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   703
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   704
fun unify_elemss _ _ [] = []
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   705
  | unify_elemss _ [] [elems] = [elems]
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   706
  | unify_elemss ctxt fixed_parms elemss =
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   707
      let
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   708
        val thy = ProofContext.theory_of ctxt;
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   709
        val phis = unify_parms ctxt fixed_parms (map (snd o fst o fst) elemss)
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   710
          |> map (Element.instT_morphism thy);
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   711
        fun inst ((((name, ps), mode), elems), phi) =
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   712
          (((name, map (apsnd (Option.map (Morphism.typ phi))) ps),
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   713
              map_mode (map (Element.morph_witness phi)) mode),
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   714
            map (Element.morph_ctxt phi) elems);
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   715
      in map inst (elemss ~~ phis) end;
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   716
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   717
19810
dae765e552ce renamed Type.(un)varifyT to Logic.(un)varifyT;
wenzelm
parents: 19783
diff changeset
   718
fun renaming xs parms = zip_options parms xs
dae765e552ce renamed Type.(un)varifyT to Logic.(un)varifyT;
wenzelm
parents: 19783
diff changeset
   719
  handle Library.UnequalLengths =>
dae765e552ce renamed Type.(un)varifyT to Logic.(un)varifyT;
wenzelm
parents: 19783
diff changeset
   720
    error ("Too many arguments in renaming: " ^
dae765e552ce renamed Type.(un)varifyT to Logic.(un)varifyT;
wenzelm
parents: 19783
diff changeset
   721
      commas (map (fn NONE => "_" | SOME x => quote (fst x)) xs));
dae765e552ce renamed Type.(un)varifyT to Logic.(un)varifyT;
wenzelm
parents: 19783
diff changeset
   722
dae765e552ce renamed Type.(un)varifyT to Logic.(un)varifyT;
wenzelm
parents: 19783
diff changeset
   723
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   724
(* params_of_expr:
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   725
   Compute parameters (with types and syntax) of locale expression.
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   726
*)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   727
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   728
fun params_of_expr ctxt fixed_params expr (prev_parms, prev_types, prev_syn) =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   729
  let
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   730
    val thy = ProofContext.theory_of ctxt;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   731
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   732
    fun merge_tenvs fixed tenv1 tenv2 =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   733
        let
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   734
          val [env1, env2] = unify_parms ctxt fixed
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   735
                [tenv1 |> Symtab.dest |> map (apsnd SOME),
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   736
                 tenv2 |> Symtab.dest |> map (apsnd SOME)]
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   737
        in
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   738
          Symtab.merge (op =) (Symtab.map (Element.instT_type env1) tenv1,
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   739
            Symtab.map (Element.instT_type env2) tenv2)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   740
        end;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   741
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   742
    fun merge_syn expr syn1 syn2 =
19932
63bd0eeb4e0d fixed sml/nj value restriction problem
haftmann
parents: 19931
diff changeset
   743
        Symtab.merge (op = : mixfix * mixfix -> bool) (syn1, syn2)
23655
d2d1138e0ddc replaced exception TableFun/GraphFun.DUPS by TableFun/GraphFun.DUP;
wenzelm
parents: 23591
diff changeset
   744
        handle Symtab.DUP x => err_in_expr ctxt
d2d1138e0ddc replaced exception TableFun/GraphFun.DUPS by TableFun/GraphFun.DUP;
wenzelm
parents: 23591
diff changeset
   745
          ("Conflicting syntax for parameter: " ^ quote x) expr;
20366
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   746
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   747
    fun params_of (expr as Locale name) =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   748
          let
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   749
            val {imports, params, ...} = the_locale thy name;
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   750
            val parms = map (fst o fst) params;
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   751
            val (parms', types', syn') = params_of imports;
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   752
            val all_parms = merge_lists parms' parms;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   753
            val all_types = merge_tenvs [] types' (params |> map fst |> Symtab.make);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   754
            val all_syn = merge_syn expr syn' (params |> map (apfst fst) |> Symtab.make);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   755
          in (all_parms, all_types, all_syn) end
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   756
      | params_of (expr as Rename (e, xs)) =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   757
          let
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   758
            val (parms', types', syn') = params_of e;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   759
            val ren = renaming xs parms';
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   760
            (* renaming may reduce number of parameters *)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   761
            val new_parms = map (Element.rename ren) parms' |> distinct (op =);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   762
            val ren_syn = syn' |> Symtab.dest |> map (Element.rename_var ren);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   763
            val new_syn = fold (Symtab.insert (op =)) ren_syn Symtab.empty
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   764
                handle Symtab.DUP x =>
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   765
                  err_in_expr ctxt ("Conflicting syntax for parameter: " ^ quote x) expr;
22700
5a699d278cfa Thm.fold_terms;
wenzelm
parents: 22678
diff changeset
   766
            val syn_types = map (apsnd (fn mx =>
5a699d278cfa Thm.fold_terms;
wenzelm
parents: 22678
diff changeset
   767
                SOME (Type.freeze_type (#1 (TypeInfer.paramify_dummies (Syntax.mixfixT mx) 0)))))
5a699d278cfa Thm.fold_terms;
wenzelm
parents: 22678
diff changeset
   768
              (Symtab.dest new_syn);
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   769
            val ren_types = types' |> Symtab.dest |> map (apfst (Element.rename ren));
20366
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   770
            val (env :: _) = unify_parms ctxt []
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   771
                ((ren_types |> map (apsnd SOME)) :: map single syn_types);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   772
            val new_types = fold (Symtab.insert (op =))
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   773
                (map (apsnd (Element.instT_type env)) ren_types) Symtab.empty;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   774
          in (new_parms, new_types, new_syn) end
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   775
      | params_of (Merge es) =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   776
          fold (fn e => fn (parms, types, syn) =>
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   777
                   let
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   778
                     val (parms', types', syn') = params_of e
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   779
                   in
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   780
                     (merge_lists parms parms', merge_tenvs [] types types',
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   781
                      merge_syn e syn syn')
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   782
                   end)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   783
            es ([], Symtab.empty, Symtab.empty)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   784
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   785
      val (parms, types, syn) = params_of expr;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   786
    in
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   787
      (merge_lists prev_parms parms, merge_tenvs fixed_params prev_types types,
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   788
       merge_syn expr prev_syn syn)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   789
    end;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   790
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   791
fun make_params_ids params = [(("", params), ([], Assumed []))];
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   792
fun make_raw_params_elemss (params, tenv, syn) =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   793
    [((("", map (fn p => (p, Symtab.lookup tenv p)) params), Assumed []),
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   794
      Int [Fixes (map (fn p =>
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   795
        (p, Symtab.lookup tenv p, Symtab.lookup syn p |> the)) params)])];
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   796
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   797
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   798
(* flatten_expr:
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   799
   Extend list of identifiers by those new in locale expression expr.
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   800
   Compute corresponding list of lists of locale elements (one entry per
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   801
   identifier).
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   802
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   803
   Identifiers represent locale fragments and are in an extended form:
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   804
     ((name, ps), (ax_ps, axs))
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   805
   (name, ps) is the locale name with all its parameters.
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   806
   (ax_ps, axs) is the locale axioms with its parameters;
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   807
     axs are always taken from the top level of the locale hierarchy,
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   808
     hence axioms may contain additional parameters from later fragments:
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   809
     ps subset of ax_ps.  axs is either singleton or empty.
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   810
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   811
   Elements are enriched by identifier-like information:
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   812
     (((name, ax_ps), axs), elems)
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   813
   The parameters in ax_ps are the axiom parameters, but enriched by type
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   814
   info: now each entry is a pair of string and typ option.  Axioms are
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   815
   type-instantiated.
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   816
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   817
*)
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   818
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
   819
fun flatten_expr ctxt ((prev_idents, prev_syntax), expr) =
12014
035ab884b9e0 beginnings of new locales (not yet functional);
wenzelm
parents: 11896
diff changeset
   820
  let
035ab884b9e0 beginnings of new locales (not yet functional);
wenzelm
parents: 11896
diff changeset
   821
    val thy = ProofContext.theory_of ctxt;
12263
6f2acf10e2a2 locale expressions;
wenzelm
parents: 12143
diff changeset
   822
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   823
    fun rename_parms top ren ((name, ps), (parms, mode)) =
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   824
        ((name, map (Element.rename ren) ps),
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   825
         if top
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   826
         then (map (Element.rename ren) parms,
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   827
               map_mode (map (Element.morph_witness (Element.rename_morphism ren))) mode)
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
   828
         else (parms, mode));
12263
6f2acf10e2a2 locale expressions;
wenzelm
parents: 12143
diff changeset
   829
20167
fe5fd4fd4114 Strict dfs traversal of imported and registered identifiers.
ballarin
parents: 20092
diff changeset
   830
    (* add (name, ps) and its registrations, recursively; adjust hyps of witnesses *)
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   831
20167
fe5fd4fd4114 Strict dfs traversal of imported and registered identifiers.
ballarin
parents: 20092
diff changeset
   832
    fun add_with_regs ((name, pTs), mode) (wits, ids, visited) =
fe5fd4fd4114 Strict dfs traversal of imported and registered identifiers.
ballarin
parents: 20092
diff changeset
   833
        if member (fn (a, (b, _)) => a = b) visited (name, map #1 pTs)
fe5fd4fd4114 Strict dfs traversal of imported and registered identifiers.
ballarin
parents: 20092
diff changeset
   834
        then (wits, ids, visited)
fe5fd4fd4114 Strict dfs traversal of imported and registered identifiers.
ballarin
parents: 20092
diff changeset
   835
        else
20366
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   836
          let
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   837
            val {params, regs, ...} = the_locale thy name;
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   838
            val pTs' = map #1 params;
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   839
            val ren = map #1 pTs' ~~ map (fn (x, _) => (x, NONE)) pTs;
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   840
              (* dummy syntax, since required by rename *)
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   841
            val pTs'' = map (fn ((p, _), (_, T)) => (p, T)) (pTs ~~ pTs');
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   842
            val [env] = unify_parms ctxt pTs [map (apsnd SOME) pTs''];
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   843
              (* propagate parameter types, to keep them consistent *)
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   844
            val regs' = map (fn ((name, ps), wits) =>
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   845
                ((name, map (Element.rename ren) ps),
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   846
                 map (Element.transfer_witness thy) wits)) regs;
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   847
            val new_regs = regs';
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   848
            val new_ids = map fst new_regs;
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   849
            val new_idTs =
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   850
              map (apsnd (map (fn p => (p, (the o AList.lookup (op =) pTs) p)))) new_ids;
17096
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
   851
20366
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   852
            val new_wits = new_regs |> map (#2 #> map
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   853
              (Element.morph_witness
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   854
                (Element.instT_morphism thy env $>
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   855
                  Element.rename_morphism ren $>
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
   856
                  Element.satisfy_morphism wits)));
20366
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   857
            val new_ids' = map (fn (id, wits) =>
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   858
                (id, ([], Derived wits))) (new_ids ~~ new_wits);
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   859
            val new_idTs' = map (fn ((n, pTs), (_, ([], mode))) =>
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   860
                ((n, pTs), mode)) (new_idTs ~~ new_ids');
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   861
            val new_id = ((name, map #1 pTs), ([], mode));
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   862
            val (wits', ids', visited') = fold add_with_regs new_idTs'
20167
fe5fd4fd4114 Strict dfs traversal of imported and registered identifiers.
ballarin
parents: 20092
diff changeset
   863
              (wits @ flat new_wits, ids, visited @ [new_id]);
20366
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   864
          in
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   865
            (wits', ids' @ [new_id], visited')
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
   866
          end;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   867
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   868
    (* distribute top-level axioms over assumed ids *)
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   869
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   870
    fun axiomify all_ps ((name, parms), (_, Assumed _)) axioms =
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   871
        let
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   872
          val {elems, ...} = the_locale thy name;
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   873
          val ts = maps
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   874
            (fn (Assumes asms, _) => maps (map #1 o #2) asms
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   875
              | _ => [])
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   876
            elems;
19018
88b4979193d8 added abbreviations: activated by init, no expressions yet;
wenzelm
parents: 18964
diff changeset
   877
          val (axs1, axs2) = chop (length ts) axioms;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   878
        in (((name, parms), (all_ps, Assumed axs1)), axs2) end
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   879
      | axiomify all_ps (id, (_, Derived ths)) axioms =
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   880
          ((id, (all_ps, Derived ths)), axioms);
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   881
17096
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
   882
    (* identifiers of an expression *)
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
   883
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   884
    fun identify top (Locale name) =
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   885
    (* CB: ids_ax is a list of tuples of the form ((name, ps), axs),
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   886
       where name is a locale name, ps a list of parameter names and axs
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   887
       a list of axioms relating to the identifier, axs is empty unless
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   888
       identify at top level (top = true);
14215
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
   889
       parms is accumulated list of parameters *)
12289
ec2dafd0a6a9 clarified locale operations (rename, merge);
wenzelm
parents: 12277
diff changeset
   890
          let
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   891
            val {axiom, imports, params, ...} = the_locale thy name;
19278
4d762b77d319 Internal restructuring: local parameters.
ballarin
parents: 19276
diff changeset
   892
            val ps = map (#1 o #1) params;
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
   893
            val (ids', parms') = identify false imports;
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   894
                (* acyclic import dependencies *)
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   895
20167
fe5fd4fd4114 Strict dfs traversal of imported and registered identifiers.
ballarin
parents: 20092
diff changeset
   896
            val (_, ids'', _) = add_with_regs ((name, map #1 params), Assumed []) ([], ids', ids');
fe5fd4fd4114 Strict dfs traversal of imported and registered identifiers.
ballarin
parents: 20092
diff changeset
   897
            val ids_ax = if top then fst (fold_map (axiomify ps) ids'' axiom) else ids'';
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   898
            in (ids_ax, merge_lists parms' ps) end
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   899
      | identify top (Rename (e, xs)) =
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   900
          let
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   901
            val (ids', parms') = identify top e;
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
   902
            val ren = renaming xs parms'
18678
dd0c569fa43d sane ERROR handling;
wenzelm
parents: 18671
diff changeset
   903
              handle ERROR msg => err_in_locale' ctxt msg ids';
17096
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
   904
19061
ffbbac0261c9 removed distinct, renamed gen_distinct to distinct;
wenzelm
parents: 19025
diff changeset
   905
            val ids'' = distinct (eq_fst (op =)) (map (rename_parms top ren) ids');
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   906
            val parms'' = distinct (op =) (maps (#2 o #1) ids'');
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   907
          in (ids'', parms'') end
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   908
      | identify top (Merge es) =
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   909
          fold (fn e => fn (ids, parms) =>
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   910
                   let
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   911
                     val (ids', parms') = identify top e
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   912
                   in
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   913
                     (merge_alists ids ids', merge_lists parms parms')
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   914
                   end)
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   915
            es ([], []);
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   916
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   917
    fun inst_wit all_params (t, th) = let
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   918
         val {hyps, prop, ...} = Thm.rep_thm th;
16861
7446b4be013b tuned fold on terms;
wenzelm
parents: 16850
diff changeset
   919
         val ps = map (apsnd SOME) (fold Term.add_frees (prop :: hyps) []);
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
   920
         val [env] = unify_parms ctxt all_params [ps];
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   921
         val t' = Element.instT_term env t;
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
   922
         val th' = Element.instT_thm thy env th;
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
   923
       in (t', th') end;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   924
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   925
    fun eval all_params tenv syn ((name, params), (locale_params, mode)) =
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   926
      let
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   927
        val {params = ps_mx, elems = elems_stamped, ...} = the_locale thy name;
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   928
        val elems = map fst elems_stamped;
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   929
        val ps = map fst ps_mx;
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   930
        fun lookup_syn x = (case Symtab.lookup syn x of SOME Structure => NONE | opt => opt);
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   931
        val locale_params' = map (fn p => (p, Symtab.lookup tenv p |> the)) locale_params;
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   932
        val mode' = map_mode (map (Element.map_witness (inst_wit all_params))) mode;
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   933
        val ren = map fst ps ~~ map (fn p => (p, lookup_syn p)) params;
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   934
        val [env] = unify_parms ctxt all_params [map (apfst (Element.rename ren) o apsnd SOME) ps];
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
   935
        val elem_morphism =
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
   936
          Element.rename_morphism ren $>
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
   937
          Morphism.name_morphism (NameSpace.qualified (params_prefix params)) $>
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
   938
          Element.instT_morphism thy env;
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
   939
        val elems' = map (Element.morph_ctxt elem_morphism) elems;
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
   940
      in (((name, map (apsnd SOME) locale_params'), mode'), elems') end;
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   941
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   942
    (* parameters, their types and syntax *)
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   943
    val (all_params', tenv, syn) = params_of_expr ctxt [] expr ([], Symtab.empty, Symtab.empty);
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   944
    val all_params = map (fn p => (p, Symtab.lookup tenv p |> the)) all_params';
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   945
    (* compute identifiers and syntax, merge with previous ones *)
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   946
    val (ids, _) = identify true expr;
20951
868120282837 gen_rem(s) abandoned in favour of remove / subtract
haftmann
parents: 20911
diff changeset
   947
    val idents = subtract (eq_fst (op =)) prev_idents ids;
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   948
    val syntax = merge_syntax ctxt ids (syn, prev_syntax);
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   949
    (* type-instantiate elements *)
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
   950
    val final_elemss = map (eval all_params tenv syntax) idents;
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
   951
  in ((prev_idents @ idents, syntax), final_elemss) end;
12046
a404358fd965 locale elements;
wenzelm
parents: 12014
diff changeset
   952
12510
172d18ec3b54 proper treatment of internal parameters;
wenzelm
parents: 12502
diff changeset
   953
end;
172d18ec3b54 proper treatment of internal parameters;
wenzelm
parents: 12502
diff changeset
   954
12070
c72fe1edc9e7 proper treatment of local syntax;
wenzelm
parents: 12063
diff changeset
   955
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
   956
(* activate elements *)
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
   957
12510
172d18ec3b54 proper treatment of internal parameters;
wenzelm
parents: 12502
diff changeset
   958
local
172d18ec3b54 proper treatment of internal parameters;
wenzelm
parents: 12502
diff changeset
   959
21686
4f5f6c685ab4 export: added explicit term operation;
wenzelm
parents: 21665
diff changeset
   960
fun axioms_export axs _ As =
4f5f6c685ab4 export: added explicit term operation;
wenzelm
parents: 21665
diff changeset
   961
  (Element.satisfy_thm axs #> Drule.implies_intr_list (Library.drop (length axs, As)), fn t => t);
12263
6f2acf10e2a2 locale expressions;
wenzelm
parents: 12143
diff changeset
   962
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   963
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   964
(* NB: derived ids contain only facts at this stage *)
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   965
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   966
fun activate_elem _ _ ((ctxt, mode), Fixes fixes) =
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
   967
      ((ctxt |> ProofContext.add_fixes_i fixes |> snd, mode), [])
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   968
  | activate_elem _ _ ((ctxt, mode), Constrains _) =
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   969
      ((ctxt, mode), [])
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   970
  | activate_elem ax_in_ctxt _ ((ctxt, Assumed axs), Assumes asms) =
13399
c136276dc847 support locale ``views'' (for cumulative predicates);
wenzelm
parents: 13394
diff changeset
   971
      let
18728
6790126ab5f6 simplified type attribute;
wenzelm
parents: 18708
diff changeset
   972
        val asms' = Attrib.map_specs (Attrib.attribute_i (ProofContext.theory_of ctxt)) asms;
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
   973
        val ts = maps (map #1 o #2) asms';
19018
88b4979193d8 added abbreviations: activated by init, no expressions yet;
wenzelm
parents: 18964
diff changeset
   974
        val (ps, qs) = chop (length ts) axs;
17856
0551978bfda5 goal statements: accomodate before_qed argument;
wenzelm
parents: 17756
diff changeset
   975
        val (_, ctxt') =
21370
d9dd7b4e5e69 replaced Variable.fix_frees by Variable.auto_fixes (depends on body mode);
wenzelm
parents: 21361
diff changeset
   976
          ctxt |> fold Variable.auto_fixes ts
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   977
          |> ProofContext.add_assms_i (axioms_export (if ax_in_ctxt then ps else [])) asms';
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   978
      in ((ctxt', Assumed qs), []) end
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   979
  | activate_elem _ _ ((ctxt, Derived ths), Assumes asms) =
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   980
      ((ctxt, Derived ths), [])
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   981
  | activate_elem _ _ ((ctxt, Assumed axs), Defines defs) =
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   982
      let
18728
6790126ab5f6 simplified type attribute;
wenzelm
parents: 18708
diff changeset
   983
        val defs' = Attrib.map_specs (Attrib.attribute_i (ProofContext.theory_of ctxt)) defs;
19732
1c37d117a25d activate Defines: fix frees;
wenzelm
parents: 19662
diff changeset
   984
        val asms = defs' |> map (fn ((name, atts), (t, ps)) =>
1c37d117a25d activate Defines: fix frees;
wenzelm
parents: 19662
diff changeset
   985
            let val ((c, _), t') = LocalDefs.cert_def ctxt t
20872
wenzelm
parents: 20664
diff changeset
   986
            in (t', ((Thm.def_name_optional c name, atts), [(t', ps)])) end);
17856
0551978bfda5 goal statements: accomodate before_qed argument;
wenzelm
parents: 17756
diff changeset
   987
        val (_, ctxt') =
21370
d9dd7b4e5e69 replaced Variable.fix_frees by Variable.auto_fixes (depends on body mode);
wenzelm
parents: 21361
diff changeset
   988
          ctxt |> fold (Variable.auto_fixes o #1) asms
19732
1c37d117a25d activate Defines: fix frees;
wenzelm
parents: 19662
diff changeset
   989
          |> ProofContext.add_assms_i LocalDefs.def_export (map #2 asms);
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   990
      in ((ctxt', Assumed axs), []) end
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   991
  | activate_elem _ _ ((ctxt, Derived ths), Defines defs) =
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   992
      ((ctxt, Derived ths), [])
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
   993
  | activate_elem _ is_ext ((ctxt, mode), Notes (kind, facts)) =
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
   994
      let
18728
6790126ab5f6 simplified type attribute;
wenzelm
parents: 18708
diff changeset
   995
        val facts' = Attrib.map_facts (Attrib.attribute_i (ProofContext.theory_of ctxt)) facts;
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
   996
        val (res, ctxt') = ctxt |> ProofContext.note_thmss_i kind facts';
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
   997
      in ((ctxt', mode), if is_ext then res else []) end;
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
   998
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
   999
fun activate_elems ax_in_ctxt (((name, ps), mode), elems) ctxt =
17033
f4c1ce91aa3c Release of interpretation in locale.
ballarin
parents: 17000
diff changeset
  1000
  let
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  1001
    val thy = ProofContext.theory_of ctxt;
17033
f4c1ce91aa3c Release of interpretation in locale.
ballarin
parents: 17000
diff changeset
  1002
    val ((ctxt', _), res) =
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1003
      foldl_map (activate_elem ax_in_ctxt (name = ""))
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1004
        ((ProofContext.qualified_names ctxt, mode), elems)
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1005
      handle ERROR msg => err_in_locale ctxt msg [(name, map fst ps)];
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1006
    val ctxt'' = if name = "" then ctxt'
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1007
          else let
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1008
              val ps' = map (fn (n, SOME T) => Free (n, T)) ps;
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  1009
            in if test_local_registration ctxt' (name, ps') then ctxt'
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  1010
              else let
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1011
                  val ctxt'' = put_local_registration (name, ps') ((true, ""), [])
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1012
                    (Morphism.identity, ((Vartab.empty, []), (Vartab.empty, []) )) ctxt'
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  1013
                in case mode of
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  1014
                    Assumed axs =>
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  1015
                      fold (add_local_witness (name, ps') o
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  1016
                        Element.assume_witness thy o Element.witness_prop) axs ctxt''
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  1017
                  | Derived ths => fold (add_local_witness (name, ps')) ths ctxt''
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  1018
                end
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1019
            end
16144
e339119f4261 renamed cond_extern to extern;
wenzelm
parents: 16105
diff changeset
  1020
  in (ProofContext.restore_naming ctxt ctxt'', res) end;
13399
c136276dc847 support locale ``views'' (for cumulative predicates);
wenzelm
parents: 13394
diff changeset
  1021
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1022
fun activate_elemss ax_in_ctxt prep_facts =
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1023
    fold_map (fn (((name, ps), mode), raw_elems) => fn ctxt =>
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1024
      let
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1025
        val elems = map (prep_facts ctxt) raw_elems;
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  1026
        val (ctxt', res) = apsnd flat
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1027
            (activate_elems ax_in_ctxt (((name, ps), mode), elems) ctxt);
21530
9e2ff9d4b2b0 Element.map_ctxt_attrib;
wenzelm
parents: 21523
diff changeset
  1028
        val elems' = elems |> map (Element.map_ctxt_attrib Args.closure);
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1029
      in (((((name, ps), mode), elems'), res), ctxt') end);
12834
e5bec3268932 added locale_facts(_i) interface (useful for simple ML proof tools);
wenzelm
parents: 12806
diff changeset
  1030
12546
wenzelm
parents: 12532
diff changeset
  1031
in
wenzelm
parents: 12532
diff changeset
  1032
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1033
(* CB: activate_facts prep_facts (ctxt, elemss),
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1034
   where elemss is a list of pairs consisting of identifiers and
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1035
   context elements, extends ctxt by the context elements yielding
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1036
   ctxt' and returns (ctxt', (elemss', facts)).
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1037
   Identifiers in the argument are of the form ((name, ps), axs) and
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1038
   assumptions use the axioms in the identifiers to set up exporters
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1039
   in ctxt'.  elemss' does not contain identifiers and is obtained
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1040
   from elemss and the intermediate context with prep_facts.
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
  1041
   If read_facts or cert_facts is used for prep_facts, these also remove
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1042
   the internal/external markers from elemss. *)
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1043
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1044
fun activate_facts ax_in_ctxt prep_facts (ctxt, args) =
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1045
  let val ((elemss, factss), ctxt') = activate_elemss ax_in_ctxt prep_facts args ctxt |>> split_list
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  1046
  in (ctxt', (elemss, flat factss)) end;
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
  1047
12510
172d18ec3b54 proper treatment of internal parameters;
wenzelm
parents: 12502
diff changeset
  1048
end;
172d18ec3b54 proper treatment of internal parameters;
wenzelm
parents: 12502
diff changeset
  1049
12307
459aa05af6be qualify imported facts;
wenzelm
parents: 12289
diff changeset
  1050
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1051
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1052
(** prepare locale elements **)
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1053
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1054
(* expressions *)
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1055
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1056
fun intern_expr thy (Locale xname) = Locale (intern thy xname)
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1057
  | intern_expr thy (Merge exprs) = Merge (map (intern_expr thy) exprs)
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1058
  | intern_expr thy (Rename (expr, xs)) = Rename (intern_expr thy expr, xs);
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1059
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1060
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1061
(* propositions and bindings *)
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1062
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1063
(* flatten (ctxt, prep_expr) ((ids, syn), expr)
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1064
   normalises expr (which is either a locale
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1065
   expression or a single context element) wrt.
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1066
   to the list ids of already accumulated identifiers.
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1067
   It returns ((ids', syn'), elemss) where ids' is an extension of ids
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1068
   with identifiers generated for expr, and elemss is the list of
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1069
   context elements generated from expr.
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1070
   syn and syn' are symtabs mapping parameter names to their syntax.  syn'
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1071
   is an extension of syn.
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1072
   For details, see flatten_expr.
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1073
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1074
   Additionally, for a locale expression, the elems are grouped into a single
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1075
   Int; individual context elements are marked Ext.  In this case, the
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1076
   identifier-like information of the element is as follows:
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1077
   - for Fixes: (("", ps), []) where the ps have type info NONE
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1078
   - for other elements: (("", []), []).
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1079
   The implementation of activate_facts relies on identifier names being
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1080
   empty strings for external elements.
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1081
*)
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1082
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1083
fun flatten (ctxt, _) ((ids, syn), Elem (Fixes fixes)) = let
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1084
        val ids' = ids @ [(("", map #1 fixes), ([], Assumed []))]
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1085
      in
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1086
        ((ids',
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1087
         merge_syntax ctxt ids'
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1088
           (syn, Symtab.make (map (fn fx => (#1 fx, #3 fx)) fixes))
23655
d2d1138e0ddc replaced exception TableFun/GraphFun.DUPS by TableFun/GraphFun.DUP;
wenzelm
parents: 23591
diff changeset
  1089
           handle Symtab.DUP x => err_in_locale ctxt
d2d1138e0ddc replaced exception TableFun/GraphFun.DUPS by TableFun/GraphFun.DUP;
wenzelm
parents: 23591
diff changeset
  1090
             ("Conflicting syntax for parameter: " ^ quote x)
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1091
             (map #1 ids')),
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1092
         [((("", map (rpair NONE o #1) fixes), Assumed []), Ext (Fixes fixes))])
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1093
      end
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1094
  | flatten _ ((ids, syn), Elem elem) =
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1095
      ((ids @ [(("", []), ([], Assumed []))], syn), [((("", []), Assumed []), Ext elem)])
16102
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1096
  | flatten (ctxt, prep_expr) ((ids, syn), Expr expr) =
c5f6726d9bb1 Locale expressions: rename with optional mixfix syntax.
ballarin
parents: 16028
diff changeset
  1097
      apsnd (map (apsnd Int)) (flatten_expr ctxt ((ids, syn), prep_expr expr));
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1098
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1099
local
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1100
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1101
local
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1102
12727
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1103
fun declare_int_elem (ctxt, Fixes fixes) =
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1104
      (ctxt |> ProofContext.add_fixes_i (map (fn (x, T, mx) =>
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1105
        (x, Option.map (Term.map_type_tfree (TypeInfer.param 0)) T, mx)) fixes) |> snd, [])
12727
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1106
  | declare_int_elem (ctxt, _) = (ctxt, []);
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1107
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1108
fun declare_ext_elem prep_vars (ctxt, Fixes fixes) =
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1109
      let val (vars, _) = prep_vars fixes ctxt
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1110
      in (ctxt |> ProofContext.add_fixes_i vars |> snd, []) end
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1111
  | declare_ext_elem prep_vars (ctxt, Constrains csts) =
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1112
      let val (_, ctxt') = prep_vars (map (fn (x, T) => (x, SOME T, NoSyn)) csts) ctxt
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1113
      in (ctxt', []) end
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1114
  | declare_ext_elem _ (ctxt, Assumes asms) = (ctxt, map #2 asms)
19585
70a1ce3b23ae removed 'concl is' patterns;
wenzelm
parents: 19482
diff changeset
  1115
  | declare_ext_elem _ (ctxt, Defines defs) = (ctxt, map (fn (_, (t, ps)) => [(t, ps)]) defs)
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1116
  | declare_ext_elem _ (ctxt, Notes _) = (ctxt, []);
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1117
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1118
fun declare_elems prep_vars (ctxt, (((name, ps), Assumed _), elems)) =
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1119
    let val (ctxt', propps) =
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1120
      (case elems of
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1121
        Int es => foldl_map declare_int_elem (ctxt, es)
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1122
      | Ext e => foldl_map (declare_ext_elem prep_vars) (ctxt, [e]))
18678
dd0c569fa43d sane ERROR handling;
wenzelm
parents: 18671
diff changeset
  1123
      handle ERROR msg => err_in_locale ctxt msg [(name, map fst ps)]
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1124
    in (ctxt', propps) end
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1125
  | declare_elems _ (ctxt, ((_, Derived _), elems)) = (ctxt, []);
12727
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1126
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1127
in
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1128
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1129
fun declare_elemss prep_vars fixed_params raw_elemss ctxt =
12727
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1130
  let
14215
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
  1131
    (* CB: fix of type bug of goal in target with context elements.
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
  1132
       Parameters new in context elements must receive types that are
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
  1133
       distinct from types of parameters in target (fixed_params).  *)
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
  1134
    val ctxt_with_fixed =
19900
21a99d88d925 ProofContext: moved variable operations to struct Variable;
wenzelm
parents: 19873
diff changeset
  1135
      fold Variable.declare_term (map Free fixed_params) ctxt;
12727
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1136
    val int_elemss =
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1137
      raw_elemss
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  1138
      |> map_filter (fn (id, Int es) => SOME (id, es) | _ => NONE)
14215
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
  1139
      |> unify_elemss ctxt_with_fixed fixed_params;
12727
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1140
    val (_, raw_elemss') =
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1141
      foldl_map (fn ((_, es) :: elemss, (id, Int _)) => (elemss, (id, Int es)) | x => x)
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1142
        (int_elemss, raw_elemss);
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1143
  in foldl_map (declare_elems prep_vars) (ctxt, raw_elemss') end;
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1144
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1145
end;
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1146
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1147
local
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1148
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1149
val norm_term = Envir.beta_norm oo Term.subst_atomic;
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1150
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1151
fun abstract_thm thy eq =
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1152
  Thm.assume (Thm.cterm_of thy eq) |> Drule.gen_all |> Drule.abs_def;
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
  1153
18190
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1154
fun bind_def ctxt (name, ps) eq (xs, env, ths) =
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1155
  let
18831
f1315d118059 LocalDefs;
wenzelm
parents: 18806
diff changeset
  1156
    val ((y, T), b) = LocalDefs.abs_def eq;
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1157
    val b' = norm_term env b;
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1158
    val th = abstract_thm (ProofContext.theory_of ctxt) eq;
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1159
    fun err msg = err_in_locale ctxt (msg ^ ": " ^ quote y) [(name, map fst ps)];
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1160
  in
21962
279b129498b6 removed conditional combinator;
wenzelm
parents: 21708
diff changeset
  1161
    exists (equal y o #1) xs andalso
279b129498b6 removed conditional combinator;
wenzelm
parents: 21708
diff changeset
  1162
      err "Attempt to define previously specified variable";
279b129498b6 removed conditional combinator;
wenzelm
parents: 21708
diff changeset
  1163
    exists (fn (Free (y', _), _) => y = y' | _ => false) env andalso
279b129498b6 removed conditional combinator;
wenzelm
parents: 21708
diff changeset
  1164
      err "Attempt to redefine variable";
16861
7446b4be013b tuned fold on terms;
wenzelm
parents: 16850
diff changeset
  1165
    (Term.add_frees b' xs, (Free (y, T), b') :: env, th :: ths)
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1166
  end;
12575
34985eee55b1 fixed inst_thm: proper domain of env;
wenzelm
parents: 12546
diff changeset
  1167
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1168
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1169
(* CB: for finish_elems (Int and Ext),
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1170
   extracts specification, only of assumed elements *)
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1171
18190
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1172
fun eval_text _ _ _ (Fixes _) text = text
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1173
  | eval_text _ _ _ (Constrains _) text = text
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1174
  | eval_text _ (_, Assumed _) is_ext (Assumes asms)
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1175
        (((exts, exts'), (ints, ints')), (xs, env, defs)) =
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1176
      let
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  1177
        val ts = maps (map #1 o #2) asms;
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1178
        val ts' = map (norm_term env) ts;
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1179
        val spec' =
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1180
          if is_ext then ((exts @ ts, exts' @ ts'), (ints, ints'))
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1181
          else ((exts, exts'), (ints @ ts, ints' @ ts'));
16861
7446b4be013b tuned fold on terms;
wenzelm
parents: 16850
diff changeset
  1182
      in (spec', (fold Term.add_frees ts' xs, env, defs)) end
18190
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1183
  | eval_text _ (_, Derived _) _ (Assumes _) text = text
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1184
  | eval_text ctxt (id, Assumed _) _ (Defines defs) (spec, binds) =
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1185
      (spec, fold (bind_def ctxt id o #1 o #2) defs binds)
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1186
  | eval_text _ (_, Derived _) _ (Defines _) text = text
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1187
  | eval_text _ _ _ (Notes _) text = text;
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1188
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1189
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1190
(* for finish_elems (Int),
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1191
   remove redundant elements of derived identifiers,
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1192
   turn assumptions and definitions into facts,
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1193
   satisfy hypotheses of facts *)
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1194
17096
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
  1195
fun finish_derived _ _ (Assumed _) (Fixes fixes) = SOME (Fixes fixes)
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
  1196
  | finish_derived _ _ (Assumed _) (Constrains csts) = SOME (Constrains csts)
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
  1197
  | finish_derived _ _ (Assumed _) (Assumes asms) = SOME (Assumes asms)
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
  1198
  | finish_derived _ _ (Assumed _) (Defines defs) = SOME (Defines defs)
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
  1199
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1200
  | finish_derived _ _ (Derived _) (Fixes _) = NONE
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1201
  | finish_derived _ _ (Derived _) (Constrains _) = NONE
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1202
  | finish_derived sign satisfy (Derived _) (Assumes asms) = asms
17096
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
  1203
      |> map (apsnd (map (fn (a, _) => ([Thm.assume (cterm_of sign a)], []))))
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1204
      |> pair Thm.assumptionK |> Notes
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1205
      |> Element.morph_ctxt satisfy |> SOME
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1206
  | finish_derived sign satisfy (Derived _) (Defines defs) = defs
17096
8327b71282ce Improved generation of witnesses in interpretation.
ballarin
parents: 17033
diff changeset
  1207
      |> map (apsnd (fn (d, _) => [([Thm.assume (cterm_of sign d)], [])]))
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1208
      |> pair Thm.definitionK |> Notes
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1209
      |> Element.morph_ctxt satisfy |> SOME
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1210
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1211
  | finish_derived _ satisfy _ (Notes facts) = Notes facts
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1212
      |> Element.morph_ctxt satisfy |> SOME;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1213
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1214
(* CB: for finish_elems (Ext) *)
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1215
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1216
fun closeup _ false elem = elem
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1217
  | closeup ctxt true elem =
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1218
      let
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1219
        fun close_frees t =
19900
21a99d88d925 ProofContext: moved variable operations to struct Variable;
wenzelm
parents: 19873
diff changeset
  1220
          let val frees = rev (filter_out (Variable.is_fixed ctxt o #1) (Term.add_frees t []))
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1221
          in Term.list_all_free (frees, t) end;
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1222
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1223
        fun no_binds [] = []
18678
dd0c569fa43d sane ERROR handling;
wenzelm
parents: 18671
diff changeset
  1224
          | no_binds _ = error "Illegal term bindings in locale element";
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1225
      in
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1226
        (case elem of
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1227
          Assumes asms => Assumes (asms |> map (fn (a, propps) =>
19585
70a1ce3b23ae removed 'concl is' patterns;
wenzelm
parents: 19482
diff changeset
  1228
            (a, map (fn (t, ps) => (close_frees t, no_binds ps)) propps)))
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1229
        | Defines defs => Defines (defs |> map (fn (a, (t, ps)) =>
18831
f1315d118059 LocalDefs;
wenzelm
parents: 18806
diff changeset
  1230
            (a, (close_frees (#2 (LocalDefs.cert_def ctxt t)), no_binds ps))))
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1231
        | e => e)
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1232
      end;
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1233
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
  1234
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1235
fun finish_ext_elem parms _ (Fixes fixes, _) = Fixes (map (fn (x, _, mx) =>
17271
2756a73f63a5 introduced some new-style AList operations
haftmann
parents: 17257
diff changeset
  1236
      (x, AList.lookup (op =) parms x, mx)) fixes)
18899
a8e913c93578 theorem(_in_locale): Element.statement, Obtain.statement;
wenzelm
parents: 18890
diff changeset
  1237
  | finish_ext_elem parms _ (Constrains _, _) = Constrains []
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1238
  | finish_ext_elem _ close (Assumes asms, propp) =
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1239
      close (Assumes (map #1 asms ~~ propp))
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1240
  | finish_ext_elem _ close (Defines defs, propp) =
19585
70a1ce3b23ae removed 'concl is' patterns;
wenzelm
parents: 19482
diff changeset
  1241
      close (Defines (map #1 defs ~~ map (fn [(t, ps)] => (t, ps)) propp))
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1242
  | finish_ext_elem _ _ (Notes facts, _) = Notes facts;
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1243
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1244
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1245
(* CB: finish_parms introduces type info from parms to identifiers *)
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15456
diff changeset
  1246
(* CB: only needed for types that have been NONE so far???
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1247
   If so, which are these??? *)
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1248
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1249
fun finish_parms parms (((name, ps), mode), elems) =
19932
63bd0eeb4e0d fixed sml/nj value restriction problem
haftmann
parents: 19931
diff changeset
  1250
  (((name, map (fn (x, _) => (x, AList.lookup (op = : string * string -> bool) parms x)) ps), mode), elems);
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1251
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1252
fun finish_elems ctxt parms _ ((text, wits), ((id, Int e), _)) =
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1253
      let
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1254
        val [(id' as (_, mode), es)] = unify_elemss ctxt parms [(id, e)];
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1255
        val wits' = case mode of Assumed _ => wits | Derived ths => wits @ ths;
18190
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1256
        val text' = fold (eval_text ctxt id' false) es text;
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  1257
        val es' = map_filter
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1258
          (finish_derived (ProofContext.theory_of ctxt) (Element.satisfy_morphism wits') mode) es;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1259
      in ((text', wits'), (id', map Int es')) end
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1260
  | finish_elems ctxt parms do_close ((text, wits), ((id, Ext e), [propp])) =
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1261
      let
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1262
        val e' = finish_ext_elem parms (closeup ctxt do_close) (e, propp);
18190
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1263
        val text' = eval_text ctxt id true e' text;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1264
      in ((text', wits), (id, [Ext e'])) end
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1265
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1266
in
12510
172d18ec3b54 proper treatment of internal parameters;
wenzelm
parents: 12502
diff changeset
  1267
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1268
(* CB: only called by prep_elemss *)
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1269
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1270
fun finish_elemss ctxt parms do_close =
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1271
  foldl_map (apsnd (finish_parms parms) o finish_elems ctxt parms do_close);
12839
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1272
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1273
end;
584a3e0b00f2 reorganized code for predicate text;
wenzelm
parents: 12834
diff changeset
  1274
16736
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
  1275
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1276
(* Remove duplicate Defines elements: temporary workaround to fix Afp/Category. *)
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1277
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1278
fun defs_ord (defs1, defs2) =
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1279
    list_ord (fn ((_, (d1, _)), (_, (d2, _))) =>
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1280
      Term.fast_term_ord (d1, d2)) (defs1, defs2);
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1281
structure Defstab =
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1282
    TableFun(type key = ((string * Attrib.src list) * (term * term list)) list
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1283
        val ord = defs_ord);
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1284
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1285
fun rem_dup_defs es ds =
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1286
    fold_map (fn e as (Defines defs) => (fn ds =>
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1287
                 if Defstab.defined ds defs
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1288
                 then (Defines [], ds)
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1289
                 else (e, Defstab.update (defs, ()) ds))
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1290
               | e => (fn ds => (e, ds))) es ds;
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1291
fun rem_dup_elemss (Int es) ds = apfst Int (rem_dup_defs es ds)
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1292
  | rem_dup_elemss (Ext e) ds = (Ext e, ds);
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1293
fun rem_dup_defines raw_elemss =
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1294
    fold_map (fn (id as (_, (Assumed _)), es) => (fn ds =>
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1295
                     apfst (pair id) (rem_dup_elemss es ds))
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1296
               | (id as (_, (Derived _)), es) => (fn ds =>
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1297
                     ((id, es), ds))) raw_elemss Defstab.empty |> #1;
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1298
16736
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
  1299
(* CB: type inference and consistency checks for locales.
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
  1300
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
  1301
   Works by building a context (through declare_elemss), extracting the
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
  1302
   required information and adjusting the context elements (finish_elemss).
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
  1303
   Can also universally close free vars in assms and defs.  This is only
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1304
   needed for Ext elements and controlled by parameter do_close.
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1305
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1306
   Only elements of assumed identifiers are considered.
16736
1e792b32abef Preparations for interpretation of locales in locales.
ballarin
parents: 16620
diff changeset
  1307
*)
15127
2550a5578d39 Disallowed "includes" in locale declarations.
ballarin
parents: 15104
diff changeset
  1308
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1309
fun prep_elemss prep_vars prepp do_close context fixed_params raw_elemss raw_concl =
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1310
  let
15127
2550a5578d39 Disallowed "includes" in locale declarations.
ballarin
parents: 15104
diff changeset
  1311
    (* CB: contexts computed in the course of this function are discarded.
2550a5578d39 Disallowed "includes" in locale declarations.
ballarin
parents: 15104
diff changeset
  1312
       They are used for type inference and consistency checks only. *)
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1313
    (* CB: fixed_params are the parameters (with types) of the target locale,
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1314
       empty list if there is no target. *)
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1315
    (* CB: raw_elemss are list of pairs consisting of identifiers and
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1316
       context elements, the latter marked as internal or external. *)
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1317
    val raw_elemss = rem_dup_defines raw_elemss;
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1318
    val (raw_ctxt, raw_proppss) = declare_elemss prep_vars fixed_params raw_elemss context;
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1319
    (* CB: raw_ctxt is context with additional fixed variables derived from
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1320
       the fixes elements in raw_elemss,
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1321
       raw_proppss contains assumptions and definitions from the
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1322
       external elements in raw_elemss. *)
18550
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1323
    fun prep_prop raw_propp (raw_ctxt, raw_concl)  =
18450
e57731ba01dd discontinued unflat in favour of burrow and burrow_split
haftmann
parents: 18421
diff changeset
  1324
      let
e57731ba01dd discontinued unflat in favour of burrow and burrow_split
haftmann
parents: 18421
diff changeset
  1325
        (* CB: add type information from fixed_params to context (declare_term) *)
e57731ba01dd discontinued unflat in favour of burrow and burrow_split
haftmann
parents: 18421
diff changeset
  1326
        (* CB: process patterns (conclusion and external elements only) *)
e57731ba01dd discontinued unflat in favour of burrow and burrow_split
haftmann
parents: 18421
diff changeset
  1327
        val (ctxt, all_propp) =
19900
21a99d88d925 ProofContext: moved variable operations to struct Variable;
wenzelm
parents: 19873
diff changeset
  1328
          prepp (fold Variable.declare_term (map Free fixed_params) raw_ctxt, raw_concl @ raw_propp);
18450
e57731ba01dd discontinued unflat in favour of burrow and burrow_split
haftmann
parents: 18421
diff changeset
  1329
        (* CB: add type information from conclusion and external elements to context *)
19900
21a99d88d925 ProofContext: moved variable operations to struct Variable;
wenzelm
parents: 19873
diff changeset
  1330
        val ctxt = fold Variable.declare_term (maps (map fst) all_propp) ctxt;
18450
e57731ba01dd discontinued unflat in favour of burrow and burrow_split
haftmann
parents: 18421
diff changeset
  1331
        (* CB: resolve schematic variables (patterns) in conclusion and external elements. *)
e57731ba01dd discontinued unflat in favour of burrow and burrow_split
haftmann
parents: 18421
diff changeset
  1332
        val all_propp' = map2 (curry (op ~~))
e57731ba01dd discontinued unflat in favour of burrow and burrow_split
haftmann
parents: 18421
diff changeset
  1333
          (#1 (#2 (ProofContext.bind_propp_schematic_i (ctxt, all_propp)))) (map (map snd) all_propp);
19018
88b4979193d8 added abbreviations: activated by init, no expressions yet;
wenzelm
parents: 18964
diff changeset
  1334
        val (concl, propp) = chop (length raw_concl) all_propp';
18550
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1335
      in (propp, (ctxt, concl)) end
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1336
18550
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1337
    val (proppss, (ctxt, concl)) =
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1338
      (fold_burrow o fold_burrow) prep_prop raw_proppss (raw_ctxt, raw_concl);
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
  1339
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1340
    (* CB: obtain all parameters from identifier part of raw_elemss *)
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1341
    val xs = map #1 (params_of' raw_elemss);
12727
330cb92aaea3 unify_frozen: proper use of maxidx';
wenzelm
parents: 12711
diff changeset
  1342
    val typing = unify_frozen ctxt 0
19900
21a99d88d925 ProofContext: moved variable operations to struct Variable;
wenzelm
parents: 19873
diff changeset
  1343
      (map (Variable.default_type raw_ctxt) xs)
21a99d88d925 ProofContext: moved variable operations to struct Variable;
wenzelm
parents: 19873
diff changeset
  1344
      (map (Variable.default_type ctxt) xs);
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1345
    val parms = param_types (xs ~~ typing);
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1346
    (* CB: parms are the parameters from raw_elemss, with correct typing. *)
12273
7fb9840d358d beginnings of actual locale expressions;
wenzelm
parents: 12263
diff changeset
  1347
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1348
    (* CB: extract information from assumes and defines elements
16169
b59202511b8a Locales: new element constrains, parameter renaming with syntax,
ballarin
parents: 16144
diff changeset
  1349
       (fixes, constrains and notes in raw_elemss don't have an effect on
b59202511b8a Locales: new element constrains, parameter renaming with syntax,
ballarin
parents: 16144
diff changeset
  1350
       text and elemss), compute final form of context elements. *)
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1351
    val ((text, _), elemss) = finish_elemss ctxt parms do_close
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1352
      ((((([], []), ([], [])), ([], [], [])), []), raw_elemss ~~ proppss);
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1353
    (* CB: text has the following structure:
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1354
           (((exts, exts'), (ints, ints')), (xs, env, defs))
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1355
       where
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1356
         exts: external assumptions (terms in external assumes elements)
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1357
         exts': dito, normalised wrt. env
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1358
         ints: internal assumptions (terms in internal assumes elements)
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1359
         ints': dito, normalised wrt. env
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1360
         xs: the free variables in exts' and ints' and rhss of definitions,
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1361
           this includes parameters except defined parameters
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1362
         env: list of term pairs encoding substitutions, where the first term
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1363
           is a free variable; substitutions represent defines elements and
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1364
           the rhs is normalised wrt. the previous env
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1365
         defs: theorems representing the substitutions from defines elements
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1366
           (thms are normalised wrt. env).
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1367
       elemss is an updated version of raw_elemss:
16169
b59202511b8a Locales: new element constrains, parameter renaming with syntax,
ballarin
parents: 16144
diff changeset
  1368
         - type info added to Fixes and modified in Constrains
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1369
         - axiom and definition statement replaced by corresponding one
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1370
           from proppss in Assumes and Defines
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1371
         - Facts unchanged
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1372
       *)
13308
1dbed9ea764b clarified text content of locale body;
wenzelm
parents: 13297
diff changeset
  1373
  in ((parms, elemss, concl), text) end;
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
  1374
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
  1375
in
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
  1376
18671
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1377
fun read_elemss x = prep_elemss ProofContext.read_vars ProofContext.read_propp_schematic x;
621efeed255b uniform handling of fixes;
wenzelm
parents: 18617
diff changeset
  1378
fun cert_elemss x = prep_elemss ProofContext.cert_vars ProofContext.cert_propp_schematic x;
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1379
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1380
end;
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1381
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1382
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
  1383
(* facts and attributes *)
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1384
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1385
local
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1386
20965
75ffb934929d add_locale(_i): return actual result context;
wenzelm
parents: 20951
diff changeset
  1387
fun check_name name =
18678
dd0c569fa43d sane ERROR handling;
wenzelm
parents: 18671
diff changeset
  1388
  if NameSpace.is_qualified name then error ("Illegal qualified name: " ^ quote name)
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
  1389
  else name;
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1390
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  1391
fun prep_facts _ _ _ ctxt (Int elem) = elem
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  1392
      |> Element.morph_ctxt (Morphism.thm_morphism (Thm.transfer (ProofContext.theory_of ctxt)))
20965
75ffb934929d add_locale(_i): return actual result context;
wenzelm
parents: 20951
diff changeset
  1393
  | prep_facts prep_name get intern ctxt (Ext elem) = elem |> Element.map_ctxt
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
  1394
     {var = I, typ = I, term = I,
18678
dd0c569fa43d sane ERROR handling;
wenzelm
parents: 18671
diff changeset
  1395
      name = prep_name,
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
  1396
      fact = get ctxt,
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1397
      attrib = Args.assignable o intern (ProofContext.theory_of ctxt)};
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1398
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1399
in
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1400
20965
75ffb934929d add_locale(_i): return actual result context;
wenzelm
parents: 20951
diff changeset
  1401
fun read_facts x = prep_facts check_name ProofContext.get_thms Attrib.intern_src x;
75ffb934929d add_locale(_i): return actual result context;
wenzelm
parents: 20951
diff changeset
  1402
fun cert_facts x = prep_facts I (K I) (K I) x;
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1403
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1404
end;
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1405
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1406
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1407
(* Get the specification of a locale *)
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1408
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1409
(*The global specification is made from the parameters and global
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1410
  assumptions, the local specification from the parameters and the
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1411
  local assumptions.*)
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1412
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1413
local
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1414
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1415
fun gen_asms_of get thy name =
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1416
  let
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1417
    val ctxt = ProofContext.init thy;
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1418
    val (_, raw_elemss) = flatten (ctxt, I) (([], Symtab.empty), Expr (Locale name));
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1419
    val ((_, elemss, _), _) = read_elemss false ctxt [] raw_elemss [];
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1420
  in
18890
34a9e466201f *_asms_of fixed.
ballarin
parents: 18831
diff changeset
  1421
    elemss |> get
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1422
      |> maps (fn (_, es) => map (fn Int e => e) es)
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1423
      |> maps (fn Assumes asms => asms | _ => [])
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1424
      |> map (apsnd (map fst))
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1425
  end;
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1426
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1427
in
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1428
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1429
fun parameters_of thy name =
19278
4d762b77d319 Internal restructuring: local parameters.
ballarin
parents: 19276
diff changeset
  1430
  the_locale thy name |> #params;
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1431
19276
ac90764bb654 New interface function parameters_of_expr.
ballarin
parents: 19061
diff changeset
  1432
fun parameters_of_expr thy expr =
ac90764bb654 New interface function parameters_of_expr.
ballarin
parents: 19061
diff changeset
  1433
  let
ac90764bb654 New interface function parameters_of_expr.
ballarin
parents: 19061
diff changeset
  1434
    val ctxt = ProofContext.init thy;
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1435
    val pts = params_of_expr ctxt [] (intern_expr thy expr)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1436
        ([], Symtab.empty, Symtab.empty);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1437
    val raw_params_elemss = make_raw_params_elemss pts;
19276
ac90764bb654 New interface function parameters_of_expr.
ballarin
parents: 19061
diff changeset
  1438
    val ((_, syn), raw_elemss) = flatten (ctxt, intern_expr thy)
ac90764bb654 New interface function parameters_of_expr.
ballarin
parents: 19061
diff changeset
  1439
        (([], Symtab.empty), Expr expr);
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1440
    val ((parms, _, _), _) =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1441
        read_elemss false ctxt [] (raw_params_elemss @ raw_elemss) [];
19276
ac90764bb654 New interface function parameters_of_expr.
ballarin
parents: 19061
diff changeset
  1442
  in map (fn p as (n, _) => (p, Symtab.lookup syn n |> the)) parms end;
ac90764bb654 New interface function parameters_of_expr.
ballarin
parents: 19061
diff changeset
  1443
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1444
fun local_asms_of thy name =
18890
34a9e466201f *_asms_of fixed.
ballarin
parents: 18831
diff changeset
  1445
  gen_asms_of (single o Library.last_elem) thy name;
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1446
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1447
fun global_asms_of thy name =
18890
34a9e466201f *_asms_of fixed.
ballarin
parents: 18831
diff changeset
  1448
  gen_asms_of I thy name;
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1449
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1450
end;
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1451
22523
19e4fd6ffcaa exported interface for intro rules
haftmann
parents: 22351
diff changeset
  1452
fun intros thy =
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  1453
  #intros o the o Symtab.lookup (#2 (LocalesData.get thy));
22523
19e4fd6ffcaa exported interface for intro rules
haftmann
parents: 22351
diff changeset
  1454
    (*returns introduction rule for delta predicate and locale predicate
19e4fd6ffcaa exported interface for intro rules
haftmann
parents: 22351
diff changeset
  1455
      as a pair of singleton lists*)
19e4fd6ffcaa exported interface for intro rules
haftmann
parents: 22351
diff changeset
  1456
18795
303793f49b0f Interface to access the specification of a named locale.
ballarin
parents: 18782
diff changeset
  1457
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1458
(* full context statements: imports + elements + conclusion *)
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1459
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1460
local
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1461
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1462
fun prep_context_statement prep_expr prep_elemss prep_facts
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1463
    do_close fixed_params imports elements raw_concl context =
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1464
  let
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1465
    val thy = ProofContext.theory_of context;
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1466
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1467
    val (import_params, import_tenv, import_syn) =
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1468
      params_of_expr context fixed_params (prep_expr thy imports)
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1469
        ([], Symtab.empty, Symtab.empty);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1470
    val includes = map_filter (fn Expr e => SOME e | Elem _ => NONE) elements;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1471
    val (incl_params, incl_tenv, incl_syn) = fold (params_of_expr context fixed_params)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1472
      (map (prep_expr thy) includes) (import_params, import_tenv, import_syn);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1473
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1474
    val ((import_ids, _), raw_import_elemss) =
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1475
      flatten (context, prep_expr thy) (([], Symtab.empty), Expr imports);
14215
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
  1476
    (* CB: normalise "includes" among elements *)
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1477
    val ((ids, syn), raw_elemsss) = foldl_map (flatten (context, prep_expr thy))
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1478
      ((import_ids, incl_syn), elements);
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1479
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  1480
    val raw_elemss = flat raw_elemsss;
14508
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1481
    (* CB: raw_import_elemss @ raw_elemss is the normalised list of
859b11514537 Experimental command for instantiation of locales in proof contexts:
ballarin
parents: 14446
diff changeset
  1482
       context elements obtained from import and elements. *)
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1483
    (* Now additional elements for parameters are inserted. *)
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1484
    val import_params_ids = make_params_ids import_params;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1485
    val incl_params_ids =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1486
        make_params_ids (incl_params \\ import_params);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1487
    val raw_import_params_elemss =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1488
        make_raw_params_elemss (import_params, incl_tenv, incl_syn);
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1489
    val raw_incl_params_elemss =
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1490
        make_raw_params_elemss (incl_params \\ import_params, incl_tenv, incl_syn);
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1491
    val ((parms, all_elemss, concl), (spec, (_, _, defs))) = prep_elemss do_close
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1492
      context fixed_params
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1493
      (raw_import_params_elemss @ raw_import_elemss @ raw_incl_params_elemss @ raw_elemss) raw_concl;
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1494
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1495
    (* replace extended ids (for axioms) by ids *)
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1496
    val (import_ids', incl_ids) = chop (length import_ids) ids;
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
  1497
    val all_ids = import_params_ids @ import_ids' @ incl_params_ids @ incl_ids;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1498
    val all_elemss' = map (fn (((_, ps), _), (((n, ps'), mode), elems)) =>
17485
c39871c52977 introduced AList module
haftmann
parents: 17449
diff changeset
  1499
        (((n, map (fn p => (p, (the o AList.lookup (op =) ps') p)) ps), mode), elems))
20035
80c79876d2de Internal restructuring: identify no longer computes syntax.
ballarin
parents: 20032
diff changeset
  1500
      (all_ids ~~ all_elemss);
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1501
    (* CB: all_elemss and parms contain the correct parameter types *)
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1502
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1503
    val (ps, qs) = chop (length raw_import_params_elemss + length raw_import_elemss) all_elemss';
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1504
    val (import_ctxt, (import_elemss, _)) =
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1505
      activate_facts false prep_facts (context, ps);
14215
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
  1506
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1507
    val (ctxt, (elemss, _)) =
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1508
      activate_facts false prep_facts (ProofContext.set_stmt true import_ctxt, qs);
12834
e5bec3268932 added locale_facts(_i) interface (useful for simple ML proof tools);
wenzelm
parents: 12806
diff changeset
  1509
  in
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1510
    ((((import_ctxt, import_elemss), (ctxt, elemss, syn)),
19991
0c9650664d47 Locales no longer generate views. The following functions have changed
ballarin
parents: 19984
diff changeset
  1511
      (parms, spec, defs)), concl)
12834
e5bec3268932 added locale_facts(_i) interface (useful for simple ML proof tools);
wenzelm
parents: 12806
diff changeset
  1512
  end;
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1513
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
  1514
fun prep_statement prep_locale prep_ctxt raw_locale elems concl ctxt =
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1515
  let
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1516
    val thy = ProofContext.theory_of ctxt;
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1517
    val locale = Option.map (prep_locale thy) raw_locale;
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1518
    val (fixed_params, imports) =
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
  1519
      (case locale of
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1520
        NONE => ([], empty)
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15456
diff changeset
  1521
      | SOME name =>
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1522
          let val {params = ps, ...} = the_locale thy name
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1523
          in (map fst ps, Locale name) end);
19991
0c9650664d47 Locales no longer generate views. The following functions have changed
ballarin
parents: 19984
diff changeset
  1524
    val ((((locale_ctxt, _), (elems_ctxt, _, _)), _), concl') =
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1525
      prep_ctxt false fixed_params imports elems concl ctxt;
19991
0c9650664d47 Locales no longer generate views. The following functions have changed
ballarin
parents: 19984
diff changeset
  1526
  in (locale, locale_ctxt, elems_ctxt, concl') end;
13399
c136276dc847 support locale ``views'' (for cumulative predicates);
wenzelm
parents: 13394
diff changeset
  1527
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1528
fun prep_expr prep imports body ctxt =
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1529
  let
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1530
    val (((_, import_elemss), (ctxt', elemss, _)), _) = prep imports body ctxt;
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1531
    val all_elems = maps snd (import_elemss @ elemss);
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1532
  in (all_elems, ctxt') end;
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1533
12529
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1534
in
d99716a53f59 simultaneous type-inference of complete context/statement specifications;
wenzelm
parents: 12514
diff changeset
  1535
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
  1536
val read_ctxt = prep_context_statement intern_expr read_elemss read_facts;
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
  1537
val cert_ctxt = prep_context_statement (K I) cert_elemss cert_facts;
14215
ebf291f3b449 Improvements to Isar/Locales: premises generated by "includes" elements
ballarin
parents: 13629
diff changeset
  1538
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1539
fun read_context imports body ctxt = #1 (read_ctxt true [] imports (map Elem body) [] ctxt);
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1540
fun cert_context imports body ctxt = #1 (cert_ctxt true [] imports (map Elem body) [] ctxt);
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
  1541
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1542
val read_expr = prep_expr read_context;
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1543
val cert_expr = prep_expr cert_context;
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1544
21035
326c15917a33 export map_elem;
wenzelm
parents: 21005
diff changeset
  1545
fun read_context_statement loc = prep_statement intern read_ctxt loc;
326c15917a33 export map_elem;
wenzelm
parents: 21005
diff changeset
  1546
fun read_context_statement_i loc = prep_statement (K I) read_ctxt loc;
326c15917a33 export map_elem;
wenzelm
parents: 21005
diff changeset
  1547
fun cert_context_statement loc = prep_statement (K I) cert_ctxt loc;
18806
0d2aa1cceb7d init: include view;
wenzelm
parents: 18795
diff changeset
  1548
12502
9e7f72e25022 beginning support for type instantiation;
wenzelm
parents: 12323
diff changeset
  1549
end;
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
  1550
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
  1551
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1552
(* init *)
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1553
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1554
fun init loc =
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1555
  ProofContext.init
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1556
  #> (#2 o cert_context_statement (SOME loc) [] []);
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1557
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1558
13336
1bd21b082466 tuned add_thmss;
wenzelm
parents: 13308
diff changeset
  1559
(* print locale *)
12070
c72fe1edc9e7 proper treatment of local syntax;
wenzelm
parents: 12063
diff changeset
  1560
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1561
fun print_locale thy show_facts imports body =
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1562
  let val (all_elems, ctxt) = read_expr imports body (ProofContext.init thy) in
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1563
    Pretty.big_list "locale elements:" (all_elems
17316
fc7cc8137b97 fixed printing of locales
ballarin
parents: 17271
diff changeset
  1564
      |> (if show_facts then I else filter (fn Notes _ => false | _ => true))
21701
627c90b310c1 tuned print_locale output;
wenzelm
parents: 21686
diff changeset
  1565
      |> map (Element.pretty_ctxt ctxt) |> filter_out null
627c90b310c1 tuned print_locale output;
wenzelm
parents: 21686
diff changeset
  1566
      |> map Pretty.chunks)
13336
1bd21b082466 tuned add_thmss;
wenzelm
parents: 13308
diff changeset
  1567
    |> Pretty.writeln
12277
2b28d7dd91f5 improved ordering of evaluated elements;
wenzelm
parents: 12273
diff changeset
  1568
  end;
12070
c72fe1edc9e7 proper treatment of local syntax;
wenzelm
parents: 12063
diff changeset
  1569
c72fe1edc9e7 proper treatment of local syntax;
wenzelm
parents: 12063
diff changeset
  1570
12706
05fa6a8a6320 removed add_thmss;
wenzelm
parents: 12702
diff changeset
  1571
16144
e339119f4261 renamed cond_extern to extern;
wenzelm
parents: 16105
diff changeset
  1572
(** store results **)
12702
721b622d8967 add_thmss_hybrid;
wenzelm
parents: 12680
diff changeset
  1573
19018
88b4979193d8 added abbreviations: activated by init, no expressions yet;
wenzelm
parents: 18964
diff changeset
  1574
(* naming of interpreted theorems *)
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1575
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1576
fun global_note_prefix_i kind (fully_qualified, prfx) args thy =
16144
e339119f4261 renamed cond_extern to extern;
wenzelm
parents: 16105
diff changeset
  1577
  thy
22796
34c316d7b630 renamed some old names Theory.xxx to Sign.xxx;
wenzelm
parents: 22772
diff changeset
  1578
  |> Sign.qualified_names
34c316d7b630 renamed some old names Theory.xxx to Sign.xxx;
wenzelm
parents: 22772
diff changeset
  1579
  |> (if fully_qualified then Sign.sticky_prefix prfx else Sign.add_path prfx)
16144
e339119f4261 renamed cond_extern to extern;
wenzelm
parents: 16105
diff changeset
  1580
  |> PureThy.note_thmss_i kind args
22796
34c316d7b630 renamed some old names Theory.xxx to Sign.xxx;
wenzelm
parents: 22772
diff changeset
  1581
  ||> Sign.restore_naming thy;
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1582
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1583
fun local_note_prefix_i kind (fully_qualified, prfx) args ctxt =
16144
e339119f4261 renamed cond_extern to extern;
wenzelm
parents: 16105
diff changeset
  1584
  ctxt
19061
ffbbac0261c9 removed distinct, renamed gen_distinct to distinct;
wenzelm
parents: 19025
diff changeset
  1585
  |> ProofContext.qualified_names
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1586
  |> (if fully_qualified then ProofContext.sticky_prefix prfx else ProofContext.add_path prfx)
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1587
  |> ProofContext.note_thmss_i kind args
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1588
  ||> ProofContext.restore_naming ctxt;
16144
e339119f4261 renamed cond_extern to extern;
wenzelm
parents: 16105
diff changeset
  1589
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1590
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1591
(* join equations of an id with already accumulated ones *)
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1592
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1593
fun join_eqns get_reg prep_id ctxt id eqns =
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1594
  let
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1595
    val id' = prep_id id
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1596
    val eqns' = case get_reg id'
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1597
      of NONE => eqns
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1598
	| SOME (_, _, eqns') => Termtab.join (fn t => fn (_, e) => e) (eqns, eqns')
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1599
            handle Termtab.DUP t =>
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1600
	      error ("Conflicting interpreting equations for term " ^
24920
2a45e400fdad generic Syntax.pretty/string_of operations;
wenzelm
parents: 24787
diff changeset
  1601
		quote (Syntax.string_of_term ctxt t))
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1602
  in ((id', eqns'), eqns') end;
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1603
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1604
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  1605
(* collect witnesses and equations up to a particular target for global
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  1606
   registration; requires parameters and flattened list of identifiers
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1607
   instead of recomputing it from the target *)
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1608
25357
6ea18fd11058 avoid "import" as identifier, which is a keyword in Alice;
wenzelm
parents: 25286
diff changeset
  1609
fun collect_global_witnesses thy imprt parms ids vts = let
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1610
    val ts = map Logic.unvarify vts;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1611
    val (parms, parmTs) = split_list parms;
19810
dae765e552ce renamed Type.(un)varifyT to Logic.(un)varifyT;
wenzelm
parents: 19783
diff changeset
  1612
    val parmvTs = map Logic.varifyT parmTs;
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1613
    val vtinst = fold (Sign.typ_match thy) (parmvTs ~~ map Term.fastype_of ts) Vartab.empty;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1614
    val tinst = Vartab.dest vtinst |> map (fn ((x, 0), (_, T)) => (x, T))
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1615
        |> Symtab.make;
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1616
    (* replace parameter names in ids by instantiations *)
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1617
    val vinst = Symtab.make (parms ~~ vts);
17412
e26cb20ef0cc TableFun/Symtab: curried lookup and update;
wenzelm
parents: 17384
diff changeset
  1618
    fun vinst_names ps = map (the o Symtab.lookup vinst) ps;
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1619
    val inst = Symtab.make (parms ~~ ts);
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  1620
    val inst_ids = map (apfst (apsnd vinst_names)) ids;
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  1621
    val assumed_ids' = map_filter (fn (id, (_, Assumed _)) => SOME id | _ => NONE) inst_ids;
25357
6ea18fd11058 avoid "import" as identifier, which is a keyword in Alice;
wenzelm
parents: 25286
diff changeset
  1622
    val wits = maps (#2 o the o get_global_registration thy imprt) assumed_ids';
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  1623
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  1624
    val ids' = map fst inst_ids;
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1625
    val eqns =
25357
6ea18fd11058 avoid "import" as identifier, which is a keyword in Alice;
wenzelm
parents: 25286
diff changeset
  1626
      fold_map (join_eqns (get_global_registration thy imprt) I (ProofContext.init thy))
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  1627
        ids' Termtab.empty |> snd |> Termtab.dest |> map snd;
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1628
  in ((tinst, inst), wits, eqns) end;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1629
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1630
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1631
(* standardise export morphism *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1632
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1633
(* clone from Element.generalize_facts *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1634
fun standardize thy export facts =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1635
  let
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1636
    val exp_fact = Drule.zero_var_indexes_list o map Thm.strip_shyps o Morphism.fact export;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1637
    val exp_term = TermSubst.zero_var_indexes o Morphism.term export;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1638
      (* FIXME sync with exp_fact *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1639
    val exp_typ = Logic.type_map exp_term;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1640
    val morphism =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1641
      Morphism.morphism {name = I, var = I, typ = exp_typ, term = exp_term, fact = exp_fact};
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1642
  in Element.facts_map (Element.morph_ctxt morphism) facts end;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1643
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1644
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1645
(* suppress application of name morphism: workaroud for class package *) (* FIXME *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1646
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1647
fun morph_ctxt' phi = Element.map_ctxt
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1648
  {name = I,
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1649
   var = Morphism.var phi,
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1650
   typ = Morphism.typ phi,
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1651
   term = Morphism.term phi,
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1652
   fact = Morphism.fact phi,
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1653
   attrib = Args.morph_values phi};
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1654
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1655
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1656
(* compute morphism and apply to args *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1657
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1658
fun interpret_args thy prfx insts prems eqns atts2 exp attrib args =
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1659
  let
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1660
    val inst = Morphism.name_morphism (NameSpace.qualified prfx) $>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1661
      Element.inst_morphism thy insts $> Element.satisfy_morphism prems $>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1662
      Morphism.term_morphism (MetaSimplifier.rewrite_term thy eqns []) $>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1663
      Morphism.thm_morphism (MetaSimplifier.rewrite_rule eqns)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1664
  in
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1665
    args |> Element.facts_map (morph_ctxt' inst) |>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1666
      map (fn (attn, bs) => (attn,
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1667
        bs |> map (fn (ths, atts) => (ths, (atts @ atts2))))) |>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1668
      standardize thy exp |> Attrib.map_facts attrib
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1669
  end;
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1670
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  1671
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1672
(* store instantiations of args for all registered interpretations
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1673
   of the theory *)
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1674
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1675
fun note_thmss_registrations target (kind, args) thy =
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1676
  let
19278
4d762b77d319 Internal restructuring: local parameters.
ballarin
parents: 19276
diff changeset
  1677
    val parms = the_locale thy target |> #params |> map fst;
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1678
    val ids = flatten (ProofContext.init thy, intern_expr thy)
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  1679
      (([], Symtab.empty), Expr (Locale target)) |> fst |> fst;
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1680
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1681
    val regs = get_global_registrations thy target;
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1682
    (* add args to thy for all registrations *)
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1683
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1684
    fun activate (vts, (((fully_qualified, prfx), atts2), (exp, imp), _, _)) thy =
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  1685
      let
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1686
        val (insts, prems, eqns) = collect_global_witnesses thy imp parms ids vts;
20911
8fc5850446ed removed obsolete note_thmss(_i);
wenzelm
parents: 20872
diff changeset
  1687
        val attrib = Attrib.attribute_i thy;
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  1688
        val args' = interpret_args thy prfx insts prems eqns atts2 exp attrib args;
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1689
      in global_note_prefix_i kind (fully_qualified, prfx) args' thy |> snd end;
18190
b7748c77562f tuned Pattern.match/unify;
wenzelm
parents: 18137
diff changeset
  1690
  in fold activate regs thy end;
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1691
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1692
20911
8fc5850446ed removed obsolete note_thmss(_i);
wenzelm
parents: 20872
diff changeset
  1693
(* locale results *)
12958
99f5c4a37b29 added smart_have_thmss (global storage);
wenzelm
parents: 12862
diff changeset
  1694
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1695
fun add_thmss loc kind args ctxt =
12706
05fa6a8a6320 removed add_thmss;
wenzelm
parents: 12702
diff changeset
  1696
  let
21582
ac6af184bfb0 simplified add_thmss;
wenzelm
parents: 21530
diff changeset
  1697
    val (ctxt', ([(_, [Notes args'])], _)) =
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1698
      activate_facts true cert_facts
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1699
        (ctxt, [((("", []), Assumed []), [Ext (Notes (kind, args))])]);
20911
8fc5850446ed removed obsolete note_thmss(_i);
wenzelm
parents: 20872
diff changeset
  1700
    val ctxt'' = ctxt' |> ProofContext.theory
8fc5850446ed removed obsolete note_thmss(_i);
wenzelm
parents: 20872
diff changeset
  1701
      (change_locale loc
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1702
        (fn (axiom, imports, elems, params, lparams, decls, regs, intros) =>
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1703
          (axiom, imports, elems @ [(Notes args', stamp ())],
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  1704
            params, lparams, decls, regs, intros))
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1705
      #> note_thmss_registrations loc args');
21582
ac6af184bfb0 simplified add_thmss;
wenzelm
parents: 21530
diff changeset
  1706
  in ctxt'' end;
15703
727ef1b8b3ee *** empty log message ***
wenzelm
parents: 15696
diff changeset
  1707
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
  1708
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1709
(* declarations *)
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1710
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1711
local
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1712
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1713
fun decl_attrib decl phi = Thm.declaration_attribute (K (decl phi));
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1714
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1715
fun add_decls add loc decl =
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1716
  ProofContext.theory (change_locale loc
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1717
    (fn (axiom, imports, elems, params, lparams, decls, regs, intros) =>
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1718
      (axiom, imports, elems, params, lparams, add (decl, stamp ()) decls, regs, intros))) #>
24006
60ac90b795be Druke.dummy_thm;
wenzelm
parents: 23918
diff changeset
  1719
  add_thmss loc Thm.internalK
60ac90b795be Druke.dummy_thm;
wenzelm
parents: 23918
diff changeset
  1720
    [(("", [Attrib.internal (decl_attrib decl)]), [([Drule.dummy_thm], [])])];
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1721
23418
c195f6f13769 balanced conjunctions;
wenzelm
parents: 23228
diff changeset
  1722
in
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1723
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1724
val add_type_syntax = add_decls (apfst o cons);
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1725
val add_term_syntax = add_decls (apsnd o cons);
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1726
val add_declaration = add_decls (K I);
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1727
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1728
end;
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1729
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1730
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1731
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1732
(** define locales **)
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1733
13336
1bd21b082466 tuned add_thmss;
wenzelm
parents: 13308
diff changeset
  1734
(* predicate text *)
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  1735
(* CB: generate locale predicates and delta predicates *)
13336
1bd21b082466 tuned add_thmss;
wenzelm
parents: 13308
diff changeset
  1736
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1737
local
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1738
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1739
(* introN: name of theorems for introduction rules of locale and
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1740
     delta predicates;
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1741
   axiomsN: name of theorem set with destruct rules for locale predicates,
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1742
     also name suffix of delta predicates. *)
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1743
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1744
val introN = "intro";
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1745
val axiomsN = "axioms";
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1746
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1747
fun atomize_spec thy ts =
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1748
  let
23418
c195f6f13769 balanced conjunctions;
wenzelm
parents: 23228
diff changeset
  1749
    val t = Logic.mk_conjunction_balanced ts;
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1750
    val body = ObjectLogic.atomize_term thy t;
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1751
    val bodyT = Term.fastype_of body;
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1752
  in
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1753
    if bodyT = propT then (t, propT, Thm.reflexive (Thm.cterm_of thy t))
23591
d32a85385e17 simplified ObjectLogic.atomize;
wenzelm
parents: 23418
diff changeset
  1754
    else (body, bodyT, ObjectLogic.atomize (Thm.cterm_of thy t))
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1755
  end;
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1756
25073
13db30d367d2 locale pred: authentic syntax, tuned aprop_tr' accordingly;
wenzelm
parents: 25067
diff changeset
  1757
fun aprop_tr' n c = (Syntax.constN ^ c, fn ctxt => fn args =>
13db30d367d2 locale pred: authentic syntax, tuned aprop_tr' accordingly;
wenzelm
parents: 25067
diff changeset
  1758
  if length args = n then
13db30d367d2 locale pred: authentic syntax, tuned aprop_tr' accordingly;
wenzelm
parents: 25067
diff changeset
  1759
    Syntax.const "_aprop" $
13db30d367d2 locale pred: authentic syntax, tuned aprop_tr' accordingly;
wenzelm
parents: 25067
diff changeset
  1760
      Term.list_comb (Syntax.free (Consts.extern (ProofContext.consts_of ctxt) c), args)
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1761
  else raise Match);
13336
1bd21b082466 tuned add_thmss;
wenzelm
parents: 13308
diff changeset
  1762
15104
ballarin
parents: 15099
diff changeset
  1763
(* CB: define one predicate including its intro rule and axioms
ballarin
parents: 15099
diff changeset
  1764
   - bname: predicate name
ballarin
parents: 15099
diff changeset
  1765
   - parms: locale parameters
ballarin
parents: 15099
diff changeset
  1766
   - defs: thms representing substitutions from defines elements
ballarin
parents: 15099
diff changeset
  1767
   - ts: terms representing locale assumptions (not normalised wrt. defs)
ballarin
parents: 15099
diff changeset
  1768
   - norm_ts: terms representing locale assumptions (normalised wrt. defs)
ballarin
parents: 15099
diff changeset
  1769
   - thy: the theory
ballarin
parents: 15099
diff changeset
  1770
*)
ballarin
parents: 15099
diff changeset
  1771
13420
39fca1e5818a removed unused locale_facts(_i);
wenzelm
parents: 13415
diff changeset
  1772
fun def_pred bname parms defs ts norm_ts thy =
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1773
  let
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1774
    val name = Sign.full_name thy bname;
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1775
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1776
    val (body, bodyT, body_eq) = atomize_spec thy norm_ts;
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1777
    val env = Term.add_term_free_names (body, []);
20664
ffbc5a57191a member (op =);
wenzelm
parents: 20548
diff changeset
  1778
    val xs = filter (member (op =) env o #1) parms;
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1779
    val Ts = map #2 xs;
23178
07ba6b58b3d2 simplified/unified list fold;
wenzelm
parents: 22846
diff changeset
  1780
    val extraTs = (Term.term_tfrees body \\ List.foldr Term.add_typ_tfrees [] Ts)
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1781
      |> Library.sort_wrt #1 |> map TFree;
13399
c136276dc847 support locale ``views'' (for cumulative predicates);
wenzelm
parents: 13394
diff changeset
  1782
    val predT = map Term.itselfT extraTs ---> Ts ---> bodyT;
13336
1bd21b082466 tuned add_thmss;
wenzelm
parents: 13308
diff changeset
  1783
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1784
    val args = map Logic.mk_type extraTs @ map Free xs;
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1785
    val head = Term.list_comb (Const (name, predT), args);
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  1786
    val statement = ObjectLogic.ensure_propT thy head;
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1787
18358
0a733e11021a re-oriented some result tuples in PureThy
haftmann
parents: 18343
diff changeset
  1788
    val ([pred_def], defs_thy) =
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1789
      thy
25073
13db30d367d2 locale pred: authentic syntax, tuned aprop_tr' accordingly;
wenzelm
parents: 25067
diff changeset
  1790
      |> bodyT = propT ? Sign.add_advanced_trfuns ([], [], [aprop_tr' (length args) name], [])
13db30d367d2 locale pred: authentic syntax, tuned aprop_tr' accordingly;
wenzelm
parents: 25067
diff changeset
  1791
      |> Sign.declare_const [] (bname, predT, NoSyn) |> snd
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1792
      |> PureThy.add_defs_i false [((Thm.def_name bname, Logic.mk_equals (head, body)), [])];
20059
25935807eb08 Element.prove_witness: context;
wenzelm
parents: 20037
diff changeset
  1793
    val defs_ctxt = ProofContext.init defs_thy |> Variable.declare_term head;
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1794
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1795
    val cert = Thm.cterm_of defs_thy;
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1796
20059
25935807eb08 Element.prove_witness: context;
wenzelm
parents: 20037
diff changeset
  1797
    val intro = Goal.prove_global defs_thy [] norm_ts statement (fn _ =>
21708
45e7491bea47 reorganized structure Tactic vs. MetaSimplifier;
wenzelm
parents: 21701
diff changeset
  1798
      MetaSimplifier.rewrite_goals_tac [pred_def] THEN
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1799
      Tactic.compose_tac (false, body_eq RS Drule.equal_elim_rule1, 1) 1 THEN
23418
c195f6f13769 balanced conjunctions;
wenzelm
parents: 23228
diff changeset
  1800
      Tactic.compose_tac (false,
c195f6f13769 balanced conjunctions;
wenzelm
parents: 23228
diff changeset
  1801
        Conjunction.intr_balanced (map (Thm.assume o cert) norm_ts), 0) 1);
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1802
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1803
    val conjuncts =
19423
51eeee99bd8f use conjunction stuff from conjunction.ML;
wenzelm
parents: 19370
diff changeset
  1804
      (Drule.equal_elim_rule2 OF [body_eq,
21708
45e7491bea47 reorganized structure Tactic vs. MetaSimplifier;
wenzelm
parents: 21701
diff changeset
  1805
        MetaSimplifier.rewrite_rule [pred_def] (Thm.assume (cert statement))])
23418
c195f6f13769 balanced conjunctions;
wenzelm
parents: 23228
diff changeset
  1806
      |> Conjunction.elim_balanced (length ts);
17257
0ab67cb765da introduced binding priority 1 for linear combinators etc.
haftmann
parents: 17228
diff changeset
  1807
    val axioms = ts ~~ conjuncts |> map (fn (t, ax) =>
20059
25935807eb08 Element.prove_witness: context;
wenzelm
parents: 20037
diff changeset
  1808
      Element.prove_witness defs_ctxt t
21708
45e7491bea47 reorganized structure Tactic vs. MetaSimplifier;
wenzelm
parents: 21701
diff changeset
  1809
       (MetaSimplifier.rewrite_goals_tac defs THEN
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1810
        Tactic.compose_tac (false, ax, 0) 1));
18550
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1811
  in ((statement, intro, axioms), defs_thy) end;
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1812
18550
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1813
fun assumes_to_notes (Assumes asms) axms =
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1814
      fold_map (fn (a, spec) => fn axs =>
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1815
          let val (ps, qs) = chop (length spec) axs
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1816
          in ((a, [(ps, [])]), qs) end) asms axms
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1817
      |> apfst (curry Notes Thm.assumptionK)
18550
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1818
  | assumes_to_notes e axms = (e, axms);
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1819
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1820
(* CB: the following two change only "new" elems, these have identifier ("", _). *)
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1821
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1822
(* turn Assumes into Notes elements *)
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1823
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1824
fun change_assumes_elemss axioms elemss =
18550
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1825
  let
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1826
    val satisfy = Element.morph_ctxt (Element.satisfy_morphism axioms);
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1827
    fun change (id as ("", _), es) =
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1828
          fold_map assumes_to_notes (map satisfy es)
18550
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1829
          #-> (fn es' => pair (id, es'))
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1830
      | change e = pair e;
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1831
  in
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  1832
    fst (fold_map change elemss (map Element.conclude_witness axioms))
18550
59b89f625d68 add_local_context now yields imported and body elements seperatly; additional slight clenup in code
haftmann
parents: 18546
diff changeset
  1833
  end;
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1834
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1835
(* adjust hyps of Notes elements *)
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1836
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1837
fun change_elemss_hyps axioms elemss =
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1838
  let
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1839
    val satisfy = Element.morph_ctxt (Element.satisfy_morphism axioms);
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  1840
    fun change (id as ("", _), es) = (id, map (fn e as Notes _ => satisfy e | e => e) es)
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1841
      | change e = e;
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1842
  in map change elemss end;
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1843
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1844
in
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1845
15104
ballarin
parents: 15099
diff changeset
  1846
(* CB: main predicate definition function *)
ballarin
parents: 15099
diff changeset
  1847
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1848
fun define_preds pname (parms, ((exts, exts'), (ints, ints')), defs) elemss thy =
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1849
  let
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1850
    val ((elemss', more_ts), a_elem, a_intro, thy'') =
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1851
      if null exts then ((elemss, []), [], [], thy)
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1852
      else
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1853
        let
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1854
          val aname = if null ints then pname else pname ^ "_" ^ axiomsN;
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1855
          val ((statement, intro, axioms), thy') =
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1856
            thy
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1857
            |> def_pred aname parms defs exts exts';
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1858
          val elemss' = change_assumes_elemss axioms elemss;
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1859
          val a_elem = [(("", []), [Assumes [((pname ^ "_" ^ axiomsN, []), [(statement, [])])]])];
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1860
          val (_, thy'') =
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1861
            thy'
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1862
            |> PureThy.note_thmss_qualified Thm.internalK aname [((introN, []), [([intro], [])])];
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1863
        in ((elemss', [statement]), a_elem, [intro], thy'') end;
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1864
    val (predicate, stmt', elemss'', b_intro, thy'''') =
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1865
      if null ints then (([], []), more_ts, elemss' @ a_elem, [], thy'')
13394
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1866
      else
b39347206719 define cumulative predicate view;
wenzelm
parents: 13375
diff changeset
  1867
        let
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1868
          val ((statement, intro, axioms), thy''') =
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1869
            thy''
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1870
            |> def_pred pname parms defs (ints @ more_ts) (ints' @ more_ts);
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1871
          val cstatement = Thm.cterm_of thy''' statement;
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1872
          val elemss'' = change_elemss_hyps axioms elemss';
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1873
          val b_elem = [(("", []),
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1874
               [Assumes [((pname ^ "_" ^ axiomsN, []), [(statement, [])])]])];
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1875
          val (_, thy'''') =
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1876
            thy'''
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1877
            |> PureThy.note_thmss_qualified Thm.internalK pname
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1878
                 [((introN, []), [([intro], [])]),
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1879
                  ((axiomsN, []), [(map (Drule.standard o Element.conclude_witness) axioms, [])])];
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1880
        in (([cstatement], axioms), [statement], elemss'' @ b_elem, [intro], thy'''') end;
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1881
  in (((elemss'', predicate, stmt'), (a_intro, b_intro)), thy'''') end;
13375
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1882
7cbf2dea46d0 proper predicate definitions of locale body;
wenzelm
parents: 13336
diff changeset
  1883
end;
13336
1bd21b082466 tuned add_thmss;
wenzelm
parents: 13308
diff changeset
  1884
1bd21b082466 tuned add_thmss;
wenzelm
parents: 13308
diff changeset
  1885
13297
wenzelm
parents: 13211
diff changeset
  1886
(* add_locale(_i) *)
wenzelm
parents: 13211
diff changeset
  1887
wenzelm
parents: 13211
diff changeset
  1888
local
wenzelm
parents: 13211
diff changeset
  1889
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1890
(* turn Defines into Notes elements, accumulate definition terms *)
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1891
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1892
fun defines_to_notes is_ext thy (Defines defs) defns =
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1893
    let
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1894
      val defs' = map (fn (_, (def, _)) => (("", []), (def, []))) defs
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1895
      val notes = map (fn (a, (def, _)) =>
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1896
        (a, [([assume (cterm_of thy def)], [])])) defs
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1897
    in
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1898
      (if is_ext then SOME (Notes (Thm.definitionK, notes)) else NONE, defns @ [Defines defs'])
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1899
    end
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1900
  | defines_to_notes _ _ e defns = (SOME e, defns);
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1901
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1902
fun change_defines_elemss thy elemss defns =
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1903
  let
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1904
    fun change (id as (n, _), es) defns =
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1905
        let
19942
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1906
          val (es', defns') = fold_map (defines_to_notes (n="") thy) es defns
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1907
        in ((id, map_filter I es'), defns') end
dc92e3aebc71 Improved handling of defines imported in duplicate.
ballarin
parents: 19932
diff changeset
  1908
  in fold_map change elemss defns end;
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1909
18343
e36238ac5359 defines: beta/eta contract lhs;
wenzelm
parents: 18330
diff changeset
  1910
fun gen_add_locale prep_ctxt prep_expr
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1911
    predicate_name bname raw_imports raw_body thy =
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1912
    (* predicate_name: NONE - open locale without predicate
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1913
        SOME "" - locale with predicate named as locale
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1914
        SOME "name" - locale with predicate named "name" *)
13297
wenzelm
parents: 13211
diff changeset
  1915
  let
16458
4c6fd0c01d28 accomodate change of TheoryDataFun;
wenzelm
parents: 16346
diff changeset
  1916
    val name = Sign.full_name thy bname;
21962
279b129498b6 removed conditional combinator;
wenzelm
parents: 21708
diff changeset
  1917
    val _ = is_some (get_locale thy name) andalso
279b129498b6 removed conditional combinator;
wenzelm
parents: 21708
diff changeset
  1918
      error ("Duplicate definition of locale " ^ quote name);
13297
wenzelm
parents: 13211
diff changeset
  1919
wenzelm
parents: 13211
diff changeset
  1920
    val thy_ctxt = ProofContext.init thy;
17228
19b460b39dad print_locale omits facts by default
ballarin
parents: 17221
diff changeset
  1921
    val (((import_ctxt, import_elemss), (body_ctxt, body_elemss, syn)),
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1922
      text as (parms, ((_, exts'), _), defs)) =
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1923
      prep_ctxt raw_imports raw_body thy_ctxt;
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1924
    val elemss = import_elemss @ body_elemss |>
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1925
        map_filter (fn ((id, Assumed axs), elems) => SOME (id, elems) | _ => NONE);
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1926
    val imports = prep_expr thy raw_imports;
13297
wenzelm
parents: 13211
diff changeset
  1927
23178
07ba6b58b3d2 simplified/unified list fold;
wenzelm
parents: 22846
diff changeset
  1928
    val extraTs = List.foldr Term.add_term_tfrees [] exts' \\
07ba6b58b3d2 simplified/unified list fold;
wenzelm
parents: 22846
diff changeset
  1929
      List.foldr Term.add_typ_tfrees [] (map snd parms);
17228
19b460b39dad print_locale omits facts by default
ballarin
parents: 17221
diff changeset
  1930
    val _ = if null extraTs then ()
17437
9deaf32c83be interpretation uses primitive goal interface
ballarin
parents: 17412
diff changeset
  1931
      else warning ("Additional type variable(s) in locale specification " ^ quote bname);
17228
19b460b39dad print_locale omits facts by default
ballarin
parents: 17221
diff changeset
  1932
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1933
    val ((((elemss', predicate as (predicate_statement, predicate_axioms), stmt'), intros),
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1934
          pred_thy), (imports, regs)) =
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1935
      case predicate_name
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1936
       of SOME predicate_name =>
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1937
            let
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1938
              val predicate_name' = case predicate_name of "" => bname | _ => predicate_name;
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1939
              val (elemss', defns) = change_defines_elemss thy elemss [];
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1940
              val elemss'' = elemss' @ [(("", []), defns)];
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1941
              val (((elemss''', predicate as (_, axioms), stmt'), intros), thy') =
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1942
                define_preds predicate_name' text elemss'' thy;
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1943
              fun mk_regs elemss wits =
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1944
                fold_map (fn (id, elems) => fn wts => let
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1945
                    val ts = List.concat (List.mapPartial (fn (Assumes asms) =>
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1946
                      SOME (List.concat (map (map #1 o #2) asms)) | _ => NONE) elems);
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1947
                    val (wts1, wts2) = chop (length ts) wts
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1948
                  in ((apsnd (map fst) id, wts1), wts2) end) elemss wits |> fst;
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1949
              val regs = mk_regs elemss''' axioms |>
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1950
                    map_filter (fn (("", _), _) => NONE | e => SOME e);
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1951
            in ((((elemss''', predicate, stmt'), intros), thy'), (empty, regs)) end
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1952
        | NONE => ((((elemss, ([], []), []), ([], [])), thy), (imports, []));
13420
39fca1e5818a removed unused locale_facts(_i);
wenzelm
parents: 13415
diff changeset
  1953
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  1954
    fun axiomify axioms elemss =
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1955
      (axioms, elemss) |> foldl_map (fn (axs, (id, elems)) => let
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  1956
                   val ts = flat (map_filter (fn (Assumes asms) =>
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  1957
                     SOME (maps (map #1 o #2) asms) | _ => NONE) elems);
19018
88b4979193d8 added abbreviations: activated by init, no expressions yet;
wenzelm
parents: 18964
diff changeset
  1958
                   val (axs1, axs2) = chop (length ts) axs;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  1959
                 in (axs2, ((id, Assumed axs1), elems)) end)
15206
09d78ec709c7 Modified locales: improved implementation of "includes".
ballarin
parents: 15127
diff changeset
  1960
        |> snd;
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1961
    val (ctxt, (_, facts)) = activate_facts true (K I)
20965
75ffb934929d add_locale(_i): return actual result context;
wenzelm
parents: 20951
diff changeset
  1962
      (ProofContext.init pred_thy, axiomify predicate_axioms elemss');
21393
c648e24fd7ee add_locale: re-init result context (avoids subtle modifications after introducing predicate views internally);
wenzelm
parents: 21370
diff changeset
  1963
    val view_ctxt = Assumption.add_view thy_ctxt predicate_statement ctxt;
21602
cb13024d0e36 Goal.norm/close_result;
wenzelm
parents: 21600
diff changeset
  1964
    val export = Goal.close_result o Goal.norm_result o
cb13024d0e36 Goal.norm/close_result;
wenzelm
parents: 21600
diff changeset
  1965
      singleton (ProofContext.export view_ctxt thy_ctxt);
13420
39fca1e5818a removed unused locale_facts(_i);
wenzelm
parents: 13415
diff changeset
  1966
    val facts' = facts |> map (fn (a, ths) => ((a, []), [(map export ths, [])]));
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  1967
    val elems' = maps #2 (filter (equal "" o #1 o #1) elemss');
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1968
    val elems'' = map_filter (fn (Fixes _) => NONE | e => SOME e) elems';
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1969
    val axs' = map (Element.assume_witness pred_thy) stmt';
21393
c648e24fd7ee add_locale: re-init result context (avoids subtle modifications after introducing predicate views internally);
wenzelm
parents: 21370
diff changeset
  1970
    val loc_ctxt = pred_thy
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  1971
      |> PureThy.note_thmss_qualified Thm.assumptionK bname facts' |> snd
19061
ffbbac0261c9 removed distinct, renamed gen_distinct to distinct;
wenzelm
parents: 19025
diff changeset
  1972
      |> declare_locale name
ffbbac0261c9 removed distinct, renamed gen_distinct to distinct;
wenzelm
parents: 19025
diff changeset
  1973
      |> put_locale name
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1974
       {axiom = axs',
22573
2ac646ab2f6c avoid clash with Alice keywords;
wenzelm
parents: 22523
diff changeset
  1975
        imports = imports,
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  1976
        elems = map (fn e => (e, stamp ())) elems'',
19278
4d762b77d319 Internal restructuring: local parameters.
ballarin
parents: 19276
diff changeset
  1977
        params = params_of elemss' |> map (fn (x, SOME T) => ((x, T), the (Symtab.lookup syn x))),
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1978
        lparams = map #1 (params_of' body_elemss),
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  1979
        decls = ([], []),
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  1980
        regs = regs,
21393
c648e24fd7ee add_locale: re-init result context (avoids subtle modifications after introducing predicate views internally);
wenzelm
parents: 21370
diff changeset
  1981
        intros = intros}
c648e24fd7ee add_locale: re-init result context (avoids subtle modifications after introducing predicate views internally);
wenzelm
parents: 21370
diff changeset
  1982
      |> init name;
c648e24fd7ee add_locale: re-init result context (avoids subtle modifications after introducing predicate views internally);
wenzelm
parents: 21370
diff changeset
  1983
  in (name, loc_ctxt) end;
13297
wenzelm
parents: 13211
diff changeset
  1984
wenzelm
parents: 13211
diff changeset
  1985
in
wenzelm
parents: 13211
diff changeset
  1986
18917
77e18862990f refined signature of locale module
haftmann
parents: 18907
diff changeset
  1987
val add_locale = gen_add_locale read_context intern_expr;
77e18862990f refined signature of locale module
haftmann
parents: 18907
diff changeset
  1988
val add_locale_i = gen_add_locale cert_context (K I);
13297
wenzelm
parents: 13211
diff changeset
  1989
wenzelm
parents: 13211
diff changeset
  1990
end;
wenzelm
parents: 13211
diff changeset
  1991
19018
88b4979193d8 added abbreviations: activated by init, no expressions yet;
wenzelm
parents: 18964
diff changeset
  1992
val _ = Context.add_setup
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1993
 (add_locale_i (SOME "") "var" empty [Fixes [(Name.internal "x", NONE, NoSyn)]] #>
20965
75ffb934929d add_locale(_i): return actual result context;
wenzelm
parents: 20951
diff changeset
  1994
  snd #> ProofContext.theory_of #>
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  1995
  add_locale_i (SOME "") "struct" empty [Fixes [(Name.internal "S", NONE, Structure)]] #>
20965
75ffb934929d add_locale(_i): return actual result context;
wenzelm
parents: 20951
diff changeset
  1996
  snd #> ProofContext.theory_of);
15801
d2f5ca3c048d superceded by Pure.thy and CPure.thy;
wenzelm
parents: 15798
diff changeset
  1997
13297
wenzelm
parents: 13211
diff changeset
  1998
12730
fd0f8fa2b6bd produce predicate text;
wenzelm
parents: 12727
diff changeset
  1999
17355
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2000
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2001
(** Normalisation of locale statements ---
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2002
    discharges goals implied by interpretations **)
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2003
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2004
local
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2005
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2006
fun locale_assm_intros thy =
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2007
  Symtab.fold (fn (_, {intros = (a, _), ...}) => fn intros => (a @ intros))
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  2008
    (#2 (LocalesData.get thy)) [];
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2009
fun locale_base_intros thy =
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2010
  Symtab.fold (fn (_, {intros = (_, b), ...}) => fn intros => (b @ intros))
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  2011
    (#2 (LocalesData.get thy)) [];
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2012
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2013
fun all_witnesses ctxt =
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2014
  let
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2015
    val thy = ProofContext.theory_of ctxt;
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2016
    fun get registrations = Symtab.fold (fn (_, regs) => fn thms =>
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2017
        (Registrations.dest thy regs |> map (fn (_, (_, (exp, _), wits, _)) =>
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2018
          map (Element.conclude_witness #> Morphism.thm exp) wits) |> flat) @ thms)
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2019
      registrations [];
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  2020
  in get (RegistrationsData.get (Context.Proof ctxt)) end;
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2021
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2022
in
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2023
19984
29bb4659f80a Method intro_locales replaced by intro_locales and unfold_locales.
ballarin
parents: 19942
diff changeset
  2024
fun intro_locales_tac eager ctxt facts st =
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2025
  let
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2026
    val wits = all_witnesses ctxt;
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2027
    val thy = ProofContext.theory_of ctxt;
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2028
    val intros = locale_base_intros thy @ (if eager then locale_assm_intros thy else []);
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2029
  in
25270
2ed7b34f58e6 generic tactic Method.intros_tac
haftmann
parents: 25095
diff changeset
  2030
    Method.intros_tac (wits @ intros) facts st
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2031
  end;
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2032
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2033
val _ = Context.add_setup (Method.add_methods
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2034
  [("intro_locales",
19984
29bb4659f80a Method intro_locales replaced by intro_locales and unfold_locales.
ballarin
parents: 19942
diff changeset
  2035
    Method.ctxt_args (fn ctxt => Method.METHOD (intro_locales_tac false ctxt)),
29bb4659f80a Method intro_locales replaced by intro_locales and unfold_locales.
ballarin
parents: 19942
diff changeset
  2036
    "back-chain introduction rules of locales without unfolding predicates"),
29bb4659f80a Method intro_locales replaced by intro_locales and unfold_locales.
ballarin
parents: 19942
diff changeset
  2037
   ("unfold_locales",
29bb4659f80a Method intro_locales replaced by intro_locales and unfold_locales.
ballarin
parents: 19942
diff changeset
  2038
    Method.ctxt_args (fn ctxt => Method.METHOD (intro_locales_tac true ctxt)),
29bb4659f80a Method intro_locales replaced by intro_locales and unfold_locales.
ballarin
parents: 19942
diff changeset
  2039
    "back-chain all introduction rules of locales")]);
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2040
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2041
end;
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2042
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2043
15598
4ab52355bb53 Registrations of global locale interpretations: improved, better naming.
ballarin
parents: 15596
diff changeset
  2044
(** Interpretation commands **)
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2045
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2046
local
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2047
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2048
(* extract proof obligations (assms and defs) from elements *)
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2049
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2050
fun extract_asms_elems ((id, Assumed _), elems) = (id, maps Element.prems_of elems)
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2051
  | extract_asms_elems ((id, Derived _), _) = (id, []);
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2052
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2053
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
  2054
(* activate instantiated facts in theory or context *)
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2055
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2056
structure Idtab =
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2057
  TableFun(type key = string * term list
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2058
    val ord = prod_ord string_ord (list_ord Term.fast_term_ord));
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2059
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2060
fun gen_activate_facts_elemss mk_ctxt get_reg note note_interp attrib put_reg add_wit add_eqn
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2061
        attn all_elemss new_elemss propss eq_attns (exp, imp) thmss thy_ctxt =
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2062
  let
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2063
    val ctxt = mk_ctxt thy_ctxt;
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2064
    val (propss, eq_props) = chop (length new_elemss) propss;
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2065
    val (thmss, eq_thms) = chop (length new_elemss) thmss;
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2066
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2067
    fun activate_elem prems eqns exp ((fully_qualified, prfx), atts) (Notes (kind, facts)) thy_ctxt =
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2068
        let
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2069
          val ctxt = mk_ctxt thy_ctxt;
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2070
          val facts' = interpret_args (ProofContext.theory_of ctxt) prfx
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2071
              (Symtab.empty, Symtab.empty) prems eqns atts
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2072
              exp (attrib thy_ctxt) facts;
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2073
        in snd (note_interp kind (fully_qualified, prfx) facts' thy_ctxt) end
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2074
      | activate_elem _ _ _ _ _ thy_ctxt = thy_ctxt;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2075
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2076
    fun activate_elems prems eqns exp ((id, _), elems) thy_ctxt =
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2077
      let
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2078
        val (prfx_atts, _, _) = case get_reg thy_ctxt imp id
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  2079
         of SOME x => x
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  2080
          | NONE => sys_error ("Unknown registration of " ^ quote (fst id)
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  2081
              ^ " while activating facts.");
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2082
      in fold (activate_elem prems (the (Idtab.lookup eqns id)) exp prfx_atts) elems thy_ctxt end;
17033
f4c1ce91aa3c Release of interpretation in locale.
ballarin
parents: 17000
diff changeset
  2083
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2084
    val thy_ctxt' = thy_ctxt
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2085
      (* add registrations *)
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2086
      |> fold (fn ((id, _), _) => put_reg id attn (exp, imp)) new_elemss
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2087
      (* add witnesses of Assumed elements (only those generate proof obligations) *)
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2088
      |> fold (fn (id, thms) => fold (add_wit id) thms) (map fst propss ~~ thmss)
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2089
      (* add equations *)
24693
fe88913f3706 eliminated ProofContext.read_termTs;
wenzelm
parents: 24638
diff changeset
  2090
      |> fold (fn (id, thms) => fold (add_eqn id) thms) (map fst eq_props ~~
24952
f336c36f41a0 removed redundant strip_vars/abs_eqn, use improved Drule.abs_def instead;
wenzelm
parents: 24941
diff changeset
  2091
          (map o map) (Drule.abs_def o LocalDefs.meta_rewrite_rule ctxt o
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  2092
            Element.conclude_witness) eq_thms);
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2093
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2094
    val prems = flat (map_filter
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2095
          (fn ((id, Assumed _), _) => Option.map #2 (get_reg thy_ctxt' imp id)
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2096
            | ((_, Derived _), _) => NONE) all_elemss);
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2097
    val thy_ctxt'' = thy_ctxt'
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2098
      (* add witnesses of Derived elements *)
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2099
      |> fold (fn (id, thms) => fold (add_wit id o Element.morph_witness (Element.satisfy_morphism prems)) thms)
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2100
         (map_filter (fn ((_, Assumed _), _) => NONE
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2101
            | ((id, Derived thms), _) => SOME (id, thms)) new_elemss)
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2102
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2103
    (* Accumulate equations *)
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  2104
    val all_eqns =
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2105
      fold_map (join_eqns (get_reg thy_ctxt'' imp) (fst o fst) ctxt) all_elemss Termtab.empty
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  2106
      |> fst
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  2107
      |> map (apsnd (map snd o Termtab.dest))
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2108
      |> (fn xs => fold Idtab.update xs Idtab.empty)
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  2109
      (* Idtab.make wouldn't work here: can have conflicting duplicates,
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2110
         because instantiation may equate ids and equations are accumulated! *)
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2111
  in
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2112
    thy_ctxt''
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2113
    (* add equations *)
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2114
    |> fold (fn (attns, thms) =>
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2115
         fold (fn (attn, thm) => note "lemma"
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2116
           [(apsnd (map (attrib thy_ctxt'')) attn,
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2117
             [([Element.conclude_witness thm], [])])] #> snd)
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2118
           (attns ~~ thms)) (unflat eq_thms eq_attns ~~ eq_thms)
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2119
    (* add facts *)
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2120
    |> fold (activate_elems prems all_eqns exp) new_elemss
21499
fbd6422a847a uniform interface for type_syntax/term_syntax/declaration, dependent on morphism;
wenzelm
parents: 21483
diff changeset
  2121
  end;
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2122
17355
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2123
fun global_activate_facts_elemss x = gen_activate_facts_elemss
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2124
      ProofContext.init
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2125
      get_global_registration
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2126
      PureThy.note_thmss_i
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  2127
      global_note_prefix_i
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2128
      Attrib.attribute_i
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2129
      put_global_registration add_global_witness add_global_equation
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2130
      x;
17355
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2131
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2132
fun local_activate_facts_elemss x = gen_activate_facts_elemss
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2133
      I
15696
1da4ce092c0b First release of interpretation commands.
ballarin
parents: 15624
diff changeset
  2134
      get_local_registration
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2135
      ProofContext.note_thmss_i
19018
88b4979193d8 added abbreviations: activated by init, no expressions yet;
wenzelm
parents: 18964
diff changeset
  2136
      local_note_prefix_i
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2137
      (Attrib.attribute_i o ProofContext.theory_of)
17033
f4c1ce91aa3c Release of interpretation in locale.
ballarin
parents: 17000
diff changeset
  2138
      put_local_registration
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2139
      add_local_witness
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2140
      add_local_equation
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2141
      x;
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2142
25067
0f19e65ac0b6 clarified naming conventions of 'parse' and 'check' (as opposed to former 'cert');
wenzelm
parents: 25038
diff changeset
  2143
fun prep_instantiations parse_term parse_prop ctxt parms (insts, eqns) =
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2144
  let
24941
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2145
    (* parameters *)
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2146
    val (parm_names, parm_types) = parms |> split_list
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2147
      ||> map (TypeInfer.paramify_vars o Logic.varifyT);
25038
522abf8a5f87 canonical interpretation interface
haftmann
parents: 25002
diff changeset
  2148
    val type_parms = fold Term.add_tvarsT parm_types [] |> map (Logic.mk_type o TVar);
24941
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2149
    val type_parm_names = fold Term.add_tfreesT (map snd parms) [] |> map fst;
22772
e0788ff2e811 read_instantiations: proper type-inference with fixed variables, infer parameter types as well;
wenzelm
parents: 22756
diff changeset
  2150
e0788ff2e811 read_instantiations: proper type-inference with fixed variables, infer parameter types as well;
wenzelm
parents: 22756
diff changeset
  2151
    (* parameter instantiations *)
e0788ff2e811 read_instantiations: proper type-inference with fixed variables, infer parameter types as well;
wenzelm
parents: 22756
diff changeset
  2152
    val d = length parms - length insts;
e0788ff2e811 read_instantiations: proper type-inference with fixed variables, infer parameter types as well;
wenzelm
parents: 22756
diff changeset
  2153
    val insts =
e0788ff2e811 read_instantiations: proper type-inference with fixed variables, infer parameter types as well;
wenzelm
parents: 22756
diff changeset
  2154
      if d < 0 then error "More arguments than parameters in instantiation."
e0788ff2e811 read_instantiations: proper type-inference with fixed variables, infer parameter types as well;
wenzelm
parents: 22756
diff changeset
  2155
      else insts @ replicate d NONE;
24941
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2156
    val (given_ps, given_insts) =
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2157
      ((parm_names ~~ parm_types) ~~ insts) |> map_filter
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2158
          (fn (_, NONE) => NONE
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2159
            | ((n, T), SOME inst) => SOME ((n, T), inst))
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2160
        |> split_list;
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2161
    val (given_parm_names, given_parm_types) = given_ps |> split_list;
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2162
25067
0f19e65ac0b6 clarified naming conventions of 'parse' and 'check' (as opposed to former 'cert');
wenzelm
parents: 25038
diff changeset
  2163
    (* parse insts / eqns *)
0f19e65ac0b6 clarified naming conventions of 'parse' and 'check' (as opposed to former 'cert');
wenzelm
parents: 25038
diff changeset
  2164
    val given_insts' = map (parse_term ctxt) given_insts;
0f19e65ac0b6 clarified naming conventions of 'parse' and 'check' (as opposed to former 'cert');
wenzelm
parents: 25038
diff changeset
  2165
    val eqns' = map (parse_prop ctxt) eqns;
0f19e65ac0b6 clarified naming conventions of 'parse' and 'check' (as opposed to former 'cert');
wenzelm
parents: 25038
diff changeset
  2166
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2167
    (* type inference and contexts *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2168
    val arg = type_parms @ map2 TypeInfer.constrain given_parm_types given_insts' @ eqns';
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2169
    val res = Syntax.check_terms ctxt arg;
24941
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2170
    val ctxt' = ctxt |> fold Variable.auto_fixes res;
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2171
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2172
    (* instantiation *)
24941
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2173
    val (type_parms'', res') = chop (length type_parms) res;
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2174
    val (given_insts'', eqns'') = chop (length given_insts) res';
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2175
    val instT = Symtab.make (type_parm_names ~~ map Logic.dest_type type_parms'');
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2176
    val inst = Symtab.make (given_parm_names ~~ given_insts'');
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2177
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2178
    (* export from eigencontext *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2179
    val export = Variable.export_morphism ctxt' ctxt;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2180
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2181
    (* import, its inverse *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2182
    val domT = fold Term.add_tfrees res [] |> map TFree;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2183
    val importT = domT |> map (fn x => (Morphism.typ export x, x))
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2184
      |> map_filter (fn (TFree _, _) => NONE  (* fixed point of export *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2185
               | (TVar y, x) => SOME (fst y, x)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2186
               | _ => error "internal: illegal export in interpretation")
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2187
      |> Vartab.make;
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2188
    val dom = fold Term.add_frees res [] |> map Free;
25357
6ea18fd11058 avoid "import" as identifier, which is a keyword in Alice;
wenzelm
parents: 25286
diff changeset
  2189
    val imprt = dom |> map (fn x => (Morphism.term export x, x))
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2190
      |> map_filter (fn (Free _, _) => NONE  (* fixed point of export *)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2191
               | (Var y, x) => SOME (fst y, x)
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2192
               | _ => error "internal: illegal export in interpretation")
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2193
      |> Vartab.make;
25357
6ea18fd11058 avoid "import" as identifier, which is a keyword in Alice;
wenzelm
parents: 25286
diff changeset
  2194
  in (((instT, inst), eqns''), (export, ((importT, domT), (imprt, dom)))) end;
24941
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2195
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2196
val read_instantiations = prep_instantiations Syntax.parse_term Syntax.parse_prop;
25067
0f19e65ac0b6 clarified naming conventions of 'parse' and 'check' (as opposed to former 'cert');
wenzelm
parents: 25038
diff changeset
  2197
val check_instantiations = prep_instantiations (K I) (K I);
15598
4ab52355bb53 Registrations of global locale interpretations: improved, better naming.
ballarin
parents: 15596
diff changeset
  2198
22772
e0788ff2e811 read_instantiations: proper type-inference with fixed variables, infer parameter types as well;
wenzelm
parents: 22756
diff changeset
  2199
fun gen_prep_registration mk_ctxt test_reg activate
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2200
    prep_attr prep_expr prep_insts
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2201
    thy_ctxt raw_attn raw_expr raw_insts =
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2202
  let
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2203
    val ctxt = mk_ctxt thy_ctxt;
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2204
    val thy = ProofContext.theory_of ctxt;
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2205
    val ctxt' = ProofContext.init thy;
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2206
    fun prep_attn attn = (apsnd o map)
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2207
      (Attrib.crude_closure ctxt o Args.assignable o prep_attr thy) attn;
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2208
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2209
    val attn = prep_attn raw_attn;
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2210
    val expr = prep_expr thy raw_expr;
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2211
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2212
    val pts = params_of_expr ctxt' [] expr ([], Symtab.empty, Symtab.empty);
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2213
    val params_ids = make_params_ids (#1 pts);
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2214
    val raw_params_elemss = make_raw_params_elemss pts;
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2215
    val ((ids, _), raw_elemss) = flatten (ctxt', I) (([], Symtab.empty), Expr expr);
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2216
    val ((parms, all_elemss, _), (_, (_, defs, _))) =
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2217
      read_elemss false ctxt' [] (raw_params_elemss @ raw_elemss) [];
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2218
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2219
    (** compute instantiation **)
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2220
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2221
    (* consistency check: equations need to be stored in a particular locale,
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2222
       therefore if equations are present locale expression must be a name *)
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2223
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2224
    val _ = case (expr, snd raw_insts) of
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2225
        (Locale _, _) => () | (_, []) => ()
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2226
      | (_, _) => error "Interpretations with `where' only permitted if locale expression is a name.";
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2227
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2228
    (* read or certify instantiation *)
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2229
    val (raw_insts', raw_eqns) = raw_insts;
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2230
    val (raw_eq_attns, raw_eqns') = split_list raw_eqns;
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2231
    val (((instT, inst1), eqns), morphs) = prep_insts ctxt parms (raw_insts', raw_eqns');
25095
ea8307dac208 Interpretation equations may have name and/or attribute;
ballarin
parents: 25073
diff changeset
  2232
    val eq_attns = map prep_attn raw_eq_attns;
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2233
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2234
    (* defined params without given instantiation *)
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2235
    val not_given = filter_out (Symtab.defined inst1 o fst) parms;
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  2236
    fun add_def (p, pT) inst =
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2237
      let
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2238
        val (t, T) = case find_first (fn (Free (a, _), _) => a = p) defs of
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2239
               NONE => error ("Instance missing for parameter " ^ quote p)
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2240
             | SOME (Free (_, T), t) => (t, T);
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2241
        val d = Element.inst_term (instT, inst) t;
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  2242
      in Symtab.update_new (p, d) inst end;
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2243
    val inst2 = fold add_def not_given inst1;
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2244
    val inst_morphism = Element.inst_morphism thy (instT, inst2);
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  2245
    (* Note: insts contain no vars. *)
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2246
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2247
    (** compute proof obligations **)
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2248
15598
4ab52355bb53 Registrations of global locale interpretations: improved, better naming.
ballarin
parents: 15596
diff changeset
  2249
    (* restore "small" ids *)
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2250
    val ids' = map (fn ((n, ps), (_, mode)) =>
19783
82f365a14960 Improved parameter management of locales.
ballarin
parents: 19780
diff changeset
  2251
          ((n, map (fn p => Free (p, (the o AList.lookup (op =) parms) p)) ps), mode))
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2252
        ids;
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2253
    val (_, all_elemss') = chop (length raw_params_elemss) all_elemss
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2254
    (* instantiate ids and elements *)
19931
fb32b43e7f80 Restructured locales with predicates: import is now an interpretation.
ballarin
parents: 19914
diff changeset
  2255
    val inst_elemss = (ids' ~~ all_elemss') |> map (fn (((n, ps), _), ((_, mode), elems)) =>
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2256
      ((n, map (Morphism.term (inst_morphism $> fst morphs)) ps),
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  2257
        map (fn Int e => Element.morph_ctxt inst_morphism e) elems)
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  2258
      |> apfst (fn id => (id, map_mode (map (Element.morph_witness inst_morphism)) mode)));
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2259
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
  2260
    (* remove fragments already registered with theory or context *)
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2261
    val new_inst_elemss = filter_out (fn ((id, _), _) =>
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2262
          test_reg thy_ctxt id) inst_elemss;
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2263
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2264
    (* equations *)
23918
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  2265
    val eqn_elems = if null eqns then []
a4abccde0929 interpretation: unfolding of equations;
ballarin
parents: 23655
diff changeset
  2266
      else [(Library.last_elem inst_elemss |> fst |> fst, eqns)];
22658
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2267
263d42253f53 Experimental interpretation code for definitions.
ballarin
parents: 22573
diff changeset
  2268
    val propss = map extract_asms_elems new_inst_elemss @ eqn_elems;
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2269
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2270
  in (propss, activate attn inst_elemss new_inst_elemss propss eq_attns morphs) end;
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2271
22756
b9b78b90ba47 Interpretation equations applied to attributes;
ballarin
parents: 22700
diff changeset
  2272
fun gen_prep_global_registration mk_ctxt = gen_prep_registration ProofContext.init
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2273
  test_global_registration
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2274
  global_activate_facts_elemss mk_ctxt;
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
  2275
22756
b9b78b90ba47 Interpretation equations applied to attributes;
ballarin
parents: 22700
diff changeset
  2276
fun gen_prep_local_registration mk_ctxt = gen_prep_registration I
24787
df56433cc059 Theory/context data restructured; simplified interface for printing of interpretations.
ballarin
parents: 24751
diff changeset
  2277
  test_local_registration
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2278
  local_activate_facts_elemss mk_ctxt;
15624
484178635bd8 Further work on interpretation commands. New command `interpret' for
ballarin
parents: 15623
diff changeset
  2279
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2280
val prep_global_registration = gen_prep_global_registration
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2281
  Attrib.intern_src intern_expr read_instantiations;
24941
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2282
val prep_global_registration_i = gen_prep_global_registration
25067
0f19e65ac0b6 clarified naming conventions of 'parse' and 'check' (as opposed to former 'cert');
wenzelm
parents: 25038
diff changeset
  2283
  (K I) (K I) check_instantiations;
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2284
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2285
val prep_local_registration = gen_prep_local_registration
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2286
  Attrib.intern_src intern_expr read_instantiations;
24941
9ab032df81c8 Prepare proper interface of interpretation_i, interpret_i.
ballarin
parents: 24920
diff changeset
  2287
val prep_local_registration_i = gen_prep_local_registration
25067
0f19e65ac0b6 clarified naming conventions of 'parse' and 'check' (as opposed to former 'cert');
wenzelm
parents: 25038
diff changeset
  2288
  (K I) (K I) check_instantiations;
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2289
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2290
fun prep_registration_in_locale target expr thy =
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2291
  (* target already in internal form *)
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2292
  let
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2293
    val ctxt = ProofContext.init thy;
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2294
    val ((raw_target_ids, target_syn), _) = flatten (ctxt, I)
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2295
        (([], Symtab.empty), Expr (Locale target));
19278
4d762b77d319 Internal restructuring: local parameters.
ballarin
parents: 19276
diff changeset
  2296
    val fixed = the_locale thy target |> #params |> map #1;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2297
    val ((all_ids, syn), raw_elemss) = flatten (ctxt, intern_expr thy)
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2298
        ((raw_target_ids, target_syn), Expr expr);
19018
88b4979193d8 added abbreviations: activated by init, no expressions yet;
wenzelm
parents: 18964
diff changeset
  2299
    val (target_ids, ids) = chop (length raw_target_ids) all_ids;
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2300
    val ((parms, elemss, _), _) = read_elemss false ctxt fixed raw_elemss [];
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2301
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2302
    (** compute proof obligations **)
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2303
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2304
    (* restore "small" ids, with mode *)
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2305
    val ids' = map (apsnd snd) ids;
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2306
    (* remove Int markers *)
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2307
    val elemss' = map (fn (_, es) =>
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2308
        map (fn Int e => e) es) elemss
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2309
    (* extract assumptions and defs *)
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2310
    val ids_elemss = ids' ~~ elemss';
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2311
    val propss = map extract_asms_elems ids_elemss;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2312
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2313
    (** activation function:
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2314
        - add registrations to the target locale
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2315
        - add induced registrations for all global registrations of
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2316
          the target, unless already present
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2317
        - add facts of induced registrations to theory **)
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2318
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  2319
    fun activate thmss thy = let
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2320
        val satisfy = Element.satisfy_thm (flat thmss);
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  2321
        val ids_elemss_thmss = ids_elemss ~~ thmss;
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2322
        val regs = get_global_registrations thy target;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2323
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2324
        fun activate_id (((id, Assumed _), _), thms) thy =
17033
f4c1ce91aa3c Release of interpretation in locale.
ballarin
parents: 17000
diff changeset
  2325
            thy |> put_registration_in_locale target id
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2326
                |> fold (add_witness_in_locale target id) thms
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2327
          | activate_id _ thy = thy;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2328
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2329
        fun activate_reg (vts, (((fully_qualified, prfx), atts2), (exp, imp), _, _)) thy =
21483
e4be91feca50 replaced Args.map_values/Element.map_ctxt_values by general morphism application;
wenzelm
parents: 21441
diff changeset
  2330
          let
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2331
            val (insts, wits, _) = collect_global_witnesses thy imp fixed target_ids vts;
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  2332
            fun inst_parms ps = map
17485
c39871c52977 introduced AList module
haftmann
parents: 17449
diff changeset
  2333
                  (the o AList.lookup (op =) (map #1 fixed ~~ vts)) ps;
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2334
            val disch = Element.satisfy_thm wits;
19482
9f11af8f7ef9 tuned basic list operators (flat, maps, map_filter);
wenzelm
parents: 19423
diff changeset
  2335
            val new_elemss = filter (fn (((name, ps), _), _) =>
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2336
                not (test_global_registration thy (name, inst_parms ps))) (ids_elemss);
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2337
            fun activate_assumed_id (((_, Derived _), _), _) thy = thy
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2338
              | activate_assumed_id ((((name, ps), Assumed _), _), thms) thy = let
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2339
                val ps' = inst_parms ps;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2340
              in
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2341
                if test_global_registration thy (name, ps')
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2342
                then thy
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2343
                else thy
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2344
                  |> put_global_registration (name, ps') ((fully_qualified, prfx), atts2) (exp, imp)
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2345
                  |> fold (fn witn => fn thy => add_global_witness (name, ps')
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2346
                     (Element.morph_witness (Element.inst_morphism thy insts) witn) thy) thms
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2347
              end;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2348
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2349
            fun activate_derived_id ((_, Assumed _), _) thy = thy
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2350
              | activate_derived_id (((name, ps), Derived ths), _) thy = let
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2351
                val ps' = inst_parms ps;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2352
              in
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2353
                if test_global_registration thy (name, ps')
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2354
                then thy
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2355
                else thy
25286
35e954ff67f8 Use of export rather than standard in interpretation.
ballarin
parents: 25270
diff changeset
  2356
                  |> put_global_registration (name, ps') ((fully_qualified, prfx), atts2) (exp, imp)
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2357
                  |> fold (fn witn => fn thy => add_global_witness (name, ps')
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2358
                       (witn |> Element.map_witness (fn (t, th) =>  (* FIXME *)
18137
cb916659c89b moved datatype elem to element.ML;
wenzelm
parents: 18123
diff changeset
  2359
                       (Element.inst_term insts t,
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2360
                        disch (Element.inst_thm thy insts (satisfy th))))) thy) ths
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2361
              end;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2362
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  2363
            fun activate_elem (Notes (kind, facts)) thy =
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2364
                let
21523
a267ecd51f90 tuned morphisms;
wenzelm
parents: 21499
diff changeset
  2365
                  val att_morphism =
22241
5b2dc1b30e7a interpretation: attempt to be more serious about name_morphism;
wenzelm
parents: 21962
diff changeset
  2366
                    Morphism.name_morphism (NameSpace.qualified prfx) $>
21523
a267ecd51f90 tuned morphisms;
wenzelm
parents: 21499
diff changeset
  2367
                    Morphism.thm_morphism satisfy $>
a267ecd51f90 tuned morphisms;
wenzelm
parents: 21499
diff changeset
  2368
                    Element.inst_morphism thy insts $>
a267ecd51f90 tuned morphisms;
wenzelm
parents: 21499
diff changeset
  2369
                    Morphism.thm_morphism disch;
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2370
                  val facts' = facts
21523
a267ecd51f90 tuned morphisms;
wenzelm
parents: 21499
diff changeset
  2371
                    |> Attrib.map_facts (Attrib.attribute_i thy o Args.morph_values att_morphism)
a267ecd51f90 tuned morphisms;
wenzelm
parents: 21499
diff changeset
  2372
                    |> map (apfst (apsnd (fn a => a @ map (Attrib.attribute thy) atts2)))
a267ecd51f90 tuned morphisms;
wenzelm
parents: 21499
diff changeset
  2373
                    |> map (apsnd (map (apfst (map (disch o Element.inst_thm thy insts o satisfy)))))
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2374
                in
18377
0e1d025d57b3 oriented result pairs in PureThy
haftmann
parents: 18358
diff changeset
  2375
                  thy
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  2376
                  |> global_note_prefix_i kind (fully_qualified, prfx) facts'
18377
0e1d025d57b3 oriented result pairs in PureThy
haftmann
parents: 18358
diff changeset
  2377
                  |> snd
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2378
                end
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2379
              | activate_elem _ thy = thy;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2380
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2381
            fun activate_elems (_, elems) thy = fold activate_elem elems thy;
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2382
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2383
          in thy |> fold activate_assumed_id ids_elemss_thmss
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2384
                 |> fold activate_derived_id ids_elemss
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2385
                 |> fold activate_elems new_elemss end;
17033
f4c1ce91aa3c Release of interpretation in locale.
ballarin
parents: 17000
diff changeset
  2386
      in
17138
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2387
        thy |> fold activate_id ids_elemss_thmss
ad4c98fd367b Interpretation in locales: extended back end;
ballarin
parents: 17109
diff changeset
  2388
            |> fold activate_reg regs
17033
f4c1ce91aa3c Release of interpretation in locale.
ballarin
parents: 17000
diff changeset
  2389
      end;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2390
17033
f4c1ce91aa3c Release of interpretation in locale.
ballarin
parents: 17000
diff changeset
  2391
  in (propss, activate) end;
17000
552df70f52c2 First version of interpretation in locales. Not yet fully functional.
ballarin
parents: 16947
diff changeset
  2392
21005
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
  2393
fun prep_propp propss = propss |> map (fn (_, props) =>
21361
653d1631f997 simplified Proof.theorem(_i) interface;
wenzelm
parents: 21264
diff changeset
  2394
  map (rpair [] o Element.mark_witness) props);
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  2395
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  2396
fun prep_result propps thmss =
19780
dce2168b0ea4 export read/cert_expr;
wenzelm
parents: 19732
diff changeset
  2397
  ListPair.map (fn ((_, props), thms) => map2 Element.make_witness props thms) (propps, thmss);
17437
9deaf32c83be interpretation uses primitive goal interface
ballarin
parents: 17412
diff changeset
  2398
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2399
fun gen_interpretation prep_registration after_qed (prfx, raw_atts) raw_expr raw_insts thy =
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  2400
  (* prfx = (flag indicating full qualification, name prefix) *)
17355
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2401
  let
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2402
    val (propss, activate) = prep_registration thy (prfx, raw_atts) raw_expr raw_insts;
20366
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
  2403
    fun after_qed' results =
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
  2404
      ProofContext.theory (activate (prep_result propss results))
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
  2405
      #> after_qed;
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  2406
  in
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2407
    thy
23418
c195f6f13769 balanced conjunctions;
wenzelm
parents: 23228
diff changeset
  2408
    |> ProofContext.init
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  2409
    |> Proof.theorem_i NONE after_qed' (prep_propp propss)
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2410
    |> Element.refine_witness
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2411
    |> Seq.hd
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2412
  end;
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2413
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2414
fun gen_interpret prep_registration after_qed (prfx, atts) expr insts int state =
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  2415
  (* prfx = (flag indicating full qualification, name prefix) *)
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2416
  let
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2417
    val _ = Proof.assert_forward_or_chain state;
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2418
    val ctxt = Proof.context_of state;
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2419
    val (propss, activate) = prep_registration ctxt (prfx, atts) expr insts;
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2420
    fun after_qed' results =
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2421
      Proof.map_context (K (ctxt |> activate (prep_result propss results)))
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2422
      #> Proof.put_facts NONE
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2423
      #> after_qed;
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2424
  in
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2425
    state
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2426
    |> Proof.local_goal (ProofDisplay.print_results int) (K I) ProofContext.bind_propp_i
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2427
      "interpret" NONE after_qed' (map (pair ("", [])) (prep_propp propss))
19810
dae765e552ce renamed Type.(un)varifyT to Logic.(un)varifyT;
wenzelm
parents: 19783
diff changeset
  2428
    |> Element.refine_witness |> Seq.hd
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  2429
  end;
17355
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2430
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2431
in
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2432
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  2433
val interpretation_i = gen_interpretation prep_global_registration_i;
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2434
val interpretation = gen_interpretation prep_global_registration;
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  2435
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2436
20366
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
  2437
fun interpretation_in_locale after_qed (raw_target, expr) thy =
17355
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2438
  let
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2439
    val target = intern thy raw_target;
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2440
    val (propss, activate) = prep_registration_in_locale target expr thy;
21361
653d1631f997 simplified Proof.theorem(_i) interface;
wenzelm
parents: 21264
diff changeset
  2441
    val raw_propp = prep_propp propss;
21005
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
  2442
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
  2443
    val (_, _, goal_ctxt, propp) = thy
21665
ba07e24dc941 encode declarations as notes (attributes), which enables proper inheritance, interpretation etc.;
wenzelm
parents: 21602
diff changeset
  2444
      |> ProofContext.init
21361
653d1631f997 simplified Proof.theorem(_i) interface;
wenzelm
parents: 21264
diff changeset
  2445
      |> cert_context_statement (SOME target) [] raw_propp;
21005
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
  2446
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
  2447
    fun after_qed' results =
20366
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
  2448
      ProofContext.theory (activate (prep_result propss results))
867696dc64fc global goals/qeds: after_qed operates on Proof.context (potentially local_theory);
wenzelm
parents: 20317
diff changeset
  2449
      #> after_qed;
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  2450
  in
21005
8f3896f0e5af interpretation_in_locale: standalone goal setup;
wenzelm
parents: 20965
diff changeset
  2451
    goal_ctxt
21441
940ef3e85c5a notes: proper kind;
wenzelm
parents: 21393
diff changeset
  2452
    |> Proof.theorem_i NONE after_qed' propp
19810
dae765e552ce renamed Type.(un)varifyT to Logic.(un)varifyT;
wenzelm
parents: 19783
diff changeset
  2453
    |> Element.refine_witness |> Seq.hd
18123
1bb572e8cee9 avoid prove_plain, export_plain, simplified after_qed;
wenzelm
parents: 18038
diff changeset
  2454
  end;
17449
429ca1e21289 interpretation: use goal commands without target -- no storing of results;
wenzelm
parents: 17438
diff changeset
  2455
22351
587845efb4cf locale: add_locale accepts explicit predicate name, interpretation supports non-mandatory prefixes
haftmann
parents: 22339
diff changeset
  2456
val interpret_i = gen_interpret prep_local_registration_i;
22300
596f49b70c70 internal interfaces for interpretation and interpret
haftmann
parents: 22241
diff changeset
  2457
val interpret = gen_interpret prep_local_registration;
15596
8665d08085df First version of global registration command.
ballarin
parents: 15574
diff changeset
  2458
11896
1ff33f896720 moved locale.ML to Isar/locale.ML;
wenzelm
parents:
diff changeset
  2459
end;
17355
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2460
5b31131c0365 load late, after proof.ML;
wenzelm
parents: 17316
diff changeset
  2461
end;