{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | The core Futhark AST does not contain type information when we
-- use a variable.  Therefore, most transformations expect to be able
-- to access some kind of symbol table that maps names to their types.
--
-- This module defines the concept of a type environment as a mapping
-- from variable names to 'NameInfo's.  Convenience facilities are
-- also provided to communicate that some monad or applicative functor
-- maintains type information.
module Futhark.IR.Prop.Scope
  ( HasScope (..),
    NameInfo (..),
    LocalScope (..),
    Scope,
    Scoped (..),
    inScopeOf,
    scopeOfLParams,
    scopeOfFParams,
    scopeOfPattern,
    scopeOfPatElem,
    SameScope,
    castScope,

    -- * Extended type environment
    ExtendedScope,
    extendedScope,
  )
where

import Control.Monad.Except
import qualified Control.Monad.RWS.Lazy
import qualified Control.Monad.RWS.Strict
import Control.Monad.Reader
import qualified Data.Map.Strict as M
import Futhark.IR.Decorations
import Futhark.IR.Pretty ()
import Futhark.IR.Prop.Patterns
import Futhark.IR.Prop.Types
import Futhark.IR.Syntax

-- | How some name in scope was bound.
data NameInfo lore
  = LetName (LetDec lore)
  | FParamName (FParamInfo lore)
  | LParamName (LParamInfo lore)
  | IndexName IntType

deriving instance Decorations lore => Show (NameInfo lore)

instance Decorations lore => Typed (NameInfo lore) where
  typeOf :: NameInfo lore -> Type
typeOf (LetName LetDec lore
dec) = LetDec lore -> Type
forall t. Typed t => t -> Type
typeOf LetDec lore
dec
  typeOf (FParamName FParamInfo lore
dec) = FParamInfo lore -> Type
forall t. Typed t => t -> Type
typeOf FParamInfo lore
dec
  typeOf (LParamName LParamInfo lore
dec) = LParamInfo lore -> Type
forall t. Typed t => t -> Type
typeOf LParamInfo lore
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

-- | A scope is a mapping from variable names to information about
-- that name.
type Scope lore = M.Map VName (NameInfo lore)

-- | The class of applicative functors (or more common in practice:
-- monads) that permit the lookup of variable types.  A default method
-- for 'lookupType' exists, which is sufficient (if not always
-- maximally efficient, and using 'error' to fail) when 'askScope'
-- is defined.
class (Applicative m, Decorations lore) => HasScope lore m | m -> lore where
  -- | Return the type of the given variable, or fail if it is not in
  -- the type environment.
  lookupType :: VName -> m Type
  lookupType = (NameInfo lore -> Type) -> m (NameInfo lore) -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameInfo lore -> Type
forall t. Typed t => t -> Type
typeOf (m (NameInfo lore) -> m Type)
-> (VName -> m (NameInfo lore)) -> VName -> m Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> m (NameInfo lore)
forall lore (m :: * -> *).
HasScope lore m =>
VName -> m (NameInfo lore)
lookupInfo

  -- | Return the info of the given variable, or fail if it is not in
  -- the type environment.
  lookupInfo :: VName -> m (NameInfo lore)
  lookupInfo VName
name =
    (Scope lore -> NameInfo lore) -> m (NameInfo lore)
forall lore (m :: * -> *) a.
HasScope lore m =>
(Scope lore -> a) -> m a
asksScope (NameInfo lore -> VName -> Scope lore -> NameInfo lore
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault NameInfo lore
notFound VName
name)
    where
      notFound :: NameInfo lore
notFound =
        String -> NameInfo lore
forall a. HasCallStack => String -> a
error (String -> NameInfo lore) -> String -> NameInfo lore
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
pretty VName
name
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found in type environment."

  -- | Return the type environment contained in the applicative
  -- functor.
  askScope :: m (Scope lore)

  -- | Return the result of applying some function to the type
  -- environment.
  asksScope :: (Scope lore -> a) -> m a
  asksScope Scope lore -> a
f = Scope lore -> a
f (Scope lore -> a) -> m (Scope lore) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Scope lore)
forall lore (m :: * -> *). HasScope lore m => m (Scope lore)
askScope

