Parallel term reduction

1 Feb 2009


      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)

John D. Ramsdell

Luke Palmer

Luke Palmer

John D. Ramsdell

John D. Ramsdell

tags

participants (2)