Skip to content

Commit

Permalink
Make worky with PTC. Remove Template Haskell stuff.
Browse files Browse the repository at this point in the history
  • Loading branch information
ahubers committed May 19, 2022
1 parent bcd43ea commit 8a22d0d
Show file tree
Hide file tree
Showing 10 changed files with 41 additions and 26 deletions.
21 changes: 12 additions & 9 deletions Data/HashMap/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,8 @@
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UnboxedSums #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE PartialTypeConstructors #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}

Expand Down Expand Up @@ -167,6 +169,7 @@ import GHC.Stack (HasCallStack)
import Prelude hiding (filter, foldl, foldr, lookup, map,
null, pred)
import Text.Read hiding (step)
import GHC.Types (Total, type(@))

import qualified Data.Data as Data
import qualified Data.Foldable as Foldable
Expand All @@ -176,7 +179,7 @@ import qualified Data.Hashable.Lifted as H
import qualified Data.HashMap.Internal.Array as A
import qualified Data.List as List
import qualified GHC.Exts as Exts
import qualified Language.Haskell.TH.Syntax as TH
-- import qualified Language.Haskell.TH.Syntax as TH

-- | Convenience function. Compute a hash value for the given value.
hash :: H.Hashable a => a -> Hash
Expand All @@ -189,12 +192,12 @@ instance (NFData k, NFData v) => NFData (Leaf k v) where
rnf (L k v) = rnf k `seq` rnf v

-- | @since 0.2.17.0
instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where
#if MIN_VERSION_template_haskell(2,16,0)
liftTyped (L k v) = [|| L k $! v ||]
#else
lift (L k v) = [| L k $! v |]
#endif
-- instance (TH.Lift k, TH.Lift v) => TH.Lift (Leaf k v) where
-- #if MIN_VERSION_template_haskell(2,16,0)
-- liftTyped (L k v) = [|| L k $! v ||]
-- #else
-- lift (L k v) = [| L k $! v |]
-- #endif

-- | @since 0.2.14.0
instance NFData k => NFData1 (Leaf k) where
Expand Down Expand Up @@ -248,7 +251,7 @@ data HashMap k v
type role HashMap nominal representational

-- | @since 0.2.17.0
deriving instance (TH.Lift k, TH.Lift v) => TH.Lift (HashMap k v)
-- deriving instance (TH.Lift k, TH.Lift v) => TH.Lift (HashMap k v)

instance (NFData k, NFData v) => NFData (HashMap k v) where
rnf Empty = ()
Expand Down Expand Up @@ -1768,7 +1771,7 @@ map f = mapWithKey (const f)
-- associated with the keys involved will depend in an unspecified way on
-- their insertion order.
traverseWithKey
:: Applicative f
:: (Total f, Applicative f)
=> (k -> v1 -> f v2)
-> HashMap k v1 -> f (HashMap k v2)
traverseWithKey f = go
Expand Down
21 changes: 11 additions & 10 deletions Data/HashMap/Internal/Array.hs
Original file line number Diff line number Diff line change
Expand Up @@ -102,7 +102,7 @@ import Prelude hiding (all, filter, foldMap, foldl, foldr, length,
map, read, traverse)

import qualified GHC.Exts as Exts
import qualified Language.Haskell.TH.Syntax as TH
-- import qualified Language.Haskell.TH.Syntax as TH
#if defined(ASSERTS)
import qualified Prelude
#endif
Expand Down Expand Up @@ -522,15 +522,16 @@ fromList' n xs0 =
go xs mary (i+1)

-- | @since 0.2.17.0
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
-- 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 :: Int
-- arlen = I# (sizeofSmallArray# (unArray ar))
-- arlist = toList ar

toList :: Array a -> [a]
toList = foldr (:) []
Expand Down
1 change: 1 addition & 0 deletions Data/HashMap/Internal/Debug.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PartialTypeConstructors, QuantifiedConstraints #-}

