How to replace existentially quantified variable? - isabelle

Here is a simple type system:
datatype type =
VoidType
| IntegerType
| RealType
| StringType
datatype val =
VoidVal
| IntegerVal int
| RealVal real
| StringVal string
fun type_of :: "val ⇒ type" where
"type_of (VoidVal) = VoidType"
| "type_of (IntegerVal _) = IntegerType"
| "type_of (RealVal _) = RealType"
| "type_of (StringVal _) = StringType"
with type conformance relation:
inductive less_type :: "type ⇒ type ⇒ bool" (infix "<" 65) where
"IntegerType < RealType"
Integer values can be casted to corresponding real values:
inductive cast :: "val ⇒ val ⇒ bool" where
"cast (IntegerVal x) (RealVal x)"
I'm trying to prove the following lemma. If type of a variable x conforms to RealType, then there exists a value y with type RealType and x can be casted to y.
lemma is_castable_to_real:
"type_of x < RealType ⟹ ∃y. type_of y = RealType ∧ cast x y"
apply (rule exI[of _ "RealVal v"])
I can prove the generic lemma using cases tactics:
lemma is_castable:
"type_of x < τ ⟹ ∃y. type_of y = τ ∧ cast x y"
by (cases x; cases τ; auto simp add: less_type.simps cast.simps)
But I'm trying to understand how to treat existential quantifiers in lemmas. So I'm trying to provide a concrete example RealVal v for y:
type_of x < RealType ⟹ ∃v. type_of (RealVal v) = RealType ∧ cast x (RealVal v)
The problem is that I get the following proposition instead:
type_of x < RealType ⟹ type_of (RealVal v) = RealType ∧ cast x (RealVal v)
What is the kind of variable v? Is it universally quantified variable? How to make it existentially quantified one?

To prove an existential, you can give a concrete example.
In your case, this example can be derived from the assumption of the lemma.
lemma is_castable_to_real:
assumes subtype_of_real: "type_of x < RealType"
shows "∃y. type_of y = RealType ∧ cast x y"
proof -
have "type_of x = IntegerType"
using subtype_of_real less_type.cases by blast
from this obtain i where x_def: "x = IntegerVal i"
by (cases x, auto)
(* prove it for concrete example (RealVal i) *)
have "type_of (RealVal i) = RealType ∧ cast x (RealVal i)"
by (auto simp add: x_def cast.intros)
(* From the concrete example, the existential statement follows: *)
thus "∃y. type_of y = RealType ∧ cast x y" ..
qed
If you just use v before obtaining or defining it somehow, the value will be similar to undefined. It has the correct type, but you do not know anything about it.
If you start the proof without the dash (-) Isabelle will use the default tactic and you would get the subgoal type_of ?y = RealType ∧ cast x ?y. Here ?y is a schematic variable and you can later provide any value that was already available before starting the proof. Maybe this is the kind of variable you get for v, but it is still not clear how you got to the last line in your question.

Related

Isabelle Failed to refine any pending goal during instantiation

datatype 'a list = Cons 'a "'a list" | Nil
instantiation list :: (order) order
begin
fun less_eq_list :: "'a list ⇒ 'a list ⇒ bool" where
"less_eq_list Nil Nil = True" |
"less_eq_list (Cons _ _) Nil = True" |
"less_eq_list Nil (Cons _ _) = False" |
"less_eq_list (Cons _ a) (Cons _ b) = less_eq_list a b"
instance
proof
fix x y:: "'a list"
show "x ≤ x"
apply(induct_tac x)
apply(auto)
done
(* at this point the state is
show x ≤ x
Successful attempt to solve goal by exported rule:
?x2 ≤ ?x2
proof (state)
this:
x ≤ x
goal (3 subgoals):
1. ⋀x y. (x < y) = (x ≤ y ∧ ¬ y ≤ x)
2. ⋀x y z. x ≤ y ⟹ y ≤ z ⟹ x ≤ z
3. ⋀x y. x ≤ y ⟹ y ≤ x ⟹ x = y
*)
show "(x < y) = (x ≤ y ∧ ¬ y ≤ x)"
(* I get an error here
Failed to refine any pending goal
Local statement fails to refine any pending goal
Failed attempt to solve goal by exported rule:
(?x2 < ?y2) = (?x2 ≤ ?y2 ∧ ¬ ?y2 ≤ ?x2)
*)
qed
end
What is wrong with this? The proof of "x ≤ x" worked like a charm. Somehow "(x < y) = (x ≤ y ∧ ¬ y ≤ x)" doesn't match any subgoal.
Class order is a subclass of preorder, which in turn is a subclass of ord. Class ord requires you to define both less_eq (≤) and less (<). In your code, you have correctly defined less_eq_list but forgot to define less_list, and that's why you got an error when trying to prove (x < y) = (x ≤ y ∧ ¬ y ≤ x).

