logict 0.6.0.3 → 0.7.0.0
raw patch · 4 files changed
+53/−75 lines, 4 files
Files
- Control/Monad/Logic.hs +28/−8
- Control/Monad/Logic/Class.hs +18/−66
- changelog.md +6/−0
- logict.cabal +1/−1
Control/Monad/Logic.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP, UndecidableInstances, Rank2Types, FlexibleInstances, MultiParamTypeClasses #-}- ------------------------------------------------------------------------- -- | -- Module : Control.Monad.Logic@@ -16,9 +14,11 @@ -- /Backtracking, Interleaving, and Terminating -- Monad Transformers/, by -- Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry--- (<http://www.cs.rutgers.edu/~ccshan/logicprog/LogicT-icfp2005.pdf>).+-- (<http://okmij.org/ftp/papers/LogicT.pdf>). ------------------------------------------------------------------------- +{-# LANGUAGE CPP, UndecidableInstances, Rank2Types, FlexibleInstances, MultiParamTypeClasses #-}+ module Control.Monad.Logic ( module Control.Monad.Logic.Class, -- * The Logic monad@@ -49,7 +49,9 @@ import Control.Monad.State.Class import Control.Monad.Error.Class +#if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid(mappend, mempty))+#endif import qualified Data.Foldable as F import qualified Data.Traversable as T @@ -57,7 +59,7 @@ ------------------------------------------------------------------------- -- | A monad transformer for performing backtracking computations--- layered over another monad 'm'+-- layered over another monad @m@. newtype LogicT m a = LogicT { unLogicT :: forall r. (a -> m r -> m r) -> m r -> m r } @@ -95,7 +97,7 @@ ------------------------------------------------------------------------- -- | The basic Logic monad, for performing backtracking computations--- returning values of type 'a'+-- returning values of type @a@. type Logic = LogicT Identity -------------------------------------------------------------------------@@ -118,7 +120,9 @@ ------------------------------------------------------------------------- -- | Extracts up to a given number of results from a Logic computation. observeMany :: Int -> Logic a -> [a]-observeMany i = runIdentity . observeManyT i+observeMany i = take i . observeAll+-- Implementing 'observeMany' using 'observeManyT' is quite costly,+-- because it calls 'msplit' multiple times. ------------------------------------------------------------------------- -- | Runs a Logic computation with the specified initial success and@@ -161,13 +165,29 @@ liftIO = lift . liftIO instance (Monad m) => MonadLogic (LogicT m) where+ -- 'msplit' is quite costly even if the base 'Monad' is 'Identity'.+ -- Try to avoid it. msplit m = lift $ unLogicT m ssk (return Nothing) where ssk a fk = return $ Just (a, (lift fk >>= reflect))+ once m = LogicT $ \sk fk -> unLogicT m (\a _ -> sk a fk) fk+ lnot m = LogicT $ \sk fk -> unLogicT m (\_ _ -> fk) (sk () fk) -instance (Monad m, F.Foldable m) => F.Foldable (LogicT m) where+#if MIN_VERSION_base(4,8,0)++instance {-# OVERLAPPABLE #-} (Monad m, F.Foldable m) => F.Foldable (LogicT m) where foldMap f m = F.fold $ unLogicT m (liftM . mappend . f) (return mempty) +instance {-# OVERLAPPING #-} F.Foldable (LogicT Identity) where+ foldr f z m = runLogic m f z++#else++instance {-# OVERLAPPABLE #-} (Monad m, F.Foldable m) => F.Foldable (LogicT m) where+ foldMap f m = F.fold $ unLogicT m (liftM . mappend . f) (return mempty)++#endif+ instance T.Traversable (LogicT Identity) where traverse g l = runLogic l (\a ft -> cons <$> g a <*> ft) (pure mzero) where cons a l' = return a `mplus` l'@@ -175,7 +195,7 @@ -- Needs undecidable instances instance MonadReader r m => MonadReader r (LogicT m) where ask = lift ask- local f m = LogicT $ \sk fk -> unLogicT m ((local f .) . sk) (local f fk)+ local f m = LogicT (\sk fk -> local f (unLogicT m sk fk)) -- Needs undecidable instances instance MonadState s m => MonadState s (LogicT m) where
Control/Monad/Logic/Class.hs view
@@ -14,20 +14,15 @@ -- /Backtracking, Interleaving, and Terminating -- Monad Transformers/, by -- Oleg Kiselyov, Chung-chieh Shan, Daniel P. Friedman, Amr Sabry--- (<http://www.cs.rutgers.edu/~ccshan/logicprog/LogicT-icfp2005.pdf>)+-- (<http://okmij.org/ftp/papers/LogicT.pdf>) ------------------------------------------------------------------------- -module Control.Monad.Logic.Class (MonadLogic(..), reflect, lnot) where+module Control.Monad.Logic.Class (MonadLogic(..), reflect) where +import Control.Monad.Reader import qualified Control.Monad.State.Lazy as LazyST import qualified Control.Monad.State.Strict as StrictST -import Control.Monad.Reader--import Data.Monoid-import qualified Control.Monad.Writer.Lazy as LazyWT-import qualified Control.Monad.Writer.Strict as StrictWT- ------------------------------------------------------------------------------- -- | Minimal implementation: msplit class (MonadPlus m) => MonadLogic m where@@ -79,6 +74,10 @@ -- such. once :: m a -> m a + -- | Inverts a logic computation. If @m@ succeeds with at least one value,+ -- @lnot m@ fails. If @m@ fails, then @lnot m@ succeeds the value @()@.+ lnot :: m a -> m ()+ -- All the class functions besides msplit can be derived from msplit, if -- desired interleave m1 m2 = msplit m1 >>=@@ -92,7 +91,9 @@ once m = do (a, _) <- maybe mzero return =<< msplit m return a + lnot m = ifte (once m) (const mzero) (return ()) + ------------------------------------------------------------------------------- -- | The inverse of msplit. Satisfies the following law: --@@ -101,33 +102,27 @@ reflect Nothing = mzero reflect (Just (a, m)) = return a `mplus` m --- | Inverts a logic computation. If @m@ succeeds with at least one value,--- @lnot m@ fails. If @m@ fails, then @lnot m@ succeeds the value @()@.-lnot :: MonadLogic m => m a -> m ()-lnot m = ifte (once m) (const mzero) (return ())- -- An instance of MonadLogic for lists instance MonadLogic [] where msplit [] = return Nothing msplit (x:xs) = return $ Just (x, xs) --- Some of these may be questionable instances. Splitting a transformer does--- not allow you to provide different input to the monadic object returned.--- So, for instance, in:+-- | 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'+-- > let Just (_, rm') = runReaderT (msplit rm) r in runReaderT rm' r' ----- The "r'" parameter will be ignored, as "r" was already threaded through the--- computation. The results are similar for StateT. However, this is likely not--- an issue as most uses of msplit (all the ones in this library, at least) would--- not allow for that anyway.+-- @r'@ will be ignored, because @r@ was already threaded through the+-- computation. instance MonadLogic m => MonadLogic (ReaderT e m) where msplit rm = ReaderT $ \e -> do r <- msplit $ runReaderT rm e case r of Nothing -> return Nothing Just (a, m) -> return (Just (a, lift m)) +-- | See note on splitting above. instance MonadLogic m => MonadLogic (StrictST.StateT s m) where msplit sm = StrictST.StateT $ \s -> do r <- msplit (StrictST.runStateT sm s)@@ -148,6 +143,7 @@ once ma = StrictST.StateT $ \s -> once (StrictST.runStateT ma s) +-- | See note on splitting above. instance MonadLogic m => MonadLogic (LazyST.StateT s m) where msplit sm = LazyST.StateT $ \s -> do r <- msplit (LazyST.runStateT sm s)@@ -167,47 +163,3 @@ (LazyST.runStateT el s) once ma = LazyST.StateT $ \s -> once (LazyST.runStateT ma s)--instance (MonadLogic m, Monoid w) => MonadLogic (StrictWT.WriterT w m) where- msplit wm = StrictWT.WriterT $- do r <- msplit (StrictWT.runWriterT wm)- case r of- Nothing -> return (Nothing, mempty)- Just ((a,w), m) ->- return (Just (a, StrictWT.WriterT m), w)-- interleave ma mb = StrictWT.WriterT $- StrictWT.runWriterT ma `interleave` StrictWT.runWriterT mb-- ma >>- f = StrictWT.WriterT $- StrictWT.runWriterT ma >>- \(a,w) ->- StrictWT.runWriterT (StrictWT.tell w >> f a)-- ifte t th el = StrictWT.WriterT $- ifte (StrictWT.runWriterT t)- (\(a,w) -> StrictWT.runWriterT (StrictWT.tell w >> th a))- (StrictWT.runWriterT el)-- once ma = StrictWT.WriterT $ once (StrictWT.runWriterT ma)--instance (MonadLogic m, Monoid w) => MonadLogic (LazyWT.WriterT w m) where- msplit wm = LazyWT.WriterT $- do r <- msplit (LazyWT.runWriterT wm)- case r of- Nothing -> return (Nothing, mempty)- Just ((a,w), m) ->- return (Just (a, LazyWT.WriterT m), w)-- interleave ma mb = LazyWT.WriterT $- LazyWT.runWriterT ma `interleave` LazyWT.runWriterT mb-- ma >>- f = LazyWT.WriterT $- LazyWT.runWriterT ma >>- \(a,w) ->- LazyWT.runWriterT (LazyWT.tell w >> f a)-- ifte t th el = LazyWT.WriterT $- ifte (LazyWT.runWriterT t)- (\(a,w) -> LazyWT.runWriterT (LazyWT.tell w >> th a))- (LazyWT.runWriterT el)-- once ma = LazyWT.WriterT $ once (LazyWT.runWriterT ma)
changelog.md view
@@ -1,3 +1,9 @@+# 0.7.0.0++* Remove unlawful `MonadLogic (Writer T w m)` instances.+* Fix `MonadReader r (LogicT m)` instance.+* Move `lnot` into `MonadLogic` class.+ # 0.6.0.3 * Comply with MonadFail proposal.
logict.cabal view
@@ -1,5 +1,5 @@ name: logict-version: 0.6.0.3+version: 0.7.0.0 description: A continuation-based, backtracking, logic programming monad. An adaptation of the two-continuation implementation found in the paper "Backtracking, Interleaving, and Terminating