packages feed

primitive-containers 0.3.3 → 0.4.0

raw patch · 24 files changed

+70/−1139 lines, 24 filesdep +primitive-unlifteddep −aesondep −quantificationdep −unordered-containersdep ~QuickCheckdep ~basedep ~contiguous

Dependencies added: primitive-unlifted

Dependencies removed: aeson, quantification, unordered-containers, vector

Dependency ranges changed: QuickCheck, base, contiguous, contiguous-checked, quickcheck-classes, text

Files

primitive-containers.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: primitive-containers-version: 0.3.3+version: 0.4.0 synopsis: containers backed by arrays description:   Containers backed by flat arrays. Updates require rebuilding the@@ -39,19 +39,14 @@     , primitive-sort >= 0.1 && < 0.2     , hashable >= 1.2.5     , deepseq >= 1.4-      -- move these five out when we kick out dependent maps -    , quantification >= 0.5.0 && < 0.6-    , aeson >= 1.0 && < 1.5-    , unordered-containers >= 0.2.8.0-    , vector >= 0.11 && < 0.13-    , text >= 1.2 && < 1.3+    , primitive-unlifted >= 0.1 && <0.2   if flag(checked)     build-depends: -        contiguous-checked >= 0.3.2 && < 0.4+        contiguous-checked >= 0.4 && < 0.5       , primitive-checked >= 0.6.4.1   else     build-depends: -        contiguous >= 0.3.2 && < 0.4+        contiguous >= 0.4 && < 0.5       , primitive >= 0.6.4   exposed-modules:     Data.Continuous.Set.Lifted@@ -77,11 +72,6 @@     Data.Map.Subset.Strict.Unlifted     Data.Map.Subset.Lazy.Lifted     Data.Map.Subset.Lazy.Unlifted-    Data.Dependent.Map.Class-    Data.Dependent.Map.Internal-    Data.Dependent.Map.Lifted.Lifted-    Data.Dependent.Map.Unlifted.Lifted-    Data.Dependent.Map.Unboxed.Lifted     Data.Map.Interval.DBTSLL     Data.Map.Interval.DBTSUL     Data.Map.Interval.DBTSUU@@ -109,13 +99,12 @@   build-depends:       base     , HUnit-    , QuickCheck < 2.13-    , aeson+    , QuickCheck     , containers >= 0.5.10     , primitive     , primitive-containers-    , quantification >= 0.4-    , quickcheck-classes >= 0.6+    , primitive-unlifted+    , quickcheck-classes >= 0.6.2     , tasty     , tasty-hunit     , tasty-quickcheck@@ -133,6 +122,7 @@   build-depends:       base >= 4.8 && < 4.12     , primitive+    , primitive-unlifted >= 0.1.1     , primitive-containers     , ghc-prim     , gauge
src/Data/Continuous/Set/Internal.hs view
@@ -89,18 +89,18 @@   -> Set arr a singleton Nothing Nothing = universe singleton Nothing (Just (incHi,hi)) = runST $ do-  keys <- I.replicateM 1 hi >>= I.unsafeFreeze-  incs <- I.replicateM 1 (edgePairToWord8 (inclusivityToEdge incHi) EdgeAbsent) >>= I.unsafeFreeze+  keys <- I.replicateMutable 1 hi >>= I.unsafeFreeze+  incs <- I.replicateMutable 1 (edgePairToWord8 (inclusivityToEdge incHi) EdgeAbsent) >>= I.unsafeFreeze   return (Set keys incs) singleton (Just (incLo,lo)) Nothing = runST $ do-  keys <- I.replicateM 1 lo >>= I.unsafeFreeze-  incs <- I.replicateM 1 (edgePairToWord8 EdgeAbsent (inclusivityToEdge incLo)) >>= I.unsafeFreeze+  keys <- I.replicateMutable 1 lo >>= I.unsafeFreeze+  incs <- I.replicateMutable 1 (edgePairToWord8 EdgeAbsent (inclusivityToEdge incLo)) >>= I.unsafeFreeze   return (Set keys incs) singleton (Just (incLo,lo)) (Just (incHi,hi)) = case compare lo hi of   GT -> empty   EQ -> if incLo == Inclusive && incHi == Inclusive     then runST $ do-      keys <- I.replicateM 2 lo >>= I.unsafeFreeze+      keys <- I.replicateMutable 2 lo >>= I.unsafeFreeze       incsMut <- I.new 2       I.write incsMut 0 (inclusivityPairToWord8 Inclusive Inclusive)       I.write incsMut 1 (edgePairToWord8 EdgeAbsent EdgeAbsent)@@ -112,7 +112,7 @@ -- the caller must ensure that lo is less than hi unsafeSingleton :: (Contiguous arr, Element arr a) => Inclusivity -> a -> Inclusivity -> a -> Set arr a unsafeSingleton incLo lo incHi hi = runST $ do-  keysMut <- I.replicateM 2 lo+  keysMut <- I.replicateMutable 2 lo   I.write keysMut 1 hi   keys <- I.unsafeFreeze keysMut   incsMut <- I.new 2@@ -123,7 +123,7 @@  except :: (Contiguous arr, Element arr a) => a -> Set arr a except x = Set keys incs where-  keys = runST $ I.replicateM 2 x >>= I.unsafeFreeze+  keys = runST $ I.replicateMutable 2 x >>= I.unsafeFreeze   incs = runST $ do     m <- I.new 1     I.write m 0 (edgePairToWord8 EdgeExclusive EdgeExclusive)@@ -147,7 +147,7 @@ -- less than the lower bound for pos inf unsafeInfinities :: (Contiguous arr, Element arr a) => Inclusivity -> a -> Inclusivity -> a -> Set arr a unsafeInfinities negInfHiInc negInfHi posInfLoInc posInfLo = runST $ do-  keysMut <- I.replicateM 2 negInfHi+  keysMut <- I.replicateMutable 2 negInfHi   I.write keysMut 1 posInfLo   keys <- I.unsafeFreeze keysMut   incsMut <- I.new 1
− src/Data/Dependent/Map/Class.hs 
@@ -1,78 +0,0 @@-{-# language ConstraintKinds #-}-{-# language CPP #-}-{-# language ExistentialQuantification #-}-{-# language FlexibleContexts #-}-{-# language FlexibleInstances #-}-{-# language MagicHash #-}-{-# language MultiParamTypeClasses #-}-{-# language PolyKinds #-}-{-# language RankNTypes #-}-{-# language ScopedTypeVariables #-}-{-# language TypeFamilies #-}-{-# language TypeFamilyDependencies #-}-{-# language TypeInType #-}-{-# language UnboxedTuples #-}---- I really do not like the typeclasses defined in this module.--- With the QuantifiedConstraints extension (in GHC 8.6), we should--- be able to get rid of this entire module. But we will want to--- wait a while before doing that.-module Data.Dependent.Map.Class-  ( Apply(..)-  , Universally(..)-  , ApplyUniversally(..)-  ) where--import Data.Kind (Type,Constraint)-import Data.Proxy (Proxy(..))-import Data.Exists (OrdForall(..),EqForall(..),PrimForall(..))-import Data.Primitive (Prim(..))-import Data.Primitive.Contiguous (Always)-import Data.Primitive.UnliftedArray (PrimUnlifted(..))-import GHC.Exts--newtype Apply f a = Apply (f a)--class ApplyUniversally (f :: k -> Type) (x :: Type -> Constraint) where-  applyUniversallyLifted :: forall a y. Proxy f -> Proxy x -> Proxy a -> (x (f a) => y) -> y-#if MIN_VERSION_base(4,10,0) -  applyUniversallyUnlifted :: forall a (y :: TYPE 'UnliftedRep). Proxy f -> Proxy x -> Proxy a -> (x (f a) => y) -> y-#else-  applyUniversallyUnlifted :: forall a (y :: TYPE 'PtrRepUnlifted). Proxy f -> Proxy x -> Proxy a -> (x (f a) => y) -> y-#endif--class Universally (f :: k -> Type) (x :: Type -> Constraint) where-  universally :: Proxy f -> Proxy x -> Proxy a -> (x (Apply f a) => y) -> y--instance ApplyUniversally f PrimUnlifted => PrimUnlifted (Apply f a) where-  toArrayArray# (Apply v) = applyUniversallyUnlifted (Proxy :: Proxy f) (Proxy :: Proxy PrimUnlifted) (Proxy :: Proxy a) (toArrayArray# v)-  fromArrayArray# a = applyUniversallyLifted (Proxy :: Proxy f) (Proxy :: Proxy PrimUnlifted) (Proxy :: Proxy a) (fromArrayArray# a)--instance EqForall f => Eq (Apply f a) where-  Apply x == Apply y = eqForall x y--instance OrdForall f => Ord (Apply f a) where-  compare (Apply x) (Apply y) = compareForall x y--instance PrimForall f => Prim (Apply f a) where-  sizeOf# _ = sizeOfForall# (proxy# :: Proxy# f)-  alignment# _ = alignmentForall# (proxy# :: Proxy# f)-  indexByteArray# = coerce (indexByteArrayForall# :: ByteArray# -> Int# -> f a)-  readByteArray# = coerce (readByteArrayForall# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, f a #) )-  writeByteArray# = coerce (writeByteArrayForall# :: MutableByteArray# s -> Int# -> f a -> State# s -> State# s )-  setByteArray# = coerce (setByteArrayForall# :: MutableByteArray# s -> Int# -> Int# -> f a -> State# s -> State# s )-  indexOffAddr# = coerce (indexOffAddrForall# :: Addr# -> Int# -> f a)-  readOffAddr# = coerce (readOffAddrForall# :: Addr# -> Int# -> State# s -> (# State# s, f a #) )-  writeOffAddr# = coerce (writeOffAddrForall# :: Addr# -> Int# -> f a -> State# s -> State# s)-  setOffAddr# = coerce (setOffAddrForall# :: Addr# -> Int# -> Int# -> f a -> State# s -> State# s)--instance Universally f Always where-  universally _ _ _ y = y--instance ApplyUniversally f Always where-  applyUniversallyLifted _ _ _ y = y-  applyUniversallyUnlifted _ _ _ y = y--instance ApplyUniversally f PrimUnlifted => Universally f PrimUnlifted where-  universally _ _ _ y = y-
− src/Data/Dependent/Map/Internal.hs 
@@ -1,423 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeInType #-}--module Data.Dependent.Map.Internal-  ( Map(..)-  , empty-  , null-  , singleton-  , lookup-  , fromList-  , fromListN-  , map-  , mapWithKey-  , mapMaybe-  , mapMaybeWithKey-  , appendRightBiased-  , append-  , toList-  , showsPrec-  , equals-  , compare-  , unsafeFreezeZip-  , toJSON-  , parseJSON-  , foldrWithKey-  , foldlWithKeyM'-  , foldMapWithKey-  , traverseWithKey_-  , size-  ) where--import Prelude hiding (lookup,showsPrec,compare,null,map)--import Data.Dependent.Map.Class (Universally,Apply,ApplyUniversally)-import Data.Primitive.Contiguous (Contiguous,Mutable,Element)-import Control.Monad.ST (ST,runST)-import Data.Proxy (Proxy(..))-import GHC.Exts (Any,coerce)-import Unsafe.Coerce (unsafeCoerce)-import Data.Exists (OrdForallPoly(..),EqForallPoly(..),DependentPair(..),ShowForall,ToSing)-import Data.Exists (ShowForeach,EqForeach,OrdForeach,ToJSONKeyForall,FromJSONForeach)-import Data.Exists (ToJSONForall,ToJSONKeyFunctionForall,ToJSONForeach)-import Data.Exists (FromJSONKeyExists,SemigroupForeach,Sing)-import Data.Semigroup (Semigroup)-import Data.Primitive.Sort (sortUniqueTaggedMutable)-import Data.Kind (Type)-import Data.Aeson (ToJSON,FromJSON)-import Data.Text (Text)-import qualified Data.List as L-import qualified Data.Vector as V-import qualified Data.Exists as EX-import qualified Data.Aeson as AE-import qualified Data.Aeson.Types as AET-import qualified Data.HashMap.Strict as HM-import qualified Prelude as P-import qualified Data.Map.Internal as I-import qualified Data.Primitive.Contiguous as I-import qualified Data.Dependent.Map.Class as C-import qualified Data.Map.Internal as M-import qualified Data.Foldable as F--newtype Map karr varr (k :: u -> Type) (v :: u -> Type) = Map (M.Map karr varr (Apply k Any) (v Any))--empty :: (Contiguous karr, Contiguous varr) => Map karr varr k v-empty = Map M.empty--null :: forall karr varr k v. (Contiguous varr) => Map karr varr k v -> Bool-null (Map m) = M.null m--singleton :: forall karr varr k v a.-     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr))-  => k a -> v a -> Map karr varr k v-singleton k v = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ Map (M.singleton (wrapKey k) (wrapValue (Proxy :: Proxy v) (Proxy :: Proxy a) v))--toJSON :: forall karr varr k v.-     (ToJSONKeyForall k, ToJSONForeach v, ToSing k, Contiguous karr, Contiguous varr,ApplyUniversally v (Element varr),Universally k (Element karr))-  => Map karr varr k v-  -> AE.Value-toJSON (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ case EX.toJSONKeyForall :: ToJSONKeyFunctionForall k of-      EX.ToJSONKeyValueForall toValue _ -> AE.Array $ V.fromListN-        ( M.size m )-        ( M.foldrWithKey-          ( \(C.Apply k) v xs -> AE.toJSON (toValue k,EX.toJSONForeach (EX.toSing k) v) : xs-          ) [] m-        )-      EX.ToJSONKeyTextForall toText _ -> AE.Object-        ( M.foldlWithKey'-          ( \hm (C.Apply k) v -> HM.insert (toText k) (EX.toJSONForeach (EX.toSing k) v) hm-          ) HM.empty m-        )--parseJSON :: forall karr varr k v.-     (FromJSONKeyExists k, ToSing k, OrdForallPoly k, FromJSONForeach v, Contiguous karr, Contiguous varr, ApplyUniversally v (Element varr),Universally k (Element karr),ApplyUniversally k (Element karr))-  => AE.Value-  -> AET.Parser (Map karr varr k v)-parseJSON theValue =-  case EX.fromJSONKeyExists :: AE.FromJSONKeyFunction (EX.Exists k) of-    AE.FromJSONKeyCoerce _ -> error "Data.Dependent.Map.Internal.fromJSON: this cannot happen"-    AE.FromJSONKeyText fromText -> AET.withObject "DependentMap"-      (fmap fromList . HM.foldrWithKey (f1 fromText) (return []))-      theValue-    AE.FromJSONKeyTextParser fromText -> AET.withObject "DependentMap"-      (fmap fromList . HM.foldrWithKey (f2 fromText) (return []))-      theValue-    AE.FromJSONKeyValue fromValue -> AET.withArray "DependentMap"-      (fmap fromList . F.foldlM (f3 fromValue) [])-      theValue-  where-  f1 :: (Text -> EX.Exists k) -> Text -> AE.Value -> AET.Parser [DependentPair k v] -> AET.Parser [DependentPair k v]-  f1 fromText keyText valRaw m = case fromText keyText of-    EX.Exists key -> do-      let keySing = EX.toSing key-      val <- EX.parseJSONForeach keySing valRaw-      dm <- m-      return (DependentPair key val : dm)-  f2 :: (Text -> AET.Parser (EX.Exists k)) -> Text -> AE.Value -> AET.Parser [DependentPair k v] -> AET.Parser [DependentPair k v]-  f2 fromText keyText valRaw m = do-    EX.Exists key <- fromText keyText-    let keySing = EX.toSing key-    val <- EX.parseJSONForeach keySing valRaw-    dm <- m-    return (DependentPair key val : dm)-  f3 :: (AE.Value -> AET.Parser (EX.Exists k)) -> [DependentPair k v] -> AE.Value -> AET.Parser [DependentPair k v]-  f3 fromValue dm pairRaw = do-    (keyRaw :: AE.Value,valRaw :: AE.Value) <- AE.parseJSON pairRaw-    EX.Exists key <- fromValue keyRaw-    let keySing = EX.toSing key-    val <- EX.parseJSONForeach keySing valRaw-    return (DependentPair key val : dm)---        --lookup :: forall karr varr k v a.-     (OrdForallPoly k, Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr))-  => k a-  -> Map karr varr k v-  -> Maybe (v a)-{-# INLINABLE lookup #-}-lookup k (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ case M.lookup (wrapKey k) m of-      Nothing -> Nothing-      Just v -> Just (unwrapValue (Proxy :: Proxy v) (Proxy :: Proxy a) v)--appendWith :: forall u karr varr (k :: u -> Type) (v :: u -> Type).-     (Contiguous karr, ApplyUniversally k (Element karr), Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k, ToSing k)-  => (forall (a :: u). Sing a -> v a -> v a -> v a)-  -> Map karr varr k v-  -> Map karr varr k v-  -> Map karr varr k v-appendWith f xs ys = fromList (nubUnionWith f (toList xs) (toList ys))--- For some reason, this more natural implementation causes segfaults--- appendWith f (Map m1) (Map m2) = id---   $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)---   $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)---   $ Map (M.appendWithKey (\(C.Apply k) v1 v2 -> f (EX.toSing k) v1 v2) m1 m2)--nubUnionWith :: forall u (k :: u -> Type) (v :: u -> Type). (EqForallPoly k, ToSing k)-  => (forall (a :: u). Sing a -> v a -> v a -> v a)-  -> [DependentPair k v]-  -> [DependentPair k v]-  -> [DependentPair k v]-nubUnionWith f = go [] where-  go acc [] ys = acc ++ ys-  go acc (x@(DependentPair kx vx) : xs) ys = case findPair kx ys of-    Nothing -> go (x : acc) xs ys-    Just (ys',vy) -> go (DependentPair kx (f (EX.toSing kx) vx vy) : acc) xs ys'--findPair :: EqForallPoly k => k a -> [DependentPair k v] -> Maybe ([DependentPair k v], v a)-findPair k = go [] where-  go _ [] = Nothing-  go finger (x@(DependentPair kx vx) : xs) = case EX.eqForallPoly k kx of-    EX.WitnessedEqualityUnequal -> go (x : finger) xs-    EX.WitnessedEqualityEqual -> Just (L.reverse finger ++ xs, vx)--append :: forall karr varr k v.-     (Contiguous karr, ApplyUniversally k (Element karr), Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k, SemigroupForeach v, ToSing k)-  => Map karr varr k v-  -> Map karr varr k v-  -> Map karr varr k v-append = appendWith (EX.appendForeach :: (forall a. Sing a -> v a -> v a -> v a))--appendRightBiased :: forall karr varr k v.-     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k)-  => Map karr varr k v-  -> Map karr varr k v-  -> Map karr varr k v-appendRightBiased (Map m1) (Map m2) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ Map (M.appendRightBiased m1 m2)--wrapKeyUnapplied :: f k -> f Any-wrapKeyUnapplied = unsafeCoerce--wrapKey :: f k -> Apply f Any-wrapKey = unsafeCoerce--wrapValue :: Proxy v -> Proxy a -> v a -> v Any-wrapValue _ _ = unsafeCoerce--unwrapValue :: Proxy v -> Proxy a -> v Any -> v a-unwrapValue _ _ = unsafeCoerce--unsafeCoerceMutableKeyArray ::-     Mutable karr s (f Any)-  -> Mutable karr s (Apply f Any)-unsafeCoerceMutableKeyArray = unsafeCoerce--fromList ::-     (Contiguous karr, ApplyUniversally k (Element karr), Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k)-  => [DependentPair k v]-  -> Map karr varr k v-fromList = fromListN 1--fromListN ::-     (Contiguous karr, ApplyUniversally k (Element karr), Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k)-  => Int-  -> [DependentPair k v]-  -> Map karr varr k v-{-# INLINABLE fromListN #-}-fromListN n xs = runST $ do-  (ks,vs) <- mutableArraysFromPairs (max n 1) xs-  unsafeFreezeZip ks vs---- | This function is really unsafe. The user needs to use unsafeCoerce to even use it.-unsafeFreezeZip :: forall karr varr k v s.-     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k)-  => Mutable karr s (k Any)-  -> Mutable varr s (v Any)-  -> ST s (Map karr varr k v)-{-# INLINABLE unsafeFreezeZip #-}-unsafeFreezeZip keys0 vals0 = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ fmap Map (M.unsafeFreezeZip (unsafeCoerceMutableKeyArray keys0) vals0)--mutableArraysFromPairs :: forall karr varr k v s.-     (Contiguous karr, ApplyUniversally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), OrdForallPoly k)-  => Int -- must be at least one-  -> [DependentPair k v]-  -> ST s (Mutable karr s (k Any), Mutable varr s (v Any))-{-# INLINABLE mutableArraysFromPairs #-}-mutableArraysFromPairs n xs = id-  $ C.applyUniversallyLifted (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ do-    let go :: Int-           -> Int-           -> Mutable karr s (k Any)-           -> Mutable varr s (v Any)-           -> [DependentPair k v]-           -> ST s (Int,Mutable karr s (k Any),Mutable varr s (v Any))-        go !ix !_ !ks !vs [] = return (ix,ks,vs)-        go !ix !len !ks !vs (DependentPair k v : ys) = if ix < len-          then do-            I.write ks ix (wrapKeyUnapplied k)-            I.write vs ix (wrapValue (Proxy :: Proxy v) Proxy v)-            go (ix + 1) len ks vs ys-          else do-            let len' = len * 2-            ks' <- I.new len'-            vs' <- I.new len'-            I.copyMutable ks' 0 ks 0 len-            I.copyMutable vs' 0 vs 0 len-            I.write ks' ix (wrapKeyUnapplied k)-            I.write vs' ix (wrapValue (Proxy :: Proxy v) Proxy v)-            go (ix + 1) len' ks' vs' ys-    ks0 <- I.new n-    vs0 <- I.new n-    (len,ks',vs') <- go 0 n ks0 vs0 xs-    ksFinal <- I.resize ks' len-    vsFinal <- I.resize vs' len-    return (ksFinal,vsFinal)--foldrWithKey :: forall karr varr k v b.-     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr))-  => (forall a. k a -> v a -> b -> b)-  -> b-  -> Map karr varr k v-  -> b-foldrWithKey f z (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ M.foldrWithKey (unsafeCoerceRightFoldFunction f) z m--foldMapWithKey :: forall karr varr k v m.-     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), Monoid m)-  => (forall a. k a -> v a -> m)-  -> Map karr varr k v-  -> m-foldMapWithKey f (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ M.foldMapWithKey (unsafeCoerceFoldMapFunction f) m--traverseWithKey_ :: forall karr varr k v m b.-     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), Applicative m)-  => (forall a. k a -> v a -> m b)-  -> Map karr varr k v-  -> m ()-traverseWithKey_ f (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ M.traverseWithKey_ (unsafeCoerceFoldMapFunction f) m--foldlWithKeyM' :: forall karr varr k v m b.-     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), Monad m)-  => (forall a. b -> k a -> v a -> m b)-  -> b-  -> Map karr varr k v-  -> m b-foldlWithKeyM' f z (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ M.foldlWithKeyM' (unsafeCoerceLeftFoldFunctionM f) z m--toList :: -     (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr))-  => Map karr varr k v-  -> [DependentPair k v]-toList = foldrWithKey (\k v xs -> DependentPair k v : xs) []--unsafeCoerceMapMaybeWithKeyFunction ::-     (forall a. k a -> v a -> Maybe (w a))-  -> Apply k Any -> v Any -> Maybe (w Any)-unsafeCoerceMapMaybeWithKeyFunction = unsafeCoerce--unsafeCoerceMapWithKeyFunction ::-     (forall a. k a -> v a -> w a)-  -> Apply k Any -> v Any -> w Any-unsafeCoerceMapWithKeyFunction = unsafeCoerce--unsafeCoerceLeftFoldFunctionM :: -     (forall a. b -> k a -> v a -> m b)-  -> b -> Apply k Any -> v Any -> m b-unsafeCoerceLeftFoldFunctionM = unsafeCoerce--unsafeCoerceRightFoldFunction :: -     (forall a. k a -> v a -> b -> b)-  -> Apply k Any -> v Any -> b -> b-unsafeCoerceRightFoldFunction = unsafeCoerce--unsafeCoerceFoldMapFunction :: -     (forall a. k a -> v a -> m)-  -> Apply k Any -> v Any -> m-unsafeCoerceFoldMapFunction = unsafeCoerce--showsPrec :: (Contiguous karr, Universally k (Element karr), ShowForall k, ShowForeach v, ToSing k, Contiguous varr, ApplyUniversally v (Element varr))-  => Int -> Map karr varr k v -> ShowS-showsPrec p xs = showParen (p > 10) $-  showString "fromList " . shows (toList xs)--equals :: (Contiguous karr, Universally k (Element karr), EqForallPoly k, EqForeach v, ToSing k, Contiguous varr, ApplyUniversally v (Element varr))-  => Map karr varr k v-  -> Map karr varr k v-  -> Bool-equals a b = toList a == toList b--compare :: (Contiguous karr, Universally k (Element karr), OrdForallPoly k, OrdForeach v, ToSing k, Contiguous varr, ApplyUniversally v (Element varr))-  => Map karr varr k v-  -> Map karr varr k v-  -> Ordering-compare a b = P.compare (toList a) (toList b)--size :: forall karr varr k v. (Contiguous varr, ApplyUniversally v (Element varr)) => Map karr varr k v -> Int-size (Map m) = id-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ M.size m--map :: forall karr varr k v w. (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), ApplyUniversally w (Element varr))-  => (forall a. v a -> w a)-  -> Map karr varr k v-  -> Map karr varr k w-map f (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy w) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ Map (M.map f m)--mapMaybe :: forall karr varr k v w. (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), ApplyUniversally w (Element varr))-  => (forall a. v a -> Maybe (w a))-  -> Map karr varr k v-  -> Map karr varr k w-mapMaybe f (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy w) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ Map (M.mapMaybe f m)--mapMaybeWithKey :: forall karr varr k v w. (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), ApplyUniversally w (Element varr))-  => (forall a. k a -> v a -> Maybe (w a))-  -> Map karr varr k v-  -> Map karr varr k w-mapMaybeWithKey f (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy w) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ Map (M.mapMaybeWithKey (unsafeCoerceMapMaybeWithKeyFunction f) m)--mapWithKey :: forall karr varr k v w. (Contiguous karr, Universally k (Element karr), Contiguous varr, ApplyUniversally v (Element varr), ApplyUniversally w (Element varr))-  => (forall a. k a -> v a -> w a)-  -> Map karr varr k v-  -> Map karr varr k w-mapWithKey f (Map m) = id-  $ C.universally (Proxy :: Proxy k) (Proxy :: Proxy (Element karr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy v) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ C.applyUniversallyLifted (Proxy :: Proxy w) (Proxy :: Proxy (Element varr)) (Proxy :: Proxy Any)-  $ Map (M.mapWithKey (unsafeCoerceMapWithKeyFunction f) m)
− src/Data/Dependent/Map/Lifted/Lifted.hs 
@@ -1,88 +0,0 @@-{-# language GeneralizedNewtypeDeriving #-}-{-# language PolyKinds #-}-{-# language RankNTypes #-}-{-# language TypeFamilies #-}--module Data.Dependent.Map.Lifted.Lifted-  ( Map-  , singleton-  , lookup-  , toList-  , fromList-  , mapMaybe-  , mapMaybeWithKey-  ) where--import Prelude hiding (lookup)--import Data.Aeson (FromJSON,ToJSON)-import Data.Primitive (Array)-import Data.Semigroup (Semigroup)-import Data.Exists (EqForallPoly,EqForeach,OrdForeach)-import Data.Exists (OrdForallPoly,DependentPair,ShowForall,ShowForeach,ToSing)-import Data.Exists (ToJSONKeyForall,FromJSONKeyExists,ToJSONForeach,SemigroupForeach)-import Data.Exists (FromJSONForeach)-import GHC.Exts (IsList)--import qualified Data.Aeson as AE-import qualified Data.Dependent.Map.Internal as I-import qualified Data.Semigroup as SG-import qualified GHC.Exts--newtype Map k v = Map (I.Map Array Array k v)--singleton :: k a -> v a -> Map k v-singleton f v = Map (I.singleton f v)--lookup :: OrdForallPoly k => k a -> Map k v -> Maybe (v a)-lookup k (Map x) = I.lookup k x--fromList :: OrdForallPoly k => [DependentPair k v] -> Map k v-fromList xs = Map (I.fromList xs)--fromListN :: OrdForallPoly k => Int -> [DependentPair k v] -> Map k v-fromListN n xs = Map (I.fromListN n xs)--toList :: Map k v -> [DependentPair k v]-toList (Map x) = I.toList x--mapMaybe ::-     (forall a. v a -> Maybe (w a))-  -> Map k v-  -> Map k w-mapMaybe f (Map m) = Map (I.mapMaybe f m)--mapMaybeWithKey ::-     (forall a. k a -> v a -> Maybe (w a))-  -> Map k v-  -> Map k w-mapMaybeWithKey f (Map m) = Map (I.mapMaybeWithKey f m)--instance OrdForallPoly k => IsList (Map k v) where-  type Item (Map k v) = DependentPair k v-  fromListN = fromListN-  fromList = fromList-  toList = toList-  -instance (ShowForall k, ToSing k, ShowForeach v) => Show (Map k v) where-  showsPrec p (Map s) = I.showsPrec p s--instance (EqForallPoly k, ToSing k, EqForeach v) => Eq (Map k v) where-  Map x == Map y = I.equals x y--instance (OrdForallPoly k, ToSing k, OrdForeach v) => Ord (Map k v) where-  compare (Map x) (Map y) = I.compare x y--instance (ToSing k, OrdForallPoly k, SemigroupForeach v) => Semigroup (Map k v) where-  Map x <> Map y = Map (I.append x y)--instance (ToSing k, OrdForallPoly k, SemigroupForeach v) => Monoid (Map k v) where-  mempty = Map I.empty-  mappend = (SG.<>)--instance (ToSing k, ToJSONKeyForall k, ToJSONForeach v) => ToJSON (Map k v) where-  toJSON (Map m) = I.toJSON m--instance (ToSing k, FromJSONKeyExists k, FromJSONForeach v, OrdForallPoly k) => FromJSON (Map k v) where-  parseJSON v = fmap Map (I.parseJSON v)-
− src/Data/Dependent/Map/Unboxed/Lifted.hs 
@@ -1,189 +0,0 @@-{-# language FlexibleContexts #-}-{-# language GeneralizedNewtypeDeriving #-}-{-# language PolyKinds #-}-{-# language RankNTypes #-}-{-# language TypeFamilies #-}--module Data.Dependent.Map.Unboxed.Lifted-  ( Map-  , empty-  , null-  , singleton-  , lookup-  , foldrWithKey-  , foldlWithKeyM'-  , foldMapWithKey-  , traverseWithKey_-  , toList-  , fromList-  , map-  , mapWithKey-  , mapMaybe-  , mapMaybeWithKey-  , size-    -- * Unsafe Functions-  , unsafeFreezeZip-  , unsafeCoerceKeys-  ) where--import Prelude hiding (lookup,null,map)--import Control.Monad.ST (ST)-import Data.Aeson (FromJSON,ToJSON)-import Data.Dependent.Map.Class (Universally,ApplyUniversally)-import Data.Exists (EqForallPoly,EqForeach,OrdForeach)-import Data.Exists (OrdForallPoly,DependentPair,ShowForall,ShowForeach,ToSing)-import Data.Exists (ToJSONKeyForall,FromJSONKeyExists,ToJSONForeach,SemigroupForeach)-import Data.Exists (FromJSONForeach)-import Data.Primitive (Array,PrimArray,Prim,MutablePrimArray,MutableArray)-import Data.Proxy (Proxy)-import Data.Semigroup (Semigroup)-import GHC.Exts (IsList,Any)-import Unsafe.Coerce (unsafeCoerce)--import qualified Data.Aeson as AE-import qualified Data.Semigroup as SG-import qualified Data.Dependent.Map.Internal as I-import qualified GHC.Exts-import qualified Data.Set.Unboxed.Internal as SU-import qualified Data.Map.Internal as M--newtype Map k v = Map (I.Map PrimArray Array k v)--empty :: Map k v-empty = Map I.empty--null :: Map k v -> Bool-null (Map m) = I.null m--singleton :: Universally k Prim => k a -> v a -> Map k v-singleton f v = Map (I.singleton f v)--lookup :: (Universally k Prim, ApplyUniversally k Prim, OrdForallPoly k) => k a -> Map k v -> Maybe (v a)-lookup k (Map x) = I.lookup k x--fromList :: (Universally k Prim, ApplyUniversally k Prim, OrdForallPoly k) => [DependentPair k v] -> Map k v-fromList xs = Map (I.fromList xs)--fromListN :: (Universally k Prim, ApplyUniversally k Prim, OrdForallPoly k) => Int -> [DependentPair k v] -> Map k v-fromListN n xs = Map (I.fromListN n xs)--toList :: Universally k Prim => Map k v -> [DependentPair k v]-toList (Map x) = I.toList x--size :: Map k v -> Int-size (Map x) = I.size x--foldrWithKey :: -     Universally k Prim-  => (forall a. k a -> v a -> b -> b)-  -> b-  -> Map k v-  -> b-foldrWithKey f b (Map m) = I.foldrWithKey f b m--foldlWithKeyM' :: -     (Universally k Prim, Monad m)-  => (forall a. b -> k a -> v a -> m b)-  -> b-  -> Map k v-  -> m b-foldlWithKeyM' f b (Map m) = I.foldlWithKeyM' f b m--foldMapWithKey :: -     (Universally k Prim, Monoid m)-  => (forall a. k a -> v a -> m)-  -> Map k v-  -> m-foldMapWithKey f (Map m) = I.foldMapWithKey f m--traverseWithKey_ :: -     (Universally k Prim, Applicative m)-  => (forall a. k a -> v a -> m b)-  -> Map k v-  -> m ()-traverseWithKey_ f (Map m) = I.traverseWithKey_ f m--map ::-     Universally k Prim-  => (forall a. v a -> w a)-  -> Map k v-  -> Map k w-map f (Map m) = Map (I.map f m)--mapMaybe ::-     Universally k Prim-  => (forall a. v a -> Maybe (w a))-  -> Map k v-  -> Map k w-mapMaybe f (Map m) = Map (I.mapMaybe f m)--mapMaybeWithKey ::-     Universally k Prim-  => (forall a. k a -> v a -> Maybe (w a))-  -> Map k v-  -> Map k w-mapMaybeWithKey f (Map m) = Map (I.mapMaybeWithKey f m)--mapWithKey ::-     Universally k Prim-  => (forall a. k a -> v a -> w a)-  -> Map k v-  -> Map k w-mapWithKey f (Map m) = Map (I.mapWithKey f m)---- | This function is even more unsafe than the @unsafeFreezeZip@ provided by--- @Data.Map.Unboxed.Lifted@. The user needs to use @unsafeCoerce@ to even use this--- function.-unsafeFreezeZip :: -     (Universally k Prim, OrdForallPoly k)-  => MutablePrimArray s (k Any)-  -> MutableArray s (v Any)-  -> ST s (Map k v)-{-# INLINABLE unsafeFreezeZip #-}-unsafeFreezeZip keys0 vals0 =-  fmap Map (I.unsafeFreezeZip keys0 vals0)---- | /O(1)/ This function is highly unsafe. The user is responsible for ensuring--- that:------ * Both @k'@ and @forall a. k a@ have the same runtime representation.--- * The @Ord@ instance for @k'@ agrees with the @OrdForallPoly@ instance---   for @k@.-unsafeCoerceKeys :: Proxy k' -> Map k v -> SU.Set k'-unsafeCoerceKeys p (Map (I.Map m)) =-  -- TODO: Technical debt. Add this function to the Internal module-  -- so that the data constructor does not have to be exported.-  unsafeCoerceSet p (SU.Set (M.keys m))--unsafeCoerceSet :: Proxy k' -> SU.Set (k Any) -> SU.Set k'-unsafeCoerceSet _ = unsafeCoerce--instance (Universally k Prim, ApplyUniversally k Prim, OrdForallPoly k) => IsList (Map k v) where-  type Item (Map k v) = DependentPair k v-  fromListN = fromListN-  fromList = fromList-  toList = toList-  -instance (Universally k Prim, ApplyUniversally k Prim, ShowForall k, ToSing k, ShowForeach v) => Show (Map k v) where-  showsPrec p (Map s) = I.showsPrec p s--instance (Universally k Prim, ApplyUniversally k Prim, EqForallPoly k, ToSing k, EqForeach v) => Eq (Map k v) where-  Map x == Map y = I.equals x y--instance (Universally k Prim, ApplyUniversally k Prim, OrdForallPoly k, ToSing k, OrdForeach v) => Ord (Map k v) where-  compare (Map x) (Map y) = I.compare x y--instance (Universally k Prim, ToSing k, ToJSONKeyForall k, ToJSONForeach v) => ToJSON (Map k v) where-  toJSON (Map m) = I.toJSON m--instance (Universally k Prim, ApplyUniversally k Prim, ToSing k, FromJSONKeyExists k, FromJSONForeach v, OrdForallPoly k) => FromJSON (Map k v) where-  parseJSON v = fmap Map (I.parseJSON v)--instance (ApplyUniversally k Prim, Universally k Prim, ToSing k, OrdForallPoly k, SemigroupForeach v) => Semigroup (Map k v) where-  Map x <> Map y = Map (I.append x y)--instance (ApplyUniversally k Prim, Universally k Prim, ToSing k, OrdForallPoly k, SemigroupForeach v) => Monoid (Map k v) where-  mempty = Map I.empty-  mappend = (SG.<>)-
− src/Data/Dependent/Map/Unlifted/Lifted.hs 
@@ -1,23 +0,0 @@-{-# language FlexibleContexts #-}--module Data.Dependent.Map.Unlifted.Lifted-  ( Map-  , singleton-  , lookup-  ) where--import Prelude hiding (lookup)--import Data.Primitive (Array,UnliftedArray,PrimUnlifted)-import Data.Dependent.Map.Class-import Data.Exists (OrdForallPoly)-import qualified Data.Dependent.Map.Internal as I--newtype Map k v = Map (I.Map UnliftedArray Array k v)--singleton :: ApplyUniversally k PrimUnlifted => k a -> v a -> Map k v-singleton f v = Map (I.singleton f v)--lookup :: (OrdForallPoly k, ApplyUniversally k PrimUnlifted) => k a -> Map k v -> Maybe (v a)-lookup k (Map x) = I.lookup k x-
src/Data/Map/Interval/DBTS/Internal.hs view
@@ -37,6 +37,10 @@   , convertKeysValues   ) where +-- TODO: In very unusual situation where the keys or values+-- are passed to the FFI, the approach used here can lead to+-- unsoundness. This will be addressed in GHC 8.10.+ import Prelude hiding (pure,lookup,compare,map,showsPrec,concat,traverse,foldMap)  import Control.Monad.ST (ST,runST)@@ -166,11 +170,11 @@ pure :: (Contiguous karr, Contiguous varr, Element karr k, Element varr v, Bounded k) => v -> Map karr varr k v pure v = Map   (runST $ do-     !(arr :: Mutable karr s k) <- I.replicateM 1 maxBound+     !(arr :: Mutable karr s k) <- I.replicateMutable 1 maxBound      I.unsafeFreeze arr   )   (runST $ do-     !(arr :: Mutable varr s v) <- I.replicateM 1 v+     !(arr :: Mutable varr s v) <- I.replicateMutable 1 v      I.unsafeFreeze arr   )
src/Data/Map/Interval/DBTSLL.hs view
@@ -38,6 +38,7 @@ import Data.Primitive.Array (Array) import Control.Monad.Primitive (PrimMonad) import qualified Data.Semigroup as SG+import qualified Data.Foldable as F import qualified Data.Map.Interval.DBTS.Internal as I import qualified GHC.Exts as E @@ -67,6 +68,12 @@   type Item (Map k v) = (k,k,v)   fromList xs = Map (I.fromList mempty xs)   toList (Map m) = I.toList m++instance Foldable (Map k) where+  foldr f b (Map m) = F.foldr f b (I.elems m)+  foldl' f b (Map m) = F.foldl' f b (I.elems m)+  toList (Map m) = F.toList (I.elems m)+  length (Map m) = F.length (I.elems m)  pure :: Bounded k => v -> Map k v pure = Map . I.pure
src/Data/Map/Lifted/Unlifted.hs view
@@ -37,7 +37,9 @@ import Prelude hiding (lookup,map)  import Data.Semigroup (Semigroup)-import Data.Primitive (Array,UnliftedArray,PrimUnlifted)+import Data.Primitive (Array)+import Data.Primitive.Unlifted.Array (UnliftedArray)+import Data.Primitive.Unlifted.Class (PrimUnlifted) import Data.Set.Lifted.Internal (Set(..)) import qualified GHC.Exts as E import qualified Data.Semigroup as SG
src/Data/Map/Subset/Lazy/Unlifted.hs view
@@ -26,7 +26,7 @@ import Data.Set.Unlifted.Internal (Set(..)) import Data.Bifunctor (first) import Data.Semigroup (Semigroup)-import Data.Primitive (PrimUnlifted)+import Data.Primitive.Unlifted.Class (PrimUnlifted)  import qualified Data.Map.Unlifted.Lifted as M import qualified Data.Map.Subset.Lazy.Internal as I
src/Data/Map/Subset/Strict/Unlifted.hs view
@@ -20,7 +20,7 @@ import Data.Set.Unlifted.Internal (Set(..)) import Data.Bifunctor (first) import Data.Semigroup (Semigroup)-import Data.Primitive (PrimUnlifted)+import Data.Primitive.Unlifted.Class (PrimUnlifted)  import qualified Data.Map.Subset.Strict.Internal as I
src/Data/Map/Unboxed/Unlifted.hs view
@@ -46,7 +46,8 @@ import Control.Monad.ST (ST) import Data.Primitive (PrimArray,MutablePrimArray) import Data.Primitive.Types (Prim)-import Data.Primitive.UnliftedArray (PrimUnlifted,UnliftedArray,MutableUnliftedArray)+import Data.Primitive.Unlifted.Array (UnliftedArray,MutableUnliftedArray)+import Data.Primitive.Unlifted.Class (PrimUnlifted) import Data.Semigroup (Semigroup) import Data.Set.Unboxed.Internal (Set(..))
src/Data/Map/Unlifted/Lifted.hs view
@@ -35,7 +35,8 @@  import Control.Monad.ST (ST) import Data.Semigroup (Semigroup)-import Data.Primitive.UnliftedArray (PrimUnlifted,UnliftedArray,MutableUnliftedArray)+import Data.Primitive.Unlifted.Array (UnliftedArray,MutableUnliftedArray)+import Data.Primitive.Unlifted.Class (PrimUnlifted) import Data.Primitive (Array,MutableArray) import Data.Set.Unlifted.Internal (Set(..)) import qualified GHC.Exts as E
src/Data/Map/Unlifted/Unboxed.hs view
@@ -35,7 +35,8 @@ import Control.Monad.ST (ST) import Data.Semigroup (Semigroup) import Data.Primitive.Types (Prim)-import Data.Primitive.UnliftedArray (PrimUnlifted,UnliftedArray,MutableUnliftedArray)+import Data.Primitive.Unlifted.Array (UnliftedArray,MutableUnliftedArray)+import Data.Primitive.Unlifted.Class (PrimUnlifted) import Data.Primitive.PrimArray (PrimArray,MutablePrimArray) import Data.Set.Unlifted.Internal (Set(..)) import qualified GHC.Exts as E
src/Data/Set/Internal.hs view
@@ -20,6 +20,7 @@   , intersects   , append   , member+  , lookupIndex   , showsPrec   , equals   , compare@@ -49,7 +50,6 @@  import Control.Monad.ST (ST,runST) import Data.Hashable (Hashable)-import Data.Primitive.UnliftedArray (PrimUnlifted(..)) import Data.Primitive.Contiguous (Contiguous,Mutable,Element) import qualified Prelude as P import qualified Data.Primitive.Contiguous as A@@ -57,10 +57,6 @@  newtype Set arr a = Set (arr a) -instance Contiguous arr => PrimUnlifted (Set arr a) where-  toArrayArray# (Set a) = A.unlift a-  fromArrayArray# a = Set (A.lift a)- append :: (Contiguous arr, Element arr a, Ord a) => Set arr a -> Set arr a -> Set arr a append (Set x) (Set y) = Set (unionArr x y)   @@ -261,6 +257,20 @@             EQ -> True             GT -> go (mid + 1) end {-# INLINEABLE member #-}++lookupIndex :: forall arr a. (Contiguous arr, Element arr a, Ord a) => a -> Set arr a -> Maybe Int+lookupIndex a (Set arr) = go 0 (A.size arr - 1) where+  go :: Int -> Int -> Maybe Int+  go !start !end = if end < start+    then Nothing+    else+      let !mid = div (end + start) 2+          !v = A.index arr mid+       in case P.compare a v of+            LT -> go start (mid - 1)+            EQ -> Just mid+            GT -> go (mid + 1) end+{-# INLINEABLE lookupIndex #-}  concat :: forall arr a. (Contiguous arr, Element arr a, Ord a) => [Set arr a] -> Set arr a concat = C.concatSized size empty append
src/Data/Set/Lifted.hs view
@@ -10,6 +10,7 @@   , singleton   , null   , member+  , lookupIndex   , size   , difference   , (\\)@@ -69,6 +70,11 @@ -- | Test whether or not an element is present in a set. member :: Ord a => a -> Set a -> Bool member a (Set s) = I.member a s++-- | /O(log n)/. Lookup the /index/ of an element, which is+-- its zero-based index in the sorted sequence of elements. +lookupIndex :: Ord a => a -> Set a -> Maybe Int+lookupIndex a (Set s) = I.lookupIndex a s  -- | Construct a set with a single element. singleton :: a -> Set a
src/Data/Set/Lifted/Internal.hs view
@@ -15,7 +15,6 @@  import Prelude hiding (foldr) -import Data.Primitive.UnliftedArray (PrimUnlifted(..)) import Data.Functor.Classes (Eq1(liftEq),Show1(liftShowsPrec)) import Data.Hashable (Hashable) import Data.Hashable.Lifted (Hashable1)@@ -36,10 +35,6 @@   foldr = foldr   foldl' = foldl'   foldr' = foldr'--instance PrimUnlifted (Set a) where-  toArrayArray# (Set x) = toArrayArray# x-  fromArrayArray# y = Set (fromArrayArray# y)  instance Ord a => Semigroup (Set a) where   Set x <> Set y = Set (I.append x y)
src/Data/Set/NonEmpty/Unlifted.hs view
@@ -30,7 +30,8 @@ import Prelude hiding (foldr,foldMap,null)  import Data.Hashable (Hashable)-import Data.Primitive.UnliftedArray (PrimUnlifted(..),UnliftedArray)+import Data.Primitive.Unlifted.Array (UnliftedArray)+import Data.Primitive.Unlifted.Class (PrimUnlifted) import Data.Semigroup (Semigroup) import Data.List.NonEmpty (NonEmpty) @@ -44,10 +45,6 @@ import qualified Data.Set.Unlifted.Internal as SI  newtype Set a = Set (I.Set UnliftedArray a)--instance PrimUnlifted (Set a) where-  toArrayArray# (Set x) = toArrayArray# x-  fromArrayArray# y = Set (fromArrayArray# y)  instance (Ord a, PrimUnlifted a) => Semigroup (Set a) where   Set x <> Set y = Set (I.append x y)
src/Data/Set/Unboxed.hs view
@@ -40,7 +40,7 @@ import Data.Hashable (Hashable) import Data.Primitive.PrimArray (PrimArray) import Data.Primitive.Types (Prim)-import Data.Primitive.UnliftedArray (PrimUnlifted(..))+import Data.Primitive.Unlifted.Class (PrimUnlifted(..)) import Data.Semigroup (Semigroup) import Data.Set.Unboxed.Internal (Set(..)) import qualified Data.Foldable as F
src/Data/Set/Unboxed/Internal.hs view
@@ -13,7 +13,7 @@ import Prelude hiding (foldr)  import Data.Hashable (Hashable)-import Data.Primitive (Prim,PrimArray,Array,PrimUnlifted(..))+import Data.Primitive (Prim,PrimArray,Array) import Data.Semigroup (Semigroup) import Text.Show (showListWith) @@ -25,10 +25,6 @@  -- | A set of elements. newtype Set a = Set (I.Set PrimArray a)--instance PrimUnlifted (Set a) where-  toArrayArray# (Set x) = toArrayArray# x-  fromArrayArray# y = Set (fromArrayArray# y)  instance (Prim a, Ord a) => Semigroup (Set a) where   Set x <> Set y = Set (I.append x y)
src/Data/Set/Unlifted.hs view
@@ -35,7 +35,8 @@  import Prelude hiding (foldr,foldMap,null,enumFromTo) -import Data.Primitive.UnliftedArray (UnliftedArray, PrimUnlifted(..))+import Data.Primitive.Unlifted.Array (UnliftedArray)+import Data.Primitive.Unlifted.Class (PrimUnlifted) import Data.Semigroup (Semigroup) import Data.Set.Unlifted.Internal (Set(..)) import qualified Data.Set.Internal as I
src/Data/Set/Unlifted/Internal.hs view
@@ -13,7 +13,8 @@ import Prelude hiding (foldr)  import Data.Hashable (Hashable)-import Data.Primitive.UnliftedArray (PrimUnlifted(..),UnliftedArray)+import Data.Primitive.Unlifted.Array (UnliftedArray)+import Data.Primitive.Unlifted.Class (PrimUnlifted) import Data.Primitive (Array) import Data.Semigroup (Semigroup) @@ -24,10 +25,6 @@ import qualified GHC.Exts as E  newtype Set a = Set { getSet :: I.Set UnliftedArray a }--instance PrimUnlifted (Set a) where-  toArrayArray# (Set x) = toArrayArray# x-  fromArrayArray# y = Set (fromArrayArray# y)  instance (Ord a, PrimUnlifted a) => Semigroup (Set a) where   Set x <> Set y = Set (I.append x y)
test/Main.hs view
@@ -25,17 +25,10 @@ import Control.Monad (forM) import Data.Bool (bool) import Data.Continuous.Set.Lifted (Inclusivity(..))-import Data.Dependent.Map.Class (Universally(..),ApplyUniversally(..))-import Data.Exists (EqForeach(..),OrdForeach(..),EqForallPoly(..),OrdForallPoly(..),Sing)-import Data.Exists (FromJSONForeach(..),SemigroupForeach(..))-import Data.Exists (PrimForall(..),ToJSONKeyForall(..),ToJSONKeyFunctionForall(..))-import Data.Exists (ToJSONForeach(..),FromJSONKeyExists(..),Exists(..))-import Data.Exists (ToSing(..),DependentPair(..),ShowForall(..),ShowForeach(..))-import Data.Exists (WitnessedEquality(..),WitnessedOrdering(..),EqForall(..),OrdForall(..)) import Data.Functor.Const (Const(..)) import Data.Kind (Type) import Data.List.NonEmpty (NonEmpty((:|)))-import Data.Primitive.UnliftedArray (PrimUnlifted)+import Data.Primitive.Unlifted.Class (PrimUnlifted) import Data.Proxy (Proxy(..)) import Data.Semigroup (Semigroup) import Test.HUnit.Base (assertEqual)@@ -44,8 +37,6 @@ import Test.Tasty.HUnit (testCase,(@?=)) import Text.Read (readMaybe) import Unsafe.Coerce (unsafeCoerce)-import qualified Data.Aeson as AE-import qualified Data.Aeson.Encoding as AEE import qualified Data.Text as T import qualified Test.Tasty.QuickCheck as TQC import qualified Test.QuickCheck as QC@@ -68,8 +59,6 @@ import qualified Data.Diet.Set.Lifted as DSL import qualified Data.Continuous.Set.Lifted as CSL import qualified Data.Diet.Unbounded.Set.Lifted as DUSL-import qualified Data.Dependent.Map.Lifted.Lifted as DPMLL-import qualified Data.Dependent.Map.Unboxed.Lifted as DPMUL import qualified Data.Map.Subset.Strict.Lifted as MSL import qualified Data.Map.Interval.DBTSLL as MIDBTS @@ -180,29 +169,6 @@         ]       ]     ]-  , testGroup "Dependent"-    [ testGroup "Map"-      [ -- testGroup "Lifted"-        -- [ testGroup "Lifted"-        --   [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (DPMLL.Map Key Value)))-        --   , lawsToTest (QCC.ordLaws (Proxy :: Proxy (DPMLL.Map Key Value)))-        --   , lawsToTest (QCC.isListLaws (Proxy :: Proxy (DPMLL.Map Key Value)))-        --   , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (DPMLL.Map Key Value)))-        --   , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (DPMLL.Map Key Value)))-        --   ]-        -- ]-        testGroup "Unboxed"-        [ testGroup "Lifted"-          [ lawsToTest (QCC.eqLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))-          , lawsToTest (QCC.ordLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))-          , lawsToTest (QCC.isListLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))-          , lawsToTest (QCC.jsonLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))-          , lawsToTest (QCC.semigroupLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))-          , lawsToTest (QCC.monoidLaws (Proxy :: Proxy (DPMUL.Map UnboxedKey Value)))-          ]-        ]-      ]-    ]   , testGroup "Continuous"     [ testGroup "Set"       [ testGroup "Lifted"@@ -729,251 +695,9 @@  deriving instance Arbitrary a => Arbitrary (SG.First a) -data Universe-  = UniverseInt-  | UniverseOrdering-  | UniverseBool-  | UniverseChar--data SingUniverse :: Universe -> Type where-  SingUniverseInt :: SingUniverse 'UniverseInt-  SingUniverseOrdering :: SingUniverse 'UniverseOrdering-  SingUniverseBool :: SingUniverse 'UniverseBool-  SingUniverseChar :: SingUniverse 'UniverseChar--deriving instance Show (SingUniverse u)--type instance Sing = SingUniverse--type family Interpret (u :: Universe) :: Type where-  Interpret 'UniverseInt = Integer-  Interpret 'UniverseOrdering = Ordering-  Interpret 'UniverseBool = Bool-  Interpret 'UniverseChar = Char--newtype Value :: Universe -> Type where-  Value :: Interpret u -> Value u--instance EqForeach Value where-  eqForeach SingUniverseInt (Value x) (Value y) = x == y-  eqForeach SingUniverseOrdering (Value x) (Value y) = x == y-  eqForeach SingUniverseBool (Value x) (Value y) = x == y-  eqForeach SingUniverseChar (Value x) (Value y) = x == y--instance OrdForeach Value where-  compareForeach SingUniverseInt (Value x) (Value y) = compare x y-  compareForeach SingUniverseOrdering (Value x) (Value y) = compare x y-  compareForeach SingUniverseBool (Value x) (Value y) = compare x y-  compareForeach SingUniverseChar (Value x) (Value y) = compare x y--instance ShowForeach Value where-  showsPrecForeach SingUniverseInt p (Value x) = showsPrec p x-  showsPrecForeach SingUniverseBool p (Value x) = showsPrec p x-  showsPrecForeach SingUniverseOrdering p (Value x) = showsPrec p x-  showsPrecForeach SingUniverseChar p (Value x) = showsPrec p x--instance SemigroupForeach Value where-  appendForeach SingUniverseInt (Value x) (Value y) = Value (x + y)-  appendForeach SingUniverseBool (Value x) (Value y) = Value (x && y)-  appendForeach SingUniverseOrdering (Value x) (Value y) = Value (x <> y)-  appendForeach SingUniverseChar (Value x) (Value _) = Value x- -- This type interpret the lowest two bits of the Word8 -- as the Universe value. Doing this is unsafe, but if the -- data constructor of a type like this is not exported, it -- is possible to build safe interfaces on top of this. newtype UnboxedKey u = UnboxedKey Word8   deriving (Show,Prim,Eq,Ord)--unboxedIntKey :: Word8 -> UnboxedKey 'UniverseInt-unboxedIntKey w = UnboxedKey (w * 4 + 0)--unboxedBoolKey :: Word8 -> UnboxedKey 'UniverseBool-unboxedBoolKey w = UnboxedKey (w * 4 + 1)--unboxedOrderingKey :: Word8 -> UnboxedKey 'UniverseOrdering-unboxedOrderingKey w = UnboxedKey (w * 4 + 2)--unboxedCharKey :: Word8 -> UnboxedKey 'UniverseChar-unboxedCharKey w = UnboxedKey (w * 4 + 3)--instance ToJSONKeyForall UnboxedKey where-  toJSONKeyForall = ToJSONKeyTextForall-    (\(UnboxedKey n) -> T.pack (show n))-    (\(UnboxedKey n) -> AEE.text (T.pack (show n)))--instance FromJSONKeyExists UnboxedKey where-  fromJSONKeyExists = AE.FromJSONKeyTextParser-    (\t -> case readMaybe (T.unpack t) of-      Nothing -> fail "Value, FromJSONKeyExists: bad value"-      Just w -> return (Exists (UnboxedKey w))-    )--instance FromJSONForeach Value where-  parseJSONForeach SingUniverseInt = fmap Value . AE.parseJSON -  parseJSONForeach SingUniverseBool = fmap Value . AE.parseJSON-  parseJSONForeach SingUniverseOrdering = fmap Value . AE.parseJSON-  parseJSONForeach SingUniverseChar = fmap Value . AE.parseJSON--instance ToJSONForeach Value where-  toJSONForeach SingUniverseInt (Value a) = AE.toJSON a-  toJSONForeach SingUniverseBool (Value a) = AE.toJSON a-  toJSONForeach SingUniverseOrdering (Value a) = AE.toJSON a-  toJSONForeach SingUniverseChar (Value a) = AE.toJSON a--instance ToSing UnboxedKey where-  toSing (UnboxedKey w) = case mod w 4 of-    0 -> unsafeCoerce SingUniverseInt-    1 -> unsafeCoerce SingUniverseBool-    2 -> unsafeCoerce SingUniverseOrdering-    _ -> unsafeCoerce SingUniverseChar--instance ShowForall UnboxedKey where-  showsPrecForall = showsPrec--instance EqForall UnboxedKey where-  eqForall = (==)--instance EqForallPoly UnboxedKey where-  eqForallPoly (UnboxedKey a) (UnboxedKey b) = if a == b-    then unsafeCoerce WitnessedEqualityEqual-    else WitnessedEqualityUnequal--instance OrdForall UnboxedKey where-  compareForall = compare--instance OrdForallPoly UnboxedKey where-  compareForallPoly (UnboxedKey a) (UnboxedKey b) = case compare a b of-    LT -> WitnessedOrderingLT-    GT -> WitnessedOrderingGT-    EQ -> unsafeCoerce WitnessedOrderingEQ--data Key u = Key !Int !(SingUniverse u)-  deriving (Show)--instance ShowForall Key where-  showsPrecForall = showsPrec--instance ToSing Key where-  toSing (Key _ s) = s--instance EqForall Key where-  eqForall (Key i1 _) (Key i2 _) = i1 == i2--instance OrdForall Key where-  compareForall (Key i1 _) (Key i2 _) = compare i1 i2--instance EqForallPoly Key where-  eqForallPoly (Key i1 s1) (Key i2 s2) = if i1 == i2-    then case s1 of-      SingUniverseInt -> case s2 of-        SingUniverseInt -> WitnessedEqualityEqual-        _ -> WitnessedEqualityUnequal-      SingUniverseOrdering -> case s2 of-        SingUniverseOrdering -> WitnessedEqualityEqual-        _ -> WitnessedEqualityUnequal-      SingUniverseBool -> case s2 of-        SingUniverseBool -> WitnessedEqualityEqual-        _ -> WitnessedEqualityUnequal-      SingUniverseChar -> case s2 of-        SingUniverseChar -> WitnessedEqualityEqual-        _ -> WitnessedEqualityUnequal-    else WitnessedEqualityUnequal--instance EqForall SingUniverse where-  eqForall _ _ = True--instance OrdForall SingUniverse where-  compareForall _ _ = EQ--instance EqForallPoly SingUniverse where-  eqForallPoly SingUniverseInt SingUniverseInt = WitnessedEqualityEqual-  eqForallPoly SingUniverseInt _ = WitnessedEqualityUnequal-  eqForallPoly SingUniverseBool SingUniverseBool = WitnessedEqualityEqual-  eqForallPoly SingUniverseBool _ = WitnessedEqualityUnequal-  eqForallPoly SingUniverseOrdering SingUniverseOrdering = WitnessedEqualityEqual-  eqForallPoly SingUniverseOrdering _ = WitnessedEqualityUnequal-  eqForallPoly SingUniverseChar SingUniverseChar = WitnessedEqualityEqual-  eqForallPoly SingUniverseChar _ = WitnessedEqualityUnequal--instance OrdForallPoly SingUniverse where-  compareForallPoly SingUniverseInt SingUniverseInt      = WitnessedOrderingEQ-  compareForallPoly SingUniverseInt SingUniverseOrdering = WitnessedOrderingLT-  compareForallPoly SingUniverseInt SingUniverseBool     = WitnessedOrderingLT-  compareForallPoly SingUniverseInt SingUniverseChar     = WitnessedOrderingLT-  compareForallPoly SingUniverseOrdering SingUniverseInt      = WitnessedOrderingGT-  compareForallPoly SingUniverseOrdering SingUniverseOrdering = WitnessedOrderingEQ-  compareForallPoly SingUniverseOrdering SingUniverseBool     = WitnessedOrderingLT-  compareForallPoly SingUniverseOrdering SingUniverseChar     = WitnessedOrderingLT-  compareForallPoly SingUniverseBool SingUniverseInt      = WitnessedOrderingGT-  compareForallPoly SingUniverseBool SingUniverseOrdering = WitnessedOrderingGT-  compareForallPoly SingUniverseBool SingUniverseBool     = WitnessedOrderingEQ-  compareForallPoly SingUniverseBool SingUniverseChar     = WitnessedOrderingLT-  compareForallPoly SingUniverseChar SingUniverseInt      = WitnessedOrderingGT-  compareForallPoly SingUniverseChar SingUniverseOrdering = WitnessedOrderingGT-  compareForallPoly SingUniverseChar SingUniverseBool     = WitnessedOrderingGT-  compareForallPoly SingUniverseChar SingUniverseChar     = WitnessedOrderingEQ--instance OrdForallPoly Key where-  compareForallPoly (Key i1 s1) (Key i2 s2) = case compare i1 i2 of-    LT -> WitnessedOrderingLT-    GT -> WitnessedOrderingGT-    EQ -> compareForallPoly s1 s2--class ArbitraryDependentPair k v where-  arbitraryDependentPair :: Gen (DependentPair k v)--instance ArbitraryDependentPair k v => Arbitrary (DependentPair k v) where-  arbitrary = arbitraryDependentPair--instance ArbitraryDependentPair Key Value where-  arbitraryDependentPair = do-    (i :: Int) <- QC.choose (0, 10)-    QC.oneof-      [ DependentPair (Key i SingUniverseInt) . Value <$> QC.arbitrary-      , DependentPair (Key i SingUniverseBool) . Value <$> QC.arbitrary-      , DependentPair (Key i SingUniverseChar) . Value <$> QC.arbitrary-      , DependentPair (Key i SingUniverseOrdering) . Value <$> QC.arbitrary-      ]--instance ArbitraryDependentPair UnboxedKey Value where-  arbitraryDependentPair = do-    (i :: Word8) <- QC.choose (0, 10)-    QC.oneof-      [ DependentPair (unboxedIntKey i) . Value <$> QC.arbitrary-      , DependentPair (unboxedBoolKey i) . Value <$> QC.arbitrary-      , DependentPair (unboxedCharKey i) . Value <$> QC.arbitrary-      , DependentPair (unboxedOrderingKey i) . Value <$> QC.arbitrary-      ]-    -instance (ArbitraryDependentPair k v, OrdForallPoly k) => Arbitrary (DPMLL.Map k v) where-  arbitrary = do-    len <- QC.choose (0,35)-    DPMLL.fromList <$> QC.vectorOf len arbitraryDependentPair--instance (ArbitraryDependentPair k v, OrdForallPoly k, Universally k Prim, ApplyUniversally k Prim) => Arbitrary (DPMUL.Map k v) where-  arbitrary = do-    len <- QC.choose (0,35)-    DPMUL.fromList <$> QC.vectorOf len arbitraryDependentPair--instance Universally UnboxedKey Prim where-  universally _ _ _ x = x--instance ApplyUniversally UnboxedKey Prim where-  applyUniversallyLifted _ _ _ x = x-  applyUniversallyUnlifted _ _ _ x = x---- very unsafe instance-instance PrimForall UnboxedKey where-  sizeOfForall# _ = sizeOf# (undefined :: UnboxedKey a)-  alignmentForall# _ = alignment# (undefined :: UnboxedKey a)-  indexByteArrayForall# = indexByteArray#-  readByteArrayForall# = readByteArray#-  writeByteArrayForall# = writeByteArray#-  setByteArrayForall# = setByteArray#-  readOffAddrForall# = readOffAddr#-  writeOffAddrForall# = writeOffAddr#-  indexOffAddrForall# = indexOffAddr#-  setOffAddrForall# = setOffAddr#--