Is there any connection implemented between propositional and promoted equality?
Let's say I have
prf :: x :~: y
in scope for some Symbols; by pattern matching on it being Refl, I can transform that into
prf' :: (x :== y) :~: True
like this:
fromProp :: (KnownSymbol x, KnownSymbol y) => x :~: y -> (x :== y) :~: True
fromProp Refl = Refl
But what about the other direction? If I try
toProp :: (KnownSymbol x, KnownSymbol y) => (x :== y) :~: True -> x :~: y
toProp Refl = Refl
then all I get is
• Could not deduce: x ~ y
from the context: 'True ~ (x :== y)
Yes, going between the two representations is possible (assuming the implementation of :== is correct), but it requires computation.
The information you need is not present in the Boolean itself (it's been erased to a single bit); you have to recover it. This involves interrogating the two participants of the original Boolean equality test (which means you have to keep them around at runtime), and using your knowledge of the result to eliminate the impossible cases. It's rather tedious to re-perform a computation for which you already know the answer!
Working in Agda, and using naturals instead of strings (because they're simpler):
open import Data.Nat
open import Relation.Binary.PropositionalEquality
open import Data.Bool
_==_ : ℕ -> ℕ -> Bool
zero == zero = true
suc n == suc m = n == m
_ == _ = false
==-refl : forall n -> (n == n) ≡ true
==-refl zero = refl
==-refl (suc n) = ==-refl n
fromProp : forall {n m} -> n ≡ m -> (n == m) ≡ true
fromProp {n} refl = ==-refl n
-- we have ways of making you talk
toProp : forall {n m} -> (n == m) ≡ true -> n ≡ m
toProp {zero} {zero} refl = refl
toProp {zero} {suc m} ()
toProp {suc n} {zero} ()
toProp {suc n} {suc m} p = cong suc (toProp {n}{m} p)
In principle I think you could make this work in Haskell using singletons, but why bother? Don't use Booleans!
Related
There is an elegant derinition of list of fibonacci numbers:
fibs :: [Integer]
fibs = fib 1 1 where
fib a b = a : fib b (a + b)
Can it be translated to use recursion-schemes library?
The closest I could get is the following code that uses completely different approach:
fibN' :: Nat -> Integer
fibN' = histo $ \case
(refix -> x:y:_) -> x + y
_ -> 1
I can provide the rest of the code if necessary, but essentially I get the Nth fibonacci number by using a histomorphism of Nat = Fix Maybe. Maybe (Cofree Maybe a) turns out to be isomorphic to [a], so refix can be thought just as a sort of toList to make the pattern shorter.
Upd:
I found shorter code but it only stores one value and in a non-generic way:
fib' :: (Integer, Integer) -> [Integer]
fib' = ana $ \(x, y) -> Cons x (y, x+y)
A non-generic way to store full history:
fib'' :: [Integer] -> [Integer]
fib'' = ana $ \l#(x:y:_) -> Cons x (x + y : l)
Sure. Your fibs is readily translated into an unfoldr, which is just a slightly different way to spell ana.
fibs = unfoldr (\(a, b) -> Just (a, (b, a + b))) (1,1)
Here is (sort of) what I wanted:
type L f a = f (Cofree f a)
histAna
:: (Functor f, Corecursive t) =>
(f (Cofree g a) -> Base t (L g a))
-> (L g a -> f a)
-> L g a -> t
histAna unlift psi = ana (unlift . lift) where
lift oldHist = (:< oldHist) <$> psi oldHist
psi
takes an "old history" as a seed,
produces one level and seeds just like in normal ana,
then the new seeds are appended to the "old history", so the newHistory becomes newSeed :< oldHistory
unlift produces current level from seed and history.
fibsListAna :: Num a => L Maybe a -> [a]
fibsListAna = histAna unlift psi where
psi (Just (x :< Just (y :< _))) = Just $ x + y
unlift x = case x of
Nothing -> Nil
h#(Just (v :< _)) -> Cons v h
r1 :: [Integer]
r1 = take 10 $ toList $ fibsListAna $ Just (0 :< Just (1 :< Nothing))
Stream version can also be implemented (Identity and (,) a functors respectively should be used). The binary tree case works too, but it's not clear if it's of any use. Here is a degenerated case I wrote blindly just to satisfy the type checker:
fibsTreeAna :: Num a => L Fork a -> Tree a
fibsTreeAna = histAna unlift psi where
psi (Fork (a :< _) (b :< _)) = Fork a b
unlift x = case x of
h#(Fork (a :< _) (b :< _)) -> NodeF (a + b) h h
It's not clear if we lose anything by replacing Cofree with lists:
histAna
:: (Functor f, Corecursive t) =>
(f [a] -> Base t [a])
-> ([a] -> f a)
-> [a] -> t
histAna unlift psi = ana (unlift . lift) where
lift oldHist = (: oldHist) <$> psi oldHist
In this case 'history' becomes just the path to the tree root filled by seeds.
The list version turns out to be easily simplified by using different functor so seeding and filling the level can be accomplished in one place:
histAna psi = ana lift where
lift oldHist = (: oldHist) <$> psi oldHist
fibsListAna :: Num a => [a]
fibsListAna = histAna psi [0,1] where
psi (x : y : _) = Cons (x + y) (x + y)
The original code with Cofree can be simplified too:
histAna :: (Functor f, Corecursive t) => (L f a -> Base t (f a)) -> L f a -> t
histAna psi = ana $ \oldHist -> fmap (:< oldHist) <$> psi oldHist
fibsListAna :: Num a => L Maybe a -> [a]
fibsListAna = histAna $ \case
Just (x :< Just (y :< _)) -> Cons (x + y) (Just (x + y))
fibsStreamAna :: Num a => L Identity a -> Stream a
fibsStreamAna = histAna $ \case
Identity (x :< Identity (y :< _)) -> (x + y, Identity $ x + y)
fibsTreeAna :: Num a => L Fork a -> Tree a
fibsTreeAna = histAna $ \case
Fork (a :< _) (b :< _) -> NodeF (a + b) (Fork a a) (Fork b b)
Okasaki describes persistent real-time queues which can be realized in Haskell using the type
data Queue a = forall x . Queue
{ front :: [a]
, rear :: [a]
, schedule :: [x]
}
where incremental rotations maintain the invariant
length schedule = length front - length rear
More details
If you're familiar with the queues involved, you can skip this section.
The rotation function looks like
rotate :: [a] -> [a] -> [a] -> [a]
rotate [] (y : _) a = y : a
rotate (x : xs) (y : ys) a =
x : rotate xs ys (y : a)
and it's called by a smart constructor
exec :: [a] -> [a] -> [x] -> Queue a
exec f r (_ : s) = Queue f r s
exec f r [] = Queue f' [] f' where
f' = rotate f r []
after each queue operation. The smart constructor is always called when length s = length f - length r + 1, ensuring that the pattern match in rotate will succeed.
The problem
I hate partial functions! I'd love to find a way to express the structural invariant in the types. The usual dependent vector seems a likely choice:
data Nat = Z | S Nat
data Vec n a where
Nil :: Vec 'Z a
Cons :: a -> Vec n a -> Vec ('S n) a
and then (perhaps)
data Queue a = forall x rl sl . Queue
{ front :: Vec (sl :+ rl) a
, rear :: Vec rl a
, schedule :: Vec sl x
}
The trouble is that I haven't been able to figure out how to juggle the types. It seems extremely likely that some amount of unsafeCoerce will be needed to make this efficient. However, I haven't been able to come up with an approach that's even vaguely manageable. Is it possible to do this nicely in Haskell?
Here is what I got:
open import Function
open import Data.Nat.Base
open import Data.Vec
grotate : ∀ {n m} {A : Set}
-> (B : ℕ -> Set)
-> (∀ {n} -> A -> B n -> B (suc n))
-> Vec A n
-> Vec A (suc n + m)
-> B m
-> B (suc n + m)
grotate B cons [] (y ∷ ys) a = cons y a
grotate B cons (x ∷ xs) (y ∷ ys) a = grotate (B ∘ suc) cons xs ys (cons y a)
rotate : ∀ {n m} {A : Set} -> Vec A n -> Vec A (suc n + m) -> Vec A m -> Vec A (suc n + m)
rotate = grotate (Vec _) _∷_
record Queue (A : Set) : Set₁ where
constructor queue
field
{X} : Set
{n m} : ℕ
front : Vec A (n + m)
rear : Vec A m
schedule : Vec X n
open import Relation.Binary.PropositionalEquality
open import Data.Nat.Properties.Simple
exec : ∀ {m n A} -> Vec A (n + m) -> Vec A (suc m) -> Vec A n -> Queue A
exec {m} {suc n} f r (_ ∷ s) = queue (subst (Vec _) (sym (+-suc n m)) f) r s
exec {m} f r [] = queue (with-zero f') [] f' where
with-zero = subst (Vec _ ∘ suc) (sym (+-right-identity m))
without-zero = subst (Vec _ ∘ suc) (+-right-identity m)
f' = without-zero (rotate f (with-zero r) [])
rotate is defined in terms of grotate for the same reason reverse is defined in terms of foldl (or enumerate in terms of genumerate): because Vec A (suc n + m) is not definitionally Vec A (n + suc m), while (B ∘ suc) m is definitionally B (suc m).
exec has the same implementation as you provided (modulo those substs), but I'm not sure about the types: is it OK that r must be non-empty?
The other answer is super clever (please take a moment to upvote it), but as someone not familiar with Agda, how this would be implemented in Haskell was not obvious to me. Here's a full Haskell version. We'll need a whole slew of extensions, as well as Data.Type.Equality (since we will need to do some limited amount of type-proofs).
{-# LANGUAGE GADTs, ScopedTypeVariables,RankNTypes,
TypeInType, TypeFamilies, TypeOperators #-}
import Data.Type.Equality
Defining Nat, Vec, and Queue
Next, we define the usual type-level natural numbers (this looks like just a regular data definition, but because we have TypeInType enabled, it will get automatically promoted when we use it in a type) and a type function (a type family) for addition. Note that although there are multiple ways of defining +, our choice here will impact what follows. We'll also define the usual Vec which is very much like a list except that it encodes its length in the phantom type n. With that, we can go ahead and define the type of our queue.
data Nat = Z | S Nat
type family n + m where
Z + m = m
S n + m = S (n + m)
data Vec a n where
Nil :: Vec a Z
(:::) :: a -> Vec a n -> Vec a (S n)
data Queue a where
Queue :: { front :: Vec a (n + m)
, rear :: Vec a m
, schedule :: Vec x n } -> Queue a
Defining rotate
Now, things start to get hairier. We want to define a function rotate that has type rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m), but you quickly run into a variety of proof related problems with just defining this recursively. The solution is instead to define a slightly more general grotate, which can be defined recursively, and for which rotate is a special case.
The point of Bump is to circumvent the fact that there is no such thing as type level composition in Haskell. There is no way of writing things an operator like (∘) such that (S ∘ S) x is S (S x). The workaround is to continuously wrap/unwrap with Bump/lower.
newtype Bump p n = Bump { lower :: p (S n) }
grotate :: forall p n m a.
(forall n. a -> p n -> p (S n)) ->
Vec a n ->
Vec a (S n + m) ->
p m ->
p (S n + m)
grotate cons Nil (y ::: _) zs = cons y zs
grotate cons (x ::: xs) (y ::: ys) zs = lower (grotate consS xs ys (Bump (cons y zs)))
where
consS :: forall n. a -> Bump p n -> Bump p (S n)
consS = \a -> Bump . cons a . lower
rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m)
rotate = grotate (:::)
We need explicit foralls here to make it very clear which type variables are getting captured and which aren't, as well as to denote higher-rank types.
Singleton natural numbers SNat
Before we proceed to exec, we set up some machinery that will allow us to prove some type-level arithmetic claims (which we need to get exec to typecheck). We start by making an SNat type (which is a singleton type corresponding to Nat). SNat reflects its value in a phantom type variable.
data SNat n where
SZero :: SNat Z
SSucc :: SNat n -> SNat (S n)
We can then make a couple useful functions to do things with SNat.
sub1 :: SNat (S n) -> SNat n
sub1 (SSucc x) = x
size :: Vec a n -> SNat n
size Nil = SZero
size (_ ::: xs) = SSucc (size xs)
Finally, we are prepared to prove some arithmetic, namely that n + S m ~ S (n + m) and n + Z ~ n.
plusSucc :: (SNat n) -> (SNat m) -> (n + S m) :~: S (n + m)
plusSucc SZero _ = Refl
plusSucc (SSucc n) m = gcastWith (plusSucc n m) Refl
plusZero :: SNat n -> (n + Z) :~: n
plusZero SZero = Refl
plusZero (SSucc n) = gcastWith (plusZero n) Refl
Defining exec
Now that we have rotate, we can define exec. This definition looks almost identical to the one in the question (with lists), except annotated with gcastWith <some-proof>.
exec :: Vec a (n + m) -> Vec a (S m) -> Vec a n -> Queue a
exec f r (_ ::: s) = gcastWith (plusSucc (size s) (sub1 (size r))) $ Queue f r s
exec f r Nil = gcastWith (plusZero (sub1 (size r))) $
let f' = rotate f r Nil in (Queue f' Nil f')
It is probably worth noting that we can get some stuff for free by using singletons. With the right extensions enabled, the following more readable code
import Data.Singletons.TH
singletons [d|
data Nat = Z | S Nat
(+) :: Nat -> Nat -> Nat
Z + n = n
S m + n = S (m + n)
|]
defines, Nat, the type family :+ (equivalent to my +), and the singleton type SNat (with constructors SZ and SS equivalent to my SZero and SSucc) all in one.
I'm working in an example of dependently typed program in Haskell and I would like to "rewrite" an evidence of propositional equality type a :~: b defined in singletons library.
More specifically, I have a data type for represent evidence of regular expression membership. My trouble is how to deal with evidence of concatenation of two regular expressions. In my code, I have a GADT called InRegExp xs e that express the fact that xs is in the language of regular expression e. For concatenation, I have the following constructor:
InCat :: InRegExp xs l -> InRegExp ys r ->
(zs :~: xs ++ ys) -> InRegExp zs (Cat l r)
So far, so good. Now I want to define an inversion lemma for membership in concatenation of two regular expressions:
inCatInv :: InRegExp (xs ++ ys) (Cat e e') -> (InRegExp xs e , InRegExp ys e')
inCatInv (InCat p p' Refl) = (p , p')
but the code is rejected by GHC with the following error message:
Could not deduce (xs1 ~ xs)
from the context ('Cat e e' ~ 'Cat l r)
bound by a pattern with constructor
InCat :: forall (zs :: [Nat])
(xs :: [Nat])
(l :: RegExp [Nat])
(ys :: [Nat])
(r :: RegExp [Nat]).
InRegExp xs l
-> InRegExp ys r -> zs :~: (xs ++ ys) -> InRegExp zs ('Cat l r),
in an equation for ‘inCatInv’
at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:11-25
or from ((xs ++ ys) ~ (xs1 ++ ys1))
bound by a pattern with constructor
Refl :: forall (k :: BOX) (b :: k). b :~: b,
in an equation for ‘inCatInv’
at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:22-25
‘xs1’ is a rigid type variable bound by
a pattern with constructor
InCat :: forall (zs :: [Nat])
(xs :: [Nat])
(l :: RegExp [Nat])
(ys :: [Nat])
(r :: RegExp [Nat]).
InRegExp xs l
-> InRegExp ys r -> zs :~: (xs ++ ys) -> InRegExp zs ('Cat l r),
in an equation for ‘inCatInv’
at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:11
‘xs’ is a rigid type variable bound by
the type signature for
inCatInv :: InRegExp (xs ++ ys) ('Cat e e')
-> (InRegExp xs e, InRegExp ys e')
at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:43:13
Expected type: InRegExp xs e
Actual type: InRegExp xs1 l
Relevant bindings include
p :: InRegExp xs1 l
(bound at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:17)
inCatInv :: InRegExp (xs ++ ys) ('Cat e e')
-> (InRegExp xs e, InRegExp ys e')
(bound at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:1)
In the expression: p
In the expression: (p, p')
In Agda or Idris, this kind of inversion lemma works just fine. Is possible to express such inversion lemma in Haskell? The complete code is available in the following gist.
Any tip or explanation of how can I express such lemma or why it isn't possible to express is highly appreciated.
The simplest method for writing dependently typed programs in Haskell is to first write it in Agda, then replace (x : A) -> B with Sing x -> b. However, we can use Proxy instead of Sing when we're sure we won't need to compute with values.
In our case (assuming our goal is to write hasEmpty from your gist), we only need a single Sing in the Cat constructor, because we need a pattern matching proof for the following function:
appendEmpty :: Sing xs -> Proxy ys -> (xs :++ ys) :~: '[] -> (xs :~: '[], ys :~: '[])
appendEmpty SNil ys eq = (Refl, eq)
appendEmpty (SCons x xs) ys eq = case eq of {}
appendEmpty establishes that the sublists of the empty list are empty too, so we can use them in the Cat case for hasEmpty. Anyway, below's the whole code.
I used a slightly different but equivalent definition for Star that reuses Choice and Eps for building a list structure.
{-# language
TemplateHaskell, UndecidableInstances, LambdaCase, EmptyCase,
DataKinds, PolyKinds, GADTs, TypeFamilies, ScopedTypeVariables,
TypeOperators #-}
import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Proxy
$(singletons [d|
data Regex c
= Sym c
| Cat (Regex c) (Regex c)
| Choice (Regex c) (Regex c)
| Star (Regex c)
| Eps
deriving (Show)
|])
appendEmpty :: Sing xs -> Proxy ys -> (xs :++ ys) :~: '[] -> (xs :~: '[], ys :~: '[])
appendEmpty SNil ys eq = (Refl, eq)
appendEmpty (SCons x xs) ys eq = case eq of {}
data InRegex :: [c] -> Regex c -> * where
InEps :: InRegex '[] Eps
InSym :: InRegex '[c] (Sym c)
InCat :: Sing xs -> InRegex xs l -> InRegex ys r -> InRegex (xs :++ ys) (Cat l r)
InLeft :: InRegex xs l -> InRegex xs (Choice l r)
InRight :: InRegex ys r -> InRegex ys (Choice l r)
InStar :: InRegex xs (Choice Eps (Cat r (Star r))) -> InRegex xs (Star r)
hasEmpty :: Sing r -> Either (InRegex '[] r) (InRegex '[] r -> Void)
hasEmpty (SSym _) = Right (\case {})
hasEmpty (SCat l r) = case hasEmpty l of
Left inl -> case hasEmpty r of
Left inr -> Left (InCat SNil inl inr)
Right notInr -> Right
(\(InCat xs inl (inr :: InRegex ys r)) -> case appendEmpty xs (Proxy :: Proxy ys) Refl of
(Refl, Refl) -> notInr inr)
Right notInl -> Right
(\(InCat xs inl (inr :: InRegex ys r)) -> case appendEmpty xs (Proxy :: Proxy ys) Refl of
(Refl, Refl) -> notInl inl)
hasEmpty (SChoice l r) = case hasEmpty l of
Left inl -> Left (InLeft inl)
Right notInl -> case hasEmpty r of
Left inr -> Left (InRight inr)
Right notInr -> Right (\case
InLeft inl -> notInl inl
InRight inr -> notInr inr)
hasEmpty (SStar r) = Left (InStar (InLeft InEps))
hasEmpty SEps = Left InEps
Dipping my toe into the waters of dependent types, I had a crack at the canonical "list with statically-typed length" example.
{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}
-- a kind declaration
data Nat = Z | S Nat
data SafeList :: (Nat -> * -> *) where
Nil :: SafeList Z a
Cons :: a -> SafeList n a -> SafeList (S n) a
-- the type signature ensures that the input list has at least one element
safeHead :: SafeList (S n) a -> a
safeHead (Cons x xs) = x
This seems to work:
ghci> :t Cons 5 (Cons 3 Nil)
Cons 5 (Cons 3 Nil) :: Num a => SafeList ('S ('S 'Z)) a
ghci> safeHead (Cons 'x' (Cons 'c' Nil))
'x'
ghci> safeHead Nil
Couldn't match type 'Z with 'S n0
Expected type: SafeList ('S n0) a0
Actual type: SafeList 'Z a0
In the first argument of `safeHead', namely `Nil'
In the expression: safeHead Nil
In an equation for `it': it = safeHead Nil
However, in order for this data-type to be actually useful, I should be able to build it from run-time data for which you don't know the length at compile time. My naïve attempt:
fromList :: [a] -> SafeList n a
fromList = foldr Cons Nil
This fails to compile, with the type error:
Couldn't match type 'Z with 'S n
Expected type: a -> SafeList n a -> SafeList n a
Actual type: a -> SafeList n a -> SafeList ('S n) a
In the first argument of `foldr', namely `Cons'
In the expression: foldr Cons Nil
In an equation for `fromList': fromList = foldr Cons Nil
I understand why this is happening: the return type of Cons is different for each iteration of the fold - that's the whole point! But I can't see a way around it, probably because I've not read deeply enough into the subject. (I can't imagine all this effort is being put into a type system that is impossible to use in practice!)
So: How can I build this sort of dependently-typed data from 'normal' simply-typed data?
Following #luqui's advice I was able to make fromList compile:
data ASafeList a where
ASafeList :: SafeList n a -> ASafeList a
fromList :: [a] -> ASafeList a
fromList = foldr f (ASafeList Nil)
where f x (ASafeList xs) = ASafeList (Cons x xs)
Here's my attempt to unpack the ASafeList and use it:
getSafeHead :: [a] -> a
getSafeHead xs = case fromList xs of ASafeList ys -> safeHead ys
This causes another type error:
Couldn't match type `n' with 'S n0
`n' is a rigid type variable bound by
a pattern with constructor
ASafeList :: forall a (n :: Nat). SafeList n a -> ASafeList a,
in a case alternative
at SafeList.hs:33:22
Expected type: SafeList ('S n0) a
Actual type: SafeList n a
In the first argument of `safeHead', namely `ys'
In the expression: safeHead ys
In a case alternative: ASafeList ys -> safeHead ys
Again, intuitively it makes sense that this would fail to compile. I can call fromList with an empty list, so the compiler has no guarantee that I'll be able to call safeHead on the resulting SafeList. This lack of knowledge is roughly what the existential ASafeList captures.
Can this problem be solved? I feel like I might have walked down a logical dead-end.
Never throw anything away.
If you're going to take the trouble to crank along a list to make a length-indexed list (known in the literature as a "vector"), you may as well remember its length.
So, we have
data Nat = Z | S Nat
data Vec :: Nat -> * -> * where -- old habits die hard
VNil :: Vec Z a
VCons :: a -> Vec n a -> Vec (S n) a
but we can also give a run time representation to static lengths. Richard Eisenberg's "Singletons" package will do this for you, but the basic idea is to give a type of run time representations for static numbers.
data Natty :: Nat -> * where
Zy :: Natty Z
Sy :: Natty n -> Natty (S n)
Crucially, if we have a value of type Natty n, then we can interrogate that value to find out what n is.
Hasochists know that run time representability is often so boring that even a machine can manage it, so we hide it inside a type class
class NATTY (n :: Nat) where
natty :: Natty n
instance NATTY Z where
natty = Zy
instance NATTY n => NATTY (S n) where
natty = Sy natty
Now we can give a slightly more informative existential treatment of the length you get from your lists.
data LenList :: * -> * where
LenList :: NATTY n => Vec n a -> LenList a
lenList :: [a] -> LenList a
lenList [] = LenList VNil
lenList (x : xs) = case lenList xs of LenList ys -> LenList (VCons x ys)
You get the same code as the length-destroying version, but you can grab a run time representation of the length anytime you like, and you don't need to crawl along the vector to get it.
Of course, if you want the length to be a Nat, it's still a pain that you instead have a Natty n for some n.
It's a mistake to clutter one's pockets.
Edit I thought I'd add a little, to address the "safe head" usage issue.
First, let me add an unpacker for LenList which gives you the number in your hand.
unLenList :: LenList a -> (forall n. Natty n -> Vec n a -> t) -> t
unLenList (LenList xs) k = k natty xs
And now suppose I define
vhead :: Vec (S n) a -> a
vhead (VCons a _) = a
enforcing the safety property. If I have a run time representation of the length of a vector, I can look at it to see if vhead applies.
headOrBust :: LenList a -> Maybe a
headOrBust lla = unLenList lla $ \ n xs -> case n of
Zy -> Nothing
Sy _ -> Just (vhead xs)
So you look at one thing, and in doing so, learn about another.
In
fromList :: [a] -> SafeList n a
n is universally quantified -- i.e. this signature is claiming that we should be able to build a SafeList of any length from the list. Instead you want to quantify existentially, which can only be done by defining a new data type:
data ASafeList a where
ASafeList :: SafeList n a -> ASafeList a
Then your signature should be
fromList :: [a] -> ASafeList a
You can use it by pattern matching on ASafeList
useList :: ASafeList a -> ...
useList (ASafeList xs) = ...
and in the body, xs will be a SafeList n a type with an unknown (rigid) n. You will probably have to add more operations to use it in any nontrivial way.
If you want to use dependently typed functions on runtime data, then you need to ensure, that this data doesn't violate encoded in type signatures laws. It's easier to understand this by an example. Here is our setup:
data Nat = Z | S Nat
data Natty (n :: Nat) where
Zy :: Natty Z
Sy :: Natty n -> Natty (S n)
data Vec :: * -> Nat -> * where
VNil :: Vec a Z
VCons :: a -> Vec a n -> Vec a (S n)
We can write some simple functions on Vec:
vhead :: Vec a (S n) -> a
vhead (VCons x xs) = x
vtoList :: Vec a n -> [a]
vtoList VNil = []
vtoList (VCons x xs) = x : vtoList xs
vlength :: Vec a n -> Natty n
vlength VNil = Zy
vlength (VCons x xs) = Sy (vlength xs)
For writing the canonical example of the lookup function we need the concept of finite sets. They are usually defined as
data Fin :: Nat -> where
FZ :: Fin (S n)
FS :: Fin n -> Fin (S n)
Fin n represents all numbers less than n.
But just like there is a type level equivalent of Nats — Nattys, there is a type level equivalent of Fins. But now we can incorporate value level and type level Fins:
data Finny :: Nat -> Nat -> * where
FZ :: Finny (S n) Z
FS :: Finny n m -> Finny (S n) (S m)
The first Nat is an upper bound of a Finny. And the second Nat corresponds to an actual value of a Finny. I.e. it must be equal to toNatFinny i, where
toNatFinny :: Finny n m -> Nat
toNatFinny FZ = Z
toNatFinny (FS i) = S (toNatFinny i)
Defining the lookup function is now straightforward:
vlookup :: Finny n m -> Vec a n -> a
vlookup FZ (VCons x xs) = x
vlookup (FS i) (VCons x xs) = vlookup i xs
And some tests:
print $ vlookup FZ (VCons 1 (VCons 2 (VCons 3 VNil))) -- 1
print $ vlookup (FS FZ) (VCons 1 (VCons 2 (VCons 3 VNil))) -- 2
print $ vlookup (FS (FS (FS FZ))) (VCons 1 (VCons 2 (VCons 3 VNil))) -- compile-time error
That was simple, but what about the take function? It's not harder:
type Finny0 n = Finny (S n)
vtake :: Finny0 n m -> Vec a n -> Vec a m
vtake FZ _ = VNil
vtake (FS i) (VCons x xs) = VCons x (vtake i xs)
We need Finny0 instead of Finny, because lookup requires a Vec to be non-empty, so if there is a value of type Finny n m, then n = S n' for some n'. But vtake FZ VNil is perfectly valid, so we need to relax this restriction. So Finny0 n represents all numbers less or equal n.
But what about runtime data?
vfromList :: [a] -> (forall n. Vec a n -> b) -> b
vfromList [] f = f VNil
vfromList (x:xs) f = vfromList xs (f . VCons x)
I.e. "give me a list and a function, that accepts a Vec of arbitrary length, and I'll apply the latter to the former". vfromList xs returns a continuation (i.e. something of type (a -> r) -> r) modulo higher-rank types. Let's try it:
vmhead :: Vec a n -> Maybe a
vmhead VNil = Nothing
vmhead (VCons x xs) = Just x
main = do
print $ vfromList ([] :: [Int]) vmhead -- Nothing
print $ vfromList [1..5] vmhead -- Just 1
Works. But aren't we just repeat ourself? Why vmhead, when there is vhead already? Should we rewrite all safe functions in an unsafe way to make is possible to use them on runtime data? That would be silly.
All we need is to ensure, that all invariants hold. Let's try this principle on the vtake function:
fromIntFinny :: Int -> (forall n m. Finny n m -> b) -> b
fromIntFinny 0 f = f FZ
fromIntFinny n f = fromIntFinny (n - 1) (f . FS)
main = do
xs <- readLn :: IO [Int]
i <- read <$> getLine
putStrLn $
fromIntFinny i $ \i' ->
vfromList xs $ \xs' ->
undefined -- what's here?
fromIntFinny is just like vfromList. It's instructive to see, what the types are:
i' :: Finny n m
xs' :: Vec a p
But vtake has this type: Finny0 n m -> Vec a n -> Vec a m. So we need to coerce i', so that it would be of type Finny0 p m. And also toNatFinny i' must be equal to toNatFinny coerced_i'. But this coercion is not possible in general, since if S p < n, then there are elements in Finny n m, that are not in Finny (S p) m, since S p and n are upper bounds.
coerceFinnyBy :: Finny n m -> Natty p -> Maybe (Finny0 p m)
coerceFinnyBy FZ p = Just FZ
coerceFinnyBy (FS i) (Sy p) = fmap FS $ i `coerceFinnyBy` p
coerceFinnyBy _ _ = Nothing
That's why there is Maybe here.
main = do
xs <- readLn :: IO [Int]
i <- read <$> getLine
putStrLn $
fromIntFinny i $ \i' ->
vfromList xs $ \xs' ->
case i' `coerceFinnyBy` vlength xs' of
Nothing -> "What should I do with this input?"
Just i'' -> show $ vtoList $ vtake i'' xs'
In the Nothing case a number, that was read from the input, is bigger, than the length of a list. In the Just case a number is less or equal to the length of a list and coerced to the appropriate type, so vtake i'' xs' is well-typed.
This works, but we introduced the coerceFinnyBy function, that looks rather ad hoc. Decidable "less or equal" relation would be the appropriate alternative:
data (:<=) :: Nat -> Nat -> * where
Z_le_Z :: Z :<= m -- forall n, 0 <= n
S_le_S :: n :<= m -> S n :<= S m -- forall n m, n <= m -> S n <= S m
type n :< m = S n :<= m
(<=?) :: Natty n -> Natty m -> Either (m :< n) (n :<= m) -- forall n m, n <= m || m < n
Zy <=? m = Right Z_le_Z
Sy n <=? Zy = Left (S_le_S Z_le_Z)
Sy n <=? Sy m = either (Left . S_le_S) (Right . S_le_S) $ n <=? m
And a safe injecting function:
inject0Le :: Finny0 n p -> n :<= m -> Finny0 m p
inject0Le FZ _ = FZ
inject0Le (FS i) (S_le_S le) = FS (inject0Le i le)
I.e. if n is an upper bound for some number and n <= m, then m is an upper bound for this number too. And another one:
injectLe0 :: Finny n p -> n :<= m -> Finny0 m p
injectLe0 FZ (S_le_S le) = FZ
injectLe0 (FS i) (S_le_S le) = FS (injectLe0 i le)
The code now looks like this:
getUpperBound :: Finny n m -> Natty n
getUpperBound = undefined
main = do
xs <- readLn :: IO [Int]
i <- read <$> getLine
putStrLn $
fromIntFinny i $ \i' ->
vfromList xs $ \xs' ->
case getUpperBound i' <=? vlength xs' of
Left _ -> "What should I do with this input?"
Right le -> show $ vtoList $ vtake (injectLe0 i' le) xs'
It compiles, but what definition should getUpperBound have? Well, you can't define it. A n in Finny n m lives only at the type level, you can't extract it or get somehow. If we can't perform "downcast", we can perform "upcast":
fromIntNatty :: Int -> (forall n. Natty n -> b) -> b
fromIntNatty 0 f = f Zy
fromIntNatty n f = fromIntNatty (n - 1) (f . Sy)
fromNattyFinny0 :: Natty n -> (forall m. Finny0 n m -> b) -> b
fromNattyFinny0 Zy f = f FZ
fromNattyFinny0 (Sy n) f = fromNattyFinny0 n (f . FS)
For comparison:
fromIntFinny :: Int -> (forall n m. Finny n m -> b) -> b
fromIntFinny 0 f = f FZ
fromIntFinny n f = fromIntFinny (n - 1) (f . FS)
So a continuation in fromIntFinny is universally quantified over the n and m variables, while a continuation in fromNattyFinny0 is universally quantified over just m. And fromNattyFinny0 receives a Natty n instead of Int.
There is Finny0 n m instead of Finny n m, because FZ is an element of forall n m. Finny n m, while FZ is not necessarily an element of forall m. Finny n m for some n, specifically FZ is not an element of forall m. Finny 0 m (so this type is uninhabited).
After all, we can join fromIntNatty and fromNattyFinny0 together:
fromIntNattyFinny0 :: Int -> (forall n m. Natty n -> Finny0 n m -> b) -> b
fromIntNattyFinny0 n f = fromIntNatty n $ \n' -> fromNattyFinny0 n' (f n')
Achieving the same result, as in the #pigworker's answer:
unLenList :: LenList a -> (forall n. Natty n -> Vec n a -> t) -> t
unLenList (LenList xs) k = k natty xs
Some tests:
main = do
xs <- readLn :: IO [Int]
ns <- read <$> getLine
forM_ ns $ \n -> putStrLn $
fromIntNattyFinny0 n $ \n' i' ->
vfromList xs $ \xs' ->
case n' <=? vlength xs' of
Left _ -> "What should I do with this input?"
Right le -> show $ vtoList $ vtake (inject0Le i' le) xs'
for
[1,2,3,4,5,6]
[0,2,5,6,7,10]
returns
[]
[1,2]
[1,2,3,4,5]
[1,2,3,4,5,6]
What should I do with this input?
What should I do with this input?
The code: http://ideone.com/3GX0hd
EDIT
Well, you can't define it. A n in Finny n m lives only at the type
level, you can't extract it or get somehow.
That's not true. Having SingI n => Finny n m -> ..., we can get n as fromSing sing.
For example I want to make a type MyType of integer triples. But not just Cartesian product of three Integer, I want the type to represent all (x, y, z) such that x + y + z = 5.
How do I do that? Except of using just (x, y) since z = 5 - x - y.
And the same question if I have three constructors A, B, C and the type should be all (A x, B y, C z) such that x + y + z = 5.
I think the trick here is that you don't enforce it on the type-level, you use "smart constructors": i.e. only allow creation of such "tuples" via a function that generates such values:
module Test(MyType,x,y,z,createMyType) where
data MyType = MT { x :: Int, y :: Int, z :: Int }
createMyType :: Int -> Int -> MyType
createMyType myX myY = MT { x = myX, y = myY, z = 5 - myX - myY }
If you want to generate all possible such values, then you can write a function to do so, either with provided or specified bounds.
It may very well be possible to use type-level Church Numerals or some such so as to enforce creation of these, but it's almost definitely too much work for what you probably want/need.
This might not be what you want (i.e. "Except of using just (x, y) since z = 5 - x - y") but it makes more sense than trying to have some kind of enforced restriction on the type level for allowing valid values.
Types can ensure the correct "type" of value (no pun intended); to ensure validity of values you hide the constructor and only allow creation via approved functions that guarantee any invariants you require.
Yes, smart constructors or Agda are the way to go here, but if you really wanted to go crazy with the "dependent" approach, in Haskell:
{-# LANGUAGE GADTs, TypeFamilies, RankNTypes, StandaloneDeriving, UndecidableInstances, TypeOperators #-}
data Z = Z
data S n = S n
data Nat n where
Zero :: Nat Z
Suc :: Nat n -> Nat (S n)
deriving instance Show (Nat n)
type family (:+) a b :: *
type instance (:+) Z b = b
type instance (:+) (S a) b = S (a :+ b)
plus :: Nat x -> Nat y -> Nat (x :+ y)
plus Zero y = y
plus (Suc x) y = Suc (x `plus` y)
type family (:*) a b :: *
type instance (:*) Z b = Z
type instance (:*) (S a) b = b :+ (a :* b)
times :: Nat x -> Nat y -> Nat (x :* y)
times Zero y = Zero
times (Suc x) y = y `plus` (x `times` y)
data (:==) a b where
Refl :: a :== a
deriving instance Show (a :== b)
cong :: a :== b -> f a :== f b
cong Refl = Refl
data Triple where
Triple :: Nat x -> Nat y -> Nat z -> (z :== (x :+ y)) -> Triple
deriving instance Show Triple
-- Half a decision procedure
equal :: Nat x -> Nat y -> Maybe (x :== y)
equal Zero Zero = Just Refl
equal (Suc x) Zero = Nothing
equal Zero (Suc y) = Nothing
equal (Suc x) (Suc y) = cong `fmap` equal x y
triple' :: Nat x -> Nat y -> Nat z -> Maybe Triple
triple' x y z = fmap (Triple x y z) $ equal z (x `plus` y)
toNat :: (forall n. Nat n -> r) -> Integer -> r
toNat f n | n < 0 = error "why can't we have a natural type?"
toNat f 0 = f Zero
toNat f n = toNat (f . Suc) (n - 1)
triple :: Integer -> Integer -> Integer -> Maybe Triple
triple x y z = toNat (\x' -> toNat (\y' -> toNat (\z' -> triple' x' y' z') z) y) x
data Yatima where
Yatima :: Nat x -> Nat y -> Nat z -> ((x :* x) :+ (y :* y) :+ (z :* z) :== S (S (S (S (S Z))))) -> Yatima
deriving instance Show Yatima
yatima' :: Nat x -> Nat y -> Nat z -> Maybe Yatima
yatima' x y z =
fmap (Yatima x y z) $ equal ((x `times` x) `plus` (y `times` y) `plus` (z `times` z)) (Suc (Suc (Suc (Suc (Suc Zero)))))
yatima :: Integer -> Integer -> Integer -> Maybe Yatima
yatima x y z = toNat (\x' -> toNat (\y' -> toNat (\z' -> yatima' x' y' z') z) y) x
{-
λ> triple 3 4 5
Nothing
λ> triple 3 4 7
Just (Triple (Suc (Suc (Suc Zero))) (Suc (Suc (Suc (Suc Zero)))) Refl (Suc (Suc (Suc (Suc (Suc (Suc (Suc Zero))))))))
λ> yatima 0 1 2
Just (Yatima Zero (Suc Zero) (Suc (Suc Zero)) Refl)
λ> yatima 1 1 2
Nothing
-}
And bam, you have a statically checked invariant in your code! Except you can lie...
The normal dependently-typed way to do this would be to use a sigma (dependent product) type, for example in Agda:
open import Relation.Binary.PropositionalEquality (_≡_)
open import Data.Nat (ℕ; _+_)
open import Data.Product (Σ; ×; _,_)
FiveTriple : Set
FiveTriple = Σ (ℕ × ℕ × ℕ) (λ{ (x , y , z) → x + y + z ≡ 5 })
someFiveTriple : FiveTriple
someFiveTriple = (0 , 2 , 5) , refl
This is why Σ is often called an ‘existential’ type: it allows you to specify both some data and some property about that data.
I'm not an expert on this, but I don't think you can implement this in Haskell at the type level, as Haskell does not support dependent types. You might want to look at Agda.
Just elaborating on ivanm's answer:
data MyType = MT {x :: Int, y :: Int, z :: Int } deriving Show
createMyType :: Int -> Int -> Int -> Maybe MyType
createMyType a b c
| a + b + c == 5 = Just MT { x = a, y = b, z = c }
| otherwise = Nothing