<commit_before>{-# OPTIONS -cpp -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Sequence
-- Copyright   :  (c) <NAME> 2005
-- License     :  BSD-style
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  portable
--
-- General purpose finite sequences.
-- Apart from being finite and having strict operations, sequences
-- also differ from lists in supporting a wider variety of operations
-- efficiently.
--
-- An amortized running time is given for each operation, with /n/ referring
-- to the length of the sequence and /i/ being the integral index used by
-- some operations.  These bounds hold even in a persistent (shared) setting.
--
-- The implementation uses 2-3 finger trees annotated with sizes,
-- as described in section 4.2 of
--
--    * <NAME> and <NAME>,
--	\"Finger trees: a simple general-purpose data structure\",
--	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
-- operations on lists in the "Prelude".  The ambiguity may be resolved
-- using either qualification or the @hiding@ clause.
--
-----------------------------------------------------------------------------

module Data.Sequence (
	Seq,
	-- * Construction
	empty,		-- :: Seq a
	singleton,	-- :: a -> Seq a
	(<|),		-- :: a -> Seq a -> Seq a
	(|>),		-- :: Seq a -> a -> Seq a
	(><),		-- :: Seq a -> Seq a -> Seq a
	-- * Deconstruction
	-- ** Queries
	null,		-- :: Seq a -> Bool
	length,		-- :: Seq a -> Int
	-- ** Views
	ViewL(..),
	viewl,		-- :: Seq a -> ViewL a
	ViewR(..),
	viewr,		-- :: Seq a -> ViewR a
	-- ** Indexing
	index,		-- :: Seq a -> Int -> a
	adjust,		-- :: (a -> a) -> Int -> Seq a -> Seq a
	update,		-- :: Int -> a -> Seq a -> Seq a
	take,		-- :: Int -> Seq a -> Seq a
	drop,		-- :: Int -> Seq a -> Seq a
	splitAt,	-- :: Int -> Seq a -> (Seq a, Seq a)
	-- * Lists
	fromList,	-- :: [a] -> Seq a
	toList,		-- :: Seq a -> [a]
	-- * Folds
	-- ** Right associative
	foldr,		-- :: (a -> b -> b) -> b -> Seq a -> b
	foldr1,		-- :: (a -> a -> a) -> Seq a -> a
	foldr',		-- :: (a -> b -> b) -> b -> Seq a -> b
	foldrM,		-- :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
	-- ** Left associative
	foldl,		-- :: (a -> b -> a) -> a -> Seq b -> a
	foldl1,		-- :: (a -> a -> a) -> Seq a -> a
	foldl',		-- :: (a -> b -> a) -> a -> Seq b -> a
	foldlM,		-- :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
	-- * Transformations
	reverse,	-- :: Seq a -> Seq a
#if TESTING
	valid,
#endif
	) where

import Prelude hiding (
	null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
	reverse)
import qualified Prelude (foldr)
import qualified Data.List (foldl', intersperse)
import Control.Monad (MonadPlus(..))
import Data.FunctorM
import Data.Typeable

#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
import Data.Generics.Basics (Data(..), Fixity(..),
			constrIndex, mkConstr, mkDataType)
#endif

#if TESTING
import Control.Monad (liftM, liftM2, liftM3, liftM4)
import Test.QuickCheck
#endif

infixr 5 `consTree`
infixl 5 `snocTree`

infixr 5 ><
infixr 5 <|, :<
infixl 5 |>, :>

class Sized a where
	size :: a -> Int

-- | General-purpose finite sequences.
newtype Seq a = Seq (FingerTree (Elem a))

instance Functor Seq where
	fmap f (Seq xs) = Seq (fmap (fmap f) xs)

instance Monad Seq where
	return = singleton
	xs >>= f = foldl' add empty xs
	  where add ys x = ys >< f x

instance MonadPlus Seq where
	mzero = empty
	mplus = (><)

instance FunctorM Seq where
	fmapM f = foldlM f' empty
	  where f' ys x = do
			y <- f x
			return $! (ys |> y)
	fmapM_ f = foldlM f' ()
	  where f' _ x = f x >> return ()

instance Eq a => Eq (Seq a) where
	xs == ys = length xs == length ys && toList xs == toList ys

instance Ord a => Ord (Seq a) where
	compare xs ys = compare (toList xs) (toList ys)

#if TESTING
instance Show a => Show (Seq a) where
	showsPrec p (Seq x) = showsPrec p x
#else
instance Show a => Show (Seq a) where
	showsPrec _ xs = showChar '<' .
		flip (Prelude.foldr ($)) (Data.List.intersperse (showChar ',')
						(map shows (toList xs))) .
		showChar '>'
#endif

#include "Typeable.h"
INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")

#if __GLASGOW_HASKELL__
instance Data a => Data (Seq a) where
	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
<commit_msg>[project @ 2005-10-20 15:08:35 by ross] Read instance<commit_after>{-# OPTIONS -cpp -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Sequence
-- Copyright   :  (c) <NAME> 2005
-- License     :  BSD-style
-- Maintainer  :  <EMAIL>
-- Stability   :  experimental
-- Portability :  portable
--
-- General purpose finite sequences.
-- Apart from being finite and having strict operations, sequences
-- also differ from lists in supporting a wider variety of operations
-- efficiently.
--
-- An amortized running time is given for each operation, with /n/ referring
-- to the length of the sequence and /i/ being the integral index used by
-- some operations.  These bounds hold even in a persistent (shared) setting.
--
-- The implementation uses 2-3 finger trees annotated with sizes,
-- as described in section 4.2 of
--
--    * <NAME> and <NAME>,
--	\"Finger trees: a simple general-purpose data structure\",
--	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
-- operations on lists in the "Prelude".  The ambiguity may be resolved
-- using either qualification or the @hiding@ clause.
--
-----------------------------------------------------------------------------

module Data.Sequence (
	Seq,
	-- * Construction
	empty,		-- :: Seq a
	singleton,	-- :: a -> Seq a
	(<|),		-- :: a -> Seq a -> Seq a
	(|>),		-- :: Seq a -> a -> Seq a
	(><),		-- :: Seq a -> Seq a -> Seq a
	-- * Deconstruction
	-- ** Queries
	null,		-- :: Seq a -> Bool
	length,		-- :: Seq a -> Int
	-- ** Views
	ViewL(..),
	viewl,		-- :: Seq a -> ViewL a
	ViewR(..),
	viewr,		-- :: Seq a -> ViewR a
	-- ** Indexing
	index,		-- :: Seq a -> Int -> a
	adjust,		-- :: (a -> a) -> Int -> Seq a -> Seq a
	update,		-- :: Int -> a -> Seq a -> Seq a
	take,		-- :: Int -> Seq a -> Seq a
	drop,		-- :: Int -> Seq a -> Seq a
	splitAt,	-- :: Int -> Seq a -> (Seq a, Seq a)
	-- * Lists
	fromList,	-- :: [a] -> Seq a
	toList,		-- :: Seq a -> [a]
	-- * Folds
	-- ** Right associative
	foldr,		-- :: (a -> b -> b) -> b -> Seq a -> b
	foldr1,		-- :: (a -> a -> a) -> Seq a -> a
	foldr',		-- :: (a -> b -> b) -> b -> Seq a -> b
	foldrM,		-- :: Monad m => (a -> b -> m b) -> b -> Seq a -> m b
	-- ** Left associative
	foldl,		-- :: (a -> b -> a) -> a -> Seq b -> a
	foldl1,		-- :: (a -> a -> a) -> Seq a -> a
	foldl',		-- :: (a -> b -> a) -> a -> Seq b -> a
	foldlM,		-- :: Monad m => (a -> b -> m a) -> a -> Seq b -> m a
	-- * Transformations
	reverse,	-- :: Seq a -> Seq a
#if TESTING
	valid,
#endif
	) where

import Prelude hiding (
	null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
	reverse)
import qualified Prelude (foldr)
import qualified Data.List (foldl', intersperse)
import Control.Monad (MonadPlus(..))
import Data.FunctorM
import Data.Typeable

#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
import Text.Read (readPrec, lexP, Lexeme(..), (<++), (+++), reset)
import Data.Generics.Basics (Data(..), Fixity(..),
			constrIndex, mkConstr, mkDataType)
#endif

#if TESTING
import Control.Monad (liftM, liftM2, liftM3, liftM4)
import Test.QuickCheck
#endif

infixr 5 `consTree`
infixl 5 `snocTree`

infixr 5 ><
infixr 5 <|, :<
infixl 5 |>, :>

class Sized a where
	size :: a -> Int

-- | General-purpose finite sequences.
newtype Seq a = Seq (FingerTree (Elem a))

instance Functor Seq where
	fmap f (Seq xs) = Seq (fmap (fmap f) xs)

instance Monad Seq where
	return = singleton
	xs >>= f = foldl' add empty xs
	  where add ys x = ys >< f x

instance MonadPlus Seq where
	mzero = empty
	mplus = (><)

instance FunctorM Seq where
	fmapM f = foldlM f' empty
	  where f' ys x = do
			y <- f x
			return $! (ys |> y)
	fmapM_ f = foldlM f' ()
	  where f' _ x = f x >> return ()

instance Eq a => Eq (Seq a) where
	xs == ys = length xs == length ys && toList xs == toList ys

instance Ord a => Ord (Seq a) where
	compare xs ys = compare (toList xs) (toList ys)

#if TESTING
instance Show a => Show (Seq a) where
	showsPrec p (Seq x) = showsPrec p x
#else
instance Show a => Show (Seq a) where
	showsPrec _ xs = showChar '<' .
		flip (Prelude.foldr ($)) (Data.List.intersperse (showChar ',')
						(map shows (toList xs))) .
		showChar '>'
#endif

instance Read a => Read (Seq a) where
#ifdef __GLASGOW_HASKELL__
	readPrec = parens $ (symbol "<>" >> return empty) <++ do
		symbol "<"
		readEnd empty <++ readRest empty
	  where readEnd xs = do
			symbol ">"
			return xs
		readRest xs = do
			x <- reset readPrec
			let xs' = xs |> x
			readEnd xs' <++ do
				symbol ","
				readRest xs'
		parens p = p +++ do
			Punc "(" <- lexP
			x        <- reset (parens p)
			Punc ")" <- lexP
			return x
		symbol s = do
			Symbol "<" <- lexP
			return ()
#else
	readsPrec _ = readParen False $ \ r -> do
		(tok,s) <- lex r
		case tok of
			"<>" -> return (empty,s)
			"<"  -> do
				(tok',t) <- lex s
				case tok' of
					">" -> return (empty,t)
					_   -> readRest empty s
			_    -> []
	  where readRest xs s = do
			(x,t) <- reads s
			let xs' = xs |> x
			(tok,u) <- lex t
			case tok of
				">" -> return (xs',u)
				"," -> readRest xs' u
				_   -> []
#endif

#include "Typeable.h"
INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")

#if __GLASGOW_HASKELL__
instance Data a => Data (Seq a) where
	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

{'fraction_non_alphanumeric': 0.18934081346423562, 'fraction_numerical': 0.005984104721832632, 'mean_word_length': 2.2236286919831225, 'pattern_counts': {'":': 0, '<': 57, '<?xml version=': 0, '>': 218, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7412963', 'n_tokens_mistral': 4230, 'n_tokens_neox': 3969, 'n_words': 1371}