Commit 33f0fc59 authored by Sven Keidel's avatar Sven Keidel

fix unsound parallel fixpoint iteration

parent 2700f84e
Pipeline #35817 passed with stages
in 45 minutes and 9 seconds
......@@ -6,7 +6,7 @@ module Control.Arrow.Fix.Parallel where
import Prelude hiding (iterate)
import Control.Arrow
import Control.Arrow hiding (loop)
import Control.Arrow.Trans
import Control.Arrow.Fix
import Control.Arrow.Fix.Stack as Stack
......@@ -43,12 +43,17 @@ parallel f = proc a -> do
iterate -< a
update = proc a -> do
m <- Cache.lookup -< a
case m of
Just (_,b) -> returnA -< b
Nothing -> do
Cache.initialize -< a
b <- Stack.push f -< a
(_,b') <- Cache.update -< (a,b)
returnA -< b'
loop <- Stack.elem -< a
if loop
then do
m <- Cache.lookup -< a
case m of
Just (_,b) -> returnA -< b
Nothing -> do
Cache.initialize -< a
b <- Stack.push f -< a
(_,b') <- Cache.update -< (a,b)
returnA -< b'
else
Stack.push f -< a
{-# INLINE parallel #-}
......@@ -46,12 +46,12 @@ maxSize limit strat f = proc a -> do
else strat f -< a
{-# INLINE maxSize #-}
widenInput :: ArrowStack a c => Widening a -> FixpointCombinator c a b
widenInput :: (Complete a, ArrowStack a c) => Widening a -> FixpointCombinator c a b
widenInput widen f = proc a -> do
m <- peek -< ()
f -< case m of
Nothing -> a
Just x -> snd $ x `widen` a
Just x -> snd $ x `widen` (x a)
{-# INLINE widenInput #-}
reuse :: (ArrowChoice c, ArrowStack a c) => (a -> [a] -> Maybe a) -> FixpointCombinator c a b
......
......@@ -31,7 +31,7 @@ maybeHead (a:_) = Just a
maybeHead [] = Nothing
pow :: [a] -> Seq [a]
pow = foldl (\xs x -> fmap (x:) xs<> xs) mempty
pow = foldl (\powersets x -> fmap (x:) powersets <> powersets) mempty
-- @powComplement M@ computes for a set M, the set { (X,M\X) | X in P(M) }
powComplement :: [a] -> Seq ([a], [a])
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment