Copyright | (c) Dan Doel |
---|---|
License | BSD3 |
Maintainer | Andrew Lelechenko <andrew.lelechenko@gmail.com> |
Safe Haskell | Safe |
Language | Haskell2010 |
A backtracking, logic programming monad.
Adapted from the paper Backtracking, Interleaving, and Terminating Monad Transformers, by Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry (http://okmij.org/ftp/papers/LogicT.pdf).
Synopsis
- class MonadPlus m => MonadLogic m where
- reflect :: MonadLogic m => Maybe (a, m a) -> m a
Documentation
class MonadPlus m => MonadLogic m where Source #
Minimal implementation: msplit
msplit :: m a -> m (Maybe (a, m a)) Source #
Attempts to split the computation, giving access to the first result. Satisfies the following laws:
msplit mzero == return Nothing msplit (return a `mplus` m) == return (Just (a, m))
interleave :: m a -> m a -> m a Source #
Fair disjunction. It is possible for a logical computation to have an infinite number of potential results, for instance:
odds = return 1 `mplus` liftM (2+) odds
Such computations can cause problems in some circumstances. Consider:
do x <- odds `mplus` return 2 if even x then return x else mzero
Such a computation may never consider the 'return 2', and will therefore never terminate. By contrast, interleave ensures fair consideration of both branches of a disjunction
(>>-) :: m a -> (a -> m b) -> m b infixl 1 Source #
Fair conjunction. Similarly to the previous function, consider the distributivity law for MonadPlus:
(mplus a b) >>= k = (a >>= k) `mplus` (b >>= k)
If 'a >>= k' can backtrack arbitrarily many tmes, (b >>= k) may never be considered. (>>-) takes similar care to consider both branches of a disjunctive computation.
ifte :: m a -> (a -> m b) -> m b -> m b Source #
Logical conditional. The equivalent of Prolog's soft-cut. If its first argument succeeds at all, then the results will be fed into the success branch. Otherwise, the failure branch is taken. satisfies the following laws:
ifte (return a) th el == th a ifte mzero th el == el ifte (return a `mplus` m) th el == th a `mplus` (m >>= th)
Pruning. Selects one result out of many. Useful for when multiple results of a computation will be equivalent, or should be treated as such.
Inverts a logic computation. If m
succeeds with at least one value,
lnot m
fails. If m
fails, then lnot m
succeeds the value ()
.
Instances
MonadLogic [] Source # | |
Monad m => MonadLogic (LogicT m) Source # | |
Defined in Control.Monad.Logic msplit :: LogicT m a -> LogicT m (Maybe (a, LogicT m a)) Source # interleave :: LogicT m a -> LogicT m a -> LogicT m a Source # (>>-) :: LogicT m a -> (a -> LogicT m b) -> LogicT m b Source # ifte :: LogicT m a -> (a -> LogicT m b) -> LogicT m b -> LogicT m b Source # | |
MonadLogic m => MonadLogic (StateT s m) Source # | See note on splitting above. |
Defined in Control.Monad.Logic.Class msplit :: StateT s m a -> StateT s m (Maybe (a, StateT s m a)) Source # interleave :: StateT s m a -> StateT s m a -> StateT s m a Source # (>>-) :: StateT s m a -> (a -> StateT s m b) -> StateT s m b Source # ifte :: StateT s m a -> (a -> StateT s m b) -> StateT s m b -> StateT s m b Source # | |
MonadLogic m => MonadLogic (StateT s m) Source # | See note on splitting above. |
Defined in Control.Monad.Logic.Class msplit :: StateT s m a -> StateT s m (Maybe (a, StateT s m a)) Source # interleave :: StateT s m a -> StateT s m a -> StateT s m a Source # (>>-) :: StateT s m a -> (a -> StateT s m b) -> StateT s m b Source # ifte :: StateT s m a -> (a -> StateT s m b) -> StateT s m b -> StateT s m b Source # | |
MonadLogic m => MonadLogic (ReaderT e m) Source # | Note that splitting a transformer does not allow you to provide different input to the monadic object returned. For instance, in: let Just (_, rm') = runReaderT (msplit rm) r in runReaderT rm' r'
|
Defined in Control.Monad.Logic.Class msplit :: ReaderT e m a -> ReaderT e m (Maybe (a, ReaderT e m a)) Source # interleave :: ReaderT e m a -> ReaderT e m a -> ReaderT e m a Source # (>>-) :: ReaderT e m a -> (a -> ReaderT e m b) -> ReaderT e m b Source # ifte :: ReaderT e m a -> (a -> ReaderT e m b) -> ReaderT e m b -> ReaderT e m b Source # |
reflect :: MonadLogic m => Maybe (a, m a) -> m a Source #
The inverse of msplit. Satisfies the following law:
msplit m >>= reflect == m