instance
  (Applicative m, Monad m, Decorations lore) =>
  HasScope lore (ReaderT (Scope lore) m)
  where
  askScope :: ReaderT (Scope lore) m (Scope lore)
askScope = ReaderT (Scope lore) m (Scope lore)
forall r (m :: * -> *). MonadReader r m => m r
ask

instance (Monad m, HasScope lore m) => HasScope lore (ExceptT e m) where
  askScope :: ExceptT e m (Scope lore)
askScope = m (Scope lore) -> ExceptT e m (Scope lore)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Scope lore)
forall lore (m :: * -> *). HasScope lore m => m (Scope lore)
askScope

instance
  (Applicative m, Monad m, Monoid w, Decorations lore) =>
  HasScope lore (Control.Monad.RWS.Strict.RWST (Scope lore) w s m)
  where
  askScope :: RWST (Scope lore) w s m (Scope lore)
askScope = RWST (Scope lore) w s m (Scope lore)
forall r (m :: * -> *). MonadReader r m => m r
ask

instance
  (Applicative m, Monad m, Monoid w, Decorations lore) =>
  HasScope lore (Control.Monad.RWS.Lazy.RWST (Scope lore) w s m)
  where
  askScope :: RWST (Scope lore) w s m (Scope lore)
askScope = RWST (Scope lore) w s m (Scope lore)
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | The class of monads that not only provide a 'Scope', but also
-- the ability to locally extend it.  A 'Reader' containing a
-- 'Scope' is the prototypical example of such a monad.
class (HasScope lore m, Monad m) => LocalScope lore m where
  -- | Run a computation with an extended type environment.  Note that
  -- this is intended to *add* to the current type environment, it
  -- does not replace it.
  localScope :: Scope lore -> m a -> m a

instance (Monad m, LocalScope lore m) => LocalScope lore (ExceptT e m) where
  localScope :: forall a. Scope lore -> 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 lore -> m (Either e a) -> m (Either e a))
-> Scope lore
-> ExceptT e m a
-> ExceptT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope lore -> m (Either e a) -> m (Either e a)
forall lore (m :: * -> *) a.
LocalScope lore m =>
Scope lore -> m a -> m a
localScope

instance
  (Applicative m, Monad m, Decorations lore) =>
  LocalScope lore (ReaderT (Scope lore) m)
  where
  localScope :: forall a.
Scope lore -> ReaderT (Scope lore) m a -> ReaderT (Scope lore) m a
localScope = (Scope lore -> Scope lore)
-> ReaderT (Scope lore) m a -> ReaderT (Scope lore) m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((Scope lore -> Scope lore)
 -> ReaderT (Scope lore) m a -> ReaderT (Scope lore) m a)
-> (Scope lore -> Scope lore -> Scope lore)
-> Scope lore
-> ReaderT (Scope lore) m a
-> ReaderT (Scope lore) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope lore -> Scope lore -> Scope lore
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union

instance
  (Applicative m, Monad m, Monoid w, Decorations lore) =>
  LocalScope lore (Control.Monad.RWS.Strict.RWST (Scope lore) w s m)
  where
  localScope :: forall a.
Scope lore
-> RWST (Scope lore) w s m a -> RWST (Scope lore) w s m a
localScope = (Scope lore -> Scope lore)
-> RWST (Scope lore) w s m a -> RWST (Scope lore) w s m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((Scope lore -> Scope lore)
 -> RWST (Scope lore) w s m a -> RWST (Scope lore) w s m a)
-> (Scope lore -> Scope lore -> Scope lore)
-> Scope lore
-> RWST (Scope lore) w s m a
-> RWST (Scope lore) w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope lore -> Scope lore -> Scope lore
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union

instance
  (Applicative m, Monad m, Monoid w, Decorations lore) =>
  LocalScope lore (Control.Monad.RWS.Lazy.RWST (Scope lore) w s m)
  where
  localScope :: forall a.
Scope lore
-> RWST (Scope lore) w s m a -> RWST (Scope lore) w s m a
localScope = (Scope lore -> Scope lore)
-> RWST (Scope lore) w s m a -> RWST (Scope lore) w s m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((Scope lore -> Scope lore)
 -> RWST (Scope lore) w s m a -> RWST (Scope lore) w s m a)
