Is this a bug in Idris's type-checker (or unification)? - idris

The following snippet compiles fine in Idris 2,
divMod2 : Nat -> (Nat, Bool)
divMod2 Z = (Z, False)
divMod2 (S Z) = (Z, True)
divMod2 (S (S n)) = case divMod2 n of (k, r) => (S k, r)
lm : {q:_} -> divMod2 (q+q) = (q, False)
lm {q=0} = Refl
lm {q=S q} = rewrite sym $ plusSuccRightSucc q q in
rewrite lm {q} in Refl
but it caused Idris 1.3.4 to fail:
|
14 | rewrite lm {q} in Refl
| ~~~~~~
When checking right hand side of lm with expected type
divMod2 (S q + S q) = (S q, False)
When checking an application of function rewrite__impl:
Type mismatch between
(q1, False) = (q1, False) (Type of Refl)
and
case divMod2 (plus q q) of (k, r) => (S k, r) = (q1, False) (Expected type)
Specifically:
Type mismatch between
(q1, False)
and
case divMod2 (plus q q) of
(k, r) => (S k, r)
I know Idris 1 has become obsolete, but am still curious about the underlying reason behind this observation. Could someone help to explain this?
I've done a bit more dig here and found surprisingly that Idris1 failed to compile the following even simpler code snippet, which compiles correctly by Idris2:
f : Nat -> (Nat, Bool)
f Z = (Z, False)
f (S n) = case f n of (k, r) => (S k, r)
h2 : {q:_} -> f (S (q+1)) = case f (q+1) of (k, r) => (S k, r)
h2 = Refl
It spit error message:
|
19 | h2 = Refl
| ~~~~
When checking right hand side of h2 with expected type
f (S (q + 1)) = case f (q + 1) of (k, r) => (S k, r)
Type mismatch between
case f (plus q 1) of (k, r) => (S k, r) = case f (plus q 1) of (k, r) => (S k, r) (Type of Refl)
and
case f (plus q 1) of (k, r) => (S k, r) = case f (plus q 1) of (k, r) => (S k, r) (Expected type)
Specifically:
Type mismatch between
case f (plus q 1) of
(k, r) => (S k, r)
and
case f (plus q 1) of
(k, r) => (S k, r)
Aren't the two mismatching terms identical? Why couldn't be constructed with Refl?

Related

Why doesn't cong typecheck in Idris 2

I'm writing a function to test propositional equality of Nat, and it typechecks in Idris 1.
sameNat : (n : Nat) -> (m : Nat) -> Maybe (n = m)
sameNat Z Z = Just Refl
sameNat (S n) (S m) = case sameNat n m of
Just e => Just (cong e)
Nothing => Nothing
sameNat _ _ = Nothing
But it doesn't typecheck in Idris 2 (0.4.0) and I got this error.
Error: While processing right hand side of sameNat. When
unifying n = m and Nat m e -> :: ?x ?xs n m e.
Mismatch between: n = m and Nat m e -> :: ?x ?xs n m e.
It typechecks when I write a specific version of cong and use it.
cong' : n = m -> S n = S m
cong' Refl = Refl
Why doesn't this typecheck and how can I make it typecheck?
The type signature of cong changed:
Idris 1:
cong : (a = b) -> f a = f b
Idris 2:
Prelude.cong : (0 f : (t -> u)) -> a = b -> f a = f b

Idris Type mismatch that occurs even from template

