merged
authorboehmes
Mon, 15 Nov 2010 18:04:04 +0100
changeset 40552 4d48ec261d01
parent 40551 a0dd429e97d9 (diff)
parent 40549 63a3c8539d41 (current diff)
child 40553 1264c9172338
merged
--- a/src/HOL/Tools/SMT/smt_solver.ML	Mon Nov 15 17:04:53 2010 +0100
+++ b/src/HOL/Tools/SMT/smt_solver.ML	Mon Nov 15 18:04:04 2010 +0100
@@ -106,11 +106,6 @@
   map File.shell_quote (solver @ args) @
   [File.shell_path problem_path, "2>&1", ">", File.shell_path proof_path])
 
-fun check_return_code {output, redirected_output, return_code} =
-  if return_code <> 0 then
-    raise SMT_Failure.SMT (SMT_Failure.Solver_Crashed return_code)
-  else (redirected_output, output)
-
 fun run ctxt cmd args input =
   (case C.certificates_of ctxt of
     NONE => Cache_IO.run (make_cmd (choose cmd) args) input
@@ -124,7 +119,7 @@
       | (SOME output, _) =>
          (tracing ("Using cached certificate from " ^
             File.shell_path (Cache_IO.cache_path_of certs) ^ " ...");
-          output))) |> check_return_code
+          output)))
 
 in
 
@@ -135,11 +130,15 @@
 
     val _ = C.trace_msg ctxt (pretty "Problem:" o split_lines) input
 
-    val (res, err) = C.with_timeout ctxt (run ctxt cmd args) input
+    val {redirected_output=res, output=err, return_code} =
+      C.with_timeout ctxt (run ctxt cmd args) input
     val _ = C.trace_msg ctxt (pretty "Solver:") err
 
     val ls = rev (snd (chop_while (equal "") (rev res)))
     val _ = C.trace_msg ctxt (pretty "Result:") ls
+
+    val _ = null ls andalso return_code <> 0 andalso
+      raise SMT_Failure.SMT (SMT_Failure.Solver_Crashed return_code)
   in ls end
 
 end
--- a/src/HOL/Tools/SMT/z3_model.ML	Mon Nov 15 17:04:53 2010 +0100
+++ b/src/HOL/Tools/SMT/z3_model.ML	Mon Nov 15 18:04:04 2010 +0100
@@ -114,18 +114,30 @@
   let
     fun match ts ((n, _), _) = matches terms (member (op aconv) ts) n
 
-    val ints =
-      find_first (match [@{term int}]) vs
-      |> Option.map (fn (_, cases) =>
-           let val (cs, (_, e)) = split_last cases
-           in (e, map (apfst hd) cs) end)
-    fun nat_of (v as Value _) = 
-          (case ints of
-            NONE => v
-          | SOME (e, tab) => the_default e (AList.lookup (op =) tab v))
-      | nat_of e = e
+    val (default_int, ints) =
+      (case find_first (match [@{term int}]) vs of
+        NONE => (NONE, [])
+      | SOME (_, cases) =>
+          let val (cs, (_, e)) = split_last cases
+          in (SOME e, map (apfst hd) cs) end)
+
+    fun nat_of @{typ nat} (v as Value _) =
+          AList.lookup (op =) ints v |> the_default (the_default v default_int)
+      | nat_of _ e = e
+
+    fun subst_nat T k ([], e) =
+          let fun app f i = if i <= 0 then I else app f (i-1) o f
+          in ([], nat_of (app Term.range_type k T) e) end
+      | subst_nat T k (arg :: args, e) =
+          subst_nat (Term.range_type T) (k-1) (args, e)
+          |> apfst (cons (nat_of (Term.domain_type T) arg))
+
+    fun subst_nats (v as ((n, k), cases)) =
+      (case Symtab.lookup terms n of
+        NONE => v
+      | SOME t => ((n, k), map (subst_nat (Term.fastype_of t) k) cases))
   in
-    map (subst nat_of) vs
+    map subst_nats vs
     |> filter_out (match [@{term int}, @{term nat}])
   end