fail for problems containg the universal sort (as those problems cannot be atomized)
authorboehmes
Wed, 07 Apr 2010 20:38:11 +0200
changeset 36082 8f10b0e77d94
parent 36081 70deefb6c093
child 36083 59f843c3f17f
fail for problems containg the universal sort (as those problems cannot be atomized)
src/HOL/SMT/Examples/SMT_Examples.thy
src/HOL/SMT/Tools/smt_solver.ML
--- a/src/HOL/SMT/Examples/SMT_Examples.thy	Wed Apr 07 19:48:58 2010 +0200
+++ b/src/HOL/SMT/Examples/SMT_Examples.thy	Wed Apr 07 20:38:11 2010 +0200
@@ -539,7 +539,8 @@
 
 lemma "i \<noteq> i1 \<and> i \<noteq> i2 \<Longrightarrow> (f (i1 := v1, i2 := v2)) i = f i" by smt
 
-lemma "(f g x = (g x \<and> True)) \<or> (f g x = True) \<or> (g x = True)" by smt
+lemma "(f g (x::'a::type) = (g x \<and> True)) \<or> (f g x = True) \<or> (g x = True)"
+  by smt
 
 lemma "id 3 = 3 \<and> id True = True" by (smt id_def)
 
--- a/src/HOL/SMT/Tools/smt_solver.ML	Wed Apr 07 19:48:58 2010 +0200
+++ b/src/HOL/SMT/Tools/smt_solver.ML	Wed Apr 07 20:38:11 2010 +0200
@@ -262,11 +262,22 @@
            | SMT_COUNTEREXAMPLE ce => fail_tac tracing (pretty_cex ctxt ce) st)
 
   fun smt_solver rules ctxt = solver_of (Context.Proof ctxt) ctxt rules
+
+  val has_topsort = Term.exists_type (Term.exists_subtype (fn
+      TFree (_, []) => true
+    | TVar (_, []) => true
+    | _ => false))
 in
 fun smt_tac' pass_exns ctxt rules =
   Tactic.rtac @{thm ccontr} THEN'
   SUBPROOF (fn {context, prems, ...} =>
-    SAFE pass_exns (Tactic.rtac o smt_solver (rules @ prems)) context 1) ctxt
+    let val thms = rules @ prems
+    in
+      if exists (has_topsort o Thm.prop_of) thms
+      then fail_tac (trace_msg context I)
+        "SMT: proof state contains the universal sort {}"
+      else SAFE pass_exns (Tactic.rtac o smt_solver thms) context 1
+    end) ctxt
 
 val smt_tac = smt_tac' false
 end