Can I construct a while structure algebraically using class and locale? - isabelle

I am constructing program statements from algebraic structures, rather than using definitions or functions.That is to set their properties in Isabelle using locale or class commands.
Now I need to construct a while statement.
I know I can define it in command of functions, or I can define it using kleene algebra. But, as I said before, I just want to describe the nature of a class or locale.
So I wrote this code:
consts skip :: "'a" ("II")
type_synonym 'a proc = "'a "
class sequen =
fixes seq :: "'a proc ⇒'a proc ⇒'a proc " (infixl ";;" 60)
assumes seq_assoc : "(x ;; y) ;; z = x ;; (y ;; z)"
and seq_skip_left : "II ;; x = x"
and seq_skip_right : "x ;; II = x"
definition ifprog :: " 'a proc ⇒ bool ⇒ 'a proc ⇒ 'a proc " ("(_ ◃ _ ▹ _)" [52,0,53] 52)
where "x ◃ bexp ▹ y ≡ (THE z::'a proc . (bexp = True ⟶ z = x) ∧ (bexp = False ⟶ z = y))"
locale while_unfold =
sequen seq
for seq :: "'a proc ⇒'a proc ⇒'a proc " +
fixes while ::"bool ⇒ 'a proc ⇒ 'a proc" ("while _ do _ od")
assumes while_ltera : "while bexp do P od = (P ;; (while bexp do P od)) ◃ bexp ▹ II"
If that were possible, I wouldn't be asking questions here, I've got a problem :
Type unification failed: Variable 'a::type not of sort sequen
And then, these details are:
Type unification failed: Variable 'a::type not of sort sequen
Type error in application: incompatible operand type
Operator: (;;) :: ??'a ⇒ ??'a ⇒ ??'a
Operand: P :: 'a
How can I avoid this problem, or can this descriptive method be used to construct statements that have an iterative function, such as while.