-> (Scope lore -> Scope lore -> Scope lore)
-> Scope lore
-> RWST (Scope lore) w s m a
-> RWST (Scope lore) w s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope lore -> Scope lore -> Scope lore
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union

-- | The class of things that can provide a scope.  There is no
-- overarching rule for what this means.  For a 'Stm', it is the
-- corresponding pattern.  For a t'Lambda', is is the parameters.
class Scoped lore a | a -> lore where
  scopeOf :: a -> Scope lore

-- | Extend the monadic scope with the 'scopeOf' the given value.
inScopeOf :: (Scoped lore a, LocalScope lore m) => a -> m b -> m b
inScopeOf :: forall lore a (m :: * -> *) b.
(Scoped lore a, LocalScope lore m) =>
a -> m b -> m b
inScopeOf = Scope lore -> m b -> m b
forall lore (m :: * -> *) a.
LocalScope lore m =>
Scope lore -> m a -> m a
localScope (Scope lore -> m b -> m b) -> (a -> Scope lore) -> a -> m b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Scope lore
forall lore a. Scoped lore a => a -> Scope lore
scopeOf

instance Scoped lore a => Scoped lore [a] where
  scopeOf :: [a] -> Scope lore
scopeOf = [Scope lore] -> Scope lore
forall a. Monoid a => [a] -> a
mconcat ([Scope lore] -> Scope lore)
-> ([a] -> [Scope lore]) -> [a] -> Scope lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Scope lore) -> [a] -> [Scope lore]
forall a b. (a -> b) -> [a] -> [b]
map a -> Scope lore
forall lore a. Scoped lore a => a -> Scope lore
scopeOf

instance Scoped lore (Stms lore) where
  scopeOf :: Stms lore -> Scope lore
scopeOf = (Stm lore -> Scope lore) -> Stms lore -> Scope lore
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Stm lore -> Scope lore
forall lore a. Scoped lore a => a -> Scope lore
scopeOf

instance Scoped lore (Stm lore) where
  scopeOf :: Stm lore -> Scope lore
scopeOf = PatternT (LetDec lore) -> Scope lore
forall lore dec. (LetDec lore ~ dec) => PatternT dec -> Scope lore
scopeOfPattern (PatternT (LetDec lore) -> Scope lore)
-> (Stm lore -> PatternT (LetDec lore)) -> Stm lore -> Scope lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stm lore -> PatternT (LetDec lore)
forall lore. Stm lore -> Pattern lore
stmPattern

instance Scoped lore (FunDef lore) where
  scopeOf :: FunDef lore -> Scope lore
scopeOf = [Param (FParamInfo lore)] -> Scope lore
forall lore dec.
(FParamInfo lore ~ dec) =>
[Param dec] -> Scope lore
scopeOfFParams ([Param (FParamInfo lore)] -> Scope lore)
-> (FunDef lore -> [Param (FParamInfo lore)])
-> FunDef lore
-> Scope lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunDef lore -> [Param (FParamInfo lore)]
forall lore. FunDef lore -> [FParam lore]
funDefParams

instance Scoped lore (VName, NameInfo lore) where
  scopeOf :: (VName, NameInfo lore) -> Scope lore
scopeOf = (VName -> NameInfo lore -> Scope lore)
-> (VName, NameInfo lore) -> Scope lore
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry VName -> NameInfo lore -> Scope lore
forall k a. k -> a -> Map k a
M.singleton

instance Scoped lore (LoopForm lore) where
  scopeOf :: LoopForm lore -> Scope lore
scopeOf (WhileLoop VName
_) = Scope lore
forall a. Monoid a => a
mempty
  scopeOf (ForLoop VName
i IntType
it SubExp
_ [(LParam lore, VName)]
xs) =
    VName -> NameInfo lore -> Scope lore -> Scope lore
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VName
i (IntType -> NameInfo lore
forall lore. IntType -> NameInfo lore
IndexName IntType
it) (Scope lore -> Scope lore) -> Scope lore -> Scope lore
forall a b. (a -> b) -> a -> b
$ [LParam lore] -> Scope lore
forall lore dec.
(LParamInfo lore ~ dec) =>
[Param dec] -> Scope lore
scopeOfLParams (((LParam lore, VName) -> LParam lore)
-> [(LParam lore, VName)] -> [LParam lore]
forall a b. (a -> b) -> [a] -> [b]
map (LParam lore, VName) -> LParam lore
forall a b. (a, b) -> a
fst [(LParam lore, VName)]
xs)

