| author | haftmann | 
| Tue, 10 Aug 2010 14:53:41 +0200 | |
| changeset 38312 | 9dd57db3c0f2 | 
| parent 36621 | 2fd4e2c76636 | 
| child 39288 | f1ae2493d93f | 
| permissions | -rw-r--r-- | 
| 256 | 1 | (* Title: Pure/type.ML | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 2 | Author: Tobias Nipkow, Lawrence C Paulson, and Markus Wenzel | 
| 0 | 3 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 4 | Type signatures and certified types, special treatment of type vars, | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 5 | matching and unification of types, extend and merge type signatures. | 
| 0 | 6 | *) | 
| 7 | ||
| 8 | signature TYPE = | |
| 2964 | 9 | sig | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 10 | (*type signatures and certified types*) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 11 | datatype decl = | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 12 | LogicalType of int | | 
| 14989 | 13 | Abbreviation of string list * typ * bool | | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 14 | Nonterminal | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 15 | type tsig | 
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 16 | val eq_tsig: tsig * tsig -> bool | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 17 | val rep_tsig: tsig -> | 
| 33095 
bbd52d2f8696
renamed NameSpace to Name_Space -- also to emphasize its subtle change in semantics;
 wenzelm parents: 
33094diff
changeset | 18 |    {classes: Name_Space.T * Sorts.algebra,
 | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 19 | default: sort, | 
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 20 | types: decl Name_Space.table, | 
| 26641 | 21 | log_types: string list} | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 22 | val empty_tsig: tsig | 
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 23 | val class_space: tsig -> Name_Space.T | 
| 35680 | 24 | val class_alias: Name_Space.naming -> binding -> string -> tsig -> tsig | 
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 25 | val intern_class: tsig -> xstring -> string | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 26 | val extern_class: tsig -> string -> xstring | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 27 | val defaultS: tsig -> sort | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 28 | val logical_types: tsig -> string list | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 29 | val eq_sort: tsig -> sort * sort -> bool | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 30 | val subsort: tsig -> sort * sort -> bool | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 31 | val of_sort: tsig -> typ * sort -> bool | 
| 19464 | 32 | val inter_sort: tsig -> sort * sort -> sort | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 33 | val cert_class: tsig -> class -> class | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 34 | val cert_sort: tsig -> sort -> sort | 
| 36447 | 35 | val minimize_sort: tsig -> sort -> sort | 
| 31946 
99ac0321cd47
witness_sorts: proper type witnesses for hyps, not invented "'hyp" variables;
 wenzelm parents: 
30343diff
changeset | 36 | val witness_sorts: tsig -> (typ * sort) list -> sort list -> (typ * sort) list | 
| 24274 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 37 | type mode | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 38 | val mode_default: mode | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 39 | val mode_syntax: mode | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 40 | val mode_abbrev: mode | 
| 24484 | 41 | val get_mode: Proof.context -> mode | 
| 42 | val set_mode: mode -> Proof.context -> Proof.context | |
| 43 | val restore_mode: Proof.context -> Proof.context -> Proof.context | |
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 44 | val type_space: tsig -> Name_Space.T | 
| 35680 | 45 | val type_alias: Name_Space.naming -> binding -> string -> tsig -> tsig | 
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 46 | val intern_type: tsig -> xstring -> string | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 47 | val extern_type: tsig -> string -> xstring | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 48 | val is_logtype: tsig -> string -> bool | 
| 35359 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 49 | val the_decl: tsig -> string -> decl | 
| 24274 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 50 | val cert_typ_mode: mode -> tsig -> typ -> typ | 
| 14993 | 51 | val cert_typ: tsig -> typ -> typ | 
| 19464 | 52 | val arity_number: tsig -> string -> int | 
| 53 | val arity_sorts: Pretty.pp -> tsig -> string -> sort -> sort list | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 54 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 55 | (*special treatment of type vars*) | 
| 36621 
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
 wenzelm parents: 
36450diff
changeset | 56 | val sort_of_atyp: typ -> sort | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 57 | val strip_sorts: typ -> typ | 
| 621 | 58 | val no_tvars: typ -> typ | 
| 35845 
e5980f0ad025
renamed varify/unvarify operations to varify_global/unvarify_global to emphasize that these only work in a global situation;
 wenzelm parents: 
35680diff
changeset | 59 | val varify_global: (string * sort) list -> term -> ((string * sort) * indexname) list * term | 
| 33832 | 60 | val legacy_freeze_thaw_type: typ -> typ * (typ -> typ) | 
| 61 | val legacy_freeze_type: typ -> typ | |
| 62 | val legacy_freeze_thaw: term -> term * (term -> term) | |
| 63 | val legacy_freeze: term -> term | |
| 2964 | 64 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 65 | (*matching and unification*) | 
| 2964 | 66 | exception TYPE_MATCH | 
| 25324 | 67 | type tyenv = (sort * typ) Vartab.table | 
| 26327 | 68 | val lookup: tyenv -> indexname * sort -> typ option | 
| 32648 
143e0b0a6b33
Correct chasing of type variable instantiations during type unification.
 paulson parents: 
32030diff
changeset | 69 | val devar: tyenv -> typ -> typ | 
| 16946 | 70 | val typ_match: tsig -> typ * typ -> tyenv -> tyenv | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 71 | val typ_instance: tsig -> typ * typ -> bool | 
| 16946 | 72 | val raw_match: typ * typ -> tyenv -> tyenv | 
| 19694 | 73 | val raw_matches: typ list * typ list -> tyenv -> tyenv | 
| 16946 | 74 | val raw_instance: typ * typ -> bool | 
| 2964 | 75 | exception TUNIFY | 
| 16946 | 76 | val unify: tsig -> typ * typ -> tyenv * int -> tyenv * int | 
| 77 | val raw_unify: typ * typ -> tyenv -> tyenv | |
| 19696 | 78 | val raw_unifys: typ list * typ list -> tyenv -> tyenv | 
| 17804 | 79 | val could_unify: typ * typ -> bool | 
| 19696 | 80 | val could_unifys: typ list * typ list -> bool | 
| 16650 | 81 | val eq_type: tyenv -> typ * typ -> bool | 
| 0 | 82 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 83 | (*extend and merge type signatures*) | 
| 33095 
bbd52d2f8696
renamed NameSpace to Name_Space -- also to emphasize its subtle change in semantics;
 wenzelm parents: 
