module Autolib.Util.Doppler 

( doppler
)

where

-- -- $Id$

-- do BFS, emit duplicate pairs
-- i. e. identical items with different paths

import Autolib.FiniteMap

doppler :: Ord a 
	=> Int
	-> (a -> [a]) 
        -> a 
	-> [(a,a)]
doppler :: forall a. Ord a => Int -> (a -> [a]) -> a -> [(a, a)]
doppler Int
schranke a -> [a]
f a
x = State a -> [(a, a)]
forall a. Ord a => State a -> [(a, a)]
action (State a -> [(a, a)]) -> State a -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ Int -> (a -> [a]) -> a -> State a
forall a. Int -> (a -> [a]) -> a -> State a
start Int
schranke a -> [a]
f a
x

action :: Ord a => State a -> [(a, a)]

action :: forall a. Ord a => State a -> [(a, a)]
action State a
s | Map a a -> Int
forall {k} {a}. Map k a -> Int
sizeFM ( State a -> Map a a
forall a. State a -> FiniteMap a a
seen State a
s ) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> State a -> Int
forall a. State a -> Int
schrank State a
s = []

action State a
s = case State a -> [a]
forall a. State a -> [a]
current State a
s of
    [] -> case State a -> [a]
forall a. State a -> [a]
future State a
s of
	       [] -> []
	       [a]
f -> State a -> [(a, a)]
forall a. Ord a => State a -> [(a, a)]
action (State a -> [(a, a)]) -> State a -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ State a
s { current = f
			       , future = [] 
			       }
    ( a
x : [a]
xs ) -> 
	case Map a a -> a -> Maybe a
forall k a. Ord k => FiniteMap k a -> k -> Maybe a
lookupFM ( State a -> Map a a
forall a. State a -> FiniteMap a a
seen State a
s ) a
x of
	     Maybe a
Nothing -> State a -> [(a, a)]
forall a. Ord a => State a -> [(a, a)]
action (State a -> [(a, a)]) -> State a -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ State a
s  { seen = addToFM ( seen s ) x x
				    , current = xs 
				    , future = next s x ++ future s
				    }
	     Just a
y  -> ( a
y, a
x ) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: State a -> [(a, a)]
forall a. Ord a => State a -> [(a, a)]
action (  State a
s { current = xs } )

data State a = 
     State { forall a. State a -> Int
schrank :: Int
	   , forall a. State a -> a -> [a]
next :: a -> [ a ]
	   , forall a. State a -> FiniteMap a a
seen :: FiniteMap a a
	   , forall a. State a -> [a]
current :: [ a ] 
	   , forall a. State a -> [a]
future :: [ a ]
	   }

start :: Int ->  (a -> [a]) -> a -> State a
start :: forall a. Int -> (a -> [a]) -> a -> State a
start Int
s a -> [a]
f a
x = State { schrank :: Int
schrank = Int
s
		, next :: a -> [a]
next = a -> [a]
f
		, seen :: FiniteMap a a
seen = FiniteMap a a
forall {k} {a}. Map k a
emptyFM
		, current :: [a]
current = [a
x]
		, future :: [a]
future = []
		}