Skip to content

Commit

Permalink
Add Lift instances
Browse files Browse the repository at this point in the history
  • Loading branch information
treeowl committed Dec 22, 2021
1 parent bd165b0 commit 3b83b78
Show file tree
Hide file tree
Showing 4 changed files with 40 additions and 5 deletions.
13 changes: 9 additions & 4 deletions Data/HashMap/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,10 +1,13 @@
{-# LANGUAGE BangPatterns, CPP, MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE LambdaCase #-}
#if __GLASGOW_HASKELL__ >= 802
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UnboxedSums #-}
Expand Down Expand Up @@ -179,6 +182,7 @@ import GHC.Exts (TYPE, Int (..), Int#)
import Data.Functor.Identity (Identity (..))
import Control.Applicative (Const (..))
import Data.Coerce (coerce)
import qualified Language.Haskell.TH.Syntax as TH

-- | A set of values. A set cannot contain duplicate values.
------------------------------------------------------------------------
Expand All @@ -188,7 +192,7 @@ hash :: H.Hashable a => a -> Hash
hash = fromIntegral . H.hash

data Leaf k v = L !k v
deriving (Eq)
deriving (Eq, TH.Lift)

instance (NFData k, NFData v) => NFData (Leaf k v) where
rnf (L k v) = rnf k `seq` rnf v
Expand All @@ -214,6 +218,7 @@ data HashMap k v
| Leaf !Hash !(Leaf k v)
| Full !(A.Array (HashMap k v))
| Collision !Hash !(A.Array (Leaf k v))
deriving (TH.Lift)

type role HashMap nominal representational

Expand Down
25 changes: 25 additions & 0 deletions Data/HashMap/Internal/Array.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples, ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}

Expand Down Expand Up @@ -69,6 +70,7 @@ module Data.HashMap.Internal.Array
, traverse'
, toList
, fromList
, fromList'
) where

import Control.Applicative (liftA2)
Expand All @@ -84,6 +86,8 @@ import GHC.Exts (SmallArray#, newSmallArray#, readSmallArray#, writeSmallArray#,
SmallMutableArray#, sizeofSmallArray#, copySmallArray#, thawSmallArray#,
sizeofSmallMutableArray#, copySmallMutableArray#, cloneSmallMutableArray#)

import qualified Language.Haskell.TH.Syntax as TH

#if defined(ASSERTS)
import qualified Prelude
#endif
Expand Down Expand Up @@ -474,6 +478,27 @@ fromList n xs0 =
go (x:xs) mary i = do write mary i x
go xs mary (i+1)

fromList' :: Int -> [a] -> Array a
fromList' n xs0 =
CHECK_EQ("fromList'", n, Prelude.length xs0)
run $ do
mary <- new_ n
go xs0 mary 0
where
go [] !mary !_ = return mary
go (!x:xs) mary i = do write mary i x
go xs mary (i+1)

instance TH.Lift a => TH.Lift (Array a) where
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped ar = [|| fromList' arlen arlist ||]
#else
lift ar = [| fromList' arlen arlist |]
#endif
where
arlen = length ar
arlist = toList ar

toList :: Array a -> [a]
toList = foldr (:) []

Expand Down
4 changes: 4 additions & 0 deletions Data/HashSet/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
Expand Down Expand Up @@ -113,11 +115,13 @@ import qualified Data.Hashable.Lifted as H
#if MIN_VERSION_deepseq(1,4,3)
import qualified Control.DeepSeq as NF
#endif
import qualified Language.Haskell.TH.Syntax as TH

-- | A set of values. A set cannot contain duplicate values.
newtype HashSet a = HashSet {
asMap :: HashMap a ()
}
} deriving (TH.Lift)

type role HashSet nominal

Expand Down
3 changes: 2 additions & 1 deletion unordered-containers.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,8 @@ library
build-depends:
base >= 4.9 && < 5,
deepseq >= 1.1,
hashable >= 1.0.1.1 && < 1.5
hashable >= 1.0.1.1 && < 1.5,
template-haskell

default-language: Haskell2010

Expand Down

0 comments on commit 3b83b78

Please sign in to comment.