content: -- |
  --   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,foldl',
                         filter,takeWhile,dropWhile,lookup,take,drop,splitAt,
                         zip,zip3,zipWith,zipWith3,unzip,unzip3,null)
  import qualified Control.Monad.Fail as Fail
  import qualified Prelude
  import Data.Edison.Prelude ( runFail_ )
  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          :: (Fail.MonadFail rm) => [a] -> rm (a, [a])
  lhead          :: [a] -> a
  lheadM         :: (Fail.MonadFail rm) => [a] -> rm a
  ltail          :: [a] -> [a]
  ltailM         :: (Fail.MonadFail rm) => [a] -> rm [a]
  rview          :: (Fail.MonadFail rm) => [a] -> rm (a, [a])
  rhead          :: [a] -> a
  rheadM         :: (Fail.MonadFail rm) => [a] -> rm a
  rtail          :: [a] -> [a]
  rtailM         :: (Fail.MonadFail 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        :: (Fail.MonadFail 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 = runFail_ (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}
  