1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
{-# LANGUAGE Rank2Types #-}
-- |
-- Module : Control.Monad.SearchTree
-- Copyright : Sebastian Fischer
-- License : BSD3
--
-- Maintainer : Niels Bunkenburg (nbu@informatik.uni-kiel.de)
-- Stability : experimental
-- Portability : portable
--
-- This Haskell library provides an implementation of the MonadPlus
-- type class that represents the search space as a tree whose
-- constructors represent mzero, return, and mplus.
--
-- Such a tree can be used to implement different search strategies,
-- e.g., by using a queue. It can also be used as a basis for parallel
-- search strategies that evaluate different parts of the search space
-- concurrently.
module Control.Monad.SearchTree ( SearchTree(..), Search, searchTree ) where
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
-- |
-- The type @SearchTree a@ represents non-deterministic computations
-- as a tree structure.
data SearchTree a = None | One a | Choice (SearchTree a) (SearchTree a)
deriving Show
instance Functor SearchTree where
fmap _ None = None
fmap f (One x) = One (f x)
fmap f (Choice s t) = Choice (fmap f s) (fmap f t)
instance Applicative SearchTree where
pure = One
(<*>) = ap
instance Alternative SearchTree where
empty = mzero
(<|>) = mplus
instance Monad SearchTree where
None >>= _ = None
One x >>= f = f x
Choice s t >>= f = Choice (s >>= f) (t >>= f)
instance MonadFail SearchTree where
fail _ = None
instance MonadPlus SearchTree where
mzero = None
mplus = Choice
instance MonadFix SearchTree where
mfix f = case fix (f . unOne) of
None -> None
One x -> One x
Choice _ _ -> Choice (mfix (leftChoice . f)) (mfix (rightChoice . f))
where
unOne (One x) = x
unOne _ = error "mfix SearchTree: not One"
leftChoice (Choice s _) = s
leftChoice _ = error "mfix SearchTree: not Choice"
rightChoice (Choice _ t) = t
rightChoice _ = error "mfix SearchTree: not Choice"
-- |
-- Another search monad based on continuations that produce search
-- trees.
newtype Search a = Search
{ -- | Passes a continuation to a monadic search action.
search :: forall r. (a -> SearchTree r) -> SearchTree r
}
-- | Computes the @SearchTree@ representation of a @Search@ action.
searchTree :: Search a -> SearchTree a
searchTree a = search a One
instance Functor Search where
fmap f a = Search (\k -> search a (k . f))
instance Applicative Search where
pure x = Search ($ x)
(<*>) = ap
instance Alternative Search where
empty = mzero
(<|>) = mplus
instance Monad Search where
a >>= f = Search (\k -> search a (\x -> search (f x) k))
instance MonadFail Search where
fail _ = mzero
instance MonadPlus Search where
mzero = Search (const mzero)
a `mplus` b = Search (\k -> search a k `mplus` search b k)
instance MonadFix Search where
mfix f = Search (\k -> mfix (searchTree . f) >>= k)
|
