I have a reduction system in which a rule takes a term and returns a set of terms. The reduction system creates a tree that originates at a starting value called the root. For most problems, the reduction system terminates, but a step count limit protects from non-termination. Rule application is expensive, so it is essential that a rule is never applied to the same problem twice. This check makes my program sequential, in that parallel annotations don't improve performance on SMPs. There isn't even an obvious place to add them in my program, at least not to me. How do people write parallel reduction systems that avoid redundant rule application? John
module Main (main) where
import System.Time (ClockTime(..), getClockTime
data Eq a => Item a = Item { item :: a, parent :: Maybe (Item a) }
instance Eq a => Eq (Item a) where x == y = item x == item y
The reduction system takes a rule, a step count, and an initial value, and computes a tree of reductions. The order of the items in the returned list is irrelevant, because the tree is assembled as a post processing step.
reduce :: (Eq a, Monad m) => (a -> [a]) -> Int -> a -> m [Item a] reduce rule limit root = step rule limit [top] [top] where top = Item { item = root, parent = Nothing }
step rule limit seen todo, where seen in the items already seen, and todo is the items on the queue.
step :: (Eq a, Monad m) => (a -> [a]) -> Int -> [Item a] -> [Item a] -> m [Item a] step _ limit _ _ | limit <= 0 = fail "Step limit exceeded" step _ _ seen [] = return seen step rule limit seen (next : rest) = loop seen rest children where children = map child (rule (item next)) child i = Item { item = i, parent = Just next } loop seen rest [] = step rule (limit - 1) seen rest loop seen rest (kid : kids) = if elem kid seen then loop seen rest kids else loop (kid : seen) (rest ++ [kid]) kids
A silly rule
rule :: Int -> [Int] rule n = filter (>= 0) [n - 1, n - 2, n - 3]
secDiff :: ClockTime -> ClockTime -> Float secDiff (TOD secs1 psecs1) (TOD secs2 psecs2) = fromInteger (psecs2 - psecs1) / 1e12 + fromInteger (secs2 - secs1)
main :: IO () main = do t0 <- getClockTime ns <- reduce rule 20000 5000 t1 <- getClockTime putStrLn $ "length: " ++ show (length ns) putStrLn $ "time: " ++ show (secDiff t0 t1) ++ " seconds"
The makefile ------------ PROG = reduce GHCFLAGS = -Wall -fno-warn-name-shadowing -O %: %.lhs ghc $(GHCFLAGS) -o $@ $< all: $(PROG) clean: -rm *.o *.hi $(PROG)