[project @ 2005-09-18 02:22:33 by dons]

[haskell-directory.git] / Data / Sequence.hs

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 7ff4403..bc3a743 100644 (file)
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -cpp #-}
+{-# OPTIONS -cpp -fglasgow-exts #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Sequence
@@ -22,7 +22,7 @@
 --
 --    * Ralf Hinze and Ross Paterson,
 --     \"Finger trees: a simple general-purpose data structure\",
---     submitted to /Journal of Functional Programming/.
+--     to appear in /Journal of Functional Programming/.
 --     <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
 --
 -- /Note/: Many of these operations have the same names as similar
@@ -83,6 +83,9 @@ import qualified Prelude (foldr)
 import qualified Data.List (foldl', intersperse)
 import Data.FunctorM
 import Data.Typeable
+#ifdef __GLASGOW_HASKELL__
+import GHC.Exts (build)
+#endif
 
 #if TESTING
 import Control.Monad (liftM, liftM2, liftM3, liftM4)
@@ -90,7 +93,8 @@ import Test.QuickCheck
 #endif
 
 #if __GLASGOW_HASKELL__
-import Data.Generics.Basics (Data(..), mkNorepType)
+import Data.Generics.Basics (Data(..), Fixity(..),
+                       constrIndex, mkConstr, mkDataType)
 #endif
 
 infixr 5 `consTree`
@@ -120,7 +124,7 @@ instance Ord a => Ord (Seq a) where
        compare xs ys = compare (toList xs) (toList ys)
 
 #if TESTING
-instance (Show a) => Show (Seq a) where
+instance Show a => Show (Seq a) where
        showsPrec p (Seq x) = showsPrec p x
 #else
 instance Show a => Show (Seq a) where
@@ -143,18 +147,26 @@ INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
 
 #if __GLASGOW_HASKELL__
 instance Data a => Data (Seq a) where
-       gfoldl f z      = gfoldSeq f z id
-       toConstr _      = error "toConstr"
-       gunfold _ _     = error "gunfold"
-       dataTypeOf _    = mkNorepType "Data.Sequence.Seq"
-
--- Treat the type as consisting of constructors of arity 0, 1, 2, ...
-gfoldSeq :: Data a => (forall a b. Data a => c (a -> b) -> a -> c b) ->
-       (forall g. g -> c g) -> (Seq a -> r) -> Seq a -> c r
-gfoldSeq f z k s = case viewr s of
-       EmptyR -> z (k empty)
-       xs :> x -> gfoldSeq f z (snoc k) xs `f` x
-  where        snoc k xs x = k (xs |> x)
+       gfoldl f z s    = case viewl s of
+               EmptyL  -> z empty
+               x :< xs -> z (<|) `f` x `f` xs
+
+       gunfold k z c   = case constrIndex c of
+               1 -> z empty
+               2 -> k (k (z (<|)))
+               _ -> error "gunfold"
+
+       toConstr xs
+         | null xs     = emptyConstr
+         | otherwise   = consConstr
+
+       dataTypeOf _    = seqDataType
+
+       dataCast1       = gcast1
+
+emptyConstr = mkConstr seqDataType "empty" [] Prefix
+consConstr  = mkConstr seqDataType "<|" [] Infix
+seqDataType = mkDataType "Data.Sequence.Seq" [emptyConstr, consConstr]
 #endif
 
 -- Finger trees
@@ -168,6 +180,8 @@ data FingerTree a
 #endif
 
 instance Sized a => Sized (FingerTree a) where
+       {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}
+       {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}
        size Empty              = 0
        size (Single x)         = size x
        size (Deep v _ _ _)     = v
@@ -179,6 +193,8 @@ instance Functor FingerTree where
                Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
 
 {-# INLINE deep #-}
+{-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
+{-# SPECIALIZE 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
 
@@ -200,6 +216,8 @@ instance Functor Digit where
        fmap f (Four a b c d) = Four (f a) (f b) (f c) (f d)
 
 instance Sized a => Sized (Digit a) where
+       {-# SPECIALIZE instance Sized (Digit (Elem a)) #-}
+       {-# SPECIALIZE instance Sized (Digit (Node a)) #-}
        size xs = foldlDigit (\ i x -> i + size x) 0 xs
 
 {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-}
@@ -228,10 +246,14 @@ 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
 
@@ -862,7 +884,12 @@ fromList   =  Data.List.foldl' (|>) empty
 
 -- | /O(n)/. List of elements of the sequence.
 toList         :: Seq a -> [a]
+#ifdef __GLASGOW_HASKELL__
+{-# INLINE toList #-}
+toList xs      =  build (\ c n -> foldr c n xs)
+#else
 toList         =  foldr (:) []
+#endif
 
 ------------------------------------------------------------------------
 -- Folds