I implemented Aho-Corasick string matching in Haskell. It is a purely functional implementation compared to many other implementations.
The input to build an automata is [([a],b)]. which is a list of (pattern,output) pairs.
b has to form a monoid, so we know what to do when more than one match occurs at the same place.
I borrowed many idea from the KMP implementation by Twan van Laarhoven(which I suspect is a implementation of the MP instead of KMP algorithm).
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function
import Control.Arrow
data Automaton a b = Node {delta :: a -> Automaton a b,
output :: b
}
-- assume the input function eq is a equivalence relation, then this
-- produce all the equivalent classes.
equivalentClasses :: (a->a->Bool)->[a]->[[a]]
equivalentClasses eq = foldl parts []
where parts [] a = [[a]]
parts (x:xs) a
| eq (head x) a = (a:x):xs
| otherwise = x:parts xs a
buildAutomaton :: (Monoid b,Eq a) => [([a],b)] -> Automaton a b
buildAutomaton xs = automaton
where automaton = build (const automaton) xs mempty
-- this builds one node of the automaton. Tying the knot happens everywhere
build :: (Monoid b,Eq a)=> (a -> Automaton a b) -> [([a],b)] -> b -> Automaton a b
build trans' xs out = node
where node = Node trans out
trans a
| isNothing next = trans' a
| otherwise = fromJust next
where next = lookup a table
table = map transPair $ equivalentClasses (on (==) (head . fst)) xs
transPair xs = (a, build (delta (trans' a)) ys out)
where a = head $ fst $ head xs
(ys,zs) = partition (not . null . fst) $ map (first tail) xs
out = mappend (mconcat $ map snd zs) (output $ trans' a)
-- this function simulates the automaton.
match :: Eq a => Automaton a b -> [a] -> [b]
match a xs = map output $ scanl delta a xs
-- an example to check if a list is a sublist of another list
isInfixOf' :: Eq a => [a] -> [a] -> Bool
isInfixOf' xs ys = getAll $ mconcat $ match (buildAutomaton [(xs, All True)]) ys
