Haskell singletons : typelits package

Question

I have a hard time convincing compiler that my types are correct. With regular Nat s with Zero and Succ constructors it is pretty straightforward (the goal is to write replicate function for length-indexed lists ( Vect )):

replicate' :: SNat n -> a -> Vect n a
replicate' SZero _ = Nil
replicate' (SSucc n) a = a :> replicate' n a

But regular Nat is drastically slow.

So there is a package that mirrors GHC.TypeLits in singletons library for faster Nats. But I can't make the above example work with it:

sameNat :: forall a b. (KnownNat a, KnownNat b) => SNat a -> SNat b -> Maybe (a :~: b)
sameNat x y
  | natVal (Proxy :: Proxy a) == natVal (Proxy :: Proxy b) = Just (unsafeCoerce Refl)
  | otherwise            = Nothing

replicate'' :: (KnownNat n) => SNat n -> a -> Vect n a
replicate'' n a =
  case sameNat n (sing :: Sing 0) of
    Just Refl -> Nil
    Nothing   -> a ::> replicate'' (sPred n) a

This won't typecheck on last line :

Couldn't match type ‘n’
                     with ‘(n GHC.TypeNats.- 1) GHC.TypeNats.+ 1’

Answer 1

The problem is that sameNat n (sing :: Sing 0) gives you a usable n ~ 0 proof in the case that n is zero (when you pattern match on Just Refl ), but if n is not zero it just gives you Nothing . That doesn't tell you anything at all about n , so as far as the type checker is aware you can call exactly the same set of things inside the Nothing branch as you could without calling sameNat in the first place (in particular, you can't use sPred because that requires that 1 <= n ).

So we need to pattern match on something that either provides evidence that n ~ 0 or provides evidence that 1 <= n . Something like this:

data IsZero (n :: Nat)
  where Zero :: (0 ~ n) => IsZero n
        NonZero :: (1 <= n) => IsZero n
deriving instance Show (IsZero n)

Then we could write replicate'' this way:

isZero :: forall n. SNat n -> IsZero n
isZero n = _

replicate'' :: SNat n -> a -> Vect n a
replicate'' n x = case isZero n
                    of Zero -> Nil
                       NonZero -> x ::> replicate'' (sPred n) x

Of course that's just moved the problem to implementing the isZero function, which hasn't really bought us anything, but I'm going to stick with it because it's handy to have this as the basis of any other inductive definitions you want to make using Nat .

So, implementing isZero . We could handle the zero case with sameNat of course, but that doesn't help the non-zero case. The singletons package also provides Data.Singletons.Decide , which gives you a way of getting a proof of equality or inequality of types based on their singletons. So we can do this:

isZero :: forall n. SNat n -> IsZero n
isZero n = case n %~ (SNat @0)
             of Proved Refl -> Zero
                Disproved nonsense -> NonZero

Sadly this doesn't work either! The Proved case is fine (and the same as sameNat giving us Just Refl , basically). But the "proof of inequality" comes in the form of nonsense being bound to a function of type (n :~: 0) -> Void , and if we assume totality (without shenanigans) then the existence of such a function "proves" that we can't construct a n :~: 0 value, which proves that n definitely isn't 0 . But this is just too far from a proof that 1 <= n ; we can see that if n isn't 0 then it must be at least 1, from the properties of natural numbers, but GHC doesn't know this.

Another way to go would be to use singleton's Ord support and pattern match on SNat @1 :%<= n :

isZero :: forall n. SNat n -> IsZero n
isZero n = case (SNat @1) %:<= n
             of STrue -> NonZero
                SFalse -> Zero

