{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DeriveGeneric #-}
#endif
module Bound.Scope
( Scope(..)
, abstract, abstract1, abstractEither
, instantiate, instantiate1, instantiateEither
, fromScope
, toScope
, splat
, bindings
, mapBound
, mapScope
, liftMBound
, liftMScope
, foldMapBound
, foldMapScope
, traverseBound_
, traverseScope_
, mapMBound_
, mapMScope_
, traverseBound
, traverseScope
, mapMBound
, mapMScope
, serializeScope
, deserializeScope
, hoistScope
, bitraverseScope
, bitransverseScope
, transverseScope
, instantiateVars
) where
import Bound.Class
import Bound.Var
import Control.Applicative
import Control.DeepSeq
import Control.Monad hiding (mapM, mapM_)
import Control.Monad.Morph
import Data.Bifunctor
import Data.Bifoldable
import qualified Data.Binary as Binary
import Data.Binary (Binary)
import Data.Bitraversable
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Foldable
import Data.Functor.Classes
import Data.Hashable (Hashable (..))
import Data.Hashable.Lifted (Hashable1(..), hashWithSalt1)
import Data.Monoid
import qualified Data.Serialize as Serialize
import Data.Serialize (Serialize)
import Data.Traversable
import Prelude hiding (foldr, mapM, mapM_)
import Data.Data
#if defined(__GLASGOW_HASKELL__)
import GHC.Generics ( Generic, Generic1 )
#endif
newtype Scope b f a = Scope { forall b (f :: * -> *) a. Scope b f a -> f (Var b (f a))
unscope :: f (Var b (f a)) }
#if defined(__GLASGOW_HASKELL__)
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b (f :: * -> *) a x. Rep (Scope b f a) x -> Scope b f a
forall b (f :: * -> *) a x. Scope b f a -> Rep (Scope b f a) x
$cto :: forall b (f :: * -> *) a x. Rep (Scope b f a) x -> Scope b f a
$cfrom :: forall b (f :: * -> *) a x. Scope b f a -> Rep (Scope b f a) x
Generic)
#endif
deriving instance Functor f => Generic1 (Scope b f)
instance Functor f => Functor (Scope b f) where
fmap :: forall a b. (a -> b) -> Scope b f a -> Scope b f b
fmap a -> b
f (Scope f (Var b (f a))
a) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) f (Var b (f a))
a)
{-# INLINE fmap #-}
instance Foldable f => Foldable (Scope b f) where
foldMap :: forall m a. Monoid m => (a -> m) -> Scope b f a -> m
foldMap a -> m
f (Scope f (Var b (f a))
a) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f)) f (Var b (f a))
a
{-# INLINE foldMap #-}
instance Traversable f => Traversable (Scope b f) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Scope b f a -> f (Scope b f b)
traverse a -> f b
f (Scope f (Var b (f a))
a) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f)) f (Var b (f a))
a
{-# INLINE traverse #-}
instance (Functor f, Monad f) => Applicative (Scope b f) where
pure :: forall a. a -> Scope b f a
pure a
a = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. a -> Var b a
F (forall (m :: * -> *) a. Monad m => a -> m a
return a
a)))
{-# INLINE pure #-}
<*> :: forall a b. Scope b f (a -> b) -> Scope b f a -> Scope b f b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
{-# INLINE (<*>) #-}
instance Monad f => Monad (Scope b f) where
Scope f (Var b (f a))
e >>= :: forall a b. Scope b f a -> (a -> Scope b f b) -> Scope b f b
>>= a -> Scope b f b
f = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall a b. (a -> b) -> a -> b
$ f (Var b (f a))
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Var b (f a)
v -> case Var b (f a)
v of
B b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. b -> Var b a
B b
b)
F f a
ea -> f a
ea forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b (f :: * -> *) a. Scope b f a -> f (Var b (f a))
unscope forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Scope b f b
f
{-# INLINE (>>=) #-}
instance MonadTrans (Scope b) where
lift :: forall (m :: * -> *) a. Monad m => m a -> Scope b m a
lift m a
m = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. a -> Var b a
F m a
m))
{-# INLINE lift #-}
instance MFunctor (Scope b) where
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> Scope b m b -> Scope b n b
hoist = forall (f :: * -> *) (g :: * -> *) b a.
Functor f =>
(forall x. f x -> g x) -> Scope b f a -> Scope b g a
hoistScope
{-# INLINE hoist #-}
instance (Monad f, Eq b, Eq1 f, Eq a) => Eq (Scope b f a) where == :: Scope b f a -> Scope b f a -> Bool
(==) = forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
instance (Monad f, Ord b, Ord1 f, Ord a) => Ord (Scope b f a) where compare :: Scope b f a -> Scope b f a -> Ordering
compare = forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
instance (Read b, Read1 f, Read a) => Read (Scope b f a) where readsPrec :: Int -> ReadS (Scope b f a)
readsPrec = forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1
instance (Show b, Show1 f, Show a) => Show (Scope b f a) where showsPrec :: Int -> Scope b f a -> ShowS
showsPrec = forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
instance (Monad f, Eq b, Eq1 f) => Eq1 (Scope b f) where
liftEq :: forall a b. (a -> b -> Bool) -> Scope b f a -> Scope b f b -> Bool
liftEq a -> b -> Bool
f Scope b f a
m Scope b f b
n = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f) (forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope Scope b f a
m) (forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope Scope b f b
n)
instance (Monad f, Ord b, Ord1 f) => Ord1 (Scope b f) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> Scope b f a -> Scope b f b -> Ordering
liftCompare a -> b -> Ordering
f Scope b f a
m Scope b f b
n = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f) (forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope Scope b f a
m) (forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope Scope b f b
n)
instance (Show b, Show1 f) => Show1 (Scope b f) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Scope b f a -> ShowS
liftShowsPrec Int -> a -> ShowS
f [a] -> ShowS
g Int
d Scope b f a
m = forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> f a -> ShowS
f' [f a] -> ShowS
g') (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> f a -> ShowS
f' [f a] -> ShowS
g')) String
"Scope" Int
d (forall b (f :: * -> *) a. Scope b f a -> f (Var b (f a))
unscope Scope b f a
m) where
f' :: Int -> f a -> ShowS
f' = forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
f [a] -> ShowS
g
g' :: [f a] -> ShowS
g' = forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList Int -> a -> ShowS
f [a] -> ShowS
g
instance (Read b, Read1 f) => Read1 (Scope b f) where
liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Scope b f a)
liftReadsPrec Int -> ReadS a
f ReadS [a]
g = forall a. (String -> ReadS a) -> Int -> ReadS a
readsData forall a b. (a -> b) -> a -> b
$ forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith (forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec (forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (f a)
f' ReadS [f a]
g') (forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS (f a)
f' ReadS [f a]
g')) String
"Scope" forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope where
f' :: Int -> ReadS (f a)
f' = forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
f ReadS [a]
g
g' :: ReadS [f a]
g' = forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
f ReadS [a]
g
instance Bound (Scope b) where
Scope f (Var b (f a))
m >>>= :: forall (f :: * -> *) a c.
Monad f =>
Scope b f a -> (a -> f c) -> Scope b f c
>>>= a -> f c
f = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> f c
f)) f (Var b (f a))
m)
{-# INLINE (>>>=) #-}
instance (Hashable b, Monad f, Hashable1 f) => Hashable1 (Scope b f) where
liftHashWithSalt :: forall a. (Int -> a -> Int) -> Int -> Scope b f a -> Int
liftHashWithSalt Int -> a -> Int
h Int
s Scope b f a
m = forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt (forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt Int -> a -> Int
h) Int
s (forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope Scope b f a
m)
{-# INLINE liftHashWithSalt #-}
instance (Hashable b, Monad f, Hashable1 f, Hashable a) => Hashable (Scope b f a) where
hashWithSalt :: Int -> Scope b f a -> Int
hashWithSalt Int
n Scope b f a
m = forall (f :: * -> *) a.
(Hashable1 f, Hashable a) =>
Int -> f a -> Int
hashWithSalt1 Int
n (forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope Scope b f a
m)
{-# INLINE hashWithSalt #-}
instance NFData (f (Var b (f a))) => NFData (Scope b f a) where
rnf :: Scope b f a -> ()
rnf Scope b f a
scope = forall a. NFData a => a -> ()
rnf (forall b (f :: * -> *) a. Scope b f a -> f (Var b (f a))
unscope Scope b f a
scope)
abstract :: Monad f => (a -> Maybe b) -> f a -> Scope b f a
abstract :: forall (f :: * -> *) a b.
Monad f =>
(a -> Maybe b) -> f a -> Scope b f a
abstract a -> Maybe b
f f a
e = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall {m :: * -> *}. Monad m => a -> Var b (m a)
k f a
e) where
k :: a -> Var b (m a)
k a
y = case a -> Maybe b
f a
y of
Just b
z -> forall b a. b -> Var b a
B b
z
Maybe b
Nothing -> forall b a. a -> Var b a
F (forall (m :: * -> *) a. Monad m => a -> m a
return a
y)
{-# INLINE abstract #-}
abstract1 :: (Monad f, Eq a) => a -> f a -> Scope () f a
abstract1 :: forall (f :: * -> *) a. (Monad f, Eq a) => a -> f a -> Scope () f a
abstract1 a
a = forall (f :: * -> *) a b.
Monad f =>
(a -> Maybe b) -> f a -> Scope b f a
abstract (\a
b -> if a
a forall a. Eq a => a -> a -> Bool
== a
b then forall a. a -> Maybe a
Just () else forall a. Maybe a
Nothing)
{-# INLINE abstract1 #-}
abstractEither :: Monad f => (a -> Either b c) -> f a -> Scope b f c
abstractEither :: forall (f :: * -> *) a b c.
Monad f =>
(a -> Either b c) -> f a -> Scope b f c
abstractEither a -> Either b c
f f a
e = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall {m :: * -> *}. Monad m => a -> Var b (m c)
k f a
e) where
k :: a -> Var b (m c)
k a
y = case a -> Either b c
f a
y of
Left b
z -> forall b a. b -> Var b a
B b
z
Right c
y' -> forall b a. a -> Var b a
F (forall (m :: * -> *) a. Monad m => a -> m a
return c
y')
instantiate :: Monad f => (b -> f a) -> Scope b f a -> f a
instantiate :: forall (f :: * -> *) b a.
Monad f =>
(b -> f a) -> Scope b f a -> f a
instantiate b -> f a
k Scope b f a
e = forall b (f :: * -> *) a. Scope b f a -> f (Var b (f a))
unscope Scope b f a
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Var b (f a)
v -> case Var b (f a)
v of
B b
b -> b -> f a
k b
b
F f a
a -> f a
a
{-# INLINE instantiate #-}
instantiate1 :: Monad f => f a -> Scope n f a -> f a
instantiate1 :: forall (f :: * -> *) a n. Monad f => f a -> Scope n f a -> f a
instantiate1 f a
e = forall (f :: * -> *) b a.
Monad f =>
(b -> f a) -> Scope b f a -> f a
instantiate (forall a b. a -> b -> a
const f a
e)
{-# INLINE instantiate1 #-}
instantiateEither :: Monad f => (Either b a -> f c) -> Scope b f a -> f c
instantiateEither :: forall (f :: * -> *) b a c.
Monad f =>
(Either b a -> f c) -> Scope b f a -> f c
instantiateEither Either b a -> f c
f Scope b f a
s = forall b (f :: * -> *) a. Scope b f a -> f (Var b (f a))
unscope Scope b f a
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Var b (f a)
v -> case Var b (f a)
v of
B b
b -> Either b a -> f c
f (forall a b. a -> Either a b
Left b
b)
F f a
ea -> f a
ea forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either b a -> f c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
{-# INLINE instantiateEither #-}
fromScope :: Monad f => Scope b f a -> f (Var b a)
fromScope :: forall (f :: * -> *) b a. Monad f => Scope b f a -> f (Var b a)
fromScope (Scope f (Var b (f a))
s) = f (Var b (f a))
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Var b (f a)
v -> case Var b (f a)
v of
F f a
e -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall b a. a -> Var b a
F f a
e
B b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. b -> Var b a
B b
b)
{-# INLINE fromScope #-}
toScope :: Monad f => f (Var b a) -> Scope b f a
toScope :: forall (f :: * -> *) b a. Monad f => f (Var b a) -> Scope b f a
toScope f (Var b a)
e = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => a -> m a
return) f (Var b a)
e)
{-# INLINE toScope #-}
splat :: Monad f => (a -> f c) -> (b -> f c) -> Scope b f a -> f c
splat :: forall (f :: * -> *) a c b.
Monad f =>
(a -> f c) -> (b -> f c) -> Scope b f a -> f c
splat a -> f c
f b -> f c
unbind Scope b f a
s = forall b (f :: * -> *) a. Scope b f a -> f (Var b (f a))
unscope Scope b f a
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Var b (f a)
v -> case Var b (f a)
v of
B b
b -> b -> f c
unbind b
b
F f a
ea -> f a
ea forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> f c
f
{-# INLINE splat #-}
bindings :: Foldable f => Scope b f a -> [b]
bindings :: forall (f :: * -> *) b a. Foldable f => Scope b f a -> [b]
bindings (Scope f (Var b (f a))
s) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}. Var a a -> [a] -> [a]
f [] f (Var b (f a))
s where
f :: Var a a -> [a] -> [a]
f (B a
v) [a]
vs = a
v forall a. a -> [a] -> [a]
: [a]
vs
f Var a a
_ [a]
vs = [a]
vs
{-# INLINE bindings #-}
mapBound :: Functor f => (b -> b') -> Scope b f a -> Scope b' f a
mapBound :: forall (f :: * -> *) b b' a.
Functor f =>
(b -> b') -> Scope b f a -> Scope b' f a
mapBound b -> b'
f (Scope f (Var b (f a))
s) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Var b a -> Var b' a
f' f (Var b (f a))
s) where
f' :: Var b a -> Var b' a
f' (B b
b) = forall b a. b -> Var b a
B (b -> b'
f b
b)
f' (F a
a) = forall b a. a -> Var b a
F a
a
{-# INLINE mapBound #-}
mapScope :: Functor f => (b -> d) -> (a -> c) -> Scope b f a -> Scope d f c
mapScope :: forall (f :: * -> *) b d a c.
Functor f =>
(b -> d) -> (a -> c) -> Scope b f a -> Scope d f c
mapScope b -> d
f a -> c
g (Scope f (Var b (f a))
s) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> d
f (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> c
g)) f (Var b (f a))
s
{-# INLINE mapScope #-}
liftMBound :: Monad m => (b -> b') -> Scope b m a -> Scope b' m a
liftMBound :: forall (m :: * -> *) b b' a.
Monad m =>
(b -> b') -> Scope b m a -> Scope b' m a
liftMBound b -> b'
f (Scope m (Var b (m a))
s) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall {a}. Var b a -> Var b' a
f' m (Var b (m a))
s) where
f' :: Var b a -> Var b' a
f' (B b
b) = forall b a. b -> Var b a
B (b -> b'
f b
b)
f' (F a
a) = forall b a. a -> Var b a
F a
a
{-# INLINE liftMBound #-}
liftMScope :: Monad m => (b -> d) -> (a -> c) -> Scope b m a -> Scope d m c
liftMScope :: forall (m :: * -> *) b d a c.
Monad m =>
(b -> d) -> (a -> c) -> Scope b m a -> Scope d m c
liftMScope b -> d
f a -> c
g (Scope m (Var b (m a))
s) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap b -> d
f (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> c
g)) m (Var b (m a))
s
{-# INLINE liftMScope #-}
foldMapBound :: (Foldable f, Monoid r) => (b -> r) -> Scope b f a -> r
foldMapBound :: forall (f :: * -> *) r b a.
(Foldable f, Monoid r) =>
(b -> r) -> Scope b f a -> r
foldMapBound b -> r
f (Scope f (Var b (f a))
s) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {a}. Var b a -> r
f' f (Var b (f a))
s where
f' :: Var b a -> r
f' (B b
a) = b -> r
f b
a
f' Var b a
_ = forall a. Monoid a => a
mempty
{-# INLINE foldMapBound #-}
foldMapScope :: (Foldable f, Monoid r) =>
(b -> r) -> (a -> r) -> Scope b f a -> r
foldMapScope :: forall (f :: * -> *) r b a.
(Foldable f, Monoid r) =>
(b -> r) -> (a -> r) -> Scope b f a -> r
foldMapScope b -> r
f a -> r
g (Scope f (Var b (f a))
s) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap b -> r
f (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> r
g)) f (Var b (f a))
s
{-# INLINE foldMapScope #-}
traverseBound_ :: (Applicative g, Foldable f) =>
(b -> g d) -> Scope b f a -> g ()
traverseBound_ :: forall (g :: * -> *) (f :: * -> *) b d a.
(Applicative g, Foldable f) =>
(b -> g d) -> Scope b f a -> g ()
traverseBound_ b -> g d
f (Scope f (Var b (f a))
s) = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall {a}. Var b a -> g ()
f' f (Var b (f a))
s
where f' :: Var b a -> g ()
f' (B b
a) = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ b -> g d
f b
a
f' Var b a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE traverseBound_ #-}
traverseScope_ :: (Applicative g, Foldable f) =>
(b -> g d) -> (a -> g c) -> Scope b f a -> g ()
traverseScope_ :: forall (g :: * -> *) (f :: * -> *) b d a c.
(Applicative g, Foldable f) =>
(b -> g d) -> (a -> g c) -> Scope b f a -> g ()
traverseScope_ b -> g d
f a -> g c
g (Scope f (Var b (f a))
s) = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bifoldable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f ()
bitraverse_ b -> g d
f (forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ a -> g c
g)) f (Var b (f a))
s
{-# INLINE traverseScope_ #-}
mapMBound_ :: (Monad g, Foldable f) => (b -> g d) -> Scope b f a -> g ()
mapMBound_ :: forall (g :: * -> *) (f :: * -> *) b d a.
(Monad g, Foldable f) =>
(b -> g d) -> Scope b f a -> g ()
mapMBound_ b -> g d
f (Scope f (Var b (f a))
s) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}. Var b a -> g ()
f' f (Var b (f a))
s where
f' :: Var b a -> g ()
f' (B b
a) = do d
_ <- b -> g d
f b
a; forall (m :: * -> *) a. Monad m => a -> m a
return ()
f' Var b a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE mapMBound_ #-}
mapMScope_ :: (Monad m, Foldable f) =>
(b -> m d) -> (a -> m c) -> Scope b f a -> m ()
mapMScope_ :: forall (m :: * -> *) (f :: * -> *) b d a c.
(Monad m, Foldable f) =>
(b -> m d) -> (a -> m c) -> Scope b f a -> m ()
mapMScope_ b -> m d
f a -> m c
g (Scope f (Var b (f a))
s) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bifoldable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f ()
bimapM_ b -> m d
f (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m c
g)) f (Var b (f a))
s
{-# INLINE mapMScope_ #-}
traverseBound :: (Applicative g, Traversable f) =>
(b -> g c) -> Scope b f a -> g (Scope c f a)
traverseBound :: forall (g :: * -> *) (f :: * -> *) b c a.
(Applicative g, Traversable f) =>
(b -> g c) -> Scope b f a -> g (Scope c f a)
traverseBound b -> g c
f (Scope f (Var b (f a))
s) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {a}. Var b a -> g (Var c a)
f' f (Var b (f a))
s where
f' :: Var b a -> g (Var c a)
f' (B b
b) = forall b a. b -> Var b a
B forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> g c
f b
b
f' (F a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall b a. a -> Var b a
F a
a)
{-# INLINE traverseBound #-}
traverseScope :: (Applicative g, Traversable f) =>
(b -> g d) -> (a -> g c) -> Scope b f a -> g (Scope d f c)
traverseScope :: forall (g :: * -> *) (f :: * -> *) b d a c.
(Applicative g, Traversable f) =>
(b -> g d) -> (a -> g c) -> Scope b f a -> g (Scope d f c)
traverseScope b -> g d
f a -> g c
g (Scope f (Var b (f a))
s) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse b -> g d
f (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> g c
g)) f (Var b (f a))
s
{-# INLINE traverseScope #-}
mapMBound :: (Monad m, Traversable f) =>
(b -> m c) -> Scope b f a -> m (Scope c f a)
mapMBound :: forall (m :: * -> *) (f :: * -> *) b c a.
(Monad m, Traversable f) =>
(b -> m c) -> Scope b f a -> m (Scope c f a)
mapMBound b -> m c
f (Scope f (Var b (f a))
s) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a}. Var b a -> m (Var c a)
f' f (Var b (f a))
s) where
f' :: Var b a -> m (Var c a)
f' (B b
b) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall b a. b -> Var b a
B (b -> m c
f b
b)
f' (F a
a) = forall (m :: * -> *) a. Monad m => a -> m a
return (forall b a. a -> Var b a
F a
a)
{-# INLINE mapMBound #-}
mapMScope :: (Monad m, Traversable f) =>
(b -> m d) -> (a -> m c) -> Scope b f a -> m (Scope d f c)
mapMScope :: forall (m :: * -> *) (f :: * -> *) b d a c.
(Monad m, Traversable f) =>
(b -> m d) -> (a -> m c) -> Scope b f a -> m (Scope d f c)
mapMScope b -> m d
f a -> m c
g (Scope f (Var b (f a))
s) = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bimapM b -> m d
f (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m c
g)) f (Var b (f a))
s)
{-# INLINE mapMScope #-}
serializeScope :: (Serial1 f, MonadPut m) => (b -> m ()) -> (v -> m ()) -> Scope b f v -> m ()
serializeScope :: forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadPut m) =>
(b -> m ()) -> (v -> m ()) -> Scope b f v -> m ()
serializeScope b -> m ()
pb v -> m ()
pv (Scope f (Var b (f v))
body) = forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith (forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadPut m) =>
(a -> m ()) -> (b -> m ()) -> f a b -> m ()
serializeWith2 b -> m ()
pb forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadPut m) =>
(a -> m ()) -> f a -> m ()
serializeWith v -> m ()
pv) f (Var b (f v))
body
{-# INLINE serializeScope #-}
deserializeScope :: (Serial1 f, MonadGet m) => m b -> m v -> m (Scope b f v)
deserializeScope :: forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadGet m) =>
m b -> m v -> m (Scope b f v)
deserializeScope m b
gb m v
gv = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith (forall (f :: * -> * -> *) (m :: * -> *) a b.
(Serial2 f, MonadGet m) =>
m a -> m b -> m (f a b)
deserializeWith2 m b
gb forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) (m :: * -> *) a.
(Serial1 f, MonadGet m) =>
m a -> m (f a)
deserializeWith m v
gv)
{-# INLINE deserializeScope #-}
bitraverseScope :: (Bitraversable t, Applicative f) => (k -> f k') -> (a -> f a') -> Scope b (t k) a -> f (Scope b (t k') a')
bitraverseScope :: forall (t :: * -> * -> *) (f :: * -> *) k k' a a' b.
(Bitraversable t, Applicative f) =>
(k -> f k')
-> (a -> f a') -> Scope b (t k) a -> f (Scope b (t k') a')
bitraverseScope k -> f k'
f = forall (f :: * -> *) (t :: * -> *) (u :: * -> *) c c' b.
Applicative f =>
(forall a a'. (a -> f a') -> t a -> f (u a'))
-> (c -> f c') -> Scope b t c -> f (Scope b u c')
bitransverseScope (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse k -> f k'
f)
{-# INLINE bitraverseScope #-}
transverseScope :: (Applicative f, Monad f, Traversable g)
=> (forall r. g r -> f (h r))
-> Scope b g a -> f (Scope b h a)
transverseScope :: forall (f :: * -> *) (g :: * -> *) (h :: * -> *) b a.
(Applicative f, Monad f, Traversable g) =>
(forall r. g r -> f (h r)) -> Scope b g a -> f (Scope b h a)
transverseScope forall r. g r -> f (h r)
tau (Scope g (Var b (g a))
e) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall r. g r -> f (h r)
tau forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall r. g r -> f (h r)
tau) g (Var b (g a))
e)
bitransverseScope :: Applicative f => (forall a a'. (a -> f a') -> t a -> f (u a')) -> (c -> f c') -> Scope b t c -> f (Scope b u c')
bitransverseScope :: forall (f :: * -> *) (t :: * -> *) (u :: * -> *) c c' b.
Applicative f =>
(forall a a'. (a -> f a') -> t a -> f (u a'))
-> (c -> f c') -> Scope b t c -> f (Scope b u c')
bitransverseScope forall a a'. (a -> f a') -> t a -> f (u a')
tau c -> f c'
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a a'. (a -> f a') -> t a -> f (u a')
tau (forall (p :: * -> * -> *) (f :: * -> *) a a' b.
(Choice p, Applicative f) =>
p a (f a') -> p (Var b a) (f (Var b a'))
_F (forall a a'. (a -> f a') -> t a -> f (u a')
tau c -> f c'
f)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b (f :: * -> *) a. Scope b f a -> f (Var b (f a))
unscope
{-# INLINE bitransverseScope #-}
instantiateVars :: Monad t => [a] -> Scope Int t a -> t a
instantiateVars :: forall (t :: * -> *) a. Monad t => [a] -> Scope Int t a -> t a
instantiateVars [a]
as = forall (f :: * -> *) b a.
Monad f =>
(b -> f a) -> Scope b f a -> f a
instantiate ([t a]
vs forall a. [a] -> Int -> a
!!) where
vs :: [t a]
vs = forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return [a]
as
{-# INLINE instantiateVars #-}
hoistScope :: Functor f => (forall x. f x -> g x) -> Scope b f a -> Scope b g a
hoistScope :: forall (f :: * -> *) (g :: * -> *) b a.
Functor f =>
(forall x. f x -> g x) -> Scope b f a -> Scope b g a
hoistScope forall x. f x -> g x
t (Scope f (Var b (f a))
b) = forall b (f :: * -> *) a. f (Var b (f a)) -> Scope b f a
Scope forall a b. (a -> b) -> a -> b
$ forall x. f x -> g x
t (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall x. f x -> g x
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Var b (f a))
b)
{-# INLINE hoistScope #-}
instance (Serial b, Serial1 f) => Serial1 (Scope b f) where
serializeWith :: forall (m :: * -> *) a.
MonadPut m =>
(a -> m ()) -> Scope b f a -> m ()
serializeWith = forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadPut m) =>
(b -> m ()) -> (v -> m ()) -> Scope b f v -> m ()
serializeScope forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
deserializeWith :: forall (m :: * -> *) a. MonadGet m => m a -> m (Scope b f a)
deserializeWith = forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadGet m) =>
m b -> m v -> m (Scope b f v)
deserializeScope forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance (Serial b, Serial1 f, Serial a) => Serial (Scope b f a) where
serialize :: forall (m :: * -> *). MonadPut m => Scope b f a -> m ()
serialize = forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadPut m) =>
(b -> m ()) -> (v -> m ()) -> Scope b f v -> m ()
serializeScope forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
deserialize :: forall (m :: * -> *). MonadGet m => m (Scope b f a)
deserialize = forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadGet m) =>
m b -> m v -> m (Scope b f v)
deserializeScope forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
instance (Binary b, Serial1 f, Binary a) => Binary (Scope b f a) where
put :: Scope b f a -> Put
put = forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadPut m) =>
(b -> m ()) -> (v -> m ()) -> Scope b f v -> m ()
serializeScope forall t. Binary t => t -> Put
Binary.put forall t. Binary t => t -> Put
Binary.put
get :: Get (Scope b f a)
get = forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadGet m) =>
m b -> m v -> m (Scope b f v)
deserializeScope forall t. Binary t => Get t
Binary.get forall t. Binary t => Get t
Binary.get
instance (Serialize b, Serial1 f, Serialize a) => Serialize (Scope b f a) where
put :: Putter (Scope b f a)
put = forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadPut m) =>
(b -> m ()) -> (v -> m ()) -> Scope b f v -> m ()
serializeScope forall t. Serialize t => Putter t
Serialize.put forall t. Serialize t => Putter t
Serialize.put
get :: Get (Scope b f a)
get = forall (f :: * -> *) (m :: * -> *) b v.
(Serial1 f, MonadGet m) =>
m b -> m v -> m (Scope b f v)
deserializeScope forall t. Serialize t => Get t
Serialize.get forall t. Serialize t => Get t
Serialize.get
#ifdef __GLASGOW_HASKELL__
deriving instance (Typeable b, Typeable f, Data a, Data (f (Var b (f a)))) => Data (Scope b f a)
#endif