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.
Related
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
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']]]])
I have a hard time convincing compiler that my types are correct. With regular
Nats 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’
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 K. A. Buhr's suggested approach using unsafeCoerce, here the code for replicate is actually using the type checker to verify that it constructs a Vect n a 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 n a 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 n a -> 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 K. A. 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.
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 (i.e., 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)))
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)
First, I started with some typical type-level natural number stuff.
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
data Nat = Z | S Nat
type family Plus (n :: Nat) (m :: Nat) :: Nat
type instance Plus Z m = m
type instance Plus (S n) m = S (Plus n m)
So I wanted to create a data type representing an n-dimensional grid. (A generalization of what is found at Evaluating cellular automata is comonadic.)
data U (n :: Nat) x where
Point :: x -> U Z x
Dimension :: [U n x] -> U n x -> [U n x] -> U (S n) x
The idea is that the type U num x is the type of a num-dimensional grid of xs, which is "focused" on a particular point in the grid.
So I wanted to make this a comonad, and I noticed that there's this potentially useful function I can make:
ufold :: (x -> U m r) -> U n x -> U (Plus n m) r
ufold f (Point x) = f x
ufold f (Dimension ls mid rs) =
Dimension (map (ufold f) ls) (ufold f mid) (map (ufold f) rs)
We can now implement a "dimension join" that turns an n-dimensional grid of m-dimensional grids into an (n+m)-dimensional grid, in terms of this combinator. This will come in handy when dealing with the result of cojoin which will produce grids of grids.
dimJoin :: U n (U m x) -> U (Plus n m) x
dimJoin = ufold id
So far so good. I also noticed that the Functor instance can be written in terms of ufold.
instance Functor (U n) where
fmap f = ufold (\x -> Point (f x))
However, this results in a type error.
Couldn't match type `n' with `Plus n 'Z'
But if we whip up some copy pasta, then the type error goes away.
instance Functor (U n) where
fmap f (Point x) = Point (f x)
fmap f (Dimension ls mid rs) =
Dimension (map (fmap f) ls) (fmap f mid) (map (fmap f) rs)
Well I hate the taste of copy pasta, so my question is this. How can I tell the type system that Plus n Z is equal to n? And the catch is this: you can't make a change to the type family instances that would cause dimJoin to produce a similar type error.
What you need is a nice propositional equality type:
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
data Nat = Z | S Nat
type family Plus (n :: Nat) (m :: Nat) :: Nat
type instance Plus Z m = m
type instance Plus (S n) m = S (Plus n m)
data (:=) :: k -> k -> * where
Refl :: a := a
data Natural (n :: Nat) where
Zero :: Natural Z
Suc :: Natural n -> Natural (S n)
plusZero :: Natural n -> n := (n `Plus` Z)
plusZero Zero = Refl
plusZero (Suc n) | Refl <- plusZero n = Refl
This allows you to prove arbitrary things about your types and bring that knowledge into scope locally by pattern matching on the Refl.
One annoying thing is that my plusZero proof requires induction over the natural in question, which you won't be able to do by default (since it doesn't exist at runtime). A typeclass for generating Natural witnesses would be easy, though.
Another option for your particular case might be just to invert the arguments to plus in your type definition so that you get the Z on the left and it reduces automagically. It's often a good first step to make sure your types are as simple as you can make them, but then you'll often need propositional equality for more complicated things, regardless.