Ok, le regole erano scritte malissimo, erano millemila righe di codice tutte uguali (dai, non fatemene una colpa, guardate l'ora a cui ho postato).

Ho pulito un po' il codice, ma il problema è rimasto ._.

codice:
import Data.Maybe

-- State definition:
-- StateInternal left right side where
-- left and right are (missionary, cannibals)

data Side = L | R	-- Side where the boat is
	deriving (Eq, Show)

-- Abstract internal representation of the state data
data StateInternal = StateInternal (Int, Int) (Int, Int) Side
	deriving (Eq, Show)

-- Abstract internal representation of the route data	
type RouteInternal = String

-- Abstract Stat type
data State = State StateInternal [RouteInternal]
	deriving Show

{- 	Two States are equivalent where they have the same
	StateInternal data, regardless of the route that led there.
-}
instance Eq State where
	State s1 r1 == State s2 r2 = s1 == s2

-- Initial state and final state
s0 :: StateInternal
sln :: StateInternal
s0 = StateInternal (3,3) (0,0) L
sln = StateInternal (0,0) (3,3) R

-- Applies a rule to a state
applyTo :: State -> ( State -> Maybe State ) -> Maybe State
applyTo state rule = rule state

-- BFS Search
search :: StateInternal -> [(State -> Maybe State)] -> StateInternal -> Maybe State
search s0 rules sln = bfs [(State s0 [])] [] rules (State sln [])

bfs :: [State] -> [State] -> [(State -> Maybe State)] -> State -> Maybe State
bfs [] _ _ _ = Nothing
bfs (sc:ss) visited rules sln
	| sc == sln = Just sc
	| otherwise = bfs searchSpace visitedSpace rules sln where
		visitedSpace = sc : (listrm1 visited sc)
		searchSpace = listrm (ss ++ newStates) visitedSpace where
			newStates = catMaybes (map (applyTo sc) rules)

-- listrm
listrm :: (Eq a) => [a] -> [a] -> [a]
listrm [] _ = []
listrm ls [] = ls
listrm ls (y:ys) = listrm1 (listrm ls ys) y

listrm1 :: (Eq a) => [a] -> a -> [a]
listrm1 [] _ = []
listrm1 (x:xs) y
	| x == y = g
	| otherwise = x : g where
		g = listrm1 xs y


----- Rules -----

rules :: [(State -> Maybe State)]
rules = [rule1, rule2, rule3]

-- Checks if a state is acceptable
accept :: StateInternal -> Bool
accept (StateInternal (lm, lc) (rm, rc) side) = 
	(acceptShore (lm, lc)) && (acceptShore (rm, rc))

-- Checks if a shore is acceptable
acceptShore :: (Int, Int) -> Bool
acceptShore (m, c)
	| (m < 0 || c < 0) = False
	| m == 0 = True
	| otherwise = (m >= c)

-- Common rule structure
boilerplate :: State -> StateInternal -> String -> Maybe State
boilerplate (State oldstate route) proposedState rulename =
	if (accept proposedState) then 
		Just (State proposedState (route ++ [rulename]))
	else Nothing
		
	
-- Move 1 missionary
rule0 :: State -> Maybe State
rule0 state@(State s@(StateInternal (lm, lc) (rm, rc) side) route) =
	boilerplate state proposedState rulename where
		proposedState = if (side == L) then StateInternal (lm - 1, lc) (rm + 1, rc) R
							else StateInternal (lm + 1, lc) (rm - 1, rc ) L
		rulename = if (side == L) then "1M L->R"
						else "1M R->L"

-- Move 1 cannibal
rule1 :: State -> Maybe State
rule1 state@(State s@(StateInternal (lm, lc) (rm, rc) side) route) =
	boilerplate state proposedState rulename where
		proposedState = if (side == L) then StateInternal (lm, lc - 1) (rm, rc + 1) R
							else StateInternal (lm, lc + 1) (rm, rc - 1) L
		rulename = if (side == L) then "1C L->R"
						else "1C R->L"

-- Move 1 missionary and 1 cannibal
rule2 :: State -> Maybe State
rule2 state@(State s@(StateInternal (lm, lc) (rm, rc) side) route) =
	boilerplate state proposedState rulename where
		proposedState = if (side == L) then StateInternal (lm - 1, lc - 1) (rm + 1, rc + 1) R
							else StateInternal (lm + 1, lc + 1) (rm - 1, rc - 1) L
		rulename = if (side == L) then "1M 1C L->R"
						else "1M 1C R->L"

-- Move 2 missionaries
rule3 :: State -> Maybe State
rule3 state@(State s@(StateInternal (lm, lc) (rm, rc) side) route) =
	boilerplate state proposedState rulename where
		proposedState = if (side == L) then StateInternal (lm - 2, lc) (rm + 2, rc) R
							else StateInternal (lm + 2, lc) (rm - 2, rc) L
		rulename = if (side == L) then "2M L->R"
						else "2M R->L"

-- Move 2 cannibals
rule4 :: State -> Maybe State
rule4 state@(State s@(StateInternal (lm, lc) (rm, rc) side) route) =
	boilerplate state proposedState rulename where
		proposedState = if (side == L) then StateInternal (lm, lc - 2) (rm, rc + 2) R
							else StateInternal (lm, lc + 2) (rm, rc - 2) L
		rulename = if (side == L) then "2C L->R"
						else "2C R->L"