hexpr-0.0.0.0: A framework for symbolic, homoiconic languages.

Safe HaskellNone

Control.Monad.Environment

Description

We provide an implementation of environments, as well as a monad for performing computations in mutable environments. See Env for the definition of environments that we are using here. See EnvironmentT for details on what is available withing a mutable environment computation.

Synopsis

Documentation

data EnvironmentT k v m a Source

Perform computations involving the manipulation of MEnv m k v terms.

Within the monad, we track not only the active (current) environment, but we also provide a default environment. The default environment is intended as a "top-level" environment that is available when using freshEnv. For environments that do not reference the default environment, use emptyEnv.

Instances

MonadTrans (EnvironmentT k v) 
C m => Monad (EnvironmentT k v m) 
C m => Functor (EnvironmentT k v m) 
C m => Applicative (EnvironmentT k v m) 
(MonadIO m, C m) => MonadIO (EnvironmentT k v m) 

data Env k v Source

Environments, also called contexts, are a set of bindings along with an optional parent environment.

When an environment is searched for a key, it first looks in its own bindings map, then looks in its parent's. When a binding is added to an environment, the environments own bindings are updated; its ancestors remain unchanged.

Instances

Monoid (Env k v) 

data MEnv m k v Source

Where Env represents immutable (mathematical) environments, MEnv represent mutable environments. Mutable environments can be useful for accumulating recursive bindings, or for interpreting languages with mutable binding environments.

The implementation of mutable cells (allocation, reading, writing) is abstracted by m. See Data.Ref for more information.

type Bindings k v = [(k, v)]Source

Synonym for some key-value mapping.

type EnvironmentIO k v = EnvironmentT k v IOSource

Run the Environment monad with IORefs.

type EnvironmentST s k v = EnvironmentT k v (ST s)Source

Run the Environment monad with STRefs.

evalEnvironmentT :: C m => Bindings k v -> EnvironmentT k v m a -> m aSource

Provided a bindings for a default environment, run an environment computation.

extractLocal :: MEnv m k v -> MEnv m k vSource

Retrieve an MEnv in every way equal to the one passed, except that the result has no parent.

The cell in the new environment continues to reference the old, so changes in the state of one are mirrored in the other.

extractParent :: MEnv m k v -> Maybe (MEnv m k v)Source

Retrieve the parent of the passed MEnv.

copyEnv :: C m => MEnv m k v -> EnvironmentT k v m (MEnv m k v)Source

Make a deep copy of the passed environment.

That is, both the MEnv's own bindings cell is copied, the parent (if any) is copied, and a new environment is constructed of the two, which shares no state with the original with respect to find and bind. Bound values are not copied, however, so state may still be shared insofar as the bound values have state.

copyLocalEnv :: C m => MEnv m k v -> EnvironmentT k v m (MEnv m k v)Source

Make a shallow copy of the passed environment

That is, only the MEnv's own bindings cell is copied; the parent (if any) is not copied. A new environment is constructed of the two, which shares only enough state with the original so that writes to the new do not affect the original, and only writes to the parents of the original are available (modulo shadowing) in the new. Bound values are not copied, however, so state may also be shared insofar as the bound values have state.

find :: (C m, Eq k) => k -> EnvironmentT k v m (Maybe v)Source

Lookup the value associated with the passed key in the current environment. See Env, getFindEnv.

bind :: C m => k -> v -> EnvironmentT k v m ()Source

Bind the key to the value in the current environment. See Env, getFindEnv.

findIn :: (C m, Eq k) => MEnv m k v -> k -> EnvironmentT k v m (Maybe v)Source

Lookup the value associated with the passed key in the passed MEnv. See Env for more detail on the search semantics.

We have findIn e k v === withEnv e (find k v), but the implementation of findIn does less bookkeeping internally.

bindIn :: C m => MEnv m k v -> k -> v -> EnvironmentT k v m ()Source

Bind a key to a value in the passed MEnv. See Env for more detail on the search semantics.

We have bindIn e k v === withEnv e (bind k v), but the implementation of findIn does less bookkeeping internally.

getEnv :: C m => EnvironmentT k v m (MEnv m k v)Source

Synonym for getFindEnv.

getFindEnv :: C m => EnvironmentT k v m (MEnv m k v)Source

Obtain a handle to the environment in which searches begin.

getBindEnv :: C m => EnvironmentT k v m (MEnv m k v)Source

Obtain a handle to the environment in which searches begin.

withEnv :: C m => MEnv m k v -> EnvironmentT k v m a -> EnvironmentT k v m aSource

Perform an action in the given environment.

emptyEnv :: C m => EnvironmentT k v m a -> EnvironmentT k v m aSource

Perform an action in a new, empty, parentless environment.

freshEnv :: C m => EnvironmentT k v m a -> EnvironmentT k v m aSource

Perform an action in a new, default, parentless environment.

localEnv :: C m => EnvironmentT k v m a -> EnvironmentT k v m aSource

Perform an action in a new, initially empty environment, child to the current.

letInEnv :: C m => EnvironmentT k v m a -> EnvironmentT k v m b -> EnvironmentT k v m bSource

Perform the first action in a localEnv, then perform the second with the binding environment the same as the original finding environment.