data-reify 0.1 → 0.2
raw patch · 3 files changed
+45/−25 lines, 3 filesdep +containersdep −ghc-primdep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: containers
Dependencies removed: ghc-prim
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Data/Unsafe/Reify.hs +24/−21
- data-reify.cabal +4/−2
- test/Test4.hs +17/−2
Data/Unsafe/Reify.hs view
@@ -1,17 +1,15 @@-{-# LANGUAGE MagicHash, UndecidableInstances, TypeFamilies #-}+{-# LANGUAGE UndecidableInstances, TypeFamilies #-} module Data.Unsafe.Reify ( MuRef(..), Graph(..), reifyGraph ) where -import GHC.Exts (Int(I#))-import GHC.Prim (reallyUnsafePtrEquality#, (/=#)) import Control.Concurrent.MVar import Control.Monad import Data.Unique--+import System.Mem.StableName+import Data.IntMap as M -- | 'MuRef' is a class that provided a way to reference into a specific type, -- and a way to map over the deferenced internals.@@ -22,11 +20,9 @@ mapDeRef :: (Monad m) => (a -> m Unique) -> (DeRef a) a -> m (DeRef a Unique) - -- '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 - instance (Functor e,Show (e Int)) => Show (Graph e) where show (Graph netlist start) = "let " ++ show [ (hashUnique u,fmap hashUnique e) | (u,e) <- netlist @@ -36,29 +32,36 @@ -- the dereferenced nodes, with their children as 'Unique' rather than recursive values. reifyGraph :: (MuRef s) => s -> IO (Graph (DeRef s))-reifyGraph m = do rt1 <- newMVar []+reifyGraph m = do rt1 <- newMVar empty rt2 <- newMVar [] root <- findNodes rt1 rt2 m pairs <- readMVar rt2 return (Graph pairs root) -findNodes :: (MuRef s) => MVar [(Unique,s)] -> MVar [(Unique,DeRef s Unique)] -> s -> IO Unique+findNodes :: (MuRef s) + => MVar (IntMap [(StableName s,Unique)]) + -> MVar [(Unique,DeRef s Unique)] + -> s + -> IO Unique findNodes rt1 rt2 j = do+ st <- makeStableName j tab <- takeMVar rt1- case [ m | (m,i) <- tab, j `seq` i `seq` (j `eq` i) ] of- (var:_) -> do putMVar rt1 tab- return $ var- [] -> do var <- newUnique- let e = deRef j - putMVar rt1 $ (var,j) : tab+ case mylookup st tab of+ Just var -> do putMVar rt1 tab+ return $ var+ Nothing -> + do var <- newUnique+ let e = deRef j+ putMVar rt1 $ M.insertWith (++) (hashStableName st) [(st,var)] tab res <- mapDeRef (findNodes rt1 rt2) e tab' <- takeMVar rt2 putMVar rt2 $ (var,res) : tab' return var- --- Dangerous, dangerous stuff.-eq :: a -> a -> Bool-eq a b = reallyUnsafePtrEquality# a b /=# 0#-- + where+ mylookup h tab = + case M.lookup (hashStableName h) tab of+ Just tab2 -> case Prelude.lookup h tab2 of+ Just uq -> Just uq+ Nothing -> Nothing+ Nothing -> Nothing
data-reify.cabal view
@@ -1,5 +1,5 @@ Name: data-reify-Version: 0.1+Version: 0.2 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,6 +13,8 @@ Providing an instance for 'MuRef' is the mechanism for allowing a structure to be reified into a graph, and four examples of this are provided. .+ Version 0.2 of data-reify uses 'StableName's, and is much faster.+ . © 2009 Andy Gill; BSD3 license. Category: Language, Data, Parsing, Reflection @@ -27,7 +29,7 @@ Cabal-Version: >= 1.6 Library- Build-Depends: base, ghc-prim+ Build-Depends: base, containers Exposed-modules: Data.Unsafe.Reify Ghc-Options: -Wall
test/Test4.hs view
@@ -8,13 +8,14 @@ import Control.Applicative hiding (Const) import Data.Unique -import Data.Unsafe.Reify -- Should this is Unsafe.Reify??+import Data.Unsafe.Reify import Control.Monad+import System.CPUTime data List a b = Nil | Cons a b deriving Show- + instance MuRef [a] where type DeRef [a] = List a deRef [] = Nil@@ -32,3 +33,17 @@ reifyGraph g1 >>= print let g2 = [1..10] ++ g2 reifyGraph g2 >>= print++ -- now, some timings.+ ns <- sequence [ timeme n | n <- take 8 (iterate (*2) 1024) ]+ print $ reverse $ take 4 $ reverse [ n2 / n1 | (n1,n2) <- zip ns (tail ns) ]++timeme n = do+ i <- getCPUTime+ let g3 = [1..n] ++ g3+ reifyGraph g3 >>= \ (Graph xs _) -> putStr $ show (length xs)+ j <- getCPUTime+ let n :: Float+ n = fromIntegral ((j - i) `div` 1000000000)+ putStrLn $ " ==> " ++ show (n / 1000) + return n