Commit 11c79d36 authored by Sven Keidel's avatar Sven Keidel

fix fixpoint algo

parent 03b3c623
......@@ -117,9 +117,9 @@ memoize (FixT f) = FixT $ \(stackWidening,widening) -> proc (((stack,oldCache),
-- cache with previous knowledge about the result or ⊥, compute
-- the result of the function and update the fixpoint cache.
Nothing -> do
let yOld = fromMaybe bottom (M.unsafeLookup x oldCache)
newCache' = M.insert x yOld newCache
(x',stack') = runState (stackWidening x) stack
let (x',stack') = runState (stackWidening x) stack
yOld = fromMaybe bottom (M.unsafeLookup x' oldCache)
newCache' = M.insert x' yOld newCache
(newCache'',y) <- f (stackWidening,widening) -< (((stack',oldCache), newCache'),x')
let newCache''' = M.unsafeInsertWith (flip (T.widening widening)) x' y newCache''
y' = fromJust (M.unsafeLookup x' newCache''')
......
......@@ -36,12 +36,9 @@ pi2 = arr snd
-- | Zips two lists together.
zipWith :: ArrowChoice c => c (x,y) z -> c ([x],[y]) [z]
zipWith f = proc (l1,l2) -> case (l1,l2) of
([],_) -> returnA -< []
(_,[]) -> returnA -< []
(a:as,b:bs) -> do
c <- f -< (a,b)
cs <- zipWith f -< (as,bs)
returnA -< c:cs
([],_) -> returnA -< []
(_,[]) -> returnA -< []
(a:as,b:bs) -> uncurry (:) ^<< f *** zipWith f -< ((a,b),(as,bs))
-- | Folds a computation over a list from left to right.
fold :: ArrowChoice c => c (a,x) a -> c ([x],a) a
......
......@@ -10,8 +10,8 @@ import Prelude hiding (lookup,map,Either(..),(**))
import Control.Arrow
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as H
import Data.Hashable
import Data.Order
import Data.Identifiable
......@@ -47,6 +47,7 @@ widening w (Map m1) (Map m2) = Map $ H.map join $ H.unionWith (E.widening (finit
Left (_,a) -> (May,a)
Right (_,b) -> (May,b)
LeftRight (t1,a) (t2,b) -> (t1 t2,a `w` b)
{-# INLINE widening #-}
{-# SCC widening #-}
instance (Identifiable a, PreOrd b) => LowerBounded (Map a b) where
......
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