intern 0.1 → 0.2.0

raw patch · 5 files changed

+66/−84 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/ByteString/Interned.hs +8/−6
• Data/Interned.hs +1/−0
• Data/Interned/Internal.hs +8/−77
• Data/String/Interned.hs +47/−0
• intern.cabal +2/−1

@@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies, FlexibleInstances #-} module Data.ByteString.Interned-  ( InternedByteString+  ( InternedByteString(..)   ) where  import Data.String@@ -10,7 +10,7 @@ import Data.Hashable import Data.Function (on) -data InternedByteString = IBS +data InternedByteString = InternedByteString    {-# UNPACK #-} !(Id InternedByteString)   {-# UNPACK #-} !ByteString @@ -24,17 +24,19 @@   compare = compare `on` identity  instance Show InternedByteString where-  showsPrec d (IBS _ b) = showsPrec d b+  showsPrec d (InternedByteString _ b) = showsPrec d b  instance Interned InternedByteString where   type Uninterned InternedByteString = ByteString   data Description InternedByteString = DBS {-# UNPACK #-} !ByteString     deriving (Eq)    describe = DBS-  unintern (IBS _ b) = b -  identify = IBS-  identity (IBS i _) = i+  identify = InternedByteString+  identity (InternedByteString i _) = i   cache = ibsCache++instance Uninternable InternedByteString where+  unintern (InternedByteString _ b) = b   instance Hashable (Description InternedByteString) where   hash (DBS h) = hash h

@@ -1,5 +1,6 @@ module Data.Interned   ( Interned(..)+  , Uninternable(..)   , mkCache   , Cache   , Id(..)

@@ -2,8 +2,10 @@            , FlexibleInstances            , FlexibleContexts            , GeneralizedNewtypeDeriving #-}+ module Data.Interned.Internal   ( Interned(..)+  , Uninternable(..)   , mkCache   , Cache(..)   , CacheState(..)@@ -18,7 +20,9 @@ import GHC.IO (unsafeDupablePerformIO, unsafePerformIO) import System.Mem.Weak -data CacheState t = CacheState {-# UNPACK #-} !(Id t) (HashMap (Description t) (Weak t))+data CacheState t = CacheState +   {-# UNPACK #-} !(Id t) +   !(HashMap (Description t) (Weak t))  newtype Cache t = Cache { getCache :: MVar (CacheState t) } @@ -37,11 +41,13 @@   data Description t   type Uninterned t   describe :: Uninterned t -> Description t -  unintern :: t -> Uninterned t   identify :: Id t -> Uninterned t -> t   identity :: t -> Id t   cache    :: Cache t +class Interned t => Uninternable t where+  unintern :: t -> Uninterned t+ intern :: Interned t => Uninterned t -> t intern bt = unsafeDupablePerformIO $ modifyMVar (getCache cache) go    where@@ -58,78 +64,3 @@              return (CacheState (i + 1) (HashMap.insert dt wt m), t)   remove = modifyMVar_ (getCache cache) $      \ (CacheState i m) -> return $ CacheState i (HashMap.delete dt m)--{--type Var = Int--data Term-  = App {-# UNPACK #-} !(Id Term) !Term !Term-  | Lam {-# UNPACK #-} !(Id Term) {-# UNPACK #-} !Var !Term !Term-  | Pi  {-# UNPACK #-} !(Id Term) {-# UNPACK #-} !Var !Term !Term-  | Set {-# UNPACK #-} !(Id Term) {-# UNPACK #-} !Int-  deriving Show-data UninternedTerm -  = BApp Term Term-  | BLam Var Term Term -  | BPi  Var Term Term-  | BSet Int deriving Show-instance Interned Term where-  type Uninterned Term = UninternedTerm-  data Description Term = DApp (Id Term) (Id Term)-                 | DLam Var (Id Term) (Id Term)-                 | DPi  Var (Id Term) (Id Term)-                 | DSet Int deriving Show-  describe (BApp f a)   = DApp (identity f) (identity a) -  describe (BLam v t e) = DLam v (identity t) (identity e)-  describe (BPi v t e)  = DPi v (identity t) (identity e)-  describe (BSet n) = DSet n-  identify i = go where-    go (BApp f a) = App i f a -    go (BLam v t e) = Lam i v t e-    go (BPi v t e) = Pi i v t e-    go (BSet n) = Set i n-  identity (App i _ _) = i-  identity (Lam i _ _ _) = i-  identity (Pi i _ _ _) = i-  identity (Set i _) = i-  unintern (App _ f a) = BApp f a-  unintern (Lam _ v t e) = BLam v t e-  unintern (Pi _ v t e) = BPi v t e-  unintern (Set _ n) = BSet n-  cache = termCache--termCache :: Cache Term-termCache = mkCache-{-# NOINLINE termCache #-}--instance Eq (Description Term) where-  DApp f a     == DApp f' a'    = f == f' && a == a'-  DLam v t e   == DLam v' t' e' = v == v' && t == t' && e == e'-  DPi v t e    == DPi v' t' e'  = v == v' && t == t' && e == e'-  DSet n       == DSet n'       = n == n'-  _            == _             = False--instance Hashable (Description Term) where-  hash (DApp f a)   = 0 `hashWithSalt` f `hashWithSalt` a-  hash (DLam v t e) = 1 `hashWithSalt` v `hashWithSalt` t `hashWithSalt` e-  hash (DPi v t e)  = 2 `hashWithSalt` v `hashWithSalt` t `hashWithSalt` e-  hash (DSet n)     = 3 `hashWithSalt` n--instance Eq Term where-  (==) = (==) `on` identity--instance Ord Term where-  compare = compare `on` identity--app :: Term -> Term -> Term-app a b = intern (BApp a b)--lam :: Var -> Term -> Term -> Term-lam v t e = intern (BLam v t e)--pi :: Var -> Term -> Term -> Term-pi v t e = intern (BPi v t e)--set :: Int -> Term-set i = intern (BSet i)--}

@@ -0,0 +1,47 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances #-}+module Data.String.Interned+  ( InternedString(..)+  ) where++import Data.String+import Data.Interned+import Data.Hashable+import Data.Foldable+import Data.Function (on)++data InternedString = IS +  {-# UNPACK #-} !(Id InternedString)+  String++instance IsString InternedString where+  fromString = intern++instance Eq InternedString where+  (==) = (==) `on` identity++instance Ord InternedString where+  compare = compare `on` identity++instance Show InternedString where+  showsPrec d (IS _ b) = showsPrec d b++instance Interned InternedString where+  type Uninterned InternedString = String+  data Description InternedString = Cons {-# UNPACK #-} !Char String | Nil+    deriving (Eq) +  describe (c:cs) = Cons c cs+  describe []     = Nil+  identify = IS+  identity (IS i _) = i+  cache = stringCache++instance Uninternable InternedString where+  unintern (IS _ b) = b ++instance Hashable (Description InternedString) where+  hash (Cons c s) = foldl' hashWithSalt (hashWithSalt 0 c) s+  hash Nil        = 0++stringCache :: Cache InternedString+stringCache = mkCache+{-# NOINLINE stringCache #-}

@@ -1,6 +1,6 @@ name:          intern category:      Data, Data Structures-version:       0.1+version:       0.2.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -28,5 +28,6 @@     Data.Interned     Data.Interned.Internal     Data.ByteString.Interned+    Data.String.Interned    ghc-options: -Wall