introduced SMT.distinct as a representation of the solvers' built-in predicate; check that SMT.distinct is always applied to an explicit list
authorboehmes
Fri, 29 Oct 2010 18:17:04 +0200
changeset 405206486c610a549
parent 40519 364aa76f7e21
child 40521 eed48b11abdb
introduced SMT.distinct as a representation of the solvers' built-in predicate; check that SMT.distinct is always applied to an explicit list
src/HOL/Boogie/Tools/boogie_loader.ML
src/HOL/SMT.thy
src/HOL/SMT_Examples/SMT_Examples.thy
src/HOL/SMT_Examples/SMT_Tests.thy
src/HOL/Tools/SMT/smt_normalize.ML
src/HOL/Tools/SMT/smt_translate.ML
src/HOL/Tools/SMT/smtlib_interface.ML
src/HOL/Tools/SMT/z3_interface.ML
src/HOL/Tools/SMT/z3_proof_reconstruction.ML
src/HOL/Tools/SMT/z3_proof_tools.ML
     1.1 --- a/src/HOL/Boogie/Tools/boogie_loader.ML	Fri Oct 29 17:38:57 2010 +0200
     1.2 +++ b/src/HOL/Boogie/Tools/boogie_loader.ML	Fri Oct 29 18:17:04 2010 +0200
     1.3 @@ -191,7 +191,7 @@
     1.4              | NONE => NONE)
     1.5          | is_unique _ = NONE
     1.6        fun mk_unique_axiom T ts =
     1.7 -        Const (@{const_name distinct}, HOLogic.listT T --> @{typ bool}) $
     1.8 +        Const (@{const_name SMT.distinct}, HOLogic.listT T --> @{typ bool}) $
     1.9            HOLogic.mk_list T ts
    1.10      in
    1.11        map_filter is_unique fns
    1.12 @@ -383,7 +383,7 @@
    1.13    fun mk_list T = HOLogic.mk_list T
    1.14  
    1.15    fun mk_distinct T ts =
    1.16 -    Const (@{const_name distinct}, HOLogic.listT T --> @{typ bool}) $
    1.17 +    Const (@{const_name SMT.distinct}, HOLogic.listT T --> @{typ bool}) $
    1.18        mk_list T ts
    1.19  
    1.20    fun quant name f = scan_line name (num -- num -- num) >> pair f
     2.1 --- a/src/HOL/SMT.thy	Fri Oct 29 17:38:57 2010 +0200
     2.2 +++ b/src/HOL/SMT.thy	Fri Oct 29 18:17:04 2010 +0200
     2.3 @@ -49,6 +49,20 @@
     2.4  
     2.5  
     2.6  
     2.7 +subsection {* Distinctness *}
     2.8 +
     2.9 +text {*
    2.10 +As an abbreviation for a quadratic number of inequalities, SMT solvers
    2.11 +provide a built-in @{text distinct}.  To avoid confusion with the
    2.12 +already defined (and more general) @{term List.distinct}, a separate
    2.13 +constant is defined.
    2.14 +*}
    2.15 +
    2.16 +definition distinct :: "'a list \<Rightarrow> bool"
    2.17 +where "distinct xs = List.distinct xs"
    2.18 +
    2.19 +
    2.20 +
    2.21  subsection {* Higher-order encoding *}
    2.22  
    2.23  text {*
    2.24 @@ -314,7 +328,7 @@
    2.25  
    2.26  hide_type (open) pattern
    2.27  hide_const Pattern term_eq
    2.28 -hide_const (open) trigger pat nopat fun_app z3div z3mod
    2.29 +hide_const (open) trigger pat nopat distinct fun_app z3div z3mod
    2.30  
    2.31  
    2.32  
     3.1 --- a/src/HOL/SMT_Examples/SMT_Examples.thy	Fri Oct 29 17:38:57 2010 +0200
     3.2 +++ b/src/HOL/SMT_Examples/SMT_Examples.thy	Fri Oct 29 18:17:04 2010 +0200
     3.3 @@ -293,11 +293,11 @@
     3.4  
     3.5  lemma "(0 \<le> y + -1 * x \<or> \<not> 0 \<le> x \<or> 0 \<le> (x::int)) = (\<not> False)" by smt
     3.6  
     3.7 -lemma "distinct [x < (3::int), 3 \<le> x]" by smt
     3.8 +lemma "SMT.distinct [x < (3::int), 3 \<le> x]" by smt
     3.9  
    3.10  lemma
    3.11    assumes "a > (0::int)"
    3.12 -  shows "distinct [a, a * 2, a - a]"
    3.13 +  shows "SMT.distinct [a, a * 2, a - a]"
    3.14    using assms by smt
    3.15  
    3.16  lemma "
    3.17 @@ -430,7 +430,7 @@
    3.18     False \<or> P = (x - 1 = y) \<or> (\<not>P \<longrightarrow> False)"
    3.19    by smt
    3.20  
    3.21 -lemma "distinct [a + (1::nat), a * 2 + 3, a - a]" by smt
    3.22 +lemma "SMT.distinct [a + (1::nat), a * 2 + 3, a - a]" by smt
    3.23  
    3.24  lemma "int (nat \<bar>x::int\<bar>) = \<bar>x\<bar>" by smt
    3.25  
     4.1 --- a/src/HOL/SMT_Examples/SMT_Tests.thy	Fri Oct 29 17:38:57 2010 +0200
     4.2 +++ b/src/HOL/SMT_Examples/SMT_Tests.thy	Fri Oct 29 18:17:04 2010 +0200
     4.3 @@ -104,15 +104,15 @@
     4.4    by smt+
     4.5  
     4.6  lemma
     4.7 -  "distinct []"
     4.8 -  "distinct [a]"
     4.9 -  "distinct [a, b, c] \<longrightarrow> a \<noteq> c"
    4.10 -  "distinct [a, b, c] \<longrightarrow> d = b \<longrightarrow> a \<noteq> d"
    4.11 -  "\<not> distinct [a, b, a, b]"
    4.12 -  "a = b \<longrightarrow> \<not>distinct [a, b]"
    4.13 -  "a = b \<and> a = c \<longrightarrow> \<not>distinct [a, b, c]"
    4.14 -  "distinct [a, b, c, d] \<longrightarrow> distinct [d, b, c, a]"
    4.15 -  "distinct [a, b, c, d] \<longrightarrow> distinct [a, b, c] \<and> distinct [b, c, d]"
    4.16 +  "SMT.distinct []"
    4.17 +  "SMT.distinct [a]"
    4.18 +  "SMT.distinct [a, b, c] \<longrightarrow> a \<noteq> c"
    4.19 +  "SMT.distinct [a, b, c] \<longrightarrow> d = b \<longrightarrow> a \<noteq> d"
    4.20 +  "\<not> SMT.distinct [a, b, a, b]"
    4.21 +  "a = b \<longrightarrow> \<not> SMT.distinct [a, b]"
    4.22 +  "a = b \<and> a = c \<longrightarrow> \<not> SMT.distinct [a, b, c]"
    4.23 +  "SMT.distinct [a, b, c, d] \<longrightarrow> SMT.distinct [d, b, c, a]"
    4.24 +  "SMT.distinct [a, b, c, d] \<longrightarrow> SMT.distinct [a, b, c] \<and> SMT.distinct [b, c, d]"
    4.25    by smt+
    4.26  
    4.27  lemma
    4.28 @@ -193,7 +193,7 @@
    4.29    by smt+
    4.30  
    4.31  lemma
    4.32 -  "distinct [a, b, c] \<and> (\<forall>x y. f x = f y \<longrightarrow> y = x) \<longrightarrow> f a \<noteq> f b"
    4.33 +  "SMT.distinct [a, b, c] \<and> (\<forall>x y. f x = f y \<longrightarrow> y = x) \<longrightarrow> f a \<noteq> f b"
    4.34    sorry  (* FIXME: injective function *)
    4.35  
    4.36  lemma
    4.37 @@ -636,7 +636,7 @@
    4.38    "i1 \<noteq> i2 \<longrightarrow> (f (i1 := v1, i2 := v2)) i2 = v2"
    4.39    "i1 = i2 \<longrightarrow> (f (i1 := v1, i2 := v2)) i1 = v2"
    4.40    "i1 = i2 \<longrightarrow> (f (i1 := v1, i2 := v2)) i1 = v2"
    4.41 -  "distinct [i1, i2, i3] \<longrightarrow> (f (i1 := v1, i2 := v2)) i3 = f i3"
    4.42 +  "SMT.distinct [i1, i2, i3] \<longrightarrow> (f (i1 := v1, i2 := v2)) i3 = f i3"
    4.43    by smt+
    4.44  
    4.45  
     5.1 --- a/src/HOL/Tools/SMT/smt_normalize.ML	Fri Oct 29 17:38:57 2010 +0200
     5.2 +++ b/src/HOL/Tools/SMT/smt_normalize.ML	Fri Oct 29 18:17:04 2010 +0200
     5.3 @@ -40,15 +40,18 @@
     5.4     three elements in the argument list) *)
     5.5  
     5.6  local
     5.7 -  fun is_trivial_distinct (Const (@{const_name distinct}, _) $ t) =
     5.8 -        length (HOLogic.dest_list t) <= 2
     5.9 +  fun is_trivial_distinct (Const (@{const_name SMT.distinct}, _) $ t) =
    5.10 +       (length (HOLogic.dest_list t) <= 2
    5.11 +        handle TERM _ => error ("SMT: constant " ^
    5.12 +          quote @{const_name SMT.distinct} ^ " must be applied to " ^
    5.13 +          "an explicit list."))
    5.14      | is_trivial_distinct _ = false
    5.15  
    5.16    val thms = map mk_meta_eq @{lemma
    5.17 -    "distinct [] = True"
    5.18 -    "distinct [x] = True"
    5.19 -    "distinct [x, y] = (x ~= y)"
    5.20 -    by simp_all}
    5.21 +    "SMT.distinct [] = True"
    5.22 +    "SMT.distinct [x] = True"
    5.23 +    "SMT.distinct [x, y] = (x ~= y)"
    5.24 +    by (simp_all add: distinct_def)}
    5.25    fun distinct_conv _ =
    5.26      if_true_conv is_trivial_distinct (Conv.rewrs_conv thms)
    5.27  in
     6.1 --- a/src/HOL/Tools/SMT/smt_translate.ML	Fri Oct 29 17:38:57 2010 +0200
     6.2 +++ b/src/HOL/Tools/SMT/smt_translate.ML	Fri Oct 29 18:17:04 2010 +0200
     6.3 @@ -233,7 +233,7 @@
     6.4          (q as Const (qn, _), [Abs (n, T, t')]) =>
     6.5            if is_some (quantifier qn) then q $ Abs (n, T, in_trig t')
     6.6            else as_term (in_term t)
     6.7 -      | (Const (c as (@{const_name distinct}, T)), [t']) =>
     6.8 +      | (Const (c as (@{const_name SMT.distinct}, T)), [t']) =>
     6.9            if is_builtin_distinct then Const (pred c) $ in_list T in_term t'
    6.10            else as_term (in_term t)
    6.11        | (Const c, ts) =>
    6.12 @@ -377,7 +377,7 @@
    6.13        | (Const (@{const_name Let}, _), [t1, Abs (_, T, t2)]) =>
    6.14            transT T ##>> trans t1 ##>> trans t2 #>>
    6.15            (fn ((U, u1), u2) => SLet (U, u1, u2))
    6.16 -      | (h as Const (c as (@{const_name distinct}, T)), [t1]) =>
    6.17 +      | (h as Const (c as (@{const_name SMT.distinct}, T)), [t1]) =>
    6.18            (case builtin_fun ctxt c (HOLogic.dest_list t1) of
    6.19              SOME (n, ts) => fold_map trans ts #>> app n
    6.20            | NONE => transs h T [t1])
     7.1 --- a/src/HOL/Tools/SMT/smtlib_interface.ML	Fri Oct 29 17:38:57 2010 +0200
     7.2 +++ b/src/HOL/Tools/SMT/smtlib_interface.ML	Fri Oct 29 18:17:04 2010 +0200
     7.3 @@ -167,7 +167,7 @@
     7.4    | conn @{const_name If} = SOME "if_then_else"
     7.5    | conn _ = NONE
     7.6  
     7.7 -fun pred @{const_name distinct} _ = SOME "distinct"
     7.8 +fun pred @{const_name SMT.distinct} _ = SOME "distinct"
     7.9    | pred @{const_name HOL.eq} _ = SOME "="
    7.10    | pred @{const_name term_eq} _ = SOME "="
    7.11    | pred @{const_name less} T = if_int_type T "<"
     8.1 --- a/src/HOL/Tools/SMT/z3_interface.ML	Fri Oct 29 17:38:57 2010 +0200
     8.2 +++ b/src/HOL/Tools/SMT/z3_interface.ML	Fri Oct 29 18:17:04 2010 +0200
     8.3 @@ -65,7 +65,7 @@
     8.4  (** interface **)
     8.5  
     8.6  local
     8.7 -  val {extra_norm, translate} = SMTLIB_Interface.interface
     8.8 +  val {translate, ...} = SMTLIB_Interface.interface
     8.9    val {prefixes, strict, header, builtins, serialize} = translate
    8.10    val {is_builtin_pred, ...}= the strict
    8.11    val {builtin_typ, builtin_num, builtin_fun, ...} = builtins
    8.12 @@ -189,7 +189,7 @@
    8.13  fun mk_list cT cts =
    8.14    fold_rev (Thm.mk_binop (instT cT cons_term)) cts (instT cT nil_term)
    8.15  
    8.16 -val distinct = mk_inst_pair (destT1 o destT1) @{cpat distinct}
    8.17 +val distinct = mk_inst_pair (destT1 o destT1) @{cpat SMT.distinct}
    8.18  fun mk_distinct [] = mk_true
    8.19    | mk_distinct (cts as (ct :: _)) =
    8.20        Thm.capply (instT' ct distinct) (mk_list (Thm.ctyp_of_term ct) cts)
     9.1 --- a/src/HOL/Tools/SMT/z3_proof_reconstruction.ML	Fri Oct 29 17:38:57 2010 +0200
     9.2 +++ b/src/HOL/Tools/SMT/z3_proof_reconstruction.ML	Fri Oct 29 18:17:04 2010 +0200
     9.3 @@ -303,14 +303,14 @@
     9.4            prove disjI3 (Thm.capply @{cterm Not} ct2, false) (ct1, false)
     9.5        | @{term HOL.disj} $ _ $ _ =>
     9.6            prove disjI2 (Thm.capply @{cterm Not} ct1, false) (ct2, true)
     9.7 -      | Const (@{const_name distinct}, _) $ _ =>
     9.8 +      | Const (@{const_name SMT.distinct}, _) $ _ =>
     9.9            let
    9.10              fun dis_conv cv = Conv.arg_conv (Conv.arg1_conv cv)
    9.11              fun prv cu =
    9.12                let val (cu1, cu2) = Thm.dest_binop (Thm.dest_arg cu)
    9.13                in prove disjI4 (Thm.dest_arg cu2, true) (cu1, true) end
    9.14            in T.with_conv (dis_conv T.unfold_distinct_conv) prv ct end
    9.15 -      | @{term Not} $ (Const (@{const_name distinct}, _) $ _) =>
    9.16 +      | @{term Not} $ (Const (@{const_name SMT.distinct}, _) $ _) =>
    9.17            let
    9.18              fun dis_conv cv = Conv.arg_conv (Conv.arg1_conv (Conv.arg_conv cv))
    9.19              fun prv cu =
    9.20 @@ -476,7 +476,7 @@
    9.21      (case Term.head_of (Thm.term_of cl) of
    9.22        @{term HOL.conj} => prove_nary L.is_conj (prove_eq_exn f)
    9.23      | @{term HOL.disj} => prove_nary L.is_disj (prove_eq_exn f)
    9.24 -    | Const (@{const_name distinct}, _) => prove_distinct (prove_eq_safe f)
    9.25 +    | Const (@{const_name SMT.distinct}, _) => prove_distinct (prove_eq_safe f)
    9.26      | _ => prove (prove_eq_safe f)) cp
    9.27  in
    9.28  fun monotonicity eqs ct =
    10.1 --- a/src/HOL/Tools/SMT/z3_proof_tools.ML	Fri Oct 29 17:38:57 2010 +0200
    10.2 +++ b/src/HOL/Tools/SMT/z3_proof_tools.ML	Fri Oct 29 18:17:04 2010 +0200
    10.3 @@ -204,7 +204,7 @@
    10.4        | @{term HOL.disj} $ _ $ _ => abstr2 cvs ct
    10.5        | @{term HOL.implies} $ _ $ _ => abstr2 cvs ct
    10.6        | Const (@{const_name HOL.eq}, _) $ _ $ _ => abstr2 cvs ct
    10.7 -      | Const (@{const_name distinct}, _) $ _ =>
    10.8 +      | Const (@{const_name SMT.distinct}, _) $ _ =>
    10.9            if ext_logic then abs_arg (abs_list abstr fresh_abstraction) cvs ct
   10.10            else fresh_abstraction cvs ct
   10.11        | Const (@{const_name If}, _) $ _ $ _ $ _ =>
   10.12 @@ -263,10 +263,10 @@
   10.13      (Conv.rewrs_conv [set1, set2, set3, set4] else_conv
   10.14      (Conv.rewr_conv set5 then_conv Conv.arg_conv set_conv)) ct
   10.15  
   10.16 -  val dist1 = @{lemma "distinct [] == ~False" by simp}
   10.17 -  val dist2 = @{lemma "distinct [x] == ~False" by simp}
   10.18 -  val dist3 = @{lemma "distinct (x # xs) == x ~: set xs & distinct xs"
   10.19 -    by simp}
   10.20 +  val dist1 = @{lemma "SMT.distinct [] == ~False" by (simp add: distinct_def)}
   10.21 +  val dist2 = @{lemma "SMT.distinct [x] == ~False" by (simp add: distinct_def)}
   10.22 +  val dist3 = @{lemma "SMT.distinct (x # xs) == x ~: set xs & distinct xs"
   10.23 +    by (simp add: distinct_def)}
   10.24  
   10.25    fun binop_conv cv1 cv2 = Conv.combination_conv (Conv.arg_conv cv1) cv2
   10.26  in