-- | The scope of a pattern.
scopeOfPattern :: LetDec lore ~ dec => PatternT dec -> Scope lore
scopeOfPattern :: forall lore dec. (LetDec lore ~ dec) => PatternT dec -> Scope lore
scopeOfPattern =
  [Scope lore] -> Scope lore
forall a. Monoid a => [a] -> a
mconcat ([Scope lore] -> Scope lore)
-> (PatternT dec -> [Scope lore]) -> PatternT dec -> Scope lore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatElemT dec -> Scope lore) -> [PatElemT dec] -> [Scope lore]
forall a b. (a -> b) -> [a] -> [b]
map PatElemT dec -> Scope lore
forall lore dec. (LetDec lore ~ dec) => PatElemT dec -> Scope lore
scopeOfPatElem ([PatElemT dec] -> [Scope lore])
-> (PatternT dec -> [PatElemT dec]) -> PatternT dec -> [Scope lore]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatternT dec -> [PatElemT dec]
forall dec. PatternT dec -> [PatElemT dec]
patternElements

-- | The scope of a pattern element.
scopeOfPatElem :: LetDec lore ~ dec => PatElemT dec -> Scope lore
scopeOfPatElem :: forall lore dec. (LetDec lore ~ dec) => PatElemT dec -> Scope lore
scopeOfPatElem (PatElem VName
name dec
dec) = VName -> NameInfo lore -> Map VName (NameInfo lore)
forall k a. k -> a -> Map k a
M.singleton VName
name (NameInfo lore -> Map VName (NameInfo lore))
-> NameInfo lore -> Map VName (NameInfo lore)
forall a b. (a -> b) -> a -> b
$ LetDec lore -> NameInfo lore
forall lore. LetDec lore -> NameInfo lore
LetName dec
LetDec lore
dec

-- | The scope of some lambda parameters.
scopeOfLParams ::
  LParamInfo lore ~ dec =>
  [Param dec] ->
  Scope lore
scopeOfLParams :: forall lore dec.
(LParamInfo lore ~ dec) =>
[Param dec] -> Scope lore
scopeOfLParams = [(VName, NameInfo lore)] -> Map VName (NameInfo lore)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(VName, NameInfo lore)] -> Map VName (NameInfo lore))
-> ([Param dec] -> [(VName, NameInfo lore)])
-> [Param dec]
-> Map VName (NameInfo lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Param dec -> (VName, NameInfo lore))
-> [Param dec] -> [(VName, NameInfo lore)]
forall a b. (a -> b) -> [a] -> [b]
map Param dec -> (VName, NameInfo lore)
forall {lore}. Param (LParamInfo lore) -> (VName, NameInfo lore)
f
  where
    f :: Param (LParamInfo lore) -> (VName, NameInfo lore)
f Param (LParamInfo lore)
param = (Param (LParamInfo lore) -> VName
forall dec. Param dec -> VName
paramName Param (LParamInfo lore)
param, LParamInfo lore -> NameInfo lore
forall lore. LParamInfo lore -> NameInfo lore
LParamName (LParamInfo lore -> NameInfo lore)
-> LParamInfo lore -> NameInfo lore
forall a b. (a -> b) -> a -> b
$ Param (LParamInfo lore) -> LParamInfo lore
forall dec. Param dec -> dec
paramDec Param (LParamInfo lore)
param)

-- | The scope of some function or loop parameters.
scopeOfFParams ::
  FParamInfo lore ~ dec =>
  [Param dec] ->
  Scope lore
scopeOfFParams :: forall lore dec.
(FParamInfo lore ~ dec) =>
[Param dec] -> Scope lore
scopeOfFParams = [(VName, NameInfo lore)] -> Map VName (NameInfo lore)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(VName, NameInfo lore)] -> Map VName (NameInfo lore))
-> ([Param dec] -> [(VName, NameInfo lore)])
-> [Param dec]
-> Map VName (NameInfo lore)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Param dec -> (VName, NameInfo lore))
-> [Param dec] -> [(VName, NameInfo lore)]
forall a b. (a -> b) -> [a] -> [b]
map Param dec -> (VName, NameInfo lore)
forall {lore}. Param (FParamInfo lore) -> (VName, NameInfo lore)
f
  where
    f :: Param (FParamInfo lore) -> (VName, NameInfo lore)
