{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Futhark.IR.Prop.Scope
( HasScope (..),
NameInfo (..),
LocalScope (..),
Scope,
Scoped (..),
inScopeOf,
scopeOfLParams,
scopeOfFParams,
scopeOfLoopForm,
scopeOfPat,
scopeOfPatElem,
SameScope,
castScope,
ExtendedScope,
extendedScope,
)
where
import Control.Monad.Except
import Control.Monad.RWS.Lazy qualified
import Control.Monad.RWS.Strict qualified
import Control.Monad.Reader
import Data.Map.Strict qualified as M
import Futhark.IR.Pretty ()
import Futhark.IR.Prop.Types
import Futhark.IR.Rep
import Futhark.IR.Syntax
data NameInfo rep
= LetName (LetDec rep)
| FParamName (FParamInfo rep)
| LParamName (LParamInfo rep)
| IndexName IntType
deriving instance (RepTypes rep) => Show (NameInfo rep)
instance (RepTypes rep) => Typed (NameInfo rep) where
typeOf :: NameInfo rep -> Type
typeOf (LetName LetDec rep
dec) = LetDec rep -> Type
forall t. Typed t => t -> Type
typeOf LetDec rep
dec
typeOf (FParamName FParamInfo rep
dec) = FParamInfo rep -> Type
forall t. Typed t => t -> Type
typeOf FParamInfo rep
dec
typeOf (LParamName LParamInfo rep
dec) = LParamInfo rep -> Type
forall t. Typed t => t -> Type
typeOf LParamInfo rep
dec
typeOf (IndexName IntType
it) = PrimType -> Type
forall shape u. PrimType -> TypeBase shape u
Prim (PrimType -> Type) -> PrimType -> Type
forall a b. (a -> b) -> a -> b
$ IntType -> PrimType
IntType IntType
it
type Scope rep = M.Map VName (NameInfo rep)
class (Applicative m, RepTypes rep) => HasScope rep m | m -> rep where
lookupType :: VName -> m Type
lookupType = (NameInfo rep -> Type) -> m (NameInfo rep) -> m Type
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameInfo rep -> Type
forall t. Typed t => t -> Type
typeOf (m (NameInfo rep) -> m Type)
-> (VName -> m (NameInfo rep)) -> VName -> m Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> m (NameInfo rep)
forall rep (m :: * -> *).
HasScope rep m =>
VName -> m (NameInfo rep)
lookupInfo
lookupInfo :: VName -> m (NameInfo rep)
lookupInfo VName
name =
(Scope rep -> NameInfo rep) -> m (NameInfo rep)
forall a. (Scope rep -> a) -> m a
forall rep (m :: * -> *) a.
HasScope rep m =>
(Scope rep -> a) -> m a
asksScope (NameInfo rep -> VName -> Scope rep -> NameInfo rep
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault NameInfo rep
notFound VName
name)
where
notFound :: NameInfo rep
notFound =
String -> NameInfo rep
forall a. HasCallStack => String -> a
error (String -> NameInfo rep) -> String -> NameInfo rep
forall a b. (a -> b) -> a -> b
$
String
"Scope.lookupInfo: Name "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ VName -> String
forall a. Pretty a => a -> String
prettyString VName
name
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found in type environment."
askScope :: m (Scope rep)
asksScope :: (Scope rep -> a) -> m a
asksScope Scope rep -> a
f = Scope rep -> a
f (Scope rep -> a) -> m (Scope rep) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Scope rep)
forall rep (m :: * -> *). HasScope rep m => m (Scope rep)
askScope
instance
(Monad m, RepTypes rep) =>
HasScope rep (ReaderT (Scope rep) m)
where
askScope :: ReaderT (Scope rep) m (Scope rep)
askScope = ReaderT (Scope rep) m (Scope rep)
forall r (m :: * -> *). MonadReader r m => m r
ask
instance (Monad m, HasScope rep m) => HasScope rep (ExceptT e m) where
askScope :: ExceptT e m (Scope rep)
askScope = m (Scope rep) -> ExceptT e m (Scope rep)
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Scope rep)
forall rep (m :: * -> *). HasScope rep m => m (Scope rep)
askScope
instance
(Monad m, Monoid w, RepTypes rep) =>
HasScope rep (Control.Monad.RWS.Strict.RWST (Scope rep) w s m)
where
askScope :: RWST (Scope rep) w s m (Scope rep)
askScope = RWST (Scope rep) w s m (Scope rep)
forall r (m :: * -> *). MonadReader r m => m r
ask
instance
(Monad m, Monoid w, RepTypes rep) =>
HasScope rep (Control.Monad.RWS.Lazy.RWST (Scope rep) w s m)
where
askScope :: RWST (Scope rep) w s m (Scope rep)
askScope = RWST (Scope rep) w s m (Scope rep)
forall r (m :: * -> *). MonadReader r m => m r
ask
class (HasScope rep m, Monad m) => LocalScope rep m where
localScope :: Scope rep -> m a -> m a
instance (LocalScope rep m) => LocalScope rep (ExceptT e m) where
localScope :: forall a. Scope rep -> ExceptT e m a -> ExceptT e m a
localScope = (m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT ((m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a)
-> (Scope rep -> m (Either e a) -> m (Either e a))
-> Scope rep
-> ExceptT e m a
-> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope rep -> m (Either e a) -> m (Either e a)
forall a. Scope rep -> m a -> m a
forall rep (m :: * -> *) a.
LocalScope rep m =>
Scope rep -> m a -> m a
localScope
instance
(Monad m, RepTypes rep) =>
LocalScope rep (ReaderT (Scope rep) m)
where
localScope :: forall a.
Scope rep -> ReaderT (Scope rep) m a -> ReaderT (Scope rep) m a
localScope = (Scope rep -> Scope rep)
-> ReaderT (Scope rep) m a -> ReaderT (Scope rep) m a
forall a.
(Scope rep -> Scope rep)
-> ReaderT (Scope rep) m a -> ReaderT (Scope rep) m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((Scope rep -> Scope rep)
-> ReaderT (Scope rep) m a -> ReaderT (Scope rep) m a)
-> (Scope rep -> Scope rep -> Scope rep)
-> Scope rep
-> ReaderT (Scope rep) m a
-> ReaderT (Scope rep) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope rep -> Scope rep -> Scope rep
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
instance
(Monad m, Monoid w, RepTypes rep) =>
LocalScope rep (Control.Monad.RWS.Strict.RWST (Scope rep) w s m)
where
localScope :: forall a.
Scope rep -> RWST (Scope rep) w s m a -> RWST (Scope rep) w s m a
localScope = (Scope rep -> Scope rep)
-> RWST (Scope rep) w s m a -> RWST (Scope rep) w s m a
forall a.
(Scope rep -> Scope rep)
-> RWST (Scope rep) w s m a -> RWST (Scope rep) w s m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((Scope rep -> Scope rep)
-> RWST (Scope rep) w s m a -> RWST (Scope rep) w s m a)
-> (Scope rep -> Scope rep -> Scope rep)
-> Scope rep
-> RWST (Scope rep) w s m a
-> RWST (Scope rep) w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope rep -> Scope rep -> Scope rep
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
instance
(Monad m, Monoid w, RepTypes rep) =>
LocalScope rep (Control.Monad.RWS.Lazy.RWST (Scope rep) w s m)
where
localScope :: forall a.
Scope rep -> RWST (Scope rep) w s m a -> RWST (Scope rep) w s m a
localScope = (Scope rep -> Scope rep)
-> RWST (Scope rep) w s m a -> RWST (Scope rep) w s m a
forall a.
(Scope rep -> Scope rep)
-> RWST (Scope rep) w s m a -> RWST (Scope rep) w s m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((Scope rep -> Scope rep)
-> RWST (Scope rep) w s m a -> RWST (Scope rep) w s m a)
-> (Scope rep -> Scope rep -> Scope rep)
-> Scope rep
-> RWST (Scope rep) w s m a
-> RWST (Scope rep) w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope rep -> Scope rep -> Scope rep
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
class Scoped rep a | a -> rep where
scopeOf :: a -> Scope rep
inScopeOf :: (Scoped rep a, LocalScope rep m) => a -> m b -> m b
inScopeOf :: forall rep a (m :: * -> *) b.
(Scoped rep a, LocalScope rep m) =>
a -> m b -> m b
inScopeOf = Scope rep -> m b -> m b
forall a. Scope rep -> m a -> m a
forall rep (m :: * -> *) a.
LocalScope rep m =>
Scope rep -> m a -> m a
localScope (Scope rep -> m b -> m b) -> (a -> Scope rep) -> a -> m b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Scope rep
forall rep a. Scoped rep a => a -> Scope rep
scopeOf
instance (Scoped rep a) => Scoped rep [a] where
scopeOf :: [a] -> Scope rep
scopeOf = [Scope rep] -> Scope rep
forall a. Monoid a => [a] -> a
mconcat ([Scope rep] -> Scope rep)
-> ([a] -> [Scope rep]) -> [a] -> Scope rep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Scope rep) -> [a] -> [Scope rep]
forall a b. (a -> b) -> [a] -> [b]
map a -> Scope rep
forall rep a. Scoped rep a => a -> Scope rep
scopeOf
instance Scoped rep (Stms rep) where
scopeOf :: Stms rep -> Scope rep
scopeOf = (Stm rep -> Scope rep) -> Stms rep -> Scope rep
forall m a. Monoid m => (a -> m) -> Seq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Stm rep -> Scope rep
forall rep a. Scoped rep a => a -> Scope rep
scopeOf
instance Scoped rep (Stm rep) where
scopeOf :: Stm rep -> Scope rep
scopeOf = Pat (LetDec rep) -> Scope rep
forall rep dec. (LetDec rep ~ dec) => Pat dec -> Scope rep
scopeOfPat (Pat (LetDec rep) -> Scope rep)
-> (Stm rep -> Pat (LetDec rep)) -> Stm rep -> Scope rep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stm rep -> Pat (LetDec rep)
forall rep. Stm rep -> Pat (LetDec rep)
stmPat
instance Scoped rep (FunDef rep) where
scopeOf :: FunDef rep -> Scope rep
scopeOf = [Param (FParamInfo rep)] -> Scope rep
forall rep dec. (FParamInfo rep ~ dec) => [Param dec] -> Scope rep
scopeOfFParams ([Param (FParamInfo rep)] -> Scope rep)
-> (FunDef rep -> [Param (FParamInfo rep)])
-> FunDef rep
-> Scope rep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef rep -> [Param (FParamInfo rep)]
forall rep. FunDef rep -> [FParam rep]
funDefParams
instance Scoped rep (VName, NameInfo rep) where
scopeOf :: (VName, NameInfo rep) -> Scope rep
scopeOf = (VName -> NameInfo rep -> Scope rep)
-> (VName, NameInfo rep) -> Scope rep
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry VName -> NameInfo rep -> Scope rep
forall k a. k -> a -> Map k a
M.singleton
scopeOfLoopForm :: LoopForm -> Scope rep
scopeOfLoopForm :: forall rep. LoopForm -> Scope rep
scopeOfLoopForm (WhileLoop VName
_) = Scope rep
forall a. Monoid a => a
mempty
scopeOfLoopForm (ForLoop VName
i IntType
it SubExp
_) = VName -> NameInfo rep -> Scope rep
forall k a. k -> a -> Map k a
M.singleton VName
i (NameInfo rep -> Scope rep) -> NameInfo rep -> Scope rep
forall a b. (a -> b) -> a -> b
$ IntType -> NameInfo rep
forall rep. IntType -> NameInfo rep
IndexName IntType
it
scopeOfPat :: (LetDec rep ~ dec) => Pat dec -> Scope rep
scopeOfPat :: forall rep dec. (LetDec rep ~ dec) => Pat dec -> Scope rep
scopeOfPat =
[Scope rep] -> Scope rep
forall a. Monoid a => [a] -> a
mconcat ([Scope rep] -> Scope rep)
-> (Pat dec -> [Scope rep]) -> Pat dec -> Scope rep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatElem dec -> Scope rep) -> [PatElem dec] -> [Scope rep]
forall a b. (a -> b) -> [a] -> [b]
map PatElem dec -> Scope rep
forall rep dec. (LetDec rep ~ dec) => PatElem dec -> Scope rep
scopeOfPatElem ([PatElem dec] -> [Scope rep])
-> (Pat dec -> [PatElem dec]) -> Pat dec -> [Scope rep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat dec -> [PatElem dec]
forall dec. Pat dec -> [PatElem dec]
patElems
scopeOfPatElem :: (LetDec rep ~ dec) => PatElem dec -> Scope rep
scopeOfPatElem :: forall rep dec. (LetDec rep ~ dec) => PatElem dec -> Scope rep
scopeOfPatElem (PatElem VName
name dec
dec) = VName -> NameInfo rep -> Map VName (NameInfo rep)
forall k a. k -> a -> Map k a
M.singleton VName
name (NameInfo rep -> Map VName (NameInfo rep))
-> NameInfo rep -> Map VName (NameInfo rep)
forall a b. (a -> b) -> a -> b
$ LetDec rep -> NameInfo rep
forall rep. LetDec rep -> NameInfo rep
LetName dec
LetDec rep
dec
scopeOfLParams ::
(LParamInfo rep ~ dec) =>
[Param dec] ->
Scope rep
scopeOfLParams :: forall rep dec. (LParamInfo rep ~ dec) => [Param dec] -> Scope rep
scopeOfLParams = [(VName, NameInfo rep)] -> Map VName (NameInfo rep)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(VName, NameInfo rep)] -> Map VName (NameInfo rep))
-> ([Param dec] -> [(VName, NameInfo rep)])
-> [Param dec]
-> Map VName (NameInfo rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Param dec -> (VName, NameInfo rep))
-> [Param dec] -> [(VName, NameInfo rep)]
forall a b. (a -> b) -> [a] -> [b]
map Param dec -> (VName, NameInfo rep)
Param (LParamInfo rep) -> (VName, NameInfo rep)
forall {rep}. Param (LParamInfo rep) -> (VName, NameInfo rep)
f
where
f :: Param (LParamInfo rep) -> (VName, NameInfo rep)
f Param (LParamInfo rep)
param = (Param (LParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName Param (LParamInfo rep)
param, LParamInfo rep -> NameInfo rep
forall rep. LParamInfo rep -> NameInfo rep
LParamName (LParamInfo rep -> NameInfo rep) -> LParamInfo rep -> NameInfo rep
forall a b. (a -> b) -> a -> b
$ Param (LParamInfo rep) -> LParamInfo rep
forall dec. Param dec -> dec
paramDec Param (LParamInfo rep)
param)
scopeOfFParams ::
(FParamInfo rep ~ dec) =>
[Param dec] ->
Scope rep
scopeOfFParams :: forall rep dec. (FParamInfo rep ~ dec) => [Param dec] -> Scope rep
scopeOfFParams = [(VName, NameInfo rep)] -> Map VName (NameInfo rep)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(VName, NameInfo rep)] -> Map VName (NameInfo rep))
-> ([Param dec] -> [(VName, NameInfo rep)])
-> [Param dec]
-> Map VName (NameInfo rep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Param dec -> (VName, NameInfo rep))
-> [Param dec] -> [(VName, NameInfo rep)]
forall a b. (a -> b) -> [a] -> [b]
map Param dec -> (VName, NameInfo rep)
Param (FParamInfo rep) -> (VName, NameInfo rep)
forall {rep}. Param (FParamInfo rep) -> (VName, NameInfo rep)
f
where
f :: Param (FParamInfo rep) -> (VName, NameInfo rep)
f Param (FParamInfo rep)
param = (Param (FParamInfo rep) -> VName
forall dec. Param dec -> VName
paramName Param (FParamInfo rep)
param, FParamInfo rep -> NameInfo rep
forall rep. FParamInfo rep -> NameInfo rep
FParamName (FParamInfo rep -> NameInfo rep) -> FParamInfo rep -> NameInfo rep
forall a b. (a -> b) -> a -> b
$ Param (FParamInfo rep) -> FParamInfo rep
forall dec. Param dec -> dec
paramDec Param (FParamInfo rep)
param)
instance Scoped rep (Lambda rep) where
scopeOf :: Lambda rep -> Scope rep
scopeOf Lambda rep
lam = [Param (LParamInfo rep)] -> Scope rep
forall rep dec. (LParamInfo rep ~ dec) => [Param dec] -> Scope rep
scopeOfLParams ([Param (LParamInfo rep)] -> Scope rep)
-> [Param (LParamInfo rep)] -> Scope rep
forall a b. (a -> b) -> a -> b
$ Lambda rep -> [Param (LParamInfo rep)]
forall rep. Lambda rep -> [LParam rep]
lambdaParams Lambda rep
lam
type SameScope rep1 rep2 =
( LetDec rep1 ~ LetDec rep2,
FParamInfo rep1 ~ FParamInfo rep2,
LParamInfo rep1 ~ LParamInfo rep2
)
castScope ::
(SameScope fromrep torep) =>
Scope fromrep ->
Scope torep
castScope :: forall fromrep torep.
SameScope fromrep torep =>
Scope fromrep -> Scope torep
castScope = (NameInfo fromrep -> NameInfo torep)
-> Map VName (NameInfo fromrep) -> Map VName (NameInfo torep)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NameInfo fromrep -> NameInfo torep
forall fromrep torep.
SameScope fromrep torep =>
NameInfo fromrep -> NameInfo torep
castNameInfo
castNameInfo ::
(SameScope fromrep torep) =>
NameInfo fromrep ->
NameInfo torep
castNameInfo :: forall fromrep torep.
SameScope fromrep torep =>
NameInfo fromrep -> NameInfo torep
castNameInfo (LetName LetDec fromrep
dec) = LetDec torep -> NameInfo torep
forall rep. LetDec rep -> NameInfo rep
LetName LetDec fromrep
LetDec torep
dec
castNameInfo (FParamName FParamInfo fromrep
dec) = FParamInfo torep -> NameInfo torep
forall rep. FParamInfo rep -> NameInfo rep
FParamName FParamInfo fromrep
FParamInfo torep
dec
castNameInfo (LParamName LParamInfo fromrep
dec) = LParamInfo torep -> NameInfo torep
forall rep. LParamInfo rep -> NameInfo rep
LParamName LParamInfo fromrep
LParamInfo torep
dec
castNameInfo (IndexName IntType
it) = IntType -> NameInfo torep
forall rep. IntType -> NameInfo rep
IndexName IntType
it
newtype ExtendedScope rep m a = ExtendedScope (ReaderT (Scope rep) m a)
deriving
( (forall a b.
(a -> b) -> ExtendedScope rep m a -> ExtendedScope rep m b)
-> (forall a b.
a -> ExtendedScope rep m b -> ExtendedScope rep m a)
-> Functor (ExtendedScope rep m)
forall a b. a -> ExtendedScope rep m b -> ExtendedScope rep m a
forall a b.
(a -> b) -> ExtendedScope rep m a -> ExtendedScope rep m b
forall rep (m :: * -> *) a b.
Functor m =>
a -> ExtendedScope rep m b -> ExtendedScope rep m a
forall rep (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExtendedScope rep m a -> ExtendedScope rep m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall rep (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExtendedScope rep m a -> ExtendedScope rep m b
fmap :: forall a b.
(a -> b) -> ExtendedScope rep m a -> ExtendedScope rep m b
$c<$ :: forall rep (m :: * -> *) a b.
Functor m =>
a -> ExtendedScope rep m b -> ExtendedScope rep m a
<$ :: forall a b. a -> ExtendedScope rep m b -> ExtendedScope rep m a
Functor,
Functor (ExtendedScope rep m)
Functor (ExtendedScope rep m)
-> (forall a. a -> ExtendedScope rep m a)
-> (forall a b.
ExtendedScope rep m (a -> b)
-> ExtendedScope rep m a -> ExtendedScope rep m b)
-> (forall a b c.
(a -> b -> c)
-> ExtendedScope rep m a
-> ExtendedScope rep m b
-> ExtendedScope rep m c)
-> (forall a b.
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b)
-> (forall a b.
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m a)
-> Applicative (ExtendedScope rep m)
forall a. a -> ExtendedScope rep m a
forall a b.
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m a
forall a b.
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b
forall a b.
ExtendedScope rep m (a -> b)
-> ExtendedScope rep m a -> ExtendedScope rep m b
forall a b c.
(a -> b -> c)
-> ExtendedScope rep m a
-> ExtendedScope rep m b
-> ExtendedScope rep m c
forall {rep} {m :: * -> *}.
Applicative m =>
Functor (ExtendedScope rep m)
forall rep (m :: * -> *) a.
Applicative m =>
a -> ExtendedScope rep m a
forall rep (m :: * -> *) a b.
Applicative m =>
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m a
forall rep (m :: * -> *) a b.
Applicative m =>
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b
forall rep (m :: * -> *) a b.
Applicative m =>
ExtendedScope rep m (a -> b)
-> ExtendedScope rep m a -> ExtendedScope rep m b
forall rep (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ExtendedScope rep m a
-> ExtendedScope rep m b
-> ExtendedScope rep m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall rep (m :: * -> *) a.
Applicative m =>
a -> ExtendedScope rep m a
pure :: forall a. a -> ExtendedScope rep m a
$c<*> :: forall rep (m :: * -> *) a b.
Applicative m =>
ExtendedScope rep m (a -> b)
-> ExtendedScope rep m a -> ExtendedScope rep m b
<*> :: forall a b.
ExtendedScope rep m (a -> b)
-> ExtendedScope rep m a -> ExtendedScope rep m b
$cliftA2 :: forall rep (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ExtendedScope rep m a
-> ExtendedScope rep m b
-> ExtendedScope rep m c
liftA2 :: forall a b c.
(a -> b -> c)
-> ExtendedScope rep m a
-> ExtendedScope rep m b
-> ExtendedScope rep m c
$c*> :: forall rep (m :: * -> *) a b.
Applicative m =>
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b
*> :: forall a b.
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b
$c<* :: forall rep (m :: * -> *) a b.
Applicative m =>
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m a
<* :: forall a b.
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m a
Applicative,
Applicative (ExtendedScope rep m)
Applicative (ExtendedScope rep m)
-> (forall a b.
ExtendedScope rep m a
-> (a -> ExtendedScope rep m b) -> ExtendedScope rep m b)
-> (forall a b.
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b)
-> (forall a. a -> ExtendedScope rep m a)
-> Monad (ExtendedScope rep m)
forall a. a -> ExtendedScope rep m a
forall a b.
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b
forall a b.
ExtendedScope rep m a
-> (a -> ExtendedScope rep m b) -> ExtendedScope rep m b
forall {rep} {m :: * -> *}.
Monad m =>
Applicative (ExtendedScope rep m)
forall rep (m :: * -> *) a. Monad m => a -> ExtendedScope rep m a
forall rep (m :: * -> *) a b.
Monad m =>
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b
forall rep (m :: * -> *) a b.
Monad m =>
ExtendedScope rep m a
-> (a -> ExtendedScope rep m b) -> ExtendedScope rep m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall rep (m :: * -> *) a b.
Monad m =>
ExtendedScope rep m a
-> (a -> ExtendedScope rep m b) -> ExtendedScope rep m b
>>= :: forall a b.
ExtendedScope rep m a
-> (a -> ExtendedScope rep m b) -> ExtendedScope rep m b
$c>> :: forall rep (m :: * -> *) a b.
Monad m =>
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b
>> :: forall a b.
ExtendedScope rep m a
-> ExtendedScope rep m b -> ExtendedScope rep m b
$creturn :: forall rep (m :: * -> *) a. Monad m => a -> ExtendedScope rep m a
return :: forall a. a -> ExtendedScope rep m a
Monad,
MonadReader (Scope rep)
)
instance
(HasScope rep m, Monad m) =>
HasScope rep (ExtendedScope rep m)
where
lookupType :: VName -> ExtendedScope rep m Type
lookupType VName
name = do
Maybe Type
res <- (Scope rep -> Maybe Type) -> ExtendedScope rep m (Maybe Type)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Scope rep -> Maybe Type) -> ExtendedScope rep m (Maybe Type))
-> (Scope rep -> Maybe Type) -> ExtendedScope rep m (Maybe Type)
forall a b. (a -> b) -> a -> b
$ (NameInfo rep -> Type) -> Maybe (NameInfo rep) -> Maybe Type
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameInfo rep -> Type
forall t. Typed t => t -> Type
typeOf (Maybe (NameInfo rep) -> Maybe Type)
-> (Scope rep -> Maybe (NameInfo rep)) -> Scope rep -> Maybe Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Scope rep -> Maybe (NameInfo rep)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
name
ExtendedScope rep m Type
-> (Type -> ExtendedScope rep m Type)
-> Maybe Type
-> ExtendedScope rep m Type
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ReaderT (Scope rep) m Type -> ExtendedScope rep m Type
forall rep (m :: * -> *) a.
ReaderT (Scope rep) m a -> ExtendedScope rep m a
ExtendedScope (ReaderT (Scope rep) m Type -> ExtendedScope rep m Type)
-> ReaderT (Scope rep) m Type -> ExtendedScope rep m Type
forall a b. (a -> b) -> a -> b
$ m Type -> ReaderT (Scope rep) m Type
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Scope rep) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Type -> ReaderT (Scope rep) m Type)
-> m Type -> ReaderT (Scope rep) m Type
forall a b. (a -> b) -> a -> b
$ VName -> m Type
forall rep (m :: * -> *). HasScope rep m => VName -> m Type
lookupType VName
name) Type -> ExtendedScope rep m Type
forall a. a -> ExtendedScope rep m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Type
res
askScope :: ExtendedScope rep m (Scope rep)
askScope = (Scope rep -> Scope rep -> Scope rep)
-> ExtendedScope rep m (Scope rep -> Scope rep)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Scope rep -> Scope rep -> Scope rep
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ExtendedScope rep m (Scope rep -> Scope rep)
-> ExtendedScope rep m (Scope rep)
-> ExtendedScope rep m (Scope rep)
forall a b.
ExtendedScope rep m (a -> b)
-> ExtendedScope rep m a -> ExtendedScope rep m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (Scope rep) m (Scope rep)
-> ExtendedScope rep m (Scope rep)
forall rep (m :: * -> *) a.
ReaderT (Scope rep) m a -> ExtendedScope rep m a
ExtendedScope (m (Scope rep) -> ReaderT (Scope rep) m (Scope rep)
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Scope rep) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Scope rep)
forall rep (m :: * -> *). HasScope rep m => m (Scope rep)
askScope)
extendedScope ::
ExtendedScope rep m a ->
Scope rep ->
m a
extendedScope :: forall rep (m :: * -> *) a.
ExtendedScope rep m a -> Scope rep -> m a
extendedScope (ExtendedScope ReaderT (Scope rep) m a
m) = ReaderT (Scope rep) m a -> Scope rep -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Scope rep) m a
m