src/HOL/Tools/res_hol_clause.ML
changeset 20865 2cfa020109c1
parent 20864 bb75b876b260
child 20953 1ea394dc2a0f
equal deleted inserted replaced
20864:bb75b876b260 20865:2cfa020109c1
   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