But that doesn't work either, because the STrue and SFalse are just singletons for type level True and False , disconnected from the original comparison. We don't get a proof that 0 ~ n or 1 <= n from either side of this (and similarly can't get it to work by comparing with SNat @0 either). This is type-checker boolean blindness, basically.

Ultimately I was never able to satisfactorily solve this in my code. As far as I can tell we're missing a primitive; we either need to be able to compare singletons in a way that gives us < or <= constraints on the corresponding types, or we need a switch on whether a Nat is zero or nonzero.

So I cheated:

isZero :: forall n. SNat n -> IsZero n
isZero n = case n %~ (SNat @0)
             of Proved Refl -> Zero
                Disproved _ -> unsafeCoerce (NonZero @1)

Since NonZero only contains evidence that n is 1 or more, but not any other information about n , you can just unsafely coerce a proof that 1 is 1 or more.

Here's a full working example:

{-# LANGUAGE DataKinds
           , GADTs
           , KindSignatures
           , ScopedTypeVariables
           , StandaloneDeriving
           , TypeApplications
           , TypeOperators
  #-}

import GHC.TypeLits ( type (<=), type (-) )
import Data.Singletons.TypeLits ( Sing (SNat), SNat, Nat )
import Data.Singletons.Prelude.Enum ( sPred )
import Data.Singletons.Decide ( SDecide ((%~))
                              , Decision (Proved, Disproved)
                              , (:~:) (Refl)
                              )
import Unsafe.Coerce ( unsafeCoerce )

data IsZero (n :: Nat)
  where Zero :: (0 ~ n) => IsZero n
        NonZero :: (1 <= n) => IsZero n
deriving instance Show (IsZero n)

isZero :: forall n. SNat n -> IsZero n
isZero n = case n %~ (SNat @0)
             of Proved Refl -> Zero
                Disproved _ -> unsafeCoerce (NonZero @1)


data Vect (n :: Nat) a
  where Nil :: Vect 0 a
        (::>) :: a -> Vect (n - 1) a -> Vect n a
deriving instance Show a => Show (Vect n a)

replicate'' :: SNat n -> a -> Vect n a
replicate'' n x = case isZero n
                    of Zero -> Nil
                       NonZero -> x ::> replicate'' (sPred n) x

head'' :: (1 <= n) => Vect n a -> a
head'' (x ::> _) = x

main :: IO ()
main = putStrLn
     . (:[])
     . head''
     $ replicate''
         (SNat @1000000000000000000000000000000000000000000000000000000)
         '\x1f60e'

Note that unlike KA Buhr's suggested approach using unsafeCoerce , here the code for replicate is actually using the type checker to verify that it constructs a Vect na in accordance to the SNat n provided, whereas their suggestion requires you to trust that the code does this (the actual meat of the work is done by iterate counting on Int ) and only makes sure that the callers use the SNat n and the Vect na consistently. The only bit of code you have to just trust (unchecked by the compiler) is that a Refuted _ :: Decision (n :~: 0) really does imply 1 <= n , inside isZero (which you can reuse to write lots of other functions that need to switch on whether a SNat is zero or not).

As you try to implement more functionality with your Vect , you'll find that a lot of "obvious" things GHC doesn't know about the properties of Nat are quite painful. Data.Constraint.Nat from the constraints package has a lot of useful proofs you can use (for example, if you try to implement drop :: (k <= n) => SNat k -> Vect na -> Vect (n - k) a , you'll probably end up needing leTrans so that when you know that 1 <= k then also 1 <= n and you can actually pattern match to strip off another element). Avoiding this kind of hasochism is where KA Buhr's approach can be a great help, if you want to just implement your operation with code you trust and unsafeCoerce the types to line up.

Answer 2

As far as I can see, the exact approach you're taking can't work the way you want. sameNat is evaluated at run-time, so its "decision" isn't available to the type checker, which therefore can't perform any type inference based on differentiating between the two branches of the case construct.

You might be interested in my answer to How to deconstruct an SNat (singletons) , regarding a similar question, which provides an implementation that avoids unsafeCoerce entirely through the use of type classes. However, as @Ben has pointed out in the comments, because of this use of type classes, the compiler has to follow a chain of n instance definitions whenever you define a vector of size n (and the compiled code may explicitly include a structure of n nested instance dictionaries) making this impractical for real code. For example, a million element vector is likely to cause the compiler to run for too long and/or use too much memory to be acceptable.

For real code, I would suggest doing the type check manually (ie, verifying that the code, as written, is type safe) and forcing it with unsafeCoerce :

replicate1 :: (KnownNat n) => SNat n -> a -> Vect n a
replicate1 n a =
  unsafeCoerce (iterate (unsafeCoerce . (a ::>)) Nil
                !! fromInteger (fromSing n))

Obviously, this definition misses the point of dependent typing for this particular definition, but the hope is that you can build up a set of trusted (manually type-checked) primitives and then build non-trivial algorithms on top of them that can benefit from more rigorous type-checking.

Note that in this particular case, you don't even really need the n parameter, so you can write:

{-# LANGUAGE ScopedTypeVariables #-}

replicate2 :: forall a n . (KnownNat n) => a -> Vect n a
replicate2 a =
  unsafeCoerce (iterate (unsafeCoerce . (a ::>)) Nil
        !! fromInteger (fromSing (SNat :: SNat n)))

Anyway, a full working example is:

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Singletons
import Data.Singletons.Prelude
import Data.Singletons.TypeLits
import Unsafe.Coerce

infixr 5 ::>
data Vect (n :: Nat) a where
  Nil :: Vect 0 a
  (::>) :: a -> Vect (n :- 1) a -> Vect n a

instance (Show a) => Show (Vect n a) where
  showsPrec _ Nil = showString "Nil"
  showsPrec d (x ::> xs) = showParen (d > prec) $
showsPrec (prec+1) x . showString " ::> " . showsPrec prec xs
where prec=5

replicate1 :: (KnownNat n) => SNat n -> a -> Vect n a
replicate1 n a =
  unsafeCoerce (iterate (unsafeCoerce . (a ::>)) Nil
        !! fromInteger (fromSing n))

replicate2 :: forall a n . (KnownNat n) => a -> Vect n a
replicate2 a =
  unsafeCoerce (iterate (unsafeCoerce . (a ::>)) Nil
        !! fromInteger (fromSing (SNat :: SNat n)))

head' :: Vect (n :+ 1) a -> a
head' (x ::> _) = x

tail' :: ((n :+ 1) :- 1) ~ n => Vect (n :+ 1) a -> Vect n a
tail' (_ ::> v) = v

main = do print (replicate2 False   :: Vect 0 Bool)
          print (replicate2 "Three" :: Vect 3 String)
          print (head' (tail' (replicate2 "1M" :: Vect 1000000 String)))

          print (replicate1 (SNat :: SNat 0) False   :: Vect 0 Bool)
          print (replicate1 (SNat :: SNat 3) "Three" :: Vect 3 String)
          print (head' (tail' (replicate1 (SNat :: SNat 1000000) "1M" :: Vect 1000000 String)))