Personal tools

Amb

From HaskellWiki

Revision as of 01:56, 28 March 2008 by Elliott (Talk | contribs)

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search

This is an implementation of the amb operator in Haskell. Interestingly, it is identical to the list monad: remove 'amb' and the examples below work fine (apart, of course, from the IO one).

Notably, AmbT could be considered ListT done right.

import Control.Monad.Cont
import Control.Monad.State
import Control.Monad.Identity
 
type Point r a m = () -> AmbT r a m a
newtype AmbT r a m b = AmbT { unAmbT :: StateT [Point r a m] (ContT r m) b }
type Amb r a = AmbT r a Identity
 
instance MonadTrans (AmbT r a) where
    lift = AmbT . lift . lift
 
instance (Monad m) => Monad (AmbT r a m) where
    AmbT a >>= b = AmbT $ a >>= unAmbT . b
    return = AmbT . return
 
backtrack :: (Monad m) => AmbT r a m b
backtrack = do xss <- AmbT get
               case xss of
                 [] -> fail "amb tree exhausted"
                 (f:xs) -> do AmbT $ put xs
                              f ()
                              return undefined
 
addPoint :: (Monad m) => Point r a m -> AmbT r a m ()
addPoint x = AmbT $ modify (x:)
 
amb :: (Monad m) => [b] -> AmbT r a m b
amb []     = backtrack
amb (x:xs) = ambCC $ \exit -> do
               ambCC $ \k -> addPoint k >> exit x
               amb xs
    where ambCC f = AmbT $ callCC $ \k -> unAmbT $ f $ AmbT . k
 
cut :: (Monad m) => AmbT r a m ()
cut = AmbT $ put []
 
runAmbT :: (Monad m) => AmbT r a m r -> m r
runAmbT (AmbT a) = runContT (evalStateT a []) return
 
runAmb :: Amb r a r -> r
runAmb = runIdentity . runAmbT

And some examples:

example :: Amb r Integer (Integer,Integer)
example = do x <- amb [1,2,3]
             y <- amb [4,5,6]
             if x*y == 8
               then return (x,y)
               else amb []
 
factor :: Integer -> Amb r Integer (Integer,Integer)
factor a = do x <- amb [2..]
              y <- amb [2..x]
              if x*y == a
                then return (x,y)
                else amb []
 
factorIO :: Integer -> AmbT r Integer IO (Integer,Integer)
factorIO a = do lift $ putStrLn $ "Factoring " ++ show a
                x <- amb [2..]
                y <- amb [2..x]
                lift $ putStrLn $ "Trying " ++ show x ++ " and " ++ show y
                if x*y == a
                  then do lift $ putStrLn "Found it!"
                          return (x,y)
                  else do lift $ putStrLn $ "Nope (" ++ show (x*y) ++ ")"
                          amb []