Can I get KnownNat n to imply KnownNat (n * 3), etc? - haskell

I'm working with data types of this shape, using V from linear:
type Foo n = V (n * 3) Double -> Double
Having it fixed on n is pretty important, because I want to be able to ensure that I'm passing in the right number of elements at compile-time. This is a part of my program that already works well, independent of what I'm doing here.
For any KnownNat n, I can generate a Foo n satisfying the behavior that my program needs. For the purposes of this question it can be something silly like
mkFoo :: KnownNat (n * 3) => Foo n
mkFoo = sum
Or for a more meaningful example, it can generate a random V of the same length and use dot on the two. The KnownNat constraint here is redundant, but in reality, it's needed to do make a Foo. I make one Foo and use it for my entire program (or with multiple inputs), so this guarantees me that whenever I use it, I'm using on things with the same length, and on things that the structure of the Foo dictates.
And finally, I have a function that makes inputs for a Foo:
bar :: KnownNat (n * 3) => Proxy n -> [V (n * 3) Double]
bar is actually the reason why i'm using n * 3 as a type function, instead of just manually expanding it out. The reason is that bar might do its job by using three vectors of length n and appending them all together as a vector of length n * 3. Also, n is a much more meaningful parameter to the function, semantically, than n * 3. This also lets me disallow improper values like n's that aren't multiples of 3, etc.
Now, before, everything worked fine as long as I defined a type synonym at the beginning:
type N = 5
And I can just then pass in Proxy :: Proxy N to bar, and use mkFoo :: Foo N. And everything worked fine.
-- works fine
doStuff :: [Double]
doStuff = let inps = bar (Proxy :: Proxy N)
in map (mkFoo :: Foo N) inps
But now I want to be able to adjust N during runtime by loading information from a file, or from command line arguments.
I tried doing it by calling reflectNat:
doStuff :: Integer -> Double
doStuff n = reflectNat 5 $ \pn#(Proxy :: Proxy n) ->
let inps = bar (Proxy :: Proxy n)
in map (mkFoo :: Foo n) inps
But...bar and mkFoo require KnownNat (n * 3), but reflectNat just gives me KnownNat n.
Is there any way I can generalize the proof that reflectNat gives me to satisfy foo ?

So, three months later, I have been going back and forth on good ways to accomplish this, but I finally settled on an actual very succinct trick that doesn't require any throwaway newtypes; it involves using a Dict from the constraints library; you could easily write a:
natDict :: KnownNat n => Proxy n -> Dict (KnownNat n)
natDict _ = Dict
triple :: KnownNat n => Proxy n -> Dict (KnownNat (n * 3))
triple p = reifyNat (natVal p * 3) $
\p3 -> unsafeCoerce (natDict p3)
And once you get Dict (KnownNat (n * 3), you can pattern match on it to get the (n * 3) instance in scope:
case triple (Proxy :: Proxy n) of
Dict -> -- KnownNat (n * 3) is in scope
You can actually set these up as generic, too:
addNats :: (KnownNat n, KnownNat m) => Proxy n -> Proxy m -> Dict (KnownNat (n * m))
addNats px py = reifyNat (natVal px + natVal py) $
\pz -> unsafeCoerce (natDict pz)
Or, you can make them operators and you can use them to "combine" Dicts:
infixl 6 %+
infixl 7 %*
(%+) :: Dict (KnownNat n) -> Dict (KnownNat m) -> Dict (KnownNat (n + m))
(%*) :: Dict (KnownNat n) -> Dict (KnownNat m) -> Dict (KnownNat (n * m))
And you can do things like:
case d1 %* d2 %+ d3 of
Dict -> -- in here, KnownNat (n1 * n2 + n3) is in scope
I've wrapped this up in a nice library, typelits-witnesses that I've been using. Thank you all for your help!

I post another answer as it is more direct, editing the previous won't make sense.
In fact using the trick (popularised if not invented by Edward Kmett), from reflections reifyNat:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
import GHC.TypeLits
import Data.Proxy
import Unsafe.Coerce
newtype MagicNat3 r = MagicNat3 (forall (n :: Nat). KnownNat (n * 3) => Proxy n -> r)
trickValue :: Integer -> Integer
trickValue = (*3)
-- No type-level garantee that the function will be called with (n * 3)
-- you have to believe us
trick :: forall a n. KnownNat n => Proxy n -> (forall m. KnownNat (m * 3) => Proxy m -> a) -> a
trick p f = unsafeCoerce (MagicNat3 f :: MagicNat3 a) (trickValue (natVal p)) Proxy
test :: forall m. KnownNat (m * 3) => Proxy m -> Integer
test _ = natVal (Proxy :: Proxy (m * 3))
So when you run it:
λ *Main > :t trick (Proxy :: Proxy 4) test :: Integer
trick (Proxy :: Proxy 4) test :: Integer :: Integer
λ *Main > trick (Proxy :: Proxy 4) test :: Integer
12
The trick is based on the fact that in GHC the one member class dictionaries (like KnownNat) are represented by the member itself. In KnownNat situation it turns out to be Integer. So we just unsafeCoerce it there. Universal quantification makes it sound from the outside.

Your question isn't very descriptive, so I'll try my best to feel blanks:
Let's assume that Blah n is Proxy n.
I also assume that reflectNat is a way to call universally quantified (over typelevel Nat) function, using term-level natural number.
I don't know better way than writing your own reflectNat providing that
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
import GHC.TypeLits
import Data.Proxy
data Vec a (n :: Nat) where
Nil :: Vec a 0
Cons :: a -> Vec a n -> Vec a (1 + n)
vecToList :: Vec a n -> [a]
vecToList Nil = []
vecToList (Cons h t) = h : vecToList t
repl :: forall n a. KnownNat n => Proxy n -> a -> Vec a n
repl p x = undefined -- this is a bit tricky with Nat from GHC.TypeLits, but possible
foo :: forall (n :: Nat). KnownNat (1 + n) => Proxy n -> Vec Bool (1 + n)
foo _ = repl (Proxy :: Proxy (1 + n)) True
-- Here we have to write our own version of 'reflectNat' providing right 'KnownNat' instances
-- so we can call `foo`
reflectNat :: Integer -> (forall n. KnownNat (1 + n) => Proxy (n :: Nat) -> a) -> a
reflectNat = undefined
test :: [Bool]
test = reflectNat 5 $ \p -> vecToList (foo p)
Alternatively, using singletons you can use SomeSing. Then types will be different
reflectNat :: Integer -> (forall (n :: Nat). SomeSing (n :: Nat) -> a) -> a
I.e. instead of magic dict KnownNat you have concrete singleton value. Thus in foo you'd need to construct SomeSing (1 + n) explicitly, given SomeSing n -- which is quite simple.
In run-time both KnownNat dictionary and SomeSing value will be passed around carring the number value, and explicit is IMHO better in this situation.p)