How to define a supremum on a set?

I'm trying to describe a type system of a programming language. It has a common subtype for any types (VoidType) and a common supertype for any types (AnyType):
datatype type =
VoidType |
AnyType |
BooleanType |
EBooleanType |
RealType |
IntegerType |
UnlimNatType |
StringType
fun subtype_strict_fun :: "type ⇒ type ⇒ bool" (infix "<:sf" 55) where
"_ <:sf VoidType = False"
| "VoidType <:sf _ = True"
| "AnyType <:sf _ = False"
| "_ <:sf AnyType = True"
| "BooleanType <:sf EBooleanType = True"
| "IntegerType <:sf RealType = True"
| "UnlimNatType <:sf IntegerType = True"
| "UnlimNatType <:sf RealType = True"
| "_ <:sf _ = False"
definition subtype_fun :: "type ⇒ type ⇒ bool" (infix "<:f" 55) where
"x <:f y ≡ x = y ∨ x <:sf y"
I'm trying to instantinate type as ccpo:
instantiation type :: ccpo
begin
definition "less_eq = subtype_fun"
definition "less = subtype_strict_fun"
lemma subtype_strict_eq_subtype:
"(x <:sf y) = (x <:f y ∧ ¬ y <:f x)"
by (cases x; cases y; simp add: subtype_fun_def)
lemma subtype_refl:
"x <:f x"
by (simp add: subtype_fun_def)
lemma subtype_trans:
"x <:f y ⟹ y <:f z ⟹ x <:f z"
by (cases x; cases y; cases z; simp add: subtype_fun_def)
lemma subtype_antisym:
"x <:f y ⟹ y <:f x ⟹ x = y"
by (cases x; cases y; simp add: subtype_fun_def)
instance
apply intro_classes
apply (simp add: less_eq_type_def less_type_def subtype_strict_eq_subtype)
apply (simp add: less_eq_type_def less_type_def subtype_refl)
apply (metis less_eq_type_def subtype_trans)
apply (metis less_eq_type_def subtype_antisym)
end
Could you suggest how to define a supremum function Sup :: OCL.type set ⇒ OCL.type?
The type OCL.type is finite, so all sets of type OCL.type set are finite, too. Moreover, there is also a top element in your hierarchy. Therefore, you can define the Sup operation simply by folding sup over the given set. The locale comm_monoid_set provides the necessary infrastructure. First, instantiate the type classes semilattice_sup and order_top. Then interpret comm_monoid_set:
interpretation ocl': abel_semigroup sup "top :: OCL.type" <proof>
interpretation ocl: comm_monoid_set sup "top :: OCL.type" <proof>
This generates the folded sup operation over sets under the name ocl.F. So,
definition "Sup_ocl = ocl.F id"
gives you a definition for the Sup operation. This is a general construction that works for any finite upper semilattice with a top element. But it will not give you any dedicated setup for reasoning about the OCL.type hierarchy in particular. You'll have to derive appropriate rules yourself.

How to define a linear ordering on a type?

I'm trying to define a conjunction function for 4-valued logic (false, true, null, and error). In my case the conjunction is equivavlent to min function on linear order false < error < null < true.
datatype bool4 = JF | JT | BN | BE
instantiation bool4 :: linear_order
begin
fun leq_bool4 :: "bool4 ⇒ bool4 ⇒ bool" where
"leq_bool4 JF b = True"
| "leq_bool4 BE b = (b = BE ∨ b = BN ∨ b = JT)"
| "leq_bool4 BN b = (b = BN ∨ b = JT)"
| "leq_bool4 JT b = (b = JT)"
instance proof
fix x y z :: bool4
show "x ⊑ x"
by (induct x) simp_all
show "x ⊑ y ⟹ y ⊑ z ⟹ x ⊑ z"
by (induct x; induct y) simp_all
show "x ⊑ y ⟹ y ⊑ x ⟹ x = y"
by (induct x; induct y) simp_all
show "x ⊑ y ∨ y ⊑ x"
by (induct x; induct y) simp_all
qed
end
definition and4 :: "bool4 ⇒ bool4 ⇒ bool4" where
"and4 a b ≡ minimum a b"
I guess there must be an easier way to define a linear order in Isabelle HOL. Could you suggest a simplification of the theory?
You can use the "Datatype_Order_Generator" AFP entry.
Then it's as simple as importing "$AFP/Datatype_Order_Generator/Order_Generator" and declaring derive linorder "bool4". Note that the constructors must be declared in the order you want them when defining your datatype.
Details on how to download and use the AFP locally can be found here.

