data-reify 0.6.1 → 0.6.2

raw patch · 4 files changed

+139/−70 lines, 4 filesdep +hashabledep +unordered-containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hashable, unordered-containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +22/−1
• Data/Reify.hs +71/−35
• data-reify.cabal +41/−30
• test/Test2.hs +5/−4

@@ -1,2 +1,23 @@+## 0.6.2 [2020.09.30]+* Use `HashMap`s and `IntSet`s internally for slightly better performance.+ ## 0.6.1-* Fixed warnings in GHC 7.10+* Fix warnings in GHC 7.10.++## 0.5+* Merge the mono-typed and dynamic version again, by using 'DynStableName', an+  unphantomized version of StableName.++## 0.4+* Use 'Int' as a synonym for 'Unique' rather than 'Data.Unique' for node ids,+  by popular demand.++## 0.3+* Provide two versions of 'MuRef', the mono-typed version, for trees of a+  single type, and the dynamic-typed version, for trees of different types.++## 0.2+* Use 'StableName's, making `data-reify` much faster.++## 0.1+* Use unsafe pointer compares.

@@ -1,21 +1,30 @@-{-# LANGUAGE TypeFamilies, RankNTypes #-}+{-# LANGUAGE CPP, TypeFamilies, RankNTypes #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE BangPatterns #-} module Data.Reify (         MuRef(..),         module Data.Reify.Graph,-        reifyGraph+        reifyGraph,+        reifyGraphs         ) where  import Control.Applicative import Control.Concurrent.MVar -import Data.IntMap as M+import Data.HashMap.Lazy as M+import Data.Hashable as H import Data.Reify.Graph+import qualified Data.IntSet as S+#if !(MIN_VERSION_base(4,8,0))+import Data.Traversable+#endif  import System.Mem.StableName -import Unsafe.Coerce- import Prelude+#if __GLASGOW_HASKELL__ < 708+import Unsafe.Coerce+#endif  -- | 'MuRef' is a class that provided a way to reference into a specific type, -- and a way to map over the deferenced internals.@@ -23,9 +32,9 @@ class MuRef a where   type DeRef a :: * -> * -  mapDeRef :: (Applicative f) => -              (forall b . (MuRef b, DeRef a ~ DeRef b) => b -> f u) -                        -> a +  mapDeRef :: (Applicative f) =>+              (forall b . (MuRef b, DeRef a ~ DeRef b) => b -> f u)+                        -> a                         -> f (DeRef a u)  -- | 'reifyGraph' takes a data structure that admits 'MuRef', and returns a 'Graph' that contains@@ -35,55 +44,82 @@ reifyGraph m = do rt1 <- newMVar M.empty                   rt2 <- newMVar []                   uVar <- newMVar 0-                  root <- findNodes rt1 rt2 uVar m-                  pairs <- readMVar rt2-                  return (Graph pairs root)+                  reifyWithContext rt1 rt2 uVar m -findNodes :: (MuRef s) -          => MVar (IntMap [(DynStableName,Int)])  -          -> MVar [(Int,DeRef s Int)] +-- | 'reifyGraphs' takes a 'Traversable' container 't s' of a data structure 's'+-- admitting 'MuRef', and returns a 't (Graph (DeRef s))' with the graph nodes+-- resolved within the same context.+--+-- This allows for, e.g., a list of mutually recursive structures.+reifyGraphs :: (MuRef s, Traversable t) => t s -> IO (t (Graph (DeRef s)))+reifyGraphs coll = do rt1 <- newMVar M.empty+                      uVar <- newMVar 0+                      flip traverse coll $ \m -> do+                        rt2 <- newMVar []+                        reifyWithContext rt1 rt2 uVar m++reifyWithContext :: (MuRef s)+          => MVar (HashMap DynStableName Int)+          -> MVar [(Int,DeRef s Int)]           -> MVar Int-          -> s +          -> s+          -> IO (Graph (DeRef s))+reifyWithContext rt1 rt2 uVar j = do+  root <- findNodes rt1 rt2 uVar S.empty j+  pairs <- readMVar rt2+  return (Graph pairs root)++findNodes :: (MuRef s)+          => MVar (HashMap DynStableName Int)+          -> MVar [(Int,DeRef s Int)]+          -> MVar Int+          -> S.IntSet+          -> s           -> IO Int-findNodes rt1 rt2 uVar j | j `seq` True = do+findNodes rt1 rt2 uVar nodeSet !j = do         st <- makeDynStableName j         tab <- takeMVar rt1-        case mylookup st tab of+        case M.lookup st tab of           Just var -> do putMVar rt1 tab-                         return $ var-          Nothing -> +                         if var `S.member` nodeSet+                           then return var+                           else do res <- mapDeRef (findNodes rt1 rt2 uVar (S.insert var nodeSet)) j+                                   tab' <- takeMVar rt2+                                   putMVar rt2 $ (var,res) : tab'+                                   return var+          Nothing ->                     do var <- newUnique uVar-                       putMVar rt1 $ M.insertWith (++) (hashDynStableName st) [(st,var)] tab-                       res <- mapDeRef (findNodes rt1 rt2 uVar) j+                       putMVar rt1 $ M.insert st var tab+                       res <- mapDeRef (findNodes rt1 rt2 uVar (S.insert var nodeSet)) j                        tab' <- takeMVar rt2                        putMVar rt2 $ (var,res) : tab'                        return var-findNodes _ _ _ _ = error "findNodes: strictness seq function failed to return True" -mylookup :: DynStableName -> IntMap [(DynStableName,Int)] -> Maybe Int-mylookup h tab =-           case M.lookup (hashDynStableName h) tab of-             Just tab2 -> Prelude.lookup h [ (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'-  --- Stable names that not use phantom types.++-- Stable names that do not use phantom types. -- As suggested by Ganesh Sittampalam.-data DynStableName = DynStableName (StableName ())+-- Note: GHC can't unpack these because of the existential+-- quantification, but there doesn't seem to be much+-- potential to unpack them anyway.+data DynStableName = forall a. DynStableName !(StableName a) -hashDynStableName :: DynStableName -> Int-hashDynStableName (DynStableName sn) = hashStableName sn+instance Hashable DynStableName where+  hashWithSalt s (DynStableName n) = hashWithSalt s n  instance Eq DynStableName where-    (DynStableName sn1) == (DynStableName sn2) = sn1 == sn2+#if __GLASGOW_HASKELL__ >= 708+  DynStableName m == DynStableName n = eqStableName m n+#else+  DynStableName m == DynStableName n = m == unsafeCoerce n+#endif  makeDynStableName :: a -> IO DynStableName makeDynStableName a = do     st <- makeStableName a-    return $ DynStableName (unsafeCoerce st)+    return $ DynStableName st

@@ -1,46 +1,47 @@ Name:               data-reify-Version:            0.6.1+Version:            0.6.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-		    a type class instance. This gives an alternative to using 'Ref' for observable sharing.-		    .-		    Observable sharing in general is unsafe, so we use the IO monad to bound this effect,-		    but can be used safely even with 'unsafePerformIO' if some simple conditions are met.-		    Typically this package will be used to tie the knot with DSL's that depend of-		    observable sharing, like Lava.- 		    .-		    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.-		    .-		    History: -		    Version 0.1 used unsafe pointer compares.-		    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 used 'Int' as a synonym for 'Unique' rather than 'Data.Unique'-		    for node ids, by popular demand.-		    Version 0.5 merged the mono-typed and dynamic version again, by using -		    'DynStableName', an unphantomized version of StableName.-		    .-		    &#169; 2009 Andy Gill; BSD3 license.+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+                    a type class instance. This gives an alternative to using 'Ref' for observable sharing.+                    .+                    Observable sharing in general is unsafe, so we use the IO monad to bound this effect,+                    but can be used safely even with 'unsafePerformIO' if some simple conditions are met.+                    Typically this package will be used to tie the knot with DSL's that depend of+                    observable sharing, like Lava.+                    .+                    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.+                    .+                    &#169; 2009 Andy Gill; BSD3 license. -Category:            Language, Data, Parsing, Reflection +Category:            Language, Data, Parsing, Reflection License:             BSD3 License-file:        LICENSE Author:              Andy Gill Maintainer:          Andy Gill <andygill@ku.edu> Copyright:           (c) 2009 Andy Gill-Homepage:            http://www.ittc.ku.edu/csdl/fpg/Tools/IOReification+Homepage:            http://ku-fpg.github.io/software/data-reify/ Stability:           alpha build-type: 	     Simple-Cabal-Version:       >= 1.8+Cabal-Version:       >= 1.10+tested-with:         GHC == 7.0.4+                   , GHC == 7.2.2+                   , GHC == 7.4.2+                   , GHC == 7.6.3+                   , GHC == 7.8.4+                   , GHC == 7.10.3+                   , GHC == 8.0.2+                   , GHC == 8.2.2+                   , GHC == 8.4.4+                   , GHC == 8.6.5+                   , GHC == 8.8.3+                   , GHC == 8.10.1 extra-source-files:  CHANGELOG.md, README.md  source-repository head   type:        git-  location:    git://github.com/ku-fpg/data-reify+  location:    https://github.com/ku-fpg/data-reify  Flag tests   Description: Enable full development tree@@ -48,17 +49,21 @@   Library-  Build-Depends: base >= 4 && < 5, containers+  Build-Depends: base >= 4 && < 5, hashable, containers, unordered-containers   Exposed-modules:        Data.Reify,        Data.Reify.Graph   Ghc-Options:  -Wall+  if impl(ghc >= 8.6)+    ghc-options: -Wno-star-is-type+  default-language: Haskell2010  Executable data-reify-test1   Build-Depends:  base, data-reify   Main-Is:        Test1.hs   Hs-Source-Dirs: test   ghc-options:    -Wall+  default-language: Haskell2010   if !flag(tests)     buildable: False @@ -68,6 +73,7 @@   Main-Is:        Test2.hs   Hs-Source-Dirs: test   ghc-options:    -Wall+  default-language: Haskell2010   if !flag(tests)     buildable: False @@ -76,6 +82,7 @@   Main-Is:        Test3.hs   Hs-Source-Dirs: test   ghc-options:    -Wall+  default-language: Haskell2010   if !flag(tests)     buildable: False @@ -84,6 +91,7 @@   Main-Is:        Test4.hs   Hs-Source-Dirs: test   ghc-options:    -Wall+  default-language: Haskell2010   if !flag(tests)     buildable: False @@ -92,6 +100,7 @@   Main-Is:        Test5.hs   Hs-Source-Dirs: test   ghc-options:    -Wall+  default-language: Haskell2010   if !flag(tests)     buildable: False @@ -100,6 +109,7 @@   Main-Is:        Test6.hs   Hs-Source-Dirs: test   ghc-options:    -Wall+  default-language: Haskell2010   if !flag(tests)     buildable: False @@ -108,5 +118,6 @@   Main-Is:        Test7.hs   Hs-Source-Dirs: test   ghc-options:    -Wall+  default-language: Haskell2010   if !flag(tests)     buildable: False

@@ -29,13 +29,14 @@    fmap f (StateDeRef a tr) = StateDeRef a [ (b,f s) | (b,s) <- tr ]  main :: IO ()-main = reifyGraph s0 >>= print-        +main = do reifyGraph s0 >>= print+          reifyGraphs [s0, s1] >>= print+ {- Alt:  data State s i o = State s [(i,o,State s i o)]         deriving Show-        + state :: s -> State s i o state s = State s [] @@ -50,5 +51,5 @@         deriving Show  -}-     +