[commit: ghc] wip/drop-containers-dep-from-th: Drop external build-dep on `containers` (4233489)
git at git.haskell.org
git at git.haskell.org
Thu Apr 24 07:35:16 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/drop-containers-dep-from-th
Link : http://ghc.haskell.org/trac/ghc/changeset/4233489aecca5a3426ea48401c99ae95b4dfc23e/ghc
>---------------------------------------------------------------
commit 4233489aecca5a3426ea48401c99ae95b4dfc23e
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date: Thu Apr 24 09:05:45 2014 +0200
Drop external build-dep on `containers`
This is an attempt to address
https://github.com/haskell/cabal/issues/1811
by ripping the less than 100 lines of code actually used from the
containers package into an internal non-exposed `template-haskell` module.
Moreover, `template-haskell` does not expose the `Map` type, so this change should
have no visible effect on the public API.
Signed-off-by: Herbert Valerio Riedel <hvr at gnu.org>
>---------------------------------------------------------------
4233489aecca5a3426ea48401c99ae95b4dfc23e
.../Language/Haskell/TH/Lib/Map.hs | 108 ++++++++++++++++++++
.../template-haskell/Language/Haskell/TH/PprLib.hs | 4 +-
libraries/template-haskell/template-haskell.cabal | 4 +-
testsuite/tests/th/TH_Roles2.stderr | 13 ++-
4 files changed, 119 insertions(+), 10 deletions(-)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs
new file mode 100644
index 0000000..ac24151
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE BangPatterns #-}
+
+-- This is a non-exposed internal module
+--
+-- The code in this module has been ripped from containers-0.5.5.1:Data.Map.Base [1] almost
+-- verbatimely to avoid a dependency of 'template-haskell' on the containers package.
+--
+-- [1] see https://hackage.haskell.org/package/containers-0.5.5.1
+--
+-- The original code is BSD-licensed and copyrighted by Daan Leijen, Andriy Palamarchuk, et al.
+
+module Language.Haskell.TH.Lib.Map
+ ( Map
+ , empty
+ , insert
+ , Language.Haskell.TH.Lib.Map.lookup
+ ) where
+
+data Map k a = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a)
+ | Tip
+
+type Size = Int
+
+empty :: Map k a
+empty = Tip
+{-# INLINE empty #-}
+
+singleton :: k -> a -> Map k a
+singleton k x = Bin 1 k x Tip Tip
+{-# INLINE singleton #-}
+
+size :: Map k a -> Int
+size Tip = 0
+size (Bin sz _ _ _ _) = sz
+{-# INLINE size #-}
+
+lookup :: Ord k => k -> Map k a -> Maybe a
+lookup = go
+ where
+ go _ Tip = Nothing
+ go !k (Bin _ kx x l r) = case compare k kx of
+ LT -> go k l
+ GT -> go k r
+ EQ -> Just x
+{-# INLINABLE lookup #-}
+
+
+insert :: Ord k => k -> a -> Map k a -> Map k a
+insert = go
+ where
+ go :: Ord k => k -> a -> Map k a -> Map k a
+ go !kx x Tip = singleton kx x
+ go !kx x (Bin sz ky y l r) =
+ case compare kx ky of
+ LT -> balanceL ky y (go kx x l) r
+ GT -> balanceR ky y l (go kx x r)
+ EQ -> Bin sz kx x l r
+{-# INLINABLE insert #-}
+
+balanceL :: k -> a -> Map k a -> Map k a -> Map k a
+balanceL k x l r = case r of
+ Tip -> case l of
+ Tip -> Bin 1 k x Tip Tip
+ (Bin _ _ _ Tip Tip) -> Bin 2 k x l Tip
+ (Bin _ lk lx Tip (Bin _ lrk lrx _ _)) -> Bin 3 lrk lrx (Bin 1 lk lx Tip Tip) (Bin 1 k x Tip Tip)
+ (Bin _ lk lx ll@(Bin _ _ _ _ _) Tip) -> Bin 3 lk lx ll (Bin 1 k x Tip Tip)
+ (Bin ls lk lx ll@(Bin lls _ _ _ _) lr@(Bin lrs lrk lrx lrl lrr))
+ | lrs < ratio*lls -> Bin (1+ls) lk lx ll (Bin (1+lrs) k x lr Tip)
+ | otherwise -> Bin (1+ls) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+size lrr) k x lrr Tip)
+
+ (Bin rs _ _ _ _) -> case l of
+ Tip -> Bin (1+rs) k x Tip r
+
+ (Bin ls lk lx ll lr)
+ | ls > delta*rs -> case (ll, lr) of
+ (Bin lls _ _ _ _, Bin lrs lrk lrx lrl lrr)
+ | lrs < ratio*lls -> Bin (1+ls+rs) lk lx ll (Bin (1+rs+lrs) k x lr r)
+ | otherwise -> Bin (1+ls+rs) lrk lrx (Bin (1+lls+size lrl) lk lx ll lrl) (Bin (1+rs+size lrr) k x lrr r)
+ (_, _) -> error "Failure in Data.Map.balanceL"
+ | otherwise -> Bin (1+ls+rs) k x l r
+{-# NOINLINE balanceL #-}
+
+balanceR :: k -> a -> Map k a -> Map k a -> Map k a
+balanceR k x l r = case l of
+ Tip -> case r of
+ Tip -> Bin 1 k x Tip Tip
+ (Bin _ _ _ Tip Tip) -> Bin 2 k x Tip r
+ (Bin _ rk rx Tip rr@(Bin _ _ _ _ _)) -> Bin 3 rk rx (Bin 1 k x Tip Tip) rr
+ (Bin _ rk rx (Bin _ rlk rlx _ _) Tip) -> Bin 3 rlk rlx (Bin 1 k x Tip Tip) (Bin 1 rk rx Tip Tip)
+ (Bin rs rk rx rl@(Bin rls rlk rlx rll rlr) rr@(Bin rrs _ _ _ _))
+ | rls < ratio*rrs -> Bin (1+rs) rk rx (Bin (1+rls) k x Tip rl) rr
+ | otherwise -> Bin (1+rs) rlk rlx (Bin (1+size rll) k x Tip rll) (Bin (1+rrs+size rlr) rk rx rlr rr)
+
+ (Bin ls _ _ _ _) -> case r of
+ Tip -> Bin (1+ls) k x l Tip
+
+ (Bin rs rk rx rl rr)
+ | rs > delta*ls -> case (rl, rr) of
+ (Bin rls rlk rlx rll rlr, Bin rrs _ _ _ _)
+ | rls < ratio*rrs -> Bin (1+ls+rs) rk rx (Bin (1+ls+rls) k x l rl) rr
+ | otherwise -> Bin (1+ls+rs) rlk rlx (Bin (1+ls+size rll) k x l rll) (Bin (1+rrs+size rlr) rk rx rlr rr)
+ (_, _) -> error "Failure in Data.Map.balanceR"
+ | otherwise -> Bin (1+ls+rs) k x l r
+{-# NOINLINE balanceR #-}
+
+delta,ratio :: Int
+delta = 3
+ratio = 2
diff --git a/libraries/template-haskell/Language/Haskell/TH/PprLib.hs b/libraries/template-haskell/Language/Haskell/TH/PprLib.hs
index 93e37ce..c4b0b77 100644
--- a/libraries/template-haskell/Language/Haskell/TH/PprLib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/PprLib.hs
@@ -40,8 +40,8 @@ import Language.Haskell.TH.Syntax
import qualified Text.PrettyPrint as HPJ
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, liftM2, ap)
-import Data.Map ( Map )
-import qualified Data.Map as Map ( lookup, insert, empty )
+import Language.Haskell.TH.Lib.Map ( Map )
+import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty )
import GHC.Base (Int(..))
infixl 6 <>
diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal
index ca0e344..fb8dbd7 100644
--- a/libraries/template-haskell/template-haskell.cabal
+++ b/libraries/template-haskell/template-haskell.cabal
@@ -42,9 +42,11 @@ Library
Language.Haskell.TH.Quote
Language.Haskell.TH.Syntax
+ other-modules:
+ Language.Haskell.TH.Lib.Map
+
build-depends:
base == 4.7.*,
- containers == 0.5.*,
pretty == 1.1.*
-- We need to set the package name to template-haskell (without a
diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr
index a4526e1..bd44d12 100644
--- a/testsuite/tests/th/TH_Roles2.stderr
+++ b/testsuite/tests/th/TH_Roles2.stderr
@@ -2,15 +2,14 @@ TYPE SIGNATURES
TYPE CONSTRUCTORS
T :: k -> *
data T (k::BOX) (a::k)
- No C type associated
- Roles: [nominal, representational]
- RecFlag NonRecursive, Not promotable
- =
- FamilyInstance: none
+ No C type associated
+ Roles: [nominal, representational]
+ RecFlag NonRecursive, Not promotable
+ =
+ FamilyInstance: none
COERCION AXIOMS
Dependent modules: []
-Dependent packages: [array-0.5.0.0, base, containers-0.5.5.1,
- deepseq-1.3.0.2, ghc-prim, integer-gmp, pretty-1.1.1.1,
+Dependent packages: [base, ghc-prim, integer-gmp, pretty-1.1.1.1,
template-haskell]
==================== Typechecker ====================
More information about the ghc-commits
mailing list