finding sublist

[Andrew J Bromage]

G'day all.

On Mon, May 06, 2002 at 02:15:55PM +1000, Garner, Robin wrote:

> How you would do this in a functional implementation is another question -
> Dijkstra's example is comparing two arrays, and there may be inefficiencies
> translating it to a list-based implementation.

Here's my humble contribution.  It compiles the string to a function
which performs the match, using continuations to handle the failure
transitions.  It's also not a good example of the sort of Haskell
code that you should write.  It's possibly also buggy.

Also note that this returns the list split at the point _after_ the
string is matched, not before.  Altering it to return the point before
is left as an exercise.

Cheers,
Andrew Bromage

--------8<--CUT HERE---8<--------

import List

type PartialMatchFunc m a = [a] -> [a] -> m ([a], [a])

makeMatchFunc :: (Monad m, Eq a) => [a] -> ([a] -> m ([a],[a]))
makeMatchFunc []
  = error "Can't make match func for empty list"
makeMatchFunc xs
  = \ys -> matchfunc [] ys
  where
  	matchfunc = makeMatchFunc' [dofail] (zip xs (overlap xs))
	dofail = \ps xs -> case xs of
				[] -> error "can't match"
				(y:ys) -> matchfunc (y:ps) ys

overlap :: (Eq a) => [a] -> [Int]
overlap str
  = overlap' [0] str
  where
	overlap' prev []
	  = reverse prev
	overlap' prev (x:xs)
	  = let get_o o
		  | o < 2 || str !! (o-2) == x = o
		  | otherwise = get_o (1 + prev !! (length prev - o + 1))
	    in overlap' (get_o (head prev + 1):prev) xs

makeMatchFunc' :: (Monad m, Eq a) => [PartialMatchFunc m a] -> [(a, Int)]
		-> PartialMatchFunc m a
makeMatchFunc' prev []
  = \ps xs -> return (reverse ps, xs)
makeMatchFunc' prev mms@((x,failstate):ms)
  = thisf
  where
	mf = makeMatchFunc' (thisf:prev) ms
	failcont = prev !! (length prev - failstate - 1)
	thisf = \ps xs -> case xs of
				[] -> fail "can't match"
				(y:ys) -> if (x == y) then mf (y:ps) ys
						else failcont ps xs

-- Some tests

type MatchMaybe a = [a] -> Maybe ([a],[a])

ex_abra :: MatchMaybe Char
ex_abra = makeMatchFunc "abracadabra"

test :: IO ()
test
  = foldr1 (>>) [ putStrLn t | t <- tests ]
  where
	tests = [
		show (ex_abra "abracadabra"),
		show (ex_abra "ababracadabra"),
		show (ex_abra "ababracadabrabra"),
		show (ex_abra "ababrabracadabrabra")
		]