Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers On branch : master
http://hackage.haskell.org/trac/ghc/changeset/68cc2e86ecc6d57943906a96d99ce2be3958d60f >--------------------------------------------------------------- commit 68cc2e86ecc6d57943906a96d99ce2be3958d60f Author: Milan Straka <[email protected]> Date: Sun Mar 4 18:54:28 2012 +0100 Fix Data.Sequence warnings. As GHC HEAD found out, methods deep, node2, node3 were both INLINE and SPECIALIZE. Make them INLINE only. Also the -Wwarn option can be removed. >--------------------------------------------------------------- Data/Sequence.hs | 18 ------------------ 1 files changed, 0 insertions(+), 18 deletions(-) diff --git a/Data/Sequence.hs b/Data/Sequence.hs index 5f430ab..c6263d5 100644 --- a/Data/Sequence.hs +++ b/Data/Sequence.hs @@ -5,18 +5,6 @@ #if __GLASGOW_HASKELL__ >= 703 {-# LANGUAGE Trustworthy #-} #endif -{-# OPTIONS_GHC -Wwarn #-} - --- The above -Wwarn is due to e.g. >--------------------------------------------------------------- --- {-# INLINE deep #-} --- {-# SPECIALIZE INLINE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) --- -> Digit (Elem a) -> FingerTree (Elem a) #-} >--------------------------------------------------------------- --- SPECIALISE really is wrong here. We should either specialise or --- inline. Not sure which is wanted. Newer GHCs will emit a warning --- in this case. - ----------------------------------------------------------------------------- -- | -- Module : Data.Sequence @@ -335,8 +323,6 @@ instance NFData a => NFData (FingerTree a) where rnf (Deep _ pr m sf) = rnf pr `seq` rnf m `seq` rnf sf {-# INLINE deep #-} -{-# SPECIALIZE INLINE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} -{-# SPECIALIZE INLINE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a deep pr m sf = Deep (size pr + size m + size sf) pr m sf @@ -471,14 +457,10 @@ instance Sized (Node a) where size (Node3 v _ _ _) = v {-# INLINE node2 #-} -{-# SPECIALIZE node2 :: Elem a -> Elem a -> Node (Elem a) #-} -{-# SPECIALIZE node2 :: Node a -> Node a -> Node (Node a) #-} node2 :: Sized a => a -> a -> Node a node2 a b = Node2 (size a + size b) a b {-# INLINE node3 #-} -{-# SPECIALIZE node3 :: Elem a -> Elem a -> Elem a -> Node (Elem a) #-} -{-# SPECIALIZE node3 :: Node a -> Node a -> Node a -> Node (Node a) #-} node3 :: Sized a => a -> a -> a -> Node a node3 a b c = Node3 (size a + size b + size c) a b c _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