What happens during function proofs

I am trying to proof a property of the icmp6 checksum function (sum 16bit integers, add carry, invert 16bit integer).
I defined the functions in isabelle. (I know my proofs are terrible)
But for some reason, isabelle can't proof something about the icmp_csum function, it wants to have.
When I replace the oops in the paste with done it produces thousands of lines that just says:
"linarith_split_limit exceeded (current value is 9)"
theory Scratch
imports Main Int List
begin
fun norm_helper :: "nat ⇒ nat" where
"norm_helper x = (let y = divide x 65536 in (y + x - y * 65536))"
lemma "x ≥ 65536 ⟹ norm_helper x < x" by simp
lemma h: "norm_helper x ≤ x" by simp
fun normalize :: "nat ⇒ nat" where
"normalize x = (if x ≥ 65536
then normalize (norm_helper x)
else x)"
inductive norm_to :: "nat ⇒ nat ⇒ bool" where
"(x < 65536) ⟹ norm_to x x"
| "norm_to y z ⟹ y = norm_helper x ⟹ norm_to x z"
lemma ne: "norm_to x y ⟹ y = normalize x"
apply (induct x y rule: norm_to.induct) by simp+
lemma i: "norm_to x y ⟹ x ≥ y"
apply (induct x y rule: norm_to.induct) by simp+
lemma l: "norm_to x y ⟹ y < 65536"
apply (induct x y rule: norm_to.induct) by simp+
lemma en: "y = normalize x ⟹ norm_to x y"
apply (induct x rule: normalize.induct)
proof -
fix x :: nat
assume 1: "(x ≥ 65536 ⟹ y = Scratch.normalize (norm_helper x) ⟹ norm_to (norm_helper x) y)"
assume 2: "y = Scratch.normalize x"
show "norm_to x y"
proof (cases "x ≥ 65536")
show "¬ 65536 ≤ x ⟹ norm_to x y"
using norm_to.intros(1)[of x] 2 by simp
{
assume s: "65536 ≤ x"
have d: "y = normalize (norm_helper x)" using 2 s by simp
show "65536 ≤ x ⟹ norm_to x y"
using 1 d norm_to.intros(2)[of "norm_helper x" y x]
by blast
}
qed
qed
lemma "normalize x ≤ x" using en i by simp
lemma n[simp]: "normalize x < 65536" using en l by blast
fun sum :: "nat list ⇒ nat" where
"sum [] = 0"
| "sum (x#xs) = x + sum xs"
fun csum :: "nat list ⇒ nat" where
"csum xs = normalize (sum xs)"
fun invert :: "nat ⇒ nat" where
"invert x = 65535 - x"
lemma c: "csum xs ≤ 65535" using n[of "sum xs"] by simp
lemma ic: "invert (csum xs) ≥ 0" using c[of xs] by blast
lemma asdf:
assumes "xs = ys"
shows "invert (csum xs) = invert (csum ys)"
using HOL.arg_cong[of "csum xs" "csum ys" invert,
OF HOL.arg_cong[of xs ys csum]] assms(1)
by blast
function icmp_csum :: "nat list ⇒ nat" where
"icmp_csum xs = invert (csum xs)"
apply simp
apply (rule asdf)
apply simp
oops
end
I have no idea why there is tracing output from linarith there, but given that your definition is neither recursive nor performs pattern matching, you can write it as a definition:
definition icmp_csum :: "nat list ⇒ nat" where
"icmp_csum xs = invert (csum xs)"
Another possibility is to change invert to a definition instead of a fun. (In general, if it's neither recursive nor performs pattern matching, definition is preferable because it has much less overhead than fun.)
NB, just import Main, not Main Int List.
Edit: An explanation from Tobias Nipkow on the mailing list:
This is a known issue. In the outdated LNCS 2283 you can find a discussion what to do about it in Section 3.5.3 Simplification and Recursive Functions. The gist: don't use "if", use pattern matching or "case". Or disable if_split.

Lifting a partial definition to a quotient type

I have a partially-defined operator (disj_union below) on sets that I would like to lift to a quotient type (natq). Morally, I think this should be ok, because it is always possible to find in the equivalence class some representative for which the operator is defined [*]. However, I cannot complete the proof that the lifted definition preserves the equivalence, because disj_union is only partially defined. In my theory file below, I propose one way I have found to define my disj_union operator, but I don't like it because it features lots of abs and Rep functions, and I think it would be hard to work with (right?).
What is a good way to define this kind of thing using quotients in Isabelle?
theory My_Theory imports
"~~/src/HOL/Library/Quotient_Set"
begin
(* A ∪-operator that is defined only on disjoint operands. *)
definition "X ∩ Y = {} ⟹ disj_union X Y ≡ X ∪ Y"
(* Two sets are equivalent if they have the same cardinality. *)
definition "card_eq X Y ≡ finite X ∧ finite Y ∧ card X = card Y"
(* Quotient sets of naturals by this equivalence. *)
quotient_type natq = "nat set" / partial: card_eq
proof (intro part_equivpI)
show "∃x. card_eq x x" by (metis card_eq_def finite.emptyI)
show "symp card_eq" by (metis card_eq_def symp_def)
show "transp card_eq" by (metis card_eq_def transp_def)
qed
(* I want to lift my disj_union operator to the natq type.
But I cannot complete the proof, because disj_union is
only partially defined. *)
lift_definition natq_add :: "natq ⇒ natq ⇒ natq"
is "disj_union"
oops
(* Here is another attempt to define natq_add. I think it
is correct, but it looks hard to prove things about,
because it uses abstraction and representation functions
explicitly. *)
definition natq_add :: "natq ⇒ natq ⇒ natq"
where "natq_add X Y ≡
let (X',Y') = SOME (X',Y').
X' ∈ Rep_natq X ∧ Y' ∈ Rep_natq Y ∧ X' ∩ Y' = {}
in abs_natq (disj_union X' Y')"
end
[*] This is a little bit like how capture-avoiding substitution is only defined on the condition that bound variables do not clash; a condition that can always be satisfied by renaming to another representative in the alpha-equivalence class.
What about something like this (just an idea):
definition disj_union' :: "nat set ⇒ nat set ⇒ nat set"
where "disj_union' X Y ≡
let (X',Y') = SOME (X',Y').
card_eq X' X ∧ card_eq Y' Y ∧ X' ∩ Y' = {}
in disj_union X' Y'"
lift_definition natq_add :: "natq ⇒ natq ⇒ natq"
is "disj_union'" oops
For the record, here is Ondřej's suggestion (well, a slight amendment thereof, in which only one of the operands is renamed, not both) carried out to completion...
(* A version of disj_union that is always defined. *)
definition disj_union' :: "nat set ⇒ nat set ⇒ nat set"
where "disj_union' X Y ≡
let Y' = SOME Y'.
card_eq Y' Y ∧ X ∩ Y' = {}
in disj_union X Y'"
(* Can always choose a natural that is not in a given finite subset of ℕ. *)
lemma nats_infinite:
fixes A :: "nat set"
assumes "finite A"
shows "∃x. x ∉ A"
proof (rule ccontr, simp)
assume "∀x. x ∈ A"
hence "A = UNIV" by fast
hence "finite UNIV" using assms by fast
thus False by fast
qed
(* Can always choose n naturals that are not in a given finite subset of ℕ. *)
lemma nat_renaming:
fixes x :: "nat set" and n :: nat
assumes "finite x"
shows "∃z'. finite z' ∧ card z' = n ∧ x ∩ z' = {}"
using assms
apply (induct n)
apply (intro exI[of _ "{}"], simp)
apply (clarsimp)
apply (rule_tac x="insert (SOME y. y ∉ x ∪ z') z'" in exI)
apply (intro conjI, simp)
apply (rule someI2_ex, rule nats_infinite, simp, simp)+
done
lift_definition natq_add :: "natq ⇒ natq ⇒ natq"
is "disj_union'"
apply (unfold disj_union'_def card_eq_def)
apply (rule someI2_ex, simp add: nat_renaming)
apply (rule someI2_ex, simp add: nat_renaming)
apply (metis card.union_inter_neutral disj_union_def empty_iff finite_Un)
done

Resources