--
-- * 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
#endif
#if __GLASGOW_HASKELL__
-import Data.Generics.Basics (Data(..), mkNorepType)
+import Data.Generics.Basics (Data(..), Fixity(..),
+ constrIndex, mkConstr, mkDataType)
#endif
infixr 5 `consTree`
#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
#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
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) #-}