Testing out an "easy" example of identity types, mod equality, but transitivity proof wont type check, even from the template. More than a fix, I want to know why?
Here's a snippet of the minimal problem
data ModEq : (n:Nat) -> (x:Nat) -> (y:Nat) -> Type where
{- 3 constructors
reflexive: x == x (mod n),
left-induct: x == y (mod n) => (x+n) == y (mod n)
right-induct: x == y (mod n) => x == (y+n) (mod n)
-}
Reflex : (x:Nat) -> ModEq n x x --- Needs syntatic sugar, for now prefix
LInd : (ModEq n x y) -> ModEq n (x+n) y
RInd : (ModEq n x y) -> ModEq n x (y+n)
{----- Proof of transitive property. -----}
total
isTrans : (ModEq n x y) -> (ModEq n y z) -> (ModEq n x z)
{- x=x & x=y => x=y -}
isTrans (Reflex x) v = v
isTrans u (Reflex y) = u
{- ((x=y=>(x+n)=y) & y=z) => x=y & y=z => x=z (induct) => (x+n)=z -}
isTrans (LInd u) v = LInd (isTrans u v)
isTrans u (RInd v) = RInd (isTrans u v)
{- (x=y=>x=(y+n)) & (y=z=>(y+n)=z) => x=y & y=z => x=z (induct) -}
isTrans (RInd u) (LInd v) = isTrans u v
The type mismatch is in the last line, even though from the comment line I really cannot tell why logically its wrong. Here's the error:
48 | isTrans (RInd u) (LInd v) = isTrans u v
| ~~~~~~~
When checking left hand side of isTrans:
When checking an application of Main.isTrans:
Type mismatch between
ModEq n (x + n) z (Type of LInd v)
and
ModEq n (y + n) z (Expected type)
Specifically:
Type mismatch between
plus x n
and
plus y n
Not only am I confused by how LInd v got assigned the (wrong seeming) type ModEq n (x+n) z, but I point out that when I simply try the "type-define-refine" approach with the built in template I get:
isTrans : (ModEq n x y) -> (ModEq n y z) -> (ModEq n x z)
isTrans (RInd _) (LInd _) = ?isTrans_rhs_1
And even this wont type-check, it complains:
40 | isTrans (RInd _) (LInd _) = ?isTrans_rhs_1
| ~~~~~~~
When checking left hand side of isTrans:
When checking an application of Main.isTrans:
Type mismatch between
ModEq n (x + n) z (Type of LInd _)
and
ModEq n (y + n) z (Expected type)
Specifically:
Type mismatch between
plus x n
and
plus y n
The issue is that the compiler isn't able to deduce in your last case that y = {x + n}. You can give it this hint, though:
isTrans : (ModEq n x y) -> (ModEq n y z) -> (ModEq n x z)
isTrans (Reflex _) v = v
isTrans u (Reflex _) = u
isTrans (LInd u) v = LInd $ isTrans u v
isTrans u (RInd v) = RInd $ isTrans u v
isTrans (RInd u) (LInd v) {n} {x} {y = x + n} = ?isTrans_rhs
Which gives you the following goal for isTrans_rhs:
x : Nat
n : Nat
u : ModEq n x x
z : Nat
v : ModEq n x z
--------------------------------------
isTrans_rhs : ModEq n x z
and thus, you can conclude with isTrans (RInd u) (LInd v) {n} {x} {y = x + n} = v

An Idris proof about `mod`

