Here is a definition of a simple language:
theory SimpleLang
imports Main
begin
type_synonym vname = "string"
datatype exp = BConst bool | IConst int | Let vname exp exp | Var vname | And exp exp
datatype type = BType | IType
type_synonym tenv = "vname ⇒ type option"
inductive typing :: "tenv ⇒ exp ⇒ type ⇒ bool"
("(1_/ ⊢/ (_ :/ _))" [50,0,50] 50) where
BConstTyping: "Γ ⊢ BConst c : BType" |
IConstTyping: "Γ ⊢ IConst c : IType" |
LetTyping: "⟦Γ ⊢ init : t1; Γ(var ↦ t1) ⊢ body : t⟧ ⟹ Γ ⊢ Let var init body : t" |
VarTyping: "Γ var = Some t ⟹ Γ ⊢ Var var : t" |
AndTyping: "⟦Γ ⊢ a : BType; Γ ⊢ b : BType⟧ ⟹ Γ ⊢ And a b : BType"
lemma AndTypingRev:
"Γ ⊢ And a b : BType ⟹ Γ ⊢ a : BType ∧ Γ ⊢ b : BType"
end
I defined a typing function for expressions. And I'm trying to prove that if And-expression has a Bool Type then both of its arguments have Bool Type too. It's a reversion of AndTyping rule from the theory.
Could you suggest how to prove this lemma? Could it be proved without Isar?
inductive proves an elimination rule called typing.cases for this sort of thing. That allows you to do ‘rule inversion’. The Isar way is to do it like this:
lemma AndTypingRev:
assumes "Γ ⊢ And a b : BType"
shows "Γ ⊢ a : BType ∧ Γ ⊢ b : BType"
using assms by (cases rule: typing.cases) auto
Since this is the default rule for case distinctions involving typing, you can also just write by cases auto. In any case, if you use cases for this, you should chain in the assumption involving typing with using, from, etc.
You can also do it without chaining using e.g. erule:
lemma AndTypingRev:
"Γ ⊢ And a b : BType ⟹ Γ ⊢ a : BType ∧ Γ ⊢ b : BType"
by (erule typing.cases) auto
There is another way: You can use the inductive_cases command to automatically generate a suitable lemma for rule inversion (essentially, it's a specialised version of the typing.cases rule):
inductive_cases AndTypingRev: "Γ ⊢ And a b : BType"
You can make it even more general:
inductive_cases AndTypingRev: "Γ ⊢ And a b : t"
That gives you an elimination rule AndTypingRev that you can use with erule, elim, or cases:
?Γ ⊢ And ?a ?b : ?t ⟹
(?t = BType ⟹ ?Γ ⊢ ?a : BType ⟹ ?Γ ⊢ ?b : BType ⟹ ?P) ⟹
?P
Related
The labeled transition of Isballe is defined below, which contains the prior node and the successor node, the set represents the condition.
type_synonym ('q,'a) LTS = "('q * 'a set * 'q) set"
After the LTS, we need to define a function of the reachable from Node a to Node b. The definition of LTS_is_reachable like:
inductive LTS_is_reachable :: "('q, 'a) LTS ⇒ ('q * 'q) set ⇒ 'q ⇒ 'a list ⇒ 'q ⇒ bool" for Δ and Δ' where
LTS_Empty[intro!]: "LTS_is_reachable Δ Δ' q [] q" |
LTS_Step1: "LTS_is_reachable Δ Δ' q l q'" if "(q, q'') ∈ Δ'" and "LTS_is_reachable Δ Δ' q'' l q'" |
LTS_Step2[intro!]: "LTS_is_reachable Δ Δ' q (a # w) q'" if "a ∈ σ" and "(q, σ, q'') ∈ Δ" and "LTS_is_reachable Δ Δ' q'' w q'"
where the LTS_empty denotes node q could arrive at self by empty list, LTS_Step1 denotes if there exists node q and p in Delta', then q could reach p no condition, and LTS_Step2 denotes that node q could reach node q'' by the alphbet sigma.
Finally, I try to prove a lemma
lemma removeFromAtoEndTrans:"LTS_is_reachable Δ (insert (ini, end) Δ') ini l end ⟹ l ≠ [] ⟹ ∀(q, σ, p) ∈ Δ. q ≠ ini ∧ q ≠ end ⟹ ∀(end, p) ∈ Δ'. p = end ⟹ LTS_is_reachable Δ Δ' ini l end"
This lemma said that if the list l isn't empty, we could remove ini-> end from Delta2. It obviously holds. Through the tool nitpick, it can not find any counter-examples. But I could think about any ideas to prove it. Any helps would be appreciated.
I'm studying topological filters in Filter.thy
theory Filter
imports Set_Interval Lifting_Set
begin
subsection ‹Filters›
text ‹
This definition also allows non-proper filters.
›
locale is_filter =
fixes F :: "('a ⇒ bool) ⇒ bool"
assumes True: "F (λx. True)"
assumes conj: "F (λx. P x) ⟹ F (λx. Q x) ⟹ F (λx. P x ∧ Q x)"
assumes mono: "∀x. P x ⟶ Q x ⟹ F (λx. P x) ⟹ F (λx. Q x)"
typedef 'a filter = "{F :: ('a ⇒ bool) ⇒ bool. is_filter F}"
proof
show "(λx. True) ∈ ?filter" by (auto intro: is_filter.intro)
qed
I don't get this definition. It's quite convoluted so I'll simplify it first
The expression
F (λx. P x) could be simplified to F P (using eta reduction of lambda calculus). The predicate 'a ⇒ bool is really just a set 'a set. Similarly ('a ⇒ bool) ⇒ bool should be 'a set set. Then we could rewrite the axioms as
assumes conj: "P ∈ F ∧ Q ∈ F ⟹ Q ∩ P ∈ F"
assumes mono: "P ⊆ Q ∧ P ∈ F ⟹ Q ∈ F"
Now my question is about the True axiom. It is equivalent to
assumes True: "UNIV ∈ F"
This does not match with the definitions of filters that I ever saw.
The axiom should be instead
assumes True: "{} ∉ F" (* the name True is not very fitting anymore *)
The statement UNIV ∈ F is unnecessary because it follows from axiom mono.
So what's up with this definition that Isabelle provides?
The link provided by Javier Diaz has lots of explanations.
Turns out this is a definition of improper filter. The axiom True is necessary and does not follow from mono. If this axiom was missing then F could be defined as
F P = False
or in set-theory notation, F could be an empty set and mono and conj would then be satisfied vacuously.
Can you suggest how to apply an induction rule to the following lemma?
datatype 'a expr =
Literal "'a literal_expr"
| Var "string"
and 'a literal_expr =
NullLiteral
| CollectionLiteral "'a collection_literal_part_expr list"
and 'a collection_literal_part_expr =
CollectionItem "'a expr"
datatype 'a type = OclVoid | Set "'a type"
inductive typing and collection_parts_typing where
"typing Γ (Literal NullLiteral) OclVoid"
| "collection_parts_typing Γ prts τ ⟹
typing Γ (Literal (CollectionLiteral prts)) (Set τ)"
| "collection_parts_typing Γ [] OclVoid"
| "⟦typing Γ a τ; collection_parts_typing Γ xs σ⟧ ⟹
collection_parts_typing Γ (CollectionItem a # xs) σ"
lemma
"typing Γ1 expr τ1 ⟹ typing Γ1 expr σ1 ⟹ τ1 = σ1" and
"collection_parts_typing Γ2 prts τ2 ⟹
collection_parts_typing Γ2 prts σ2 ⟹ τ2 = σ2"
apply (induct expr and prts)
apply (induct rule: typing_collection_parts_typing.inducts)
The following questions contains a very simple examples:
How to prove lemmas for mutually recursive types?
How to fix "Illegal schematic variable(s)" in mutually recursive rule induction?
But my example is more complicated. And I can't understand what's wrong with my datatypes, predicates or lemmas. This exact theory can be reformulated without mutual recursion. But it's just a small fragment of my actual theory.
There exists a plausible solution that is similar to the one provided in the accepted answer to your previous question. Please note that I changed some of the names of some of the elements in your definitions and that I relied heavily on sledgehammer to bring the proof to a conclusion.
datatype 'a expr =
Literal "'a literal_expr"
| Var "string"
and 'a literal_expr =
NL
| CL "'a clpe list"
and 'a clpe = CI "'a expr"
datatype 'a type = OclVoid | Set "'a type"
inductive typing and cpt where
"typing Γ (Literal NL) OclVoid"
| "cpt Γ prts τ ⟹ typing Γ (Literal (CL prts)) (Set τ)"
| "cpt Γ [] OclVoid"
| "⟦typing Γ a τ; cpt Γ xs σ⟧ ⟹ cpt Γ (CI a # xs) σ"
lemma
fixes Γ1 Γ2 :: 'a
and expr :: "'b expr"
and prts :: "'b clpe list"
and σ1 τ1 σ2 τ2 :: "'c type"
shows
"typing Γ1 expr τ1 ⟹ typing Γ1 expr σ1 ⟹ τ1 = σ1" and
"cpt Γ2 prts τ2 ⟹ cpt Γ2 prts σ2 ⟹ τ2 = σ2"
apply(
induction Γ1 expr τ1 and Γ2 prts τ2
arbitrary: σ1 and σ2
rule: typing_cpt.inducts
)
subgoal by (blast dest: typing.cases)
subgoal
by (metis
expr.inject(1)
literal_expr.distinct(1)
literal_expr.inject
typing.cases)
subgoal by (blast dest: cpt.cases)
subgoal by (metis cpt.cases list.discI list.sel(3))
done
Isabelle version: Isabelle2020
I've written some simple parser combinators (without backtracking etc.). Here are the important definitions for my problem.
type_synonym ('a, 's) parser = "'s list ⇒ ('a * 's list) option"
definition sequenceP :: "('a, 's) parser
⇒ ('b, 's) parser
⇒ ('b, 's) parser" (infixl ">>P" 60) where
"sequenceP p q ≡ λ i .
(case p i of
None ⇒ None
| Some v ⇒ q (snd v))"
definition consumerP :: "('a, 's) parser ⇒ bool" where
"consumerP p ≡ (∀ i . (case p i of
None ⇒ True |
Some v ⇒ length (snd v) ≤ length i))"
I do want to proof the following lemma.
lemma consumerPI: "consumerP p ⟹ consumerP q ⟹ consumerP (p >>P q)"
apply (unfold sequenceP_def)
apply (simp (no_asm) add:consumerP_def)
apply clarsimp
apply (case_tac "case p i of None ⇒ None | Some v ⇒ q (snd v)")
apply simp
apply clarsimp
apply (case_tac "p i")
apply simp
apply clarsimp
apply (unfold consumerP_def)
I arrive at this proof state, at which I fail to continue.
goal (1 subgoal):
1. ⋀i a b aa ba.
⟦∀i. case p i of None ⇒ True | Some v ⇒ length (snd v) ≤ length i;
∀i. case q i of None ⇒ True | Some v ⇒ length (snd v) ≤ length i; q ba = Some (a, b); p i = Some (aa, ba)⟧
⟹ length b ≤ length i
Can anybody give me a tip how to solve this goal?
Thanks in advance!
It turns out that if you just want to prove the lemma, without further insight, then
lemma consumerPI: "consumerP p ⟹ consumerP q ⟹ consumerP (p >>P q)"
by (smt consumerP_def le_trans option.case_eq_if sequenceP_def)
does the job.
If you want to have insight, you want to go for a structured proof. First identify some useful lemmas about consumerP, and then write a Isar proof that details the necessary steps.
lemma consumerPI[intro!]:
assumes "⋀ i x r . p i = Some (x,r) ⟹ length r ≤ length i"
shows "consumerP p"
unfolding consumerP_def by (auto split: option.split elim: assms)
lemma consumerPE[elim, consumes 1]:
assumes "consumerP p"
assumes "p i = Some (x,r)"
shows "length r ≤ length i"
using assms by (auto simp add: consumerP_def split: option.split_asm)
lemma consumerP_sequencePI: "consumerP p ⟹ consumerP q ⟹ consumerP (p >>P q)"
proof-
assume "consumerP p"
assume "consumerP q"
show "consumerP (p >>P q)"
proof(rule consumerPI)
fix i x r
assume "(p >>P q) i = Some (x, r)"
then obtain x' r' where "p i = Some (x', r')" and "q r' = Some (x,r)"
by (auto simp add: sequenceP_def split:option.split_asm)
from `consumerP q` and `q r' = Some (x, r)`
have "length r ≤ length r'" by (rule consumerPE)
also
from `consumerP p` and `p i = Some (x', r')`
have "length r' ≤ length i" by (rule consumerPE)
finally
show "length r ≤ length i".
qed
qed
In fact, for this definition you can very nicely use the inductive command, and get intro and elim rules for free:
inductive consumerP where
consumerPI: "(⋀ i x r . p i = Some (x,r) ⟹ length r ≤ length i) ⟹ consumerP p"
In the above proof, you can replace by (rule consumerPE) by by cases and it works.
I'm having difficulty convincing Agda to termination-check the function fmap below and similar functions defined recursively over the structure of a Trie. A Trie is a trie whose domain is a Type, an object-level type formed from unit, products and fixed points (I've omitted coproducts to keep the code minimal). The problem seems to relate to a type-level substitution I use in the definition of Trie. (The expression const (μₜ τ) * τ means apply the substitution const (μₜ τ) to the type τ.)
module Temp where
open import Data.Unit
open import Category.Functor
open import Function
open import Level
open import Relation.Binary
-- A context is just a snoc-list.
data Cxt {𝒂} (A : Set 𝒂) : Set 𝒂 where
ε : Cxt A
_∷ᵣ_ : Cxt A → A → Cxt A
-- Context membership.
data _∈_ {𝒂} {A : Set 𝒂} (a : A) : Cxt A → Set 𝒂 where
here : ∀ {Δ} → a ∈ Δ ∷ᵣ a
there : ∀ {Δ a′} → a ∈ Δ → a ∈ Δ ∷ᵣ a′
infix 3 _∈_
-- Well-formed types, using de Bruijn indices.
data _⊦ (Δ : Cxt ⊤) : Set where
nat : Δ ⊦
𝟏 : Δ ⊦
var : _ ∈ Δ → Δ ⊦
_+_ _⨰_ : Δ ⊦ → Δ ⊦ → Δ ⊦
μ : Δ ∷ᵣ _ ⊦ → Δ ⊦
infix 3 _⊦
-- A closed type.
Type : Set
Type = ε ⊦
-- Type-level substitutions and renamings.
Sub Ren : Rel (Cxt ⊤) zero
Sub Δ Δ′ = _ ∈ Δ → Δ′ ⊦
Ren Δ Δ′ = ∀ {x} → x ∈ Δ → x ∈ Δ′
-- Renaming extension.
extendᵣ : ∀ {Δ Δ′} → Ren Δ Δ′ → Ren (Δ ∷ᵣ _) (Δ′ ∷ᵣ _)
extendᵣ ρ here = here
extendᵣ ρ (there x) = there (ρ x)
-- Lift a type renaming to a type.
_*ᵣ_ : ∀ {Δ Δ′} → Ren Δ Δ′ → Δ ⊦ → Δ′ ⊦
_ *ᵣ nat = nat
_ *ᵣ 𝟏 = 𝟏
ρ *ᵣ (var x) = var (ρ x)
ρ *ᵣ (τ₁ + τ₂) = (ρ *ᵣ τ₁) + (ρ *ᵣ τ₂)
ρ *ᵣ (τ₁ ⨰ τ₂) = (ρ *ᵣ τ₁) ⨰ (ρ *ᵣ τ₂)
ρ *ᵣ (μ τ) = μ (extendᵣ ρ *ᵣ τ)
-- Substitution extension.
extend : ∀ {Δ Δ′} → Sub Δ Δ′ → Sub (Δ ∷ᵣ _) (Δ′ ∷ᵣ _)
extend θ here = var here
extend θ (there x) = there *ᵣ (θ x)
-- Lift a type substitution to a type.
_*_ : ∀ {Δ Δ′} → Sub Δ Δ′ → Δ ⊦ → Δ′ ⊦
θ * nat = nat
θ * 𝟏 = 𝟏
θ * var x = θ x
θ * (τ₁ + τ₂) = (θ * τ₁) + (θ * τ₂)
θ * (τ₁ ⨰ τ₂) = (θ * τ₁) ⨰ (θ * τ₂)
θ * μ τ = μ (extend θ * τ)
data Trie {𝒂} (A : Set 𝒂) : Type → Set 𝒂 where
〈〉 : A → 𝟏 ▷ A
〔_,_〕 : ∀ {τ₁ τ₂} → τ₁ ▷ A → τ₂ ▷ A → τ₁ + τ₂ ▷ A
↑_ : ∀ {τ₁ τ₂} → τ₁ ▷ τ₂ ▷ A → τ₁ ⨰ τ₂ ▷ A
roll : ∀ {τ} → (const (μ τ) * τ) ▷ A → μ τ ▷ A
infixr 5 Trie
syntax Trie A τ = τ ▷ A
{-# NO_TERMINATION_CHECK #-}
fmap : ∀ {a} {A B : Set a} {τ} → (A → B) → τ ▷ A → τ ▷ B
fmap f (〈〉 x) = 〈〉 (f x)
fmap f 〔 σ₁ , σ₂ 〕 = 〔 fmap f σ₁ , fmap f σ₂ 〕
fmap f (↑ σ) = ↑ (fmap (fmap f) σ)
fmap f (roll σ) = roll (fmap f σ)
It would seem that fmap recurses into a strictly smaller argument in each case; certainly the product case is fine if I remove recursive types. On the other hand, the definition handles recursive types fine if I remove products.
What's the simplest way to proceed here? The inline/fuse trick does not look particularly applicable, but maybe it is. Or should I be looking for another way to deal with the substitution in the definition of Trie?
The inline/fuse trick can be applied in (perhaps) surprising way. This trick is suited for problems of this sort:
data Trie (A : Set) : Set where
nil : Trie A
node : A → List (Trie A) → Trie A
map-trie : {A B : Set} → (A → B) → Trie A → Trie B
map-trie f nil = nil
map-trie f (node x xs) = node (f x) (map (map-trie f) xs)
This function is structurally recursive, but in a hidden way. map just applies map-trie f to the elements of xs, so map-trie gets applied to smaller (sub-)tries. But Agda doesn't look through the definition of map to see that it doesn't do anything funky. So we must apply the inline/fuse trick to get it past termination checker:
map-trie : {A B : Set} → (A → B) → Trie A → Trie B
map-trie f nil = nil
map-trie {A} {B} f (node x xs) = node (f x) (map′ xs)
where
map′ : List (Trie A) → List (Trie B)
map′ [] = []
map′ (x ∷ xs) = map-trie f x ∷ map′ xs
Your fmap function shares the same structure, you map a lifted function of some sort. But what to inline? If we follow the example above, we should inline fmap itself. This looks and feels a bit strange, but indeed, it works:
fmap fmap′ : ∀ {a} {A B : Set a} {τ} → (A → B) → τ ▷ A → τ ▷ B
fmap f (〈〉 x) = 〈〉 (f x)
fmap f 〔 σ₁ , σ₂ 〕 = 〔 fmap f σ₁ , fmap f σ₂ 〕
fmap f (↑ σ) = ↑ (fmap (fmap′ f) σ)
fmap f (roll σ) = roll (fmap f σ)
fmap′ f (〈〉 x) = 〈〉 (f x)
fmap′ f 〔 σ₁ , σ₂ 〕 = 〔 fmap′ f σ₁ , fmap′ f σ₂ 〕
fmap′ f (↑ σ) = ↑ (fmap′ (fmap f) σ)
fmap′ f (roll σ) = roll (fmap′ f σ)
There's another technique you can apply: it's called sized types. Instead of relying on the compiler to figure out when somethig is or is not structurally recursive, you instead specify it directly. However, you have to index your data types by a Size type, so this approach is fairly intrusive and cannot be applied to already existing types, but I think it is worth mentioning.
In its simplest form, sized type behaves as a type indexed by a natural number. This index specifies the upper bound of structural size. You can think of this as an upper bound for the height of a tree (given that the data type is an F-branching tree for some functor F). Sized version of List looks almost like a Vec, for example:
data SizedList (A : Set) : ℕ → Set where
[] : ∀ {n} → SizedList A n
_∷_ : ∀ {n} → A → SizedList A n → SizedList A (suc n)
But sized types add few features that make them easier to use. You have a constant ∞ for the case when you don't care about the size. suc is called ↑ and Agda implements few rules, such as ↑ ∞ = ∞.
Let's rewrite the Trie example to use sized types. We need a pragma at the top of the file and one import:
{-# OPTIONS --sized-types #-}
open import Size
And here's the modified data type:
data Trie (A : Set) : {i : Size} → Set where
nil : ∀ {i} → Trie A {↑ i}
node : ∀ {i} → A → List (Trie A {i}) → Trie A {↑ i}
If you leave the map-trie function as is, the termination checker is still going to complain. That's because when you don't specify any size, Agda will fill in infinity (i.e. don't-care value) and we are back at the beginning.
However, we can mark map-trie as size-preserving:
map-trie : ∀ {i A B} → (A → B) → Trie A {i} → Trie B {i}
map-trie f nil = nil
map-trie f (node x xs) = node (f x) (map (map-trie f) xs)
So, if you give it a Trie bounded by i, it will give you another Trie bounded by i as well. So map-trie can never make the Trie larger, only equally large or smaller. This is enough for the termination checker to figure out that map (map-trie f) xs is okay.
This technique can also be applied to your Trie:
open import Size
renaming (↑_ to ^_)
data Trie {𝒂} (A : Set 𝒂) : {i : Size} → Type → Set 𝒂 where
〈〉 : ∀ {i} → A →
Trie A {^ i} 𝟏
〔_,_〕 : ∀ {i τ₁ τ₂} → Trie A {i} τ₁ → Trie A {i} τ₂ →
Trie A {^ i} (τ₁ + τ₂)
↑_ : ∀ {i τ₁ τ₂} → Trie (Trie A {i} τ₂) {i} τ₁ →
Trie A {^ i} (τ₁ ⨰ τ₂)
roll : ∀ {i τ} → Trie A {i} (const (μ τ) * τ) →
Trie A {^ i} (μ τ)
infixr 5 Trie
syntax Trie A τ = τ ▷ A
fmap : ∀ {i 𝒂} {A B : Set 𝒂} {τ} → (A → B) → Trie A {i} τ → Trie B {i} τ
fmap f (〈〉 x) = 〈〉 (f x)
fmap f 〔 σ₁ , σ₂ 〕 = 〔 fmap f σ₁ , fmap f σ₂ 〕
fmap f (↑ σ) = ↑ fmap (fmap f) σ
fmap f (roll σ) = roll (fmap f σ)