diff --git a/Data/Dynamic/Reify.hs b/Data/Dynamic/Reify.hs --- a/Data/Dynamic/Reify.hs +++ b/Data/Dynamic/Reify.hs @@ -21,7 +21,6 @@ import Control.Concurrent.MVar import Control.Monad -import Data.Unique import System.Mem.StableName import Data.IntMap as M import Data.Dynamic @@ -44,36 +43,48 @@ -> f (DeRef a u) -- | 'reifyGraph' takes a data structure that admits 'MuRef', and returns a 'Graph' that contains --- the dereferenced nodes, with their children as 'Unique' rather than recursive values. +-- the dereferenced nodes, with their children as 'Int' rather than recursive values. reifyGraph :: (MuRef s, Typeable s) => s -> IO (Graph (DeRef s)) reifyGraph m = do rt1 <- newMVar M.empty rt2 <- newMVar [] - root <- findNodes rt1 rt2 m + uVar <- newMVar 0 + root <- findNodes rt1 rt2 uVar m pairs <- readMVar rt2 return (Graph pairs root) findNodes :: (MuRef s, Typeable s) - => MVar (IntMap [(Dynamic,Unique)]) -- Dynamic of StableNames - -> MVar [(Unique,DeRef s Unique)] + => MVar (IntMap [(Dynamic,Int)]) -- Dynamic of StableNames + -> MVar [(Int,DeRef s Int)] + -> MVar Int -> s - -> IO Unique -findNodes rt1 rt2 j | j `seq` True = do + -> IO Int +findNodes rt1 rt2 uVar j | j `seq` True = do st <- makeStableName j tab <- takeMVar rt1 case mylookup st tab of Just var -> do putMVar rt1 tab return $ var Nothing -> - do var <- newUnique + do var <- newUnique uVar putMVar rt1 $ M.insertWith (++) (hashStableName st) [(toDyn st,var)] tab - res <- mapDeRef (findNodes rt1 rt2) j + res <- mapDeRef (findNodes rt1 rt2 uVar) j tab' <- takeMVar rt2 putMVar rt2 $ (var,res) : tab' return var -mylookup :: (Typeable a) => StableName a -> IntMap [(Dynamic,Unique)] -> Maybe Unique +mylookup :: (Typeable a) => StableName a -> IntMap [(Dynamic,Int)] -> Maybe Int mylookup h tab = case M.lookup (hashStableName h) tab of Just tab2 -> Prelude.lookup (Just h) [ (fromDynamic c,u) | (c,u) <- tab2 ] Nothing -> Nothing + +newUnique :: MVar Int -> IO Int +newUnique var = do + v <- takeMVar var + let v' = succ v + putMVar var v' + return v' + + + diff --git a/Data/Reify.hs b/Data/Reify.hs --- a/Data/Reify.hs +++ b/Data/Reify.hs @@ -7,7 +7,6 @@ import Control.Concurrent.MVar import Control.Monad -import Data.Unique import System.Mem.StableName import Data.IntMap as M @@ -27,31 +26,33 @@ -- | 'reifyGraph' takes a data structure that admits 'MuRef', and returns a 'Graph' that contains --- the dereferenced nodes, with their children as 'Unique' rather than recursive values. +-- the dereferenced nodes, with their children as 'Int' rather than recursive values. reifyGraph :: (MuRef s) => s -> IO (Graph (DeRef s)) reifyGraph m = do rt1 <- newMVar M.empty rt2 <- newMVar [] - root <- findNodes rt1 rt2 m + uVar <- newMVar 0 + root <- findNodes rt1 rt2 uVar m pairs <- readMVar rt2 return (Graph pairs root) findNodes :: (MuRef s) - => MVar (IntMap [(StableName s,Unique)]) -- Dynamic of StableNames - -> MVar [(Unique,DeRef s Unique)] + => MVar (IntMap [(StableName s,Int)]) -- Dynamic of StableNames + -> MVar [(Int,DeRef s Int)] + -> MVar Int -> s - -> IO Unique -findNodes rt1 rt2 j | j `seq` True = do + -> IO Int +findNodes rt1 rt2 uVar j | j `seq` True = do st <- makeStableName j tab <- takeMVar rt1 case mylookup st tab of Just var -> do putMVar rt1 tab return $ var Nothing -> - do var <- newUnique + do var <- newUnique uVar putMVar rt1 $ M.insertWith (++) (hashStableName st) [(st,var)] tab - res <- mapDeRef (findNodes rt1 rt2) j + res <- mapDeRef (findNodes rt1 rt2 uVar) j tab' <- takeMVar rt2 putMVar rt2 $ (var,res) : tab' return var @@ -60,3 +61,11 @@ case M.lookup (hashStableName h) tab of Just tab2 -> Prelude.lookup h tab2 Nothing -> Nothing + + +newUnique :: MVar Int -> IO Int +newUnique var = do + v <- takeMVar var + let v' = succ v + putMVar var v' + return v' diff --git a/Data/Reify/Graph.hs b/Data/Reify/Graph.hs --- a/Data/Reify/Graph.hs +++ b/Data/Reify/Graph.hs @@ -14,17 +14,23 @@ module Data.Reify.Graph ( Graph(..), + Unique ) where -import Data.Unique +-- | 'Graph' is a basic graph structure over nodes of the higher kind 'e', with a single root. +-- There is an assumption that there is no Unique used in a node which does not have a +-- corresponding entry is the association list. +-- The idea with this structure is that it is trivial to convert into an 'Array', +-- 'IntMap', or into a Martin Erwig's Functional Graph, as required. --- 'Graph' is a basic graph structure over nodes of the higher kind 'e', with a single root. data Graph e = Graph [(Unique,e Unique)] Unique +type Unique = Int + -- | If 'e' is s Functor, and 'e' is 'Show'-able, then we can 'Show' a 'Graph'. -instance (Functor e,Show (e Int)) => Show (Graph e) where - show (Graph netlist start) = "let " ++ show [ (hashUnique u,fmap hashUnique e) +instance (Show (e Int)) => Show (Graph e) where + show (Graph netlist start) = "let " ++ show [ (u,e) | (u,e) <- netlist - ] ++ " in " ++ show (hashUnique start) + ] ++ " in " ++ show start diff --git a/data-reify.cabal b/data-reify.cabal --- a/data-reify.cabal +++ b/data-reify.cabal @@ -1,5 +1,5 @@ Name: data-reify -Version: 0.3 +Version: 0.4 Synopsis: Reify a recursive data structure into an explicit graph. Description: 'data-reify' provided the ability to turn recursive structures into explicit graphs. Many (implicitly or explicitly) recursive data structure can be given this ability, via @@ -13,9 +13,12 @@ Providing an instance for 'MuRef' is the mechanism for allowing a structure to be reified into a graph, and several examples of this are provided. . - Version 0.2 of 'data-reify' uses 'StableName's, and is much faster. - Version 0.3 provided two versions of 'MuRef', the mono-typed version, for trees of a single type, + Version 0.2 of 'data-reify' used 'StableName's, and was much faster. + Version 0.3 provided two versions of 'MuRef', the mono-typed version, + for trees of a single type, and the dynamic-typed version, for trees of different types. + Version 0.4 uses 'Int' as a synonym for 'Unique' rather than 'Data.Unique' + for node ids, by popular demand. . © 2009 Andy Gill; BSD3 license. @@ -31,7 +34,7 @@ Cabal-Version: >= 1.6 Library - Build-Depends: base, containers + Build-Depends: base >= 3 && < 4.2, containers Exposed-modules: Data.Reify, Data.Dynamic.Reify, diff --git a/test/Test4.hs b/test/Test4.hs --- a/test/Test4.hs +++ b/test/Test4.hs @@ -6,7 +6,6 @@ import Data.Monoid --import Control.Monad import Control.Applicative hiding (Const) -import Data.Unique import Data.Reify import Control.Monad diff --git a/test/Test5.hs b/test/Test5.hs --- a/test/Test5.hs +++ b/test/Test5.hs @@ -5,7 +5,6 @@ import qualified Data.Foldable as F import Data.Monoid import Control.Applicative hiding (Const) -import Data.Unique import Data.Dynamic.Reify import Data.Dynamic diff --git a/test/Test6.hs b/test/Test6.hs --- a/test/Test6.hs +++ b/test/Test6.hs @@ -6,13 +6,13 @@ import Data.Monoid --import Control.Monad import Control.Applicative hiding (Const) -import Data.Unique import Data.Dynamic.Reify import Control.Monad import System.CPUTime import Data.Typeable import Control.Exception as E + import Data.Dynamic