author | wenzelm |
Wed, 31 Dec 2008 19:54:04 +0100 | |
changeset 29278 | e9d148a808eb |
parent 29270 | 0eade173f77e |
child 29280 | c5531bf7c6b2 |
permissions | -rw-r--r-- |
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
1 |
(* Title: Pure/term.ML |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
2 |
Author: Lawrence C Paulson, Cambridge University Computer Laboratory |
1364
8ea1a962ad72
files now define a structure to allow SML/NJ to optimize the code
clasohm
parents:
1029
diff
changeset
|
3 |
|
4444 | 4 |
Simply typed lambda-calculus: types, terms, and basic operations. |
0 | 5 |
*) |
6 |
||
29257
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
7 |
infix 9 $; |
1364
8ea1a962ad72
files now define a structure to allow SML/NJ to optimize the code
clasohm
parents:
1029
diff
changeset
|
8 |
infixr 5 -->; |
4444 | 9 |
infixr --->; |
10 |
infix aconv; |
|
1364
8ea1a962ad72
files now define a structure to allow SML/NJ to optimize the code
clasohm
parents:
1029
diff
changeset
|
11 |
|
4444 | 12 |
signature BASIC_TERM = |
13 |
sig |
|
22572 | 14 |
eqtype indexname |
15 |
eqtype class |
|
16 |
eqtype sort |
|
17 |
eqtype arity |
|
4444 | 18 |
datatype typ = |
19 |
Type of string * typ list | |
|
20 |
TFree of string * sort | |
|
21 |
TVar of indexname * sort |
|
16537 | 22 |
datatype term = |
23 |
Const of string * typ | |
|
24 |
Free of string * typ | |
|
25 |
Var of indexname * typ | |
|
26 |
Bound of int | |
|
27 |
Abs of string * typ * term | |
|
17756 | 28 |
$ of term * term |
16537 | 29 |
exception TYPE of string * typ list * term list |
30 |
exception TERM of string * term list |
|
21353 | 31 |
val dummyS: sort |
16710 | 32 |
val dummyT: typ |
33 |
val no_dummyT: typ -> typ |
|
4444 | 34 |
val --> : typ * typ -> typ |
35 |
val ---> : typ list * typ -> typ |
|
16710 | 36 |
val dest_Type: typ -> string * typ list |
37 |
val dest_TVar: typ -> indexname * sort |
|
38 |
val dest_TFree: typ -> string * sort |
|
39 |
val is_Bound: term -> bool |
|
40 |
val is_Const: term -> bool |
|
41 |
val is_Free: term -> bool |
|
42 |
val is_Var: term -> bool |
|
4444 | 43 |
val is_TVar: typ -> bool |
16710 | 44 |
val dest_Const: term -> string * typ |
45 |
val dest_Free: term -> string * typ |
|
46 |
val dest_Var: term -> indexname * typ |
|
4444 | 47 |
val domain_type: typ -> typ |
4480 | 48 |
val range_type: typ -> typ |
4444 | 49 |
val binder_types: typ -> typ list |
50 |
val body_type: typ -> typ |
|
51 |
val strip_type: typ -> typ list * typ |
|
16710 | 52 |
val type_of1: typ list * term -> typ |
4444 | 53 |
val type_of: term -> typ |
16710 | 54 |
val fastype_of1: typ list * term -> typ |
4444 | 55 |
val fastype_of: term -> typ |
10806 | 56 |
val list_abs: (string * typ) list * term -> term |
18927 | 57 |
val strip_abs: term -> (string * typ) list * term |
4444 | 58 |
val strip_abs_body: term -> term |
59 |
val strip_abs_vars: term -> (string * typ) list |
|
60 |
val strip_qnt_body: string -> term -> term |
|
61 |
val strip_qnt_vars: string -> term -> (string * typ) list |
|
62 |
val list_comb: term * term list -> term |
|
63 |
val strip_comb: term -> term * term list |
|
64 |
val head_of: term -> term |
|
65 |
val size_of_term: term -> int |
|
18847 | 66 |
val map_atyps: (typ -> typ) -> typ -> typ |
67 |
val map_aterms: (term -> term) -> term -> term |
|
4444 | 68 |
val map_type_tvar: (indexname * sort -> typ) -> typ -> typ |
69 |
val map_type_tfree: (string * sort -> typ) -> typ -> typ |
|
20548
8ef25fe585a8
renamed Term.map_term_types to Term.map_types (cf. Term.fold_types);
wenzelm
parents:
20531
diff
changeset
|
70 |
val map_types: (typ -> typ) -> term -> term |
16943 | 71 |
val fold_atyps: (typ -> 'a -> 'a) -> typ -> 'a -> 'a |
72 |
val fold_aterms: (term -> 'a -> 'a) -> term -> 'a -> 'a |
|
73 |
val fold_term_types: (term -> typ -> 'a -> 'a) -> term -> 'a -> 'a |
|
74 |
val fold_types: (typ -> 'a -> 'a) -> term -> 'a -> 'a |
|
24483 | 75 |
val burrow_types: (typ list -> typ list) -> term list -> term list |
16710 | 76 |
val aconv: term * term -> bool |
4444 | 77 |
val propT: typ |
78 |
val strip_all_body: term -> term |
|
79 |
val strip_all_vars: term -> (string * typ) list |
|
80 |
val incr_bv: int * int * term -> term |
|
81 |
val incr_boundvars: int -> term -> term |
|
82 |
val add_loose_bnos: term * int * int list -> int list |
|
83 |
val loose_bnos: term -> int list |
|
84 |
val loose_bvar: term * int -> bool |
|
85 |
val loose_bvar1: term * int -> bool |
|
86 |
val subst_bounds: term list * term -> term |
|
87 |
val subst_bound: term * term -> term |
|
88 |
val betapply: term * term -> term |
|
18183 | 89 |
val betapplys: term * term list -> term |
4444 | 90 |
val subst_free: (term * term) list -> term -> term |
91 |
val abstract_over: term * term -> term |
|
11922 | 92 |
val lambda: term -> term -> term |
4444 | 93 |
val absfree: string * typ * term -> term |
17786 | 94 |
val absdummy: typ * term -> term |
4444 | 95 |
val list_abs_free: (string * typ) list * term -> term |
96 |
val list_all_free: (string * typ) list * term -> term |
|
97 |
val list_all: (string * typ) list * term -> term |
|
16710 | 98 |
val subst_atomic: (term * term) list -> term -> term |
99 |
val typ_subst_atomic: (typ * typ) list -> typ -> typ |
|
100 |
val subst_atomic_types: (typ * typ) list -> term -> term |
|
101 |
val typ_subst_TVars: (indexname * typ) list -> typ -> typ |
|
102 |
val subst_TVars: (indexname * typ) list -> term -> term |
|
103 |
val subst_Vars: (indexname * term) list -> term -> term |
|
104 |
val subst_vars: (indexname * typ) list * (indexname * term) list -> term -> term |
|
105 |
val is_first_order: string list -> term -> bool |
|
4444 | 106 |
val maxidx_of_typ: typ -> int |
107 |
val maxidx_of_typs: typ list -> int |
|
108 |
val maxidx_of_term: term -> int |
|
19909 | 109 |
val exists_subtype: (typ -> bool) -> typ -> bool |
20531 | 110 |
val exists_type: (typ -> bool) -> term -> bool |
16943 | 111 |
val exists_subterm: (term -> bool) -> term -> bool |
16710 | 112 |
val exists_Const: (string * typ -> bool) -> term -> bool |
15986 | 113 |
val show_question_marks: bool ref |
4444 | 114 |
end; |
0 | 115 |
|
4444 | 116 |
signature TERM = |
117 |
sig |
|
118 |
include BASIC_TERM |
|
19394 | 119 |
val aT: sort -> typ |
120 |
val itselfT: typ -> typ |
|
121 |
val a_itselfT: typ |
|
27335 | 122 |
val all: typ -> term |
22908 | 123 |
val argument_type_of: term -> int -> typ |
29257
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
124 |
val add_tvar_namesT: typ -> indexname list -> indexname list |
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
125 |
val add_tvar_names: term -> indexname list -> indexname list |
16943 | 126 |
val add_tvarsT: typ -> (indexname * sort) list -> (indexname * sort) list |
127 |
val add_tvars: term -> (indexname * sort) list -> (indexname * sort) list |
|
29257
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
128 |
val add_var_names: term -> indexname list -> indexname list |
16943 | 129 |
val add_vars: term -> (indexname * typ) list -> (indexname * typ) list |
29257
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
130 |
val add_tfree_namesT: typ -> string list -> string list |
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
131 |
val add_tfree_names: term -> string list -> string list |
16943 | 132 |
val add_tfreesT: typ -> (string * sort) list -> (string * sort) list |
133 |
val add_tfrees: term -> (string * sort) list -> (string * sort) list |
|
29257
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
134 |
val add_free_names: term -> string list -> string list |
16943 | 135 |
val add_frees: term -> (string * typ) list -> (string * typ) list |
25050 | 136 |
val hidden_polymorphism: term -> (indexname * sort) list |
29278 | 137 |
val declare_typ_names: typ -> Name.context -> Name.context |
138 |
val declare_term_names: term -> Name.context -> Name.context |
|
139 |
val declare_term_frees: term -> Name.context -> Name.context |
|
140 |
val variant_frees: term -> (string * 'a) list -> (string * 'a) list |
|
141 |
val rename_wrt_term: term -> (string * 'a) list -> (string * 'a) list |
|
29269
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
142 |
val eq_ix: indexname * indexname -> bool |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
143 |
val eq_tvar: (indexname * sort) * (indexname * sort) -> bool |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
144 |
val eq_var: (indexname * typ) * (indexname * typ) -> bool |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
145 |
val could_unify: term * term -> bool |
20109 | 146 |
val strip_abs_eta: int -> term -> (string * typ) list * term |
12981 | 147 |
val match_bvars: (term * term) * (string * string) list -> (string * string) list |
22031 | 148 |
val map_abs_vars: (string -> string) -> term -> term |
12981 | 149 |
val rename_abs: term -> term -> term -> term option |
25050 | 150 |
val close_schematic_term: term -> term |
16710 | 151 |
val maxidx_typ: typ -> int -> int |
152 |
val maxidx_typs: typ list -> int -> int |
|
153 |
val maxidx_term: term -> int -> int |
|
24671 | 154 |
val has_abs: term -> bool |
20239 | 155 |
val dest_abs: string * typ * term -> string * term |
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
156 |
val dummy_patternN: string |
18253 | 157 |
val dummy_pattern: typ -> term |
22723 | 158 |
val is_dummy_pattern: term -> bool |
24733 | 159 |
val free_dummy_patterns: term -> Name.context -> term * Name.context |
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
160 |
val no_dummy_patterns: term -> term |
24762 | 161 |
val replace_dummy_patterns: term -> int -> term * int |
10552 | 162 |
val is_replaced_dummy_pattern: indexname -> bool |
16035 | 163 |
val show_dummy_patterns: term -> term |
14786
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
164 |
val string_of_vname: indexname -> string |
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
165 |
val string_of_vname': indexname -> string |
4444 | 166 |
end; |
167 |
||
168 |
structure Term: TERM = |
|
1364
8ea1a962ad72
files now define a structure to allow SML/NJ to optimize the code
clasohm
parents:
1029
diff
changeset
|
169 |
struct |
0 | 170 |
|
171 |
(*Indexnames can be quickly renamed by adding an offset to the integer part, |
|
172 |
for resolution.*) |
|
16537 | 173 |
type indexname = string * int; |
0 | 174 |
|
4626 | 175 |
(* Types are classified by sorts. *) |
0 | 176 |
type class = string; |
177 |
type sort = class list; |
|
14829
cfa5fe01a7b7
moved read_int etc. to library.ML; added type 'arity';
wenzelm
parents:
14786
diff
changeset
|
178 |
type arity = string * sort list * sort; |
0 | 179 |
|
180 |
(* The sorts attached to TFrees and TVars specify the sort of that variable *) |
|
181 |
datatype typ = Type of string * typ list |
|
182 |
| TFree of string * sort |
|
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
183 |
| TVar of indexname * sort; |
0 | 184 |
|
6033
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
185 |
(*Terms. Bound variables are indicated by depth number. |
0 | 186 |
Free variables, (scheme) variables and constants have names. |
4626 | 187 |
An term is "closed" if every bound variable of level "lev" |
13000 | 188 |
is enclosed by at least "lev" abstractions. |
0 | 189 |
|
190 |
It is possible to create meaningless terms containing loose bound vars |
|
191 |
or type mismatches. But such terms are not allowed in rules. *) |
|
192 |
||
13000 | 193 |
datatype term = |
0 | 194 |
Const of string * typ |
13000 | 195 |
| Free of string * typ |
0 | 196 |
| Var of indexname * typ |
197 |
| Bound of int |
|
198 |
| Abs of string*typ*term |
|
3965 | 199 |
| op $ of term*term; |
0 | 200 |
|
16537 | 201 |
(*Errors involving type mismatches*) |
0 | 202 |
exception TYPE of string * typ list * term list; |
203 |
||
16537 | 204 |
(*Errors errors involving terms*) |
0 | 205 |
exception TERM of string * term list; |
206 |
||
207 |
(*Note variable naming conventions! |
|
208 |
a,b,c: string |
|
209 |
f,g,h: functions (including terms of function type) |
|
210 |
i,j,m,n: int |
|
211 |
t,u: term |
|
212 |
v,w: indexnames |
|
213 |
x,y: any |
|
214 |
A,B,C: term (denoting formulae) |
|
215 |
T,U: typ |
|
216 |
*) |
|
217 |
||
218 |
||
6033
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
219 |
(** Types **) |
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
220 |
|
21353 | 221 |
(*dummies for type-inference etc.*) |
222 |
val dummyS = [""]; |
|
16537 | 223 |
val dummyT = Type ("dummy", []); |
224 |
||
225 |
fun no_dummyT typ = |
|
226 |
let |
|
227 |
fun check (T as Type ("dummy", _)) = |
|
228 |
raise TYPE ("Illegal occurrence of '_' dummy type", [T], []) |
|
229 |
| check (Type (_, Ts)) = List.app check Ts |
|
230 |
| check _ = (); |
|
231 |
in check typ; typ end; |
|
232 |
||
6033
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
233 |
fun S --> T = Type("fun",[S,T]); |
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
234 |
|
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
235 |
(*handy for multiple args: [T1,...,Tn]--->T gives T1-->(T2--> ... -->T)*) |
15570 | 236 |
val op ---> = Library.foldr (op -->); |
6033
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
237 |
|
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
238 |
fun dest_Type (Type x) = x |
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
239 |
| dest_Type T = raise TYPE ("dest_Type", [T], []); |
15914 | 240 |
fun dest_TVar (TVar x) = x |
241 |
| dest_TVar T = raise TYPE ("dest_TVar", [T], []); |
|
242 |
fun dest_TFree (TFree x) = x |
|
243 |
| dest_TFree T = raise TYPE ("dest_TFree", [T], []); |
|
6033
c8c69a4a7762
moved dest_Type to term.ML from HOL/Tools/primrec_package
paulson
parents:
5986
diff
changeset
|
244 |
|
16537 | 245 |
|
0 | 246 |
(** Discriminators **) |
247 |
||
7318 | 248 |
fun is_Bound (Bound _) = true |
249 |
| is_Bound _ = false; |
|
250 |
||
0 | 251 |
fun is_Const (Const _) = true |
252 |
| is_Const _ = false; |
|
253 |
||
254 |
fun is_Free (Free _) = true |
|
255 |
| is_Free _ = false; |
|
256 |
||
257 |
fun is_Var (Var _) = true |
|
258 |
| is_Var _ = false; |
|
259 |
||
260 |
fun is_TVar (TVar _) = true |
|
261 |
| is_TVar _ = false; |
|
262 |
||
16537 | 263 |
|
0 | 264 |
(** Destructors **) |
265 |
||
266 |
fun dest_Const (Const x) = x |
|
267 |
| dest_Const t = raise TERM("dest_Const", [t]); |
|
268 |
||
269 |
fun dest_Free (Free x) = x |
|
270 |
| dest_Free t = raise TERM("dest_Free", [t]); |
|
271 |
||
272 |
fun dest_Var (Var x) = x |
|
273 |
| dest_Var t = raise TERM("dest_Var", [t]); |
|
274 |
||
275 |
||
4464 | 276 |
fun domain_type (Type("fun", [T,_])) = T |
277 |
and range_type (Type("fun", [_,T])) = T; |
|
4064 | 278 |
|
0 | 279 |
(* maps [T1,...,Tn]--->T to the list [T1,T2,...,Tn]*) |
280 |
fun binder_types (Type("fun",[S,T])) = S :: binder_types T |
|
281 |
| binder_types _ = []; |
|
282 |
||
283 |
(* maps [T1,...,Tn]--->T to T*) |
|
284 |
fun body_type (Type("fun",[S,T])) = body_type T |
|
285 |
| body_type T = T; |
|
286 |
||
287 |
(* maps [T1,...,Tn]--->T to ([T1,T2,...,Tn], T) *) |
|
288 |
fun strip_type T : typ list * typ = |
|
289 |
(binder_types T, body_type T); |
|
290 |
||
291 |
||
292 |
(*Compute the type of the term, checking that combinations are well-typed |
|
293 |
Ts = [T0,T1,...] holds types of bound variables 0, 1, ...*) |
|
294 |
fun type_of1 (Ts, Const (_,T)) = T |
|
295 |
| type_of1 (Ts, Free (_,T)) = T |
|
15570 | 296 |
| type_of1 (Ts, Bound i) = (List.nth (Ts,i) |
297 |
handle Subscript => raise TYPE("type_of: bound variable", [], [Bound i])) |
|
0 | 298 |
| type_of1 (Ts, Var (_,T)) = T |
299 |
| type_of1 (Ts, Abs (_,T,body)) = T --> type_of1(T::Ts, body) |
|
13000 | 300 |
| type_of1 (Ts, f$u) = |
0 | 301 |
let val U = type_of1(Ts,u) |
302 |
and T = type_of1(Ts,f) |
|
303 |
in case T of |
|
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
304 |
Type("fun",[T1,T2]) => |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
305 |
if T1=U then T2 else raise TYPE |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
306 |
("type_of: type mismatch in application", [T1,U], [f$u]) |
13000 | 307 |
| _ => raise TYPE |
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
308 |
("type_of: function type is expected in application", |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
309 |
[T,U], [f$u]) |
0 | 310 |
end; |
311 |
||
312 |
fun type_of t : typ = type_of1 ([],t); |
|
313 |
||
314 |
(*Determines the type of a term, with minimal checking*) |
|
13000 | 315 |
fun fastype_of1 (Ts, f$u) = |
61 | 316 |
(case fastype_of1 (Ts,f) of |
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
317 |
Type("fun",[_,T]) => T |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
318 |
| _ => raise TERM("fastype_of: expected function type", [f$u])) |
61 | 319 |
| fastype_of1 (_, Const (_,T)) = T |
320 |
| fastype_of1 (_, Free (_,T)) = T |
|
15570 | 321 |
| fastype_of1 (Ts, Bound i) = (List.nth(Ts,i) |
322 |
handle Subscript => raise TERM("fastype_of: Bound", [Bound i])) |
|
13000 | 323 |
| fastype_of1 (_, Var (_,T)) = T |
61 | 324 |
| fastype_of1 (Ts, Abs (_,T,u)) = T --> fastype_of1 (T::Ts, u); |
325 |
||
326 |
fun fastype_of t : typ = fastype_of1 ([],t); |
|
0 | 327 |
|
16678 | 328 |
(*Determine the argument type of a function*) |
22908 | 329 |
fun argument_type_of tm k = |
16678 | 330 |
let |
331 |
fun argT i (Type ("fun", [T, U])) = if i = 0 then T else argT (i - 1) U |
|
332 |
| argT _ T = raise TYPE ("argument_type_of", [T], []); |
|
333 |
||
334 |
fun arg 0 _ (Abs (_, T, _)) = T |
|
335 |
| arg i Ts (Abs (_, T, t)) = arg (i - 1) (T :: Ts) t |
|
336 |
| arg i Ts (t $ _) = arg (i + 1) Ts t |
|
337 |
| arg i Ts a = argT i (fastype_of1 (Ts, a)); |
|
22908 | 338 |
in arg k [] tm end; |
16678 | 339 |
|
0 | 340 |
|
19473 | 341 |
val list_abs = uncurry (fold_rev (fn (x, T) => fn t => Abs (x, T, t))); |
10806 | 342 |
|
18927 | 343 |
fun strip_abs (Abs (a, T, t)) = |
344 |
let val (a', t') = strip_abs t |
|
345 |
in ((a, T) :: a', t') end |
|
346 |
| strip_abs t = ([], t); |
|
347 |
||
0 | 348 |
(* maps (x1,...,xn)t to t *) |
13000 | 349 |
fun strip_abs_body (Abs(_,_,t)) = strip_abs_body t |
0 | 350 |
| strip_abs_body u = u; |
351 |
||
352 |
(* maps (x1,...,xn)t to [x1, ..., xn] *) |
|
13000 | 353 |
fun strip_abs_vars (Abs(a,T,t)) = (a,T) :: strip_abs_vars t |
0 | 354 |
| strip_abs_vars u = [] : (string*typ) list; |
355 |
||
356 |
||
357 |
fun strip_qnt_body qnt = |
|
358 |
let fun strip(tm as Const(c,_)$Abs(_,_,t)) = if c=qnt then strip t else tm |
|
359 |
| strip t = t |
|
360 |
in strip end; |
|
361 |
||
362 |
fun strip_qnt_vars qnt = |
|
363 |
let fun strip(Const(c,_)$Abs(a,T,t)) = if c=qnt then (a,T)::strip t else [] |
|
364 |
| strip t = [] : (string*typ) list |
|
365 |
in strip end; |
|
366 |
||
367 |
||
368 |
(* maps (f, [t1,...,tn]) to f(t1,...,tn) *) |
|
15570 | 369 |
val list_comb : term * term list -> term = Library.foldl (op $); |
0 | 370 |
|
371 |
||
372 |
(* maps f(t1,...,tn) to (f, [t1,...,tn]) ; naturally tail-recursive*) |
|
13000 | 373 |
fun strip_comb u : term * term list = |
0 | 374 |
let fun stripc (f$t, ts) = stripc (f, t::ts) |
13000 | 375 |
| stripc x = x |
0 | 376 |
in stripc(u,[]) end; |
377 |
||
378 |
||
379 |
(* maps f(t1,...,tn) to f , which is never a combination *) |
|
380 |
fun head_of (f$t) = head_of f |
|
381 |
| head_of u = u; |
|
382 |
||
16599 | 383 |
(*number of atoms and abstractions in a term*) |
384 |
fun size_of_term tm = |
|
385 |
let |
|
16678 | 386 |
fun add_size (t $ u, n) = add_size (t, add_size (u, n)) |
387 |
| add_size (Abs (_ ,_, t), n) = add_size (t, n + 1) |
|
388 |
| add_size (_, n) = n + 1; |
|
389 |
in add_size (tm, 0) end; |
|
0 | 390 |
|
18847 | 391 |
fun map_atyps f (Type (a, Ts)) = Type (a, map (map_atyps f) Ts) |
18976
4efb82669880
fixed the most silly bug conceivable in map_atyps
haftmann
parents:
18975
diff
changeset
|
392 |
| map_atyps f T = f T; |
18847 | 393 |
|
394 |
fun map_aterms f (t $ u) = map_aterms f t $ map_aterms f u |
|
395 |
| map_aterms f (Abs (a, T, t)) = Abs (a, T, map_aterms f t) |
|
396 |
| map_aterms f t = f t; |
|
397 |
||
18981 | 398 |
fun map_type_tvar f = map_atyps (fn TVar x => f x | T => T); |
399 |
fun map_type_tfree f = map_atyps (fn TFree x => f x | T => T); |
|
949
83c588d6fee9
Changed treatment of during type inference internally generated type
nipkow
parents:
728
diff
changeset
|
400 |
|
20548
8ef25fe585a8
renamed Term.map_term_types to Term.map_types (cf. Term.fold_types);
wenzelm
parents:
20531
diff
changeset
|
401 |
fun map_types f = |
16678 | 402 |
let |
403 |
fun map_aux (Const (a, T)) = Const (a, f T) |
|
404 |
| map_aux (Free (a, T)) = Free (a, f T) |
|
405 |
| map_aux (Var (v, T)) = Var (v, f T) |
|
406 |
| map_aux (t as Bound _) = t |
|
407 |
| map_aux (Abs (a, T, t)) = Abs (a, f T, map_aux t) |
|
408 |
| map_aux (t $ u) = map_aux t $ map_aux u; |
|
409 |
in map_aux end; |
|
0 | 410 |
|
411 |
||
16943 | 412 |
(* fold types and terms *) |
413 |
||
414 |
fun fold_atyps f (Type (_, Ts)) = fold (fold_atyps f) Ts |
|
415 |
| fold_atyps f T = f T; |
|
416 |
||
417 |
fun fold_aterms f (t $ u) = fold_aterms f t #> fold_aterms f u |
|
418 |
| fold_aterms f (Abs (_, _, t)) = fold_aterms f t |
|
419 |
| fold_aterms f a = f a; |
|
420 |
||
421 |
fun fold_term_types f (t as Const (_, T)) = f t T |
|
422 |
| fold_term_types f (t as Free (_, T)) = f t T |
|
423 |
| fold_term_types f (t as Var (_, T)) = f t T |
|
424 |
| fold_term_types f (Bound _) = I |
|
425 |
| fold_term_types f (t as Abs (_, T, b)) = f t T #> fold_term_types f b |
|
426 |
| fold_term_types f (t $ u) = fold_term_types f t #> fold_term_types f u; |
|
427 |
||
428 |
fun fold_types f = fold_term_types (K f); |
|
429 |
||
24483 | 430 |
fun replace_types (Const (c, _)) (T :: Ts) = (Const (c, T), Ts) |
431 |
| replace_types (Free (x, _)) (T :: Ts) = (Free (x, T), Ts) |
|
432 |
| replace_types (Var (xi, _)) (T :: Ts) = (Var (xi, T), Ts) |
|
433 |
| replace_types (Bound i) Ts = (Bound i, Ts) |
|
434 |
| replace_types (Abs (x, _, b)) (T :: Ts) = |
|
435 |
let val (b', Ts') = replace_types b Ts |
|
436 |
in (Abs (x, T, b'), Ts') end |
|
437 |
| replace_types (t $ u) Ts = |
|
438 |
let |
|
439 |
val (t', Ts') = replace_types t Ts; |
|
440 |
val (u', Ts'') = replace_types u Ts'; |
|
441 |
in (t' $ u', Ts'') end; |
|
442 |
||
443 |
fun burrow_types f ts = |
|
444 |
let |
|
445 |
val Ts = rev (fold (fold_types cons) ts []); |
|
446 |
val Ts' = f Ts; |
|
447 |
val (ts', []) = fold_map replace_types ts Ts'; |
|
448 |
in ts' end; |
|
449 |
||
16943 | 450 |
(*collect variables*) |
29257
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
451 |
val add_tvar_namesT = fold_atyps (fn TVar (xi, _) => insert (op =) xi | _ => I); |
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
452 |
val add_tvar_names = fold_types add_tvar_namesT; |
16943 | 453 |
val add_tvarsT = fold_atyps (fn TVar v => insert (op =) v | _ => I); |
454 |
val add_tvars = fold_types add_tvarsT; |
|
29257
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
455 |
val add_var_names = fold_aterms (fn Var (xi, _) => insert (op =) xi | _ => I); |
16943 | 456 |
val add_vars = fold_aterms (fn Var v => insert (op =) v | _ => I); |
29257
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
457 |
val add_tfree_namesT = fold_atyps (fn TFree (xi, _) => insert (op =) xi | _ => I); |
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
458 |
val add_tfree_names = fold_types add_tfree_namesT; |
16943 | 459 |
val add_tfreesT = fold_atyps (fn TFree v => insert (op =) v | _ => I); |
460 |
val add_tfrees = fold_types add_tfreesT; |
|
29257
660234d959f7
provide canonical add_tvar_namesT, add_tvar_names, add_tfree_namesT, add_tfree_names, add_free_names;
wenzelm
parents:
29256
diff
changeset
|
461 |
val add_free_names = fold_aterms (fn Free (x, _) => insert (op =) x | _ => I); |
16943 | 462 |
val add_frees = fold_aterms (fn Free v => insert (op =) v | _ => I); |
463 |
||
25050 | 464 |
(*extra type variables in a term, not covered by its type*) |
465 |
fun hidden_polymorphism t = |
|
21682 | 466 |
let |
25050 | 467 |
val T = fastype_of t; |
21682 | 468 |
val tvarsT = add_tvarsT T []; |
469 |
val extra_tvars = fold_types (fold_atyps |
|
470 |
(fn TVar v => if member (op =) tvarsT v then I else insert (op =) v | _ => I)) t []; |
|
471 |
in extra_tvars end; |
|
472 |
||
16943 | 473 |
|
29278 | 474 |
(* renaming variables *) |
475 |
||
476 |
val declare_typ_names = fold_atyps (fn TFree (a, _) => Name.declare a | _ => I); |
|
477 |
||
478 |
fun declare_term_names tm = |
|
479 |
fold_aterms |
|
480 |
(fn Const (a, _) => Name.declare (NameSpace.base a) |
|
481 |
| Free (a, _) => Name.declare a |
|
482 |
| _ => I) tm #> |
|
483 |
fold_types declare_typ_names tm; |
|
484 |
||
485 |
val declare_term_frees = fold_aterms (fn Free (x, _) => Name.declare x | _ => I); |
|
486 |
||
487 |
fun variant_frees t frees = |
|
488 |
fst (Name.variants (map fst frees) (declare_term_names t Name.context)) ~~ map snd frees; |
|
489 |
||
490 |
fun rename_wrt_term t frees = rev (variant_frees t frees); (*reversed result!*) |
|
491 |
||
492 |
||
25050 | 493 |
|
29269
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
494 |
(** Comparing terms **) |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
495 |
|
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
496 |
(* variables *) |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
497 |
|
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
498 |
fun eq_ix ((x, i): indexname, (y, j)) = i = j andalso x = y; |
16537 | 499 |
|
29269
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
500 |
fun eq_tvar ((xi, S: sort), (xi', S')) = eq_ix (xi, xi') andalso S = S'; |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
501 |
fun eq_var ((xi, T: typ), (xi', T')) = eq_ix (xi, xi') andalso T = T'; |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
502 |
|
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
503 |
|
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
504 |
(* alpha equivalence *) |
20511 | 505 |
|
506 |
fun tm1 aconv tm2 = |
|
507 |
pointer_eq (tm1, tm2) orelse |
|
508 |
(case (tm1, tm2) of |
|
509 |
(t1 $ u1, t2 $ u2) => t1 aconv t2 andalso u1 aconv u2 |
|
510 |
| (Abs (_, T1, t1), Abs (_, T2, t2)) => t1 aconv t2 andalso T1 = T2 |
|
511 |
| (a1, a2) => a1 = a2); |
|
512 |
||
513 |
||
29269
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
514 |
(*A fast unification filter: true unless the two terms cannot be unified. |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
515 |
Terms must be NORMAL. Treats all Vars as distinct. *) |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
516 |
fun could_unify (t, u) = |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
517 |
let |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
518 |
fun matchrands (f $ t) (g $ u) = could_unify (t, u) andalso matchrands f g |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
519 |
| matchrands _ _ = true; |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
520 |
in |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
521 |
case (head_of t, head_of u) of |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
522 |
(_, Var _) => true |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
523 |
| (Var _, _) => true |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
524 |
| (Const (a, _), Const (b, _)) => a = b andalso matchrands t u |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
525 |
| (Free (a, _), Free (b, _)) => a = b andalso matchrands t u |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
526 |
| (Bound i, Bound j) => i = j andalso matchrands t u |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
527 |
| (Abs _, _) => true (*because of possible eta equality*) |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
528 |
| (_, Abs _) => true |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
529 |
| _ => false |
5c25a2012975
moved term order operations to structure TermOrd (cf. Pure/term_ord.ML);
wenzelm
parents:
29265
diff
changeset
|
530 |
end; |
16678 | 531 |
|
16570 | 532 |
|
16537 | 533 |
|
0 | 534 |
(** Connectives of higher order logic **) |
535 |
||
24850 | 536 |
fun aT S = TFree (Name.aT, S); |
19394 | 537 |
|
375 | 538 |
fun itselfT ty = Type ("itself", [ty]); |
24850 | 539 |
val a_itselfT = itselfT (TFree (Name.aT, [])); |
375 | 540 |
|
0 | 541 |
val propT : typ = Type("prop",[]); |
542 |
||
543 |
fun all T = Const("all", (T-->propT)-->propT); |
|
544 |
||
545 |
(* maps !!x1...xn. t to t *) |
|
13000 | 546 |
fun strip_all_body (Const("all",_)$Abs(_,_,t)) = strip_all_body t |
0 | 547 |
| strip_all_body t = t; |
548 |
||
549 |
(* maps !!x1...xn. t to [x1, ..., xn] *) |
|
550 |
fun strip_all_vars (Const("all",_)$Abs(a,T,t)) = |
|
13000 | 551 |
(a,T) :: strip_all_vars t |
0 | 552 |
| strip_all_vars t = [] : (string*typ) list; |
553 |
||
554 |
(*increments a term's non-local bound variables |
|
555 |
required when moving a term within abstractions |
|
556 |
inc is increment for bound variables |
|
557 |
lev is level at which a bound variable is considered 'loose'*) |
|
13000 | 558 |
fun incr_bv (inc, lev, u as Bound i) = if i>=lev then Bound(i+inc) else u |
0 | 559 |
| incr_bv (inc, lev, Abs(a,T,body)) = |
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
560 |
Abs(a, T, incr_bv(inc,lev+1,body)) |
13000 | 561 |
| incr_bv (inc, lev, f$t) = |
0 | 562 |
incr_bv(inc,lev,f) $ incr_bv(inc,lev,t) |
563 |
| incr_bv (inc, lev, u) = u; |
|
564 |
||
565 |
fun incr_boundvars 0 t = t |
|
566 |
| incr_boundvars inc t = incr_bv(inc,0,t); |
|
567 |
||
12981 | 568 |
(*Scan a pair of terms; while they are similar, |
569 |
accumulate corresponding bound vars in "al"*) |
|
570 |
fun match_bvs(Abs(x,_,s),Abs(y,_,t), al) = |
|
571 |
match_bvs(s, t, if x="" orelse y="" then al |
|
572 |
else (x,y)::al) |
|
573 |
| match_bvs(f$s, g$t, al) = match_bvs(f,g,match_bvs(s,t,al)) |
|
574 |
| match_bvs(_,_,al) = al; |
|
575 |
||
576 |
(* strip abstractions created by parameters *) |
|
577 |
fun match_bvars((s,t),al) = match_bvs(strip_abs_body s, strip_abs_body t, al); |
|
578 |
||
22031 | 579 |
fun map_abs_vars f (t $ u) = map_abs_vars f t $ map_abs_vars f u |
580 |
| map_abs_vars f (Abs (a, T, t)) = Abs (f a, T, map_abs_vars f t) |
|
581 |
| map_abs_vars f t = t; |
|
582 |
||
12981 | 583 |
fun rename_abs pat obj t = |
584 |
let |
|
585 |
val ren = match_bvs (pat, obj, []); |
|
586 |
fun ren_abs (Abs (x, T, b)) = |
|
18942 | 587 |
Abs (the_default x (AList.lookup (op =) ren x), T, ren_abs b) |
12981 | 588 |
| ren_abs (f $ t) = ren_abs f $ ren_abs t |
589 |
| ren_abs t = t |
|
15531 | 590 |
in if null ren then NONE else SOME (ren_abs t) end; |
0 | 591 |
|
592 |
(*Accumulate all 'loose' bound vars referring to level 'lev' or beyond. |
|
593 |
(Bound 0) is loose at level 0 *) |
|
13000 | 594 |
fun add_loose_bnos (Bound i, lev, js) = |
20854 | 595 |
if i<lev then js else insert (op =) (i - lev) js |
0 | 596 |
| add_loose_bnos (Abs (_,_,t), lev, js) = add_loose_bnos (t, lev+1, js) |
597 |
| add_loose_bnos (f$t, lev, js) = |
|
13000 | 598 |
add_loose_bnos (f, lev, add_loose_bnos (t, lev, js)) |
0 | 599 |
| add_loose_bnos (_, _, js) = js; |
600 |
||
601 |
fun loose_bnos t = add_loose_bnos (t, 0, []); |
|
602 |
||
603 |
(* loose_bvar(t,k) iff t contains a 'loose' bound variable referring to |
|
604 |
level k or beyond. *) |
|
605 |
fun loose_bvar(Bound i,k) = i >= k |
|
606 |
| loose_bvar(f$t, k) = loose_bvar(f,k) orelse loose_bvar(t,k) |
|
607 |
| loose_bvar(Abs(_,_,t),k) = loose_bvar(t,k+1) |
|
608 |
| loose_bvar _ = false; |
|
609 |
||
2792 | 610 |
fun loose_bvar1(Bound i,k) = i = k |
611 |
| loose_bvar1(f$t, k) = loose_bvar1(f,k) orelse loose_bvar1(t,k) |
|
612 |
| loose_bvar1(Abs(_,_,t),k) = loose_bvar1(t,k+1) |
|
613 |
| loose_bvar1 _ = false; |
|
0 | 614 |
|
615 |
(*Substitute arguments for loose bound variables. |
|
616 |
Beta-reduction of arg(n-1)...arg0 into t replacing (Bound i) with (argi). |
|
4626 | 617 |
Note that for ((%x y. c) a b), the bound vars in c are x=1 and y=0 |
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
618 |
and the appropriate call is subst_bounds([b,a], c) . |
0 | 619 |
Loose bound variables >=n are reduced by "n" to |
620 |
compensate for the disappearance of lambdas. |
|
621 |
*) |
|
13000 | 622 |
fun subst_bounds (args: term list, t) : term = |
19065 | 623 |
let |
624 |
exception SAME; |
|
625 |
val n = length args; |
|
626 |
fun subst (t as Bound i, lev) = |
|
627 |
(if i < lev then raise SAME (*var is locally bound*) |
|
628 |
else incr_boundvars lev (List.nth (args, i - lev)) |
|
629 |
handle Subscript => Bound (i - n)) (*loose: change it*) |
|
630 |
| subst (Abs (a, T, body), lev) = Abs (a, T, subst (body, lev + 1)) |
|
631 |
| subst (f $ t, lev) = |
|
632 |
(subst (f, lev) $ (subst (t, lev) handle SAME => t) handle SAME => f $ subst (t, lev)) |
|
633 |
| subst _ = raise SAME; |
|
634 |
in case args of [] => t | _ => (subst (t, 0) handle SAME => t) end; |
|
0 | 635 |
|
2192
3bf092b5310b
Optimizations: removal of polymorphic equality; one-argument case
paulson
parents:
2182
diff
changeset
|
636 |
(*Special case: one argument*) |
13000 | 637 |
fun subst_bound (arg, t) : term = |
19065 | 638 |
let |
639 |
exception SAME; |
|
640 |
fun subst (Bound i, lev) = |
|
641 |
if i < lev then raise SAME (*var is locally bound*) |
|
642 |
else if i = lev then incr_boundvars lev arg |
|
643 |
else Bound (i - 1) (*loose: change it*) |
|
644 |
| subst (Abs (a, T, body), lev) = Abs (a, T, subst (body, lev + 1)) |
|
645 |
| subst (f $ t, lev) = |
|
646 |
(subst (f, lev) $ (subst (t, lev) handle SAME => t) handle SAME => f $ subst (t, lev)) |
|
647 |
| subst _ = raise SAME; |
|
648 |
in subst (t, 0) handle SAME => t end; |
|
2192
3bf092b5310b
Optimizations: removal of polymorphic equality; one-argument case
paulson
parents:
2182
diff
changeset
|
649 |
|
0 | 650 |
(*beta-reduce if possible, else form application*) |
2192
3bf092b5310b
Optimizations: removal of polymorphic equality; one-argument case
paulson
parents:
2182
diff
changeset
|
651 |
fun betapply (Abs(_,_,t), u) = subst_bound (u,t) |
0 | 652 |
| betapply (f,u) = f$u; |
653 |
||
18183 | 654 |
val betapplys = Library.foldl betapply; |
655 |
||
14786
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
656 |
|
20109 | 657 |
(*unfolding abstractions with substitution |
658 |
of bound variables and implicit eta-expansion*) |
|
659 |
fun strip_abs_eta k t = |
|
660 |
let |
|
29278 | 661 |
val used = fold_aterms declare_term_frees t Name.context; |
20109 | 662 |
fun strip_abs t (0, used) = (([], t), (0, used)) |
663 |
| strip_abs (Abs (v, T, t)) (k, used) = |
|
664 |
let |
|
20122 | 665 |
val ([v'], used') = Name.variants [v] used; |
21013 | 666 |
val t' = subst_bound (Free (v', T), t); |
20122 | 667 |
val ((vs, t''), (k', used'')) = strip_abs t' (k - 1, used'); |
668 |
in (((v', T) :: vs, t''), (k', used'')) end |
|
20109 | 669 |
| strip_abs t (k, used) = (([], t), (k, used)); |
670 |
fun expand_eta [] t _ = ([], t) |
|
671 |
| expand_eta (T::Ts) t used = |
|
672 |
let |
|
20122 | 673 |
val ([v], used') = Name.variants [""] used; |
674 |
val (vs, t') = expand_eta Ts (t $ Free (v, T)) used'; |
|
20109 | 675 |
in ((v, T) :: vs, t') end; |
676 |
val ((vs1, t'), (k', used')) = strip_abs t (k, used); |
|
677 |
val Ts = (fst o chop k' o fst o strip_type o fastype_of) t'; |
|
678 |
val (vs2, t'') = expand_eta Ts t' used'; |
|
679 |
in (vs1 @ vs2, t'') end; |
|
680 |
||
681 |
||
0 | 682 |
(*Substitute new for free occurrences of old in a term*) |
29256 | 683 |
fun subst_free [] = I |
0 | 684 |
| subst_free pairs = |
13000 | 685 |
let fun substf u = |
17314 | 686 |
case AList.lookup (op aconv) pairs u of |
15531 | 687 |
SOME u' => u' |
688 |
| NONE => (case u of Abs(a,T,t) => Abs(a, T, substf t) |
|
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
689 |
| t$u' => substf t $ substf u' |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
690 |
| _ => u) |
0 | 691 |
in substf end; |
692 |
||
13000 | 693 |
(*Abstraction of the term "body" over its occurrences of v, |
0 | 694 |
which must contain no loose bound variables. |
695 |
The resulting term is ready to become the body of an Abs.*) |
|
16882 | 696 |
fun abstract_over (v, body) = |
697 |
let |
|
16990 | 698 |
exception SAME; |
699 |
fun abs lev tm = |
|
700 |
if v aconv tm then Bound lev |
|
16882 | 701 |
else |
16990 | 702 |
(case tm of |
703 |
Abs (a, T, t) => Abs (a, T, abs (lev + 1) t) |
|
704 |
| t $ u => (abs lev t $ (abs lev u handle SAME => u) handle SAME => t $ abs lev u) |
|
705 |
| _ => raise SAME); |
|
706 |
in abs 0 body handle SAME => body end; |
|
0 | 707 |
|
21975
1152dc45d591
Term.lambda: abstract over arbitrary closed terms;
wenzelm
parents:
21797
diff
changeset
|
708 |
fun lambda v t = |
1152dc45d591
Term.lambda: abstract over arbitrary closed terms;
wenzelm
parents:
21797
diff
changeset
|
709 |
let val x = |
1152dc45d591
Term.lambda: abstract over arbitrary closed terms;
wenzelm
parents:
21797
diff
changeset
|
710 |
(case v of |
1152dc45d591
Term.lambda: abstract over arbitrary closed terms;
wenzelm
parents:
21797
diff
changeset
|
711 |
Const (x, _) => NameSpace.base x |
1152dc45d591
Term.lambda: abstract over arbitrary closed terms;
wenzelm
parents:
21797
diff
changeset
|
712 |
| Free (x, _) => x |
1152dc45d591
Term.lambda: abstract over arbitrary closed terms;
wenzelm
parents:
21797
diff
changeset
|
713 |
| Var ((x, _), _) => x |
24850 | 714 |
| _ => Name.uu) |
21975
1152dc45d591
Term.lambda: abstract over arbitrary closed terms;
wenzelm
parents:
21797
diff
changeset
|
715 |
in Abs (x, fastype_of v, abstract_over (v, t)) end; |
0 | 716 |
|
717 |
(*Form an abstraction over a free variable.*) |
|
21975
1152dc45d591
Term.lambda: abstract over arbitrary closed terms;
wenzelm
parents:
21797
diff
changeset
|
718 |
fun absfree (a,T,body) = Abs (a, T, abstract_over (Free (a, T), body)); |
24850 | 719 |
fun absdummy (T, body) = Abs (Name.internal Name.uu, T, body); |
0 | 720 |
|
721 |
(*Abstraction over a list of free variables*) |
|
722 |
fun list_abs_free ([ ] , t) = t |
|
13000 | 723 |
| list_abs_free ((a,T)::vars, t) = |
0 | 724 |
absfree(a, T, list_abs_free(vars,t)); |
725 |
||
726 |
(*Quantification over a list of free variables*) |
|
727 |
fun list_all_free ([], t: term) = t |
|
13000 | 728 |
| list_all_free ((a,T)::vars, t) = |
0 | 729 |
(all T) $ (absfree(a, T, list_all_free(vars,t))); |
730 |
||
731 |
(*Quantification over a list of variables (already bound in body) *) |
|
732 |
fun list_all ([], t) = t |
|
13000 | 733 |
| list_all ((a,T)::vars, t) = |
0 | 734 |
(all T) $ (Abs(a, T, list_all(vars,t))); |
735 |
||
16678 | 736 |
(*Replace the ATOMIC term ti by ui; inst = [(t1,u1), ..., (tn,un)]. |
0 | 737 |
A simultaneous substitution: [ (a,b), (b,a) ] swaps a and b. *) |
16678 | 738 |
fun subst_atomic [] tm = tm |
739 |
| subst_atomic inst tm = |
|
740 |
let |
|
741 |
fun subst (Abs (a, T, body)) = Abs (a, T, subst body) |
|
742 |
| subst (t $ u) = subst t $ subst u |
|
18942 | 743 |
| subst t = the_default t (AList.lookup (op aconv) inst t); |
16678 | 744 |
in subst tm end; |
0 | 745 |
|
16678 | 746 |
(*Replace the ATOMIC type Ti by Ui; inst = [(T1,U1), ..., (Tn,Un)].*) |
747 |
fun typ_subst_atomic [] ty = ty |
|
748 |
| typ_subst_atomic inst ty = |
|
749 |
let |
|
750 |
fun subst (Type (a, Ts)) = Type (a, map subst Ts) |
|
18942 | 751 |
| subst T = the_default T (AList.lookup (op = : typ * typ -> bool) inst T); |
16678 | 752 |
in subst ty end; |
15797 | 753 |
|
16678 | 754 |
fun subst_atomic_types [] tm = tm |
20548
8ef25fe585a8
renamed Term.map_term_types to Term.map_types (cf. Term.fold_types);
wenzelm
parents:
20531
diff
changeset
|
755 |
| subst_atomic_types inst tm = map_types (typ_subst_atomic inst) tm; |
16678 | 756 |
|
757 |
fun typ_subst_TVars [] ty = ty |
|
758 |
| typ_subst_TVars inst ty = |
|
759 |
let |
|
760 |
fun subst (Type (a, Ts)) = Type (a, map subst Ts) |
|
18942 | 761 |
| subst (T as TVar (xi, _)) = the_default T (AList.lookup (op =) inst xi) |
16678 | 762 |
| subst T = T; |
763 |
in subst ty end; |
|
0 | 764 |
|
16678 | 765 |
fun subst_TVars [] tm = tm |
20548
8ef25fe585a8
renamed Term.map_term_types to Term.map_types (cf. Term.fold_types);
wenzelm
parents:
20531
diff
changeset
|
766 |
| subst_TVars inst tm = map_types (typ_subst_TVars inst) tm; |
0 | 767 |
|
16678 | 768 |
fun subst_Vars [] tm = tm |
769 |
| subst_Vars inst tm = |
|
770 |
let |
|
18942 | 771 |
fun subst (t as Var (xi, _)) = the_default t (AList.lookup (op =) inst xi) |
16678 | 772 |
| subst (Abs (a, T, t)) = Abs (a, T, subst t) |
773 |
| subst (t $ u) = subst t $ subst u |
|
774 |
| subst t = t; |
|
775 |
in subst tm end; |
|
0 | 776 |
|
16678 | 777 |
fun subst_vars ([], []) tm = tm |
778 |
| subst_vars ([], inst) tm = subst_Vars inst tm |
|
779 |
| subst_vars (instT, inst) tm = |
|
780 |
let |
|
781 |
fun subst (Const (a, T)) = Const (a, typ_subst_TVars instT T) |
|
782 |
| subst (Free (a, T)) = Free (a, typ_subst_TVars instT T) |
|
783 |
| subst (t as Var (xi, T)) = |
|
17271 | 784 |
(case AList.lookup (op =) inst xi of |
16678 | 785 |
NONE => Var (xi, typ_subst_TVars instT T) |
786 |
| SOME t => t) |
|
787 |
| subst (t as Bound _) = t |
|
788 |
| subst (Abs (a, T, t)) = Abs (a, typ_subst_TVars instT T, subst t) |
|
789 |
| subst (t $ u) = subst t $ subst u; |
|
790 |
in subst tm end; |
|
0 | 791 |
|
25050 | 792 |
fun close_schematic_term t = |
793 |
let |
|
794 |
val extra_types = map (fn v => Const ("TYPE", itselfT (TVar v))) (hidden_polymorphism t); |
|
795 |
val extra_terms = map Var (rev (add_vars t [])); |
|
796 |
in fold_rev lambda (extra_types @ extra_terms) t end; |
|
797 |
||
798 |
||
0 | 799 |
|
15573 | 800 |
(** Identifying first-order terms **) |
801 |
||
20199 | 802 |
(*Differs from proofterm/is_fun in its treatment of TVar*) |
29256 | 803 |
fun is_funtype (Type ("fun", [_, _])) = true |
20199 | 804 |
| is_funtype _ = false; |
805 |
||
15573 | 806 |
(*Argument Ts is a reverse list of binder types, needed if term t contains Bound vars*) |
29256 | 807 |
fun has_not_funtype Ts t = not (is_funtype (fastype_of1 (Ts, t))); |
15573 | 808 |
|
16537 | 809 |
(*First order means in all terms of the form f(t1,...,tn) no argument has a |
16589 | 810 |
function type. The supplied quantifiers are excluded: their argument always |
811 |
has a function type through a recursive call into its body.*) |
|
16667 | 812 |
fun is_first_order quants = |
16589 | 813 |
let fun first_order1 Ts (Abs (_,T,body)) = first_order1 (T::Ts) body |
16667 | 814 |
| first_order1 Ts (Const(q,_) $ Abs(a,T,body)) = |
20664 | 815 |
member (op =) quants q andalso (*it is a known quantifier*) |
16589 | 816 |
not (is_funtype T) andalso first_order1 (T::Ts) body |
16667 | 817 |
| first_order1 Ts t = |
818 |
case strip_comb t of |
|
819 |
(Var _, ts) => forall (first_order1 Ts andf has_not_funtype Ts) ts |
|
820 |
| (Free _, ts) => forall (first_order1 Ts andf has_not_funtype Ts) ts |
|
821 |
| (Const _, ts) => forall (first_order1 Ts andf has_not_funtype Ts) ts |
|
822 |
| (Bound _, ts) => forall (first_order1 Ts andf has_not_funtype Ts) ts |
|
823 |
| (Abs _, ts) => false (*not in beta-normal form*) |
|
824 |
| _ => error "first_order: unexpected case" |
|
16589 | 825 |
in first_order1 [] end; |
15573 | 826 |
|
16710 | 827 |
|
16990 | 828 |
(* maximum index of typs and terms *) |
0 | 829 |
|
16710 | 830 |
fun maxidx_typ (TVar ((_, j), _)) i = Int.max (i, j) |
831 |
| maxidx_typ (Type (_, Ts)) i = maxidx_typs Ts i |
|
832 |
| maxidx_typ (TFree _) i = i |
|
833 |
and maxidx_typs [] i = i |
|
834 |
| maxidx_typs (T :: Ts) i = maxidx_typs Ts (maxidx_typ T i); |
|
0 | 835 |
|
16710 | 836 |
fun maxidx_term (Var ((_, j), T)) i = maxidx_typ T (Int.max (i, j)) |
837 |
| maxidx_term (Const (_, T)) i = maxidx_typ T i |
|
838 |
| maxidx_term (Free (_, T)) i = maxidx_typ T i |
|
839 |
| maxidx_term (Bound _) i = i |
|
840 |
| maxidx_term (Abs (_, T, t)) i = maxidx_term t (maxidx_typ T i) |
|
841 |
| maxidx_term (t $ u) i = maxidx_term u (maxidx_term t i); |
|
0 | 842 |
|
16710 | 843 |
fun maxidx_of_typ T = maxidx_typ T ~1; |
844 |
fun maxidx_of_typs Ts = maxidx_typs Ts ~1; |
|
845 |
fun maxidx_of_term t = maxidx_term t ~1; |
|
13665 | 846 |
|
0 | 847 |
|
848 |
||
29270
0eade173f77e
moved old add_type_XXX, add_term_XXX etc. to structure OldTerm;
wenzelm
parents:
29269
diff
changeset
|
849 |
(** misc syntax operations **) |
0 | 850 |
|
19909 | 851 |
(* substructure *) |
4017
63878e2587a7
add_typ_classes, add_typ_tycons, add_term_classes, add_term_tycons,
wenzelm
parents:
3965
diff
changeset
|
852 |
|
19909 | 853 |
fun exists_subtype P = |
854 |
let |
|
855 |
fun ex ty = P ty orelse |
|
856 |
(case ty of Type (_, Ts) => exists ex Ts | _ => false); |
|
857 |
in ex end; |
|
13646 | 858 |
|
20531 | 859 |
fun exists_type P = |
860 |
let |
|
861 |
fun ex (Const (_, T)) = P T |
|
862 |
| ex (Free (_, T)) = P T |
|
863 |
| ex (Var (_, T)) = P T |
|
864 |
| ex (Bound _) = false |
|
865 |
| ex (Abs (_, T, t)) = P T orelse ex t |
|
866 |
| ex (t $ u) = ex t orelse ex u; |
|
867 |
in ex end; |
|
868 |
||
16943 | 869 |
fun exists_subterm P = |
870 |
let |
|
871 |
fun ex tm = P tm orelse |
|
872 |
(case tm of |
|
873 |
t $ u => ex t orelse ex u |
|
874 |
| Abs (_, _, t) => ex t |
|
875 |
| _ => false); |
|
876 |
in ex end; |
|
16108
cf468b93a02e
Implement cycle-free overloading, so that definitions cannot harm consistency any more (except of course via interaction with axioms).
obua
parents:
16035
diff
changeset
|
877 |
|
29270
0eade173f77e
moved old add_type_XXX, add_term_XXX etc. to structure OldTerm;
wenzelm
parents:
29269
diff
changeset
|
878 |
fun exists_Const P = exists_subterm (fn Const c => P c | _ => false); |
0eade173f77e
moved old add_type_XXX, add_term_XXX etc. to structure OldTerm;
wenzelm
parents:
29269
diff
changeset
|
879 |
|
24671 | 880 |
fun has_abs (Abs _) = true |
881 |
| has_abs (t $ u) = has_abs t orelse has_abs u |
|
882 |
| has_abs _ = false; |
|
883 |
||
884 |
||
20199 | 885 |
(* dest abstraction *) |
0 | 886 |
|
16678 | 887 |
fun dest_abs (x, T, body) = |
888 |
let |
|
889 |
fun name_clash (Free (y, _)) = (x = y) |
|
890 |
| name_clash (t $ u) = name_clash t orelse name_clash u |
|
891 |
| name_clash (Abs (_, _, t)) = name_clash t |
|
892 |
| name_clash _ = false; |
|
893 |
in |
|
27335 | 894 |
if name_clash body then dest_abs (Name.variant [x] x, T, body) (*potentially slow*) |
16678 | 895 |
else (x, subst_bound (Free (x, T), body)) |
896 |
end; |
|
897 |
||
20160 | 898 |
|
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
899 |
(* dummy patterns *) |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
900 |
|
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
901 |
val dummy_patternN = "dummy_pattern"; |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
902 |
|
18253 | 903 |
fun dummy_pattern T = Const (dummy_patternN, T); |
904 |
||
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
905 |
fun is_dummy_pattern (Const ("dummy_pattern", _)) = true |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
906 |
| is_dummy_pattern _ = false; |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
907 |
|
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
908 |
fun no_dummy_patterns tm = |
16787 | 909 |
if not (fold_aterms (fn t => fn b => b orelse is_dummy_pattern t) tm false) then tm |
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
910 |
else raise TERM ("Illegal occurrence of '_' dummy pattern", [tm]); |
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
911 |
|
24733 | 912 |
fun free_dummy_patterns (Const ("dummy_pattern", T)) used = |
24850 | 913 |
let val [x] = Name.invents used Name.uu 1 |
24733 | 914 |
in (Free (Name.internal x, T), Name.declare x used) end |
915 |
| free_dummy_patterns (Abs (x, T, b)) used = |
|
916 |
let val (b', used') = free_dummy_patterns b used |
|
917 |
in (Abs (x, T, b'), used') end |
|
918 |
| free_dummy_patterns (t $ u) used = |
|
919 |
let |
|
920 |
val (t', used') = free_dummy_patterns t used; |
|
921 |
val (u', used'') = free_dummy_patterns u used'; |
|
922 |
in (t' $ u', used'') end |
|
923 |
| free_dummy_patterns a used = (a, used); |
|
924 |
||
24762 | 925 |
fun replace_dummy Ts (Const ("dummy_pattern", T)) i = |
926 |
(list_comb (Var (("_dummy_", i), Ts ---> T), map Bound (0 upto length Ts - 1)), i + 1) |
|
927 |
| replace_dummy Ts (Abs (x, T, t)) i = |
|
928 |
let val (t', i') = replace_dummy (T :: Ts) t i |
|
929 |
in (Abs (x, T, t'), i') end |
|
930 |
| replace_dummy Ts (t $ u) i = |
|
931 |
let |
|
932 |
val (t', i') = replace_dummy Ts t i; |
|
933 |
val (u', i'') = replace_dummy Ts u i'; |
|
934 |
in (t' $ u', i'') end |
|
935 |
| replace_dummy _ a i = (a, i); |
|
11903 | 936 |
|
937 |
val replace_dummy_patterns = replace_dummy []; |
|
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
938 |
|
10552 | 939 |
fun is_replaced_dummy_pattern ("_dummy_", _) = true |
940 |
| is_replaced_dummy_pattern _ = false; |
|
9536
b79b002f32ae
added dummy_patternN, no_dummy_patterns, replace_dummy_patterns;
wenzelm
parents:
9319
diff
changeset
|
941 |
|
16035 | 942 |
fun show_dummy_patterns (Var (("_dummy_", _), T)) = Const ("dummy_pattern", T) |
943 |
| show_dummy_patterns (t $ u) = show_dummy_patterns t $ show_dummy_patterns u |
|
944 |
| show_dummy_patterns (Abs (x, T, t)) = Abs (x, T, show_dummy_patterns t) |
|
945 |
| show_dummy_patterns a = a; |
|
946 |
||
13484 | 947 |
|
20100 | 948 |
(* display variables *) |
949 |
||
15986 | 950 |
val show_question_marks = ref true; |
15472 | 951 |
|
14786
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
952 |
fun string_of_vname (x, i) = |
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
953 |
let |
15986 | 954 |
val question_mark = if ! show_question_marks then "?" else ""; |
955 |
val idx = string_of_int i; |
|
956 |
val dot = |
|
957 |
(case rev (Symbol.explode x) of |
|
958 |
_ :: "\\<^isub>" :: _ => false |
|
959 |
| _ :: "\\<^isup>" :: _ => false |
|
960 |
| c :: _ => Symbol.is_digit c |
|
961 |
| _ => true); |
|
14786
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
962 |
in |
15986 | 963 |
if dot then question_mark ^ x ^ "." ^ idx |
964 |
else if i <> 0 then question_mark ^ x ^ idx |
|
965 |
else question_mark ^ x |
|
14786
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
966 |
end; |
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
967 |
|
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
968 |
fun string_of_vname' (x, ~1) = x |
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
969 |
| string_of_vname' xi = string_of_vname xi; |
24a7bc97a27a
moved some sort ops to sorts.ML; added string_of_vname (from Syntax module);
wenzelm
parents:
14695
diff
changeset
|
970 |
|
1364
8ea1a962ad72
files now define a structure to allow SML/NJ to optimize the code
clasohm
parents:
1029
diff
changeset
|
971 |
end; |
8ea1a962ad72
files now define a structure to allow SML/NJ to optimize the code
clasohm
parents:
1029
diff
changeset
|
972 |
|
4444 | 973 |
structure BasicTerm: BASIC_TERM = Term; |
974 |
open BasicTerm; |