350 ResClause.mk_fol_type("Comp",t,typs) |
350 ResClause.mk_fol_type("Comp",t,typs) |
351 end |
351 end |
352 | simp_type_of (TFree (a,s)) = ResClause.mk_fol_type("Fixed",ResClause.make_fixed_type_var a,[]) |
352 | simp_type_of (TFree (a,s)) = ResClause.mk_fol_type("Fixed",ResClause.make_fixed_type_var a,[]) |
353 | simp_type_of (TVar (v,s)) = ResClause.mk_fol_type("Var",ResClause.make_schematic_type_var v,[]); |
353 | simp_type_of (TVar (v,s)) = ResClause.mk_fol_type("Var",ResClause.make_schematic_type_var v,[]); |
354 |
354 |
355 fun comb_typ ("COMBI",t) = |
355 |
356 let val t' = domain_type t |
356 fun const_type_of (c,t) = |
357 in |
|
358 [simp_type_of t'] |
|
359 end |
|
360 | comb_typ ("COMBK",t) = |
|
361 let val a = domain_type t |
|
362 val b = domain_type (range_type t) |
|
363 in |
|
364 map simp_type_of [a,b] |
|
365 end |
|
366 | comb_typ ("COMBS",t) = |
|
367 let val t' = domain_type t |
|
368 val a = domain_type t' |
|
369 val b = domain_type (range_type t') |
|
370 val c = range_type (range_type t') |
|
371 in |
|
372 map simp_type_of [a,b,c] |
|
373 end |
|
374 | comb_typ ("COMBB",t) = |
|
375 let val ab = domain_type t |
|
376 val ca = domain_type (range_type t) |
|
377 val a = domain_type ab |
|
378 val b = range_type ab |
|
379 val c = domain_type ca |
|
380 in |
|
381 map simp_type_of [a,b,c] |
|
382 end |
|
383 | comb_typ ("COMBC",t) = |
|
384 let val t1 = domain_type t |
|
385 val a = domain_type t1 |
|
386 val b = domain_type (range_type t1) |
|
387 val c = range_type (range_type t1) |
|
388 in |
|
389 map simp_type_of [a,b,c] |
|
390 end |
|
391 | comb_typ ("COMBB_e",t) = |
|
392 let val t1 = domain_type t |
|
393 val a = domain_type t1 |
|
394 val b = range_type t1 |
|
395 val t2 = domain_type (range_type(range_type t)) |
|
396 val c = domain_type t2 |
|
397 val d = range_type t2 |
|
398 in |
|
399 map simp_type_of [a,b,c,d] |
|
400 end |
|
401 | comb_typ ("COMBC_e",t) = |
|
402 let val t1 = domain_type t |
|
403 val a = domain_type t1 |
|
404 val b = domain_type (range_type t1) |
|
405 val c = range_type (range_type t1) |
|
406 val d = domain_type (domain_type (range_type t)) |
|
407 in |
|
408 map simp_type_of [a,b,c,d] |
|
409 end |
|
410 | comb_typ ("COMBS_e",t) = |
|
411 let val t1 = domain_type t |
|
412 val a = domain_type t1 |
|
413 val b = domain_type (range_type t1) |
|
414 val c = range_type (range_type t1) |
|
415 val d = domain_type (domain_type (range_type t)) |
|
416 in |
|
417 map simp_type_of [a,b,c,d] |
|
418 end; |
|
419 |
|
420 fun const_type_of ("COMBI",t) = |
|
421 let val (tp,ts) = type_of t |
|
422 val I_var = comb_typ ("COMBI",t) |
|
423 in |
|
424 (tp,ts,I_var) |
|
425 end |
|
426 | const_type_of ("COMBK",t) = |
|
427 let val (tp,ts) = type_of t |
|
428 val K_var = comb_typ ("COMBK",t) |
|
429 in |
|
430 (tp,ts,K_var) |
|
431 end |
|
432 | const_type_of ("COMBS",t) = |
|
433 let val (tp,ts) = type_of t |
|
434 val S_var = comb_typ ("COMBS",t) |
|
435 in |
|
436 (tp,ts,S_var) |
|
437 end |
|
438 | const_type_of ("COMBB",t) = |
|
439 let val (tp,ts) = type_of t |
|
440 val B_var = comb_typ ("COMBB",t) |
|
441 in |
|
442 (tp,ts,B_var) |
|
443 end |
|
444 | const_type_of ("COMBC",t) = |
|
445 let val (tp,ts) = type_of t |
|
446 val C_var = comb_typ ("COMBC",t) |
|
447 in |
|
448 (tp,ts,C_var) |
|
449 end |
|
450 | const_type_of ("COMBB_e",t) = |
|
451 let val (tp,ts) = type_of t |
|
452 val B'_var = comb_typ ("COMBB_e",t) |
|
453 in |
|
454 (tp,ts,B'_var) |
|
455 end |
|
456 | const_type_of ("COMBC_e",t) = |
|
457 let val (tp,ts) = type_of t |
|
458 val C'_var = comb_typ ("COMBC_e",t) |
|
459 in |
|
460 (tp,ts,C'_var) |
|
461 end |
|
462 | const_type_of ("COMBS_e",t) = |
|
463 let val (tp,ts) = type_of t |
|
464 val S'_var = comb_typ ("COMBS_e",t) |
|
465 in |
|
466 (tp,ts,S'_var) |
|
467 end |
|
468 | const_type_of (c,t) = |
|
469 let val (tp,ts) = type_of t |
357 let val (tp,ts) = type_of t |
470 val tvars = !const_typargs(c,t) |
358 val tvars = !const_typargs(c,t) |
471 val tvars' = map simp_type_of tvars |
359 val tvars' = map simp_type_of tvars |
472 in |
360 in |
473 (tp,ts,tvars') |
361 (tp,ts,tvars') |
789 val lits_str = commas lits |
677 val lits_str = commas lits |
790 val cls_str = ResClause.gen_dfg_cls(clause_id, axiom_name, knd, lits_str, tvars@vars) |
678 val cls_str = ResClause.gen_dfg_cls(clause_id, axiom_name, knd, lits_str, tvars@vars) |
791 in (cls_str, tfree_lits) end; |
679 in (cls_str, tfree_lits) end; |
792 |
680 |
793 |
681 |
794 fun init_combs (comb,funcs) = |
|
795 case !typ_level of T_CONST => |
|
796 (case comb of "c_COMBK" => Symtab.update (comb,2) funcs |
|
797 | "c_COMBS" => Symtab.update (comb,3) funcs |
|
798 | "c_COMBI" => Symtab.update (comb,1) funcs |
|
799 | "c_COMBB" => Symtab.update (comb,3) funcs |
|
800 | "c_COMBC" => Symtab.update (comb,3) funcs |
|
801 | "c_COMBB_e" => Symtab.update (comb,4) funcs |
|
802 | "c_COMBC_e" => Symtab.update (comb,4) funcs |
|
803 | "c_COMBS_e" => Symtab.update (comb,4) funcs |
|
804 | _ => funcs) |
|
805 | _ => Symtab.update (comb,0) funcs; |
|
806 |
|
807 fun init_funcs_tab funcs = |
682 fun init_funcs_tab funcs = |
808 let val tp = !typ_level |
683 let val tp = !typ_level |
809 val funcs0 = foldl init_combs funcs ["c_COMBK","c_COMBS","c_COMBI","c_COMBB","c_COMBC", |
684 val funcs1 = case tp of T_PARTIAL => Symtab.update ("hAPP",3) funcs |
810 "c_COMBB__e","c_COMBC__e","c_COMBS__e"] |
685 | _ => Symtab.update ("hAPP",2) funcs |
811 val funcs1 = case tp of T_PARTIAL => Symtab.update ("hAPP",3) funcs0 |
|
812 | _ => Symtab.update ("hAPP",2) funcs0 |
|
813 val funcs2 = case tp of T_FULL => Symtab.update ("typeinfo",2) funcs1 |
686 val funcs2 = case tp of T_FULL => Symtab.update ("typeinfo",2) funcs1 |
814 | _ => funcs1 |
687 | _ => funcs1 |
815 in |
688 in |
816 case tp of T_CONST => Symtab.update ("c_fequal",1) funcs2 |
689 funcs2 |
817 | _ => Symtab.update ("c_fequal",0) funcs2 |
|
818 end; |
690 end; |
819 |
691 |
820 |
692 |
821 fun add_funcs (CombConst(c,_,tvars),funcs) = |
693 fun add_funcs (CombConst(c,_,tvars),funcs) = |
822 if c = "equal" then foldl ResClause.add_foltype_funcs funcs tvars |
694 if c = "equal" then foldl ResClause.add_foltype_funcs funcs tvars |