fix fixpoint algo

lib/src/Control/Arrow/Transformer/Abstract/Fixpoint.hs

@@ -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''')

lib/src/Control/Arrow/Utils.hs

@@ -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

lib/src/Data/Abstract/Map.hs

@@ -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