M.hs

module Language.Haskell.FreeTheorems.Variations.CounterExamples.Internal.M (M,runM,newInt,newAux,choice,abort,runMAll,track,assoc) where

type State s = (Int,Int,[String],[(Int,s)])

data M s a = M (State s -> [(a,State s)])

instance Monad (M s) where
    return a = M (\s -> [(a,s)])
    M m >>= k = M (\s -> concatMap (\(a,s') -> case k a of M l -> l s') (m s))

runM :: M s a -> Maybe (a, [String], [(Int,s)])
runM (M m) = case m (1,-1,[],[]) of
	       []        -> Nothing
	       ((a,(_,_,ls,as)):_) -> Just (a,reverse ls,as)

runMAll :: M s a -> [(a, [String], [(Int,s)])]
runMAll (M m) = map (\(a,(_,_,ls,as)) -> (a,reverse ls,as)) (m (1,0,[],[]))

newInt :: M s Int
newInt = M (\(i,j,ls,as) -> [(i,(i+1,j,ls,as))])

newAux :: M s Int
newAux = M (\(i,j,ls,as) -> [(j,(i,j-1,ls,as))])

choice :: M s a -> M s a -> M s a
choice (M m) (M l) = M (\s -> m s ++ l s)

abort :: M s a
abort = M (\s -> [])

track :: String -> M s ()
track l = M (\(i,j,ls,as) -> [((),(i,j,l:ls,as))])

assoc :: Int -> s -> M s ()
assoc a s = M (\(i,j,ls,as) -> [((),(i,j,ls,(a,s):as))])