kure-2.12.0: Combinators for Strategic Programming

Portabilityghc
Stabilitybeta
MaintainerNeil Sculthorpe <neil@ittc.ku.edu>
Safe HaskellSafe-Inferred

Language.KURE.Combinators.Translate

Contents

Description

This module provides a variety of combinators over Translate and Rewrite.

Synopsis

Translate Combinators

idR :: Monad m => Rewrite c m aSource

The identity Rewrite.

successT :: Monad m => Translate c m a ()Source

An always successful Translate.

contextT :: Monad m => Translate c m a cSource

Extract the current context.

exposeT :: Monad m => Translate c m a (c, a)Source

Expose the current context and value.

liftContext :: (c -> c') -> Translate c' m a b -> Translate c m a bSource

Lift a Translate to operate on a derived context.

readerT :: (a -> Translate c m a b) -> Translate c m a bSource

Look at the argument to the Translate before choosing which Translate to use.

resultT :: (m b -> n d) -> Translate c m a b -> Translate c n a dSource

Convert the monadic result of a Translate into a result in another monad.

catchesT :: MonadCatch m => [Translate c m a b] -> Translate c m a bSource

Attempt each Translate until one succeeds, then return that result and discard the rest of the Translates.

mapT :: (Traversable t, Monad m) => Translate c m a b -> Translate c m (t a) (t b)Source

Map a Translate over a list.

joinT :: Translate c m (m a) aSource

An identity translation that resembles a monadic join.

guardT :: Monad m => Translate c m Bool ()Source

Fail if the Boolean is False, succeed if the Boolean is True.

Rewrite Combinators

tryR :: MonadCatch m => Rewrite c m a -> Rewrite c m aSource

Catch a failing Rewrite, making it into an identity.

andR :: (Foldable f, Monad m) => f (Rewrite c m a) -> Rewrite c m aSource

Perform a collection of rewrites in sequence, requiring all to succeed.

orR :: (Functor f, Foldable f, MonadCatch m) => f (Rewrite c m a) -> Rewrite c m aSource

Perform a collection of rewrites in sequence, succeeding if any succeed.

(>+>) :: MonadCatch m => Rewrite c m a -> Rewrite c m a -> Rewrite c m aSource

Perform two rewrites in sequence, succeeding if one or both succeed.

repeatR :: MonadCatch m => Rewrite c m a -> Rewrite c m aSource

Repeat a Rewrite until it fails, then return the result before the failure. Requires at least the first attempt to succeed.

acceptR :: Monad m => (a -> Bool) -> Rewrite c m aSource

Look at the argument to a Rewrite, and choose to be either idR or a failure.

acceptWithFailMsgR :: Monad m => (a -> Bool) -> String -> Rewrite c m aSource

As acceptR, but takes a custom failure message.

accepterR :: Monad m => Translate c m a Bool -> Rewrite c m aSource

A generalisation of acceptR where the predicate is a Translate.

changedR :: (MonadCatch m, Eq a) => Rewrite c m a -> Rewrite c m aSource

Makes an Rewrite fail if the result value equals the argument value.

changedByR :: MonadCatch m => (a -> a -> Bool) -> Rewrite c m a -> Rewrite c m aSource

Makes a Rewrite fail if the result value and the argument value satisfy the equality predicate. This is a generalisation of changedR. changedR = changedByR (==)

sideEffectR :: Monad m => (c -> a -> m ()) -> Rewrite c m aSource

An identity Rewrite with side-effects.

Monad Transformers

anyR Support

These are useful when defining congruence combinators that succeed if any child rewrite succeeds. See the "Expr" example, or the HERMIT package.

data AnyR m a Source

The AnyR transformer, in combination with wrapAnyR and unwrapAnyR, causes a sequence of rewrites to succeed if at least one succeeds, converting failures to identity rewrites.

Instances

Monad m => Monad (AnyR m) 
MonadCatch m => MonadCatch (AnyR m) 

wrapAnyR :: MonadCatch m => Rewrite c m a -> Rewrite c (AnyR m) aSource

Wrap a Rewrite using the AnyR monad transformer.

unwrapAnyR :: Monad m => Rewrite c (AnyR m) a -> Rewrite c m aSource

Unwrap a Rewrite from the AnyR monad transformer.

oneR Support

These are useful when defining congruence combinators that succeed if one child rewrite succeeds (and the remainder are then discarded). See the "Expr" example, or the HERMIT package.

data OneR m a Source

The OneR transformer, in combination with wrapOneR and unwrapOneR, causes a sequence of rewrites to only apply the first success, converting the remainder (and failures) to identity rewrites.

Instances

Monad m => Monad (OneR m) 
MonadCatch m => MonadCatch (OneR m) 

wrapOneR :: MonadCatch m => Rewrite c m g -> Rewrite c (OneR m) gSource

Wrap a Rewrite using the OneR monad transformer.

unwrapOneR :: Monad m => Rewrite c (OneR m) a -> Rewrite c m aSource

Unwrap a Rewrite from the OneR monad transformer.