I am trying to use code_pred for an inductive predicate defined inside a locale. I came across this email which shows how this can be done:
locale l = fixes x :: 'a assumes "x = x"
inductive (in l) is_x where "is_x x"
global_interpretation i: l "0 :: nat" defines i_is_x = "i.is_x" by unfold_locales simp
declare i.is_x.intros[code_pred_intro]
code_pred i_is_x by(rule i.is_x.cases)
However, when I change the global_interpretation to use () :: unit instead of 0 :: nat, then code_pred fails with the following message:
Tactic failed
The error(s) above occurred for the goal statement⌂:
i_is_x_i x = Predicate.bind (Predicate.single x) (λx. case x of () ⇒ Predicate.single ())
I tried to do the prove manually, but at some point I got the same error.
Does anyone know how to solve this?
I don't exactly understand what is happening here, but the code generator already uses unit internally and the tactic (corresponding to before single intro rule) fails on your example.
The error does not come from the proof, but comes from proof done internally in the done part. So changing the proof does not change the issue (and you even see with sorry).
A possible work-around: use a type isomorphic to unit:
datatype myunit = MyUnit
locale l = fixes x :: 'a assumes "x = x"
inductive (in l) is_x where "is_x x"
definition X where ‹X = ()›
global_interpretation i: l "MyUnit :: myunit" defines i_is_x = "i.is_x" by unfold_locales simp
declare i.is_x.intros[code_pred_intro]
code_pred i_is_x
by (rule i.is_x.cases)
Related
I found this expression somewhere in Isabelle's standard library and tried to see what value does with it
value "(λ x::bool . ¬x) ≤ (λ x . x)"
It outputs False. What is the meaning of ≤ here? Ideally, where can I find the exact instantiation of it? When I Ctrl+Click on the lambda symbol, jEdit doesn't take me anywhere. Is λ part of meta logic then? Where is it defined?
This and many other things are defined in Lattices.thy theory in Main library
https://isabelle.in.tum.de/library/HOL/HOL/Lattices.html
under the following section.
subsection ‹Lattice on \<^typ>‹_ ⇒ _››
instantiation "fun" :: (type, semilattice_sup) semilattice_sup
begin
definition "f ⊔ g = (λx. f x ⊔ g x)"
lemma sup_apply [simp, code]: "(f ⊔ g) x = f x ⊔ g x"
by (simp add: sup_fun_def)
instance
by standard (simp_all add: le_fun_def)
end
Isabelle has some automation for quotient reasoning through the quotient package. I would like to see if that automation is of any use for my example. The relevant definitions is:
definition e_proj where "e_proj = e'_aff_bit // gluing"
So I try to write:
typedef e_aff_t = e'_aff_bit
quotient_type e_proj_t = "e'_aff_bit" / "gluing
However, I get the error:
Extra type variables in representing set: "'a"
The error(s) above occurred in typedef "e_aff_t"
Because as Manuel Eberl explains here, we cannot have type definitions that depend on type parameters. In the past, I was suggested to use the type-to-sets approach.
How would that approach work in my example? Would it lead to more automation?
In the past, I was suggested to use the type-to-sets approach ...
The suggestion that was made in my previous answer was to use the standard set-based infrastructure for reasoning about quotients. I only mentioned that there exist other options for completeness.
I still believe that it is best not to use Types-To-Sets, provided that the definition of a quotient type is the only reason why you wish to use Types-To-Sets:
Even with Types-To-Sets, you will only be able to mimic the behavior of a quotient type in a local context with certain additional assumptions. Upon leaving the local context, the theorems that use locally defined quotient types would need to be converted to the set-based theorems that would inevitably rely on the standard set-based infrastructure for reasoning about quotients.
One would need to develop additional Isabelle/ML infrastructure before Local Typedef Rule can be used to define quotient types locally conveniently. It should not be too difficult to develop an infrastructure that is useable, but it would take some time to develop something that is universally applicable. Personally, I do not consider this application to be sufficiently important to invest my time in it.
In my view, it is only viable to use Types-To-Sets for the definition of quotient types locally if you are already using Types-To-Sets for its intended purpose in a given development. Then, the possibility of using the framework for the definition of quotient types locally can be seen as a 'value-added benefit'.
For completeness, I provide an example that I developed for an answer on the mailing list some time ago. Of course, this is merely the demonstration of the concept, not a solution that can be used for work that is meant to be published in some form. To make this useable, one would need to convert this development to an Isabelle/ML command that would take care of all the details automatically.
theory Scratch
imports Main
"HOL-Types_To_Sets.Prerequisites"
"HOL-Types_To_Sets.Types_To_Sets"
begin
locale local_typedef =
fixes R :: "['a, 'a] ⇒ bool"
assumes is_equivalence: "equivp R"
begin
(*The exposition subsumes some of the content of
HOL/Types_To_Sets/Examples/Prerequisites.thy*)
context
fixes S and s :: "'s itself"
defines S: "S ≡ {x. ∃u. x = {v. R u v}}"
assumes Ex_type_definition_S:
"∃(Rep::'s ⇒ 'a set) (Abs::'a set ⇒ 's). type_definition Rep Abs S"
begin
definition "rep = fst (SOME (Rep::'s ⇒ 'a set, Abs). type_definition Rep
Abs S)"
definition "Abs = snd (SOME (Rep::'s ⇒ 'a set, Abs). type_definition Rep
Abs S)"
definition "rep' a = (SOME x. a ∈ S ⟶ x ∈ a)"
definition "Abs' x = (SOME a. a ∈ S ∧ a = {v. R x v})"
definition "rep'' = rep' o rep"
definition "Abs'' = Abs o Abs'"
lemma type_definition_S: "type_definition rep Abs S"
unfolding Abs_def rep_def split_beta'
by (rule someI_ex) (use Ex_type_definition_S in auto)
lemma rep_in_S[simp]: "rep x ∈ S"
and rep_inverse[simp]: "Abs (rep x) = x"
and Abs_inverse[simp]: "y ∈ S ⟹ rep (Abs y) = y"
using type_definition_S
unfolding type_definition_def by auto
definition cr_S where "cr_S ≡ λs b. s = rep b"
lemmas Domainp_cr_S = type_definition_Domainp[OF type_definition_S
cr_S_def, transfer_domain_rule]
lemmas right_total_cr_S = typedef_right_total[OF type_definition_S
cr_S_def, transfer_rule]
and bi_unique_cr_S = typedef_bi_unique[OF type_definition_S cr_S_def,
transfer_rule]
and left_unique_cr_S = typedef_left_unique[OF type_definition_S cr_S_def,
transfer_rule]
and right_unique_cr_S = typedef_right_unique[OF type_definition_S
cr_S_def, transfer_rule]
lemma cr_S_rep[intro, simp]: "cr_S (rep a) a" by (simp add: cr_S_def)
lemma cr_S_Abs[intro, simp]: "a∈S ⟹ cr_S a (Abs a)" by (simp add: cr_S_def)
(* this part was sledgehammered - please do not pay attention to the
(absence of) proof style *)
lemma r1: "∀a. Abs'' (rep'' a) = a"
unfolding Abs''_def rep''_def comp_def
proof-
{
fix s'
note repS = rep_in_S[of s']
then have "∃x. x ∈ rep s'" using S equivp_reflp is_equivalence by force
then have "rep' (rep s') ∈ rep s'"
using repS unfolding rep'_def by (metis verit_sko_ex')
moreover with is_equivalence repS have "rep s' = {v. R (rep' (rep s'))
v}"
by (smt CollectD S equivp_def)
ultimately have arr: "Abs' (rep' (rep s')) = rep s'"
unfolding Abs'_def by (smt repS some_sym_eq_trivial verit_sko_ex')
have "Abs (Abs' (rep' (rep s'))) = s'" unfolding arr by (rule
rep_inverse)
}
then show "∀a. Abs (Abs' (rep' (rep a))) = a" by auto
qed
lemma r2: "∀a. R (rep'' a) (rep'' a)"
unfolding rep''_def rep'_def
using is_equivalence unfolding equivp_def by blast
lemma r3: "∀r s. R r s = (R r r ∧ R s s ∧ Abs'' r = Abs'' s)"
apply(intro allI)
apply standard
subgoal unfolding Abs''_def Abs'_def
using is_equivalence unfolding equivp_def by auto
subgoal unfolding Abs''_def Abs'_def
using is_equivalence unfolding equivp_def
by (smt Abs''_def Abs'_def CollectD S comp_apply local.Abs_inverse
mem_Collect_eq someI_ex)
done
definition cr_Q where "cr_Q = (λx y. R x x ∧ Abs'' x = y)"
lemma quotient_Q: "Quotient R Abs'' rep'' cr_Q"
unfolding Quotient_def
apply(intro conjI)
subgoal by (rule r1)
subgoal by (rule r2)
subgoal by (rule r3)
subgoal by (rule cr_Q_def)
done
(* instantiate the quotient lemmas from the theory Lifting *)
lemmas Q_Quotient_abs_rep = Quotient_abs_rep[OF quotient_Q]
(*...*)
(* prove the statements about the quotient type 's *)
(*...*)
(* transfer the results back to 'a using the capabilities of transfer -
not demonstrated in the example *)
lemma aa: "(a::'a) = (a::'a)"
by auto
end
thm aa[cancel_type_definition]
(* this shows {x. ∃u. x = {v. R u v}} ≠ {} ⟹ ?a = ?a *)
end
I am new to Isabelle and this is a simplification of my first program
theory Scratch
imports Main
begin
record flow =
Src :: "nat"
Dest :: "nat"
record diagram =
DataFlows :: "flow set"
Transitions :: "nat set"
Markings :: "flow set"
fun consume :: "diagram × (nat set) ⇒ (flow set)"
where
"(consume dia trans) = {n . n ∈ (Markings dia) ∧ (∃ t ∈ trans . (Dest n) = t)}"
end
The function give the error:
Type unification failed: Clash of types "_ ⇒ " and " set"
Type error in application: operator not of function type
Operator: consume dia :: flow set
Operand: trans :: (??'a × ??'a) set ⇒ bool
What should I do for the the code to compile?
First of all, you give two parameters to your consume function, but the way you defined its type, it takes a single tuple. This is unusual and often inconvenient – defined curried functions instead, like this:
fun consume :: "diagram ⇒ (nat set) ⇒ (flow set)"
Also, trans is a constant; it is the property that a relation is transitive. You can see that by observing that trans is black to indicate that it is a constant and the other variable is blue, indicating that it is a free variable.
I therefore recommend using another name, like ts:
where
"consume dia ts = {n . n ∈ (Markings dia) ∧ (∃ t ∈ ts . (Dest n) = t)}"
What is the easiest way to generate code for a sorting algorithm that sorts its argument in reverse order, while building on top of the existing List.sort?
I came up with two solutions that are shown below in my answer. But both of them are not really satisfactory.
Any other ideas how this could be done?
I came up with two possible solutions. But both have (severe) drawbacks. (I would have liked to obtain the result almost automatically.)
Introduce a Haskell-style newtype. E.g., if we wanted to sort lists of nats, something like
datatype 'a new = New (old : 'a)
instantiation new :: (linorder) linorder
begin
definition "less_eq_new x y ⟷ old x ≥ old y"
definition "less_new x y ⟷ old x > old y"
instance by (default, case_tac [!] x) (auto simp: less_eq_new_def less_new_def)
end
At this point
value [code] "sort_key New [0::nat, 1, 0, 0, 1, 2]"
yields the desired reverse sorting. While this is comparatively easy, it is not as automatic as I would like the solution to be and in addition has a small runtime overhead (since Isabelle doesn't have Haskell's newtype).
Via a locale for the dual of a linear order. First we more or less copy the existing code for insertion sort (but instead of relying on a type class, we make the parameter that represents the comparison explicit).
fun insort_by_key :: "('b ⇒ 'b ⇒ bool) ⇒ ('a ⇒ 'b) ⇒ 'a ⇒ 'a list ⇒ 'a list"
where
"insort_by_key P f x [] = [x]"
| "insort_by_key P f x (y # ys) =
(if P (f x) (f y) then x # y # ys else y # insort_by_key P f x ys)"
definition "revsort_key f xs = foldr (insort_by_key (op ≥) f) xs []"
at this point we have code for revsort_key.
value [code] "revsort_key id [0::nat, 1, 0, 0, 1, 2]"
but we also want all the nice results that have already been proved in the linorder locale (that derives from the linorder class). To this end, we introduce the dual of a linear order and use a "mixin" (not sure if I'm using the correct naming here) to replace all occurrences of linorder.sort_key (which does not allow for code generation) by our new "code constant" revsort_key.
interpretation dual_linorder!: linorder "op ≥ :: 'a::linorder ⇒ 'a ⇒ bool" "op >"
where
"linorder.sort_key (op ≥ :: 'a ⇒ 'a ⇒ bool) f xs = revsort_key f xs"
proof -
show "class.linorder (op ≥ :: 'a ⇒ 'a ⇒ bool) (op >)" by (rule dual_linorder)
then interpret rev_order: linorder "op ≥ :: 'a ⇒ 'a ⇒ bool" "op >" .
have "rev_order.insort_key f = insort_by_key (op ≥) f"
by (intro ext) (induct_tac xa; simp)
then show "rev_order.sort_key f xs = revsort_key f xs"
by (simp add: rev_order.sort_key_def revsort_key_def)
qed
While with this solution we do not have any runtime penalty, it is far too verbose for my taste and is not easily adaptable to changes in the standard code setup (e.g., if we wanted to use the mergesort implementation from the Archive of Formal Proofs for all of our sorting operations).
Up until several days ago, I always defined a type, and then proved theorems directly about the type. Now I'm trying to use type classes.
Problem
The problem is that I can't instantiate cNAT for my type myD below, and it appears it's because simp has no effect on the abstract function cNAT, which I've made concrete with my primrec function cNAT_myD. I can only guess what's happening because of the automation that happens after instance proof.
Questions
Q1: Below, at the statement instantiation myD :: (type) cNAT, can you tell me how to finish the proof, and why I can prove the following theorem, but not the type class proof, which requires injective?
theorem dNAT_1_to_1: "(dNAT n = dNAT m) ==> n = m"
assumes injective: "(cNAT n = cNAT m) ==> n = m"
Q2: This is not as important, but at the bottom is this statement:
instantiation myD :: (type) cNAT2
It involves another way I was trying to instantiate cNAT. Can you tell me why I get Failed to refine any pending goal at shows? I put some comments in the source to explain some of what I did to set it up. I used this slightly modified formula for the requirement injective:
assumes injective: "!!n m. (cNAT2 n = cNAT2 m) --> n = m"
Specifics
My contrived datatype is this, which may be useful to me someday: (Update: Well, for another example maybe. A good mental exercise is for me to try and figure out how I can actually get something inside a 'a myD list, other than []. With BNF, something like datatype_new 'a myD = myS "'a myD fset" gives me the warning that there's an unused type variable on the right-hand side)
datatype 'a myD = myL "'a myD list"
The type class is this, which requires an injective function from nat to 'a:
class cNAT =
fixes cNAT :: "nat => 'a"
assumes injective: "(cNAT n = cNAT m) ==> n = m"
dNAT: this non-type class version of cNAT works
fun get_myL :: "'a myD => 'a myD list" where
"get_myL (myL L) = L"
primrec dNAT :: "nat => 'a myD" where
"dNAT 0 = myL []"
|"dNAT (Suc n) = myL (myL [] # get_myL(dNAT n))"
fun myD2nat :: "'a myD => nat" where
"myD2nat (myL []) = 0"
|"myD2nat (myL (x # xs)) = Suc(myD2nat (myL xs))"
theorem left_inverse_1 [simp]:
"myD2nat(dNAT n) = n"
apply(induct n, auto)
by(metis get_myL.cases get_myL.simps)
theorem dNAT_1_to_1:
"(dNAT n = dNAT m) ==> n = m"
apply(induct n)
apply(simp) (*
The simp method expanded dNAT.*)
apply(metis left_inverse_1 myD2nat.simps(1))
by (metis left_inverse_1)
cNAT: type class version that I can't instantiate
instantiation myD :: (type) cNAT
begin
primrec cNAT_myD :: "nat => 'a myD" where
"cNAT_myD 0 = myL []"
|"cNAT_myD (Suc n) = myL (myL [] # get_myL(cNAT_myD n))"
instance
proof
fix n m :: nat
show "cNAT n = cNAT m ==> n = m"
apply(induct n)
apply(simp) (*
The simp method won't expand cNAT to cNAT_myD's definition.*)
by(metis injective)+ (*
Metis proved it without unfolding cNAT_myD. It's useless. Goals always remain,
and the type variables in the output panel are all weird.*)
oops
end
cNAT2: Failed to refine any pending goal at show
(*I define a variation of `injective` in which the `assumes` definition, the
goal, and the `show` statement are exactly the same, and that strange `fails
to refine any pending goal shows up.*)
class cNAT2 =
fixes cNAT2 :: "nat => 'a"
assumes injective: "!!n m. (cNAT2 n = cNAT2 m) --> n = m"
instantiation myD :: (type) cNAT2
begin
primrec cNAT2_myD :: "nat => 'a myD" where
"cNAT2_myD 0 = myL []"
|"cNAT2_myD (Suc n) = myL (myL [] # get_myL(cNAT2_myD n))"
instance
proof (*
goal: !!n m. cNAT2 n = cNAT2 m --> n = m.*)
show
"!!n m. cNAT2 n = cNAT2 m --> n = m"
(*Failed to refine any pending goal
Local statement fails to refine any pending goal
Failed attempt to solve goal by exported rule:
cNAT2 (n::nat) = cNAT2 (m::nat) --> n = m *)
Your function cNAT is polymorphic in its result type, but the type variable does not appear among the parameters. This often causes type inference to compute a type which is more general than you want. In your case for cNAT, Isabelle infers for the two occurrences of cNAT in the show statement the type nat => 'b for some 'b of sort cNAT, but their type in the goal is nat => 'a myD. You can see this in jEdit by Ctrl-hovering over the cNAT occurrences to inspect the types. In ProofGeneral, you can enable printing of types with using [[show_consts]].
Therefore, you have to explicitly constrain types in the show statement as follows:
fix n m
assume "(cNAT n :: 'a myD) = cNAT m"
then show "n = m"
Note that it is usually not a good idea to use Isabelle's meta-connectives !! and ==> inside a show statement, you better rephrase them using fix/assume/show.