author | wenzelm |
Tue, 22 Jun 2004 10:05:47 +0200 | |
changeset 14998 | 9606c6224933 |
parent 14993 | 802f3732a54e |
child 15531 | 08c8dad8e399 |
permissions | -rw-r--r-- |
256 | 1 |
(* Title: Pure/type.ML |
0 | 2 |
ID: $Id$ |
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:
13666
diff
changeset
|
3 |
Author: Tobias Nipkow, Lawrence C Paulson, and Markus Wenzel |
0 | 4 |
|
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:
13666
diff
changeset
|
5 |
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:
13666
diff
changeset
|
6 |
matching and unification of types, extend and merge type signatures. |
0 | 7 |
*) |
8 |
||
9 |
signature TYPE = |
|
2964 | 10 |
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:
13666
diff
changeset
|
11 |
(*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:
13666
diff
changeset
|
12 |
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:
13666
diff
changeset
|
13 |
LogicalType of int | |
14989 | 14 |
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:
13666
diff
changeset
|
15 |
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:
13666
diff
changeset
|
16 |
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:
13666
diff
changeset
|
17 |
val rep_tsig: 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:
13666
diff
changeset
|
18 |
{classes: Sorts.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:
13666
diff
changeset
|
19 |
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:
13666
diff
changeset
|
20 |
types: (decl * stamp) Symtab.table, |
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:
13666
diff
changeset
|
21 |
arities: Sorts.arities, |
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:
13666
diff
changeset
|
22 |
log_types: 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:
13666
diff
changeset
|
23 |
witness: (typ * sort) option} |
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:
13666
diff
changeset
|
24 |
val empty_tsig: 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:
13666
diff
changeset
|
25 |
val classes: tsig -> class 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:
13666
diff
changeset
|
26 |
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:
13666
diff
changeset
|
27 |
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:
13666
diff
changeset
|
28 |
val universal_witness: tsig -> (typ * sort) option |
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:
13666
diff
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:
13666
diff
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:
13666
diff
changeset
|
31 |
val of_sort: tsig -> typ * 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:
13666
diff
changeset
|
32 |
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:
13666
diff
changeset
|
33 |
val cert_sort: tsig -> sort -> 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:
13666
diff
changeset
|
34 |
val witness_sorts: tsig -> sort list -> sort list -> (typ * sort) list |
14993 | 35 |
val cert_typ: tsig -> typ -> typ |
36 |
val cert_typ_syntax: tsig -> typ -> typ |
|
37 |
val cert_typ_raw: tsig -> typ -> typ |
|
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:
13666
diff
changeset
|
38 |
|
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:
13666
diff
changeset
|
39 |
(*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:
13666
diff
changeset
|
40 |
val strip_sorts: typ -> typ |
621 | 41 |
val no_tvars: typ -> typ |
42 |
val varifyT: typ -> typ |
|
43 |
val unvarifyT: typ -> typ |
|
12501 | 44 |
val varify: term * string list -> term * (string * indexname) list |
10495 | 45 |
val freeze_thaw_type : typ -> typ * (typ -> typ) |
3411
163f8f4a42d7
Removal of freeze_vars and thaw_vars. New freeze_thaw
paulson
parents:
3175
diff
changeset
|
46 |
val freeze_thaw : term -> term * (term -> term) |
2964 | 47 |
|
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:
13666
diff
changeset
|
48 |
(*matching and unification*) |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
49 |
val inst_typ_tvars: Pretty.pp -> tsig -> (indexname * typ) list -> typ -> typ |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
50 |
val inst_term_tvars: Pretty.pp -> tsig -> (indexname * typ) list -> term -> term |
2964 | 51 |
exception TYPE_MATCH |
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:
13666
diff
changeset
|
52 |
val typ_match: tsig -> typ Vartab.table * (typ * typ) -> typ Vartab.table |
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:
13666
diff
changeset
|
53 |
val typ_instance: tsig -> typ * typ -> bool |
2964 | 54 |
exception TUNIFY |
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:
13666
diff
changeset
|
55 |
val unify: tsig -> typ Vartab.table * int -> typ * typ -> typ Vartab.table * int |
450 | 56 |
val raw_unify: typ * typ -> bool |
0 | 57 |
|
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:
13666
diff
changeset
|
58 |
(*extend and merge type signatures*) |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
59 |
val add_classes: Pretty.pp -> (class * class list) list -> tsig -> tsig |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
60 |
val add_classrel: Pretty.pp -> (class * class) list -> 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:
13666
diff
changeset
|
61 |
val set_defsort: sort -> tsig -> 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:
13666
diff
changeset
|
62 |
val add_types: (string * int) list -> tsig -> 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:
13666
diff
changeset
|
63 |
val add_abbrs: (string * string list * typ) list -> tsig -> 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:
13666
diff
changeset
|
64 |
val add_nonterminals: string list -> tsig -> tsig |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
65 |
val add_arities: Pretty.pp -> arity list -> tsig -> tsig |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
66 |
val merge_tsigs: Pretty.pp -> tsig * tsig -> tsig |
2964 | 67 |
end; |
68 |
||
69 |
structure Type: TYPE = |
|
0 | 70 |
struct |
71 |
||
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:
13666
diff
changeset
|
72 |
(** type signatures and certified types **) |
2964 | 73 |
|
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:
13666
diff
changeset
|
74 |
(* 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:
13666
diff
changeset
|
75 |
|
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:
13666
diff
changeset
|
76 |
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:
13666
diff
changeset
|
77 |
LogicalType of int | |
14989 | 78 |
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:
13666
diff
changeset
|
79 |
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:
13666
diff
changeset
|
80 |
|
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:
13666
diff
changeset
|
81 |
fun str_of_decl (LogicalType _) = "logical type constructor" |
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:
13666
diff
changeset
|
82 |
| str_of_decl (Abbreviation _) = "type abbreviation" |
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:
13666
diff
changeset
|
83 |
| str_of_decl Nonterminal = "syntactic type"; |
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:
13666
diff
changeset
|
84 |
|
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:
13666
diff
changeset
|
85 |
|
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:
13666
diff
changeset
|
86 |
(* 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:
13666
diff
changeset
|
87 |
|
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:
13666
diff
changeset
|
88 |
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:
13666
diff
changeset
|
89 |
TSig of { |
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:
13666
diff
changeset
|
90 |
classes: Sorts.classes, (*declared classes with proper subclass relation*) |
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:
13666
diff
changeset
|
91 |
default: sort, (*default sort on input*) |
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:
13666
diff
changeset
|
92 |
types: (decl * stamp) Symtab.table, (*declared 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:
13666
diff
changeset
|
93 |
arities: Sorts.arities, (*image specification of types wrt. 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:
13666
diff
changeset
|
94 |
log_types: string list, (*logical types sorted by number of arguments*) |
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:
13666
diff
changeset
|
95 |
witness: (typ * sort) option}; (*witness for non-emptiness of strictest 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:
13666
diff
changeset
|
96 |
|
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:
13666
diff
changeset
|
97 |
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:
13666
diff
changeset
|
98 |
|
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:
13666
diff
changeset
|
99 |
fun make_tsig (classes, default, types, arities, log_types, witness) = |
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:
13666
diff
changeset
|
100 |
TSig {classes = classes, default = default, types = types, arities = arities, |
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:
13666
diff
changeset
|
101 |
log_types = log_types, witness = witness}; |
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:
13666
diff
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:
13666
diff
changeset
|
103 |
fun map_tsig f (TSig {classes, default, types, arities, log_types, witness}) = |
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:
13666
diff
changeset
|
104 |
make_tsig (f (classes, default, types, arities, log_types, witness)); |
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:
13666
diff
changeset
|
105 |
|
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:
13666
diff
changeset
|
106 |
fun build_tsig (classes, default, types, arities) = |
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:
13666
diff
changeset
|
107 |
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:
13666
diff
changeset
|
108 |
fun add_log_type (ts, (c, (LogicalType n, _))) = (c, n) :: 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:
13666
diff
changeset
|
109 |
| add_log_type (ts, _) = 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:
13666
diff
changeset
|
110 |
val 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:
13666
diff
changeset
|
111 |
Symtab.foldl add_log_type ([], 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:
13666
diff
changeset
|
112 |
|> Library.sort (Library.int_ord o pairself #2) |> map #1; |
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:
13666
diff
changeset
|
113 |
val witness = |
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:
13666
diff
changeset
|
114 |
(case Sorts.witness_sorts (classes, arities) log_types [] [Graph.keys classes] of |
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:
13666
diff
changeset
|
115 |
[w] => Some w | _ => None); |
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:
13666
diff
changeset
|
116 |
in make_tsig (classes, default, types, arities, log_types, witness) end; |
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:
13666
diff
changeset
|
117 |
|
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:
13666
diff
changeset
|
118 |
fun change_tsig f (TSig {classes, default, types, arities, log_types = _, witness = _}) = |
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:
13666
diff
changeset
|
119 |
build_tsig (f (classes, default, types, arities)); |
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:
13666
diff
changeset
|
120 |
|
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:
13666
diff
changeset
|
121 |
val empty_tsig = build_tsig (Graph.empty, [], Symtab.empty, Symtab.empty); |
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:
13666
diff
changeset
|
122 |
|
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:
13666
diff
changeset
|
123 |
|
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:
13666
diff
changeset
|
124 |
(* 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:
13666
diff
changeset
|
125 |
|
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:
13666
diff
changeset
|
126 |
fun classes (TSig {classes = C, ...}) = Graph.keys C; |
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:
13666
diff
changeset
|
127 |
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:
13666
diff
changeset
|
128 |
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:
13666
diff
changeset
|
129 |
fun universal_witness (TSig {witness, ...}) = witness; |
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:
13666
diff
changeset
|
130 |
|
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:
13666
diff
changeset
|
131 |
fun eq_sort (TSig {classes, ...}) = Sorts.sort_eq 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:
13666
diff
changeset
|
132 |
fun subsort (TSig {classes, ...}) = Sorts.sort_le 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:
13666
diff
changeset
|
133 |
fun of_sort (TSig {classes, arities, ...}) = Sorts.of_sort (classes, arities); |
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:
13666
diff
changeset
|
134 |
|
14989 | 135 |
fun cert_class (TSig {classes, ...}) = Sorts.certify_class classes; |
136 |
fun cert_sort (TSig {classes, ...}) = Sorts.certify_sort 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:
13666
diff
changeset
|
137 |
|
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:
13666
diff
changeset
|
138 |
fun witness_sorts (tsig as TSig {classes, arities, 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:
13666
diff
changeset
|
139 |
Sorts.witness_sorts (classes, arities) 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:
13666
diff
changeset
|
140 |
|
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:
13666
diff
changeset
|
141 |
|
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:
13666
diff
changeset
|
142 |
(* 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:
13666
diff
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:
13666
diff
changeset
|
144 |
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:
14790
diff
changeset
|
145 |
fun undecl_type c = "Undeclared type constructor: " ^ quote c; |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
146 |
|
14998 | 147 |
local |
148 |
||
149 |
fun inst_typ env (Type (c, Ts)) = Type (c, map (inst_typ env) Ts) |
|
150 |
| inst_typ env (T as TFree (x, _)) = if_none (Library.assoc_string (env, x)) T |
|
151 |
| inst_typ _ T = T; |
|
152 |
||
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:
13666
diff
changeset
|
153 |
fun certify_typ normalize syntax tsig 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:
13666
diff
changeset
|
154 |
let |
14989 | 155 |
val TSig {classes, types, ...} = 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:
13666
diff
changeset
|
156 |
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:
13666
diff
changeset
|
157 |
|
14989 | 158 |
val check_syntax = |
159 |
if syntax then K () |
|
160 |
else fn c => err ("Illegal occurrence of syntactic type: " ^ quote c); |
|
161 |
||
162 |
fun cert (T as Type (c, Ts)) = |
|
163 |
let |
|
164 |
val Ts' = map cert Ts; |
|
165 |
fun nargs n = if length Ts <> n then err (bad_nargs c) else (); |
|
166 |
in |
|
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:
13666
diff
changeset
|
167 |
(case Symtab.lookup (types, c) of |
14989 | 168 |
Some (LogicalType n, _) => (nargs n; Type (c, Ts')) |
169 |
| Some (Abbreviation (vs, U, syn), _) => (nargs (length vs); |
|
170 |
if syn then check_syntax c else (); |
|
14993 | 171 |
if normalize then inst_typ (vs ~~ Ts') U |
14989 | 172 |
else Type (c, Ts')) |
173 |
| Some (Nonterminal, _) => (nargs 0; check_syntax c; T) |
|
174 |
| None => err (undecl_type c)) |
|
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:
13666
diff
changeset
|
175 |
end |
14989 | 176 |
| cert (TFree (x, S)) = TFree (x, Sorts.certify_sort classes S) |
177 |
| cert (TVar (xi as (_, i), S)) = |
|
14993 | 178 |
if i < 0 then |
179 |
err ("Malformed type variable: " ^ quote (Term.string_of_vname xi)) |
|
14989 | 180 |
else TVar (xi, Sorts.certify_sort classes 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:
13666
diff
changeset
|
181 |
|
14989 | 182 |
val ty' = cert ty; |
14993 | 183 |
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:
14790
diff
changeset
|
184 |
|
14998 | 185 |
in |
186 |
||
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:
13666
diff
changeset
|
187 |
val cert_typ = certify_typ true false; |
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:
13666
diff
changeset
|
188 |
val cert_typ_syntax = certify_typ true true; |
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:
13666
diff
changeset
|
189 |
val cert_typ_raw = certify_typ false true; |
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:
13666
diff
changeset
|
190 |
|
14998 | 191 |
end; |
192 |
||
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:
13666
diff
changeset
|
193 |
|
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:
13666
diff
changeset
|
194 |
|
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:
13666
diff
changeset
|
195 |
(** 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:
13666
diff
changeset
|
196 |
|
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:
13666
diff
changeset
|
197 |
(* 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:
13666
diff
changeset
|
198 |
|
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:
13666
diff
changeset
|
199 |
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:
13666
diff
changeset
|
200 |
| 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:
13666
diff
changeset
|
201 |
| 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:
13666
diff
changeset
|
202 |
|
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:
13666
diff
changeset
|
203 |
|
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:
13666
diff
changeset
|
204 |
(* no_tvars *) |
621 | 205 |
|
206 |
fun no_tvars T = |
|
12501 | 207 |
(case typ_tvars T of [] => T |
208 |
| vs => raise TYPE ("Illegal schematic type variable(s): " ^ |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
209 |
commas_quote (map (Term.string_of_vname o #1) vs), [T], [])); |
621 | 210 |
|
7641 | 211 |
|
2964 | 212 |
(* varify, unvarify *) |
621 | 213 |
|
2964 | 214 |
val varifyT = map_type_tfree (fn (a, S) => TVar ((a, 0), S)); |
215 |
||
621 | 216 |
fun unvarifyT (Type (a, Ts)) = Type (a, map unvarifyT Ts) |
217 |
| unvarifyT (TVar ((a, 0), S)) = TFree (a, S) |
|
218 |
| unvarifyT T = T; |
|
219 |
||
220 |
fun varify (t, fixed) = |
|
221 |
let |
|
222 |
val fs = add_term_tfree_names (t, []) \\ fixed; |
|
223 |
val ixns = add_term_tvar_ixns (t, []); |
|
12501 | 224 |
val fmap = fs ~~ map (rpair 0) (variantlist (fs, map #1 ixns)) |
2964 | 225 |
fun thaw (f as (a, S)) = |
226 |
(case assoc (fmap, a) of |
|
227 |
None => TFree f |
|
12501 | 228 |
| Some b => TVar (b, S)); |
229 |
in (map_term_types (map_type_tfree thaw) t, fmap) end; |
|
2964 | 230 |
|
231 |
||
7641 | 232 |
(* 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:
3175
diff
changeset
|
233 |
|
7641 | 234 |
local |
235 |
||
236 |
fun new_name (ix, (pairs,used)) = |
|
3411
163f8f4a42d7
Removal of freeze_vars and thaw_vars. New freeze_thaw
paulson
parents:
3175
diff
changeset
|
237 |
let val v = variant used (string_of_indexname ix) |
163f8f4a42d7
Removal of freeze_vars and thaw_vars. New freeze_thaw
paulson
parents:
3175
diff
changeset
|
238 |
in ((ix,v)::pairs, v::used) end; |
621 | 239 |
|
7641 | 240 |
fun freeze_one alist (ix,sort) = |
3790 | 241 |
TFree (the (assoc (alist, ix)), sort) |
4142 | 242 |
handle OPTION => |
3790 | 243 |
raise TYPE ("Failure during freezing of ?" ^ string_of_indexname ix, [], []); |
2964 | 244 |
|
7641 | 245 |
fun thaw_one alist (a,sort) = TVar (the (assoc (alist,a)), sort) |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
246 |
handle OPTION => TFree(a, sort); |
416 | 247 |
|
10495 | 248 |
in |
249 |
||
250 |
(*this sort of code could replace unvarifyT*) |
|
7641 | 251 |
fun freeze_thaw_type T = |
252 |
let |
|
253 |
val used = add_typ_tfree_names (T, []) |
|
254 |
and tvars = map #1 (add_typ_tvars (T, [])); |
|
255 |
val (alist, _) = foldr new_name (tvars, ([], used)); |
|
256 |
in (map_type_tvar (freeze_one alist) T, map_type_tfree (thaw_one (map swap alist))) end; |
|
257 |
||
3411
163f8f4a42d7
Removal of freeze_vars and thaw_vars. New freeze_thaw
paulson
parents:
3175
diff
changeset
|
258 |
fun freeze_thaw t = |
7641 | 259 |
let |
260 |
val used = it_term_types add_typ_tfree_names (t, []) |
|
261 |
and tvars = map #1 (it_term_types add_typ_tvars (t, [])); |
|
262 |
val (alist, _) = foldr new_name (tvars, ([], used)); |
|
263 |
in |
|
264 |
(case alist of |
|
265 |
[] => (t, fn x => x) (*nothing to do!*) |
|
266 |
| _ => (map_term_types (map_type_tvar (freeze_one alist)) t, |
|
267 |
map_term_types (map_type_tfree (thaw_one (map swap alist))))) |
|
268 |
end; |
|
269 |
||
270 |
end; |
|
271 |
||
256 | 272 |
|
273 |
||
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:
13666
diff
changeset
|
274 |
(** matching and unification of types **) |
8899 | 275 |
|
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:
13666
diff
changeset
|
276 |
(* instantiation *) |
256 | 277 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
278 |
fun inst_typ_tvars pp tsig 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:
13666
diff
changeset
|
279 |
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:
13666
diff
changeset
|
280 |
fun inst (var as (v, S)) = |
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:
13666
diff
changeset
|
281 |
(case assoc_string_int (tye, v) of |
14993 | 282 |
Some U => |
283 |
if of_sort tsig (U, S) then U |
|
284 |
else raise TYPE ("Type not of sort " ^ Pretty.string_of_sort pp S, [U], []) |
|
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:
13666
diff
changeset
|
285 |
| None => TVar var); |
949
83c588d6fee9
Changed treatment of during type inference internally generated type
nipkow
parents:
621
diff
changeset
|
286 |
in map_type_tvar inst end; |
0 | 287 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
288 |
fun inst_term_tvars _ _ [] t = t |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
289 |
| inst_term_tvars pp tsig tye t = map_term_types (inst_typ_tvars pp tsig tye) t; |
0 | 290 |
|
291 |
||
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:
13666
diff
changeset
|
292 |
(* matching *) |
0 | 293 |
|
2964 | 294 |
exception TYPE_MATCH; |
0 | 295 |
|
2964 | 296 |
fun typ_match tsig = |
297 |
let |
|
298 |
fun match (subs, (TVar (v, S), T)) = |
|
8406
a217b0cd304d
Type.unify and Type.typ_match now use Vartab instead of association lists.
berghofe
parents:
7641
diff
changeset
|
299 |
(case Vartab.lookup (subs, v) of |
14993 | 300 |
None => |
301 |
if of_sort tsig (T, S) then Vartab.update ((v, T), subs) |
|
302 |
else raise TYPE_MATCH |
|
2964 | 303 |
| Some U => if U = T then subs else raise TYPE_MATCH) |
304 |
| match (subs, (Type (a, Ts), Type (b, Us))) = |
|
305 |
if a <> b then raise TYPE_MATCH |
|
306 |
else foldl match (subs, Ts ~~ Us) |
|
307 |
| match (subs, (TFree x, TFree y)) = |
|
308 |
if x = y then subs else raise TYPE_MATCH |
|
309 |
| match _ = raise TYPE_MATCH; |
|
310 |
in match end; |
|
0 | 311 |
|
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:
13666
diff
changeset
|
312 |
fun typ_instance tsig (T, U) = |
8406
a217b0cd304d
Type.unify and Type.typ_match now use Vartab instead of association lists.
berghofe
parents:
7641
diff
changeset
|
313 |
(typ_match tsig (Vartab.empty, (U, T)); true) handle TYPE_MATCH => false; |
2964 | 314 |
|
0 | 315 |
|
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:
13666
diff
changeset
|
316 |
(* unification *) |
2964 | 317 |
|
0 | 318 |
exception TUNIFY; |
319 |
||
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:
13666
diff
changeset
|
320 |
(*occurs_check*) |
2964 | 321 |
fun occurs v tye = |
322 |
let |
|
323 |
fun occ (Type (_, Ts)) = exists occ Ts |
|
324 |
| occ (TFree _) = false |
|
325 |
| occ (TVar (w, _)) = |
|
326 |
eq_ix (v, w) orelse |
|
8406
a217b0cd304d
Type.unify and Type.typ_match now use Vartab instead of association lists.
berghofe
parents:
7641
diff
changeset
|
327 |
(case Vartab.lookup (tye, w) of |
2964 | 328 |
None => false |
329 |
| Some U => occ U); |
|
0 | 330 |
in occ end; |
331 |
||
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:
13666
diff
changeset
|
332 |
(*chase variable assignments; if devar returns a type var then it must be unassigned*) |
2964 | 333 |
fun devar (T as TVar (v, _), tye) = |
8406
a217b0cd304d
Type.unify and Type.typ_match now use Vartab instead of association lists.
berghofe
parents:
7641
diff
changeset
|
334 |
(case Vartab.lookup (tye, v) of |
2964 | 335 |
Some U => devar (U, tye) |
336 |
| None => T) |
|
256 | 337 |
| devar (T, tye) = T; |
0 | 338 |
|
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:
13666
diff
changeset
|
339 |
fun unify (tsig as TSig {classes, arities, ...}) (tyenv, maxidx) TU = |
2964 | 340 |
let |
341 |
val tyvar_count = ref maxidx; |
|
342 |
fun gen_tyvar S = TVar (("'a", inc tyvar_count), S); |
|
343 |
||
344 |
fun mg_domain a 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:
13666
diff
changeset
|
345 |
Sorts.mg_domain (classes, arities) a S handle Sorts.DOMAIN _ => raise TUNIFY; |
2964 | 346 |
|
347 |
fun meet ((_, []), tye) = tye |
|
348 |
| 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:
13666
diff
changeset
|
349 |
if Sorts.sort_le classes (S', S) then tye |
13666
a2730043029b
Removed add_env because Vartab.map was too slow for large environments.
berghofe
parents:
12726
diff
changeset
|
350 |
else Vartab.update_new ((xi, |
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:
13666
diff
changeset
|
351 |
gen_tyvar (Sorts.inter_sort classes (S', S))), tye) |
2964 | 352 |
| 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:
13666
diff
changeset
|
353 |
if Sorts.sort_le classes (S', S) then tye |
2964 | 354 |
else raise TUNIFY |
355 |
| meet ((Type (a, Ts), S), tye) = meets ((Ts, mg_domain a S), tye) |
|
356 |
and meets (([], []), tye) = tye |
|
357 |
| meets ((T :: Ts, S :: Ss), tye) = |
|
358 |
meets ((Ts, Ss), meet ((devar (T, tye), S), tye)) |
|
359 |
| meets _ = sys_error "meets"; |
|
360 |
||
361 |
fun unif ((ty1, ty2), tye) = |
|
362 |
(case (devar (ty1, tye), devar (ty2, tye)) of |
|
363 |
(T as TVar (v, S1), U as TVar (w, S2)) => |
|
364 |
if eq_ix (v, w) then 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:
13666
diff
changeset
|
365 |
else if Sorts.sort_le classes (S1, S2) then |
13666
a2730043029b
Removed add_env because Vartab.map was too slow for large environments.
berghofe
parents:
12726
diff
changeset
|
366 |
Vartab.update_new ((w, 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:
13666
diff
changeset
|
367 |
else if Sorts.sort_le classes (S2, S1) then |
13666
a2730043029b
Removed add_env because Vartab.map was too slow for large environments.
berghofe
parents:
12726
diff
changeset
|
368 |
Vartab.update_new ((v, U), tye) |
2964 | 369 |
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:
13666
diff
changeset
|
370 |
let val S = gen_tyvar (Sorts.inter_sort classes (S1, S2)) in |
13666
a2730043029b
Removed add_env because Vartab.map was too slow for large environments.
berghofe
parents:
12726
diff
changeset
|
371 |
Vartab.update_new ((v, S), Vartab.update_new ((w, S), tye)) |
2964 | 372 |
end |
373 |
| (TVar (v, S), T) => |
|
374 |
if occurs v tye T then raise TUNIFY |
|
13666
a2730043029b
Removed add_env because Vartab.map was too slow for large environments.
berghofe
parents:
12726
diff
changeset
|
375 |
else meet ((T, S), Vartab.update_new ((v, T), tye)) |
2964 | 376 |
| (T, TVar (v, S)) => |
377 |
if occurs v tye T then raise TUNIFY |
|
13666
a2730043029b
Removed add_env because Vartab.map was too slow for large environments.
berghofe
parents:
12726
diff
changeset
|
378 |
else meet ((T, S), Vartab.update_new ((v, T), tye)) |
2964 | 379 |
| (Type (a, Ts), Type (b, Us)) => |
380 |
if a <> b then raise TUNIFY |
|
381 |
else foldr unif (Ts ~~ Us, tye) |
|
382 |
| (T, U) => if T = U then tye else raise TUNIFY); |
|
12528 | 383 |
in (unif (TU, tyenv), ! tyvar_count) end; |
0 | 384 |
|
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:
13666
diff
changeset
|
385 |
(*purely structural unification *) |
450 | 386 |
fun raw_unify (ty1, ty2) = |
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:
13666
diff
changeset
|
387 |
(unify empty_tsig (Vartab.empty, 0) (strip_sorts ty1, strip_sorts ty2); true) |
450 | 388 |
handle TUNIFY => false; |
389 |
||
390 |
||
0 | 391 |
|
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:
13666
diff
changeset
|
392 |
(** 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:
13666
diff
changeset
|
393 |
|
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:
13666
diff
changeset
|
394 |
(* arities *) |
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:
13666
diff
changeset
|
395 |
|
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:
13666
diff
changeset
|
396 |
local |
1435
aefcd255ed4a
Removed bug in type unification. Negative indexes are not used any longer.
nipkow
parents:
1392
diff
changeset
|
397 |
|
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:
13666
diff
changeset
|
398 |
fun err_decl t decl = error ("Illegal " ^ str_of_decl decl ^ ": " ^ quote t); |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
399 |
|
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
400 |
fun for_classes _ None = "" |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
401 |
| for_classes pp (Some (c1, c2)) = |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
402 |
" for classes " ^ Pretty.string_of_classrel pp [c1, c2]; |
3790 | 403 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
404 |
fun err_conflict pp t cc (c, Ss) (c', Ss') = |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
405 |
error ("Conflict of type arities" ^ for_classes pp cc ^ ":\n " ^ |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
406 |
Pretty.string_of_arity pp (t, Ss, [c]) ^ " and\n " ^ |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
407 |
Pretty.string_of_arity pp (t, Ss', [c'])); |
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:
13666
diff
changeset
|
408 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
409 |
fun coregular pp C t (c, Ss) ars = |
3790 | 410 |
let |
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:
13666
diff
changeset
|
411 |
fun conflict (c', Ss') = |
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:
13666
diff
changeset
|
412 |
if Sorts.class_le C (c, c') andalso not (Sorts.sorts_le C (Ss, Ss')) then |
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:
13666
diff
changeset
|
413 |
Some ((c, c'), (c', Ss')) |
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:
13666
diff
changeset
|
414 |
else if Sorts.class_le C (c', c) andalso not (Sorts.sorts_le C (Ss', Ss)) then |
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:
13666
diff
changeset
|
415 |
Some ((c', c), (c', Ss')) |
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:
13666
diff
changeset
|
416 |
else None; |
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:
13666
diff
changeset
|
417 |
in |
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:
13666
diff
changeset
|
418 |
(case Library.get_first conflict ars of |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
419 |
Some ((c1, c2), (c', Ss')) => err_conflict pp t (Some (c1, c2)) (c, Ss) (c', Ss') |
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:
13666
diff
changeset
|
420 |
| None => (c, Ss) :: ars) |
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:
13666
diff
changeset
|
421 |
end; |
3790 | 422 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
423 |
fun insert pp C t ((c, Ss), ars) = |
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:
13666
diff
changeset
|
424 |
(case assoc_string (ars, c) of |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
425 |
None => coregular pp C t (c, Ss) ars |
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:
13666
diff
changeset
|
426 |
| Some Ss' => |
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:
13666
diff
changeset
|
427 |
if Sorts.sorts_le C (Ss, Ss') then ars |
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:
13666
diff
changeset
|
428 |
else if Sorts.sorts_le C (Ss', Ss) |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
429 |
then coregular pp C t (c, Ss) (ars \ (c, Ss')) |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
430 |
else err_conflict pp t None (c, Ss) (c, Ss')); |
2587 | 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:
13666
diff
changeset
|
432 |
fun complete C (c, Ss) = map (rpair Ss) (Graph.all_succs C [c]); |
3790 | 433 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
434 |
fun insert_arities pp classes (arities, (t, ars)) = |
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:
13666
diff
changeset
|
435 |
let val ars' = |
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:
13666
diff
changeset
|
436 |
Symtab.lookup_multi (arities, t) |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
437 |
|> curry (foldr (insert pp classes t)) (flat (map (complete classes) ars)) |
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:
13666
diff
changeset
|
438 |
in Symtab.update ((t, ars'), arities) end; |
3790 | 439 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
440 |
fun insert_table pp classes = Symtab.foldl (fn (arities, (t, ars)) => |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
441 |
insert_arities pp classes (arities, (t, map (apsnd (map (Sorts.norm_sort classes))) ars))); |
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:
13666
diff
changeset
|
442 |
|
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:
13666
diff
changeset
|
443 |
in |
2587 | 444 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
445 |
fun add_arities pp decls tsig = tsig |> change_tsig (fn (classes, default, types, arities) => |
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:
13666
diff
changeset
|
446 |
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:
13666
diff
changeset
|
447 |
fun prep (t, Ss, S) = |
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:
13666
diff
changeset
|
448 |
(case Symtab.lookup (types, t) of |
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:
13666
diff
changeset
|
449 |
Some (LogicalType n, _) => |
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:
13666
diff
changeset
|
450 |
if length Ss = n then |
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:
13666
diff
changeset
|
451 |
(t, map (cert_sort tsig) Ss, cert_sort tsig S) |
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:
13666
diff
changeset
|
452 |
handle TYPE (msg, _, _) => error msg |
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:
13666
diff
changeset
|
453 |
else error (bad_nargs t) |
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:
13666
diff
changeset
|
454 |
| Some (decl, _) => err_decl t decl |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
455 |
| None => error (undecl_type t)); |
4603 | 456 |
|
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:
13666
diff
changeset
|
457 |
val ars = decls |> map ((fn (t, Ss, S) => (t, map (fn c => (c, Ss)) S)) o prep); |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
458 |
val arities' = foldl (insert_arities pp classes) (arities, ars); |
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:
13666
diff
changeset
|
459 |
in (classes, default, types, arities') end); |
12528 | 460 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
461 |
fun rebuild_arities pp classes arities = |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
462 |
insert_table pp classes (Symtab.empty, arities); |
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:
13666
diff
changeset
|
463 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
464 |
fun merge_arities pp classes (arities1, arities2) = |
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
465 |
insert_table pp classes (insert_table pp classes (Symtab.empty, arities1), arities2); |
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:
13666
diff
changeset
|
466 |
|
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:
13666
diff
changeset
|
467 |
end; |
4603 | 468 |
|
469 |
||
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:
13666
diff
changeset
|
470 |
(* 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:
13666
diff
changeset
|
471 |
|
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:
13666
diff
changeset
|
472 |
local |
0 | 473 |
|
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:
13666
diff
changeset
|
474 |
fun err_dup_classes cs = |
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:
13666
diff
changeset
|
475 |
error ("Duplicate declaration of class(es): " ^ commas_quote cs); |
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:
13666
diff
changeset
|
476 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
477 |
fun err_cyclic_classes pp css = |
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:
13666
diff
changeset
|
478 |
error (cat_lines (map (fn cs => |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
479 |
"Cycle in class relation: " ^ Pretty.string_of_classrel pp cs) css)); |
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:
13666
diff
changeset
|
480 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
481 |
fun add_class pp (c, cs) tsig = tsig |> change_tsig (fn (classes, default, types, arities) => |
2964 | 482 |
let |
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:
13666
diff
changeset
|
483 |
val cs' = map (cert_class tsig) cs |
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:
13666
diff
changeset
|
484 |
handle TYPE (msg, _, _) => error msg; |
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:
13666
diff
changeset
|
485 |
val classes' = classes |> Graph.new_node (c, stamp ()) |
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:
13666
diff
changeset
|
486 |
handle Graph.DUP d => err_dup_classes [d]; |
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:
13666
diff
changeset
|
487 |
val classes'' = classes' |> fold Graph.add_edge_trans_acyclic (map (pair c) cs') |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
488 |
handle Graph.CYCLES css => err_cyclic_classes pp css; |
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:
13666
diff
changeset
|
489 |
in (classes'', default, types, arities) end); |
2964 | 490 |
|
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:
13666
diff
changeset
|
491 |
in |
0 | 492 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
493 |
val add_classes = fold o add_class; |
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:
13666
diff
changeset
|
494 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
495 |
fun add_classrel pp ps tsig = tsig |> change_tsig (fn (classes, default, types, arities) => |
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:
13666
diff
changeset
|
496 |
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:
13666
diff
changeset
|
497 |
val ps' = map (pairself (cert_class tsig)) ps |
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:
13666
diff
changeset
|
498 |
handle TYPE (msg, _, _) => error msg; |
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:
13666
diff
changeset
|
499 |
val classes' = classes |> fold Graph.add_edge_trans_acyclic ps' |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
500 |
handle Graph.CYCLES css => err_cyclic_classes pp css; |
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:
13666
diff
changeset
|
501 |
val default' = default |> Sorts.norm_sort classes'; |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
502 |
val arities' = arities |> rebuild_arities pp 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:
13666
diff
changeset
|
503 |
in (classes', default', types, arities') end); |
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:
13666
diff
changeset
|
504 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
505 |
fun merge_classes pp CC = Graph.merge_trans_acyclic (op =) CC |
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:
13666
diff
changeset
|
506 |
handle Graph.DUPS cs => err_dup_classes cs |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
507 |
| Graph.CYCLES css => err_cyclic_classes pp css; |
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:
13666
diff
changeset
|
508 |
|
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:
13666
diff
changeset
|
509 |
end; |
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:
13666
diff
changeset
|
510 |
|
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:
13666
diff
changeset
|
511 |
|
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:
13666
diff
changeset
|
512 |
(* 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:
13666
diff
changeset
|
513 |
|
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:
13666
diff
changeset
|
514 |
fun set_defsort S tsig = tsig |> change_tsig (fn (classes, _, types, arities) => |
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:
13666
diff
changeset
|
515 |
(classes, cert_sort tsig S handle TYPE (msg, _, _) => error msg, types, arities)); |
0 | 516 |
|
517 |
||
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:
13666
diff
changeset
|
518 |
(* 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:
13666
diff
changeset
|
519 |
|
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:
13666
diff
changeset
|
520 |
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:
13666
diff
changeset
|
521 |
|
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:
13666
diff
changeset
|
522 |
fun err_neg_args c = |
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:
13666
diff
changeset
|
523 |
error ("Negative number of arguments in type constructor declaration: " ^ quote c); |
949
83c588d6fee9
Changed treatment of during type inference internally generated type
nipkow
parents:
621
diff
changeset
|
524 |
|
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:
13666
diff
changeset
|
525 |
fun err_in_decls c decl decl' = |
14906 | 526 |
let val s = str_of_decl decl and s' = str_of_decl decl' in |
527 |
if s = s' then error ("Duplicate declaration of " ^ s ^ ": " ^ quote c) |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
528 |
else error ("Conflict of " ^ s ^ " with " ^ s' ^ ": " ^ quote c) |
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:
13666
diff
changeset
|
529 |
end; |
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:
13666
diff
changeset
|
530 |
|
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:
13666
diff
changeset
|
531 |
fun new_decl (c, decl) 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:
13666
diff
changeset
|
532 |
(case Symtab.lookup (types, c) of |
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:
13666
diff
changeset
|
533 |
Some (decl', _) => err_in_decls c decl 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:
13666
diff
changeset
|
534 |
| None => Symtab.update ((c, (decl, stamp ())), 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:
13666
diff
changeset
|
535 |
|
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:
13666
diff
changeset
|
536 |
fun the_decl types c = fst (the (Symtab.lookup (types, c))); |
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:
13666
diff
changeset
|
537 |
|
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:
13666
diff
changeset
|
538 |
fun change_types f = change_tsig (fn (classes, default, types, arities) => |
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:
13666
diff
changeset
|
539 |
(classes, default, f types, arities)); |
2964 | 540 |
|
14989 | 541 |
fun syntactic types (Type (c, Ts)) = |
542 |
(case Symtab.lookup (types, c) of Some (Nonterminal, _) => true | _ => false) |
|
543 |
orelse exists (syntactic types) Ts |
|
544 |
| syntactic _ _ = false; |
|
545 |
||
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:
13666
diff
changeset
|
546 |
fun add_abbr (a, vs, rhs) tsig = tsig |> change_types (fn 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:
13666
diff
changeset
|
547 |
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:
13666
diff
changeset
|
548 |
fun err msg = |
14906 | 549 |
error (msg ^ "\nThe error(s) above occurred in type abbreviation: " ^ quote a); |
14993 | 550 |
val rhs' = strip_sorts (no_tvars (cert_typ_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:
13666
diff
changeset
|
551 |
handle TYPE (msg, _, _) => err msg; |
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:
13666
diff
changeset
|
552 |
in |
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:
13666
diff
changeset
|
553 |
(case duplicates vs of |
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:
13666
diff
changeset
|
554 |
[] => [] |
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:
13666
diff
changeset
|
555 |
| dups => err ("Duplicate variables on lhs: " ^ commas_quote dups)); |
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:
13666
diff
changeset
|
556 |
(case gen_rems (op =) (map (#1 o #1) (typ_tvars rhs'), vs) of |
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:
13666
diff
changeset
|
557 |
[] => [] |
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:
13666
diff
changeset
|
558 |
| extras => err ("Extra variables on rhs: " ^ commas_quote extras)); |
14989 | 559 |
types |> new_decl (a, Abbreviation (vs, rhs', syntactic types 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:
13666
diff
changeset
|
560 |
end); |
0 | 561 |
|
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:
13666
diff
changeset
|
562 |
in |
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:
13666
diff
changeset
|
563 |
|
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:
13666
diff
changeset
|
564 |
fun add_types ps = change_types (fold new_decl (ps |> map (fn (c, n) => |
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:
13666
diff
changeset
|
565 |
if n < 0 then err_neg_args c else (c, LogicalType n)))); |
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:
13666
diff
changeset
|
566 |
|
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:
13666
diff
changeset
|
567 |
val add_abbrs = fold add_abbr; |
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:
13666
diff
changeset
|
568 |
val add_nonterminals = change_types o fold new_decl o map (rpair 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:
13666
diff
changeset
|
569 |
|
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:
13666
diff
changeset
|
570 |
fun merge_types (types1, types2) = |
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:
13666
diff
changeset
|
571 |
Symtab.merge Library.eq_snd (types1, types2) handle Symtab.DUPS (d :: _) => |
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:
13666
diff
changeset
|
572 |
err_in_decls d (the_decl types1 d) (the_decl types2 d); |
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:
13666
diff
changeset
|
573 |
|
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:
13666
diff
changeset
|
574 |
end; |
0 | 575 |
|
3790 | 576 |
|
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:
13666
diff
changeset
|
577 |
(* 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:
13666
diff
changeset
|
578 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
579 |
fun merge_tsigs 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:
13666
diff
changeset
|
580 |
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:
13666
diff
changeset
|
581 |
val (TSig {classes = classes1, default = default1, types = types1, arities = arities1, |
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:
13666
diff
changeset
|
582 |
log_types = _, witness = _}) = tsig1; |
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:
13666
diff
changeset
|
583 |
val (TSig {classes = classes2, default = default2, types = types2, arities = arities2, |
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:
13666
diff
changeset
|
584 |
log_types = _, witness = _}) = tsig2; |
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:
13666
diff
changeset
|
585 |
|
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
586 |
val classes' = merge_classes pp (classes1, classes2); |
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:
13666
diff
changeset
|
587 |
val default' = Sorts.inter_sort classes' (default1, default2); |
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:
13666
diff
changeset
|
588 |
val types' = merge_types (types1, types2); |
14830
faa4865ba1ce
removed norm_typ; improved output; refer to Pretty.pp;
wenzelm
parents:
14790
diff
changeset
|
589 |
val arities' = merge_arities pp classes' (arities1, arities2); |
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:
13666
diff
changeset
|
590 |
in build_tsig (classes', default', types', arities') end; |
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:
13666
diff
changeset
|
591 |
|
0 | 592 |
end; |