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