I was trying to write a proof in Idris regarding the following subtraction-based mod operator:
mod : (x, y : Nat) -> Not (y = Z) -> Nat
mod x Z p = void (p Refl)
mod x (S k) _ = if lt x (S k) then x else helper x (minus x (S k)) (S k)
where total
helper : Nat -> Nat -> Nat -> Nat
helper Z x y = x
helper (S k) x y = if lt x y then x else helper k (minus x y) y
The theorem I wanted to prove is that the remainder as produced by "mod" above is always smaller than the divider. Namely,
mod_prop : (x, y : Nat) -> (p : Not (y=0))-> LT (mod x y p) y
I constructed a proof but was stuck by a final hole. My full code is pasted below
mod : (x, y : Nat) -> Not (y = Z) -> Nat
mod x Z p = void (p Refl)
mod x (S k) _ = if lt x (S k) then x else helper x (minus x (S k)) (S k)
where total
helper : Nat -> Nat -> Nat -> Nat
helper Z x y = x
helper (S k) x y = if lt x y then x else helper k (minus x y) y
lteZK : LTE Z k
lteZK {k = Z} = LTEZero
lteZK {k = (S k)} = let ih = lteZK {k=k} in
lteSuccRight {n=Z} {m=k} ih
lte2LTE_True : True = lte a b -> LTE a b
lte2LTE_True {a = Z} prf = lteZK
lte2LTE_True {a = (S _)} {b = Z} Refl impossible
lte2LTE_True {a = (S k)} {b = (S j)} prf =
let ih = lte2LTE_True {a=k} {b=j} prf in LTESucc ih
lte2LTE_False : False = lte a b -> GT a b
lte2LTE_False {a = Z} Refl impossible
lte2LTE_False {a = (S k)} {b = Z} prf = LTESucc lteZK
lte2LTE_False {a = (S k)} {b = (S j)} prf =
let ih = lte2LTE_False {a=k} {b=j} prf in (LTESucc ih)
total
mod_prop : (x, y : Nat) -> (p : Not (y=0))-> LT (mod x y p) y
mod_prop x Z p = void (p Refl)
mod_prop x (S k) p with (lte x k) proof lxk
mod_prop x (S k) p | True = LTESucc (lte2LTE_True lxk)
mod_prop Z (S k) p | False = LTESucc lteZK
mod_prop (S x) (S k) p | False with (lte (minus x k) k) proof lxk'
mod_prop (S x) (S k) p | False | True = LTESucc (lte2LTE_True lxk')
mod_prop (S x) (S Z) p | False | False = LTESucc ?hole
Once I run the type checker, the hole is described as follows:
- + Main.hole [P]
`-- x : Nat
p : (1 = 0) -> Void
lxk : False = lte (S x) 0
lxk' : False = lte (minus x 0) 0
--------------------------------------------------------------------------
Main.hole : LTE (Main.mod, helper (S x) 0 p x (minus (minus x 0) 1) 1) 0
I am not familiar with the syntax of Main.mod, helper (S x) 0 p x (minus (minus x 0) 1) 1 given in the idris-holes window. I guess (S x) 0 p are the three parameters of "mod" while (minus (minus x 0) 1) 1 are the three parameters of the local "helper" function of "mod"?
It seems that it's time to leverage an induction hypothesis. But how can I finish up the proof using induction?
(Main.mod, helper (S x) 0 p x (minus (minus x 0) 1) 1)
can be read as
Main.mod, helper - a qualified name for helper function, which is defined in the where clause of the mod function (Main is a module name);
Arguments of mod which are also passed to helper - (S x), 0 and p (see docs):
Any names which are visible in the outer scope are also visible in the
where clause (unless they have been redefined, such as xs here). A
name which appears only in the type will be in scope in the where
clause if it is a parameter to one of the types, i.e. it is fixed
across the entire structure.
Arguments of helper itself - x, (minus (minus x 0) 1) and 1.
Also below is another implementation of mod which uses Fin n type for the remainder in division by n. It turns out to be easier to reason about, since any value of Fin n is always less than n:
import Data.Fin
%default total
mod' : (x, y : Nat) -> {auto ok: GT y Z} -> Fin y
mod' Z (S _) = FZ
mod' (S x) (S y) with (strengthen $ mod' x (S y))
| Left _ = FZ
| Right rem = FS rem
mod : (x, y : Nat) -> {auto ok: GT y Z} -> Nat
mod x y = finToNat $ mod' x y
finLessThanBound : (f : Fin n) -> LT (finToNat f) n
finLessThanBound FZ = LTESucc LTEZero
finLessThanBound (FS f) = LTESucc (finLessThanBound f)
mod_prop : (x, y : Nat) -> {auto ok: GT y Z} -> LT (mod x y) y
mod_prop x y = finLessThanBound (mod' x y)
Here for convenience I used auto implicits for proofs that y > 0.

Can I implement Eq for a type which can contain a list of itself?

This code doesn't compile:
data Foo = A String | B (List Foo)
Eq Foo where
(==) (A x) (A y) = x == y
(==) (B xs) (B ys) = xs == ys
(==) _ _ = False
It yields the following error:
Type checking ./eq.idr eq.idr:11:3-27: | 11 | (==) (A x) (A y) =
x == y | ~~~~~~~~~~~~~~~~~~~~~~~~~ Prelude.Interfaces.Main.Foo
implementation of Prelude.Interfaces.Eq, method == is possibly not
total due to recursive path Prelude.Interfaces.Main.Foo implementation
of Prelude.Interfaces.Eq, method == --> Prelude.Interfaces.Main.Foo
implementation of Prelude.Interfaces.Eq, method ==
So is the problem here that we're relying on Eq Foo in its implementation, hence the recursive path? That doesn't seem to explain it, because this compiles:
data Bar = C String | D Bar
Eq Bar where
(==) (C x) (C y) = x == y
(==) (D x) (D y) = x == y
(==) _ _ = False
So - I can have recursive calls to == on whatever I'm defining the implementation on, but I can't to lists of it? Am I missing a trick to make this work, or am I trying to do something that's fundamentally broken somewhere?
The function that decides equality needs to be implemented in terms of mutual recursion, just as Foo itself is defined by mutual recursion.
Eq Foo where
(==) = eq
where mutual -- massive indentation necessary
eq : Foo -> Foo -> Bool
eq (A l) (A r) = l == r
eq (B l) (B r) = eq1 l r
eq _ _ = False
eq1 : List Foo -> List Foo -> Bool
eq1 (l :: ls) (r :: rs) = eq l r && eq1 ls rs
eq1 [] [] = True
eq1 _ _ = False
You can't reuse List's own (==), but it is possible to factor out a pattern.
zipWithFoldrElem : (ls : List a) -> (rs : List a) -> ((l : a) -> (r : a) -> Elem (l, r) (zip ls rs) -> b) -> (b -> Lazy b -> b) -> b -> b -> b -> b
zipWithFoldrElem [] [] _ _ e _ _ = e
zipWithFoldrElem [] (_ :: _) _ _ _ el _ = el
zipWithFoldrElem (_ :: _) [] _ _ _ _ er = er
zipWithFoldrElem (l :: ls) (r :: rs) f g e el er = f l r Here `g` zipWithFoldLazyElem ls rs (\l, r, e => f l r (There e)) g e el er
Eq Foo where
(A l) == (A r) = l == r
(B l) == (B r) = zipWithFoldrElem l r (f l r) (&&) True False False
where f : (ls : List Foo) -> (rs : List Foo) -> (l : Foo) -> (r : Foo) -> Elem (l, r) (zip ls rs) -> Bool
f (l :: _) (r :: _) l r Here = l == r
f (_ :: ls) (_ :: rs) l r (There e) = f ls rs l r e
f [] [] _ _ _ impossible
_ == _ = False
And, for show, here's a lexicographic Ord:
Ord Foo where
compare (A l) (A r) = l `compare` r
compare (B l) (B r) = zipWithFoldrElem l r (f l r) thenCompare EQ LT GT
where f : (ls : List Foo) -> (rs : List Foo) -> (l : Foo) -> (r : Foo) -> Elem (l, r) (zip ls rs) -> Ordering
f (l :: _) (r :: _) l r Here = l `compare` r
f (_ :: ls) (_ :: rs) l r (There e) = f ls rs l r e
f [] [] _ _ _ impossible
compare (A _) (B _) = LT
compare (B _) (A _) = GT
There's a much nicer way, now that I've grokked WellFounded a bit.
This data type is to Foo as Elem is to List. It tells you where to find a sub-Foo in a Foo.
-- s is smaller than b if either ...
data Smaller : (s : Foo) -> (b : Foo) -> Type where
-- it is one of the elements of ss when b = B ss
Surface : Elem s ss -> Smaller s (B ss)
-- it is smaller than one of the elements of ms when b = B ms
-- "m" is for "medium"
Deeper : Smaller s m -> Elem m ms -> Smaller s (B ms)
Smaller is WellFounded:
WellFounded Smaller where
wellFounded x = Access (acc x)
where mutual
acc : (b : Foo) -> (s : Foo) -> Smaller s b -> Accessible Smaller s
acc (B ss) s (Surface e) = accSurface ss s e
acc (B ms) s (Deeper {m} sr e) = accDeeper ms m e s sr
accSurface : (ss : List Foo) -> (s : Foo) -> Elem s ss -> Accessible Smaller s
accSurface (s :: _) s Here = Access (acc s)
accSurface (_ :: ss) s (There e) = accSurface ss s e
accDeeper : (ms : List Foo) -> (m : Foo) -> Elem m ms -> (s : Foo) -> Smaller s m -> Accessible Smaller s
accDeeper (m :: _) m Here s sr = acc m s sr
accDeeper (_ :: ms) m (There e) s sr = accDeeper ms m e s sr
This uses mutual recursion, just like my older answer, but it abstracts it away much more cleanly. The general skeleton of a WellFounded instance is:
WellFounded (rel : a -> a -> Type) where -- rel s b means s is smaller than b
wellFounded x = Access (acc x)
where acc : (b : a) -> (s : a) -> rel s b -> Accessible rel s
-- Accessible is really cryptic:
-- Access : (rec : (y : a) -> rel y x -> Accessible rel y) -> Accessible rel x
-- but the idea of acc is simple:
-- we convince the totality checker s is really smaller than b
-- acc needs to be recursive, and when it convinces the totality
-- checker, it can end with Access (acc s)
WellFounded buys us
wfRec : WellFounded rel =>
(step : (x : a) ->
(rec : (y : a) -> rel y x -> b) ->
b
) ->
a -> b
step is a function defined by open recursion. step gets an argument rec, and, instead of recursing to itself, step calls rec with a proof that the argument it's recursing on is the right size, and wfRec routes the call back to step (essentially it's fix : (step : (rec : (a -> b)) -> (x : a) -> b) -> a -> b; fix f x = f (fix f) x but total.)
We can now, cleanly, factor out the logic of (==) on lists:
eqBy : (ls : List a) -> (rs : List a) -> ((l : a) -> (r : a) -> (el : Elem l ls) -> (er : Elem r rs) -> Bool) -> Bool
eqBy (l :: ls) (r :: rs) eq = eq l r Here Here && eqBy ls rs (\l, r, el, er => eq l r (There el) (There er))
eqBy [] [] _ = True
eqBy _ _ _ = False
And the Eq instance is not much worse than the naive one:
Eq Foo where
(==) = wfRec step
where step : (x : Foo) -> ((y : Foo) -> Smaller y x -> Foo -> Bool) -> Foo -> Bool
step (A l) _ (A r) = l == r
step (B l) rec (B r) = eqBy l r (\l, r, el, er => rec l (Surface el) r)
step _ _ _ = False
eqBy and the WellFounded instance are now much more reusable than the zipWithFoldrElem abomination I previously created.

Idris determining result vector length

In Idris, if I want to remove an element based on predicate, there is filter, dropWhile, takeWhile. However, all these functions return a dependent pair (n : Nat ** Vect n elem).
Is there any function that return back as a Vect type?
For what I could think of:
Convert a dependent pair to Vect
Implement a type that indicate the length vector after transformation (thought I have no idea how), like Here, There
For above ideas, it seems quite cumbersome for 1 (convert every result) or 2 (design each of the type to indicate the result vector length).
Are there any better ways to achieve such behaviour?
dropElem : String -> Vect n String -> Vect ?resultLen String
Maybe this is what you are searching for?
import Data.Vect
count: (ty -> Bool) -> Vect n ty -> Nat
count f [] = 0
count f (x::xs) with (f x)
| False = count f xs
| True = 1 + count f xs
%hint
countLemma: {v: Vect n ty} -> count f v `LTE` n
countLemma {v=[]} = LTEZero
countLemma {v=x::xs} {f} with (f x)
| False = lteSuccRight countLemma
| True = LTESucc countLemma
filter: (f: ty -> Bool) -> (v: Vect n ty) -> Vect (count f v) ty
filter f [] = []
filter f (x::xs) with (f x)
| False = filter f xs
| True = x::filter f xs
Then you con do this:
dropElem: (s: String) -> (v: Vect n String) -> Vect (count ((/=) s) v) String
dropElem s = filter ((/=) s)
You can even reuse the existing filter implementation:
count: (ty -> Bool) -> Vect n ty -> Nat
count f v = fst $ filter f v
filter: (f: ty -> Bool) -> (v: Vect n ty) -> Vect (count f v) ty
filter f v = snd $ filter f v