f Param (FParamInfo lore)
param = (Param (FParamInfo lore) -> VName
forall dec. Param dec -> VName
paramName Param (FParamInfo lore)
param, FParamInfo lore -> NameInfo lore
forall lore. FParamInfo lore -> NameInfo lore
FParamName (FParamInfo lore -> NameInfo lore)
-> FParamInfo lore -> NameInfo lore
forall a b. (a -> b) -> a -> b
$ Param (FParamInfo lore) -> FParamInfo lore
forall dec. Param dec -> dec
paramDec Param (FParamInfo lore)
param)

instance Scoped lore (Lambda lore) where
  scopeOf :: Lambda lore -> Scope lore
scopeOf Lambda lore
lam = [Param (LParamInfo lore)] -> Scope lore
forall lore dec.
(LParamInfo lore ~ dec) =>
[Param dec] -> Scope lore
scopeOfLParams ([Param (LParamInfo lore)] -> Scope lore)
-> [Param (LParamInfo lore)] -> Scope lore
forall a b. (a -> b) -> a -> b
$ Lambda lore -> [Param (LParamInfo lore)]
forall lore. LambdaT lore -> [LParam lore]
lambdaParams Lambda lore
lam

-- | A constraint that indicates two lores have the same 'NameInfo'
-- representation.
type SameScope lore1 lore2 =
  ( LetDec lore1 ~ LetDec lore2,
    FParamInfo lore1 ~ FParamInfo lore2,
    LParamInfo lore1 ~ LParamInfo lore2
  )

-- | If two scopes are really the same, then you can convert one to
-- the other.
castScope ::
  SameScope fromlore tolore =>
  Scope fromlore ->
  Scope tolore
castScope :: forall fromlore tolore.
SameScope fromlore tolore =>
Scope fromlore -> Scope tolore
castScope = (NameInfo fromlore -> NameInfo tolore)
-> Map VName (NameInfo fromlore) -> Map VName (NameInfo tolore)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NameInfo fromlore -> NameInfo tolore
forall fromlore tolore.
SameScope fromlore tolore =>
NameInfo fromlore -> NameInfo tolore
castNameInfo

castNameInfo ::
  SameScope fromlore tolore =>
  NameInfo fromlore ->
  NameInfo tolore
castNameInfo :: forall fromlore tolore.
SameScope fromlore tolore =>
NameInfo fromlore -> NameInfo tolore
castNameInfo (LetName LetDec fromlore
dec) = LetDec tolore -> NameInfo tolore
forall lore. LetDec lore -> NameInfo lore
LetName LetDec fromlore
LetDec tolore
dec
castNameInfo (FParamName FParamInfo fromlore
dec) = FParamInfo tolore -> NameInfo tolore
forall lore. FParamInfo lore -> NameInfo lore
FParamName FParamInfo fromlore
FParamInfo tolore
dec
castNameInfo (LParamName LParamInfo fromlore
dec) = LParamInfo tolore -> NameInfo tolore
forall lore. LParamInfo lore -> NameInfo lore
LParamName LParamInfo fromlore
LParamInfo tolore
dec
castNameInfo (IndexName IntType
it) = IntType -> NameInfo tolore
forall lore. IntType -> NameInfo lore
IndexName IntType
it