I have not looked at the content of the class/locale, but the error message seems to be self-explanatory: type unification failed due to an incompatible sort constraint for the type variable 'a. Unless you rely on type inference, the sort constraint needs to be provided explicitly:
consts skip :: "'a" ("II")
type_synonym 'a proc = "'a "
class sequen =
fixes seq :: "'a proc ⇒'a proc ⇒'a proc " (infixl ";;" 60)
assumes seq_assoc : "(x ;; y) ;; z = x ;; (y ;; z)"
and seq_skip_left : "II ;; x = x"
and seq_skip_right : "x ;; II = x"
(*sequen_class.seq has the type
"'a::sequen ⇒ 'a::sequen ⇒ 'a::sequen",
which includes the sort constraint sequen for the type variable 'a:*)
declare [[show_sorts]]
term sequen_class.seq
definition ifprog :: " 'a proc ⇒ bool ⇒ 'a proc ⇒ 'a proc " ("(_ ◃ _ ▹ _)" [52,0,53] 52)
where "x ◃ bexp ▹ y ≡ (THE z::'a proc . (bexp = True ⟶ z = x) ∧ (bexp = False ⟶ z = y))"
(*note the sort constraint*)
locale while_unfold =
sequen seq
for seq :: "'a::sequen proc ⇒'a proc ⇒'a proc " +
fixes while ::"bool ⇒ 'a proc ⇒ 'a proc" ("while _ do _ od")
assumes while_ltera : "while bexp do P od = (P ;; (while bexp do P od)) ◃ bexp ▹ II"
(*alternatively, consider using a class instead of a locale, although,
most certainly, the best choice depends on your application*)
class while_unfold' =
sequen +
fixes while ::"bool ⇒ 'a proc ⇒ 'a proc" ("while _ do _ od")
assumes while_ltera : "while bexp do P od = (P ;; (while bexp do P od)) ◃ bexp ▹ II"
For more information about classes and sort constraints see sections 3.3.6 and 5.8 in the Isabelle/Isar Reference Manual. You can also take a look at section 2 in the The Isabelle/Isar Implementation.
Isabelle version: Isabelle2020

Related

Isabelle instantiation with type parameter

I'm trying to get this to work
no_notation Nil ("[]") and Cons (infixr "#" 65) and append (infixr "#" 65) and plus (infixl "+" 65)
class plus =
fixes plus :: "'a ⇒ 'a ⇒ 'a" (infixl "+" 65)
datatype 'a list =
Nil ("[]")
| Cons 'a "'a list" (infixr "#" 65)
instantiation "'a list" :: plus
begin
primrec plus_list :: "'a list ⇒ 'a list ⇒ 'a list" where
"plus_list [] ys = ys" |
"plus_list (x#xs) ys = x # (plus_list xs ys)"
instance ..
end
essentially lists are free monoids under concatenation. How do I express this fact using type-classes?
At the moment I get
Undefined type name: "'a list"⌂
in this line
instantiation "'a list" :: plus
^^^^^^^^^
If I get rid of 'a I get
Bad number of arguments for type constructor: "Test.list"
Even if I try to specialize to nat list I get
Undefined type name: "nat list"⌂
I can see here
https://isabelle.in.tum.de/doc/classes.pdf
that it is possible. However, the notation used in this pdf is strange. I can't reproduce any of the examples provided. For instance this
class eq where
eq :: α ⇒ α ⇒ bool
I suppose it's meant to be something like
class eq where
eq :: "'a ⇒ 'a ⇒ bool"
but when I paste it to jEdit I get syntax error. Other Isabelle tutorials use a different notation, like
class eq =
fixes eq :: "'a ⇒ 'a ⇒ bool"
This pdf also provides example
instance (α::eq, β::eq) pair :: eq where
eq (x1, y1) (x2, y2) = eq x1 x2 ∧ eq y1 y2
which looks like what I am looking for. An instance of a higher-order type.
no_notation Nil ("[]") and Cons (infixr "#" 65) and append (infixr "#" 65) and plus (infixl "+" 65)
class plus =
fixes plus :: "'a ⇒ 'a ⇒ 'a" (infixl "+" 65)
datatype 'a list =
Nil ("[]")
| Cons 'a "'a list" (infixr "#" 65)
instantiation list :: (type) plus
begin
primrec plus_list :: "'a list ⇒ 'a list ⇒ 'a list" where
"plus_list [] ys = ys" |
"plus_list (x#xs) ys = x # (plus_list xs ys)"
instance ..
end

Isabelle: How can I use solver this error?

**I'm using isabelle to proof security boot of device. lemma AF1_aux fail to pass the proof.
When I change if event_enabled s be to if false, it pass. I can't move forward.
Any guidance would be very helpful!
Here is the simple code**
section ‹boot security›
theory boot_sec
imports Main
begin
locale M_HLR =
(* declare the initial state *)
fixes Initial_State :: 's
(* next state function *)
fixes next_state :: "'s ⇒ 'be ⇒ 's"
(* Auxiliary function for present Stable State *)
fixes success :: "'s ⇒ bool"
(* Security Requirements *)
assumes AF1: "∃s. ∀b. next_state s b = s"
datatype Status = INIT | READ_ROM | END
record State =
status :: Status
datatype Behavior = Read_ROM |
Gen_SessionKey
definition read_rom :: "State ⇒ State" where
"read_rom s ≡ s ⦇status := READ_ROM ⦈"
definition gen_sessionkey :: "State ⇒ State" where
"gen_sessionkey s ≡ s ⦇status := END ⦈"
definition event_enabled :: "State ⇒ Behavior ⇒ bool" where
"event_enabled s be ≡ if status s = END then False else True"
definition exec_be :: "State ⇒ Behavior ⇒ State" where
"exec_be s be ≡
if event_enabled s be
then
( case be of
Read_ROM ⇒ read_rom s |
Gen_SessionKey ⇒ gen_sessionkey s )
else s"
lemma AF1_aux: "status s = END ⟹ ∀be. exec_be s be = s"
by(simp add: exec_be_def)
theorem AF1: "∃s. ∀be. exec_be s be = s"
by (meson AF1_aux State.select_convs(1))
end
The output is
theorem AF1_aux: status ?s = END ⟹ ∀be. exec_be ?s be = ?s
Failed to finish proof⌂:
goal (1 subgoal):
1. status s = END ⟹ ∀be. event_enabled s be ⟶ (case be of Read_ROM ⇒ read_rom s | Gen_SessionKey ⇒ gen_sessionkey s) = s

How to define a map of mappings?

There are 2 kinds of values in the theory - val1 and val2:
type_synonym bool3 = "bool option"
datatype val1 = BVal1 bool3 | IVal1 int | SVal1 string
datatype val2 = BVal2 bool | IVal2 int
I can map them using either the following inductive predicate:
inductive map_val_ind :: "val1 ⇒ val2 ⇒ bool" where
"map_val_ind (BVal1 (Some v)) (BVal2 v)"
| "map_val_ind (IVal1 v) (IVal2 v)"
code_pred [show_modes] map_val_ind .
values "{t. map_val_ind (BVal1 (Some True)) t}"
or the following function:
fun map_val :: "val1 ⇒ val2 option" where
"map_val (BVal1 (Some v)) = Some (BVal2 v)"
| "map_val (IVal1 v) = Some (IVal2 v)"
| "map_val _ = None"
value "map_val (BVal1 (Some True))"
I prefer inductive predicate, because it's bidirectional.
Also I need to map environments of variables:
type_synonym vname = "string"
type_synonym 'a env = "vname ⇒ 'a option"
1) Here is a first attempt to define the mapping:
definition map_env :: "val1 env ⇒ val2 env ⇒ bool" where
"map_env env1 env2 ≡ ∀x. ∃y z.
env1 x = Some y ∧
env2 x = Some z ∧
map_val_ind y z"
The problem is that it's not constructive, and I don't understand how to map an environment using this definition.
2) Here is a functional definition:
definition map_env_fun :: "val1 env ⇒ (val2 env) option" where
"map_env_fun env = (if ∀x. ∃y z. env x = Some y ∧ map_val y = Some z
then Some (λx. map_val (the (env x)))
else None)"
value "map_env_fun [''x'' ↦ BVal1 (Some True)]"
But I get the following error:
Wellsortedness error
(in code equation map_env_fun ?env ≡
if ∀x. ∃y z. equal_option_inst.equal_option (?env x) (Some y) ∧
equal_option_inst.equal_option (map_val y) (Some z)
then Some (λx. map_val (the (?env x))) else None,
with dependency "Pure.dummy_pattern" -> "map_env_fun"):
Type char list not of sort enum
No type arity list :: enum
3) And here is an inductive version:
inductive map_env_ind :: "val1 env ⇒ val2 env ⇒ bool" where
"env1 x = Some y ⟹
env2 x = Some z ⟹
map_val_ind y z ⟹
map_env_ind env1 env2"
code_pred [show_modes] map_env_ind .
The problem is that code_pred can't infer any execution modes.
How to define such an environment mapping? I prefer an inductive version, because it's bidirectional and it's easier to prove lemmas for inductive predicates.

Isabelle unification error

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)}"

How to generate code for reverse sorting

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).

Resources