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") ]