237 (make_fixed_var x,type_of T) |
237 (make_fixed_var x,type_of T) |
238 end |
238 end |
239 | pred_name_type (Var(_,_)) = raise CLAUSE("Predicate Not First Order") |
239 | pred_name_type (Var(_,_)) = raise CLAUSE("Predicate Not First Order") |
240 | pred_name_type _ = raise CLAUSE("Predicate input unexpected"); |
240 | pred_name_type _ = raise CLAUSE("Predicate input unexpected"); |
241 |
241 |
|
242 |
|
243 (* For type equality *) |
|
244 (* here "arg_typ" is the type of "="'s argument's type, not the type of the equality *) |
|
245 (* Find type of equality arg *) |
|
246 fun eq_arg_type (Type("fun",[T,_])) = |
|
247 let val (folT,_) = type_of T; |
|
248 in |
|
249 folT |
|
250 end; |
|
251 |
|
252 |
|
253 |
242 fun fun_name_type (Const(c,T)) = (lookup_const c,type_of T) |
254 fun fun_name_type (Const(c,T)) = (lookup_const c,type_of T) |
243 | fun_name_type (Free(x,T)) = (make_fixed_var x,type_of T) |
255 | fun_name_type (Free(x,T)) = (make_fixed_var x,type_of T) |
244 | fun_name_type _ = raise CLAUSE("Function Not First Order"); |
256 | fun_name_type _ = raise CLAUSE("Function Not First Order"); |
245 |
257 |
246 |
258 |
|
259 |
247 fun term_of (Var(ind_nm,T)) = |
260 fun term_of (Var(ind_nm,T)) = |
248 let val (folType,ts) = type_of T |
261 let val (folType,ts) = type_of T |
249 in |
262 in |
250 (UVar(make_schematic_var(string_of_indexname ind_nm),folType),ts) |
263 (UVar(make_schematic_var(string_of_indexname ind_nm),folType),ts) |
251 end |
264 end |
255 in |
268 in |
256 if is_meta then (UVar(make_schematic_var x,folType),ts) |
269 if is_meta then (UVar(make_schematic_var x,folType),ts) |
257 else |
270 else |
258 (Fun(make_fixed_var x,folType,[]),ts) |
271 (Fun(make_fixed_var x,folType,[]),ts) |
259 end |
272 end |
260 | term_of (Const(c,T)) = |
273 | term_of (Const(c,T)) = (* impossible to be equality *) |
261 let val (folType,ts) = type_of T |
274 let val (folType,ts) = type_of T |
262 in |
275 in |
263 (Fun(lookup_const c,folType,[]),ts) |
276 (Fun(lookup_const c,folType,[]),ts) |
264 end |
277 end |
265 | term_of (app as (t $ a)) = |
278 | term_of (app as (t $ a)) = |
269 val (args',ts2) = ResLib.unzip (map term_of args) |
282 val (args',ts2) = ResLib.unzip (map term_of args) |
270 val ts3 = ResLib.flat_noDup (ts1::ts2) |
283 val ts3 = ResLib.flat_noDup (ts1::ts2) |
271 in |
284 in |
272 (Fun(funName,funType,args'),ts3) |
285 (Fun(funName,funType,args'),ts3) |
273 end |
286 end |
274 in |
287 fun term_of_eq ((Const ("op =", typ)),args) = |
275 case f of Const(_,_) => term_of_aux () |
288 let val arg_typ = eq_arg_type typ |
|
289 val (args',ts) = ResLib.unzip (map term_of args) |
|
290 val equal_name = lookup_const ("op =") |
|
291 in |
|
292 (Fun(equal_name,arg_typ,args'),ResLib.flat_noDup ts) |
|
293 end |
|
294 in |
|
295 case f of Const ("op =", typ) => term_of_eq (f,args) |
|
296 | Const(_,_) => term_of_aux () |
276 | Free(s,_) => if (checkMeta s) then (raise CLAUSE("Function Not First Order")) else term_of_aux () |
297 | Free(s,_) => if (checkMeta s) then (raise CLAUSE("Function Not First Order")) else term_of_aux () |
277 | _ => raise CLAUSE("Function Not First Order") |
298 | _ => raise CLAUSE("Function Not First Order") |
278 end |
299 end |
279 | term_of _ = raise CLAUSE("Function Not First Order"); |
300 | term_of _ = raise CLAUSE("Function Not First Order"); |
280 |
301 |
281 |
302 |
282 |
303 |
283 |
|
284 (* For type equality *) |
|
285 (* here "arg_typ" is the type of "="'s argument's type, not the type of the equality *) |
|
286 (* Find type of equality arg *) |
|
287 local |
|
288 |
|
289 fun eq_arg_type (Type("fun",[T,_])) = |
|
290 let val (folT,_) = type_of T; |
|
291 in |
|
292 folT |
|
293 end; |
|
294 |
|
295 in |
|
296 |
304 |
297 fun pred_of_eq ((Const ("op =", typ)),args) = |
305 fun pred_of_eq ((Const ("op =", typ)),args) = |
298 let val arg_typ = eq_arg_type typ |
306 let val arg_typ = eq_arg_type typ |
299 val (args',ts) = ResLib.unzip (map term_of args) |
307 val (args',ts) = ResLib.unzip (map term_of args) |
300 val equal_name = lookup_const "op =" |
308 val equal_name = lookup_const "op =" |
301 in |
309 in |
302 (Predicate(equal_name,arg_typ,args'),ResLib.flat_noDup ts) |
310 (Predicate(equal_name,arg_typ,args'),ResLib.flat_noDup ts) |
303 end; |
311 end; |
304 |
312 |
305 end; |
|
306 |
313 |
307 (* changed for non-equality predicate *) |
314 (* changed for non-equality predicate *) |
308 (* The input "pred" cannot be an equality *) |
315 (* The input "pred" cannot be an equality *) |
309 fun pred_of_nonEq (pred,args) = |
316 fun pred_of_nonEq (pred,args) = |
310 let val (predName,(predType,ts1)) = pred_name_type pred |
317 let val (predName,(predType,ts1)) = pred_name_type pred |
551 |
558 |
552 fun string_of_kind (Clause cls) = name_of_kind (#kind cls); |
559 fun string_of_kind (Clause cls) = name_of_kind (#kind cls); |
553 |
560 |
554 fun string_of_axiomName (Clause cls) = #axiom_name cls; |
561 fun string_of_axiomName (Clause cls) = #axiom_name cls; |
555 |
562 |
556 fun string_of_term (UVar(x,_)) = x |
|
557 | string_of_term (Fun (name,typ,[])) = name |
|
558 | string_of_term (Fun (name,typ,terms)) = |
|
559 let val terms' = map string_of_term terms |
|
560 in |
|
561 if (!keep_types) then name ^ (ResLib.list_to_string (typ :: terms')) |
|
562 else name ^ (ResLib.list_to_string terms') |
|
563 end; |
|
564 |
|
565 |
|
566 |
|
567 (****!!!! Changed for typed equality !!!!****) |
563 (****!!!! Changed for typed equality !!!!****) |
568 fun wrap_eq_type typ t = eq_typ_wrapper ^"(" ^ t ^ "," ^ typ ^ ")"; |
564 fun wrap_eq_type typ t = eq_typ_wrapper ^"(" ^ t ^ "," ^ typ ^ ")"; |
569 |
565 |
570 |
566 |
571 (****!!!! Changed for typed equality !!!!****) |
567 (****!!!! Changed for typed equality !!!!****) |
575 in |
571 in |
576 if ((!keep_types) andalso (!special_equal)) then |
572 if ((!keep_types) andalso (!special_equal)) then |
577 "equal(" ^ (wrap_eq_type typ tstr1) ^ "," ^ (wrap_eq_type typ tstr2) ^ ")" |
573 "equal(" ^ (wrap_eq_type typ tstr1) ^ "," ^ (wrap_eq_type typ tstr2) ^ ")" |
578 else |
574 else |
579 "equal(" ^ tstr1 ^ "," ^ tstr2 ^ ")" |
575 "equal(" ^ tstr1 ^ "," ^ tstr2 ^ ")" |
|
576 end |
|
577 |
|
578 |
|
579 and |
|
580 string_of_term (UVar(x,_)) = x |
|
581 | string_of_term (Fun("equal",typ,terms)) = string_of_equality(typ,terms) |
|
582 | string_of_term (Fun (name,typ,[])) = name |
|
583 | string_of_term (Fun (name,typ,terms)) = |
|
584 let val terms' = map string_of_term terms |
|
585 in |
|
586 if (!keep_types) then name ^ (ResLib.list_to_string (typ :: terms')) |
|
587 else name ^ (ResLib.list_to_string terms') |
580 end; |
588 end; |
581 |
589 |
582 |
590 |
583 |
591 |
584 (* Changed for typed equality *) |
592 (* Changed for typed equality *) |