-- | -- Module : Data.Edison.Seq.ListSeq -- Copyright : Copyright (c) 1998 Chris Okasaki -- License : MIT; see COPYRIGHT file for terms and conditions -- -- Maintainer : robdockins AT fastmail DOT fm -- Stability : stable -- Portability : GHC, Hugs (MPTC and FD) -- -- This module packages the standard prelude list type as a -- sequence. This is the baseline sequence implementation and -- all methods have the default running times listed in -- "Data.Edison.Seq", except for the following two trivial operations: -- -- * toList, fromList @O( 1 )@ -- module Data.Edison.Seq.ListSeq ( -- * Sequence Type Seq, -- * Sequence Operations empty,singleton,lcons,rcons,append,lview,lhead,lheadM,ltail,ltailM, rview,rhead,rheadM,rtail,rtailM, null,size,concat,reverse,reverseOnto,fromList,toList,map,concatMap, fold,fold',fold1,fold1',foldr,foldr',foldl,foldl',foldr1,foldr1',foldl1,foldl1', reducer,reducer',reducel,reducel',reduce1,reduce1', copy,inBounds,lookup,lookupM,lookupWithDefault,update,adjust, mapWithIndex,foldrWithIndex,foldrWithIndex',foldlWithIndex,foldlWithIndex', take,drop,splitAt,subseq,filter,partition,takeWhile,dropWhile,splitWhile, zip,zip3,zipWith,zipWith3,unzip,unzip3,unzipWith,unzipWith3, strict,strictWith, -- * Unit testing structuralInvariant, -- * Documentation moduleName ) where import Prelude hiding (concat,reverse,map,concatMap,foldr,foldl,foldr1,foldl1, filter,takeWhile,dropWhile,lookup,take,drop,splitAt, zip,zip3,zipWith,zipWith3,unzip,unzip3,null) import qualified Control.Monad.Identity as ID import qualified Prelude import Data.Edison.Prelude import qualified Data.List import Data.Monoid import qualified Data.Edison.Seq as S ( Sequence(..) ) -- signatures for exported functions moduleName :: String empty :: [a] singleton :: a -> [a] lcons :: a -> [a] -> [a] rcons :: a -> [a] -> [a] append :: [a] -> [a] -> [a] lview :: (Monad rm) => [a] -> rm (a, [a]) lhead :: [a] -> a lheadM :: (Monad rm) => [a] -> rm a ltail :: [a] -> [a] ltailM :: (Monad rm) => [a] -> rm [a] rview :: (Monad rm) => [a] -> rm (a, [a]) rhead :: [a] -> a rheadM :: (Monad rm) => [a] -> rm a rtail :: [a] -> [a] rtailM :: (Monad rm) => [a] -> rm [a] null :: [a] -> Bool size :: [a] -> Int concat :: [[a]] -> [a] reverse :: [a] -> [a] reverseOnto :: [a] -> [a] -> [a] fromList :: [a] -> [a] toList :: [a] -> [a] map :: (a -> b) -> [a] -> [b] concatMap :: (a -> [b]) -> [a] -> [b] fold :: (a -> b -> b) -> b -> [a] -> b fold' :: (a -> b -> b) -> b -> [a] -> b fold1 :: (a -> a -> a) -> [a] -> a fold1' :: (a -> a -> a) -> [a] -> a foldr :: (a -> b -> b) -> b -> [a] -> b foldl :: (b -> a -> b) -> b -> [a] -> b foldr1 :: (a -> a -> a) -> [a] -> a foldl1 :: (a -> a -> a) -> [a] -> a reducer :: (a -> a -> a) -> a -> [a] -> a reducel :: (a -> a -> a) -> a -> [a] -> a reduce1 :: (a -> a -> a) -> [a] -> a foldl' :: (b -> a -> b) -> b -> [a] -> b foldl1' :: (a -> a -> a) -> [a] -> a reducer' :: (a -> a -> a) -> a -> [a] -> a reducel' :: (a -> a -> a) -> a -> [a] -> a reduce1' :: (a -> a -> a) -> [a] -> a copy :: Int -> a -> [a] inBounds :: Int -> [a] -> Bool lookup :: Int -> [a] -> a lookupM :: (Monad m) => Int -> [a] -> m a lookupWithDefault :: a -> Int -> [a] -> a update :: Int -> a -> [a] -> [a] adjust :: (a -> a) -> Int -> [a] -> [a] mapWithIndex :: (Int -> a -> b) -> [a] -> [b] foldrWithIndex :: (Int -> a -> b -> b) -> b -> [a] -> b foldlWithIndex :: (b -> Int -> a -> b) -> b -> [a] -> b foldlWithIndex' :: (b -> Int -> a -> b) -> b -> [a] -> b take :: Int -> [a] -> [a] drop :: Int -> [a] -> [a] splitAt :: Int -> [a] -> ([a], [a]) subseq :: Int -> Int -> [a] -> [a] filter :: (a -> Bool) -> [a] -> [a] partition :: (a -> Bool) -> [a] -> ([a], [a]) takeWhile :: (a -> Bool) -> [a] -> [a] dropWhile :: (a -> Bool) -> [a] -> [a] splitWhile :: (a -> Bool) -> [a] -> ([a], [a]) zip :: [a] -> [b] -> [(a,b)] zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] unzip :: [(a,b)] -> ([a], [b]) unzip3 :: [(a,b,c)] -> ([a], [b], [c]) unzipWith :: (a -> b) -> (a -> c) -> [a] -> ([b], [c]) unzipWith3 :: (a -> b) -> (a -> c) -> (a -> d) -> [a] -> ([b], [c], [d]) strict :: [a] -> [a] strictWith :: (a -> b) -> [a] -> [a] structuralInvariant :: [a] -> Bool moduleName = "Data.Edison.Seq.ListSeq" type Seq a = [a] empty = [] singleton x = [x] lcons = (:) rcons x s = s ++ [x] append = (++) lview [] = fail "ListSeq.lview: empty sequence" lview (x:xs) = return (x, xs) lheadM [] = fail "ListSeq.lheadM: empty sequence" lheadM (x:xs) = return x lhead [] = error "ListSeq.lhead: empty sequence" lhead (x:xs) = x ltailM [] = fail "ListSeq.ltailM: empty sequence" ltailM (x:xs) = return xs ltail [] = error "ListSeq.ltail: empty sequence" ltail (x:xs) = xs rview [] = fail "ListSeq.rview: empty sequence" rview xs = return (rhead xs, rtail xs) rheadM [] = fail "ListSeq.rheadM: empty sequence" rheadM (x:xs) = rh x xs where rh y [] = return y rh y (x:xs) = rh x xs rhead [] = error "ListSeq.rhead: empty sequence" rhead (x:xs) = rh x xs where rh y [] = y rh y (x:xs) = rh x xs rtailM [] = fail "ListSeq.rtailM: empty sequence" rtailM (x:xs) = return (rt x xs) where rt y [] = [] rt y (x:xs) = y : rt x xs rtail [] = error "ListSeq.rtail: empty sequence" rtail (x:xs) = rt x xs where rt y [] = [] rt y (x:xs) = y : rt x xs null = Prelude.null size = length concat = foldr append empty reverse = Prelude.reverse reverseOnto [] ys = ys reverseOnto (x:xs) ys = reverseOnto xs (x:ys) fromList xs = xs toList xs = xs map = Data.List.map concatMap = Data.List.concatMap fold = foldr fold' f = foldl' (flip f) fold1 f [] = error "ListSeq.fold1: empty sequence" fold1 f (x:xs) = foldr f x xs fold1' f [] = error "ListSeq.fold1': empty sequence" fold1' f (x:xs) = foldl' f x xs foldr = Data.List.foldr foldl = Data.List.foldl foldr' f e [] = e foldr' f e (x:xs) = f x $! foldr' f e xs foldl' f e [] = e foldl' f e (x:xs) = e `seq` foldl' f (f e x) xs foldr1 f [] = error "ListSeq.foldr1: empty sequence" foldr1 f xs = fr xs where fr [x] = x fr (x:xs) = f x $ fr xs fr _ = error "ListSeq.foldr1: bug!" foldr1' f [] = error "ListSeq.foldr1': empty sequence" foldr1' f xs = fr xs where fr [x] = x fr (x:xs) = f x $! fr xs fr _ = error "ListSeq.foldr1': bug!" foldl1 f [] = error "ListSeq.foldl1: empty sequence" foldl1 f (x:xs) = foldl f x xs foldl1' f [] = error "ListSeq.foldl1': empty sequence" foldl1' f (x:xs) = foldl' f x xs reducer f e [] = e reducer f e xs = f (reduce1 f xs) e reducer' f e [] = e reducer' f e xs = (f $! (reduce1' f xs)) $! e reducel f e [] = e reducel f e xs = f e (reduce1 f xs) reducel' f e [] = e reducel' f e xs = (f $! e) $! (reduce1' f xs) reduce1 f [] = error "ListSeq.reduce1: empty sequence" reduce1 f [x] = x reduce1 f (x1 : x2 : xs) = reduce1 f (f x1 x2 : pairup xs) where pairup (x1 : x2 : xs) = f x1 x2 : pairup xs pairup xs = xs -- can be improved using a counter and bit ops! reduce1' f [] = error "ListSeq.reduce1': empty sequence" reduce1' f [x] = x reduce1' f (x1 : x2 : xs) = x1 `seq` x2 `seq` reduce1' f (f x1 x2 : pairup xs) where pairup (x1 : x2 : xs) = x1 `seq` x2 `seq` (f x1 x2 : pairup xs) pairup xs = xs copy n x | n <= 0 = [] | otherwise = x : copy (n-1) x -- depends on n to be unboxed, should test this! inBounds i xs | i >= 0 = not (null (drop i xs)) | otherwise = False lookup i xs = ID.runIdentity (lookupM i xs) lookupM i xs | i < 0 = fail "ListSeq.lookup: not found" | otherwise = case drop i xs of [] -> fail "ListSeq.lookup: not found" (x:_) -> return x lookupWithDefault d i xs | i < 0 = d | otherwise = case drop i xs of [] -> d (x:_) -> x update i y xs | i < 0 = xs | otherwise = upd i xs where upd _ [] = [] upd i (x:xs) | i > 0 = x : upd (i - 1) xs | otherwise = y : xs adjust f i xs | i < 0 = xs | otherwise = adj i xs where adj _ [] = [] adj i (x:xs) | i > 0 = x : adj (i - 1) xs | otherwise = f x : xs mapWithIndex f = mapi 0 where mapi i [] = [] mapi i (x:xs) = f i x : mapi (succ i) xs foldrWithIndex f e = foldi 0 where foldi i [] = e foldi i (x:xs) = f i x (foldi (succ i) xs) foldrWithIndex' f e = foldi 0 where foldi i [] = e foldi i (x:xs) = f i x $! (foldi (succ i) xs) foldlWithIndex f = foldi 0 where foldi i e [] = e foldi i e (x:xs) = foldi (succ i) (f e i x) xs foldlWithIndex' f = foldi 0 where foldi i e [] = e foldi i e (x:xs) = e `seq` foldi (succ i) (f e i x) xs take i xs | i <= 0 = [] | otherwise = Data.List.take i xs drop i xs | i <= 0 = xs | otherwise = Data.List.drop i xs splitAt i xs | i <= 0 = ([], xs) | otherwise = Data.List.splitAt i xs subseq i len xs = take len (drop i xs) strict l@[] = l strict l@(_:xs) = strict xs `seq` l strictWith f l@[] = l strictWith f l@(x:xs) = f x `seq` strictWith f xs `seq` l filter = Data.List.filter partition = Data.List.partition takeWhile = Data.List.takeWhile dropWhile = Data.List.dropWhile splitWhile = Data.List.span zip = Data.List.zip zip3 = Data.List.zip3 zipWith = Data.List.zipWith zipWith3 = Data.List.zipWith3 unzip = Data.List.unzip unzip3 = Data.List.unzip3 unzipWith f g = foldr consfg ([], []) where consfg a (bs, cs) = (f a : bs, g a : cs) -- could put ~ on tuple unzipWith3 f g h = foldr consfgh ([], [], []) where consfgh a (bs, cs, ds) = (f a : bs, g a : cs, h a : ds) -- could put ~ on tuple -- no invariants structuralInvariant = const True -- declare the instance instance S.Sequence [] where {lcons = lcons; rcons = rcons; null = null; lview = lview; lhead = lhead; ltail = ltail; lheadM = lheadM; ltailM = ltailM; rview = rview; rhead = rhead; rtail = rtail; rheadM = rheadM; rtailM = rtailM; size = size; concat = concat; reverse = reverse; reverseOnto = reverseOnto; fromList = fromList; toList = toList; fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1'; foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl'; foldr1 = foldr1; foldr1' = foldr1'; foldl1 = foldl1; foldl1' = foldl1'; reducer = reducer; reducel = reducel; reduce1 = reduce1; reducel' = reducel'; reducer' = reducer'; reduce1' = reduce1'; copy = copy; inBounds = inBounds; lookup = lookup; lookupM = lookupM; lookupWithDefault = lookupWithDefault; update = update; adjust = adjust; mapWithIndex = mapWithIndex; foldrWithIndex = foldrWithIndex; foldrWithIndex' = foldrWithIndex'; foldlWithIndex = foldlWithIndex; foldlWithIndex' = foldlWithIndex'; take = take; drop = drop; splitAt = splitAt; subseq = subseq; filter = filter; partition = partition; takeWhile = takeWhile; dropWhile = dropWhile; splitWhile = splitWhile; zip = zip; zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip; unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3; strict = strict; strictWith = strictWith; structuralInvariant = structuralInvariant; instanceName s = moduleName}