Skip to content

Commit

Permalink
Add Lift instances
Browse files Browse the repository at this point in the history
Closes #342
  • Loading branch information
treeowl committed Dec 21, 2021
1 parent c481228 commit 201b476
Show file tree
Hide file tree
Showing 4 changed files with 30 additions and 8 deletions.
15 changes: 10 additions & 5 deletions Data/HashMap/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,10 +1,14 @@
{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# 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 @@ -180,6 +184,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 @@ -189,7 +194,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 @@ -215,7 +220,7 @@ data HashMap k v
| Leaf !Hash !(Leaf k v)
| Full !(A.Array (HashMap k v))
| Collision !Hash !(A.Array (Leaf k v))
deriving (Typeable)
deriving (Typeable, TH.Lift)

type role HashMap nominal representational

Expand Down
13 changes: 13 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 @@ -84,6 +85,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 +477,16 @@ fromList n xs0 =
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
7 changes: 5 additions & 2 deletions Data/HashSet/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
{-# LANGUAGE CPP, DeriveDataTypeable #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE Trustworthy #-}
Expand Down Expand Up @@ -114,11 +116,12 @@ 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 (Typeable)
} deriving (Typeable, 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 201b476

Please sign in to comment.