I am trying to implement free monad transformer similar to the FreeT from haskell's "free" package, but I don't know how to write bind so that the termination checker doesn't complain. It seems to me that the recursive call's parameter p i should be smaller than the initial parameter, but I'm not sure if that's really true. Is it possible to implement bind with --safe agda?
{-# OPTIONS --without-K --safe #-}
module Test where
import Data.Container.Combinator as Cc
import Data.Container.Combinator.Properties as Ccp
import Function.Equality as Fun
import Function.Inverse as Fun
open import Data.Container.Core as C using (Container; ⟦_⟧)
open import Data.Container.Relation.Unary.Any using (any)
open import Data.Product using (_,_)
open import Data.Sum.Base using (inj₁; inj₂)
open import Data.W using (W; sup)
open import Effect.Monad using (RawMonad)
open import Function.Base using (_$_)
open import Level
module _ (M F : Container 0ℓ 0ℓ) ⦃ M-monad : RawMonad {f = 0ℓ} ⟦ M ⟧ ⦄ where
module M = RawMonad M-monad
module _ {A X : Set} where
private
∘-correct = Ccp.Composition.correct M (F Cc.⊎ Cc.const A) {X = X}
open Fun.Π (Fun.Inverse.to ∘-correct) public
using () renaming (_⟨$⟩_ to [c∘c]⇒c[c])
open Fun.Π (Fun.Inverse.from ∘-correct) public
using () renaming (_⟨$⟩_ to c[c]⇒[c∘c])
C : Set → Set
C A = W $ M Cc.∘ (F Cc.⊎ Cc.const A)
pure : ∀{A} → A → C A
pure x = sup $ c[c]⇒[c∘c] $ M.pure $ inj₂ x , λ ()
unsup : ∀{A} → C A → ⟦ M Cc.∘ (F Cc.⊎ Cc.const A) ⟧ (C A)
unsup (sup x) = x
bind : ∀{A B} → C A → (A → C B) → C B
bind {A}{B} (sup ca) f = sup $ c[c]⇒[c∘c] $ M.join $
M._<$>_ [c∘c]⇒c[c] $ [c∘c]⇒c[c] ca M.>>= λ where
(inj₁ a , p) → M.pure $ c[c]⇒[c∘c] $ M.pure $ inj₁ a , λ i → bind (p i) f
(inj₂ x , _) → M.pure $ unsup $ f x
The issue is that the implementation of bind is mixing iterating over the
structure and moving back and forth between isomorphic sets (the extension of the composite container vs. the composition of the containers' extensions). That reasoning modulo isos obscures the termination argument.
You can bypass that by separating the two. I implemented join because
it's more convenient. Most of the code is yours, the only insight is the
use of Data.W.foldr to fork off the iteration to a library function.
join : ∀{A} → C (C A) → C A
join = Data.W.foldr $ λ ca → sup $ c[c]⇒[c∘c]
$ M.join $ M._<$>_ [c∘c]⇒c[c] $ [c∘c]⇒c[c] ca M.>>= λ where
(inj₁ a , p) → M.pure $ c[c]⇒[c∘c] $ M.pure $ inj₁ a , p
(inj₂ ca , p) → M.pure $ unsup ca
Related
I am trying to prove decidable equality of a data type in Agda using the Agda stdlib. I have the following code, but I am unsure what to fill in the hole. The goal seems to make sense, but actually constructing it is challenging.
Is this possible in Agda and are there any ideas on how to solve this?
open import Data.String as String hiding (_≟_)
open import Relation.Nullary
open import Relation.Binary
open import Relation.Binary.PropositionalEquality
module Problem1 where
data Test : Set where
test : String → Test
infix 4 _≟_
_≟_ : Decidable {A = Test} _≡_
test x ≟ test x₁ with x String.≟ x₁
... | yes refl = yes refl
... | no ¬a = no {!!}
The hole:
Goal: ¬ test x ≡ test x₁
————————————————————————————————————————————————————————————
¬a : ¬ x ≡ x₁
x₁ : ℕ
x : ℕ
This is actually a one liner, relying on case splitting over the equality proof inside an anonymous function, as follows:
... | no ¬a = no λ {refl → ¬a refl}
I am not confident enough to try proving properties about the AVL tree that is there, so I want to try something simpler. I could implement it on my own, but do not want to spend time doing that if it is already hiding in the library somewhere.
You could use a list of pairs and the notion of membership can then be encoded via Any.
Bits of a very basic library:
open import Data.List.Base using (List)
open import Data.List.Relation.Unary.Any
open import Data.Maybe
open import Data.Product
open import Function
open import Relation.Binary
open import Relation.Binary.PropositionalEquality
open import Relation.Nullary
AssocList : Set → Set → Set
AssocList A B = List (A × B)
private
variable
A B : Set
_∈_ : A → AssocList A B → Set
a ∈ abs = Any ((a ≡_) ∘ proj₁) abs
module Decidable {A : Set} (_≟_ : Decidable {A = A} _≡_) where
_∈?_ : Decidable (_∈_ {A} {B})
a ∈? abs = any ((a ≟_) ∘ proj₁) abs
_‼_ : (abs : AssocList A B) (a : A) → Maybe B
abs ‼ a with a ∈? abs
... | yes p = just (proj₂ (lookup p))
... | no ¬p = nothing
In the following example
open import Agda.Builtin.Nat
open import Agda.Builtin.Equality
postulate
f : Nat → Nat
g : ∀{x y} → f x ≡ suc y → Nat
h : Nat → Nat
h x with f x
h x | zero = zero
h x | suc y = g {x} {y} {!refl!}
Agda doesn't accept refl for an argument.
The main questions are,
what am I doing wrong?
what is the correct/optimal/established/preferred way of proving stuff like this?
And of course any insights into Agda's behavior are greatly appreciated.
≡-Reasoning and 'with' patterns and Agda: type isn't simplified in with block should answer your questions. The official docs describe how to do what you want, but they don't seem to be too beginner-friendly.
Representing beta-equality in Agda
I've recently asked what is the proper way to represent beta-equality in a proof language such as Agda. The accepted answer points a standard way to do it is by defining its congruence closure,
data _~_ {n} : Tm n → Tm n → Set where
β : ∀ {t u} → app (lam t) u ~ sub u t
app : ∀ {t t' u u'} → t ~ t' → u ~ u' → app t u ~ app t' u'
lam : ∀ {t t'} → t ~ t' → lam t ~ lam t'
~refl : ∀ {t} → t ~ t
~sym : ∀ {t t'} → t ~ t' → t' ~ t
~trans : ∀ {t t' t''} → t ~ t' → t' ~ t'' → t ~ t''
Which, if I understand correctly, specifies that: 1. the application (λx.t u) is equal to t[u/x], 2. the function/argument of an application or the body of a function can be replaced by equal terms; 3. reflexivity, symmetry and transitivity hold. The answer also suggests an alternative: one can define a one-step reduction relation between terms, then define a multi-step reduction relation, and, finally, define that two terms are equal if they can be eventually reduced to an identical term. Both of those alternatives make sense.
Another alternative
While I was waiting for the answer, I was looking at this definition:
data _~_ : Term → Term → Set where
refl : (a : Term) → a ~ a
red₁ : (a b : Term) → (f : Term → Term) → f a ~ b → f (redex a) ~ b
red₂ : (a b : Term) → (f : Term → Term) → a ~ f b → a ~ f (redex b)
amp₁ : (a b : Term) → (f : Term → Term) → f (redex a) ~ b → f a ~ b
amp₂ : (a b : Term) → (f : Term → Term) → a ~ f (redex b) → a ~ f b
Where redex a applies a single substitution if a is a λ application. This says that terms are equivalent if they are identical, or if they can be made identical by reducing/de-reducing any of its sub-expressions. One can prove sym, trans, cong:
sym : (a : Term) -> (b : Term) -> a ~ b -> b ~ a
trans : (a : Term) → (b : Term) → (c : Term) → a ~ b → b ~ c → a ~ c
cong : (f : Term → Term) → (a : Term) → (b : Term) → a ~ b → f a ~ f b
The complete source is available here. Now, for curiosity sake, I'd like to know if the third solution is also a valid representation? If so, what is its relationship with the previous two? If not, why?
A minor problem with this attempt is that this relation is inconsistent:
oops : var 0 ~ var 1
oops = red₂
(var 0)
(app id id)
(λ { (lam typ (var 0)) -> var 1; t -> var 0 })
(refl (var zero))
Since we're able to use an arbitrary Agda function on b, then, as long as we have an a that reduces to b, we're able to separate them within Agda and substitute by arbitrary / non-equal values. Thanks pgiarrusso on #agda at Freenode IRC for pointing this.
I'm working in a simple library containing definitions and properties about substitutions for simple types. I'm using the following encoding for types:
data Ty (n : Nat) : Set where
var : Fin n -> Ty n
con : Ty n
app : Ty n -> Ty n -> Ty n
so, since variables are represented as finite sets, substitutions are just vectors:
Subst : Nat -> Nat -> Set
Subst n m = Vec (Ty m) n
The complete development is in the following paste: http://lpaste.net/107751
Using this encoding, I have defined several lemmas about such substitutions, but I do not know how to define a theorem that specifies that substitutions are idempotent. I believe that I must use some property like weakening in order to express this, but I can't figure out how.
Could someone give any directions or clues?
Thanks in advance.
Substitutions that produce expressions over fresh variables are indeed idempotent. But in order to express this theorem, you have to consider your substitution Subst n m as one operating on the joint variable set Subst (n + m) (n + m). Here is a variant that uses arbitrary variable sets A and B instead of Fin n and Fin m.
open import Relation.Binary.PropositionalEquality using (_≡_; refl)
-- Disjoint union.
data _+_ (A B : Set) : Set where
left : A → A + B
right : B → A + B
-- A set of variable names can be any type.
Names = Set
-- Simple expressions over a set of names.
data Tm (A : Names) : Set where
var : A → Tm A
app : Tm A → Tm A → Tm A
-- Substitute all variables from set A by terms over a name set B.
Subst : Names → Names → Set
Subst A B = A → Tm B
subst : ∀{A B} → Subst A B → Tm A → Tm B
subst σ (var x) = σ x
subst σ (app t u) = app (subst σ t) (subst σ u)
-- Rename all variables from set A to names from set B.
Rename : Names → Names → Set
Rename A B = A → B
rename : ∀{A B} → Rename A B → Tm A → Tm B
rename σ (var x) = var (σ x)
rename σ (app t u) = app (rename σ t) (rename σ u)
-- In order to speak about idempotency of substitutions whose domain A
-- is disjoint from the variable set B used in the range, we have to promote
-- them to work on the union A+B of variable sets.
-- The promoted substitution is the identity on B,
-- and the original substitution on A, but with the result transferred from B to A + B.
promote : ∀{A B} → Subst A B → Subst (A + B) (A + B)
promote σ (left x) = rename right (σ x)
promote σ (right x) = var (right x)
module _ {A B : Set} (σ₀ : Subst A B) where
-- Now assume a promoted substitution.
σ = promote σ₀
-- A promoted substitution has no effect on terms with variables only in B.
lemma : ∀ t → subst σ (rename right t) ≡ rename right t
lemma (var x) = refl
lemma (app t u) rewrite lemma t | lemma u = refl
-- Hence, it is idempotent.
idempotency : ∀ x → subst σ (σ x) ≡ σ x
idempotency (right x) = refl
idempotency (left x) = lemma (σ₀ x)