33094diff
changeset | 84 | val add_class: Pretty.pp -> Name_Space.naming -> binding * class list -> tsig -> tsig | 
| 26669 | 85 | val hide_class: bool -> string -> tsig -> tsig | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 86 | val set_defsort: sort -> tsig -> tsig | 
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 87 | val add_type: Name_Space.naming -> binding * int -> tsig -> tsig | 
| 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 88 | val add_abbrev: Name_Space.naming -> binding * string list * typ -> tsig -> tsig | 
| 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 89 | val add_nonterminal: Name_Space.naming -> binding -> tsig -> tsig | 
| 26669 | 90 | val hide_type: bool -> string -> tsig -> tsig | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 91 | val add_arity: Pretty.pp -> arity -> tsig -> tsig | 
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 92 | val add_classrel: Pretty.pp -> class * class -> tsig -> tsig | 
| 36450 | 93 | val merge_tsig: Pretty.pp -> tsig * tsig -> tsig | 
| 2964 | 94 | end; | 
| 95 | ||
| 96 | structure Type: TYPE = | |
| 0 | 97 | struct | 
| 98 | ||
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 99 | (** type signatures and certified types **) | 
| 2964 | 100 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 101 | (* type declarations *) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 102 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 103 | datatype decl = | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 104 | LogicalType of int | | 
| 14989 | 105 | Abbreviation of string list * typ * bool | | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 106 | Nonterminal; | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 107 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 108 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 109 | (* type tsig *) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 110 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 111 | datatype tsig = | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 112 |   TSig of {
 | 
| 33095 
bbd52d2f8696
renamed NameSpace to Name_Space -- also to emphasize its subtle change in semantics;
 wenzelm parents: 
33094diff
changeset | 113 | classes: Name_Space.T * Sorts.algebra, (*order-sorted algebra of type classes*) | 
| 16370 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 114 | default: sort, (*default sort on input*) | 
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 115 | types: decl Name_Space.table, (*declared types*) | 
| 26641 | 116 | log_types: string list}; (*logical types sorted by number of arguments*) | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 117 | |
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 118 | fun eq_tsig | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 119 |    (TSig {classes = classes1, default = default1, types = types1, log_types = _},
 | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 120 |     TSig {classes = classes2, default = default2, types = types2, log_types = _}) =
 | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 121 | pointer_eq (classes1, classes2) andalso | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 122 | default1 = default2 andalso | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 123 | pointer_eq (types1, types2); | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 124 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 125 | fun rep_tsig (TSig comps) = comps; | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 126 | |
| 26641 | 127 | fun make_tsig (classes, default, types, log_types) = | 
| 128 |   TSig {classes = classes, default = default, types = types, log_types = log_types};
 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 129 | |
| 33094 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 130 | fun build_tsig (classes, default, types) = | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 131 | let | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 132 | val log_types = | 
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 133 | Symtab.fold (fn (c, LogicalType n) => cons (c, n) | _ => I) (snd types) [] | 
| 33094 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 134 | |> Library.sort (int_ord o pairself snd) |> map fst; | 
| 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 135 | in make_tsig (classes, default, types, log_types) end; | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 136 | |
| 26641 | 137 | fun map_tsig f (TSig {classes, default, types, log_types = _}) =
 | 
| 19642 | 138 | build_tsig (f (classes, default, types)); | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 139 | |
| 16370 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 140 | val empty_tsig = | 
| 33096 | 141 | build_tsig ((Name_Space.empty "class", Sorts.empty_algebra), [], Name_Space.empty_table "type"); | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 142 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 143 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 144 | (* classes and sorts *) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 145 | |
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 146 | val class_space = #1 o #classes o rep_tsig; | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 147 | |
| 35680 | 148 | fun class_alias naming binding name = map_tsig (fn ((space, classes), default, types) => | 
| 149 | ((Name_Space.alias naming binding name space, classes), default, types)); | |
| 150 | ||
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 151 | val intern_class = Name_Space.intern o class_space; | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 152 | val extern_class = Name_Space.extern o class_space; | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 153 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 154 | fun defaultS (TSig {default, ...}) = default;
 | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 155 | fun logical_types (TSig {log_types, ...}) = log_types;
 | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 156 | |