-- | A monad transformer that carries around an extended 'Scope'.
-- Its 'lookupType' method will first look in the extended 'Scope',
-- and then use the 'lookupType' method of the underlying monad.
newtype ExtendedScope lore m a = ExtendedScope (ReaderT (Scope lore) m a)
  deriving
    ( (forall a b.
 (a -> b) -> ExtendedScope lore m a -> ExtendedScope lore m b)
-> (forall a b.
    a -> ExtendedScope lore m b -> ExtendedScope lore m a)
-> Functor (ExtendedScope lore m)
forall a b. a -> ExtendedScope lore m b -> ExtendedScope lore m a
forall a b.
(a -> b) -> ExtendedScope lore m a -> ExtendedScope lore m b
forall lore (m :: * -> *) a b.
Functor m =>
a -> ExtendedScope lore m b -> ExtendedScope lore m a
forall lore (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExtendedScope lore m a -> ExtendedScope lore m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ExtendedScope lore m b -> ExtendedScope lore m a
$c<$ :: forall lore (m :: * -> *) a b.
Functor m =>
a -> ExtendedScope lore m b -> ExtendedScope lore m a
fmap :: forall a b.
(a -> b) -> ExtendedScope lore m a -> ExtendedScope lore m b
$cfmap :: forall lore (m :: * -> *) a b.
Functor m =>
(a -> b) -> ExtendedScope lore m a -> ExtendedScope lore m b
Functor,
      Functor (ExtendedScope lore m)
Functor (ExtendedScope lore m)
-> (forall a. a -> ExtendedScope lore m a)
-> (forall a b.
    ExtendedScope lore m (a -> b)
    -> ExtendedScope lore m a -> ExtendedScope lore m b)
-> (forall a b c.
    (a -> b -> c)
    -> ExtendedScope lore m a
    -> ExtendedScope lore m b
    -> ExtendedScope lore m c)
-> (forall a b.
    ExtendedScope lore m a
    -> ExtendedScope lore m b -> ExtendedScope lore m b)
-> (forall a b.
    ExtendedScope lore m a
    -> ExtendedScope lore m b -> ExtendedScope lore m a)
-> Applicative (ExtendedScope lore m)
forall a. a -> ExtendedScope lore m a
forall a b.
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m a
forall a b.
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m b
forall a b.
ExtendedScope lore m (a -> b)
-> ExtendedScope lore m a -> ExtendedScope lore m b
forall a b c.
(a -> b -> c)
-> ExtendedScope lore m a
-> ExtendedScope lore m b
-> ExtendedScope lore m c
forall {lore} {m :: * -> *}.
Applicative m =>
Functor (ExtendedScope lore m)
forall lore (m :: * -> *) a.
Applicative m =>
a -> ExtendedScope lore m a
forall lore (m :: * -> *) a b.
Applicative m =>
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m a
forall lore (m :: * -> *) a b.
Applicative m =>
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m b
forall lore (m :: * -> *) a b.
Applicative m =>
ExtendedScope lore m (a -> b)
-> ExtendedScope lore m a -> ExtendedScope lore m b
forall lore (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ExtendedScope lore m a
-> ExtendedScope lore m b
-> ExtendedScope lore 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
<* :: forall a b.
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m a
$c<* :: forall lore (m :: * -> *) a b.
Applicative m =>
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m a
*> :: forall a b.
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m b
$c*> :: forall lore (m :: * -> *) a b.
Applicative m =>
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m b
liftA2 :: forall a b c.
(a -> b -> c)
-> ExtendedScope lore m a
-> ExtendedScope lore m b
-> ExtendedScope lore m c
$cliftA2 :: forall lore (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> ExtendedScope lore m a
-> ExtendedScope lore m b
-> ExtendedScope lore m c
<*> :: forall a b.
ExtendedScope lore m (a -> b)
-> ExtendedScope lore m a -> ExtendedScope lore m b
$c<*> :: forall lore (m :: * -> *) a b.
Applicative m =>
ExtendedScope lore m (a -> b)
-> ExtendedScope lore m a -> ExtendedScope lore m b
pure :: forall a. a -> ExtendedScope lore m a
$cpure :: forall lore (m :: * -> *) a.
Applicative m =>
a -> ExtendedScope lore m a
Applicative,
      Applicative (ExtendedScope lore m)
Applicative (ExtendedScope lore m)
-> (forall a b.
    ExtendedScope lore m a
    -> (a -> ExtendedScope lore m b) -> ExtendedScope lore m b)
-> (forall a b.
    ExtendedScope lore m a
    -> ExtendedScope lore m b -> ExtendedScope lore m b)
-> (forall a. a -> ExtendedScope lore m a)
-> Monad (ExtendedScope lore m)
forall a. a -> ExtendedScope lore m a
forall a b.
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m b
forall a b.
ExtendedScope lore m a
-> (a -> ExtendedScope lore m b) -> ExtendedScope lore m b
forall {lore} {m :: * -> *}.
Monad m =>
Applicative (ExtendedScope lore m)
forall lore (m :: * -> *) a. Monad m => a -> ExtendedScope lore m a
forall lore (m :: * -> *) a b.
Monad m =>
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m b
forall lore (m :: * -> *) a b.
Monad m =>
ExtendedScope lore m a
-> (a -> ExtendedScope lore m b) -> ExtendedScope lore 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
return :: forall a. a -> ExtendedScope lore m a
$creturn :: forall lore (m :: * -> *) a. Monad m => a -> ExtendedScope lore m a
>> :: forall a b.
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m b
$c>> :: forall lore (m :: * -> *) a b.
Monad m =>
ExtendedScope lore m a
-> ExtendedScope lore m b -> ExtendedScope lore m b
>>= :: forall a b.
ExtendedScope lore m a
-> (a -> ExtendedScope lore m b) -> ExtendedScope lore m b
$c>>= :: forall lore (m :: * -> *) a b.
Monad m =>
ExtendedScope lore m a
-> (a -> ExtendedScope lore m b) -> ExtendedScope lore m b
Monad,
      MonadReader (Scope lore)
    )

instance
  (HasScope lore m, Monad m) =>
  HasScope lore (ExtendedScope lore m)
  where
  lookupType :: VName -> ExtendedScope lore m Type
lookupType VName
name = do
    Maybe Type
res <- (Scope lore -> Maybe Type) -> ExtendedScope lore m (Maybe Type)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Scope lore -> Maybe Type) -> ExtendedScope lore m (Maybe Type))
-> (Scope lore -> Maybe Type) -> ExtendedScope lore m (Maybe Type)
forall a b. (a -> b) -> a -> b
$ (NameInfo lore -> Type) -> Maybe (NameInfo lore) -> Maybe Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameInfo lore -> Type
forall t. Typed t => t -> Type
typeOf (Maybe (NameInfo lore) -> Maybe Type)
-> (Scope lore -> Maybe (NameInfo lore))
-> Scope lore
-> Maybe Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VName -> Scope lore -> Maybe (NameInfo lore)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup VName
name
    ExtendedScope lore m Type
-> (Type -> ExtendedScope lore m Type)
-> Maybe Type
-> ExtendedScope lore m Type
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ReaderT (Scope lore) m Type -> ExtendedScope lore m Type
forall lore (m :: * -> *) a.
ReaderT (Scope lore) m a -> ExtendedScope lore m a
ExtendedScope (ReaderT (Scope lore) m Type -> ExtendedScope lore m Type)
-> ReaderT (Scope lore) m Type -> ExtendedScope lore m Type
forall a b. (a -> b) -> a -> b
$ m Type -> ReaderT (Scope lore) m Type
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m Type -> ReaderT (Scope lore) m Type)
-> m Type -> ReaderT (Scope lore) m Type
forall a b. (a -> b) -> a -> b
$ VName -> m Type
forall lore (m :: * -> *). HasScope lore m => VName -> m Type
lookupType VName
name) Type -> ExtendedScope lore m Type
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Type
res
  askScope :: ExtendedScope lore m (Scope lore)
askScope = (Scope lore -> Scope lore -> Scope lore)
-> ExtendedScope lore m (Scope lore -> Scope lore)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Scope lore -> Scope lore -> Scope lore
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ExtendedScope lore m (Scope lore -> Scope lore)
-> ExtendedScope lore m (Scope lore)
-> ExtendedScope lore m (Scope lore)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT (Scope lore) m (Scope lore)
-> ExtendedScope lore m (Scope lore)
forall lore (m :: * -> *) a.
ReaderT (Scope lore) m a -> ExtendedScope lore m a
ExtendedScope (m (Scope lore) -> ReaderT (Scope lore) m (Scope lore)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Scope lore)
forall lore (m :: * -> *). HasScope lore m => m (Scope lore)
askScope)

-- | Run a computation in the extended type environment.
extendedScope ::
  ExtendedScope lore m a ->
  Scope lore ->
  m a
extendedScope :: forall lore (m :: * -> *) a.
ExtendedScope lore m a -> Scope lore -> m a
extendedScope (ExtendedScope ReaderT (Scope lore) m a
m) = ReaderT (Scope lore) m a -> Scope lore -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Scope lore) m a
m