Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
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.
A simple example of a monad that maintains such as environment is
Reader
. Indeed, HasScope
and LocalScope
instances for this
monad are already defined.
Synopsis
- class (Applicative m, RepTypes rep) => HasScope rep m | m -> rep where
- lookupType :: VName -> m Type
- lookupInfo :: VName -> m (NameInfo rep)
- askScope :: m (Scope rep)
- asksScope :: (Scope rep -> a) -> m a
- data NameInfo rep
- = LetName (LetDec rep)
- | FParamName (FParamInfo rep)
- | LParamName (LParamInfo rep)
- | IndexName IntType
- class (HasScope rep m, Monad m) => LocalScope rep m where
- localScope :: Scope rep -> m a -> m a
- type Scope rep = Map VName (NameInfo rep)
- class Scoped rep a | a -> rep where
- inScopeOf :: (Scoped rep a, LocalScope rep m) => a -> m b -> m b
- scopeOfLParams :: LParamInfo rep ~ dec => [Param dec] -> Scope rep
- scopeOfFParams :: FParamInfo rep ~ dec => [Param dec] -> Scope rep
- scopeOfLoopForm :: LoopForm -> Scope rep
- scopeOfPat :: LetDec rep ~ dec => Pat dec -> Scope rep
- scopeOfPatElem :: LetDec rep ~ dec => PatElem dec -> Scope rep
- type SameScope rep1 rep2 = (LetDec rep1 ~ LetDec rep2, FParamInfo rep1 ~ FParamInfo rep2, LParamInfo rep1 ~ LParamInfo rep2)
- castScope :: SameScope fromrep torep => Scope fromrep -> Scope torep
- data ExtendedScope rep m a
- extendedScope :: ExtendedScope rep m a -> Scope rep -> m a
Documentation
class (Applicative m, RepTypes rep) => HasScope rep m | m -> rep where Source #
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.
lookupType :: VName -> m Type Source #
Return the type of the given variable, or fail if it is not in the type environment.
lookupInfo :: VName -> m (NameInfo rep) Source #
Return the info of the given variable, or fail if it is not in the type environment.
askScope :: m (Scope rep) Source #
Return the type environment contained in the applicative functor.
asksScope :: (Scope rep -> a) -> m a Source #
Return the result of applying some function to the type environment.
Instances
How some name in scope was bound.
LetName (LetDec rep) | |
FParamName (FParamInfo rep) | |
LParamName (LParamInfo rep) | |
IndexName IntType |
Instances
class (HasScope rep m, Monad m) => LocalScope rep m where Source #
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.
localScope :: Scope rep -> m a -> m a Source #
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.
Instances
type Scope rep = Map VName (NameInfo rep) Source #
A scope is a mapping from variable names to information about that name.
class Scoped rep a | a -> rep where Source #
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 Lambda
, is is the parameters.
inScopeOf :: (Scoped rep a, LocalScope rep m) => a -> m b -> m b Source #
Extend the monadic scope with the scopeOf
the given value.
scopeOfLParams :: LParamInfo rep ~ dec => [Param dec] -> Scope rep Source #
The scope of some lambda parameters.
scopeOfFParams :: FParamInfo rep ~ dec => [Param dec] -> Scope rep Source #
The scope of some function or loop parameters.
scopeOfLoopForm :: LoopForm -> Scope rep Source #
The scope of a loop form.
scopeOfPatElem :: LetDec rep ~ dec => PatElem dec -> Scope rep Source #
The scope of a pattern element.
type SameScope rep1 rep2 = (LetDec rep1 ~ LetDec rep2, FParamInfo rep1 ~ FParamInfo rep2, LParamInfo rep1 ~ LParamInfo rep2) Source #
A constraint that indicates two representations have the same NameInfo
representation.
castScope :: SameScope fromrep torep => Scope fromrep -> Scope torep Source #
If two scopes are really the same, then you can convert one to the other.
Extended type environment
data ExtendedScope rep m a Source #
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.
Instances
extendedScope :: ExtendedScope rep m a -> Scope rep -> m a Source #
Run a computation in the extended type environment.