| 16370 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 157 | fun eq_sort (TSig {classes, ...}) = Sorts.sort_eq (#2 classes);
 | 
| 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 158 | fun subsort (TSig {classes, ...}) = Sorts.sort_le (#2 classes);
 | 
| 19642 | 159 | fun of_sort (TSig {classes, ...}) = Sorts.of_sort (#2 classes);
 | 
| 19464 | 160 | fun inter_sort (TSig {classes, ...}) = Sorts.inter_sort (#2 classes);
 | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 161 | |
| 19642 | 162 | fun cert_class (TSig {classes, ...}) = Sorts.certify_class (#2 classes);
 | 
| 163 | fun cert_sort (TSig {classes, ...}) = Sorts.certify_sort (#2 classes);
 | |
| 36447 | 164 | fun minimize_sort (TSig {classes, ...}) = Sorts.minimize_sort (#2 classes);
 | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 165 | |
| 32784 | 166 | fun witness_sorts (TSig {classes, log_types, ...}) =
 | 
| 19642 | 167 | Sorts.witness_sorts (#2 classes) log_types; | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 168 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 169 | |
| 24274 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 170 | (* certification mode *) | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 171 | |
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 172 | datatype mode = Mode of {normalize: bool, logical: bool};
 | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 173 | |
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 174 | val mode_default = Mode {normalize = true, logical = true};
 | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 175 | val mode_syntax = Mode {normalize = true, logical = false};
 | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 176 | val mode_abbrev = Mode {normalize = false, logical = false};
 | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 177 | |
| 33519 | 178 | structure Mode = Proof_Data | 
| 24484 | 179 | ( | 
| 180 | type T = mode; | |
| 181 | fun init _ = mode_default; | |
| 182 | ); | |
| 183 | ||
| 184 | val get_mode = Mode.get; | |
| 185 | fun set_mode mode = Mode.map (K mode); | |
| 186 | fun restore_mode ctxt = set_mode (get_mode ctxt); | |
| 187 | ||
| 24274 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 188 | |
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 189 | (* types *) | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 190 | |
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 191 | val type_space = #1 o #types o rep_tsig; | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 192 | |
| 35680 | 193 | fun type_alias naming binding name = map_tsig (fn (classes, default, (space, types)) => | 
| 194 | (classes, default, (Name_Space.alias naming binding name space, types))); | |
| 195 | ||
| 35669 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 196 | val intern_type = Name_Space.intern o type_space; | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 197 | val extern_type = Name_Space.extern o type_space; | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 198 | |
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 199 | val is_logtype = member (op =) o logical_types; | 
| 
a91c7ed801b8
added ProofContext.tsig_of -- proforma version for local name space only, not logical content;
 wenzelm parents: 
35359diff
changeset | 200 | |
| 27313 | 201 | |
| 202 | fun undecl_type c = "Undeclared type constructor: " ^ quote c; | |
| 203 | ||
| 33094 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 204 | fun lookup_type (TSig {types = (_, types), ...}) = Symtab.lookup types;
 | 
| 27313 | 205 | |
| 35359 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 206 | fun the_decl tsig c = | 
| 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 207 | (case lookup_type tsig c of | 
| 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 208 | NONE => error (undecl_type c) | 
| 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 209 | | SOME decl => decl); | 
| 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 210 | |
| 27313 | 211 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 212 | (* certified types *) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 213 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 214 | fun bad_nargs t = "Bad number of arguments for type constructor: " ^ quote t; | 
| 14830 
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
 wenzelm parents: 
14790diff
changeset | 215 | |
| 14998 | 216 | local | 
| 217 | ||
| 218 | fun inst_typ env (Type (c, Ts)) = Type (c, map (inst_typ env) Ts) | |
| 18957 | 219 | | inst_typ env (T as TFree (x, _)) = the_default T (AList.lookup (op =) env x) | 
| 14998 | 220 | | inst_typ _ T = T; | 
| 221 | ||
| 24274 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 222 | in | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 223 | |
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 224 | fun cert_typ_mode (Mode {normalize, logical}) tsig ty =
 | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 225 | let | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 226 | fun err msg = raise TYPE (msg, [ty], []); | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 227 | |
| 24274 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 228 | val check_logical = | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 229 |       if logical then fn c => err ("Illegal occurrence of syntactic type: " ^ quote c)
 | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 230 | else fn _ => (); | 
| 14989 | 231 | |
| 232 | fun cert (T as Type (c, Ts)) = | |
| 233 | let | |
| 234 | val Ts' = map cert Ts; | |
| 235 | fun nargs n = if length Ts <> n then err (bad_nargs c) else (); | |
| 236 | in | |
| 35359 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 237 | (case the_decl tsig c of | 
| 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 238 | LogicalType n => (nargs n; Type (c, Ts')) | 
| 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 239 | | Abbreviation (vs, U, syn) => | 
| 24274 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 240 | (nargs (length vs); | 
| 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 241 | if syn then check_logical c else (); | 
| 14993 | 242 | if normalize then inst_typ (vs ~~ Ts') U | 
| 14989 | 243 | else Type (c, Ts')) | 
| 35359 
3ec03a3cd9d0
provide direct access to the different kinds of type declarations;
 wenzelm parents: 
34272diff
changeset | 244 | | Nonterminal => (nargs 0; check_logical c; T)) | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 245 | end | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 246 | | cert (TFree (x, S)) = TFree (x, cert_sort tsig S) | 
| 14989 | 247 | | cert (TVar (xi as (_, i), S)) = | 
| 14993 | 248 | if i < 0 then | 
| 249 |             err ("Malformed type variable: " ^ quote (Term.string_of_vname xi))
 | |
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 250 | else TVar (xi, cert_sort tsig S); | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 251 | |
| 14989 | 252 | val ty' = cert ty; | 
| 14993 | 253 | in if ty = ty' then ty else ty' end; (*avoid copying of already normal type*) | 
| 14830 
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
 wenzelm parents: 
14790diff
changeset | 254 | |
| 24274 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 255 | val cert_typ = cert_typ_mode mode_default; | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 256 | |
| 14998 | 257 | end; | 
| 258 | ||
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 259 | |
| 19464 | 260 | (* type arities *) | 
| 261 | ||
| 27302 | 262 | fun arity_number tsig a = | 
| 263 | (case lookup_type tsig a of | |
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 264 | SOME (LogicalType n) => n | 
| 19464 | 265 | | _ => error (undecl_type a)); | 
| 266 | ||
| 267 | fun arity_sorts _ tsig a [] = replicate (arity_number tsig a) [] | |
| 19642 | 268 |   | arity_sorts pp (TSig {classes, ...}) a S = Sorts.mg_domain (#2 classes) a S
 | 
| 26641 | 269 | handle Sorts.CLASS_ERROR err => error (Sorts.class_error pp err); | 
| 19464 | 270 | |
| 271 | ||
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 272 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 273 | (** special treatment of type vars **) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 274 | |
| 36621 
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
 wenzelm parents: 
36450diff
changeset | 275 | (* sort_of_atyp *) | 
| 
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
 wenzelm parents: 
36450diff
changeset | 276 | |
| 
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
 wenzelm parents: 
36450diff
changeset | 277 | fun sort_of_atyp (TFree (_, S)) = S | 
| 
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
 wenzelm parents: 
36450diff
changeset | 278 | | sort_of_atyp (TVar (_, S)) = S | 
| 
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
 wenzelm parents: 
36450diff
changeset | 279 |   | sort_of_atyp T = raise TYPE ("sort_of_atyp", [T], []);
 | 
| 
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
 wenzelm parents: 
36450diff
changeset | 280 | |
| 
2fd4e2c76636
proof terms for strip_shyps, based on the version by krauss/schropp with some notable differences:
 wenzelm parents: 
36450diff
changeset | 281 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 282 | (* strip_sorts *) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 283 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 284 | fun strip_sorts (Type (a, Ts)) = Type (a, map strip_sorts Ts) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 285 | | strip_sorts (TFree (x, _)) = TFree (x, []) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 286 | | strip_sorts (TVar (xi, _)) = TVar (xi, []); | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 287 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 288 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 289 | (* no_tvars *) | 
| 621 | 290 | |
| 291 | fun no_tvars T = | |
| 29275 
9fa69e3858d6
moved old add_type_XXX, add_term_XXX etc. to structure OldTerm;
 wenzelm parents: 
29269diff
changeset | 292 | (case Term.add_tvarsT T [] of [] => T | 
| 12501 | 293 |   | vs => raise TYPE ("Illegal schematic type variable(s): " ^
 | 
| 29275 
9fa69e3858d6
moved old add_type_XXX, add_term_XXX etc. to structure OldTerm;
 wenzelm parents: 
29269diff
changeset | 294 | commas_quote (map (Term.string_of_vname o #1) (rev vs)), [T], [])); | 
| 621 | 295 | |
| 7641 | 296 | |
| 35845 
e5980f0ad025
renamed varify/unvarify operations to varify_global/unvarify_global to emphasize that these only work in a global situation;
 wenzelm parents: 
35680diff
changeset | 297 | (* varify_global *) | 
| 621 | 298 | |
| 35845 
e5980f0ad025
renamed varify/unvarify operations to varify_global/unvarify_global to emphasize that these only work in a global situation;
 wenzelm parents: 
35680diff
changeset | 299 | fun varify_global fixed t = | 
| 621 | 300 | let | 
| 19305 | 301 | val fs = Term.fold_types (Term.fold_atyps | 
| 302 | (fn TFree v => if member (op =) fixed v then I else insert (op =) v | _ => I)) t []; | |
| 29260 | 303 | val used = Name.context | 
| 304 | |> fold_types (fold_atyps (fn TVar ((a, _), _) => Name.declare a | _ => I)) t; | |
| 305 | val fmap = fs ~~ map (rpair 0) (#1 (Name.variants (map fst fs) used)); | |
| 32784 | 306 | fun thaw (f as (_, S)) = | 
| 17184 | 307 | (case AList.lookup (op =) fmap f of | 
| 15531 | 308 | NONE => TFree f | 
| 16946 | 309 | | SOME xi => TVar (xi, S)); | 
| 21116 | 310 | in (fmap, map_types (map_type_tfree thaw) t) end; | 
| 2964 | 311 | |
| 312 | ||
| 7641 | 313 | (* freeze_thaw: freeze TVars in a term; return the "thaw" inverse *) | 
| 3411 
163f8f4a42d7
Removal of freeze_vars and thaw_vars.  New freeze_thaw
 paulson parents: 
3175diff
changeset | 314 | |
| 7641 | 315 | local | 
| 316 | ||
| 16289 | 317 | fun new_name (ix, (pairs, used)) = | 
| 20071 
8f3e1ddb50e6
replaced Term.variant(list) by Name.variant(_list);
 wenzelm parents: 
19806diff
changeset | 318 | let val v = Name.variant used (string_of_indexname ix) | 
| 16289 | 319 | in ((ix, v) :: pairs, v :: used) end; | 
| 621 | 320 | |
| 16289 | 321 | fun freeze_one alist (ix, sort) = | 
| 17184 | 322 | TFree (the (AList.lookup (op =) alist ix), sort) | 
| 15531 | 323 | handle Option => | 
| 3790 | 324 |       raise TYPE ("Failure during freezing of ?" ^ string_of_indexname ix, [], []);
 | 
| 2964 | 325 | |
| 17184 | 326 | fun thaw_one alist (a, sort) = TVar (the (AList.lookup (op =) alist a), sort) | 
| 16289 | 327 | handle Option => TFree (a, sort); | 
| 416 | 328 | |
| 10495 | 329 | in | 
| 330 | ||
| 33832 | 331 | fun legacy_freeze_thaw_type T = | 
| 7641 | 332 | let | 
| 29275 
9fa69e3858d6
moved old add_type_XXX, add_term_XXX etc. to structure OldTerm;
 wenzelm parents: 
29269diff
changeset | 333 | val used = OldTerm.add_typ_tfree_names (T, []) | 
| 
9fa69e3858d6
moved old add_type_XXX, add_term_XXX etc. to structure OldTerm;
 wenzelm parents: 
29269diff
changeset | 334 | and tvars = map #1 (OldTerm.add_typ_tvars (T, [])); | 
| 23178 | 335 | val (alist, _) = List.foldr new_name ([], used) tvars; | 
| 7641 | 336 | in (map_type_tvar (freeze_one alist) T, map_type_tfree (thaw_one (map swap alist))) end; | 
| 337 | ||
| 33832 | 338 | val legacy_freeze_type = #1 o legacy_freeze_thaw_type; | 
| 16289 | 339 | |
| 33832 | 340 | fun legacy_freeze_thaw t = | 
| 7641 | 341 | let | 
| 29275 
9fa69e3858d6
moved old add_type_XXX, add_term_XXX etc. to structure OldTerm;
 wenzelm parents: 
29269diff
changeset | 342 | val used = OldTerm.it_term_types OldTerm.add_typ_tfree_names (t, []) | 
| 
9fa69e3858d6
moved old add_type_XXX, add_term_XXX etc. to structure OldTerm;
 wenzelm parents: 
29269diff
changeset | 343 | and tvars = map #1 (OldTerm.it_term_types OldTerm.add_typ_tvars (t, [])); | 
| 23178 | 344 | val (alist, _) = List.foldr new_name ([], used) tvars; | 
| 7641 | 345 | in | 
| 346 | (case alist of | |
| 347 | [] => (t, fn x => x) (*nothing to do!*) | |
| 20548 
8ef25fe585a8
renamed Term.map_term_types to Term.map_types (cf. Term.fold_types);
 wenzelm parents: 
20071diff
changeset | 348 | | _ => (map_types (map_type_tvar (freeze_one alist)) t, | 
| 
8ef25fe585a8
renamed Term.map_term_types to Term.map_types (cf. Term.fold_types);
 wenzelm parents: 
20071diff
changeset | 349 | map_types (map_type_tfree (thaw_one (map swap alist))))) | 
| 7641 | 350 | end; | 
| 351 | ||
| 33832 | 352 | val legacy_freeze = #1 o legacy_freeze_thaw; | 
| 16289 | 353 | |
| 7641 | 354 | end; | 
| 355 | ||
| 256 | 356 | |
| 357 | ||
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 358 | (** matching and unification of types **) | 
| 8899 | 359 | |
| 15797 | 360 | type tyenv = (sort * typ) Vartab.table; | 
| 256 | 361 | |
| 15797 | 362 | fun tvar_clash ixn S S' = raise TYPE ("Type variable " ^
 | 
| 363 | quote (Term.string_of_vname ixn) ^ " has two distinct sorts", | |
| 364 | [TVar (ixn, S), TVar (ixn, S')], []); | |
| 0 | 365 | |
| 26327 | 366 | fun lookup tye (ixn, S) = | 
| 17412 | 367 | (case Vartab.lookup tye ixn of | 
| 15797 | 368 | NONE => NONE | 
| 16289 | 369 | | SOME (S', T) => if S = S' then SOME T else tvar_clash ixn S S'); | 
| 370 | ||
| 0 | 371 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 372 | (* matching *) | 
| 0 | 373 | |
| 2964 | 374 | exception TYPE_MATCH; | 
| 0 | 375 | |
| 16946 | 376 | fun typ_match tsig = | 
| 2964 | 377 | let | 
| 16340 | 378 | fun match (TVar (v, S), T) subs = | 
| 26327 | 379 | (case lookup subs (v, S) of | 
| 15531 | 380 | NONE => | 
| 17412 | 381 | if of_sort tsig (T, S) then Vartab.update_new (v, (S, T)) subs | 
| 14993 | 382 | else raise TYPE_MATCH | 
| 15531 | 383 | | SOME U => if U = T then subs else raise TYPE_MATCH) | 
| 16340 | 384 | | match (Type (a, Ts), Type (b, Us)) subs = | 
| 2964 | 385 | if a <> b then raise TYPE_MATCH | 
| 16885 | 386 | else matches (Ts, Us) subs | 
| 16340 | 387 | | match (TFree x, TFree y) subs = | 
| 2964 | 388 | if x = y then subs else raise TYPE_MATCH | 
| 16885 | 389 | | match _ _ = raise TYPE_MATCH | 
| 390 | and matches (T :: Ts, U :: Us) subs = matches (Ts, Us) (match (T, U) subs) | |
| 391 | | matches _ subs = subs; | |
| 16946 | 392 | in match end; | 
| 0 | 393 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 394 | fun typ_instance tsig (T, U) = | 
| 16946 | 395 | (typ_match tsig (U, T) Vartab.empty; true) handle TYPE_MATCH => false; | 
| 396 | ||
| 397 | (*purely structural matching*) | |
| 398 | fun raw_match (TVar (v, S), T) subs = | |
| 26327 | 399 | (case lookup subs (v, S) of | 
| 17412 | 400 | NONE => Vartab.update_new (v, (S, T)) subs | 
| 16946 | 401 | | SOME U => if U = T then subs else raise TYPE_MATCH) | 
| 402 | | raw_match (Type (a, Ts), Type (b, Us)) subs = | |
| 403 | if a <> b then raise TYPE_MATCH | |
| 404 | else raw_matches (Ts, Us) subs | |
| 405 | | raw_match (TFree x, TFree y) subs = | |
| 406 | if x = y then subs else raise TYPE_MATCH | |
| 407 | | raw_match _ _ = raise TYPE_MATCH | |
| 408 | and raw_matches (T :: Ts, U :: Us) subs = raw_matches (Ts, Us) (raw_match (T, U) subs) | |
| 19694 | 409 | | raw_matches ([], []) subs = subs | 
| 410 | | raw_matches _ _ = raise TYPE_MATCH; | |
| 16946 | 411 | |
| 412 | fun raw_instance (T, U) = | |
| 413 | (raw_match (U, T) Vartab.empty; true) handle TYPE_MATCH => false; | |
| 2964 | 414 | |
| 0 | 415 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 416 | (* unification *) | 
| 2964 | 417 | |
| 0 | 418 | exception TUNIFY; | 
| 419 | ||
| 26641 | 420 | (*occurs check*) | 
| 2964 | 421 | fun occurs v tye = | 
| 422 | let | |
| 423 | fun occ (Type (_, Ts)) = exists occ Ts | |
| 424 | | occ (TFree _) = false | |
| 15797 | 425 | | occ (TVar (w, S)) = | 
| 29269 
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
 wenzelm parents: 
29260diff
changeset | 426 | Term.eq_ix (v, w) orelse | 
| 26327 | 427 | (case lookup tye (w, S) of | 
| 15531 | 428 | NONE => false | 
| 429 | | SOME U => occ U); | |
| 0 | 430 | in occ end; | 
| 431 | ||
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 432 | (*chase variable assignments; if devar returns a type var then it must be unassigned*) | 
| 16885 | 433 | fun devar tye (T as TVar v) = | 
| 26327 | 434 | (case lookup tye v of | 
| 16885 | 435 | SOME U => devar tye U | 
| 15531 | 436 | | NONE => T) | 
| 32784 | 437 | | devar _ T = T; | 
| 0 | 438 | |
| 17804 | 439 | (*order-sorted unification*) | 
| 32784 | 440 | fun unify (TSig {classes = (_, classes), ...}) TU (tyenv, maxidx) =
 | 
| 2964 | 441 | let | 
| 32738 | 442 | val tyvar_count = Unsynchronized.ref maxidx; | 
| 443 | fun gen_tyvar S = TVar ((Name.aT, Unsynchronized.inc tyvar_count), S); | |
| 2964 | 444 | |
| 19642 | 445 | fun mg_domain a S = Sorts.mg_domain classes a S | 
| 446 | handle Sorts.CLASS_ERROR _ => raise TUNIFY; | |
| 2964 | 447 | |
| 16885 | 448 | fun meet (_, []) tye = tye | 
| 449 | | meet (TVar (xi, S'), S) tye = | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 450 | if Sorts.sort_le classes (S', S) then tye | 
| 17412 | 451 | else Vartab.update_new | 
| 17221 | 452 | (xi, (S', gen_tyvar (Sorts.inter_sort classes (S', S)))) tye | 
| 16885 | 453 | | meet (TFree (_, S'), S) tye = | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 454 | if Sorts.sort_le classes (S', S) then tye | 
| 2964 | 455 | else raise TUNIFY | 
| 16885 | 456 | | meet (Type (a, Ts), S) tye = meets (Ts, mg_domain a S) tye | 
| 457 | and meets (T :: Ts, S :: Ss) tye = meets (Ts, Ss) (meet (devar tye T, S) tye) | |
| 458 | | meets _ tye = tye; | |
| 2964 | 459 | |
| 16885 | 460 | fun unif (ty1, ty2) tye = | 
| 461 | (case (devar tye ty1, devar tye ty2) of | |
| 2964 | 462 | (T as TVar (v, S1), U as TVar (w, S2)) => | 
| 29269 
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
 wenzelm parents: 
29260diff
changeset | 463 | if Term.eq_ix (v, w) then | 
| 15797 | 464 | if S1 = S2 then tye else tvar_clash v S1 S2 | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 465 | else if Sorts.sort_le classes (S1, S2) then | 
| 17412 | 466 | Vartab.update_new (w, (S2, T)) tye | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 467 | else if Sorts.sort_le classes (S2, S1) then | 
| 17412 | 468 | Vartab.update_new (v, (S1, U)) tye | 
| 2964 | 469 | else | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 470 | let val S = gen_tyvar (Sorts.inter_sort classes (S1, S2)) in | 
| 17412 | 471 | Vartab.update_new (v, (S1, S)) (Vartab.update_new (w, (S2, S)) tye) | 
| 2964 | 472 | end | 
| 473 | | (TVar (v, S), T) => | |
| 474 | if occurs v tye T then raise TUNIFY | |
| 17412 | 475 | else meet (T, S) (Vartab.update_new (v, (S, T)) tye) | 
| 2964 | 476 | | (T, TVar (v, S)) => | 
| 477 | if occurs v tye T then raise TUNIFY | |
| 17412 | 478 | else meet (T, S) (Vartab.update_new (v, (S, T)) tye) | 
| 2964 | 479 | | (Type (a, Ts), Type (b, Us)) => | 
| 480 | if a <> b then raise TUNIFY | |
| 16885 | 481 | else unifs (Ts, Us) tye | 
| 482 | | (T, U) => if T = U then tye else raise TUNIFY) | |
| 483 | and unifs (T :: Ts, U :: Us) tye = unifs (Ts, Us) (unif (T, U) tye) | |
| 484 | | unifs _ tye = tye; | |
| 485 | in (unif TU tyenv, ! tyvar_count) end; | |
| 0 | 486 | |
| 16946 | 487 | (*purely structural unification*) | 
| 488 | fun raw_unify (ty1, ty2) tye = | |
| 489 | (case (devar tye ty1, devar tye ty2) of | |
| 32784 | 490 | (T as TVar (v, S1), TVar (w, S2)) => | 
| 29269 
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
 wenzelm parents: 
29260diff
changeset | 491 | if Term.eq_ix (v, w) then | 
| 16946 | 492 | if S1 = S2 then tye else tvar_clash v S1 S2 | 
| 17412 | 493 | else Vartab.update_new (w, (S2, T)) tye | 
| 16946 | 494 | | (TVar (v, S), T) => | 
| 495 | if occurs v tye T then raise TUNIFY | |
| 17412 | 496 | else Vartab.update_new (v, (S, T)) tye | 
| 16946 | 497 | | (T, TVar (v, S)) => | 
| 498 | if occurs v tye T then raise TUNIFY | |
| 17412 | 499 | else Vartab.update_new (v, (S, T)) tye | 
| 16946 | 500 | | (Type (a, Ts), Type (b, Us)) => | 
| 501 | if a <> b then raise TUNIFY | |
| 502 | else raw_unifys (Ts, Us) tye | |
| 503 | | (T, U) => if T = U then tye else raise TUNIFY) | |
| 504 | and raw_unifys (T :: Ts, U :: Us) tye = raw_unifys (Ts, Us) (raw_unify (T, U) tye) | |
| 19696 | 505 | | raw_unifys ([], []) tye = tye | 
| 506 | | raw_unifys _ _ = raise TUNIFY; | |
| 16946 | 507 | |
| 17804 | 508 | (*fast unification filter*) | 
| 509 | fun could_unify (Type (a, Ts), Type (b, Us)) = a = b andalso could_unifys (Ts, Us) | |
| 510 | | could_unify (TFree (a, _), TFree (b, _)) = a = b | |
| 511 | | could_unify (TVar _, _) = true | |
| 512 | | could_unify (_, TVar _) = true | |
| 513 | | could_unify _ = false | |
| 514 | and could_unifys (T :: Ts, U :: Us) = could_unify (T, U) andalso could_unifys (Ts, Us) | |
| 19696 | 515 | | could_unifys ([], []) = true | 
| 516 | | could_unifys _ = false; | |
| 450 | 517 | |
| 17804 | 518 | |
| 519 | (*equality with respect to a type environment*) | |
| 32030 | 520 | fun equal_type tye (T, T') = | 
| 16885 | 521 | (case (devar tye T, devar tye T') of | 
| 16650 | 522 | (Type (s, Ts), Type (s', Ts')) => | 
| 32030 | 523 | s = s' andalso ListPair.all (equal_type tye) (Ts, Ts') | 
| 16650 | 524 | | (U, U') => U = U'); | 
| 525 | ||
| 32030 | 526 | fun eq_type tye = | 
| 527 | if Vartab.is_empty tye then op = else equal_type tye; | |
| 528 | ||
| 450 | 529 | |
| 0 | 530 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 531 | (** extend and merge type signatures **) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 532 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 533 | (* classes *) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 534 | |
| 16370 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 535 | fun add_class pp naming (c, cs) tsig = | 
| 19642 | 536 | tsig |> map_tsig (fn ((space, classes), default, types) => | 
| 16370 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 537 | let | 
| 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 538 | val cs' = map (cert_class tsig) cs | 
| 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 539 | handle TYPE (msg, _, _) => error msg; | 
| 33095 
bbd52d2f8696
renamed NameSpace to Name_Space -- also to emphasize its subtle change in semantics;
 wenzelm parents: 
33094diff
changeset | 540 | val (c', space') = space |> Name_Space.declare true naming c; | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 541 | val classes' = classes |> Sorts.add_class pp (c', cs'); | 
| 19642 | 542 | in ((space', classes'), default, types) end); | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 543 | |
| 26669 | 544 | fun hide_class fully c = map_tsig (fn ((space, classes), default, types) => | 
| 33095 
bbd52d2f8696
renamed NameSpace to Name_Space -- also to emphasize its subtle change in semantics;
 wenzelm parents: 
33094diff
changeset | 545 | ((Name_Space.hide fully c space, classes), default, types)); | 
| 16370 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 546 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 547 | |
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 548 | (* arities *) | 
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 549 | |
| 19642 | 550 | fun add_arity pp (t, Ss, S) tsig = tsig |> map_tsig (fn ((space, classes), default, types) => | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 551 | let | 
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 552 | val _ = | 
| 27302 | 553 | (case lookup_type tsig t of | 
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 554 | SOME (LogicalType n) => if length Ss <> n then error (bad_nargs t) else () | 
| 33094 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 555 |       | SOME _ => error ("Logical type constructor expected: " ^ quote t)
 | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 556 | | NONE => error (undecl_type t)); | 
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 557 | val (Ss', S') = (map (cert_sort tsig) Ss, cert_sort tsig S) | 
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 558 | handle TYPE (msg, _, _) => error msg; | 
| 19642 | 559 | val classes' = classes |> Sorts.add_arities pp ((t, map (fn c' => (c', Ss')) S')); | 
| 560 | in ((space, classes'), default, types) end); | |
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 561 | |
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 562 | |
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 563 | (* classrel *) | 
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 564 | |
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 565 | fun add_classrel pp rel tsig = | 
| 19642 | 566 | tsig |> map_tsig (fn ((space, classes), default, types) => | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 567 | let | 
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 568 | val rel' = pairself (cert_class tsig) rel | 
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 569 | handle TYPE (msg, _, _) => error msg; | 
| 32784 | 570 | val classes' = classes |> Sorts.add_classrel pp rel'; | 
| 19642 | 571 | in ((space, classes'), default, types) end); | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 572 | |
| 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 573 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 574 | (* default sort *) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 575 | |
| 19642 | 576 | fun set_defsort S tsig = tsig |> map_tsig (fn (classes, _, types) => | 
| 577 | (classes, cert_sort tsig S handle TYPE (msg, _, _) => error msg, types)); | |
| 0 | 578 | |
| 579 | ||
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 580 | (* types *) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 581 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 582 | local | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 583 | |
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 584 | fun new_decl naming (c, decl) types = | 
| 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 585 | #2 (Name_Space.define true naming (c, decl) types); | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 586 | |
| 19642 | 587 | fun map_types f = map_tsig (fn (classes, default, types) => | 
| 19579 
b802d1804b77
replaced Sorts.DOMAIN by general Sorts.CLASS_ERROR;
 wenzelm parents: 
19530diff
changeset | 588 | let | 
| 
b802d1804b77
replaced Sorts.DOMAIN by general Sorts.CLASS_ERROR;
 wenzelm parents: 
19530diff
changeset | 589 | val (space', tab') = f types; | 
| 33095 
bbd52d2f8696
renamed NameSpace to Name_Space -- also to emphasize its subtle change in semantics;
 wenzelm parents: 
33094diff
changeset | 590 | val _ = Name_Space.intern space' "dummy" = "dummy" orelse | 
| 21858 
05f57309170c
avoid conflict with Alice keywords: renamed pack -> implode, unpack -> explode, any -> many, avoided assert;
 wenzelm parents: 
21116diff
changeset | 591 | error "Illegal declaration of dummy type"; | 
| 19642 | 592 | in (classes, default, (space', tab')) end); | 
| 2964 | 593 | |
| 14989 | 594 | fun syntactic types (Type (c, Ts)) = | 
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 595 | (case Symtab.lookup types c of SOME Nonterminal => true | _ => false) | 
| 14989 | 596 | orelse exists (syntactic types) Ts | 
| 597 | | syntactic _ _ = false; | |
| 598 | ||
| 27302 | 599 | in | 
| 600 | ||
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 601 | fun add_type naming (c, n) = | 
| 33094 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 602 |   if n < 0 then error ("Bad type constructor declaration " ^ quote (Binding.str_of c))
 | 
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 603 | else map_types (new_decl naming (c, LogicalType n)); | 
| 27302 | 604 | |
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 605 | fun add_abbrev naming (a, vs, rhs) tsig = tsig |> map_types (fn types => | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 606 | let | 
| 30343 
79f022df8527
replace old bstring by binding for logical primitives: class, type, const etc.;
 wenzelm parents: 
29275diff
changeset | 607 | fun err msg = | 
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 608 |       cat_error msg ("The error(s) above occurred in type abbreviation " ^
 | 
| 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 609 | quote (Binding.str_of a)); | 
| 24274 
cb9236269af1
type mode: models certification mode (default, syntax, abbrev);
 wenzelm parents: 
23655diff
changeset | 610 | val rhs' = strip_sorts (no_tvars (cert_typ_mode mode_syntax tsig rhs)) | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 611 | handle TYPE (msg, _, _) => err msg; | 
| 33094 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 612 | val _ = | 
| 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 613 | (case duplicates (op =) vs of | 
| 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 614 | [] => [] | 
| 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 615 |       | dups => err ("Duplicate variables on lhs: " ^ commas_quote dups));
 | 
| 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 616 | val _ = | 
| 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 617 | (case subtract (op =) vs (map #1 (Term.add_tfreesT rhs' [])) of | 
| 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 618 | [] => [] | 
| 
ef0d77b1e687
eliminated separate stamp -- NameSpace.define/merge etc. ensure uniqueness already;
 wenzelm parents: 
32784diff
changeset | 619 |       | extras => err ("Extra variables on rhs: " ^ commas_quote extras));
 | 
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 620 | in types |> new_decl naming (a, Abbreviation (vs, rhs', syntactic (#2 types) rhs')) end); | 
| 0 | 621 | |
| 33173 
b8ca12f6681a
eliminated obsolete tags for types/consts -- now handled via name space, in strongly typed fashion;
 wenzelm parents: 
33097diff
changeset | 622 | fun add_nonterminal naming = map_types o new_decl naming o rpair Nonterminal; | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 623 | |
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 624 | end; | 
| 0 | 625 | |
| 26669 | 626 | fun hide_type fully c = map_tsig (fn (classes, default, (space, types)) => | 
| 33095 
bbd52d2f8696
renamed NameSpace to Name_Space -- also to emphasize its subtle change in semantics;
 wenzelm parents: 
33094diff
changeset | 627 | (classes, default, (Name_Space.hide fully c space, types))); | 
| 16370 
033d890fe91f
name space of classes and types maintained in tsig;
 wenzelm parents: 
16340diff
changeset | 628 | |
| 3790 | 629 | |
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 630 | (* merge type signatures *) | 
| 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 631 | |
| 36450 | 632 | fun merge_tsig pp (tsig1, tsig2) = | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 633 | let | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 634 |     val (TSig {classes = (space1, classes1), default = default1, types = types1,
 | 
| 26641 | 635 | log_types = _}) = tsig1; | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 636 |     val (TSig {classes = (space2, classes2), default = default2, types = types2,
 | 
| 26641 | 637 | log_types = _}) = tsig2; | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 638 | |
| 33095 
bbd52d2f8696
renamed NameSpace to Name_Space -- also to emphasize its subtle change in semantics;
 wenzelm parents: 
33094diff
changeset | 639 | val space' = Name_Space.merge (space1, space2); | 
| 19642 | 640 | val classes' = Sorts.merge_algebra pp (classes1, classes2); | 
| 19515 
9f650083da65
build classes/arities: refer to operations in sorts.ML;
 wenzelm parents: 
19464diff
changeset | 641 | val default' = Sorts.inter_sort classes' (default1, default2); | 
| 33095 
bbd52d2f8696
renamed NameSpace to Name_Space -- also to emphasize its subtle change in semantics;
 wenzelm parents: 
33094diff
changeset | 642 | val types' = Name_Space.merge_tables (types1, types2); | 
| 19642 | 643 | in build_tsig ((space', classes'), default', types') end; | 
| 14790 
0d984ee030a1
major cleanup of tsig datastructures and extend/merge operations; fixes old bugs in classes/arities code; proper treatment of nonterminals and syntax-only types;
 wenzelm parents: 
13666diff
changeset | 644 | |
| 0 | 645 | end; |