Added more functions to the signature and tidied up some functions.
authormengj
Thu, 09 Mar 2006 06:05:01 +0100
changeset 19227 d15f2baa7ecc
parent 19226 20c113d17e01
child 19228 30fce6da8cbe
Added more functions to the signature and tidied up some functions.
src/HOL/Tools/res_atp.ML
--- a/src/HOL/Tools/res_atp.ML	Wed Mar 08 21:40:46 2006 +0100
+++ b/src/HOL/Tools/res_atp.ML	Thu Mar 09 06:05:01 2006 +0100
@@ -34,6 +34,14 @@
   val hol_typ_level: unit -> ResHolClause.type_level
   val run_relevance_filter: bool ref
   val invoke_atp_ml : ProofContext.context * thm -> unit
+  val add_claset : unit -> unit
+  val add_simpset : unit -> unit
+  val add_clasimp : unit -> unit
+  val add_atpset : unit -> unit
+  val rm_claset : unit -> unit
+  val rm_simpset : unit -> unit
+  val rm_atpset : unit -> unit
+  val rm_clasimp : unit -> unit
 end;
 
 structure ResAtp : RES_ATP =
@@ -117,11 +125,11 @@
 val include_atpset = ref true;
 val add_simpset = (fn () => include_simpset:=true);
 val add_claset = (fn () => include_claset:=true);
-val add_clasimp = (fn () => include_simpset:=true;include_claset:=true);
+val add_clasimp = (fn () => (include_simpset:=true;include_claset:=true));
 val add_atpset = (fn () => include_atpset:=true);
 val rm_simpset = (fn () => include_simpset:=false);
 val rm_claset = (fn () => include_claset:=false);
-val rm_clasimp = (fn () => include_simpset:=false;include_claset:=false);
+val rm_clasimp = (fn () => (include_simpset:=false;include_claset:=false));
 val rm_atpset = (fn () => include_atpset:=false);
 
 (*** paths for HOL helper files ***)
@@ -268,39 +276,41 @@
     let val (pred,args) = strip_comb P
 	val (lg',seen') = if pred mem seen then (lg,seen) 
 			  else pred_lg pred (lg,seen)
+	val _ = if is_fol_logic lg' then () else warning ("Found a HOL predicate: " ^ (Term.str_of_term pred))
     in
 	term_lg args (lg',seen')
     end;
 
 fun lits_lg [] (lg,seen) = (lg,seen)
   | lits_lg (lit::lits) (FOL,seen) =
-    lits_lg lits (lit_lg lit (FOL,seen))
+    let val (lg,seen') = lit_lg lit (FOL,seen)
+	val _ =  if is_fol_logic lg then () else warning ("Found a HOL literal: " ^ (Term.str_of_term lit))
+    in
+	lits_lg lits (lg,seen')
+    end
   | lits_lg lits (lg,seen) = (lg,seen);
 
 
+fun dest_disj_aux (Const ("op |", _) $ t $ t') disjs = 
+    dest_disj_aux t (dest_disj_aux t' disjs)
+  | dest_disj_aux t disjs = t::disjs;
+
+fun dest_disj t = dest_disj_aux t [];
+
 fun logic_of_clause tm (lg,seen) =
     let val tm' = HOLogic.dest_Trueprop tm
-	val disjs = HOLogic.dest_disj tm'
-    in
-	lits_lg disjs (lg,seen)
-    end;
-
-fun lits_lg [] (lg,seen) = (lg,seen)
-  | lits_lg (lit::lits) (FOL,seen) =
-    lits_lg lits (lit_lg lit (FOL,seen))
-  | lits_lg lits (lg,seen) = (lg,seen);
-
-
-fun logic_of_clause tm (lg,seen) =
-    let val tm' = HOLogic.dest_Trueprop tm
-	val disjs = HOLogic.dest_disj tm'
+	val disjs = dest_disj tm'
     in
 	lits_lg disjs (lg,seen)
     end;
 
 fun logic_of_clauses [] (lg,seen) = (lg,seen)
   | logic_of_clauses (cls::clss) (FOL,seen) =
-    logic_of_clauses clss (logic_of_clause cls (FOL,seen))
+    let val (lg,seen') = logic_of_clause cls (FOL,seen)
+	val _ = if is_fol_logic lg then () else warning ("Found a HOL clause: " ^ (Term.str_of_term cls))
+    in
+	logic_of_clauses clss (lg,seen')
+    end
   | logic_of_clauses (cls::clss) (lg,seen) = (lg,seen);
 
 fun logic_of_nclauses [] (lg,seen) = (lg,seen)