Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude #-}------------------------------------------------------------------------------- This is a non-exposed internal module.---- This code contains utility function and data structures that are used-- to improve the efficiency of several instances in the Data.* namespace.-----------------------------------------------------------------------------moduleData.Functor.UtilswhereimportData.Coerce(Coercible,coerce)importGHC.Base(Applicative(..),Functor(..),Maybe(..),Monoid(..),Ord(..),Semigroup(..),($),otherwise)-- We don't expose Max and Min because, as Edward Kmett pointed out to me,-- there are two reasonable ways to define them. One way is to use Maybe, as we-- do here; the other way is to impose a Bounded constraint on the Monoid-- instance. We may eventually want to add both versions, but we don't want to-- trample on anyone's toes by imposing Max = MaxMaybe.newtypeMaxa=Max{getMax::Maybea}newtypeMina=Min{getMin::Maybea}-- | @since 4.11.0.0instanceOrda=>Semigroup(Maxa)where{-# INLINE(<>)#-}m<>MaxNothing=mMaxNothing<>n=n(Maxm@(Justx))<>(Maxn@(Justy))|x>=y=Maxm|otherwise=Maxn-- | @since 4.8.0.0instanceOrda=>Monoid(Maxa)wheremempty=MaxNothing-- | @since 4.11.0.0instanceOrda=>Semigroup(Mina)where{-# INLINE(<>)#-}m<>MinNothing=mMinNothing<>n=n(Minm@(Justx))<>(Minn@(Justy))|x<=y=Minm|otherwise=Minn-- | @since 4.8.0.0instanceOrda=>Monoid(Mina)wheremempty=MinNothing-- left-to-right state transformernewtypeStateLsa=StateL{runStateL::s->(s,a)}-- | @since 4.0instanceFunctor(StateLs)wherefmapf(StateLk)=StateL$\s->let(s',v)=ksin(s',fv)-- | @since 4.0instanceApplicative(StateLs)wherepurex=StateL(\s->(s,x))StateLkf<*>StateLkv=StateL$\s->let(s',f)=kfs(s'',v)=kvs'in(s'',fv)liftA2f(StateLkx)(StateLky)=StateL$\s->let(s',x)=kxs(s'',y)=kys'in(s'',fxy)-- right-to-left state transformernewtypeStateRsa=StateR{runStateR::s->(s,a)}-- | @since 4.0instanceFunctor(StateRs)wherefmapf(StateRk)=StateR$\s->let(s',v)=ksin(s',fv)-- | @since 4.0instanceApplicative(StateRs)wherepurex=StateR(\s->(s,x))StateRkf<*>StateRkv=StateR$\s->let(s',v)=kvs(s'',f)=kfs'in(s'',fv)liftA2f(StateRkx)(StateRky)=StateR$\s->let(s',y)=kys(s'',x)=kxs'in(s'',fxy)-- See Note [Function coercion](#.)::Coerciblebc=>(b->c)->(a->b)->(a->c)(#.)_f=coerce{-# INLINE(#.)#-}{-Note [Function coercion]~~~~~~~~~~~~~~~~~~~~~~~Several functions here use (#.) instead of (.) to avoid potential efficiencyproblems relating to #7542. The problem, in a nutshell:If N is a newtype constructor, then N x will always have the samerepresentation as x (something similar applies for a newtype deconstructor).However, if f is a function,N . f = \x -> N (f x)This looks almost the same as f, but the eta expansion lifts it--the lhs couldbe _|_, but the rhs never is. This can lead to very inefficient code.  Thus westeal a technique from Shachaf and Edward Kmett and adapt it to the current(rather clean) setting. Instead of using  N . f,  we use  N #. f, which isjustcoerce f `asTypeOf` (N . f)That is, we just *pretend* that f has the right type, and thanks to the safetyof coerce, the type checker guarantees that nothing really goes wrong. We stillhave to be a bit careful, though: remember that #. completely ignores the*value* of its left operand.-}