[GHC] #12772: (type f1 ~> f2 = forall a. f1 a -> f2 a) to core libraries
GHC
ghc-devs at haskell.org
Fri Oct 28 10:55:43 UTC 2016
#12772: (type f1 ~> f2 = forall a. f1 a -> f2 a) to core libraries
-------------------------------------+-------------------------------------
Reporter: Iceland_jack | Owner:
Type: feature request | Status: new
Priority: normal | Milestone:
Component: Build System | Version: 8.0.1
Resolution: | Keywords:
Operating System: Unknown/Multiple | Architecture:
| Unknown/Multiple
Type of failure: None/Unknown | Test Case:
Blocked By: | Blocking:
Related Tickets: | Differential Rev(s):
Wiki Page: |
-------------------------------------+-------------------------------------
Description changed by Iceland_jack:
@@ -12,33 +12,33 @@
- unLift :: Applicative f
- => Lift f a -> f a
- mapLift :: (f a -> g a)
- -> Lift f a -> Lift g a
- mapFreeT :: (Functor f, Functor m)
- => (forall a. m a -> m' a)
- -> FreeT f m a -> FreeT f m' a
- vmap :: (a -> a')
- -> Vec a n -> Vec a' n
- liftIO :: MonadIO m
- => IO a -> m a
- hoist :: Monad m
- => (forall a. m a -> n a)
- -> t m b -> t n b
- trans :: (Monad m, Monad m')
- => (forall a. m a -> m' a)
- -> Bundle m v a -> Bundle m' v a
- process :: Monad m
- => (forall a. k a -> i -> a)
- -> MachineT m k o -> ProcessT m i o
- runAlt :: Alternative g
- => (forall x. f x -> g x)
- -> Alt f a -> g a
- hoistAlt :: (forall a. f a -> g a)
- -> Alt f b -> Alt g b
- fromCurried :: Functor f
- => (forall a. k a -> Curried f h a)
- -> Day f k b -> h b
- hoistScope :: Functor f
- => (forall x. f x -> g x)
- -> Scope b f a -> Scope b g a
-
- haddockWithGhc :: (forall a. [Flag] -> Ghc a -> IO a) -> [String] -> IO ()
+ unLift :: Applicative f
+ => Lift f a -> f a
+ mapLift :: (f a -> g a)
+ -> Lift f a -> Lift g a
+ mapFreeT :: (Functor f, Functor m)
+ => (forall a. m a -> m' a)
+ -> FreeT f m a -> FreeT f m' a
+ vmap :: (a -> a')
+ -> Vec a n -> Vec a' n
+ liftIO :: MonadIO m
+ => IO a -> m a
+ hoist :: Monad m
+ => (forall a. m a -> n a)
+ -> t m b -> t n b
+ trans :: (Monad m, Monad m')
+ => (forall a. m a -> m' a)
+ -> Bundle m v a -> Bundle m' v a
+ process :: Monad m
+ => (forall a. k a -> i -> a)
+ -> MachineT m k o -> ProcessT m i o
+ runAlt :: Alternative g
+ => (forall x. f x -> g x)
+ -> Alt f a -> g a
+ hoistAlt :: (forall a. f a -> g a)
+ -> Alt f b -> Alt g b
+ fromCurried :: Functor f
+ => (forall a. k a -> Curried f h a)
+ -> Day f k b -> h b
+ hoistScope :: Functor f
+ => (forall x. f x -> g x)
+ -> Scope b f a -> Scope b g a
+ haddockWithGhc :: (forall a. [Flag] -> Ghc a -> IO a)
+ -> [String] -> IO ()
@@ -61,33 +61,33 @@
- unLift :: Applicative f
- => Lift f ~> f
- mapLift :: f ~> g
- -> Lift f ~> Lift g
- mapFreeT :: (Functor f, Functor m)
- => m ~> m'
- -> FreeT f m ~> FreeT f m'
- vmap :: (a -> a')
- -> Vec a ~> Vec a'
- liftIO :: MonadIO m
- => IO ~> m
- hoist :: Monad m
- => m ~> n
- -> t m ~> t n
- trans :: (Monad m, Monad m')
- => m ~> m'
- -> Bundle m v ~> Bundle m' v
- process :: Monad m
- => k ~> (i -> )
- -> MachineT m k ~> ProcessT m i
- runAlt :: Alternative g
- => f ~> g
- -> Alt f ~> g
- hoistAlt :: f ~> g
- -> Alt f ~> Alt g
- fromCurried :: Functor f
- => (k ~> Curried f h)
- -> Day f k ~> h
- hoistScope :: Functor f
- => f ~> g
- -> Scope b f ~> Scope b g
-
- haddockWithGhc :: ([Flag] -> Ghc ~> IO) -> [String] -> IO ()
+ unLift :: Applicative f
+ => Lift f ~> f
+ mapLift :: f ~> g
+ -> Lift f ~> Lift g
+ mapFreeT :: (Functor f, Functor m)
+ => m ~> m'
+ -> FreeT f m ~> FreeT f m'
+ vmap :: (a -> a')
+ -> Vec a ~> Vec a'
+ liftIO :: MonadIO m
+ => IO ~> m
+ hoist :: Monad m
+ => m ~> n
+ -> t m ~> t n
+ trans :: (Monad m, Monad m')
+ => m ~> m'
+ -> Bundle m v ~> Bundle m' v
+ process :: Monad m
+ => k ~> (i -> )
+ -> MachineT m k ~> ProcessT m i
+ runAlt :: Alternative g
+ => f ~> g
+ -> Alt f ~> g
+ hoistAlt :: f ~> g
+ -> Alt f ~> Alt g
+ fromCurried :: Functor f
+ => k ~> Curried f h
+ -> Day f k ~> h
+ hoistScope :: Functor f
+ => f ~> g
+ -> Scope b f ~> Scope b g
+ haddockWithGhc :: ([Flag] -> Ghc ~> IO)
+ -> [String] -> IO ()
New description:
Is this something that belongs to core libraries (it has other names in
the wild, `:~>`, `Natural`..)
{{{#!hs
type f1 ~> f2 = forall a. f1 a -> f2 a
}}}
I use it all the time and end up redefining it (it is such a short type
that maybe it's not worth it, ‘Fairbairn threshold’ something something)
{{{#!hs
unLift :: Applicative f
=> Lift f a -> f a
mapLift :: (f a -> g a)
-> Lift f a -> Lift g a
mapFreeT :: (Functor f, Functor m)
=> (forall a. m a -> m' a)
-> FreeT f m a -> FreeT f m' a
vmap :: (a -> a')
-> Vec a n -> Vec a' n
liftIO :: MonadIO m
=> IO a -> m a
hoist :: Monad m
=> (forall a. m a -> n a)
-> t m b -> t n b
trans :: (Monad m, Monad m')
=> (forall a. m a -> m' a)
-> Bundle m v a -> Bundle m' v a
process :: Monad m
=> (forall a. k a -> i -> a)
-> MachineT m k o -> ProcessT m i o
runAlt :: Alternative g
=> (forall x. f x -> g x)
-> Alt f a -> g a
hoistAlt :: (forall a. f a -> g a)
-> Alt f b -> Alt g b
fromCurried :: Functor f
=> (forall a. k a -> Curried f h a)
-> Day f k b -> h b
hoistScope :: Functor f
=> (forall x. f x -> g x)
-> Scope b f a -> Scope b g a
haddockWithGhc :: (forall a. [Flag] -> Ghc a -> IO a)
-> [String] -> IO ()
newtype Alt f a = Alt { _runAlt :: forall g. Alternative g => (forall x. f
x -> g x) -> g a }
newtype Builder = Builder (forall r. BuildStep r -> BuildStep r)
data Zipper t a = Zipper (forall b. Seq b -> t b) {-# UNPACK #-} !Int
!(Seq a)
class MonadCatch m => MonadMask m where
mask :: ((forall a. m a -> m a) -> m b) -> m b
}}}
becomes
{{{#!hs
unLift :: Applicative f
=> Lift f ~> f
mapLift :: f ~> g
-> Lift f ~> Lift g
mapFreeT :: (Functor f, Functor m)
=> m ~> m'
-> FreeT f m ~> FreeT f m'
vmap :: (a -> a')
-> Vec a ~> Vec a'
liftIO :: MonadIO m
=> IO ~> m
hoist :: Monad m
=> m ~> n
-> t m ~> t n
trans :: (Monad m, Monad m')
=> m ~> m'
-> Bundle m v ~> Bundle m' v
process :: Monad m
=> k ~> (i -> )
-> MachineT m k ~> ProcessT m i
runAlt :: Alternative g
=> f ~> g
-> Alt f ~> g
hoistAlt :: f ~> g
-> Alt f ~> Alt g
fromCurried :: Functor f
=> k ~> Curried f h
-> Day f k ~> h
hoistScope :: Functor f
=> f ~> g
-> Scope b f ~> Scope b g
haddockWithGhc :: ([Flag] -> Ghc ~> IO)
-> [String] -> IO ()
newtype Alt f a = Alt { _runAlt :: forall g. Alternative g => (f ~> g) ->
g a }
newtype Builder = Builder (BuildStep ~> BuildStep)
data Zipper t a = Zipper (Seq ~> t) {-# UNPACK #-} !Int !(Seq a)
class MonadCatch m => MonadMask m where
mask :: ((m ~> m) -> m b) -> m b
}}}
these examples are pretty similar.
----
Same for
{{{#!hs
mapBlock :: (forall e x. n e x -> n' e x)
-> Block n e x -> Block n' e x
mapGraph :: (forall e x. n e x -> n' e x)
-> Graph n e x -> Graph n' e x
mapGraphNodes1 :: (forall e x. CmmNode e x -> CmmNode e x)
-> CmmGraph -> CmmGraph
foldCat :: (Catenated t, Category s)
=> (forall a b. r a b -> s a b)
-> t r a b -> s a b
mapCat :: Catenated t
=> (forall a b. r a b -> s a b)
-> t r a b -> t s a b
newtype Copastro p a b = Copastro { runCopastro :: forall r. Costrong r =>
(forall x y. p x y -> r x y) -> r a b }
newtype CopastroSum p a b = CopastroSum { runCopastroSum :: forall r.
Cochoice r => (forall x y. p x y -> r x y) -> r a b }
}}}
vs
{{{#!hs
type f1 ~~> f2 = forall a b. f1 a b -> f2 a b
mapBlock :: n ~~> n'
-> Block n ~~> Block n'
mapGraph :: n ~~> n'
-> Graph n ~~> Graph n'
mapGraphNodes1 :: CmmNode ~~> CmmNode
-> CmmGraph -> CmmGraph
foldCat :: (Catenated t, Category s)
=> r ~~> s
-> t r ~~> s
mapCat :: Catenated t
=> r ~~> s
-> t r ~~> t s
newtype Copastro p a b = Copastro { runCopastro :: forall r. Costrong r =>
(p ~~> r) -> r a b }
newtype CopastroSum p a b = CopastroSum { runCopastroSum :: forall r.
Cochoice r => (p ~~> r) -> r a b }
}}}
--
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/12772#comment:5>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list