The following encoding of Nats is used in some Cedille sources:
cNat : ★
cNat = ∀ X : ★ . X ➔ (∀ R : ★ . (R ➔ X) ➔ R ➔ X) ➔ X
cZ : cNat
cZ = Λ X . λ z . λ s . z
cS : ∀ A : ★ . (A ➔ cNat) ➔ A ➔ cNat
cS = Λ A . λ e . λ d . Λ X . λ z . λ s . s · A (λ a . e a · X z s) d
I wonder if this is a common encoding used in other languages (Agda, Idris, Coq). If so, how can I interpret it, how it works, and how can I construct members of this type?
I've tried applying cS as in:
c0 = cZ
c1 = (cS -CNat (λ p : CNat . p) C0)
c2 = (cS -CNat (λ p : CNat . p) C1)
c3 = (cS -CNat (λ p : CNat . p) C2)
Which checks, but looks rather weird to me. p could be replaced by any cNat inside lambdas, for example. This doesn't look isomorphic to cNat to me. I guess I don't get this structure.
Edit by JC (too long for a comment, isn't an answer at all). For those who want to experiment, here's an Agda rendering.
module Mendler where
open import Level renaming (suc to lsuc)
open import Data.Nat
cNat : (ℓ : Level) → Set (lsuc ℓ)
cNat ℓ = (X : Set ℓ) → X → ((R : Set ℓ) → (R → X) → R → X) → X
private
variable
ℓ : Level
cZ : cNat ℓ
cZ X z s = z
cS : (A : Set ℓ) → (A → cNat ℓ) → A → cNat ℓ
cS A e d X z s = s A (λ a → e a X z s) d
c0 : cNat 0ℓ
c0 = cZ
c1 : cNat 0ℓ
c1 = cS ℕ (λ _ → c0) 0
Related
Two proofs at the end of chapter 3 in the LEAN tutorial that I still struggle with (and hence prevent me from going further with reading the manual) are the following:
theorem T11 : ¬(p ↔ ¬p) := sorry
for which my attempt to prove the right implication stopped at this point:
theorem T11R : ¬(p → ¬p) :=
begin
assume hyp : p → ¬ p,
cases (em p) with hp hnp,
exact (hyp hp) hp,
exact sorry
end
as obviously I don't know yet how to make use of ¬p. Not sure how to show the left implication either. The other one is this:
theorem T2R : ((p ∨ q) → r) → (p → r) ∧ (q → r) :=
begin
intros porqr, sorry
end
which I'm supposedly using (as the right implication) to show the following:
theorem T2 : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
begin
have goR : ((p ∨ q) → r) → (p → r) ∧ (q → r), from T2R p q r,
have goL : (p → r) ∧ (q → r) → ((p ∨ q) → r), from T2L p q r,
exact iff.intro (goR) (goL)
end
Here I got the left-side going:
theorem T2L : (p → r) ∧ (q → r) → ((p ∨ q) → r) :=
begin
intros prqr,
assume porq : p ∨ q,
exact or.elim porq prqr.left prqr.right
end
theorem T11R is not true, for example if p is false then p → ¬ p is true.
¬(p ↔ ¬p) is not equivalent to (¬ (p → ¬ p)) ∧ ¬ (¬ p → p); it's equivalent to ¬ ((p → ¬ p) ∧ (¬ p → p)), which is different.
For theorem T2R if you use the split tactic, it will give you two goals, one for each side of the and. You can use the left and right tactics to turn the goal p ∨ q into either p or q. The theorems or.inl and or.inr can be used to prove an or as well.
Here's a proof of T2R
theorem T2R : ((p ∨ q) → r) → (p → r) ∧ (q → r) :=
begin
intros porqr,
split,
{ assume hp : p,
apply porqr,
left,
exact hp },
{ assume hq : q,
apply porqr,
right,
exact hq },
end
Is a homomorphism between two groups proper? Here are my definitions for groups and homomorphisms:
Definition associative {ty : Type} (f : ty -> ty -> ty) (eq : ty -> ty -> Prop) :=
forall a b c, eq (f (f a b) c) (f a (f b c)).
Definition identity {ty : Type} (f : ty -> ty -> ty) (eq : ty -> ty -> Prop) (e : ty) :=
forall a, eq (f a e) a /\ eq (f e a) a.
Definition op_inverse {ty : Type} (f : ty -> ty -> ty) (eq : ty -> ty -> Prop) (e a a' : ty) :=
eq (f a a') e /\ eq (f a' a) e.
Definition op_invertible {ty : Type} (f : ty -> ty -> ty) (eq : ty -> ty -> Prop) (e : ty) :=
forall a, exists a', op_inverse f eq e a a'.
Record Group : Type := Group'
{ ty :> Type
; op : ty -> ty -> ty
; eqr : ty -> ty -> Prop
; e : ty
; eq_rel :> Equivalence eqr
; prop_op :> Proper (eqr ==> eqr ==> eqr) op
; assoc_op : associative op eqr
; id_op : identity op eqr e
; inv_op : op_invertible op eqr e
}.
Notation "A <.> B" := ((op _) A B) (at level 50).
Notation "A =.= B" := ((eqr _) A B) (at level 50).
Definition homomorphism {G H : Group} (f : G -> H) :=
forall x y, f (x <.> y) =.= (f x <.> f y).
I want to prove:
Lemma homo_is_proper : forall {G H : Group} (f : ty G -> ty H),
homomorphism f -> Proper (eqr G ==> eqr H) f.
Is this necessarily true?
It's not true.
Let H be a non-trivial group (e.g., Z/2Z), define G as the quotient of H under the total relation eqr := fun _ _ => True (G is thus isomorphic to the trivial group), and f : ty G -> ty H is the identity function. f satisfies homomorphism but it's not proper.
In general, to reflect common mathematical practice, when working with setoids, properness is a basic fact that must be proved from first principles, and that the rest of a theory rests upon. Arguably, homo_is_proper is not a natural question to ask, because all theorems and properties (such as homomorphism) should really be parameterized only by proper functions in the first place.
For the purpose of a script I would like to query the agda compiler about the definition of a function in an agda source file. I would like to ask the question: does the function named by X rely on a hole, or not? (i.e. is it a "completed proof", or is it a "proof in progress"). Where X is the name of the function in the source file.
For example, take the following example source file:
open import Relation.Binary.PropositionalEquality
postulate
A : Set
x : A
y : A
z : A
q1 : x ≡ y
q2 : y ≡ z
pf1 : x ≡ z
pf1 = trans q1 q2
pf2 : z ≡ x
pf2 rewrite q1 | q2 = refl
I would like to be able to determine (in my script), does pf2 rely on any holes? In this case the answer is no.
Alternatively, suppose that file were something like:
open import Relation.Binary.PropositionalEquality
postulate
A : Set
x : A
y : A
z : A
q1 : x ≡ y
q2 : y ≡ z
pf1 : x ≡ z
pf1 = trans q1 q2
lemma1 : z ≡ y
lemma1 = {!!}
pf2 : z ≡ x
pf2 rewrite q1 = lemma1
Now the answer to the question posed above is "yes": pf2 is incomplete because it relies on a hole (indirectly, through lemma1).
I know that I can find out the answer to the question: are there any functions in this agda source file that rely on holes. When we run the agda compiler on a source file, the return status will be 1 if there are "unsolved interaction metas", and the status will be 0 if everything is completed. However I would like to know the granular information of whether a particular function (by name) within a source file has "unsolved interaction metas".
Is there any way to do this?
I looked through the source code for the interaction mode of agda (the interface used by the agda-mode emacs code), but it seems most of the commands defined for the interaction mode rely on character ranges rather than symbols, so I haven't found a way to get this information from interaction mode.
EDIT: based on user3237465's comment, I looked into using reflection to solve this issue. It seems like it could work but there is an issue with rewrites. For example, suppose we have the following file loaded in emacs:
open import Relation.Binary.PropositionalEquality
open import Agda.Builtin.Reflection
postulate
A : Set
x : A
y : A
z : A
q1 : x ≡ y
q2 : y ≡ z
pf1 : x ≡ z
pf1 = trans q1 q2
lemma1 : z ≡ y
lemma1 = {!!}
pf2 : z ≡ x
pf2 rewrite q1 = lemma1
pf3 : z ≡ x
pf3 = trans lemma1 (sym q1)
-- user3237465 suggested this macro.
-- unfortunately, normalizing `test`
-- using this macro still doesn't show
-- information about the contents of
-- lemma1
macro
actualQuote : Term -> Term -> TC _
actualQuote term hole =
bindTC (normalise term) λ nterm ->
bindTC (quoteTC nterm) (unify hole)
test = actualQuote pf2
test2 = actualQuote pf3
test3 = actualQuote pf1
If I type C-c C-n and enter quoteTC pf3, it outputs quoteTC (trans ?0 (sym q1)). This is what I wanted because it indicates that a the proof depends on a hole.
On the other hand, if I type C-c C-n and enter quoteTC pf2, it outputs quoteTC (pf2 | x | q1). So it appears that the normalization process can't see past a rewrite.
Does anyone know if there is a way around this?
EDIT2: the normalization of pf2 using user3237465's macro is:
def (quote .test4.rewrite-20)
(arg (arg-info visible relevant)
(def (quote x) .Agda.Builtin.List.List.[])
.Agda.Builtin.List.List.∷
arg (arg-info visible relevant)
(def (quote q1) .Agda.Builtin.List.List.[])
.Agda.Builtin.List.List.∷ .Agda.Builtin.List.List.[])
This answer is about using reflection to solve the problem.
The thing missing from your attempt is using getDefinition to look inside defined functions.
Here's a complete example using agda-prelude (https://github.com/UlfNorell/agda-prelude) because I don't have time to figure out to do this with the standard library (exercise for the reader).
open import Prelude
open import Tactic.Reflection
open import Control.Monad.State
open import Container.Traversable
We need to keep track of which names we have already looked inside to avoid looping on recursive functions, so let's use a state monad.
M = StateT (List Name) TC
runM : {A : Set} → M A → TC A
runM m = fst <$> runStateT m []
isVisited : Name → M Bool
isVisited x = gets (elem x)
setVisited : Name → M ⊤
setVisited x = _ <$ modify (x ∷_)
anyM : {A : Set} → (A → M Bool) → List A → M Bool
anyM p xs = foldr _||_ false <$> traverse p xs
Unfortunately we're not going to be able to convince the termination checker that there can only be a finite number of defined functions, so let's cheat. The no-cheat option would be to set a depth limit and return true (or dont-know) if we run out of depth.
{-# TERMINATING #-}
anyMetas : Term → M Bool
checkClause : Clause → M Bool
checkClause (clause ps t) = anyMetas t
checkClause (absurd-clause ps) = return false
checkName : Name → M Bool
checkName f = do
false ← isVisited f
where true → return false
function cs ← lift (getDefinition f)
where _ → return false
anyM checkClause cs
I couldn't resist using do-notation for checkName since it makes the code so much nicer. If you're not building the latest Agda from github, you can use the commented code:
-- caseM isVisited f of λ where
-- true → return false
-- false → setVisited f >>
-- (caseM lift (getDefinition f) of λ where
-- (function cs) → anyM checkClause cs
-- _ → return false)
anyMetaArgs = anyM (anyMetas ∘ unArg)
checkSort : Sort → M Bool
checkSort (set t) = anyMetas t
checkSort (lit n) = return false
checkSort unknown = return false
anyMetas (var x args) = anyMetaArgs args
anyMetas (con c args) = anyMetaArgs args
anyMetas (def f args) = (| checkName f || anyMetaArgs args |)
anyMetas (lam v t) = anyMetas (unAbs t)
anyMetas (pat-lam cs args) = (| anyM checkClause cs || anyMetaArgs args |)
anyMetas (pi a b) = (| anyMetas (unArg a) || anyMetas (unAbs b) |)
anyMetas (agda-sort s) = checkSort s
anyMetas (lit l) = return false
anyMetas (meta x x₁) = return true
anyMetas unknown = return false
With the anyMetas function we can define a macro taking a name and returning a boolean indicating if the name depends on a meta.
macro
dependsOnMeta? : Name → Term → TC ⊤
dependsOnMeta? x hole = unify hole =<< quoteTC =<< runM (anyMetas (def x []))
Your test case now goes through
postulate
A : Set
x : A
y : A
z : A
q1 : x ≡ y
q2 : y ≡ z
pf1 : x ≡ z
pf1 = trans q1 q2
lemma1 : z ≡ y
lemma1 = {!!}
pf2 : z ≡ x
pf2 rewrite q1 = lemma1
pf3 : z ≡ x
pf3 = trans lemma1 (sym q1)
test1 : dependsOnMeta? pf1 ≡ false
test1 = refl
test2 : dependsOnMeta? pf2 ≡ true
test2 = refl
test3 : dependsOnMeta? pf3 ≡ true
test3 = refl
I am trying to prove something simple:
open import Data.List
open import Data.Nat
open import Data.Bool
open import Data.Bool.Properties
open import Relation.Binary.PropositionalEquality
open import Data.Unit
repeat : ∀ {a} {A : Set a} → ℕ → A → List A
repeat zero x = []
repeat (suc n) x = x ∷ repeat n x
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
I thought proving filter-repeat is going to be easy by pattern matching on p x:
filter-repeat p x prf zero = refl
filter-repeat p x prf (suc n) with p x
filter-repeat p x () (suc n) | false
filter-repeat p x prf (suc n) | true = cong (_∷_ x) (filter-repeat p x prf n)
However this complains that prf : ⊤ is not of type T (p x). So I thought, OK, this seems like a familiar problem, let's whip out inspect:
filter-repeat p x prf zero = refl
filter-repeat p x prf (suc n) with p x | inspect p x
filter-repeat p x () (suc n) | false | _
filter-repeat p x tt (suc n) | true | [ eq ] rewrite eq = cong (_∷_ x) (filter-repeat p x {!!} n)
but despite the rewrite, the type of the hole is still T (p x) instead of T true. Why is that? How do I reduce its type to T true so I can fill it with tt?
Workaround
I was able to work around it by using T-≡:
open import Function.Equality using (_⟨$⟩_)
open import Function.Equivalence
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x prf zero = refl
filter-repeat p x prf (suc n) with p x | inspect p x
filter-repeat p x () (suc n) | false | _
filter-repeat p x tt (suc n) | true | [ eq ] = cong (_∷_ x) (filter-repeat p x (Equivalence.from T-≡ ⟨$⟩ eq) n)
but I would still like to understand why the inspect-based solution doesn't work.
As András Kovács says the inductive case requires prf to be of type T (p x) while you've already changed it to just ⊤ by pattern matching on p x. One simple solution is just to call filter-repeat recursively before pattern matching on p x:
open import Data.Empty
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x prf 0 = refl
filter-repeat p x prf (suc n) with filter-repeat p x prf n | p x
... | r | true = cong (x ∷_) r
... | r | false = ⊥-elim prf
It also can sometimes be useful to use the protect pattern:
data Protect {a} {A : Set a} : A → Set where
protect : ∀ x → Protect x
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x q 0 = refl
filter-repeat p x q (suc n) with protect q | p x | inspect p x
... | _ | true | [ _ ] = cong (x ∷_) (filter-repeat p x q n)
... | _ | false | [ r ] = ⊥-elim (subst T r q)
protect q saves the type of q from being rewritten, but it also means that in the false case the type of q is still T (p x) rather than ⊥, hence the additional inspect.
Another variant of the same idea is
module _ {a} {A : Set a} (p : A → Bool) (x : A) (prf : T (p x)) where
filter-repeat : ∀ n → filter p (repeat n x) ≡ repeat n x
filter-repeat 0 = refl
filter-repeat (suc n) with p x | inspect p x
... | true | [ r ] = cong (x ∷_) (filter-repeat n)
... | false | [ r ] = ⊥-elim (subst T r prf)
module _ ... (prf : T (p x)) where prevents the type of prf from being rewritten as well.
Dependent pattern matching only affects the goal and the context at the exact point of their use. Matching on p xrewrites the current context and reduces the type of prf to ⊤ in the true branch.
However, when you do the recursive filter-repeat call, you once again supply x as argument there, and T (p x) in filter-repeat depends on that x, not the old one in the outer context, even though they're definitionally equal. We could've passed something other than x, hypothetically, so no assumption can be made about it before the filter-repeat call.
x can be made invariant in the context by factoring it out from the induction:
open import Data.Empty
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x prf = go where
go : ∀ n → filter p (repeat n x) ≡ repeat n x
go zero = refl
go (suc n) with p x | inspect p x
go (suc n) | true | [ eq ] = cong (_∷_ x) (go n)
go (suc n) | false | [ eq ] = ⊥-elim (subst T eq prf)
It has been stated a few places that all agda programs terminate. However I can construct a function like this:
stall : ∀ n → ℕ
stall 0 = 0
stall x = stall x
The syntax highlighter doesn't seem to like it, but there are no compilation errors.
Computing the normal form of stall 0 results in 0. Computing the result of stall 1 causes Emacs to hang in what looks a lot like a non-terminating loop.
Is this a bug? Or can Agda sometimes run forever? Or is something more subtle going on?
In fact, there are compilation errors. The agda executable finds an error and passes that information to agda-mode in Emacs, which in turn does the syntax highlighting to let you know there was an error. We can take a look at what happens if we use agda directly. Here's the file I'm using:
module C1 where
open import Data.Nat
loop : ℕ → ℕ
loop 0 = 0
loop x = loop x
Now, we call agda -i../lib-0.7/src -i. C1.agda (don't mind the -i parameters, they just let the executable know where to look for the standard library) and we get the error:
Termination checking failed for the following functions:
loop
Problematic calls:
loop x
(at D:\Agda\tc\C1.agda:7,10-14)
This is indeed compilation error. Such errors prevent us from importing this module from other modules or compiling it. For example, if we add these lines to the file above:
open import IO
main = run (putStrLn "")
And compile the module using C-c C-x C-c, agda-mode complains:
You can only compile modules without unsolved metavariables
or termination checking problems.
Other kinds of compilation errors include type checking problems:
module C2 where
open import Data.Bool
open import Data.Nat
type-error : ℕ → Bool
type-error n = n
__________________________
D:\Agda\tc\C2.agda:7,16-17
ℕ !=< Bool of type Set
when checking that the expression n has type Bool
Failed positivity check:
module C3 where
data Positivity : Set where
bad : (Positivity → Positivity) → Positivity
__________________________
D:\Agda\tc\C3.agda:3,6-16
Positivity is not strictly positive, because it occurs to the left
of an arrow in the type of the constructor bad in the definition of
Positivity.
Or unsolved metavariables:
module C4 where
open import Data.Nat
meta : ∀ {a} → ℕ
meta = 0
__________________________
Unsolved metas at the following locations:
D:\Agda\tc\C4.agda:5,11-12
Now, you rightly noticed that some errors are "dead ends", while others let you carry on writing your program. That's because some errors are worse than others. For example, if you get unsolved metavariable, chances are that you'll be able to just fill in the missing information and everything will be okay.
As for hanging the compiler: checking or compiling a module shouldn't cause agda to loop. Let's try to force the type checker to loop. We'll add more stuff into the module C1:
data _≡_ {a} {A : Set a} (x : A) : A → Set a where
refl : x ≡ x
test : loop 1 ≡ 1
test = refl
Now, to check that refl is correct expression of that type, agda has to evaluate loop 1. However, since the termination check failed, agda will not unroll loop (and end up in an infinite loop).
However, C-c C-n really forces agda to try to evaluate the expression (you basically tell it "I know what I'm doing"), so naturally you get into an infinite loop.
Incidentally, you can make agda loop if you disable the termination check:
{-# NO_TERMINATION_CHECK #-}
loop : ℕ → ℕ
loop 0 = 0
loop x = loop x
data _≡_ {a} {A : Set a} (x : A) : A → Set a where
refl : x ≡ x
test : loop 1 ≡ 1
test = refl
Which ends up in:
stack overflow
As a rule of thumb: if you can make agda loop by checking (or compiling) a module without using any compiler pragmas, then this is indeed a bug and should be reported on the bug tracker. That being said, there are few ways to make non-terminating program if you are willing to use compiler pragmas. We've already seen {-# NO_TERMINATION_CHECK #-}, here are some other ways:
{-# OPTIONS --no-positivity-check #-}
module Boom where
data Bad (A : Set) : Set where
bad : (Bad A → A) → Bad A
unBad : {A : Set} → Bad A → Bad A → A
unBad (bad f) = f
fix : {A : Set} → (A → A) → A
fix f = (λ x → f (unBad x x)) (bad λ x → f (unBad x x))
loop : {A : Set} → A
loop = fix λ x → x
This one relies on a data type which is not strictly positive. Or we could force agda to accept Set : Set (that is, the type of Set is Set itself) and reconstruct Russell's paradox:
{-# OPTIONS --type-in-type #-}
module Boom where
open import Data.Empty
open import Data.Product
open import Relation.Binary.PropositionalEquality
data M : Set where
m : (I : Set) → (I → M) → M
_∈_ : M → M → Set
a ∈ m I f = Σ I λ i → a ≡ f i
_∉_ : M → M → Set
a ∉ b = (a ∈ b) → ⊥
-- Set of all sets that are not members of themselves.
R : M
R = m (Σ M λ a → a ∉ a) proj₁
-- If a set belongs to R, it does not contain itself.
lem₁ : ∀ {X} → X ∈ R → X ∉ X
lem₁ ((Y , Y∉Y) , refl) = Y∉Y
-- If a set does not contain itself, then it is in R.
lem₂ : ∀ {X} → X ∉ X → X ∈ R
lem₂ X∉X = (_ , X∉X) , refl
-- R does not contain itself.
lem₃ : R ∉ R
lem₃ R∈R = lem₁ R∈R R∈R
-- But R also contains itself - a paradox.
lem₄ : R ∈ R
lem₄ = lem₂ lem₃
loop : {A : Set} → A
loop = ⊥-elim (lem₃ lem₄)
(source). We could also write a variant of Girard's paradox, simplified by A.J.C. Hurkens:
{-# OPTIONS --type-in-type #-}
module Boom where
⊥ = ∀ p → p
¬_ = λ A → A → ⊥
℘_ = λ A → A → Set
℘℘_ = λ A → ℘ ℘ A
U = (X : Set) → (℘℘ X → X) → ℘℘ X
τ : ℘℘ U → U
τ t = λ (X : Set) (f : ℘℘ X → X) (p : ℘ X) → t λ (x : U) → p (f (x X f))
σ : U → ℘℘ U
σ s = s U λ (t : ℘℘ U) → τ t
τσ : U → U
τσ x = τ (σ x)
Δ = λ (y : U) → ¬ (∀ (p : ℘ U) → σ y p → p (τσ y))
Ω = τ λ (p : ℘ U) → ∀ (x : U) → σ x p → p x
loop : (A : Set) → A
loop = (λ (₀ : ∀ (p : ℘ U) → (∀ (x : U) → σ x p → p x) → p Ω) →
(₀ Δ λ (x : U) (₂ : σ x Δ) (₃ : ∀ (p : ℘ U) → σ x p → p (τσ x)) →
(₃ Δ ₂ λ (p : ℘ U) → (₃ λ (y : U) → p (τσ y)))) λ (p : ℘ U) →
₀ λ (y : U) → p (τσ y)) λ (p : ℘ U) (₁ : ∀ (x : U) → σ x p → p x) →
₁ Ω λ (x : U) → ₁ (τσ x)
This one is a real mess, though. But it has a nice property that it uses only dependent functions. Strangely, it doesn't even get past type checking and causes agda to loop. Splitting the whole loop term into two helps.
The syntax highlighting you are seeing is a compile error. The termination checker's effect is to highlight non-terminating functions in a kind of pink-orange color ("salmon"). You may notice that a module containing such an error cannot be imported from other modules. It can also not be compiled down to Haskell.
So yes, Agda programs always terminate and this is not a bug.