kure-2.4.2: Combinators for Strategic Programming

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

Language.KURE.Utilities

Contents

Description

This module contains various utilities that can be useful to users of KURE, but are not essential.

Synopsis

The KURE Monad

data KureMonad a Source

A basic error Monad. KURE users may use either KureMonad or their own Monad(s).

Instances

Monad KureMonad 
Functor KureMonad 
Applicative KureMonad 
MonadCatch KureMonad

KureMonad is the minimal monad that can be an instance of MonadCatch.

Eq a => Eq (KureMonad a) 
Show a => Show (KureMonad a) 

runKureMonad :: (a -> b) -> (String -> b) -> KureMonad a -> bSource

Eliminator for KureMonad.

fromKureMonad :: (String -> a) -> KureMonad a -> aSource

Get the value from a KureMonad, providing a function to handle the error case.

Error Messages

missingChild :: Int -> StringSource

A standard error message for when the child index is out of bounds.

Generic Combinators

These functions are to aid with defining Walker instances for the Generic type. See the "Expr" example.

allTgeneric :: (Walker c m a, Monoid b) => Translate c m (Generic a) b -> c -> a -> m bSource

oneTgeneric :: Walker c m a => Translate c m (Generic a) b -> c -> a -> m bSource

allRgeneric :: Walker c m a => Rewrite c m (Generic a) -> c -> a -> m (Generic a)Source

anyRgeneric :: Walker c m a => Rewrite c m (Generic a) -> c -> a -> m (Generic a)Source

oneRgeneric :: Walker c m a => Rewrite c m (Generic a) -> c -> a -> m (Generic a)Source

childLgeneric :: Walker c m a => Int -> c -> a -> m ((c, Generic a), Generic a -> m (Generic a))Source

Attempt Combinators

anyR Support

These are useful when defining congruence combinators that succeed if any child rewrite succeeds. As well as being generally useful, such combinators are helpful when defining anyR instances. See the "Expr" example, or the HERMIT package.

attemptAny2 :: Monad m => (a1 -> a2 -> r) -> m (Bool, a1) -> m (Bool, a2) -> m rSource

attemptAny3 :: Monad m => (a1 -> a2 -> a3 -> r) -> m (Bool, a1) -> m (Bool, a2) -> m (Bool, a3) -> m rSource

attemptAny4 :: Monad m => (a1 -> a2 -> a3 -> a4 -> r) -> m (Bool, a1) -> m (Bool, a2) -> m (Bool, a3) -> m (Bool, a4) -> m rSource

attemptAnyN :: Monad m => ([a] -> b) -> [m (Bool, a)] -> m bSource

attemptAny1N :: Monad m => (a1 -> [a2] -> r) -> m (Bool, a1) -> [m (Bool, a2)] -> m rSource

oneR Support

These are useful when defining congruence combinators that succeed if one child rewrite succeeds (and the remainder are then discarded). As well as being generally useful, such combinators are helpful when defining oneR instances. See the "Expr" example, or the HERMIT package.

withArgumentT :: Monad m => Translate c m a b -> Translate c m a (m b, a)Source

Return the monadic result of a Translate and pair it with the argument.

attemptOne2 :: MonadCatch m => (a -> b -> r) -> m (m a, a) -> m (m b, b) -> m rSource

attemptOne3 :: MonadCatch m => (a -> b -> c -> r) -> m (m a, a) -> m (m b, b) -> m (m c, c) -> m rSource

attemptOne4 :: MonadCatch m => (a -> b -> c -> d -> r) -> m (m a, a) -> m (m b, b) -> m (m c, c) -> m (m d, d) -> m rSource

attemptOneN :: MonadCatch m => ([a] -> r) -> [m (m a, a)] -> m rSource

attemptOne1N :: MonadCatch m => (a -> [b] -> r) -> m (m a, a) -> [m (m b, b)] -> m rSource

Child Combinators

These functions are helpful when defining childL instances in combination with congruence combinators. See the "Lam" and "Expr" examples, or the HERMIT package.

Unfortunately they increase quadratically with the number of fields of the constructor. It would be nice if they were further expanded to include the calls of id and exposeT; however this would create a plethora of additional cases as the number (and positions) of interesting children would be additional dimensions.

Note that the numbering scheme MofN is that N is the number of children (including uninteresting children) and M is the index of the chosen child, starting with index 0. Thus M ranges from 0 to (n-1).

TO DO: use Template Haskell to generate these.

In the mean time, if you need a few more than provided here, drop me an email and I'll add them.

childLaux :: (MonadCatch m, Node b) => (c, b) -> (b -> a) -> ((c, Generic b), Generic b -> m a)Source

childL0of1 :: (MonadCatch m, Node b) => (b -> a) -> (c, b) -> ((c, Generic b), Generic b -> m a)Source

childL0of2 :: (MonadCatch m, Node b0) => (b0 -> b1 -> a) -> (c, b0) -> b1 -> ((c, Generic b0), Generic b0 -> m a)Source

childL1of2 :: (MonadCatch m, Node b1) => (b0 -> b1 -> a) -> b0 -> (c, b1) -> ((c, Generic b1), Generic b1 -> m a)Source

childL0of3 :: (MonadCatch m, Node b0) => (b0 -> b1 -> b2 -> a) -> (c, b0) -> b1 -> b2 -> ((c, Generic b0), Generic b0 -> m a)Source

childL1of3 :: (MonadCatch m, Node b1) => (b0 -> b1 -> b2 -> a) -> b0 -> (c, b1) -> b2 -> ((c, Generic b1), Generic b1 -> m a)Source

childL2of3 :: (MonadCatch m, Node b2) => (b0 -> b1 -> b2 -> a) -> b0 -> b1 -> (c, b2) -> ((c, Generic b2), Generic b2 -> m a)Source

childL0of4 :: (MonadCatch m, Node b0) => (b0 -> b1 -> b2 -> b3 -> a) -> (c, b0) -> b1 -> b2 -> b3 -> ((c, Generic b0), Generic b0 -> m a)Source

childL1of4 :: (MonadCatch m, Node b1) => (b0 -> b1 -> b2 -> b3 -> a) -> b0 -> (c, b1) -> b2 -> b3 -> ((c, Generic b1), Generic b1 -> m a)Source

childL2of4 :: (MonadCatch m, Node b2) => (b0 -> b1 -> b2 -> b3 -> a) -> b0 -> b1 -> (c, b2) -> b3 -> ((c, Generic b2), Generic b2 -> m a)Source

childL3of4 :: (MonadCatch m, Node b3) => (b0 -> b1 -> b2 -> b3 -> a) -> b0 -> b1 -> b2 -> (c, b3) -> ((c, Generic b3), Generic b3 -> m a)Source

childLMofN :: (MonadCatch m, Node b) => Int -> ([b] -> a) -> [(c, b)] -> ((c, Generic b), Generic b -> m a)Source