Related

fill a linked list, having information about the length encoded in the type, with values

I'm currently having some fun approaching typelevel programming.
Consider the following version of a linked list
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ExpLinkedList where
import GHC.TypeLits (Nat, KnownNat , type (-), type (+))
import Data.Proxy (Proxy(..))
import Data.Kind (Type)
import Fcf (TyEq, If, Eval)
data LinkedList (n :: Nat) (a :: Type) where
Nil :: LinkedList 0 a
(:#) :: a -> LinkedList n a -> LinkedList (n + 1) a
infixr 5 :#
someList :: LinkedList 2 String
someList = "test" :# "list" :# Nil
I was wondering whether it's possible to define a function which extends a LinkedList?
For example
extend :: forall m n a . LinkedList n a -> a -> LinkedList (n + m) a
extend vec elem = undefined
example :: LinkedList 5 String
example = extend #3 ("foo" :# "bar" :# Nil) "hi"
-- could be: "hi" :# "hi" :# "hi" :# "foo" :# "bar" :# Nil
I came up with different approaches which all got stuck sooner or later... Here are two of them:
Recursive Approach
In this approach, the end condition is encoded by an overlapping typeclass instance
class Extend (b :: Nat) where
ex :: a -> LinkedList n a -> LinkedList (n + b) a
instance {-# OVERLAPPING #-} Extend 0 where
ex _ vec = vec
instance Extend n where
ex a vec = nextEx newVec
-- ^
-- • Couldn't match type ‘(n1 + 1) + (n - 1)’ with ‘n1 + n’
-- Expected type: LinkedList (n1 + n) a
-- Actual type: LinkedList ((n1 + 1) + (n - 1)) a
where
newVec = a :# vec
nextEx = ex #(n - 1) a
Inductive Approach
type NextElement (n :: Nat) = Just (n - 1)
class BuildHelper (v :: Maybe Nat) (a :: Type) where
type CNE v a :: Type
buildNext :: Proxy v -> a -> CNE v a
instance BuildHelper 'Nothing a where
type CNE 'Nothing a = LinkedList 0 a
buildNext _ a = Nil
instance BuildHelper ('Just m) a where
type CNE ('Just m) a = LinkedList (m + 1) a
buildNext _ a = a :# buildNext proxy a
-- ^
-- • Couldn't match expected type ‘LinkedList m a’
-- with actual type ‘CNE
-- (If (TyEq m 0) 'Nothing ('Just (m - 1)))
where
proxy = Proxy #(NextElement m)
Evaluating this with pen and paper seems to work
-- buildNext (Proxy #(Just 2) True) :: proxy -> Bool -> Vector 3 Bool
-- = a :# buildNext #(NextElement 2) a
-- = a :# buildNext #(Just 1) a
-- = a :# a :# buildNext #(NextElement 1) a
-- = a :# a :# buildNext #(Just 0) a
-- = a :# a :# a :# buildNext #(NextElement 0) a
-- = a :# a :# a :# buildNext #(Nothing) a
-- = a :# a :# a :# Nil
Basically GHC is not able to proof that m matches (m - 1) + 1.
This is a typical use case for singletons.
Moreover, this solution relies on arithmetic properties, which are not available natively in GHC's typechecker, but are provided by the ghc-typelits-natnormalise plugin.
Plugin for reasoning about Nat
Specifically, appending length-indexed lists makes use of the associativity of (+): in the case where m = p + 1, the type of output lists in the signature of extend is LList (n + m) = LList (n + (p + 1)) which requires associativity to equal LList ((n + p) + 1) so that the constructor (:#) can be used. We also need commutativity unless we're careful in our code and proofs to not mix up 1 + p and p + 1 for example. In any case, installing that package and adding the following line teaches GHC some basic arithmetic:
{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} -- from the package ghc-typelits-natnormalise
Note that we won't have to do any such reasoning explicitly in code; the plugin provides knowledge to the compiler during typechecking.
Singletons
The function extend :: forall n m a. a -> LList m a -> LList (n + m) a needs to look at the value of m to know how many as to insert; we must change the type of extend to provide the necessary run-time information. A general solution is offered by singletons. Specifically we can define the following singleton type for the Nat kind, which has the characteristic that the run time representation of a value of type SNat n (i.e., look only at the constructors SZ and SS) uniquely determines the index n:
data SNat (n :: Nat) where
SZ :: SNat 0
SS :: SNat n -> SNat (1 + n)
See also the blog post Introduction to singletons.
Definition of extend
Then the idea is to change the signature from extend :: forall n. ... to extend :: SNat n -> ..., augmenting quantification on Nat (forall n), which will be erased at run time, with a SNat n parameter with a concrete run-time representation. The function can then be defined by pattern-matching on the SNat n argument:
extend :: SNat n -> a -> LList m a -> LList (n + m) a
extend SZ _ ys = ys
extend (SS n) x ys = x :# extend n x ys
Remark that if we ignore the types, this definition is identical to a variant of extend on simple lists (not indexed by their length) using simple Peano naturals. The function extend is one of many examples with indexed types which are merely more precisely typed versions of unindexed programs:
-- Peano representation of natural numbers
data PNat where
Z :: PNat
S :: PNat -> PNat
-- Non-indexed variant of extend
extendP :: PNat -> a -> [a] -> [a]
extendP Z _ ys = ys
extendP (S n) x ys = x : extendP n x ys
Example
An example using extend:
example :: LList 5 String
example = extend (SS (SS (SS SZ))) "hi" ("foo" :# "bar" :# Nil)
We have to write numbers in unary, which is not very fun. We can use type classes to convert Nat literals to their SNat singleton values.
Constructing SNat implicitly
class ISNat n where
snat :: SNat n
As you might already expect, there are going to be two instances, for 0 and successors respectively. 0 is the obvious one:
instance ISNat 0 where
snat = SZ
For successors, the term-level part is straightforward (snat = SS snat), but the types require a couple of tricks.
instance {-# OVERLAPPABLE #-} (ISNat p, n ~ (1 + p)) => ISNat n where
snat = SS snat
First, OVERLAPPABLE. There is no easy way to syntactically identify a type parameter n as "not 0", so we use an OVERLAPPABLE instance. (There are other ways when overlap is unacceptable, but they are not as convenient.) When encountering an ISNat n constraint, the typechecker will always picks the most specific instance possible: if n is 0 it will pick the 0 instance, if n is a non-zero literal, it will pick this overlappable instance for successors because the 0 instance is not applicable, and if n is not equal to a literal (so it is an unconstrained type variable or some stuck type family application), the 0 instance might apply, we don't really know, so the typechecker will conservatively not pick either of these instances, and it will instead look in elsewhere its context for a suitable constraint, raising a compile-time error if none is found.
Second, SS wants its result type to be of the form SNat (1 + p). So we add a constraint n ~ (1 + p).
Note that to solve that constraint (when using snat), GHC will need to guess p, which the natnormalise plugin takes care of here; otherwise we could also have added a constraint p ~ (n - 1).
With that we can finally write the example more conveniently using a Nat literal:
extend (snat :: SNat 3) "hi" ("foo" :# "bar" :# Nil)
The snat :: SNat bit might seem a little crufty. Taking care of that is left as an exercise for the reader.
Full gist: https://gist.github.com/Lysxia/cf0f8ae509d36a11ddf58bfcea8abb89

Is posible to create an infinite wrapper in Haskell with Rank N types?

I tried this experiment:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
wrapper :: forall a (b :: * -> *). Monad b => Int -> a -> b a
wrapper 1 v = return v
wrapper n v = return $ wrapper (n-1) v
But it gives to me the error:
Occurs check: cannot construct the infinite type: a ~ b0 a
Expected type: b a
Actual type: b (b0 a)
• In the expression: return $ wrapper (n - 1) v
In an equation for ‘wrapper’:
wrapper n v = return $ wrapper (n - 1) v
• Relevant bindings include
v :: a (bound at main.hs:7:11)
wrapper :: Int -> a -> b a (bound at main.hs:6:1)
Is it possible to create the function wrapper such as:
wrapper 4 'a' :: [Char]
[[[['a']]]]
Yes and no!
First of all, your type is inaccurate in the signature of the function. Taking your example of wrapper 4 'a', the return type of the function is m (m (m (m a))) (where m is []), not m a.
Secondly, we're not allowed infinite types in Haskell's type system, so we wouldn't be able to write down the correct type even if we wanted to!
That said, we can address both of these concerns with some new types that will do the type-level recursion for us. First, there's Fix:
newtype Fix f a = Fix { unFix :: f (Fix f a) }
Using this we can wrap infinitely:
wrap :: Monad m => Fix m a
wrap = Fix $ return $ wrap
As you can see, we don't need the base element (the a in your example) because we'll never hit the base of the recursion.
But that's not what you wanted either! The "infinite" here is actually something of a red herring: you want to be able to wrap something a finite number of times, using an argument to dictate the wrapping level.
You can do something like this with another wrapper:
data Wrap f a = Pure a | Wrap (f (Wrap f a))
wrapper :: Monad f => Int -> a -> Wrap f a
wrapper 0 x = Pure x
wrapper n x = Wrap $ pure $ wrapper (n-1) x
(This is in fact the free monad that we're using here)
What you're looking for exactly, though (i.e., no wrappers) can be done, however, it's quite involved, and probably not what you're looking for. I'll include it for completeness nonetheless.
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
import Data.Kind
import GHC.TypeLits
data N = Z | S N
type family Wrap (n :: N) (f :: Type -> Type) (a :: Type) :: Type where
Wrap Z f a = a
Wrap (S n) f a = Wrap n f (f a)
type family FromNat (n :: Nat) :: N where
FromNat 0 = Z
FromNat n = S (FromNat (n - 1))
data Ny (n :: N) where
Zy :: Ny Z
Sy :: Ny n -> Ny (S n)
class KnownN n where sing :: Ny n
instance KnownN Z where sing = Zy
instance KnownN n => KnownN (S n) where sing = Sy sing
wrap :: forall n f a. (KnownN (FromNat n), Monad f) => a -> Wrap (FromNat n) f a
wrap = go #(FromNat n) #f #a sing
where
go :: forall n f a. Monad f => Ny n -> a -> Wrap n f a
go Zy x = x
go (Sy n) x = go #_ #f n (return #f x)
main = print (wrap #4 'a' == [[[['a']]]])

Declare a type to for all higher order kind

I have a feeling I'm asking the impossible, but here it goes.
I want to associate type constructors with a fully applied version that number's the parameters at the type level with natural numbers. Here's an example ghci session with its desired use:
ghci> :kind! MKNumbered Maybe
MKNumbered Maybe :: *
= Maybe (Proxy Nat 1)
ghci> :kind! MKNumbered Either
MKNumbered Either :: *
= Either (Proxy Nat 1) (Proxy Nat 2)
To cut down on the noise of the above a little bit, essentially I get something like
Maybe >----> Maybe 1
Either >----> Either 1 2
It turns out, I can get close enough with the following type families. They actually use an extra parameter, specifying the total number of arguments, but that's ok.
type MkNumbered f n = UnU (MkNumbered_ (U f) 1 n)
type family MkNumbered_ (f :: k) (i::Nat) (n::Nat) :: j where
MkNumbered_ (U f) i i = U (f (Proxy i))
MkNumbered_ (U f) i n = MkNumbered_ (U (f (Proxy i))) (i+1) n
data U (a::k)
type family UnU f :: * where
UnU (U f) = f
The U type is another proxy which seems necessary to get behavior I wanted. If I have a fully applied U, i.e. U (a :: *) I can unwrap it with UnU.
The shortcoming of the above is that, since Proxy i :: *, MkNumbered can only handle constructors with * variables. Numbering
data A (f :: * -> *) a = ...
is out, A (Proxy 1) (Proxy 2) won't work in the Proxy 1 argument. I should be able to enhance MkNumbered, by introducing a number of specific numbering proxies:
data NPxy1 (n :: Nat)
data NPxy2 (n :: Nat) (a :: i)
data NPxy3 (n :: Nat) (a :: i) (b :: j)
...
This should leave me with behavior like:
ghci> :kind! MKNumbered A
MKNumbered A :: *
= A (NPxy2 Nat 1) (NPxy1 Nat 2)
That helps a lot, just those three NPxy definitions probably cover most of the higher ordered kind cases. But I was wondering if there was a way to enhance this so that I could cover all k -> j -> ... -> * cases?
Incidentally, I don't seriously hope to handle types like
data B (b::Bool) = ...
I would need something like this illegal definition:
data NPxyBool (n :: Nat) :: Bool
In any case, all the Bool types seem to be taken already. Going further, I'd be thrilled to learn that there was a way to create some data
data UndefinedN (n :: Nat) :: forall k . k
which I called UndefinedN since it seems like a bottom at the kind level.
Edit: Intended Use
The crux of my intended use is to query a type for the proxied parameter.
type family GetN s (a :: k) :: k
GetN (Either Int Char) (Proxy 1) ~ Int
However, I also require that if the Proxy index is some other specific type besides Proxy n, then that type is just returned.
GetN (Either Int Char) Maybe ~ Maybe
However, any type family solution for Proxy n makes writing family instances for GetN with Proxy n on the lhs illegal. I'm open to type class based solutions, where we can have:
instance (Proxy n ~ pxy, GetNat s n ~ a) => GetN s pxy a where...
but my requirement to also resolve concrete values to themselves causes conflicting instance definitions that I'm also having trouble to resolve.
The rest of this is just for information sake, but having the above I should be able to derive sub-data from my proxy parameter types. For example, filling in my definition of A, above:
data A f a = A { unA :: f (Maybe a) }
the sub-data at unA, as numbered parameters looks like:
type UnANums = (Proxy 1) (Maybe (Proxy 2))
I would like to derive a type family (or some other method) that creates a concrete sub-data based on an example of the super-data.
type family GetNs s (ns :: k) :: k
GetNs (A [] Int) UnANums ~ [Maybe Int]
GetNs (A (Either String) Char) UnANums ~ Either String (Maybe Char)
Ultimately, this is leading to deriving traversal signatures generically. Given a source and target contexts, for instance A f a and A g b, in a Generic representation I will have at the K1 nodes types like UnANums, from which I can derive a source and target to traverse to.
How about this:
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
module SO56047176 where
import GHC.TypeLits
import Data.Functor.Compose -- for example
type family Proxy (n :: Nat) :: k
type Maybe_ = Maybe (Proxy 0)
type Either__ = Either (Proxy 0) (Proxy 1)
type Compose___ = Compose (Proxy 0) (Proxy 1) (Proxy 2)
Data.Functor.Compose takes two (->)-kinded parameters, but Proxy 0 and Proxy 1 still work.
I found a solution by way of type and data families combined. Starting with the data definition:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
import GHC.TypeLits hiding ( (*) )
import Data.Kind
class HasNProxyK j where
data NProxyK (n :: Nat) (a::j) :: k
instance HasNProxyK Type where
data NProxyK n a = NProxyK0
instance HasNProxyK k => HasNProxyK (j -> k) where
data NProxyK n f = NProxyKSuc -- or NProxyKS (ProxyK n (f a))
I declare a type class HasNProxyK for which kinds will be instances. The associated data, NProxyK expects a Nat and some variable of the appropriate kind, j. The return type of this data family will be some other kind, k.
I then create a base case for Type, (aka *), and an inductive case for all higher kinds that eventually lead to a kind with HasNProxyK.
Checking this out in a GHCI session:
> :kind! NProxyK 3 Int
NProxyK 3 Int :: k
= NProxyK * k 3 Int
> :kind! NProxyK 3 (,,,,)
NProxyK 3 (,,,,) :: k
= NProxyK (* -> * -> * -> * -> * -> *) k 3 (,,,,)
We see that this proxy is almost ready. The lhs of the return shows that the type has a kind k, but the first kind parameter on the rhs (which I believe corresponds to the class parameter) has the appropriate kind.
We could specify at the call site the appropriate kind for k, instead I just made a type family to ensure the NProxyK kind matches the class kind.
type family ToNProxyK (n :: Nat) (a :: k) :: k where
ToNProxyK n (a :: Type) = NProxyK n a
ToNProxyK n (a :: j -> k) = NProxyK n a
>:kind! ToNProxyK 1 (,,,,)
ToNProxyK 1 (,,,,) :: * -> * -> * -> * -> * -> *
= NProxyK
(* -> * -> * -> * -> * -> *) (* -> * -> * -> * -> * -> *) 1 (,,,,)
Now, the Nat can be recovered using something like the following family:
type family LookupN (x :: k) :: Maybe Nat where
LookupN (NProxyK n a) = Just n
LookupN x = Nothing
>:kind! (LookupN (ToNProxyK 3 Maybe))
(LookupN (ToNProxyK 3 Maybe)) :: Maybe Nat
= 'Just Nat 3
>:kind! (LookupN Maybe)
(LookupN Maybe) :: Maybe Nat
= 'Nothing Nat

How to deconstruct an SNat (singletons)

I am experimenting with depedent types in Haskell and came across the following in the paper of the 'singletons' package:
replicate2 :: forall n a. SingI n => a -> Vec a n
replicate2 a = case (sing :: Sing n) of
SZero -> VNil
SSucc _ -> VCons a (replicate2 a)
So I tried to implement this myself, just toget a feel of how it works:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Singletons
import Data.Singletons.Prelude
import Data.Singletons.TypeLits
data V :: Nat -> * -> * where
Nil :: V 0 a
(:>) :: a -> V n a -> V (n :+ 1) a
infixr 5 :>
replicateV :: SingI n => a -> V n a
replicateV = replicateV' sing
where replicateV' :: Sing n -> a -> V n a
replicateV' sn a = case sn of
SNat -> undefined -- what can I do with this?
Now the problem is that the Sing instance for Nat does not have SZero or SSucc. There is only one constructor called SNat.
> :info Sing
data instance Sing n where
SNat :: KnownNat n => Sing n
This is different than other singletons that allow matching, such as STrue and SFalse, such as in the following (useless) example:
data Foo :: Bool -> * -> * where
T :: a -> Foo True a
F :: a -> Foo False a
foo :: forall a b. SingI b => a -> Foo b a
foo a = case (sing :: Sing b) of
STrue -> T a
SFalse -> F a
You can use fromSing to get a base type, but this of course does allow GHC to check the type of the output vector:
-- does not typecheck
replicateV2 :: SingI n => a -> V n a
replicateV2 = replicateV' sing
where replicateV' :: Sing n -> a -> V n a
replicateV' sn a = case fromSing sn of
0 -> Nil
n -> a :> replicateV2 a
So my question: how to implement replicateV?
EDIT
The answer given by erisco explains why my approach of deconstructing an SNat does not work. But even with the type-natural library, I am unable to implement replicateV for the V data type using GHC's build-in Nat types.
For example the following code compiles:
replicateV :: SingI n => a -> V n a
replicateV = replicateV' sing
where replicateV' :: Sing n -> a -> V n a
replicateV' sn a = case TN.sToPeano sn of
TN.SZ -> undefined
(TN.SS sn') -> undefined
But this does not seem to give enough information to the compiler to infer whether n is 0 or not. For example the following gives a compiler error:
replicateV :: SingI n => a -> V n a
replicateV = replicateV' sing
where replicateV' :: Sing n -> a -> V n a
replicateV' sn a = case TN.sToPeano sn of
TN.SZ -> Nil
(TN.SS sn') -> undefined
This gives the following error:
src/Vec.hs:25:28: error:
• Could not deduce: n1 ~ 0
from the context: TN.ToPeano n1 ~ 'TN.Z
bound by a pattern with constructor:
TN.SZ :: forall (z0 :: TN.Nat). z0 ~ 'TN.Z => Sing z0,
in a case alternative
at src/Vec.hs:25:13-17
‘n1’ is a rigid type variable bound by
the type signature for:
replicateV' :: forall (n1 :: Nat) a1. Sing n1 -> a1 -> V n1 a1
at src/Vec.hs:23:24
Expected type: V n1 a1
Actual type: V 0 a1
• In the expression: Nil
In a case alternative: TN.SZ -> Nil
In the expression:
case TN.sToPeano sn of {
TN.SZ -> Nil
(TN.SS sn') -> undefined }
• Relevant bindings include
sn :: Sing n1 (bound at src/Vec.hs:24:21)
replicateV' :: Sing n1 -> a1 -> V n1 a1 (bound at src/Vec.hs:24:9)
So, my original problem still remains, I am still unable to do anything usefull with the SNat.
There are two notions of naturals at play here. One is "literal naturals" (i.e. 0, 1, 2, and so on) and the other is "Peano naturals" (i.e. Z, S Z, S (S Z), and so on). The one the paper is using is clearly Peano naturals but the one singletons uses is literal naturals.
Thankfully there is another package called type-natural which defines Peano naturals as well as conversion to literal naturals and conversion from literal naturals.
From the comments, I'm worried I must be missing something terrifically obvious, but here's my take on it. The whole point of:
replicate2 :: forall n a. SingI n => a -> Vec a n
replicate2 a = case (sing :: Sing n) of
SZero -> VNil
SSucc _ -> VCons a (replicate2 a)
is that, in order to return VNil :: Vec a 0 when the function has general return type Vec a n, you need to specialize the n to 0, and pattern-matching on GADTs provides a way to do this, as long as you have a constructor, like SZero, that implies n ~ 0.
Now the SNats in the singleton package have no such constructor. The only way to get one, as far as I can see, is to build a whole new singleton type for naturals and implement the necessary type families. Maybe you can do it in a way that wraps the Nats, so you're closer to SZero :: Sing (SN 0), SNonZero :: Sing (SN n) than a Peano construction, but I don't know.
Of course, there's another way to specialize a function that returns Vec a n to return Vec a 0, namely type classes.
If you are willing to abandon some of the explicit singleton machinery and switch to type classes (and also allow overlapping and undecidable instances), the following seems to work. I had to slightly modify the definition of V to use n :- 1 instead of n :+ 1, but I don't think that poses a problem.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE UndecidableInstances #-}
import Data.Singletons
import Data.Singletons.Prelude
import Data.Singletons.TypeLits
data V :: Nat -> * -> * where
Nil :: V 0 a
(:>) :: a -> V (n :- 1) a -> V n a
infixr 5 :>
class VC n a where
replicateV :: a -> V n a
instance VC 0 a where
replicateV _ = Nil
instance VC (n :- 1) a => VC n a where
replicateV x = x :> replicateV x
instance (Show a) => Show (V n a) where
show Nil = "Nil"
show (x :> v) = show x ++ " :> " ++ show v
headV :: V (n :+ 1) a -> a
headV (x :> _) = x
tailV :: ((n :+ 1) :- 1) ~ n => V (n :+ 1) a -> V n a
tailV (_ :> v) = v
main = do print (replicateV False :: V 0 Bool)
print (replicateV 1 :: V 1 Int)
print (replicateV "Three" :: V 3 String)

What is the preferred alternative to Fin from Idris in Haskell

I would like to have a type which can contain values 0 to n, where n lives on the type level.
I was trying something like:
import GHC.TypeLits
import Data.Proxy
newtype FiniteNat n = FiniteNat { toInteger :: Integer }
smartConstructFiniteNat :: (KnownNat n) => Proxy n -> Integer -> Maybe (FiniteNat (Proxy n))
smartConstructFiniteNat pn i
| 0 <= i && i < n = Just (FiniteNat i)
| otherwise = Nothing
where n = natVal pn
which works basically, but it's not really satisfying somehow. Is there a "standard" solution, or even a library to achieve this? There is a lot of fuss about dependenty typed list-lengths, but I was unable to find something exactly for this. Also - I assume using GHC.TypeLits is necessary, because my n can take on rather large values, so inductive definition would probably be very slow.
You can directly translate Idris's Fin into the usual Haskell mishmash of sort-of-dependently-typed features.
data Fin n where
FZ :: Fin (S n)
FS :: Fin n -> Fin (S n)
(!) :: Vec n a -> Fin n -> a
(x :> xs) ! FZ = x
(x :> xs) ! (FS f) = xs ! f
With TypeInType you can even have singleton Fins!
data Finny n (f :: Fin n) where
FZy :: Finny (S n) FZ
FSy :: Finny n f -> Finny (S n) (FS f)
This allows you to fake up dependent quantification over runtime stuff, eg,
type family Fin2Nat n (f :: Fin n) where
Fin2Nat (S _) FZ = Z
Fin2Nat (S n) (FS f) = S (Fin2Nat n f)
-- tighten the upper bound on a given Fin as far as possible
tighten :: Finny n f -> Fin (S (Fin2Nat n f))
tighten FZy = FZ
tighten (FSy f) = FS (tighten f)
but, ugh, it kinda sucks to have to duplicate everything at the value and type level, and writing out all your kind variables (n) can get pretty tedious.
If you're really sure you need an efficient runtime representation of Fin, you can do basically what you did in your question: stuff a machine Int into a newtype and use a phantom type for its size. But the onus is on you, the library implementer, to make sure the Int fits the bound!
newtype Fin n = Fin Int
-- fake up the constructors
fz :: Fin (S n)
fz = Fin 0
fs :: Fin n -> Fin (S n)
fs (Fin n) = Fin (n+1)
This version lacks real GADT constructors, so you can't manipulate type equalities using pattern matching. You have to do it yourself using unsafeCoerce. You can give clients a type-safe interface in the form of fold, but they have to be willing to write all their code in a higher-order style, and (since fold is a catamorphism) it becomes harder to look at more than one layer at a time.
-- the unsafeCoerce calls assert that m ~ S n
fold :: (forall n. r n -> r (S n)) -> (forall n. r (S n)) -> Fin m -> r m
fold k z (Fin 0) = unsafeCoerce z
fold k z (Fin n) = unsafeCoerce $ k $ fold k z (Fin (n-1))
Oh, and you can't do type level computation (as we did with Fin2Nat above) with this representation of Fin, because type level Ints don't permit induction.
For what it's worth, Idris's Fin is just as inefficient as the GADT one above. The docs contain the following caveat:
It's probably not a good idea to use Fin for arithmetic, and they will be exceedingly inefficient at run time.
I've heard noises about a future version of Idris being able to spot "Nat with types"-style datatypes (like Fin) and automatically erase the proofs and pack the values into machine integers, but as far as I know we're not there yet.
rampion suggested pattern synonyms, and I agreed, but it is admittedly not entirely trivial to work out how to structure their signatures properly. Thus I figured I'd write a proper answer to give the full code.
First, the usual boilerplate:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
module FakeFin (Nat (..), Fin (FZ, FS), FinView (..), viewFin) where
import Numeric.Natural
import Unsafe.Coerce
Now the basic types:
data Nat = Z | S Nat
-- Fin *must* be exported abstractly (or placed in an Unsafe
-- module). Users can use its constructor to implement
-- unsafeCoerce!
newtype Fin (n :: Nat) = Fin Natural
deriving instance Show (Fin n)
It is much easier to work via a view type rather than directly, so let's define one:
data FinView n where
VZ :: FinView ('S n)
VS :: !(Fin n) -> FinView ('S n)
deriving instance Show (FinView n)
It is important to note that we could have defined FinView using explicit equality constraints, because we will have to think in those terms to give correct pattern signatures:
data FinView n where
VZ :: n ~ 'S m => FinView n
VS :: n ~ 'S m => !(Fin m) -> FinView n
Now the actual view function:
viewFin :: Fin n -> FinView n
viewFin (Fin 0) = unsafeCoerce VZ
viewFin (Fin n) = unsafeCoerce (VS (Fin (n - 1)))
The pattern signatures precisely mirror the signatures of the FinView constructors.
pattern FZ :: () => n ~ 'S m => Fin n
pattern FZ <- (viewFin -> VZ) where
FZ = Fin 0
pattern FS :: () => n ~ 'S m => Fin m -> Fin n
pattern FS m <- (viewFin -> VS m) where
FS (Fin m) = Fin (1 + m)
-- Let GHC know that users need only match on `FZ` and `FS`.
-- This pragma only works for GHC 8.2 (and presumably future
-- versions).
{-# COMPLETE FZ, FS #-}
For completeness (because it took me rather more effort to write this than I expected), here's one way to write unsafeCoerce if this module accidentally exports the Fin data constructor. I imagine there are probably simpler ways.
import Data.Type.Equality
type family YahF n a b where
YahF 'Z a _ = a
YahF _ _ b = b
newtype Yah n a b = Yah (YahF n a b)
{-# NOINLINE finZBad #-}
finZBad :: 'Z :~: n -> Fin n -> a -> b
finZBad pf q =
case q of
FZ -> blah (trans pf Refl)
FS _ -> blah (trans pf Refl)
where
blah :: forall a b m. 'Z :~: 'S m -> a -> b
blah pf2 a = getB pf2 (Yah a)
{-# NOINLINE getB #-}
getB :: n :~: 'S m -> Yah n a b -> b
getB Refl (Yah b) = b
myUnsafeCoerce :: a -> b
myUnsafeCoerce = finZBad Refl (Fin 0)
finZBad is where all the action happens, but it doesn't do anything remotely improper! If someone really gives us a non-bottom value of type Fin 'Z, then something has already gone terribly wrong. The explicit type equality evidence here is necessary because if GHC sees code wanting 'Z ~ 'S m, it will simply reject it out of hand; GHC doesn't really like hypothetical reasoning in constraints. The NOINLINE annotations are necessary because GHC's simplifier itself uses type information; handling evidence of things it knows very well are impossible confuses it terribly, with extremely arbitrary results. So we block it up and successfully implement The Evil Function.

Resources