-- | = WARNING
--
Expand Down
1 change: 1 addition & 0 deletions Data/HashMap/Internal/List.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PartialTypeConstructors, QuantifiedConstraints #-}
{-# OPTIONS_GHC -fno-full-laziness -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}

Expand Down
4 changes: 3 additions & 1 deletion Data/HashMap/Internal/Strict.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE PartialTypeConstructors, QuantifiedConstraints #-}
{-# OPTIONS_HADDOCK not-home #-}

------------------------------------------------------------------------
Expand Down Expand Up @@ -133,6 +134,7 @@ import Data.HashMap.Internal (Hash, HashMap (..), Leaf (..), LookupRes (..),
fullBitmap, hash, index, mask, nextShift, ptrEq,
sparseIndex)
import Prelude hiding (lookup, map)
import GHC.Types (Total)

-- See Note [Imports from Data.HashMap.Internal]
import qualified Data.HashMap.Internal as HM
Expand Down Expand Up @@ -591,7 +593,7 @@ mapMaybe f = mapMaybeWithKey (const f)
-- associated with the keys involved will depend in an unspecified way on
-- their insertion order.
traverseWithKey
:: Applicative f
:: (Total f, Applicative f)
=> (k -> v1 -> f v2)
-> HashMap k v1 -> f (HashMap k v2)
traverseWithKey f = go
Expand Down
1 change: 1 addition & 0 deletions Data/HashMap/Lazy.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE PartialTypeConstructors, QuantifiedConstraints #-}
{-# LANGUAGE Trustworthy #-}

------------------------------------------------------------------------
Expand Down
1 change: 1 addition & 0 deletions Data/HashMap/Strict.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE Safe #-}
{-# LANGUAGE PartialTypeConstructors, QuantifiedConstraints #-}

------------------------------------------------------------------------
-- |
Expand Down
1 change: 1 addition & 0 deletions Data/HashSet.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE PartialTypeConstructors, QuantifiedConstraints #-}
{-# LANGUAGE Safe #-}

------------------------------------------------------------------------
Expand Down
5 changes: 3 additions & 2 deletions Data/HashSet/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PartialTypeConstructors, QuantifiedConstraints #-}
{-# OPTIONS_HADDOCK not-home #-}

------------------------------------------------------------------------
Expand Down Expand Up @@ -106,7 +107,7 @@ import qualified Data.Foldable as Foldable
import qualified Data.HashMap.Internal as H
import qualified Data.List as List
import qualified GHC.Exts as Exts
import qualified Language.Haskell.TH.Syntax as TH
-- import qualified Language.Haskell.TH.Syntax as TH

-- | A set of values. A set cannot contain duplicate values.
newtype HashSet a = HashSet {
Expand All @@ -116,7 +117,7 @@ newtype HashSet a = HashSet {
type role HashSet nominal

-- | @since 0.2.17.0
deriving instance TH.Lift a => TH.Lift (HashSet a)
-- deriving instance TH.Lift a => TH.Lift (HashSet a)

instance (NFData a) => NFData (HashSet a) where
rnf = rnf . asMap
Expand Down
11 changes: 7 additions & 4 deletions unordered-containers.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,8 @@ library
base >= 4.10 && < 5,
deepseq >= 1.4.3,
hashable >= 1.2.5 && < 1.5,
template-haskell < 2.19
template-haskell < 2.19,
ghc-prim

default-language: Haskell2010

Expand All @@ -71,9 +72,11 @@ library
ghc-options: -Wall -O2 -fwarn-tabs -ferror-spans

-- For dumping the generated code:
-- ghc-options: -ddump-simpl -ddump-stg-final -ddump-cmm -ddump-asm -ddump-to-file
-- ghc-options: -dsuppress-coercions -dsuppress-unfoldings -dsuppress-module-prefixes
-- ghc-options: -dsuppress-uniques -dsuppress-timestamps
--
-- ghc-options: -ddump-tc-trace -dcore-lint -dverbose-core2core
ghc-options: -ddump-simpl -ddump-stg-final -ddump-cmm -ddump-asm -ddump-to-file
ghc-options: -dsuppress-coercions -dsuppress-unfoldings -dsuppress-module-prefixes
ghc-options: -dsuppress-uniques -dsuppress-timestamps

if flag(debug)
cpp-options: -DASSERTS
Expand Down

0 comments on commit 8a22d0d

Please sign in to comment.