data-fix-cse 0.0.1 → 0.0.2

raw patch · 3 files changed

+111/−2 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• data-fix-cse.cabal +2/−1
• src/Data/Fix/BiMapFramed.hs +70/−0
• src/Data/Fix/Cse.hs +39/−1

@@ -1,5 +1,5 @@ Name:            data-fix-cse-Version:         0.0.1+Version:         0.0.2 Cabal-Version:   >= 1.6 License:         BSD3 License-file:    LICENSE@@ -35,3 +35,4 @@       Data.Fix.Cse   Other-Modules:         Data.Fix.BiMap+      Data.Fix.BiMapFramed

@@ -0,0 +1,70 @@+-- Establishing a bijection between the values of the type a and integers, with+-- the operations to retrieve the value given its key,+-- to find the key for the existing value, and to extend the +-- bijection with a new association.++-- The type 'a' of values should at least permit equality comparison;+-- In the present implementation, we require 'a' to be a member+-- of Ord.++-- There are many ways to implement bi-maps, for example, using hash tables,+-- or maps.+-- Our implementation uses Data.Map and Data.IntMap to record+-- both parts of the association.++module Data.Fix.BiMapFramed (+	      BiMap, empty, getDag,+	      lookup_key, +	      lookup_val,+	      startFrame, stopFrame, nextFrame,   +	      insert,+	      size,+	     )+    where++import Data.Maybe+import qualified Data.Map    as M+import qualified Data.IntMap as IM++data BiMap a = BiMap [M.Map a Int] (IM.IntMap a)++startFrame :: BiMap a -> BiMap a+startFrame (BiMap ms im) = BiMap (M.empty : ms) im++stopFrame :: BiMap a -> BiMap a+stopFrame (BiMap ms im) = BiMap (if (null ms) then [M.empty] else tail ms) im++nextFrame :: BiMap a -> BiMap a+nextFrame = startFrame . stopFrame++getDag :: BiMap a -> IM.IntMap a+getDag (BiMap _ a) = a++lookup_key :: Ord a => a -> BiMap a -> Maybe Int+lookup_key e (BiMap ms _) = case dropWhile isNothing $ fmap (M.lookup e) ms of+	Just a : [] -> Just a+	_           -> Nothing++-- Find a value for a key+lookup_val :: Int -> BiMap a -> a+lookup_val k (BiMap _ m) = m IM.! k++-- Insert the value and return the corresponding key+-- and the new map+-- Alas, Map interface does not have an operation to insert and find the index +-- at the same time (although such an operation is easily possible)+insert :: Ord a => a -> BiMap a -> (Int, BiMap a)+insert v (BiMap (m:ms) im) = (k, BiMap (m':ms) im')+ where m'  = M.insert v k m+       im' = IM.insert k v im+       k   = IM.size im++empty :: BiMap a+empty = BiMap [M.empty] (IM.empty)++instance Show a => Show (BiMap a) where+    show (BiMap _ m) =  "BiMap" ++ show (IM.toList m)++size :: BiMap a -> Int+size (BiMap _ m) = IM.size m+

@@ -10,7 +10,16 @@     -- * Explicit sharing     letCse, Let(..),     letCata, letCataM,-    letWrapper+    letWrapper,++    -- * Framed sharing+    -- | If your EDSL contains imperative if-the-else blocks+    -- we need to use special version of the CSE. It allocates+    -- frames per each if- or else block. So that variables+    -- from different if-the-else branches don't get messed up.+    -- We need to allocate a new frame for each branch.+    -- We can do it with special structure @FrameInfo@.    +    FrameInfo(..), cseFramed ) where  import Control.Applicative hiding (empty)@@ -22,6 +31,7 @@ import Control.Monad.Trans.Class(lift)  import Data.Fix.BiMap+import qualified Data.Fix.BiMapFramed as F  type VarName = Int @@ -102,5 +112,33 @@   m <- get   case lookup_key e m of     Nothing -> let (k,m') = insert e m+               in  put m' >> return k+    Just k  -> return k+++-- | Marker type for creation frames of variables.+-- Start new frame when if-block starts, create next frame+-- when you go into the next branch of the same block (with else ir elif),+-- stop frame when leaving the if-then-else block. Use no frame for all +-- other expressions.+data FrameInfo = NoFrame | StartFrame | StopFrame | NextFrame+  deriving (Show, Eq, Ord)++-- | Performs common subexpression elimination with implicit sharing using information of frames.  +-- It doesn't share the variables in different branches of imperative if-then-else block.+cseFramed :: (Eq (f Int), Ord (f Int), Traversable f) => (f Int -> FrameInfo) -> Fix f -> Dag f+cseFramed getFrameInfo x = F.getDag $ execState (cataM (hashconsFramed getFrameInfo) x) F.empty++hashconsFramed :: (Ord a) => (a -> FrameInfo) -> a -> State (F.BiMap a) Int+hashconsFramed getFrameInfo e = do+  m' <- get+  let m = case getFrameInfo e of+        NoFrame    -> m'+        StartFrame -> F.startFrame m'+        StopFrame  -> F.stopFrame m'+        NextFrame  -> F.nextFrame m'      ++  case F.lookup_key e m of+    Nothing -> let (k,m') = F.insert e m                in  put m' >> return k     Just k  -> return k