src/HOL/Tools/res_axioms.ML
author wenzelm
Thu Jan 19 21:22:08 2006 +0100 (2006-01-19 ago)
changeset 18708 4b3dadb4fe33
parent 18680 677e2bdd75f0
child 18728 6790126ab5f6
permissions -rw-r--r--
setup: theory -> theory;
     1 (*  Author: Jia Meng, Cambridge University Computer Laboratory
     2     ID: $Id$
     3     Copyright 2004 University of Cambridge
     4 
     5 Transformation of axiom rules (elim/intro/etc) into CNF forms.    
     6 *)
     7 
     8 signature RES_AXIOMS =
     9   sig
    10   exception ELIMR2FOL of string
    11   val tagging_enabled : bool
    12   val elimRule_tac : thm -> Tactical.tactic
    13   val elimR2Fol : thm -> term
    14   val transform_elim : thm -> thm
    15   val clausify_axiom_pairs : (string*thm) -> (ResClause.clause*thm) list
    16   val clausify_axiom_pairsH : (string*thm) -> (ResHolClause.clause*thm) list
    17   val cnf_axiom : (string * thm) -> thm list
    18   val meta_cnf_axiom : thm -> thm list
    19   val claset_rules_of_thy : theory -> (string * thm) list
    20   val simpset_rules_of_thy : theory -> (string * thm) list
    21   val claset_rules_of_ctxt: Proof.context -> (string * thm) list
    22   val simpset_rules_of_ctxt : Proof.context -> (string * thm) list
    23   val clausify_rules_pairs : (string*thm) list -> (ResClause.clause*thm) list list
    24   val clausify_rules_pairsH : (string*thm) list -> (ResHolClause.clause*thm) list list
    25   val pairname : thm -> (string * thm)
    26   val skolem_thm : thm -> thm list
    27   val cnf_rules1 : (string * thm) list -> string list -> (string * thm list) list * string list
    28   val cnf_rules2 : (string * thm) list -> string list -> (string * term list) list * string list
    29 
    30   val meson_method_setup : theory -> theory
    31   val setup : theory -> theory
    32   end;
    33 
    34 structure ResAxioms : RES_AXIOMS =
    35  
    36 struct
    37 
    38 
    39 val tagging_enabled = false (*compile_time option*)
    40 
    41 (**** Transformation of Elimination Rules into First-Order Formulas****)
    42 
    43 (* a tactic used to prove an elim-rule. *)
    44 fun elimRule_tac th =
    45     ((rtac impI 1) ORELSE (rtac notI 1)) THEN (etac th 1) THEN
    46     REPEAT(fast_tac HOL_cs 1);
    47 
    48 exception ELIMR2FOL of string;
    49 
    50 (* functions used to construct a formula *)
    51 
    52 fun make_disjs [x] = x
    53   | make_disjs (x :: xs) = HOLogic.mk_disj(x, make_disjs xs)
    54 
    55 fun make_conjs [x] = x
    56   | make_conjs (x :: xs) =  HOLogic.mk_conj(x, make_conjs xs)
    57 
    58 fun add_EX tm [] = tm
    59   | add_EX tm ((x,xtp)::xs) = add_EX (HOLogic.exists_const xtp $ Abs(x,xtp,tm)) xs;
    60 
    61 fun is_neg (Const("Trueprop",_) $ (Const("Not",_) $ Free(p,_))) (Const("Trueprop",_) $ Free(q,_)) = (p = q)
    62   | is_neg _ _ = false;
    63 
    64 
    65 exception STRIP_CONCL;
    66 
    67 
    68 fun strip_concl' prems bvs (Const ("==>",_) $ P $ Q) =
    69       let val P' = HOLogic.dest_Trueprop P
    70   	  val prems' = P'::prems
    71       in
    72 	strip_concl' prems' bvs  Q
    73       end
    74   | strip_concl' prems bvs P = 
    75       let val P' = HOLogic.Not $ (HOLogic.dest_Trueprop P)
    76       in
    77 	add_EX (make_conjs (P'::prems)) bvs
    78       end;
    79 
    80 
    81 fun strip_concl prems bvs concl (Const ("all", _) $ Abs (x,xtp,body)) = 
    82       strip_concl prems ((x,xtp)::bvs) concl body
    83   | strip_concl prems bvs concl (Const ("==>",_) $ P $ Q) =
    84       if (is_neg P concl) then (strip_concl' prems bvs Q)
    85       else strip_concl (HOLogic.dest_Trueprop P::prems) bvs  concl Q
    86   | strip_concl prems bvs concl _ = add_EX (make_conjs prems) bvs;
    87  
    88 
    89 fun trans_elim (main,others,concl) =
    90     let val others' = map (strip_concl [] [] concl) others
    91 	val disjs = make_disjs others'
    92     in
    93 	HOLogic.mk_imp (HOLogic.dest_Trueprop main, disjs)
    94     end;
    95 
    96 
    97 (* aux function of elim2Fol, take away predicate variable. *)
    98 fun elimR2Fol_aux prems concl = 
    99     let val nprems = length prems
   100 	val main = hd prems
   101     in
   102 	if (nprems = 1) then HOLogic.Not $ (HOLogic.dest_Trueprop main)
   103         else trans_elim (main, tl prems, concl)
   104     end;
   105 
   106     
   107 (* convert an elim rule into an equivalent formula, of type term. *)
   108 fun elimR2Fol elimR = 
   109     let val elimR' = Drule.freeze_all elimR
   110 	val (prems,concl) = (prems_of elimR', concl_of elimR')
   111     in
   112 	case concl of Const("Trueprop",_) $ Free(_,Type("bool",[])) 
   113 		      => HOLogic.mk_Trueprop (elimR2Fol_aux prems concl)
   114                     | Free(x,Type("prop",[])) => HOLogic.mk_Trueprop(elimR2Fol_aux prems concl) 
   115 		    | _ => raise ELIMR2FOL("Not an elimination rule!")
   116     end;
   117 
   118 
   119 (* check if a rule is an elim rule *)
   120 fun is_elimR th = 
   121     case (concl_of th) of (Const ("Trueprop", _) $ Var (idx,_)) => true
   122 			 | Var(indx,Type("prop",[])) => true
   123 			 | _ => false;
   124 
   125 (* convert an elim-rule into an equivalent theorem that does not have the 
   126    predicate variable.  Leave other theorems unchanged.*) 
   127 fun transform_elim th =
   128   if is_elimR th then
   129     let val tm = elimR2Fol th
   130 	val ctm = cterm_of (sign_of_thm th) tm	
   131     in Goal.prove_raw [] ctm (fn _ => elimRule_tac th) end
   132  else th;
   133 
   134 
   135 (**** Transformation of Clasets and Simpsets into First-Order Axioms ****)
   136 
   137 
   138 (*Transfer a theorem into theory Reconstruction.thy if it is not already
   139   inside that theory -- because it's needed for Skolemization *)
   140 
   141 (*This will refer to the final version of theory Reconstruction.*)
   142 val recon_thy_ref = Theory.self_ref (the_context ());  
   143 
   144 (*If called while Reconstruction is being created, it will transfer to the
   145   current version. If called afterward, it will transfer to the final version.*)
   146 fun transfer_to_Reconstruction th =
   147     transfer (Theory.deref recon_thy_ref) th handle THM _ => th;
   148 
   149 fun is_taut th =
   150       case (prop_of th) of
   151            (Const ("Trueprop", _) $ Const ("True", _)) => true
   152          | _ => false;
   153 
   154 (* remove tautologous clauses *)
   155 val rm_redundant_cls = List.filter (not o is_taut);
   156      
   157        
   158 (**** SKOLEMIZATION BY INFERENCE (lcp) ****)
   159 
   160 (*Traverse a theorem, declaring Skolem function definitions. String s is the suggested
   161   prefix for the Skolem constant. Result is a new theory*)
   162 fun declare_skofuns s th thy =
   163   let fun dec_sko (Const ("Ex",_) $ (xtp as Abs(_,T,p))) (n, (thy, axs)) =
   164 	    (*Existential: declare a Skolem function, then insert into body and continue*)
   165 	    let val cname = s ^ "_" ^ Int.toString n
   166 		val args = term_frees xtp  (*get the formal parameter list*)
   167 		val Ts = map type_of args
   168 		val cT = Ts ---> T
   169 		val c = Const (Sign.full_name thy cname, cT)
   170 		val rhs = list_abs_free (map dest_Free args, HOLogic.choice_const T $ xtp)
   171 		        (*Forms a lambda-abstraction over the formal parameters*)
   172 		val def = equals cT $ c $ rhs
   173 		val thy' = Theory.add_consts_i [(cname, cT, NoSyn)] thy
   174 		           (*Theory is augmented with the constant, then its def*)
   175 		val cdef = cname ^ "_def"
   176 		val thy'' = Theory.add_defs_i false [(cdef, def)] thy'
   177 	    in dec_sko (subst_bound (list_comb(c,args), p)) 
   178 	               (n+1, (thy'', get_axiom thy'' cdef :: axs)) 
   179 	    end
   180 	| dec_sko (Const ("All",_) $ (xtp as Abs(a,T,p))) (n, thx) =
   181 	    (*Universal quant: insert a free variable into body and continue*)
   182 	    let val fname = variant (add_term_names (p,[])) a
   183 	    in dec_sko (subst_bound (Free(fname,T), p)) (n, thx) end
   184 	| dec_sko (Const ("op &", _) $ p $ q) nthy = dec_sko q (dec_sko p nthy)
   185 	| dec_sko (Const ("op |", _) $ p $ q) nthy = dec_sko q (dec_sko p nthy)
   186 	| dec_sko (Const ("HOL.tag", _) $ p) nthy = dec_sko p nthy
   187 	| dec_sko (Const ("Trueprop", _) $ p) nthy = dec_sko p nthy
   188 	| dec_sko t nthx = nthx (*Do nothing otherwise*)
   189   in  #2 (dec_sko (#prop (rep_thm th)) (1, (thy,[])))  end;
   190 
   191 (*Traverse a theorem, accumulating Skolem function definitions.*)
   192 fun assume_skofuns th =
   193   let fun dec_sko (Const ("Ex",_) $ (xtp as Abs(_,T,p))) defs =
   194 	    (*Existential: declare a Skolem function, then insert into body and continue*)
   195 	    let val name = variant (add_term_names (p,[])) (gensym "sko_")
   196                 val skos = map (#1 o Logic.dest_equals) defs  (*existing sko fns*)
   197 		val args = term_frees xtp \\ skos  (*the formal parameters*)
   198 		val Ts = map type_of args
   199 		val cT = Ts ---> T
   200 		val c = Free (name, cT)
   201 		val rhs = list_abs_free (map dest_Free args,        
   202 		                         HOLogic.choice_const T $ xtp)
   203 		      (*Forms a lambda-abstraction over the formal parameters*)
   204 		val def = equals cT $ c $ rhs
   205 	    in dec_sko (subst_bound (list_comb(c,args), p)) 
   206 	               (def :: defs)
   207 	    end
   208 	| dec_sko (Const ("All",_) $ (xtp as Abs(a,T,p))) defs =
   209 	    (*Universal quant: insert a free variable into body and continue*)
   210 	    let val fname = variant (add_term_names (p,[])) a
   211 	    in dec_sko (subst_bound (Free(fname,T), p)) defs end
   212 	| dec_sko (Const ("op &", _) $ p $ q) defs = dec_sko q (dec_sko p defs)
   213 	| dec_sko (Const ("op |", _) $ p $ q) defs = dec_sko q (dec_sko p defs)
   214 	| dec_sko (Const ("HOL.tag", _) $ p) defs = dec_sko p defs
   215 	| dec_sko (Const ("Trueprop", _) $ p) defs = dec_sko p defs
   216 	| dec_sko t defs = defs (*Do nothing otherwise*)
   217   in  dec_sko (#prop (rep_thm th)) []  end;
   218 
   219 (*cterms are used throughout for efficiency*)
   220 val cTrueprop = Thm.cterm_of HOL.thy HOLogic.Trueprop;
   221 
   222 (*cterm version of mk_cTrueprop*)
   223 fun c_mkTrueprop A = Thm.capply cTrueprop A;
   224 
   225 (*Given an abstraction over n variables, replace the bound variables by free
   226   ones. Return the body, along with the list of free variables.*)
   227 fun c_variant_abs_multi (ct0, vars) = 
   228       let val (cv,ct) = Thm.dest_abs NONE ct0
   229       in  c_variant_abs_multi (ct, cv::vars)  end
   230       handle CTERM _ => (ct0, rev vars);
   231 
   232 (*Given the definition of a Skolem function, return a theorem to replace 
   233   an existential formula by a use of that function. 
   234    Example: "EX x. x : A & x ~: B ==> sko A B : A & sko A B ~: B"  [.] *)
   235 fun skolem_of_def def =  
   236   let val (c,rhs) = Drule.dest_equals (cprop_of (Drule.freeze_all def))
   237       val (ch, frees) = c_variant_abs_multi (rhs, [])
   238       val (chilbert,cabs) = Thm.dest_comb ch
   239       val {sign,t, ...} = rep_cterm chilbert
   240       val T = case t of Const ("Hilbert_Choice.Eps", Type("fun",[_,T])) => T
   241                       | _ => raise THM ("skolem_of_def: expected Eps", 0, [def])
   242       val cex = Thm.cterm_of sign (HOLogic.exists_const T)
   243       val ex_tm = c_mkTrueprop (Thm.capply cex cabs)
   244       and conc =  c_mkTrueprop (Drule.beta_conv cabs (Drule.list_comb(c,frees)));
   245       fun tacf [prem] = rewrite_goals_tac [def] THEN rtac (prem RS someI_ex) 1
   246   in  Goal.prove_raw [ex_tm] conc tacf 
   247        |> forall_intr_list frees
   248        |> forall_elim_vars 0  (*Introduce Vars, but don't discharge defs.*)
   249        |> Thm.varifyT
   250   end;
   251 
   252 (*Converts an Isabelle theorem (intro, elim or simp format) into nnf.*)
   253 (*It now works for HOL too. *)
   254 fun to_nnf th = 
   255     th |> transfer_to_Reconstruction
   256        |> transform_elim |> Drule.freeze_all
   257        |> ObjectLogic.atomize_thm |> make_nnf;
   258 
   259 (*The cache prevents repeated clausification of a theorem, 
   260   and also repeated declaration of Skolem functions*)  
   261   (* FIXME better use Termtab!? No, we MUST use theory data!!*)
   262 val clause_cache = ref (Symtab.empty : (thm * thm list) Symtab.table)
   263 
   264 
   265 (*Generate Skolem functions for a theorem supplied in nnf*)
   266 fun skolem_of_nnf th =
   267   map (skolem_of_def o assume o (cterm_of (theory_of_thm th))) (assume_skofuns th);
   268 
   269 (*Skolemize a named theorem, with Skolem functions as additional premises.*)
   270 (*also works for HOL*) 
   271 fun skolem_thm th = 
   272   let val nnfth = to_nnf th
   273   in  Meson.make_cnf (skolem_of_nnf nnfth) nnfth
   274   end
   275   handle THM _ => [];
   276 
   277 (*Declare Skolem functions for a theorem, supplied in nnf and with its name.
   278   It returns a modified theory, unless skolemization fails.*)
   279 fun skolem thy (name,th) =
   280   let val cname = (case name of "" => gensym "sko" | s => Sign.base_name s)
   281   in Option.map 
   282         (fn nnfth => 
   283           let val (thy',defs) = declare_skofuns cname nnfth thy
   284               val skoths = map skolem_of_def defs
   285           in (thy', Meson.make_cnf skoths nnfth) end)
   286       (SOME (to_nnf th)  handle THM _ => NONE) 
   287   end;
   288 
   289 (*Populate the clause cache using the supplied theorem. Return the clausal form
   290   and modified theory.*)
   291 fun skolem_cache_thm ((name,th), thy) = 
   292   case Symtab.lookup (!clause_cache) name of
   293       NONE => 
   294 	(case skolem thy (name, Thm.transfer thy th) of
   295 	     NONE => ([th],thy)
   296 	   | SOME (thy',cls) => 
   297 	       (change clause_cache (Symtab.update (name, (th, cls))); (cls,thy')))
   298     | SOME (th',cls) =>
   299         if eq_thm(th,th') then (cls,thy)
   300 	else (warning ("skolem_cache: Ignoring variant of theorem " ^ name); 
   301 	      warning (string_of_thm th);
   302 	      warning (string_of_thm th');
   303 	      ([th],thy));
   304 	      
   305 fun skolem_cache ((name,th), thy) = #2 (skolem_cache_thm ((name,th), thy));
   306 
   307 
   308 (*Exported function to convert Isabelle theorems into axiom clauses*) 
   309 fun cnf_axiom_g cnf (name,th) =
   310   case name of
   311 	"" => cnf th (*no name, so can't cache*)
   312       | s  => case Symtab.lookup (!clause_cache) s of
   313 		NONE => 
   314 		  let val cls = cnf th
   315 		  in change clause_cache (Symtab.update (s, (th, cls))); cls end
   316 	      | SOME(th',cls) =>
   317 		  if eq_thm(th,th') then cls
   318 		  else (warning ("cnf_axiom: duplicate or variant of theorem " ^ name); 
   319 		        warning (string_of_thm th);
   320 		        warning (string_of_thm th');
   321 		        cls);
   322 
   323 fun pairname th = (Thm.name_of_thm th, th);
   324 
   325 
   326 val cnf_axiom = cnf_axiom_g skolem_thm;
   327 
   328 
   329 fun meta_cnf_axiom th = 
   330     map Meson.make_meta_clause (cnf_axiom (pairname th));
   331 
   332 
   333 
   334 (**** Extract and Clausify theorems from a theory's claset and simpset ****)
   335 
   336 (*Preserve the name of "th" after the transformation "f"*)
   337 fun preserve_name f th = Thm.name_thm (Thm.name_of_thm th, f th);
   338 
   339 (*Tags identify the major premise or conclusion, as hints to resolution provers.
   340   However, they don't appear to help in recent tests, and they complicate the code.*)
   341 val tagI = thm "tagI";
   342 val tagD = thm "tagD";
   343 
   344 val tag_intro = preserve_name (fn th => th RS tagI);
   345 val tag_elim  = preserve_name (fn th => tagD RS th);
   346 
   347 fun rules_of_claset cs =
   348   let val {safeIs,safeEs,hazIs,hazEs,...} = rep_cs cs
   349       val intros = safeIs @ hazIs
   350       val elims  = map Classical.classical_rule (safeEs @ hazEs)
   351   in
   352      Output.debug ("rules_of_claset intros: " ^ Int.toString(length intros) ^ 
   353             " elims: " ^ Int.toString(length elims));
   354      if tagging_enabled 
   355      then map pairname (map tag_intro intros @ map tag_elim elims)
   356      else map pairname (intros @ elims)
   357   end;
   358 
   359 fun rules_of_simpset ss =
   360   let val ({rules,...}, _) = rep_ss ss
   361       val simps = Net.entries rules
   362   in 
   363       Output.debug ("rules_of_simpset: " ^ Int.toString(length simps));
   364       map (fn r => (#name r, #thm r)) simps
   365   end;
   366 
   367 fun claset_rules_of_thy thy = rules_of_claset (claset_of thy);
   368 fun simpset_rules_of_thy thy = rules_of_simpset (simpset_of thy);
   369 
   370 fun claset_rules_of_ctxt ctxt = rules_of_claset (local_claset_of ctxt);
   371 fun simpset_rules_of_ctxt ctxt = rules_of_simpset (local_simpset_of ctxt);
   372 
   373 
   374 (**** Translate a set of classical/simplifier rules into CNF (still as type "thm")  ****)
   375 
   376 (* classical rules *)
   377 fun cnf_rules_g cnf_axiom [] err_list = ([],err_list)
   378   | cnf_rules_g cnf_axiom ((name,th) :: ths) err_list = 
   379       let val (ts,es) = cnf_rules_g cnf_axiom ths err_list
   380       in  (cnf_axiom (name,th) :: ts,es) handle  _ => (ts, (th::es))  end;  
   381 
   382 
   383 (*works for both FOL and HOL*)
   384 val cnf_rules = cnf_rules_g cnf_axiom;
   385 
   386 fun cnf_rules1 [] err_list = ([],err_list)
   387   | cnf_rules1 ((name,th) :: ths) err_list =
   388     let val (ts,es) = cnf_rules1 ths err_list
   389     in
   390 	((name,cnf_axiom (name,th)) :: ts,es) handle _ => (ts,(name::es)) end;
   391 
   392 fun cnf_rules2 [] err_list = ([],err_list)
   393   | cnf_rules2 ((name,th) :: ths) err_list =
   394     let val (ts,es) = cnf_rules2 ths err_list
   395     in
   396 	((name,map prop_of (cnf_axiom (name,th))) :: ts,es) handle _ => (ts,(name::es)) end;
   397 
   398 (**** Convert all theorems of a claset/simpset into clauses (ResClause.clause, or ResHolClause.clause) ****)
   399 
   400 fun make_axiom_clauses _ _ [] = []
   401   | make_axiom_clauses name i (cls::clss) =
   402       (ResClause.make_axiom_clause (prop_of cls) (name,i), cls) ::
   403       (make_axiom_clauses name (i+1) clss)
   404 
   405 (* outputs a list of (clause,theorem) pairs *)
   406 fun clausify_axiom_pairs (name,th) = 
   407     filter (fn (c,th) => not (ResClause.isTaut c))
   408            (make_axiom_clauses name 0 (cnf_axiom (name,th)));
   409 
   410 fun make_axiom_clausesH _ _ [] = []
   411   | make_axiom_clausesH name i (cls::clss) =
   412       (ResHolClause.make_axiom_clause (prop_of cls) (name,i), cls) ::
   413       (make_axiom_clausesH name (i+1) clss)
   414 
   415 fun clausify_axiom_pairsH (name,th) = 
   416     filter (fn (c,th) => not (ResHolClause.isTaut c))
   417            (make_axiom_clausesH name 0 (cnf_axiom (name,th)));
   418 
   419 
   420 fun clausify_rules_pairs_aux result [] = result
   421   | clausify_rules_pairs_aux result ((name,th)::ths) =
   422       clausify_rules_pairs_aux (clausify_axiom_pairs (name,th) :: result) ths
   423       handle THM (msg,_,_) =>  
   424 	      (Output.debug ("Cannot clausify " ^ name ^ ": " ^ msg); 
   425 	       clausify_rules_pairs_aux result ths)
   426 	 |  ResClause.CLAUSE (msg,t) => 
   427 	      (Output.debug ("Cannot clausify " ^ name ^ ": " ^ msg ^
   428 		      ": " ^ TermLib.string_of_term t); 
   429 	       clausify_rules_pairs_aux result ths)
   430 
   431 
   432 fun clausify_rules_pairs_auxH result [] = result
   433   | clausify_rules_pairs_auxH result ((name,th)::ths) =
   434       clausify_rules_pairs_auxH (clausify_axiom_pairsH (name,th) :: result) ths
   435       handle THM (msg,_,_) =>  
   436 	      (Output.debug ("Cannot clausify " ^ name ^ ": " ^ msg); 
   437 	       clausify_rules_pairs_auxH result ths)
   438 	 |  ResHolClause.LAM2COMB (t) => 
   439 	      (Output.debug ("Cannot clausify "  ^ TermLib.string_of_term t); 
   440 	       clausify_rules_pairs_auxH result ths)
   441 
   442 
   443 
   444 val clausify_rules_pairs = clausify_rules_pairs_aux [];
   445 
   446 val clausify_rules_pairsH = clausify_rules_pairs_auxH [];
   447 
   448 (*These should include any plausibly-useful theorems, especially if they need
   449   Skolem functions. FIXME: this list is VERY INCOMPLETE*)
   450 val default_initial_thms = map pairname
   451   [refl_def, antisym_def, sym_def, trans_def, single_valued_def,
   452    subset_refl, Union_least, Inter_greatest];
   453 
   454 (*Setup function: takes a theory and installs ALL simprules and claset rules 
   455   into the clause cache*)
   456 fun clause_cache_setup thy =
   457   let val simps = simpset_rules_of_thy thy
   458       and clas  = claset_rules_of_thy thy
   459       and thy0  = List.foldl skolem_cache thy default_initial_thms
   460       val thy1  = List.foldl skolem_cache thy0 clas
   461   in List.foldl skolem_cache thy1 simps end;
   462 (*Could be duplicate theorem names, due to multiple attributes*)
   463   
   464 
   465 (*** meson proof methods ***)
   466 
   467 fun cnf_rules_of_ths ths = List.concat (#1 (cnf_rules (map pairname ths) []));
   468 
   469 fun meson_meth ths ctxt =
   470   Method.SIMPLE_METHOD' HEADGOAL
   471     (CHANGED_PROP o Meson.meson_claset_tac (cnf_rules_of_ths ths) (local_claset_of ctxt));
   472 
   473 val meson_method_setup =
   474   Method.add_methods
   475     [("meson", Method.thms_ctxt_args meson_meth, 
   476       "The MESON resolution proof procedure")];
   477 
   478 
   479 
   480 (*** The Skolemization attribute ***)
   481 
   482 fun conj2_rule (th1,th2) = conjI OF [th1,th2];
   483 
   484 (*Conjoin a list of clauses to recreate a single theorem*)
   485 val conj_rule = foldr1 conj2_rule;
   486 
   487 fun skolem_global_fun (thy, th) = 
   488   let val name = Thm.name_of_thm th
   489       val (cls,thy') = skolem_cache_thm ((name,th), thy)
   490   in  (thy', conj_rule cls)  end;
   491 
   492 val skolem_global = Attrib.no_args skolem_global_fun;
   493 
   494 fun skolem_local x = Attrib.no_args (Attrib.rule (K (conj_rule o skolem_thm))) x;
   495 
   496 val setup_attrs = Attrib.add_attributes
   497  [("skolem", (skolem_global, skolem_local),
   498     "skolemization of a theorem")];
   499 
   500 val setup = clause_cache_setup #> setup_attrs;
   501 
   502 end;