data T t where
A :: Show (t a) => t a -> T t
B :: Coercible Int (t a) => t a -> T t
f :: T t -> String
f (A t) = show t
g :: T t -> Int
g (B t) = coerce t
Why does f compile but g generate an error like follows? I'm using GHC 8.4.
• Couldn't match representation of type ‘Int’ with that of ‘t a’
Inaccessible code in
a pattern with constructor:
B :: forall k (t :: k -> *) (a :: k).
Coercible Int (t a) =>
t a -> T t,
in an equation for ‘g’
• In the pattern: B t
In an equation for ‘g’: g (B t) = coerce t
Also, are Coercible constraints zero-cost even when they are embedded in GADTs?
UPD: Compiler bug: https://ghc.haskell.org/trac/ghc/ticket/15431
As a workaround, you may replace the constraint (which is not free in the first place) with a Data.Type.Coercion.Coercion (which adds an extra data wrapper around the dictionary).
data T t where
A :: Show (t a) => t a -> T t
B :: !(Coercion Int (t a)) -> t a -> T t
-- ! for correctness: you can’t have wishy-washy values like B _|_ (I "a")
-- Such values decay to _|_
f :: T t -> String
f (A x) = show x
f (B c x) = show (coerceWith (sym c) x)
newtype I a = I a
main = putStrLn $ f $ B Coercion $ I (5 :: Int)
GHC 8.6 will improve this situation in two ways:
Your original code will work, as the underlying bug was fixed.
The Coercion can be unpacked to a Coercible constraint, and this will happen automatically, due to -funbox-small-strict-fields. Thus, this T will get performance characteristics equivalent to your original for free.
Related
I'm trying to conjure a traversal to update multiple keys of an IntMap as a whole.
To dispell XY: I'm not simply trying to update them, I need the traversal to return to the caller for further composition. Or at least something composable with lenses.
I've tried many variations of the common combinators. I've tried dropping down to a functor-based definition, with a large range of experimentation shifting the foralls' scopes around, with no more success. Building from the ground up again, here's where I'm at:
import Control.Lens
import Control.Lens.Unsound
-- base case: traverse a single fixed element
t1 :: Traversal' (IntMap a) (Maybe a)
t1 = at 0
-- build-up case: traverse a pair of fixed elements
t2 :: Traversal' (IntMap a) (Maybe a)
t2 = at 0 `adjoin` at 1
-- generalizing case: do it with a fold
t3 :: Traversal' (IntMap a) (Maybe a)
t3 = foldr (\e t -> at e `adjoin` t) (at 1) [0]
t1 and t2 work fine; I'd devised t3 to be equivalent to t2, but it fails with the following error:
• Couldn't match type ‘f1’ with ‘f’
‘f1’ is a rigid type variable bound by a type expected by the context:
Traversal' (IntMap a) (Maybe a)
‘f’ is a rigid type variable bound by the type signature for:
t3 :: forall a. Traversal' (IntMap a) (Maybe a)
Expected type: (Maybe a -> f1 (Maybe a)) -> IntMap a -> f1 (IntMap a)
Actual type: (Maybe a -> f (Maybe a)) -> IntMap a -> f (IntMap a)
• In the second argument of ‘adjoin’, namely ‘t’
In the expression: at x `adjoin` t
In the first argument of ‘foldr’, namely ‘(\ x t -> at x `adjoin` t)’
I suppose this is some rank-2 trickery that's still a bit over my head. Is there any way to make this work?
I aimed for a final signature of
ats :: Foldable l => l Int -> Traversal' (IntMap a) (Maybe a)
…assuming unique keys, of course. Which I dreamed could be implemented just almost like t3.
Traversal' is a type synonym for a type containing forall, which makes it a second class citizen in the type system: we can't instantiate a type variable with such a type.
In particular, here we are trying to do so with foldr :: (a -> b -> b) -> b -> [a] -> b, we can't instantiate b = Traversal' _ _, because Traversal' contains a forall.
One work around is to wrap Traversal' in a newtype, ReifiedTraversal. Wrap (using the Traversal constructor) before passing at 1 to foldr; inside foldr, unwrap to use adjoin, and rewrap; unwrap at the end.
t3 :: Traversal' (IntMap a) (Maybe a)
t3 = runTraversal (foldr (\e t -> Traversal (at e `adjoin` runTraversal t)) (Traversal (at 1)) [0])
A traversal is a function Applicative f => (t -> f t) -> (s -> f s). You have a function f :: Maybe a -> f (Maybe a) and you want to apply it to some entries in IntMap a.
It's a bit of a puzzle to do with Applicative (there is a more natural solution using Monad), but requires less expertise than composing traversals as first-class values:
import Control.Applicative
import Data.IntMap (IntMap)
import qualified Data.IntMap as M
-- [Int] -> Traversal' (IntMap a) (Maybe a)
traverseAtKeys :: Applicative f => [Int] -> (Maybe a -> f (Maybe a)) -> IntMap a -> f (IntMap a)
traverseAtKeys keys f m =
let go i k = liftA2 (insertMaybe i) (f (M.lookup i m)) k
insertMaybe i Nothing = M.delete i
insertMaybe i (Just v) = M.insert i v
in foldr go (pure m) keys
One way to get around problems like this is to use a newtype wrapper. Specifically, consider the following:
newtype TravJoiner a b = TravJoiner { unTravJoiner :: Traversal' a b }
instance Semigroup (TravJoiner a b) where
TravJoiner x <> TravJoiner y = TravJoiner $ adjoin x y
With this, you can write your t3 without any trouble:
t3 :: Traversal' (IntMap a) (Maybe a)
t3 = unTravJoiner $ foldr (\e t -> TravJoiner (at e) <> t) (TravJoiner $ at 1) [0]
Your ats function follows nicely from there:
ats :: Foldable l => l Int -> Traversal' (IntMap a) (Maybe a)
ats = unTravJoiner . foldr (\e t -> TravJoiner (at e) <> t) (TravJoiner ignored)
I'm trying to learn monads better and am playing around with it in Haskell. I defined a monad in this way:
module TESTMonad where
import Control.Monad
newtype TEST i = TEST {getTEST :: ((i, Int), Int)} deriving (Show, Eq, Ord)
instance Functor TEST where
fmap f (TEST ((x,y), z)) = TEST ((f x, y), z)
instance Applicative TEST where
pure = return
tf <*> tx = tf >>= \f -> tx >>= \x -> return (f x)
instance Monad TEST where
return x = TEST ((x, 1), 1)
(TEST ((x, y), z)) >>= f = TEST ((plusOne a, b), c)
where
((a, b), c) = getTEST (f x)
plusOne :: Int -> Int
plusOne x = x+1
but I get the following error when I'm trying to compile it:
TESTMonad.hs:16:47: error:
• Couldn't match expected type ‘Int’ with actual type ‘b’
‘b’ is a rigid type variable bound by
the type signature for:
(>>=) :: forall a b. TEST a -> (a -> TEST b) -> TEST b
at TESTMonad.hs:16:24
• In the first argument of ‘plusOne’, namely ‘a’
In the expression: plusOne a
In the expression: (plusOne a, b)
• Relevant bindings include
a :: b (bound at TESTMonad.hs:18:19)
f :: a -> TEST b (bound at TESTMonad.hs:16:28)
(>>=) :: TEST a -> (a -> TEST b) -> TEST b
(bound at TESTMonad.hs:16:5)
Failed, modules loaded: none.
I clearly know that I might be doing lots of things in the wrong way but I have no idea what are they. Any comment would be appreciated. Thank you in advance!
The Monad instance cannot be constrained. The type of (>>=) must be
Monad m => m a -> (a -> m b) -> m b
but your definition, using plusOne :: Int -> Int, makes the type
Monad m => m Int -> (Int -> m Int) -> m Int
You could safely apply plusOne to either of the other values wrapped inside TEST, as they are already defined to be Ints.
The definition of (>>=) has no idea what the type of x might be, and the caller gets to choose f, so it has no idea what the type of f x might either. As a result, you can't really do anything with it except use it as-is.
In general, I'm wondering if there's a way to write a generic fold that generalizes a function that applies a forall type like:
f :: forall a. Data (D a) => D a -> b
given some datatype D for which instance Data (D a) (possibly with constraints on a). To be concrete, consider something even as simple as False `mkQ` isJust, or generally, a query on the constructor of a higher-kinded datatype. Similarly, consider a transformation mkT (const Nothing) that only affects one particular higher-kinded type.
Without explicit type signatures, they fail with No instance for Typeable a0, which is probably the monomorphism restriction at work. Fair enough. However, if we add explicit type signatures:
t :: GenericT
t = mkT (const Nothing :: forall a. Data a => Maybe a -> Maybe a)
q :: GenericQ Bool
q = False `mkQ` (isJust :: forall a. Data a => Maybe a -> Bool)
instead we are told that the forall type of the outer signatures are ambiguous:
Could not deduce (Typeable a0)
arising from a use of ‘mkT’
from the context: Data a
bound by the type signature for:
t :: GenericT
The type variable ‘a0’ is ambiguous
I can't wrap my head around this. If I'm really understanding correctly that a0 is the variable in t :: forall a0. Data a0 => a0 -> a0, how is it any more ambiguous than in say mkT not? If anything, I would've expected mkT to complain because it is the one that interacts with isJust. Additionally, these functions are more polymorphic than the branching on concrete types.
I'm curious to know if this is a limitation of proving the inner constraint isJust :: Data a => ... — my understanding is that any type of instance Data inhabited with Maybe a must also have Data a to be valid by the instance constraint instance Data a => Data (Maybe a).
tldr: You need to create a different function.
mkT has the following signature:
mkT :: (Typeable a, Typeable b) => (a -> a) -> (b -> b)
And you want to apply it to a polymorphic function of type (forall x. Maybe x -> Maybe x). It is not possible: there is no way to instantiate a in (a -> a) to obtain (forall x. Maybe x -> Maybe x).
It's not just a limitation of the type system, the implementation of mkT wouldn't support such an instantiation either.
mkT simply compares concrete types a and b for equality at run time. But what you want is to be able to test whether b is equal to Maybe x for some x. The logic this requires is fundamentally more involved. But it is certainly still possible.
Below, mkT1 first matches the type b against the App pattern to know whether b is some type application g y, and then tests equality of g and f:
{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications, GADTs #-}
import Type.Reflection
-- N.B.: You can add constraints on (f x), but you must do the same for b.
mkT1 :: forall f b. (Typeable f, Typeable b) => (forall x. f x -> f x) -> (b -> b)
mkT1 h =
case typeRep #b of
App g y ->
case eqTypeRep g (typeRep #f) of
Just HRefl -> h
_ -> id
_ -> id
Compilable example with mkQ1 as well:
{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications, GADTs #-}
import Type.Reflection
mkT1 :: forall f b. (Typeable f, Typeable b) => (forall x. f x -> f x) -> (b -> b)
mkT1 h =
case typeRep #b of
App g y ->
case eqTypeRep g (typeRep #f) of
Just HRefl -> h
_ -> id
_ -> id
mkQ1 :: forall f b q. (Typeable f, Typeable b) => (forall x. f x -> q) -> (b -> q) -> (b -> q)
mkQ1 h =
case typeRep #b of
App g y ->
case eqTypeRep g (typeRep #f) of
Just HRefl -> const h
_ -> id
_ -> id
f :: Maybe x -> String
f _ = "matches"
main :: IO ()
main = do
print (mkQ1 f (\_ -> "doesn't match") (Just 3 :: Maybe Int)) -- matches
print (mkQ1 f (\_ -> "doesn't match") (3 :: Int)) -- doesn't match
I can define a polykinded natural transformation like so:
type family (~>) :: k -> k -> *
type instance (~>) = (->)
newtype NT a b = NT { apply :: forall x. a x ~> b x }
type instance (~>) = NT
Which works at all kinds, so I can define e.g.
left :: Either ~> (,)
left = NT (NT (Left . fst))
This is cool and inspiring. But no matter how many tricks I play, I can't seem to get something variadic in the return type. E.g. I would like
type family (:*:) :: k -> k -> k
type instance (:*:) = (,)
type instance (:*:) = ???
It seems like this is impossible, since type families need to be fully saturated, and you can only introduce type constructors in *.
I've even tried some rather nasty tricks
type instance (:*:) = Promote2 (:*:)
type family Promote2 :: (j -> k -> l) -> (a -> j) -> (a -> k) -> (a -> l) where
promote2_law :: Promote2 f x y z :~: f (x z) (y z)
promote2_law = unsafeCoerce Refl
fstP :: forall (a :: k -> *) (b :: k -> *) (c :: k). (a :*: b) c -> a c
fstP = case promote2_law #(:~:) #a #b #c of Refl -> NT (\(a,b) -> a)
And I don't know if that even has any hope of working, since I haven't thought through how higher kinded things are "represented". But GHC knows I'm lying anyway
• Couldn't match type ‘(,)’ with ‘Promote2 (,) a’
Inaccessible code in
a pattern with constructor: Refl :: forall k (a :: k). a :~: a,
Are there any other tricks for this?
The "axiomatic" approach does actually work, I had just used the equality wrong:
fstP :: forall (a :: j -> k) (b :: j -> k) (x :: j). (a :*: b) x -> a x
fstP = castWith (Refl ~% promote2_law #(:*:) #a #b #x ~% Refl) fst
where
infixl 9 ~%
(~%) = Data.Type.Equality.apply
Using Equality.apply is essential to inform the type checker of where to apply the axiom. I made a full development of higher-kinded products here for reference.
Be warned, as I was playing with this did I get a GHC panic once. So the nasty tricks might be nasty. Still interested in other approaches.
We're used to having universally quantified types for polymorphic functions. Existentially quantified types are used much less often. How can we express existentially quantified types using universal type quantifiers?
It turns out that existential types are just a special case of Σ-types (sigma types). What are they?
Sigma types
Just as Π-types (pi types) generalise our ordinary function types, allowing the resulting type to depend on the value of its argument, Σ-types generalise pairs, allowing the type of second component to depend on the value of the first one.
In a made-up Haskell-like syntax, Σ-type would look like this:
data Sigma (a :: *) (b :: a -> *)
= SigmaIntro
{ fst :: a
, snd :: b fst
}
-- special case is a non-dependent pair
type Pair a b = Sigma a (\_ -> b)
Assuming * :: * (i.e. the inconsistent Set : Set), we can define exists a. a as:
Sigma * (\a -> a)
The first component is a type and the second one is a value of that type. Some examples:
foo, bar :: Sigma * (\a -> a)
foo = SigmaIntro Int 4
bar = SigmaIntro Char 'a'
exists a. a is fairly useless - we have no idea what type is inside, so the only operations that can work with it are type-agnostic functions such as id or const. Let's extend it to exists a. F a or even exists a. Show a => F a. Given F :: * -> *, the first case is:
Sigma * F -- or Sigma * (\a -> F a)
The second one is a bit trickier. We cannot just take a Show a type class instance and put it somewhere inside. However, if we are given a Show a dictionary (of type ShowDictionary a), we can pack it with the actual value:
Sigma * (\a -> (ShowDictionary a, F a))
-- inside is a pair of "F a" and "Show a" dictionary
This is a bit inconvenient to work with and assumes that we have a Show dictionary around, but it works. Packing the dictionary along is actually what GHC does when compiling existential types, so we could define a shortcut to have it more convenient, but that's another story. As we will learn soon enough, the encoding doesn't actually suffer from this problem.
Digression: thanks to constraint kinds, it's possible to reify the type class into concrete data type. First, we need some language pragmas and one import:
{-# LANGUAGE ConstraintKinds, GADTs, KindSignatures #-}
import GHC.Exts -- for Constraint
GADTs already give us the option to pack a type class along with the constructor, for example:
data BST a where
Nil :: BST a
Node :: Ord a => a -> BST a -> BST a -> BST a
However, we can go one step further:
data Dict :: Constraint -> * where
D :: ctx => Dict ctx
It works much like the BST example above: pattern matching on D :: Dict ctx gives us access to the whole context ctx:
show' :: Dict (Show a) -> a -> String
show' D = show
(.+) :: Dict (Num a) -> a -> a -> a
(.+) D = (+)
We also get quite natural generalisation for existential types that quantify over more type variables, such as exists a b. F a b.
Sigma * (\a -> Sigma * (\b -> F a b))
-- or we could use Sigma just once
Sigma (*, *) (\(a, b) -> F a b)
-- though this looks a bit strange
The encoding
Now, the question is: can we encode Σ-types with just Π-types? If yes, then the existential type encoding is just a special case. In all glory, I present you the actual encoding:
newtype SigmaEncoded (a :: *) (b :: a -> *)
= SigmaEncoded (forall r. ((x :: a) -> b x -> r) -> r)
There are some interesting parallels. Since dependent pairs represent existential quantification and from classical logic we know that:
(∃x)R(x) ⇔ ¬(∀x)¬R(x) ⇔ (∀x)(R(x) → ⊥) → ⊥
forall r. r is almost ⊥, so with a bit of rewriting we get:
(∀x)(R(x) → r) → r
And finally, representing universal quantification as a dependent function:
forall r. ((x :: a) -> R x -> r) -> r
Also, let's take a look at the type of Church-encoded pairs. We get a very similar looking type:
Pair a b ~ forall r. (a -> b -> r) -> r
We just have to express the fact that b may depend on the value of a, which we can do by using dependent function. And again, we get the same type.
The corresponding encoding/decoding functions are:
encode :: Sigma a b -> SigmaEncoded a b
encode (SigmaIntro a b) = SigmaEncoded (\f -> f a b)
decode :: SigmaEncoded a b -> Sigma a b
decode (SigmaEncoded f) = f SigmaIntro
-- recall that SigmaIntro is a constructor
The special case actually simplifies things enough that it becomes expressible in Haskell, let's take a look:
newtype ExistsEncoded (F :: * -> *)
= ExistsEncoded (forall r. ((x :: *) -> (ShowDictionary x, F x) -> r) -> r)
-- simplify a bit
= ExistsEncoded (forall r. (forall x. (ShowDictionary x, F x) -> r) -> r)
-- curry (ShowDictionary x, F x) -> r
= ExistsEncoded (forall r. (forall x. ShowDictionary x -> F x -> r) -> r)
-- and use the actual type class
= ExistsEncoded (forall r. (forall x. Show x => F x -> r) -> r)
Note that we can view f :: (x :: *) -> x -> x as f :: forall x. x -> x. That is, a function with extra * argument behaves as a polymorphic function.
And some examples:
showEx :: ExistsEncoded [] -> String
showEx (ExistsEncoded f) = f show
someList :: ExistsEncoded []
someList = ExistsEncoded $ \f -> f [1]
showEx someList == "[1]"
Notice that someList is actually constructed via encode, but we dropped the a argument. That's because Haskell will infer what x in the forall x. part you actually mean.
From Π to Σ?
Strangely enough (although out of the scope of this question), you can encode Π-types via Σ-types and regular function types:
newtype PiEncoded (a :: *) (b :: a -> *)
= PiEncoded (forall r. Sigma a (\x -> b x -> r) -> r)
-- \x -> is lambda introduction, b x -> r is a function type
-- a bit confusing, I know
encode :: ((x :: a) -> b x) -> PiEncoded a b
encode f = PiEncoded $ \sigma -> case sigma of
SigmaIntro a bToR -> bToR (f a)
decode :: PiEncoded a b -> (x :: a) -> b x
decode (PiEncoded f) x = f (SigmaIntro x (\b -> b))
I found an anwer in Proofs and Types by Jean-Yves Girard, Yves Lafont and Paul Taylor.
Imagine we have some one-argument type t :: * -> * and construct an existential type that holds t a for some a: exists a. t a. What can we do with such a type? In order to compute something out of it we need a function that can accept t a for arbitrary a, that means a function of type forall a. t a -> b. Knowing this, we can encode an existential type simply as a function that takes functions of type forall a. t a -> b, supplies the existential value to them and returns the result b:
{-# LANGUAGE RankNTypes #-}
newtype Exists t = Exists (forall b. (forall a. t a -> b) -> b)
Creating an existential value is now easy:
exists :: t a -> Exists t
exists x = Exists (\f -> f x)
And if we want to unpack the existential value, we just apply its content to a function that produces the result:
unexists :: (forall a. t a -> b) -> Exists t -> b
unexists f (Exists e) = e f
However, purely existential types are of very little use. We cannot do anything reasonable with a value we know nothing about. More often we need an existential type with a type class constraint. The procedure is just the same, we just add a type class constraint for a. For example:
newtype ExistsShow t = ExistsShow (forall b. (forall a. Show a => t a -> b) -> b)
existsShow :: Show a => t a -> ExistsShow t
existsShow x = ExistsShow (\f -> f x)
unexistsShow :: (forall a. Show a => t a -> b) -> ExistsShow t -> b
unexistsShow f (ExistsShow e) = e f
Note: Using existential quantification in functional programs is often considered a code-smell. It can indicate that we haven't liberated ourselves from OO thinking.