packages feed

stream-fusion (empty) → 0.1

raw patch · 50 files changed

+19970/−0 lines, 50 filesdep +basebuild-type:Customsetup-changed

Dependencies added: base

Files

+ Control/Monad/Stream.hs view
@@ -0,0 +1,352 @@+{-# OPTIONS_GHC -fno-implicit-prelude #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Stream+-- Copyright   :  (c) The University of Glasgow 2001+-- License     :  BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer  :  libraries@haskell.org+-- Stability   :  provisional+-- Portability :  portable+--+-- The 'Functor', 'Monad' and 'MonadPlus' classes,+-- with some useful operations on monads.++module Control.Monad.Stream+    (+    -- * Functor and monad classes++      Functor(fmap)+    , Monad((>>=), (>>), return, fail)++    , MonadPlus (   -- class context: Monad+          mzero     -- :: (MonadPlus m) => m a+        , mplus     -- :: (MonadPlus m) => m a -> m a -> m a+        )+    -- * Functions++    -- ** Naming conventions+    -- $naming++    -- ** Basic functions from the "Prelude"++    , mapM          -- :: (Monad m) => (a -> m b) -> [a] -> m [b]+    , mapM_         -- :: (Monad m) => (a -> m b) -> [a] -> m ()+    , forM          -- :: (Monad m) => [a] -> (a -> m b) -> m [b]+    , forM_         -- :: (Monad m) => [a] -> (a -> m b) -> m ()+    , sequence      -- :: (Monad m) => [m a] -> m [a]+    , sequence_     -- :: (Monad m) => [m a] -> m ()+    , (=<<)         -- :: (Monad m) => (a -> m b) -> m a -> m b+    , (>=>)         -- :: (Monad m) => (a -> m b) -> (b -> m c) -> (a -> m c)+    , (<=<)         -- :: (Monad m) => (b -> m c) -> (a -> m b) -> (a -> m c)+    , forever       -- :: (Monad m) => m a -> m ()++    -- ** Generalisations of list functions++    , join          -- :: (Monad m) => m (m a) -> m a+    , msum          -- :: (MonadPlus m) => [m a] -> m a+    , filterM       -- :: (Monad m) => (a -> m Bool) -> [a] -> m [a]+    , mapAndUnzipM  -- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])+    , zipWithM      -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]+    , zipWithM_     -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()+    , foldM         -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a +    , foldM_        -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()+    , replicateM    -- :: (Monad m) => Int -> m a -> m [a]+    , replicateM_   -- :: (Monad m) => Int -> m a -> m ()++    -- ** Conditional execution of monadic expressions++    , guard         -- :: (MonadPlus m) => Bool -> m ()+    , when          -- :: (Monad m) => Bool -> m () -> m ()+    , unless        -- :: (Monad m) => Bool -> m () -> m ()++    -- ** Monadic lifting operators++    , liftM         -- :: (Monad m) => (a -> b) -> (m a -> m b)+    , liftM2        -- :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)+    , liftM3        -- :: ...+    , liftM4        -- :: ...+    , liftM5        -- :: ...++    , ap            -- :: (Monad m) => m (a -> b) -> m a -> m b++    ) where++import Data.Maybe++#ifdef __GLASGOW_HASKELL__+import GHC.List+import qualified Data.Stream as Stream+import GHC.Base+#endif++#ifdef __GLASGOW_HASKELL__+infixr 1 =<<++-- -----------------------------------------------------------------------------+-- Prelude monad functions++-- | Same as '>>=', but with the arguments interchanged.+{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}+(=<<)           :: Monad m => (a -> m b) -> m a -> m b+f =<< x         = x >>= f++-- | Evaluate each action in the sequence from left to right,+-- and collect the results.+sequence       :: Monad m => [m a] -> m [a] +{-# INLINE sequence #-}+sequence ms = foldr k (return []) ms+            where+              k m m' = do { x <- m; xs <- m'; return (x:xs) }++-- | Evaluate each action in the sequence from left to right,+-- and ignore the results.+sequence_        :: Monad m => [m a] -> m () +{-# INLINE sequence_ #-}+sequence_ ms     =  foldr (>>) (return ()) ms++-- | @'mapM' f@ is equivalent to @'sequence' . 'map' f@.+mapM            :: Monad m => (a -> m b) -> [a] -> m [b]+{-# INLINE mapM #-}+mapM f as       =  sequence (map f as)++-- | @'mapM_' f@ is equivalent to @'sequence_' . 'map' f@.+mapM_           :: Monad m => (a -> m b) -> [a] -> m ()+{-# INLINE mapM_ #-}+mapM_ f as      =  sequence_ (map f as)++#endif  /* __GLASGOW_HASKELL__ */++-- -----------------------------------------------------------------------------+-- The MonadPlus class definition++-- | Monads that also support choice and failure.+class Monad m => MonadPlus m where+   -- | the identity of 'mplus'.  It should also satisfy the equations+   --+   -- > mzero >>= f  =  mzero+   -- > v >> mzero   =  mzero+   --+   -- (but the instance for 'System.IO.IO' defined in "Control.Monad.Error"+   -- does not satisfy the second one).+   mzero :: m a +   -- | an associative operation+   mplus :: m a -> m a -> m a++instance MonadPlus [] where+   mzero = []+   mplus = (++)++instance MonadPlus Maybe where+   mzero = Nothing++   Nothing `mplus` ys  = ys+   xs      `mplus` _ys = xs++-- -----------------------------------------------------------------------------+-- Functions mandated by the Prelude++-- | @'guard' b@ is @'return' ()@ if @b@ is 'True',+-- and 'mzero' if @b@ is 'False'.+guard           :: (MonadPlus m) => Bool -> m ()+guard True      =  return ()+guard False     =  mzero++-- | This generalizes the list-based 'filter' function.++filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]+filterM p xs     = foldr k (return []) xs+  where+    k x xs' = do+      flg <- p x+      ys  <- xs'+      return (if flg then x:ys else ys)++-- | 'forM' is 'mapM' with its arguments flipped+forM            :: Monad m => [a] -> (a -> m b) -> m [b]+{-# INLINE forM #-}+forM            = flip mapM++-- | 'forM_' is 'mapM_' with its arguments flipped+forM_           :: Monad m => [a] -> (a -> m b) -> m ()+{-# INLINE forM_ #-}+forM_           = flip mapM_++-- | This generalizes the list-based 'concat' function.++msum        :: MonadPlus m => [m a] -> m a+{-# INLINE msum #-}+msum        =  foldr mplus mzero++infixr 1 <=<, >=>++-- | Left-to-right Kleisli composition of monads.+(>=>)       :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)+f >=> g     = \x -> f x >>= g++-- | Right-to-left Kleisli composition of monads. '(>=>)', with the arguments flipped+(<=<)       :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)+(<=<)       = flip (>=>)++-- | @'forever' act@ repeats the action infinitely.+forever     :: (Monad m) => m a -> m ()+forever a   = a >> forever a++-- -----------------------------------------------------------------------------+-- Other monad functions++-- | The 'join' function is the conventional monad join operator. It is used to+-- remove one level of monadic structure, projecting its bound argument into the+-- outer level.+join              :: (Monad m) => m (m a) -> m a+join x            =  x >>= id++-- | The 'mapAndUnzipM' function maps its first argument over a list, returning+-- the result as a pair of lists. This function is mainly used with complicated+-- data structures or a state-transforming monad.+mapAndUnzipM      :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])+mapAndUnzipM f xs =  sequence (map f xs) >>= return . unzip++-- | The 'zipWithM' function generalizes 'zipWith' to arbitrary monads.+zipWithM          :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]+zipWithM f xs ys  =  sequence (zipWith f xs ys)++-- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.+zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()+zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)++{- | The 'foldM' function is analogous to 'foldl', except that its result is+encapsulated in a monad. Note that 'foldM' works from left-to-right over+the list arguments. This could be an issue where '(>>)' and the `folded+function' are not commutative.+++>       foldM f a1 [x1, x2, ..., xm ]++==  ++>       do+>         a2 <- f a1 x1+>         a3 <- f a2 x2+>         ...+>         f am xm++If right-to-left evaluation is required, the input list should be reversed.+-}++foldM             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a+foldM _ a []      =  return a+foldM f a (x:xs)  =  f a x >>= \fax -> foldM f fax xs+{-# INLINE [1] foldM #-}++{-# RULES+"foldM -> fusible"  [~1] forall f z xs.+    foldM f z xs = Stream.foldM f z (Stream.stream xs)+"foldM -> unfused" [1] forall f z xs.+    Stream.foldM f z (Stream.stream xs) = foldM f z xs+  #-}++-- | Like 'foldM', but discards the result.+foldM_            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m ()+foldM_ f a xs     = foldM f a xs >> return ()+{-# INLINE [1] foldM_ #-}++{-# RULES+"foldM_ -> fusible"  [~1] forall f z xs.+    foldM_ f z xs = Stream.foldM_ f z (Stream.stream xs)+"foldM_ -> unfused" [1] forall f z xs.+    Stream.foldM_ f z (Stream.stream xs) = foldM_ f z xs+  #-}++-- | @'replicateM' n act@ performs the action @n@ times,+-- gathering the results.+replicateM        :: (Monad m) => Int -> m a -> m [a]+replicateM n x    = sequence (replicate n x)++-- | Like 'replicateM', but discards the result.+replicateM_       :: (Monad m) => Int -> m a -> m ()+replicateM_ n x   = sequence_ (replicate n x)++{- | Conditional execution of monadic expressions. For example, ++>       when debug (putStr "Debugging\n")++will output the string @Debugging\\n@ if the Boolean value @debug@ is 'True',+and otherwise do nothing.+-}++when              :: (Monad m) => Bool -> m () -> m ()+when p s          =  if p then s else return ()++-- | The reverse of 'when'.++unless            :: (Monad m) => Bool -> m () -> m ()+unless p s        =  if p then return () else s++-- | Promote a function to a monad.+liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r+liftM f m1              = do { x1 <- m1; return (f x1) }++-- | Promote a function to a monad, scanning the monadic arguments from+-- left to right.  For example,+--+-- >    liftM2 (+) [0,1] [0,2] = [0,2,1,3]+-- >    liftM2 (+) (Just 1) Nothing = Nothing+--+liftM2  :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r+liftM2 f m1 m2          = do { x1 <- m1; x2 <- m2; return (f x1 x2) }++-- | Promote a function to a monad, scanning the monadic arguments from+-- left to right (cf. 'liftM2').+liftM3  :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r+liftM3 f m1 m2 m3       = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }++-- | Promote a function to a monad, scanning the monadic arguments from+-- left to right (cf. 'liftM2').+liftM4  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r+liftM4 f m1 m2 m3 m4    = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }++-- | Promote a function to a monad, scanning the monadic arguments from+-- left to right (cf. 'liftM2').+liftM5  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r+liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }++{- | In many situations, the 'liftM' operations can be replaced by uses of+'ap', which promotes function application. ++>       return f `ap` x1 `ap` ... `ap` xn++is equivalent to ++>       liftMn f x1 x2 ... xn++-}++ap                :: (Monad m) => m (a -> b) -> m a -> m b+ap                =  liftM2 id+++{- $naming++The functions in this library use the following naming conventions: ++* A postfix \'@M@\' always stands for a function in the Kleisli category:+  The monad type constructor @m@ is added to function results+  (modulo currying) and nowhere else.  So, for example, ++>  filter  ::              (a ->   Bool) -> [a] ->   [a]+>  filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]++* A postfix \'@_@\' changes the result type from @(m a)@ to @(m ())@.+  Thus, for example: ++>  sequence  :: Monad m => [m a] -> m [a] +>  sequence_ :: Monad m => [m a] -> m () ++* A prefix \'@m@\' generalizes an existing function to a monadic form.+  Thus, for example: ++>  sum  :: Num a       => [a]   -> a+>  msum :: MonadPlus m => [m a] -> m a++-}
+ Data/List/Stream.hs view
@@ -0,0 +1,2453 @@+{-# OPTIONS_GHC -O2 -fbang-patterns -fdicts-cheap #-}+-- |+-- Module      : Data.List.Stream+-- Copyright   : (c) Duncan Coutts 2007+--               (c) Don Stewart   2007+-- License     : BSD-style+-- Maintainer  : dons@cse.unsw.edu.au+-- Stability   : experimental+-- Portability : portable+--+-- A reimplementation of the standard Haskell list library to take advantage of+-- stream fusion, and new GHC optimisations. The fusion mechanism is+-- based on that described in:+--+--      /Rewriting Haskell Strings/, by Duncan Coutts, Don Stewart and+--      Roman Leshchinskiy, Practical Aspects of Declarative Languages+--      8th International Symposium, PADL 2007, 2007.+--+--      <http://www.cse.unsw.edu.au/~dons/papers/CSL06.html>+--+-- This library is a drop in replacement for "Data.List".+--+module Data.List.Stream (++    -- $fusion_intro++    -- * Basic interface+    (++),                   -- :: [a] -> [a] -> [a]+    head,                   -- :: [a] -> a+    last,                   -- :: [a] -> a+    tail,                   -- :: [a] -> [a]+    init,                   -- :: [a] -> [a]+    null,                   -- :: [a] -> Bool+    length,                 -- :: [a] -> Int++    -- * List transformations+    map,                    -- :: (a -> b) -> [a] -> [b]+    reverse,                -- :: [a] -> [a]+    intersperse,            -- :: a -> [a] -> [a]+    intercalate,            -- :: [a] -> [[a]] -> [a]+    transpose,              -- :: [[a]] -> [[a]]++    -- * Reducing lists (folds)+    foldl,                  -- :: (a -> b -> a) -> a -> [b] -> a+    foldl',                 -- :: (a -> b -> a) -> a -> [b] -> a+    foldl1,                 -- :: (a -> a -> a) -> [a] -> a+    foldl1',                -- :: (a -> a -> a) -> [a] -> a+    foldr,                  -- :: (a -> b -> b) -> b -> [a] -> b+    foldr1,                 -- :: (a -> a -> a) -> [a] -> a++    -- ** Special folds+    concat,                 -- :: [[a]] -> [a]+    concatMap,              -- :: (a -> [b]) -> [a] -> [b]+    and,                    -- :: [Bool] -> Bool+    or,                     -- :: [Bool] -> Bool+    any,                    -- :: (a -> Bool) -> [a] -> Bool+    all,                    -- :: (a -> Bool) -> [a] -> Bool+    sum,                    -- :: Num a => [a] -> a+    product,                -- :: Num a => [a] -> a+    maximum,                -- :: Ord a => [a] -> a+    minimum,                -- :: Ord a => [a] -> a++    -- * Building lists+    -- ** Scans+    scanl,                  -- :: (a -> b -> a) -> a -> [b] -> [a]+    scanl1,                 -- :: (a -> a -> a) -> [a] -> [a]+    scanr,                  -- :: (a -> b -> b) -> b -> [a] -> [b]+    scanr1,                 -- :: (a -> a -> a) -> [a] -> [a]++    -- ** Accumulating maps+    mapAccumL,              -- :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])+    mapAccumR,              -- :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])++    -- ** Infinite lists+    iterate,                -- :: (a -> a) -> a -> [a]+    repeat,                 -- :: a -> [a]+    replicate,              -- :: Int -> a -> [a]+    cycle,                  -- :: [a] -> [a]++    -- ** Unfolding+    unfoldr,                -- :: (b -> Maybe (a, b)) -> b -> [a]++    -- * Sublists+    -- ** Extracting sublists+    take,                   -- :: Int -> [a] -> [a]+    drop,                   -- :: Int -> [a] -> [a]+    splitAt,                -- :: Int -> [a] -> ([a], [a])+    takeWhile,              -- :: (a -> Bool) -> [a] -> [a]+    dropWhile,              -- :: (a -> Bool) -> [a] -> [a]+    span,                   -- :: (a -> Bool) -> [a] -> ([a], [a])+    break,                  -- :: (a -> Bool) -> [a] -> ([a], [a])+    group,                  -- :: Eq a => [a] -> [[a]]+    inits,                  -- :: [a] -> [[a]]+    tails,                  -- :: [a] -> [[a]]++    -- * Predicates+    isPrefixOf,             -- :: Eq a => [a] -> [a] -> Bool+    isSuffixOf,             -- :: Eq a => [a] -> [a] -> Bool+    isInfixOf,              -- :: Eq a => [a] -> [a] -> Bool++    -- * Searching lists+    -- ** Searching by equality+    elem,                   -- :: Eq a => a -> [a] -> Bool+    notElem,                -- :: Eq a => a -> [a] -> Bool+    lookup,                 -- :: Eq a => a -> [(a, b)] -> Maybe b++    -- ** Searching with a predicate+    find,                   -- :: (a -> Bool) -> [a] -> Maybe a+    filter,                 -- :: (a -> Bool) -> [a] -> [a]+    partition,              -- :: (a -> Bool) -> [a] -> ([a], [a])++    -- * Indexing lists++    -- | These functions treat a list @xs@ as a indexed collection,+    -- with indices ranging from 0 to @'length' xs - 1@.+    (!!),                   -- :: [a] -> Int -> a+    elemIndex,              -- :: Eq a => a -> [a] -> Maybe Int+    elemIndices,            -- :: Eq a => a -> [a] -> [Int]+    findIndex,              -- :: (a -> Bool) -> [a] -> Maybe Int+    findIndices,            -- :: (a -> Bool) -> [a] -> [Int]++    -- * Zipping and unzipping lists+    zip,                    -- :: [a] -> [b] -> [(a, b)]+    zip3,                   -- :: [a] -> [b] -> [c] -> [(a, b, c)]+    zip4,+    zip5,+    zip6,+    zip7,++    -- | The zipWith family generalises the zip family by zipping with the+    -- function given as the first argument, instead of a tupling function.+    zipWith,                -- :: (a -> b -> c) -> [a] -> [b] -> [c]+    zipWith3,               -- :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]+    zipWith4,+    zipWith5,+    zipWith6,+    zipWith7,++    unzip,                  -- :: [(a, b)] -> ([a], [b])+    unzip3,                 -- :: [(a, b, c)] -> ([a], [b], [c])+    unzip4,+    unzip5,+    unzip6,+    unzip7,++    -- * Special lists+    -- ** Functions on strings+    lines,                  -- :: String -> [String]+    words,                  -- :: String -> [String]+    unlines,                -- :: [String] -> String+    unwords,                -- :: [String] -> String++    -- ** \"Set\" operations+    nub,                    -- :: Eq a => [a] -> [a]+    delete,                 -- :: Eq a => a -> [a] -> [a]+    (\\),                   -- :: Eq a => [a] -> [a] -> [a]+    union,                  -- :: Eq a => [a] -> [a] -> [a]+    intersect,              -- :: Eq a => [a] -> [a] -> [a]++    -- ** Ordered lists +    sort,                   -- :: Ord a => [a] -> [a]+    insert,                 -- :: Ord a => a -> [a] -> [a]++    -- * Generalized functions+    -- ** The \"By\" operations++    -- | By convention, overloaded functions have a non-overloaded+    -- counterpart whose name is suffixed with \`@By@\'.+    --+    -- It is often convenient to use these functions together with+    -- 'Data.Function.on', for instance @'sortBy' ('compare'+    -- \`on\` 'fst')@.++    -- *** User-supplied equality (replacing an Eq context)++    -- | The predicate is assumed to define an equivalence.+    nubBy,                  -- :: (a -> a -> Bool) -> [a] -> [a]+    deleteBy,               -- :: (a -> a -> Bool) -> a -> [a] -> [a]+    deleteFirstsBy,         -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]+    unionBy,                -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]+    intersectBy,            -- :: (a -> a -> Bool) -> [a] -> [a] -> [a]+    groupBy,                -- :: (a -> a -> Bool) -> [a] -> [[a]]++    -- *** User-supplied comparison (replacing an Ord context)+    sortBy,                 -- :: (a -> a -> Ordering) -> [a] -> [a]+    insertBy,               -- :: (a -> a -> Ordering) -> a -> [a] -> [a]+    maximumBy,              -- :: (a -> a -> Ordering) -> [a] -> a+    minimumBy,              -- :: (a -> a -> Ordering) -> [a] -> a++    -- * The \"generic\" operations+    -- | The prefix \`@generic@\' indicates an overloaded function that+    -- is a generalized version of a "Prelude" function.+    genericLength,          -- :: Num i => [b] -> i+    genericTake,            -- :: Integral i => i -> [a] -> [a]+    genericDrop,            -- :: Integral i => i -> [a] -> [a]+    genericSplitAt,         -- :: Integral i => i -> [a] -> ([a], [a])+    genericIndex,           -- :: Integral a => [b] -> a -> b+    genericReplicate,       -- :: Integral i => i -> a -> [a]++    -- helper for GHC.List+    errorEmptyList          -- :: String -> a++  ) where++#ifndef EXTERNAL_PACKAGE++import {-# SOURCE #-} GHC.Err      ( error )+import {-# SOURCE #-} GHC.Real     (Integral)+import {-# SOURCE #-} GHC.Num      (Num(..))+import {-# SOURCE #-} GHC.Unicode  (isSpace)++import GHC.Base (Int, Eq(..), Ord(..), Ordering(..),+                 Bool(..), not, Ordering(..),+                 seq, otherwise, flip,+                 Monad(..),+                 Char, String,+                 Int(I#), Int#, (+#),+                 -- we just reuse these:+                 foldr, (++), map+                )++import Data.Maybe   (Maybe(..))++#else++import GHC.Exts (Int(I#), Int#, (+#))+import Prelude (Int,+                Integral,+                Num(..), Eq(..), Ord(..), Ordering(..),+                Bool(..), not, Maybe(..), Char, String,+                error, seq, otherwise, flip)++import Data.Char (isSpace)++#endif+++import qualified Data.Stream as Stream+import Data.Stream (stream ,unstream)++-- -----------------------------------------------------------------------------++#ifdef EXTERNAL_PACKAGE+infixr 5 +++#endif++infix  5 \\ -- comment to fool cpp+infixl 9 !!+infix  4 `elem`, `notElem`++-- -----------------------------------------------------------------------------++-- $fusion_intro+--+-- The functions in this library marked with /fusion/ are+-- (transparently) rewritten by the compiler to stream functions, using+-- the fusion framework described in /Rewriting Haskell Strings/.+--+-- For example:+--+-- > map f xs+-- +-- is transformed via rewrite rules to:+--+-- > (unstream . mapS f . stream) xs+--+-- The 'unstream' and 'stream' functions identify the allocation points+-- for each function.+--+-- When two or more fusible functions are in close proximity (i.e.+-- directly composed, or with only intermediate lets and cases), the+-- fusion rule will fire, removing the intermediate structures.+--+-- Consider:+--+-- > map f . map g+-- +-- The rewrite engine will transform this code to:+--+-- > unstream . mapS f . stream . unstream . mapS g . stream+--+-- The fusion rule will then fire:+--+-- > unstream . mapS f . mapS g . stream+--+-- Removing the intermeidate list that is allocated. The compiler then+-- optimises the result.+--+-- Functions that fail to fuse are not left in stream form. In the final+-- simplifier phase any remaining unfused functions of the form:+--+-- > unstream . g . stream+--+-- Will be transformed back to their original list implementation.+--++--+-- Notes on simplifer phasing+--+-- * api functions should be rewritten to fusible forms as soon as possble+-- * This implies a NOINLINE [1] on the top level functions, so if ghc wants+--      to inline them they'll only have their bodies inlined at the end.+-- * These rewrite rules can then fire in any but the last phase:+--      "++ -> fusible" [~1] forall xs ys.+-- * Finally, if we reach the final phase, rewrite back to best effort [a] forms:+--      "++ -> unfused" [1] forall xs ys.+-- * And then inline the result.+--+-- If fusion occurs though, hang on to those 'stream' and 'unstream' pairs:+--  {-# INLINE [0] unstream #-} -- hmm?+--+-- Todo: notes on the phasing of Streams+--++-- -----------------------------------------------------------------------------+-- Fusion for the constructors:++--+-- We do not enable fusion for (:), as it leads to a massive massive+-- slow down in compilation time.+--+{- RULES+"(:) -> fusible" [~1] forall x xs.+    x : xs = unstream (Stream.cons x (stream xs))+"(:) -> unfused" [1] forall x xs.+    unstream (Stream.cons x (stream xs)) = x : xs+  -}++-- -----------------------------------------------------------------------------+-- Basic interface++-- | /O(n)/, /fusion/. Append two lists, i.e.,+--+-- > [x1, ..., xm] ++ [y1, ..., yn] == [x1, ..., xm, y1, ..., yn]+-- > [x1, ..., xm] ++ [y1, ...] == [x1, ..., xm, y1, ...]+--+-- If the first list is not finite, the result is the first list.+-- The spine of the first list argument must be copied.++#ifdef EXTERNAL_PACKAGE+(++) :: [a] -> [a] -> [a]+(++) []     ys = ys+(++) (x:xs) ys = x : xs ++ ys+{-# NOINLINE [1] (++) #-}+#endif++-- NOTE: This is quite subtle as we do not want to copy the last list in+--+-- xs1 ++ xs2 ++ ... ++ xsn+--+-- Indeed, we don't really want to fuse the above at all unless at least +-- one of the arguments has the form (unstream s) or the result of the+-- concatenation is streamed. The rules below do precisely that. Note they+-- really fuse instead of just rewriting things into a fusible form so there+-- is no need to rewrite back.++{-# RULES+"++ -> fused on 1st arg" [~1] forall xs ys.+    unstream xs ++ ys = Stream.append1 xs ys+"++ -> fused on 2nd arg" [~1] forall xs ys.+    Stream.append1 xs (unstream ys) = unstream (Stream.append xs ys)+"++ -> fused (1)" [~1] forall xs ys.+    stream (xs ++ ys) = Stream.append (stream xs) (stream ys)+"++ -> fused (2)" [~1] forall xs ys.+    stream (Stream.append1 xs ys) = Stream.append xs (stream ys)++"++ -> 1st arg empty" forall xs.+    [] ++ xs = xs+"++ -> 2nd arg empty" forall xs.+    xs ++ [] = xs+"++ / :" forall x xs ys.+    (x:xs) ++ ys = x : (xs ++ ys)+ #-}++-- | /O(1)/, /fusion/. Extract the first element of a list, which must be+-- non-empty.+head :: [a] -> a+head (x:_) = x+head []    = errorEmptyList "head"+{-# NOINLINE [1] head #-}++{-# RULES+"head -> fusible" [~1] forall xs.+    head xs = Stream.head (stream xs)+"head -> unfused" [1] forall xs.+    Stream.head (stream xs) = head xs+  #-}++-- | /O(n)/, /fusion/. Extract the last element of a list, which must be finite+-- and non-empty.+last :: [a] -> a+last []     = errorEmptyList "last"+last (x:xs) = last' x xs+  where+    last' y []     = y+    last' _ (y:ys) = last' y ys+{-# NOINLINE [1] last #-}++{-# RULES+"last -> fusible" [~1] forall xs.+    last xs = Stream.last (stream xs)+"last -> unfused" [1] forall xs.+    Stream.last (stream xs) = last xs+  #-}++-- | /O(1)/, /fusion/. Extract the elements after the head of a list, which+-- must be non-empty.+tail :: [a] -> [a]+tail (_:xs) = xs+tail []     = errorEmptyList "tail"+{-# NOINLINE [1] tail #-}++{-# RULES+"tail -> fusible" [~1] forall xs.+    tail xs = unstream (Stream.tail (stream xs))+"tail -> unfused" [1] forall xs.+    unstream (Stream.tail (stream xs)) = tail xs+  #-}++-- | /O(n)/, /fusion/. Return all the elements of a list except the last one.+-- The list must be finite and non-empty.+init :: [a] -> [a]+init []     = errorEmptyList "init"+init (x:xs) = init' x xs+  where+    init' _ []     = []+    init' y (z:zs) = y : init' z zs+{-# NOINLINE [1] init #-}++{-# RULES+"init -> fusible" [~1] forall xs.+    init xs = unstream (Stream.init (stream xs))+"init -> unfused" [1] forall xs.+    unstream (Stream.init (stream xs)) = init xs+  #-}++-- | /O(1)/, /fusion/. Test whether a list is empty.+null :: [a] -> Bool+null []    = True+null (_:_) = False+{-# NOINLINE [1] null #-}++{-# RULES+"null -> fusible" [~1] forall xs.+    null xs = Stream.null (stream xs)+"null -> unfused" [1] forall xs.+    Stream.null (stream xs) = null xs+  #-}++-- | /O(n)/, /fusion/. 'length' returns the length of a finite list as an 'Int'.+-- It is an instance of the more general 'Data.List.genericLength',+-- the result type of which may be any kind of number.+length :: [a] -> Int+length xs0 = len xs0 0#+#ifndef __HADDOCK__+  where+    len :: [a] -> Int# -> Int+    len []     a# = I# a#+    len (_:xs) a# = len xs (a# +# 1#)+#endif+{-# NOINLINE [1] length #-}++{-# RULES+"length -> fusible" [~1] forall xs.+    length xs = Stream.length (stream xs)+"length -> unfused" [1] forall xs.+    Stream.length (stream xs) = length xs+  #-}++-- ---------------------------------------------------------------------+-- List transformations++-- | /O(n)/, /fusion/. 'map' @f xs@ is the list obtained by applying @f@ to each element+-- of @xs@, i.e.,+--+-- > map f [x1, x2, ..., xn] == [f x1, f x2, ..., f xn]+-- > map f [x1, x2, ...] == [f x1, f x2, ...]+--+-- Properties:+--+-- > map f . map g         = map (f . g)+-- > map f (repeat x)      = repeat (f x)+-- > map f (replicate n x) = replicate n (f x)++#ifdef EXTERNAL_PACKAGE+map :: (a -> b) -> [a] -> [b]+map _ []     = []+map f (x:xs) = f x : map f xs+{-# NOINLINE [1] map #-}+#endif++{-# RULES+"map -> fusible" [~1] forall f xs.+    map f xs = unstream (Stream.map f (stream xs))+"map -> unfused" [1] forall f xs.+    unstream (Stream.map f (stream xs)) = map f xs+  #-}++-- | /O(n)/, /fusion/. 'reverse' @xs@ returns the elements of @xs@ in reverse order.+-- @xs@ must be finite. Will fuse as a consumer only.+reverse :: [a] -> [a]+reverse = foldl' (flip (:)) []+{-# INLINE reverse #-}++{-+reverse l = rev l []+  where+    rev []     a = a+    rev (x:xs) a = rev xs (x:a)+-}++{-+--TODO: I'm sure there are some cunning things we can do with optimising+-- reverse. Of course if we try and fuse we may need to still force the+-- sping of the list: eg reverse . reverse = forceSpine++forceSpine :: [a] -> [a]+forceSpine xs = forceSpine' xs `seq` xs+{-# INLINE forceSpine #-}++-- The idea of this slightly odd construction is that we inline the above form+-- and in the context we may then be able to use xs directly and just keep+-- around the fact that xs must be forced at some point. Remember, seq does not+-- imply any evaluation order.++forceSpine' :: [a] -> ()+forceSpine' []      = ()+forceSpine' (_:xs') = forceSpine' xs'+{-# NOINLINE forceSpine' #-}+-}++-- | /O(n)/, /fusion/. The 'intersperse' function takes an element and a list and+-- \`intersperses\' that element between the elements of the list.+-- For example,+--+-- > intersperse ',' "abcde" == "a,b,c,d,e"+--+intersperse :: a -> [a] -> [a]+intersperse _   []       = []+intersperse sep (x0:xs0) = x0 : go xs0+  where+    go []     = []+    go (x:xs) = sep : x : go xs+{-# NOINLINE [1] intersperse #-}++{- RULES+"intersperse -> fusible" [~1] forall x xs.+    intersperse x xs = unstream (Stream.intersperse x (stream xs))+"intersperse -> unfused" [1] forall x xs.+    unstream (Stream.intersperse x (stream xs)) = intersperse x xs+  -}++-- | /O(n)/, /fusion/. 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.+-- It inserts the list @xs@ in between the lists in @xss@ and concatenates the+-- result.+--+-- > intercalate = concat . intersperse+--+intercalate :: [a] -> [[a]] -> [a]+intercalate sep xss = go (intersperse sep xss)+  where+    go []     = []+    go (y:ys) = y ++ go ys+{-# NOINLINE [1] intercalate #-}++{-+intercalate _   []         = []+intercalate sep (xs0:xss0) = go xs0 xss0+  where+    go []     xss = to xss+    go (x:xs) xss = x : go xs xss++    to []       = []+    to (xs:xss) = go' sep xs xss++    go' []     xs xss = go xs xss+    go' (s:ss) xs xss = s : go' ss xs xss+{-# NOINLINE [1] intercalate #-}+-}++-- fusion rule based on:+--      intercalate = concat . intersperse+--+{- RULES+"intercalate -> fusible" [~1] forall x xs.+    intercalate x xs = Stream.concat (Stream.intersperse x (stream xs))+"intercalate -> unfused" [1] forall x xs.+    Stream.concat (Stream.intersperse x (stream xs)) = intercalate x xs+  -}++-- | The 'transpose' function transposes the rows and columns of its argument.+-- For example,+--+-- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]+--+transpose :: [[a]] -> [[a]]+transpose []             = []+transpose ([]     : xss) = transpose xss+transpose ((x:xs) : xss) = (x : [h | (h:_t) <- xss])+                         : transpose (xs : [ t | (_h:t) <- xss])++-- TODO fuse++-- ---------------------------------------------------------------------+-- Reducing lists (folds)++-- | /O(n)/, /fusion/. 'foldl', applied to a binary operator, a starting value (typically+-- the left-identity of the operator), and a list, reduces the list+-- using the binary operator, from left to right:+--+-- > foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn+--+-- The list must be finite.+--+foldl :: (a -> b -> a) -> a -> [b] -> a+foldl f z0 xs0 = go z0 xs0+  where+    go z []     = z+    go z (x:xs) = go (f z x) xs+{-# INLINE [1] foldl #-}++{-# RULES+"foldl -> fusible"  [~1] forall f z xs.+    foldl f z xs = Stream.foldl f z (stream xs)+"foldl -> unfused" [1] forall f z xs.+    Stream.foldl f z (stream xs) = foldl f z xs+  #-}++-- | /O(n)/, /fusion/. A strict version of 'foldl'.+foldl' :: (a -> b -> a) -> a -> [b] -> a+foldl' f z0 xs0 = go z0 xs0+  where+    go !z []     = z+    go !z (x:xs) = go (f z x) xs+{-# INLINE [1] foldl' #-}++{-# RULES+"foldl' -> fusible"  [~1] forall f z xs.+    foldl' f z xs = Stream.foldl' f z (stream xs)+"foldl' -> unfused" [1] forall f z xs.+    Stream.foldl' f z (stream xs) = foldl' f z xs+  #-}++-- | /O(n)/, /fusion/. 'foldl1' is a variant of 'foldl' that has no starting value argument,+-- and thus must be applied to non-empty lists.+foldl1 :: (a -> a -> a) -> [a] -> a+foldl1 _ []       = errorEmptyList "foldl1"+foldl1 f (x0:xs0) = go x0 xs0+  where+    go z []     = z+    go z (x:xs) = go (f z x) xs+{-# INLINE [1] foldl1 #-}++{-# RULES+"foldl1 -> fusible"  [~1] forall f xs.+    foldl1 f xs = Stream.foldl1 f (stream xs)+"foldl1 -> unfused" [1] forall f xs.+    Stream.foldl1 f (stream xs) = foldl1 f xs+  #-}++-- | /O(n)/, /fusion/. A strict version of 'foldl1'+foldl1' :: (a -> a -> a) -> [a] -> a+foldl1' _ []       = errorEmptyList "foldl1'"+foldl1' f (x0:xs0) = go x0 xs0+  where+    go !z []     = z+    go !z (x:xs) = go (f z x) xs+{-# INLINE [1] foldl1' #-}++{-# RULES+"foldl1' -> fusible"  [~1] forall f xs.+    foldl1' f xs = Stream.foldl1' f (stream xs)+"foldl1 -> unfused" [1] forall f xs.+    Stream.foldl1' f (stream xs) = foldl1' f xs+  #-}++-- | /O(n)/, /fusion/. 'foldr', applied to a binary operator, a starting value (typically+-- the right-identity of the operator), and a list, reduces the list+-- using the binary operator, from right to left:+--+-- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)++#ifdef EXTERNAL_PACKAGE+foldr :: (a -> b -> b) -> b -> [a] -> b+foldr k z xs = go xs+  where+    go []     = z+    go (y:ys) = y `k` go ys+{-# INLINE [0] foldr #-}+#endif++{-# RULES+"foldr -> fusible"  [~1] forall f z xs.+    foldr f z xs = Stream.foldr f z (stream xs)+"foldr -> unfused" [1] forall f z xs.+    Stream.foldr f z (stream xs) = foldr f z xs+  #-}++-- | /O(n)/, /fusion/. 'foldr1' is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty lists.+foldr1 :: (a -> a -> a) -> [a] -> a+foldr1 _ []          = errorEmptyList "foldr1"+foldr1 k (x0:xs0)    = go x0 xs0+  where go x []      = x+        go x (x':xs) = k x (go x' xs)+{-# INLINE [1] foldr1 #-}++{-# RULES+"foldr1 -> fusible"  [~1] forall f xs.+    foldr1 f xs = Stream.foldr1 f (stream xs)+"foldr1 -> unfused" [1] forall f xs.+    Stream.foldr1 f (stream xs) = foldr1 f xs+  #-}++-- ---------------------------------------------------------------------+-- Special folds++-- | /O(n)/, /fusion/. Concatenate a list of lists.+concat :: [[a]] -> [a]+concat xss0 = to xss0+  where go []     xss = to xss+        go (x:xs) xss = x : go xs xss++        to []       = []+        to (xs:xss) = go xs xss -- hmm, this is slower than the old concat?+{-# NOINLINE [1] concat #-}++--+-- fuse via concatMap, as the Stream (Stream a) is too hard to construct+-- +-- or via foldr (++) ?+--+{-# RULES+"concat -> fused"  [~1] forall xs.+    concat xs = Stream.concat (stream xs)+"concat -> unfused" [1] forall xs.+    Stream.concat (stream xs) = concat xs+  #-}++-- | /O(n)/, /fusion/. Map a function over a list and concatenate the results.+concatMap :: (a -> [b]) -> [a] -> [b]+concatMap f = foldr (\x y -> f x ++ y) [] -- at least it will fuse.+{-# INLINE concatMap #-}++{-+concatMap f as0 = to as0+  where+    go []     as = to as+    go (b:bs) as = b : go bs as++    to []     = []+    to (a:as) = go (f a) as+{-# NOINLINE [1] concatMap #-}+-}+{- RULES+"concatMap -> fusible"  [~1] forall f xs.+    concatMap f xs = Stream.concatMap f (stream xs)+"concatMap -> unfused"  [1] forall f xs.+    Stream.concatMap f (stream xs) = concatMap f xs+  -}++-- | /O(n)/, /fusion/. 'and' returns the conjunction of a Boolean list.  For the result to be+-- 'True', the list must be finite; 'False', however, results from a 'False'+-- value at a finite index of a finite or infinite list.+--+and :: [Bool] -> Bool+and []         = True+and (False:_ ) = False+and (_    :xs) = and xs+{-# NOINLINE [1] and #-}++{-# RULES+"and -> fused"  [~1] forall xs.+    and xs = Stream.and (stream xs)+"and -> unfused" [1] forall xs.+    Stream.and (stream xs) = and xs+  #-}++-- | /O(n)/, /fusion/. 'or' returns the disjunction of a Boolean list.  For the result to be+-- 'False', the list must be finite; 'True', however, results from a 'True'+-- value at a finite index of a finite or infinite list.+or :: [Bool] -> Bool+or []        = False+or (True:_ ) = True+or (_   :xs) = or xs+{-# NOINLINE [1] or #-}++{-# RULES+"or -> fused"  [~1] forall xs.+    or xs = Stream.or (stream xs)+"or -> unfused" [1] forall xs.+    Stream.or (stream xs) = or xs+  #-}++-- | /O(n)/, /fusion/. Applied to a predicate and a list, 'any' determines if any element+-- of the list satisfies the predicate.+any :: (a -> Bool) -> [a] -> Bool+any p xs0 = go xs0+  where go []     = False+        go (x:xs) = case p x of+                      True  -> True+                      False -> go xs+{-# NOINLINE [1] any #-}++--TODO: check if being lazy in p is a cost,+--      should we do [] as a special case and then strictly evaluate p?++{-# RULES+"any -> fusible"  [~1] forall f xs.+    any f xs = Stream.any f (stream xs)+"any -> unfused" [1] forall f xs.+    Stream.any f (stream xs) = any f xs+  #-}++-- | Applied to a predicate and a list, 'all' determines if all elements+-- of the list satisfy the predicate.+all :: (a -> Bool) -> [a] -> Bool+all p xs0 = go xs0+  where go []     = True+        go (x:xs) = case p x of+                      True  -> go xs+                      False -> False+{-# NOINLINE [1] all #-}++{-# RULES+"all -> fusible"  [~1] forall f xs.+    all f xs = Stream.all f (stream xs)+"all -> unfused" [1] forall f xs.+    Stream.all f (stream xs) = all f xs+  #-}++-- | /O(n)/, /fusion/. The 'sum' function computes the sum of a finite list of numbers.+sum :: Num a => [a] -> a+sum l = sum' l 0+#ifndef __HADDOCK__+  where+    sum' []     a = a+    sum' (x:xs) a = sum' xs (a+x)+#endif+{-# NOINLINE [1] sum #-}++sumInt :: [Int] -> Int+sumInt l = sum' l 0+#ifndef __HADDOCK__+  where+    sum' []      a = a+    sum' (x:xs) !a = sum' xs (a+x)+#endif+{-# NOINLINE [1] sumInt #-}++{-# RULES+"sum spec Int" sum = sumInt :: [Int] -> Int+  #-}++{-# RULES+"sum -> fusible"  [~1] forall xs.+    sum xs = Stream.sum (stream xs)+"sum -> unfused" [1] forall xs.+    Stream.sum (stream xs) = sum xs+  #-}++{-# RULES+"sumInt -> fusible"  [~1] forall (xs :: [Int]).+    sumInt xs = Stream.sum (stream xs)+"sumInt -> unfused" [1] forall (xs :: [Int]).+    Stream.sum (stream xs) = sumInt xs+  #-}++-- | /O(n)/,/fusion/. The 'product' function computes the product of a finite list of numbers.+product :: Num a => [a] -> a+product l = prod l 1+#ifndef __HADDOCK__+  where+    prod []     a = a+    prod (x:xs) a = prod xs (a*x)+#endif+{-# NOINLINE [1] product #-}++productInt :: [Int] -> Int+productInt l = product' l 0+#ifndef __HADDOCK__+  where+    product' []      a = a+    product' (x:xs) !a = product' xs (a*x)+#endif+{-# NOINLINE [1] productInt #-}++{-# RULES+"product spec Int" product = productInt :: [Int] -> Int+  #-}++{-# RULES+"product -> fused"  [~1] forall xs.+    product xs = Stream.product (stream xs)+"product -> unfused" [1] forall xs.+    Stream.product (stream xs) = product xs+  #-}++{-# RULES+"productInt -> fusible"  [~1] forall (xs :: [Int]).+    productInt xs = Stream.product (stream xs)+"productInt -> unfused" [1] forall (xs :: [Int]).+    Stream.product (stream xs) = productInt xs+  #-}++-- | /O(n)/,/fusion/. 'maximum' returns the maximum value from a list,+-- which must be non-empty, finite, and of an ordered type.+-- It is a special case of 'Data.List.maximumBy', which allows the+-- programmer to supply their own comparison function.+maximum :: Ord a => [a] -> a+maximum []       = errorEmptyList "maximum"+maximum xs       = foldl1 max xs+{-# NOINLINE [1] maximum #-}++{-# RULES+"maximum -> fused"  [~1] forall xs.+    maximum xs = Stream.maximum (stream xs)+"maximum -> unfused" [1] forall xs.+    Stream.maximum (stream xs) = maximum xs+  #-}++-- We can't make the overloaded version of maximum strict without+-- changing its semantics (max might not be strict), but we can for+-- the version specialised to 'Int'.++{-# RULES+  "maximumInt"     maximum = (strictMaximum :: [Int] -> Int);+  "maximumChar"    maximum = (strictMaximum :: [Char] -> Char)+  #-}++strictMaximum :: (Ord a) => [a] -> a+strictMaximum [] =  errorEmptyList "maximum"+strictMaximum xs =  foldl1' max xs+{-# NOINLINE [1] strictMaximum #-}++{-# RULES+"strictMaximum -> fused"  [~1] forall xs.+    maximum xs = Stream.strictMaximum (stream xs)+"strictMaximum -> unfused" [1] forall xs.+    Stream.strictMaximum (stream xs) = strictMaximum xs+  #-}++-- | /O(n)/,/fusion/. 'minimum' returns the minimum value from a list,+-- which must be non-empty, finite, and of an ordered type.+-- It is a special case of 'Data.List.minimumBy', which allows the+-- programmer to supply their own comparison function.+minimum :: Ord a => [a] -> a+minimum [] = errorEmptyList "minimum"+minimum xs = foldl1 min xs+{-# NOINLINE [1] minimum #-}++{-# RULES+"minimum -> fused"  [~1] forall xs.+    minimum xs = Stream.minimum (stream xs)+"minimum -> unfused" [1] forall xs.+    Stream.minimum (stream xs) = minimum xs+  #-}++{-# RULES+  "minimumInt"     minimum = (strictMinimum :: [Int]  -> Int);+  "minimumChar"    minimum = (strictMinimum :: [Char] -> Char)+  #-}++strictMinimum :: (Ord a) => [a] -> a+strictMinimum [] = errorEmptyList "maximum"+strictMinimum xs = foldl1' min xs+{-# NOINLINE [1] strictMinimum #-}++{-# RULES+"strictMinimum -> fused"  [~1] forall xs.+    maximum xs = Stream.strictMinimum (stream xs)+"strictMinimum -> unfused" [1] forall xs.+    Stream.strictMinimum (stream xs) = strictMinimum xs+  #-}++-- ---------------------------------------------------------------------+-- * Building lists+-- ** Scans++-- | /O(n)/, /fusion/. 'scanl' is similar to 'foldl', but returns a list of successive+-- reduced values from the left:+--+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+--+-- Properties:+--+-- > last (scanl f z xs) == foldl f z x+--+scanl :: (a -> b -> a) -> a -> [b] -> [a]+scanl f q ls = q : case ls of+                      []   -> []+                      x:xs -> scanl f (f q x) xs+{-# INLINE [1] scanl #-}++{- or perhaps:+scanl f q xs0 = q : go q xs0+  where go q []     = []+        go q (x:xs) = let q' = f q x+                       in q' : go q' xs+-}++-- +-- note: Haskell's 'scan' is a bit weird, as it always puts the initial+-- state as a prefix. this complicates the rules.+--++{-# RULES+"scanl -> fusible"  [~1] forall f z xs.+    scanl f z xs = unstream (Stream.scanl f z (Stream.snoc (stream xs) bottom))+"scanl -> unfused" [1] forall f z xs.+    unstream (Stream.scanl f z (Stream.snoc (stream xs) bottom)) = scanl f z xs+  #-}++-- | /O(n)/,/fusion/. 'scanl1' is a variant of 'scanl' that has no starting value argument:+--+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+--+scanl1 :: (a -> a -> a) -> [a] -> [a]+scanl1 f (x:xs) = scanl f x xs+scanl1 _ []     = []+{-# INLINE [1] scanl1 #-}++{-# RULES+"scanl1 -> fusible"  [~1] forall f xs.+    scanl1 f xs = unstream (Stream.scanl1 f (Stream.snoc (stream xs) bottom))+"scanl1 -> unfused" [1] forall f xs.+    unstream (Stream.scanl1 f (Stream.snoc (stream xs) bottom)) = scanl1 f xs+  #-}+++-- | /O(n)/. 'scanr' is the right-to-left dual of 'scanl'.+-- Properties:+--+-- > head (scanr f z xs) == foldr f z xs+--+scanr :: (a -> b -> b) -> b -> [a] -> [b]+scanr _ q0 []     = [q0]+scanr f q0 (x:xs) = f x q : qs+                    where qs@(q:_) = scanr f q0 xs+{-# INLINE [1] scanr #-}++{- RULES+"scanr -> fusible"  [~1] forall f z xs.+    scanr f z xs = unstream (Stream.scanr f z (Stream.cons bottom (stream xs)))+"scanr -> unfused" [1] forall f z xs.+    unstream (Stream.scanr f z (Stream.cons bottom (stream xs))) = scanr f z xs+  -}++-- | 'scanr1' is a variant of 'scanr' that has no starting value argument.+scanr1 :: (a -> a -> a) -> [a] -> [a]+scanr1 _ []     = []+scanr1 _ [x]    = [x]+scanr1 f (x:xs) = f x q : qs+                  where qs@(q:_) = scanr1 f xs++-- TODO fuse++-- ---------------------------------------------------------------------+-- ** Accumulating maps++-- | The 'mapAccumL' function behaves like a combination of 'map' and+-- 'foldl'; it applies a function to each element of a list, passing+-- an accumulating parameter from left to right, and returning a final+-- value of this accumulator together with the new list.+--+mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])+mapAccumL _ s []     = (s, [])+mapAccumL f s (x:xs) = (s'',y:ys)+                       where (s', y ) = f s x+                             (s'',ys) = mapAccumL f s' xs++-- TODO fuse++-- | The 'mapAccumR' function behaves like a combination of 'map' and+-- 'foldr'; it applies a function to each element of a list, passing+-- an accumulating parameter from right to left, and returning a final+-- value of this accumulator together with the new list.+--+mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])+mapAccumR _ s []     = (s, [])+mapAccumR f s (x:xs) = (s'', y:ys)+                       where (s'',y ) = f s' x+                             (s', ys) = mapAccumR f s xs++-- TODO fuse++------------------------------------------------------------------------+-- ** Infinite lists++-- | /fusion/. 'iterate' @f x@ returns an infinite list of repeated applications+-- of @f@ to @x@:+--+-- > iterate f x == [x, f x, f (f x), ...]+iterate :: (a -> a) -> a -> [a]+iterate f x = x : iterate f (f x)+{-# NOINLINE [1] iterate #-}++{-# RULES+"iterate -> fusible" [~1] forall f x.+    iterate f x = unstream (Stream.iterate f x)+"iterate -> unfused" [1] forall f x.+    unstream (Stream.iterate f x) = iterate f x+  #-}++-- | /fusion/. 'repeat' @x@ is an infinite list, with @x@ the value of every element.+repeat :: a -> [a]+repeat x = xs where xs = x : xs+{-# INLINE [1] repeat #-}++{-# RULES+"repeat -> fusible" [~1] forall x.+    repeat x = unstream (Stream.repeat x)+"repeat -> unfused" [1] forall x.+    unstream (Stream.repeat x) = repeat x+  #-}++-- | /O(n)/, /fusion/. 'replicate' @n x@ is a list of length @n@ with @x@ the value of+-- every element.+-- It is an instance of the more general 'Data.List.genericReplicate',+-- in which @n@ may be of any integral type.+--+replicate :: Int -> a -> [a]+replicate n0 _ | n0 <= 0 = []+replicate n0 x           = go n0+  where+    go 0 = []+    go n = x : go (n-1)+{-# NOINLINE [1] replicate #-}++{-# RULES+"replicate -> fusible" [~1]+    replicate = \n x -> unstream (Stream.replicate n x)+"replicate -> unfused" [1] forall n x.+    unstream (Stream.replicate n x) = replicate n x+  #-}++-- | /fusion/. 'cycle' ties a finite list into a circular one, or equivalently,+-- the infinite repetition of the original list.  It is the identity+-- on infinite lists.+--+cycle :: [a] -> [a]+cycle [] = error "Prelude.cycle: empty list"+cycle xs0 = go xs0+  where+    go []     = go xs0+    go (x:xs) = x : go xs+{-# NOINLINE [1] cycle #-}++{-# RULES+"cycle -> fusible" [~1] forall xs.+    cycle xs = unstream (Stream.cycle (stream xs))+"cycle -> unfused" [1] forall xs.+    unstream (Stream.cycle (stream xs)) = cycle xs+  #-}++-- ---------------------------------------------------------------------+-- ** Unfolding++-- | /fusion/. The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'+-- reduces a list to a summary value, 'unfoldr' builds a list from+-- a seed value.  The function takes the element and returns 'Nothing'+-- if it is done producing the list or returns 'Just' @(a,b)@, in which+-- case, @a@ is a prepended to the list and @b@ is used as the next+-- element in a recursive call.  For example,+--+-- > iterate f == unfoldr (\x -> Just (x, f x))+--+-- In some cases, 'unfoldr' can undo a 'foldr' operation:+--+-- > unfoldr f' (foldr f z xs) == xs+--+-- if the following holds:+--+-- > f' (f x y) = Just (x,y)+-- > f' z       = Nothing+--+-- A simple use of unfoldr:+--+-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10+-- >  [10,9,8,7,6,5,4,3,2,1]+--+unfoldr :: (b -> Maybe (a, b)) -> b -> [a]+unfoldr f b0 = unfold b0+  where+    unfold b = case f b of+      Just (a,b') -> a : unfold b'+      Nothing     -> []+{-# INLINE [1] unfoldr #-}++{-# RULES+"unfoldr -> fusible" [~1] forall f x.+    unfoldr f x = unstream (Stream.unfoldr f x)+"unfoldr -> unfused" [1] forall f x.+    unstream (Stream.unfoldr f x) = unfoldr f x+  #-}++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++-- | /O(n)/,/fusion/. 'take' @n@, applied to a list @xs@, returns the prefix of @xs@+-- of length @n@, or @xs@ itself if @n > 'length' xs@:+--+-- > take 5 "Hello World!" == "Hello"+-- > take 3 [1,2,3,4,5] == [1,2,3]+-- > take 3 [1,2] == [1,2]+-- > take 3 [] == []+-- > take (-1) [1,2] == []+-- > take 0 [1,2] == []+--+-- It is an instance of the more general 'Data.List.genericTake',+-- in which @n@ may be of any integral type.+--+take :: Int -> [a] -> [a]+take i _ | i <= 0 = []+take i ls = take' i ls+  where+    take' :: Int -> [a] -> [a]+    take' 0 _      = []+    take' _ []     = []+    take' n (x:xs) = x : take' (n-1) xs+{-# NOINLINE [1] take #-}++{-# RULES+"take -> fusible" [~1] forall n x.+    take n x = unstream (Stream.take n (stream x))+"take -> unfused" [1] forall n x.+    unstream (Stream.take n (stream x)) = take n x+  #-}++{-+take :: Int -> [a] -> [a]+take (I# n#) xs = takeUInt n# xs++takeUInt :: Int# -> [b] -> [b]+takeUInt n xs+    | n >=# 0#  =  take_unsafe_UInt n xs+    | otherwise =  []++take_unsafe_UInt :: Int# -> [b] -> [b]+take_unsafe_UInt 0#  _  = []+take_unsafe_UInt m   ls =+  case ls of+    []     -> []+    (x:xs) -> x : take_unsafe_UInt (m -# 1#) xs+-}++-- | /O(n)/,/fusion/. 'drop' @n xs@ returns the suffix of @xs@+-- after the first @n@ elements, or @[]@ if @n > 'length' xs@:+--+-- > drop 6 "Hello World!" == "World!"+-- > drop 3 [1,2,3,4,5] == [4,5]+-- > drop 3 [1,2] == []+-- > drop 3 [] == []+-- > drop (-1) [1,2] == [1,2]+-- > drop 0 [1,2] == [1,2]+--+-- It is an instance of the more general 'Data.List.genericDrop',+-- in which @n@ may be of any integral type.+--+drop :: Int -> [a] -> [a]+drop n ls+  | n < 0     = ls+  | otherwise = drop' n ls+  where+    drop' :: Int -> [a] -> [a]+    drop' 0 xs      = xs+    drop' _  xs@[]  = xs+    drop' m (_:xs)  = drop' (m-1) xs+{-# NOINLINE [1] drop #-}++{-# RULES+"drop -> fusible" [~1] forall n x.+    drop n x = unstream (Stream.drop n (stream x))+"drop -> unfused" [1] forall n x.+    unstream (Stream.drop n (stream x)) = drop n x+  #-}++-- | 'splitAt' @n xs@ returns a tuple where first element is @xs@ prefix of+-- length @n@ and second element is the remainder of the list:+--+-- > splitAt 6 "Hello World!" == ("Hello ","World!")+-- > splitAt 3 [1,2,3,4,5] == ([1,2,3],[4,5])+-- > splitAt 1 [1,2,3] == ([1],[2,3])+-- > splitAt 3 [1,2,3] == ([1,2,3],[])+-- > splitAt 4 [1,2,3] == ([1,2,3],[])+-- > splitAt 0 [1,2,3] == ([],[1,2,3])+-- > splitAt (-1) [1,2,3] == ([],[1,2,3])+--+-- It is equivalent to @('take' n xs, 'drop' n xs)@.+-- 'splitAt' is an instance of the more general 'Data.List.genericSplitAt',+-- in which @n@ may be of any integral type.+--+splitAt :: Int -> [a] -> ([a], [a])+splitAt n ls+  | n < 0     = ([], ls)+  | otherwise = splitAt' n ls+  where+    splitAt' :: Int -> [a] -> ([a], [a])+    splitAt' 0 xs     = ([], xs)+    splitAt' _  xs@[] = (xs, xs)+    splitAt' m (x:xs) = (x:xs', xs'')+      where+        (xs', xs'') = splitAt' (m-1) xs+{-# NOINLINE [1] splitAt #-}++{-+splitAt n xs | n <= 0 = ([], xs)+splitAt _ []          = ([], [])+splitAt n (x:xs)      = (x:xs', xs'')+  where+    (xs', xs'') = splitAt (n-1) xs+-}++{-# RULES+"splitAt -> fusible" [~1] forall n xs.+    splitAt n xs = Stream.splitAt n (stream xs)+"splitAt -> unfused" [1] forall n xs.+    Stream.splitAt n (stream xs) = splitAt n xs+  #-}++-- | /O(n)/,/fusion/. 'takeWhile', applied to a predicate @p@ and a list @xs@, returns the+-- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@:+--+-- > takeWhile (< 3) [1,2,3,4,1,2,3,4] == [1,2]+-- > takeWhile (< 9) [1,2,3] == [1,2,3]+-- > takeWhile (< 0) [1,2,3] == []+--+takeWhile :: (a -> Bool) -> [a] -> [a]+takeWhile _ []    = []+takeWhile p xs0   = go xs0+  where+    go []         = []+    go (x:xs)+      | p x       = x : go xs+      | otherwise = []+{-# NOINLINE [1] takeWhile #-}++{-# RULES+"takeWhile -> fusible" [~1] forall f xs.+    takeWhile f xs = unstream (Stream.takeWhile f (stream xs))+"takeWhile -> unfused" [1] forall f xs.+    unstream (Stream.takeWhile f (stream xs)) = takeWhile f xs+  #-}++-- | /O(n)/,/fusion/. 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@:+--+-- > dropWhile (< 3) [1,2,3,4,5,1,2,3] == [3,4,5,1,2,3]+-- > dropWhile (< 9) [1,2,3] == []+-- > dropWhile (< 0) [1,2,3] == [1,2,3]+--+dropWhile :: (a -> Bool) -> [a] -> [a]+dropWhile _ []    = []+dropWhile p xs0   = go xs0+  where+    go []         = []+    go xs@(x:xs')+      | p x       = go xs'+      | otherwise = xs+{-# NOINLINE [1] dropWhile #-}++{-# RULES+"dropWhile -> fusible" [~1] forall f xs.+    dropWhile f xs = unstream (Stream.dropWhile f (stream xs))+"dropWhile -> unfused" [1] forall f xs.+    unstream (Stream.dropWhile f (stream xs)) = dropWhile f xs+  #-}++-- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where+-- first element is longest prefix (possibly empty) of @xs@ of elements that+-- satisfy @p@ and second element is the remainder of the list:+-- +-- > span (< 3) [1,2,3,4,1,2,3,4] == ([1,2],[3,4,1,2,3,4])+-- > span (< 9) [1,2,3] == ([1,2,3],[])+-- > span (< 0) [1,2,3] == ([],[1,2,3])+-- +-- 'span' @p xs@ is equivalent to @('takeWhile' p xs, 'dropWhile' p xs)@+span :: (a -> Bool) -> [a] -> ([a], [a])+span _ []         = ([], [])+span p xs0        = go xs0+  where+    go []         = ([], [])+    go xs@(x:xs')+      | p x       = let (ys,zs) = go xs'+                     in (x:ys,zs)+      | otherwise = ([],xs)++-- TODO fuse+-- Hmm, these do a lot of sharing, but is it worth it?++-- | 'break', applied to a predicate @p@ and a list @xs@, returns a tuple where+-- first element is longest prefix (possibly empty) of @xs@ of elements that+-- /do not satisfy/ @p@ and second element is the remainder of the list:+-- +-- > break (> 3) [1,2,3,4,1,2,3,4] == ([1,2,3],[4,1,2,3,4])+-- > break (< 9) [1,2,3] == ([],[1,2,3])+-- > break (> 9) [1,2,3] == ([1,2,3],[])+--+-- 'break' @p@ is equivalent to @'span' ('not' . p)@.+--+break :: (a -> Bool) -> [a] -> ([a], [a])+break _ []        = ([], [])+break p xs0       = go xs0+  where+    go []         = ([], [])+    go xs@(x:xs')+      | p x       = ([],xs)+      | otherwise = let (ys,zs) = go xs'+                    in (x:ys,zs)++-- TODO fuse++-- | The 'group' function takes a list and returns a list of lists such+-- that the concatenation of the result is equal to the argument.  Moreover,+-- each sublist in the result contains only equal elements.  For example,+--+-- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]+--+-- It is a special case of 'groupBy', which allows the programmer to supply+-- their own equality test.+group :: Eq a => [a] -> [[a]]+group []     = []+group (x:xs) = (x:ys) : group zs+               where (ys,zs) = span (x ==) xs++-- TODO fuse++-- | The 'inits' function returns all initial segments of the argument,+-- shortest first.  For example,+--+-- > inits "abc" == ["","a","ab","abc"]+--+inits :: [a] -> [[a]]+inits []     = [] : []+inits (x:xs) = [] : map (x:) (inits xs)++-- TODO fuse++-- | The 'tails' function returns all final segments of the argument,+-- longest first.  For example,+--+-- > tails "abc" == ["abc", "bc", "c",""]+--+tails :: [a] -> [[a]]+tails []         = []  : []+tails xxs@(_:xs) = xxs : tails xs++-- TODO fuse++------------------------------------------------------------------------+-- * Predicates++-- | /O(n)/,/fusion/. The 'isPrefixOf' function takes two lists and+-- returns 'True' iff the first list is a prefix of the second.+--+isPrefixOf :: Eq a => [a] -> [a] -> Bool+isPrefixOf [] _                      = True+isPrefixOf _  []                     = False+isPrefixOf (x:xs) (y:ys) | x == y    = isPrefixOf xs ys+                         | otherwise = False+{-# NOINLINE [1] isPrefixOf #-}++{-# RULES+"isPrefixOf -> fusible" [~1] forall xs ys.+    isPrefixOf xs ys = Stream.isPrefixOf (stream xs) (stream ys)+"isPrefixOf -> unfused" [1]  forall xs ys.+    Stream.isPrefixOf (stream xs) (stream ys) = isPrefixOf xs ys+  #-}++-- | The 'isSuffixOf' function takes two lists and returns 'True'+-- iff the first list is a suffix of the second.+-- Both lists must be finite.+isSuffixOf :: Eq a => [a] -> [a] -> Bool+isSuffixOf x y = reverse x `isPrefixOf` reverse y++-- TODO fuse++-- | The 'isInfixOf' function takes two lists and returns 'True'+-- iff the first list is contained, wholly and intact,+-- anywhere within the second.+--+-- Example:+--+-- > isInfixOf "Haskell" "I really like Haskell." -> True+-- > isInfixOf "Ial" "I really like Haskell." -> False+--+isInfixOf :: Eq a => [a] -> [a] -> Bool+isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)++-- TODO fuse++-- ---------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++-- | /O(n)/, /fusion/. 'elem' is the list membership predicate, usually written+-- in infix form, e.g., @x `elem` xs@.+--+elem :: Eq a => a -> [a] -> Bool+elem _ []     = False+elem x (y:ys)+  | x == y    = True+  | otherwise = elem x ys+{-# NOINLINE [1] elem #-}++{-# RULES+"elem -> fusible" [~1] forall x xs.+    elem x xs = Stream.elem x (stream xs)+"elem -> unfused" [1] forall x xs.+    Stream.elem x (stream xs) = elem x xs+  #-}++-- | /O(n)/, /fusion/. 'notElem' is the negation of 'elem'.+notElem :: Eq a => a -> [a] -> Bool+notElem x xs = not (elem x xs)+{-# INLINE notElem #-}++{- RULES+-- We don't provide an expicilty fusible version, since not . elem is+-- just as good.++"notElem -> fusible" [~1] forall x xs.+    notElem x xs = Stream.notElem x (stream xs)+"notElem -> unfused" [1] forall x xs.+    Stream.notElem x (stream xs) = notElem x xs+  -}++-- | /O(n)/,/fusion/. 'lookup' @key assocs@ looks up a key in an association list.+lookup :: Eq a => a -> [(a, b)] -> Maybe b+lookup _   []       = Nothing+lookup key xys0     = go xys0+  where+    go []           = Nothing+    go ((x,y):xys)+      | key == x    = Just y+      | otherwise   = lookup key xys+{-# NOINLINE [1] lookup #-}++{-# RULES+"lookup -> fusible" [~1] forall x xs.+    lookup x xs = Stream.lookup x (stream xs)+"lookup -> unfused" [1] forall x xs.+    Stream.lookup x (stream xs) = lookup x xs+  #-}++-- | /O(n)/,/fusion/. 'filter', applied to a predicate and a list, returns the list of+-- those elements that satisfy the predicate; i.e.,+--+-- > filter p xs = [ x | x <- xs, p x]+--+-- Properties:+--+-- > filter p (filter q s) = filter (\x -> q x && p x) s+--+filter :: (a -> Bool) -> [a] -> [a]+filter _ []       = []+filter p xs0      = go xs0+  where+    go []         = []+    go (x:xs)+      | p x       = x : go xs+      | otherwise =     go xs+{-# NOINLINE [1] filter #-}++{-# RULES+"filter -> fusible" [~1] forall f xs.+    filter f xs = unstream (Stream.filter f (stream xs))+"filter -> unfused" [1] forall f xs.+    unstream (Stream.filter f (stream xs)) = filter f xs+  #-}++------------------------------------------------------------------------+-- ** Searching with a predicate++-- | /O(n)/,/fusion/. The 'find' function takes a predicate and a list and returns the+-- first element in the list matching the predicate, or 'Nothing' if+-- there is no such element.+find :: (a -> Bool) -> [a] -> Maybe a+find _ []       = Nothing+find p xs0      = go xs0+  where+    go []                 = Nothing+    go (x:xs) | p x       = Just x+              | otherwise = go xs+{-# NOINLINE [1] find #-}++{-# RULES+"find -> fusible" [~1] forall f xs.+    find f xs = Stream.find f (stream xs)+"find -> unfused" [1] forall f xs.+    Stream.find f (stream xs) = find f xs+  #-}++-- | The 'partition' function takes a predicate a list and returns+-- the pair of lists of elements which do and do not satisfy the+-- predicate, respectively; i.e.,+--+-- > partition p xs == (filter p xs, filter (not . p) xs)+partition :: (a -> Bool) -> [a] -> ([a], [a])+partition p xs = foldr (select p) ([],[]) xs+{-# INLINE partition #-}++-- TODO fuse++select :: (a -> Bool) -> a -> ([a], [a]) -> ([a], [a])+select p x ~(ts,fs) | p x       = (x:ts,fs)+                    | otherwise = (ts, x:fs)++------------------------------------------------------------------------+-- * Indexing lists++-- | /O(n)/,/fusion/. List index (subscript) operator, starting from 0.+-- It is an instance of the more general 'Data.List.genericIndex',+-- which takes an index of any integral type.+(!!) :: [a] -> Int -> a+xs0 !! n0+  | n0 < 0    = error "Prelude.(!!): negative index"+  | otherwise = index xs0 n0+#ifndef __HADDOCK__+  where+    index []     _ = error "Prelude.(!!): index too large"+    index (y:ys) n = if n == 0 then y else index ys (n-1)+#endif+{-# NOINLINE [1] (!!) #-}++{-# RULES+"!! -> fusible" [~1] forall xs n.+    xs !! n = Stream.index (stream xs) n+"!! -> unfused" [1] forall  xs n.+    Stream.index (stream xs) n = xs !! n+  #-}++-- | The 'elemIndex' function returns the index of the first element+-- in the given list which is equal (by '==') to the query element,+-- or 'Nothing' if there is no such element.+-- +-- Properties:+--+-- > elemIndex x xs = listToMaybe [ n | (n,a) <- zip [0..] xs, a == x ]+-- > elemIndex x xs = findIndex (x==) xs+--+elemIndex	:: Eq a => a -> [a] -> Maybe Int+elemIndex x     = findIndex (x==)+{-# INLINE elemIndex #-}+{-+elemIndex :: Eq a => a -> [a] -> Maybe Int+elemIndex y xs0 = loop_elemIndex xs0 0+#ifndef __HADDOCK__+  where+    loop_elemIndex []     !_ = Nothing+    loop_elemIndex (x:xs) !n+      | p x       = Just n+      | otherwise = loop_elemIndex xs (n + 1)+    p = (y ==)+#endif+{-# NOINLINE [1] elemIndex #-}+-}+{- RULES+"elemIndex -> fusible" [~1] forall x xs.+    elemIndex x xs = Stream.elemIndex x (stream xs)+"elemIndex -> unfused" [1] forall x xs.+    Stream.elemIndex x (stream xs) = elemIndex x xs+  -}++-- | /O(n)/,/fusion/. The 'elemIndices' function extends 'elemIndex', by+-- returning the indices of all elements equal to the query element, in+-- ascending order.+--+-- Properties:+--+-- > length (filter (==a) xs) = length (elemIndices a xs)+--+elemIndices     :: Eq a => a -> [a] -> [Int]+elemIndices x   = findIndices (x==)+{-# INLINE elemIndices #-}++{-+elemIndices :: Eq a => a -> [a] -> [Int]+elemIndices y xs0 = loop_elemIndices xs0 0+#ifndef __HADDOCK__+  where+    loop_elemIndices []     !_  = []+    loop_elemIndices (x:xs) !n+      | p x       = n : loop_elemIndices xs (n + 1)+      | otherwise =     loop_elemIndices xs (n + 1)+    p = (y ==)+#endif+{-# NOINLINE [1] elemIndices #-}+-}+{- RULES+"elemIndices -> fusible" [~1] forall x xs.+    elemIndices x xs = unstream (Stream.elemIndices x (stream xs))+"elemIndices -> unfused" [1] forall x xs.+    unstream (Stream.elemIndices x (stream xs)) = elemIndices x xs+  -}++-- | The 'findIndex' function takes a predicate and a list and returns+-- the index of the first element in the list satisfying the predicate,+-- or 'Nothing' if there is no such element.+--+-- Properties:+--+-- > findIndex p xs = listToMaybe [ n | (n,x) <- zip [0..] xs, p x ]+--+findIndex :: (a -> Bool) -> [a] -> Maybe Int+findIndex p ls    = loop_findIndex ls 0#+  where+    loop_findIndex []   _ = Nothing+    loop_findIndex (x:xs) n+      | p x       = Just (I# n)+      | otherwise = loop_findIndex xs (n +# 1#)+{-# NOINLINE [1] findIndex #-}++{-# RULES+"findIndex -> fusible" [~1] forall f xs.+    findIndex f xs = Stream.findIndex f (stream xs)+"findIndex -> unfused" [1] forall f xs.+    Stream.findIndex f (stream xs) = findIndex f xs+  #-}++-- | /O(n)/,/fusion/. The 'findIndices' function extends 'findIndex', by+-- returning the indices of all elements satisfying the predicate, in+-- ascending order.+--+-- Properties:+--+-- > length (filter p xs) = length (findIndices p xs)+--+findIndices :: (a -> Bool) -> [a] -> [Int]+findIndices p ls  = loop_findIndices ls 0#+  where+    loop_findIndices []     _ = []+    loop_findIndices (x:xs) n+      | p x       = I# n : loop_findIndices xs (n +# 1#)+      | otherwise =        loop_findIndices xs (n +# 1#)+{-# NOINLINE [1] findIndices #-}++{-# RULES+"findIndices -> fusible" [~1] forall p xs.+    findIndices p xs = unstream (Stream.findIndices p (stream xs))+"findIndices -> unfused" [1]  forall p xs.+    unstream (Stream.findIndices p (stream xs)) = findIndices p xs+  #-}++------------------------------------------------------------------------+-- * Zipping and unzipping lists++-- | /O(n)/,/fusion/. 'zip' takes two lists and returns a list of+-- corresponding pairs. If one input list is short, excess elements of+-- the longer list are discarded.+--+-- Properties:+--+-- > zip a b = zipWith (,) a b+--+zip :: [a] -> [b] -> [(a, b)]+zip (a:as) (b:bs) = (a,b) : zip as bs+zip _      _      = []+{-# NOINLINE [1] zip #-}++{-# RULES+"zip -> fusible" [~1] forall xs ys.+    zip xs ys = unstream (Stream.zip (stream xs) (stream ys))+"zip -> unfused" [1]  forall xs ys.+    unstream (Stream.zip (stream xs) (stream ys)) = zip xs ys+  #-}++-- | /O(n)/,/fusion/. 'zip3' takes three lists and returns a list of+-- triples, analogous to 'zip'.+--+-- Properties:+--+-- > zip3 a b c = zipWith (,,) a b c+--+zip3 :: [a] -> [b] -> [c] -> [(a, b, c)]+zip3 (a:as) (b:bs) (c:cs) = (a,b,c) : zip3 as bs cs+zip3 _      _      _      = []+{-# NOINLINE [1] zip3 #-}++{-# RULES+"zip3 -> fusible" [~1] forall xs ys zs.+    zip3 xs ys zs = unstream (Stream.zipWith3 (,,) (stream xs) (stream ys) (stream zs))+"zip3 -> unfused" [1]  forall xs ys zs.+    unstream (Stream.zipWith3 (,,) (stream xs) (stream ys) (stream zs)) = zip3 xs ys zs+  #-}++-- | /O(n)/,/fusion/. The 'zip4' function takes four lists and returns a list of+-- quadruples, analogous to 'zip'.+zip4 :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]+zip4 = zipWith4 (,,,)+{-# INLINE zip4 #-}++-- | The 'zip5' function takes five lists and returns a list of+-- five-tuples, analogous to 'zip'.+zip5 :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]+zip5 = zipWith5 (,,,,)++-- | The 'zip6' function takes six lists and returns a list of six-tuples,+-- analogous to 'zip'.+zip6 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]+zip6 = zipWith6 (,,,,,)++-- | The 'zip7' function takes seven lists and returns a list of+-- seven-tuples, analogous to 'zip'.+zip7 :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)]+zip7 = zipWith7 (,,,,,,)++-- | /O(n)/,/fusion/. 'zipWith' generalises 'zip' by zipping with the+-- function given as the first argument, instead of a tupling function.+-- For example, @'zipWith' (+)@ is applied to two lists to produce the+-- list of corresponding sums.+-- Properties:+--+-- > zipWith (,) = zip+--+zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]+zipWith f (a:as) (b:bs) = f a b : zipWith f as bs+zipWith _ _      _      = []+{-# INLINE [1] zipWith #-}++--FIXME: If we change the above INLINE to NOINLINE then ghc goes into+--       a loop, why? Do we have some dodgy recursive rules somewhere?++{-# RULES+"zipWith -> fusible" [~1] forall f xs ys.+    zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys))+"zipWith -> unfused" [1]  forall f xs ys.+    unstream (Stream.zipWith f (stream xs) (stream ys)) = zipWith f xs ys+  #-}++-- | /O(n)/,/fusion/. The 'zipWith3' function takes a function which+-- combines three elements, as well as three lists and returns a list of+-- their point-wise combination, analogous to 'zipWith'.+--+-- Properties:+--+-- > zipWith3 (,,) = zip3+--+zipWith3 :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]+zipWith3 z (a:as) (b:bs) (c:cs) = z a b c : zipWith3 z as bs cs+zipWith3 _ _ _ _                = []+{-# NOINLINE [1] zipWith3 #-}++{-# RULES+"zipWith3 -> fusible" [~1] forall f xs ys zs.+    zipWith3 f xs ys zs = unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs))+"zipWith3 -> unfused" [1]  forall f xs ys zs.+    unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs)) = zipWith3 f xs ys zs+  #-}++-- | /O(n)/,/fusion/. The 'zipWith4' function takes a function which combines four+-- elements, as well as four lists and returns a list of their point-wise+-- combination, analogous to 'zipWith'.+zipWith4 :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]+zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)+                        = z a b c d : zipWith4 z as bs cs ds+zipWith4 _ _ _ _ _      = []+{-# NOINLINE [1] zipWith4 #-}++{-# RULES+"zipWith4 -> fusible" [~1] forall f ws xs ys zs.+    zipWith4 f ws xs ys zs = unstream (Stream.zipWith4 f (stream ws) (stream xs) (stream ys) (stream zs))+"zipWith4 -> unfused" [1]  forall f ws xs ys zs.+    unstream (Stream.zipWith4 f (stream ws) (stream xs) (stream ys) (stream zs)) = zipWith4 f ws xs ys zs+  #-}++-- | The 'zipWith5' function takes a function which combines five+-- elements, as well as five lists and returns a list of their point-wise+-- combination, analogous to 'zipWith'.+zipWith5 :: (a -> b -> c -> d -> e -> f)+         -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]+zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)+                        = z a b c d e : zipWith5 z as bs cs ds es+zipWith5 _ _ _ _ _ _    = []++-- TODO fuse++-- | The 'zipWith6' function takes a function which combines six+-- elements, as well as six lists and returns a list of their point-wise+-- combination, analogous to 'zipWith'.+zipWith6 :: (a -> b -> c -> d -> e -> f -> g)+         -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]+zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)+                        = z a b c d e f : zipWith6 z as bs cs ds es fs+zipWith6 _ _ _ _ _ _ _  = []++-- TODO fuse++-- | The 'zipWith7' function takes a function which combines seven+-- elements, as well as seven lists and returns a list of their point-wise+-- combination, analogous to 'zipWith'.+zipWith7 :: (a -> b -> c -> d -> e -> f -> g -> h)+         -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]+zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)+                         = z a b c d e f g : zipWith7 z as bs cs ds es fs gs+zipWith7 _ _ _ _ _ _ _ _ = []++-- TODO fuse++------------------------------------------------------------------------+-- unzips++-- | 'unzip' transforms a list of pairs into a list of first components+-- and a list of second components.+unzip :: [(a, b)] -> ([a], [b])+unzip = foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])++-- TODO fuse++-- | The 'unzip3' function takes a list of triples and returns three+-- lists, analogous to 'unzip'.+unzip3 :: [(a, b, c)] -> ([a], [b], [c])+unzip3 = foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[])++-- TODO fuse++-- | The 'unzip4' function takes a list of quadruples and returns four+-- lists, analogous to 'unzip'.+unzip4 :: [(a, b, c, d)] -> ([a], [b], [c], [d])+unzip4 = foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->+                      (a:as,b:bs,c:cs,d:ds))+               ([],[],[],[])++-- TODO fuse++-- | The 'unzip5' function takes a list of five-tuples and returns five+-- lists, analogous to 'unzip'.+unzip5 :: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])+unzip5 = foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->+                      (a:as,b:bs,c:cs,d:ds,e:es))+               ([],[],[],[],[])++-- TODO fuse++-- | The 'unzip6' function takes a list of six-tuples and returns six+-- lists, analogous to 'unzip'.+unzip6 :: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])+unzip6 = foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->+                      (a:as,b:bs,c:cs,d:ds,e:es,f:fs))+               ([],[],[],[],[],[])++-- TODO fuse++-- | The 'unzip7' function takes a list of seven-tuples and returns+-- seven lists, analogous to 'unzip'.+unzip7 :: [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])+unzip7 = foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->+                      (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))+               ([],[],[],[],[],[],[])++-- TODO fuse++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings++-- | /O(O)/,/fusion/. 'lines' breaks a string up into a list of strings+-- at newline characters. The resulting strings do not contain+-- newlines.+lines :: String -> [String]+lines [] = []+lines s  = let (l, s') = break (== '\n') s+            in l : case s' of+                     []      -> []+                     (_:s'') -> lines s''+--TODO: can we do better than this and preserve the same strictness?++{-+-- This implementation is fast but too strict :-(+-- it doesn't yield each line until it has seen the ending '\n'++lines :: String -> [String]+lines []  = []+lines cs0 = go [] cs0+  where+    go l []        = reverse l : []+    go l ('\n':cs) = reverse l : case cs of+                                   [] -> []+                                   _  -> go [] cs+    go l (  c :cs) = go (c:l) cs+-}+{-# INLINE [1] lines #-}++{- RULES+"lines -> fusible" [~1] forall xs.+    lines xs = unstream (Stream.lines (stream xs))+"lines -> unfused" [1]  forall xs.+    unstream (Stream.lines (stream xs)) = lines xs+  -}++-- | 'words' breaks a string up into a list of words, which were delimited+-- by white space.+words :: String -> [String]+words s = case dropWhile isSpace s of+            "" -> []+            s' -> w : words s''+                  where (w, s'') = break isSpace s'+-- TODO fuse+--TODO: can we do better than this and preserve the same strictness?++{-+-- This implementation is fast but too strict :-(+-- it doesn't yield each word until it has seen the ending space++words cs0 = dropSpaces cs0+  where+    dropSpaces :: String -> [String]+    dropSpaces []         = []+    dropSpaces (c:cs)+         | isSpace c = dropSpaces cs+         | otherwise      = munchWord [c] cs++    munchWord :: String -> String -> [String]+    munchWord w []     = reverse w : []+    munchWord w (c:cs)+      | isSpace c = reverse w : dropSpaces cs+      | otherwise      = munchWord (c:w) cs+-}++-- | /O(n)/,/fusion/. 'unlines' is an inverse operation to 'lines'.+-- It joins lines, after appending a terminating newline to each.+--+-- > unlines xs = concatMap (++"\n")+--+unlines :: [String] -> String+unlines css0 = to css0+  where go []     css = '\n' : to css+        go (c:cs) css =   c  : go cs css++        to []       = []+        to (cs:css) = go cs css+{-# NOINLINE [1] unlines #-}++--+-- fuse via:+--      unlines xs = concatMap (snoc xs '\n')+--+{- RULES+"unlines -> fusible" [~1] forall xs.+    unlines xs = unstream (Stream.concatMap (\x -> Stream.snoc (stream x) '\n') (stream xs))+"unlines -> unfused" [1]  forall xs.+    unstream (Stream.concatMap (\x -> Stream.snoc (stream x) '\n') (stream xs)) = unlines xs+  -}++-- | 'unwords' is an inverse operation to 'words'.+-- It joins words with separating spaces.+unwords :: [String] -> String+unwords []         = []+unwords (cs0:css0) = go cs0 css0+  where go []     css = to css+        go (c:cs) css = c : go cs css++        to []       = []+        to (cs:ccs) = ' ' : go cs ccs++-- TODO fuse++------------------------------------------------------------------------+-- ** \"Set\" operations++-- | The 'nub' function removes duplicate elements from a list.+-- In particular, it keeps only the first occurrence of each element.+-- (The name 'nub' means \`essence\'.)+-- It is a special case of 'nubBy', which allows the programmer to supply+-- their own equality test.+--+nub :: Eq a => [a] -> [a]+nub l               = nub' l []+  where+    nub' [] _       = []+    nub' (x:xs) ls+      | x `elem` ls = nub' xs ls+      | otherwise   = x : nub' xs (x:ls)++{- RULES+-- ndm's optimisation+"sort/nub" forall xs.  sort (nub xs) = map head (group (sort xs))+  -}++-- TODO fuse++-- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.+-- For example,+--+-- > delete 'a' "banana" == "bnana"+--+-- It is a special case of 'deleteBy', which allows the programmer to+-- supply their own equality test.+--+delete :: Eq a => a -> [a] -> [a]+delete = deleteBy (==)++-- TODO fuse++-- | The '\\' function is list difference ((non-associative).+-- In the result of @xs@ '\\' @ys@, the first occurrence of each element of+-- @ys@ in turn (if any) has been removed from @xs@.  Thus+--+-- > (xs ++ ys) \\ xs == ys.+--+-- It is a special case of 'deleteFirstsBy', which allows the programmer+-- to supply their own equality test.+(\\) :: Eq a => [a] -> [a] -> [a]+(\\) = foldl (flip delete)++-- | The 'union' function returns the list union of the two lists.+-- For example,+--+-- > "dog" `union` "cow" == "dogcw"+--+-- Duplicates, and elements of the first list, are removed from the+-- the second list, but if the first list contains duplicates, so will+-- the result.+-- It is a special case of 'unionBy', which allows the programmer to supply+-- their own equality test.+--+union :: Eq a => [a] -> [a] -> [a]+union = unionBy (==)++-- TODO fuse++-- | The 'intersect' function takes the list intersection of two lists.+-- For example,+--+-- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]+--+-- If the first list contains duplicates, so will the result.+-- It is a special case of 'intersectBy', which allows the programmer to+-- supply their own equality test.+--+intersect :: Eq a => [a] -> [a] -> [a]+intersect = intersectBy (==)++-- TODO fuse++------------------------------------------------------------------------+-- ** Ordered lists ++-- TODO stuff in Ord can use Map/IntMap+-- TODO Hooray, an Ord constraint! we could use a better structure.++-- | The 'sort' function implements a stable sorting algorithm.+-- It is a special case of 'sortBy', which allows the programmer to supply+-- their own comparison function.+--+-- Properties:+--+-- > not (null x) ==> (head . sort) x = minimum x+-- > not (null x) ==> (last . sort) x = maximum x+--+sort :: Ord a => [a] -> [a]+sort l = mergesort compare l++-- TODO fuse, we have an Ord constraint!++-- | /O(n)/,/fusion/. The 'insert' function takes an element and a list and inserts the+-- element into the list at the last position where it is still less+-- than or equal to the next element.  In particular, if the list+-- is sorted before the call, the result will also be sorted.+-- It is a special case of 'insertBy', which allows the programmer to+-- supply their own comparison function.+--+insert :: Ord a => a -> [a] -> [a]+insert e ls = insertBy (compare) e ls+{-# INLINE insert #-}++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++-- | The 'nubBy' function behaves just like 'nub', except it uses a+-- user-supplied equality predicate instead of the overloaded '=='+-- function.+nubBy :: (a -> a -> Bool) -> [a] -> [a]+nubBy eq l              = nubBy' l []+  where+    nubBy' [] _         = []+    nubBy' (y:ys) xs+      | elem_by eq y xs = nubBy' ys xs+      | otherwise       = y : nubBy' ys (y:xs)++-- TODO fuse++-- Not exported:+-- Note that we keep the call to `eq` with arguments in the+-- same order as in the reference implementation+-- 'xs' is the list of things we've seen so far, +-- 'y' is the potential new element+--+elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool+elem_by _  _ []         = False+elem_by eq y (x:xs)     = if x `eq` y then True else elem_by eq y xs++-- | The 'deleteBy' function behaves like 'delete', but takes a+-- user-supplied equality predicate.+deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]+deleteBy _  _ []        = []+deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys++-- TODO fuse++deleteFirstsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]+deleteFirstsBy eq       = foldl (flip (deleteBy eq))+++-- | The 'unionBy' function is the non-overloaded version of 'union'.+unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]+unionBy eq xs ys        = xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs++-- TODO fuse++-- | The 'intersectBy' function is the non-overloaded version of 'intersect'.+intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]+intersectBy eq xs ys    = [x | x <- xs, any (eq x) ys]++-- TODO fuse++-- | The 'groupBy' function is the non-overloaded version of 'group'.+groupBy :: (a -> a -> Bool) -> [a] -> [[a]]+groupBy _  []     = []+groupBy eq (x:xs) = (x:ys) : groupBy eq zs+                    where (ys,zs) = span (eq x) xs++-- TODO fuse++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++-- | The 'sortBy' function is the non-overloaded version of 'sort'.+sortBy :: (a -> a -> Ordering) -> [a] -> [a]+sortBy cmp l = mergesort cmp l++-- TODO fuse++mergesort :: (a -> a -> Ordering) -> [a] -> [a]+mergesort cmp xs = mergesort' cmp (map wrap xs)++mergesort' :: (a -> a -> Ordering) -> [[a]] -> [a]+mergesort' _ []    = []+mergesort' _ [xs]  = xs+mergesort' cmp xss = mergesort' cmp (merge_pairs cmp xss)++merge_pairs :: (a -> a -> Ordering) -> [[a]] -> [[a]]+merge_pairs _   []          = []+merge_pairs _   [xs]        = [xs]+merge_pairs cmp (xs:ys:xss) = merge cmp xs ys : merge_pairs cmp xss++merge :: (a -> a -> Ordering) -> [a] -> [a] -> [a]+merge _   xs [] = xs+merge _   [] ys = ys+merge cmp (x:xs) (y:ys)+ = case x `cmp` y of+        GT -> y : merge cmp (x:xs)   ys+        _  -> x : merge cmp    xs (y:ys)++wrap :: a -> [a]+wrap x = [x]++-- | /O(n)/,/fusion/. The non-overloaded version of 'insert'.+insertBy :: (a -> a -> Ordering) -> a -> [a] -> [a]+insertBy _   x [] = [x]+insertBy cmp x ys@(y:ys')+    = case cmp x y of+        GT -> y : insertBy cmp x ys'+        _  -> x : ys+{-# NOINLINE [1] insertBy #-}++{-# RULES+"insertBy -> fusible" [~1] forall f x xs.+    insertBy f x xs = unstream (Stream.insertBy f x (stream xs))+"insertBy -> unfused" [1]  forall f x xs.+    unstream (Stream.insertBy f x (stream xs)) = insertBy f x xs+  #-}++-- | /O(n)/,/fusion/. The 'maximumBy' function takes a comparison function and a list+-- and returns the greatest element of the list by the comparison function.+-- The list must be finite and non-empty.+--+maximumBy :: (a -> a -> Ordering) -> [a] -> a+maximumBy _ []   = error "List.maximumBy: empty list"+maximumBy cmp xs = foldl1 max' xs+    where+       max' x y = case cmp x y of+                    GT -> x+                    _  -> y+{-# NOINLINE [1] maximumBy #-}++{-# RULES+"maximumBy -> fused"  [~1] forall p xs.+    maximumBy p xs = Stream.maximumBy p (stream xs)+"maximumBy -> unfused" [1] forall p xs.+    Stream.maximumBy p (stream xs) = maximumBy p xs+  #-}++-- | /O(n)/,/fusion/. The 'minimumBy' function takes a comparison function and a list+-- and returns the least element of the list by the comparison function.+-- The list must be finite and non-empty.+minimumBy :: (a -> a -> Ordering) -> [a] -> a+minimumBy _ []   = error "List.minimumBy: empty list"+minimumBy cmp xs = foldl1 min' xs+    where+        min' x y = case cmp x y of+                        GT -> y+                        _  -> x+{-# NOINLINE [1] minimumBy #-}++{-# RULES+"minimumBy -> fused"  [~1] forall p xs.+    minimumBy p xs = Stream.minimumBy p (stream xs)+"minimumBy -> unfused" [1] forall p xs.+    Stream.minimumBy p (stream xs) = minimumBy p xs+  #-}++------------------------------------------------------------------------+-- * The \"generic\" operations++-- | The 'genericLength' function is an overloaded version of 'length'.  In+-- particular, instead of returning an 'Int', it returns any type which is+-- an instance of 'Num'.  It is, however, less efficient than 'length'.+--+genericLength :: Num i => [b] -> i+genericLength []    = 0+genericLength (_:l) = 1 + genericLength l+{-# NOINLINE [1] genericLength #-}++{-# RULES+"genericLength -> fusible" [~1] forall xs.+    genericLength xs = Stream.genericLength (stream xs)+"genericLength -> unfused" [1] forall xs.+    Stream.genericLength (stream xs) = genericLength xs+  #-}++{-# RULES+"genericLength -> length/Int" genericLength = length :: [a] -> Int+  #-}++-- | /O(n)/,/fusion/. The 'genericTake' function is an overloaded version of 'take', which+-- accepts any 'Integral' value as the number of elements to take.+genericTake :: Integral i => i -> [a] -> [a]+genericTake 0 _      = []+genericTake _ []     = []+genericTake n (x:xs)+             | n > 0 = x : genericTake (n-1) xs+             | otherwise = error "List.genericTake: negative argument"+{-# NOINLINE [1] genericTake #-}++{-# RULES+"genericTake -> fusible" [~1] forall xs n.+    genericTake n xs = unstream (Stream.genericTake n (stream xs))+"genericTake -> unfused" [1]  forall xs n.+    unstream (Stream.genericTake n (stream xs)) = genericTake n xs+  #-}++{-# RULES+"genericTake -> take/Int" genericTake = take :: Int -> [a] -> [a]+  #-}++-- | /O(n)/,/fusion/. The 'genericDrop' function is an overloaded version of 'drop', which+-- accepts any 'Integral' value as the number of elements to drop.+genericDrop :: Integral i => i -> [a] -> [a]+genericDrop 0 xs        = xs+genericDrop _ []        = []+genericDrop n (_:xs) | n > 0  = genericDrop (n-1) xs+genericDrop _ _         = error "List.genericDrop: negative argument"+{-# NOINLINE [1] genericDrop #-}++{-# RULES+"genericDrop -> fusible" [~1] forall xs n.+    genericDrop n xs = unstream (Stream.genericDrop n (stream xs))+"genericDrop -> unfused" [1]  forall xs n.+    unstream (Stream.genericDrop n (stream xs)) = genericDrop n xs+  #-}++{-# RULES+"genericDrop -> drop/Int" genericDrop = drop :: Int -> [a] -> [a]+  #-}++-- | /O(n)/,/fusion/. The 'genericIndex' function is an overloaded version of '!!', which+-- accepts any 'Integral' value as the index.+genericIndex :: Integral a => [b] -> a -> b+genericIndex (x:_)  0 = x+genericIndex (_:xs) n+    | n > 0           = genericIndex xs (n-1)+    | otherwise       = error "List.genericIndex: negative argument."+genericIndex _ _      = error "List.genericIndex: index too large."+{-# NOINLINE [1] genericIndex #-}+++-- can we pull the n > 0 test out and do it just once?+-- probably not since we don't know what n-1 does!!+-- can only specialise it for sane Integral instances :-(++{-# RULES+"genericIndex -> fusible" [~1] forall xs n.+    genericIndex xs n = Stream.genericIndex (stream xs) n+"genericIndex -> unfused" [1]  forall xs n.+    Stream.genericIndex (stream xs) n = genericIndex n xs+  #-}++{-# RULES+"genericIndex -> index/Int" genericIndex = (!!) :: [a] -> Int -> a+  #-}++-- | /O(n)/,/fusion/. The 'genericSplitAt' function is an overloaded+-- version of 'splitAt', which accepts any 'Integral' value as the+-- position at which to split.+--+genericSplitAt :: Integral i => i -> [a] -> ([a], [a])+genericSplitAt 0 xs     = ([],xs)+genericSplitAt _ []     = ([],[])+genericSplitAt n (x:xs) | n > 0  = (x:xs',xs'')+    where (xs',xs'') = genericSplitAt (n-1) xs+genericSplitAt _ _      = error "List.genericSplitAt: negative argument"++{-# RULES+"genericSplitAt -> fusible" [~1] forall xs n.+    genericSplitAt n xs = Stream.genericSplitAt n (stream xs)+"genericSplitAt -> unfused" [1]  forall xs n.+    Stream.genericSplitAt n (stream xs) = genericSplitAt n xs+  #-}++{-# RULES+"genericSplitAt -> splitAt/Int" genericSplitAt = splitAt :: Int -> [a] -> ([a], [a])+  #-}++-- | /O(n)/,/fusion/. The 'genericReplicate' function is an overloaded version of 'replicate',+-- which accepts any 'Integral' value as the number of repetitions to make.+--+genericReplicate :: Integral i => i -> a -> [a]+genericReplicate n x = genericTake n (repeat x)+{-# INLINE genericReplicate #-}++{-# RULES+"genericReplicate -> replicate/Int" genericReplicate = replicate :: Int -> a -> [a]+  #-}++-- ---------------------------------------------------------------------+-- Internal utilities++-- Common up near identical calls to `error' to reduce the number+-- constant strings created when compiled:+errorEmptyList :: String -> a+errorEmptyList fun = moduleError fun "empty list"+{-# NOINLINE errorEmptyList #-}++moduleError :: String -> String -> a+moduleError fun msg = error ("Data.List." ++ fun ++ ':':' ':msg)+{-# NOINLINE moduleError #-}++bottom :: a+bottom = error "Data.List.Stream: bottom"+{-# NOINLINE bottom #-}
+ Data/Stream.hs view
@@ -0,0 +1,1795 @@+-- #hide+{-# OPTIONS_GHC -fdicts-cheap -fbang-patterns #-}++-- |+-- Module      : Data.Stream+-- Copyright   : (c) Duncan Coutts 2007+--               (c) Don Stewart   2007+-- License     : BSD-style+-- Maintainer  : dons@cse.unsw.edu.au+-- Stability   : experimental+-- Portability : portable, requires cpp+-- Tested with : GHC 6.6+-- +-- Stream fusion for sequences. Described in: +--+--      /Rewriting Haskell Strings/, by Duncan Coutts, Don Stewart and+--      Roman Leshchinskiy, Practical Aspects of Declarative Languages+--      8th International Symposium, PADL 2007, 2007.+--+--      /Stream Fusion: From Lists to Streams to Nothing at All/, by+--      Duncan Coutts, Roman Leshchinskiy and Don Stwwart, ICFP 2007.+--+--      <http://www.cse.unsw.edu.au/~dons/papers/CSL06.html>+--      <http://www.cse.unsw.edu.au/~dons/papers/CLS07.html>+--+module Data.Stream (++    -- * The stream data type+    Stream(Stream),+    Step(..),++    -- * Conversions with lists+    stream,                 -- :: [a] -> Stream a+    unstream,               -- :: Stream a -> [a]++    -- internal grunge+    L(L),   -- hmm, does this affect whether these get removed?++    -- * Basic stream functions+    append,                 -- :: Stream a -> Stream a -> Stream a+    append1,                 -- :: Stream a -> [a] -> [a]+    cons,                   -- :: a -> Stream a -> Stream a+    snoc,                   -- :: Stream a -> a -> Stream a+    head,                   -- :: Stream a -> a+    last,                   -- :: Stream a -> a+    tail,                   -- :: Stream a -> Stream a+    init,                   -- :: Stream a -> Stream a+    null,                   -- :: Stream a -> Bool+    length,                 -- :: Stream a -> Int++    -- * Stream transformations+    map,                    -- :: (a -> b) -> Stream a -> Stream b+    --  reverse,                -- :: Stream a -> Stream a+    intersperse,            -- :: a -> Stream a -> Stream a+    --  intercalate,          -- :: Stream a -> Stream (Stream a) -> Stream a+    --  transpose,              -- :: Stream (Stream a) -> Stream (Stream a)++    -- * Reducing streams (folds)+    foldl,                  -- :: (b -> a -> b) -> b -> Stream a -> b+    foldl',                 -- :: (b -> a -> b) -> b -> Stream a -> b+    foldl1,                 -- :: (a -> a -> a) -> Stream a -> a+    foldl1',                -- :: (a -> a -> a) -> Stream a -> a+    foldr,                  -- :: (a -> b -> b) -> b -> Stream a -> b+    foldr1,                 -- :: (a -> a -> a) -> Stream a -> a++    -- ** Special folds+    concat,                 -- :: Stream [a] -> [a]+    concatMap,              -- :: (a -> Stream b) -> Stream a -> Stream b+    and,                    -- :: Stream Bool -> Bool+    or,                     -- :: Stream Bool -> Bool+    any,                    -- :: (a -> Bool) -> Stream a -> Bool+    all,                    -- :: (a -> Bool) -> Stream a -> Bool+    sum,                    -- :: Num a => Stream a -> a+    product,                -- :: Num a => Stream a -> a+    maximum,                -- :: Ord a => Stream a -> a+    minimum,                -- :: Ord a => Stream a -> a+    strictMaximum,          -- :: Ord a => Stream a -> a+    strictMinimum,          -- :: Ord a => Stream a -> a++    -- * Building lists+    -- ** Scans+    scanl,                  -- :: (a -> b -> a) -> a -> Stream b -> Stream a+    scanl1,                 -- :: (a -> a -> a) -> Stream a -> Stream a+{-+    scanr,                  -- :: (a -> b -> b) -> b -> Stream a -> Stream b+    scanr1,                 -- :: (a -> a -> a) -> Stream a -> Stream a+-}++{-+    -- ** Accumulating maps+    mapAccumL,              -- :: (acc -> x -> (acc, y)) -> acc -> Stream x -> (acc, Stream y)+    mapAccumR,              -- :: (acc -> x -> (acc, y)) -> acc -> Stream x -> (acc, Stream y)+-}++    -- ** Infinite streams+    iterate,                -- :: (a -> a) -> a -> Stream a+    repeat,                 -- :: a -> Stream a+    replicate,              -- :: Int -> a -> Stream a+    cycle,                  -- :: Stream a -> Stream a++    -- ** Unfolding+    unfoldr,                -- :: (b -> Maybe (a, b)) -> b -> Stream a++    -- * Substreams+    -- ** Extracting substreams+    take,                   -- :: Int -> Stream a -> Stream a+    drop,                   -- :: Int -> Stream a -> Stream a+    splitAt,                -- :: Int -> Stream a -> ([a], [a])+    takeWhile,              -- :: (a -> Bool) -> Stream a -> Stream a+    dropWhile,              -- :: (a -> Bool) -> Stream a -> Stream a+{-+    span,                   -- :: (a -> Bool) -> Stream a -> (Stream a, Stream a)+    break,                  -- :: (a -> Bool) -> Stream a -> (Stream a, Stream a)+    group,                  -- :: Eq a => Stream a -> Stream (Stream a)+    inits,                  -- :: Stream a -> Stream (Stream a)+    tails,                  -- :: Stream a -> Stream (Stream a)+-}++    -- * Predicates+    isPrefixOf,             -- :: Eq a => Stream a -> Stream a -> Bool+{-+    isSuffixOf,             -- :: Eq a => Stream a -> Stream a -> Bool+    isInfixOf,              -- :: Eq a => Stream a -> Stream a -> Bool+-}++    -- * Searching streams+    -- ** Searching by equality+    elem,                   -- :: Eq a => a -> Stream a -> Bool+    lookup,                 -- :: Eq a => a -> Stream (a, b) -> Maybe b++    -- ** Searching with a predicate+    find,                   -- :: (a -> Bool) -> Stream a -> Maybe a+    filter,                 -- :: (a -> Bool) -> Stream a -> Stream a+--  partition,              -- :: (a -> Bool) -> Stream a -> ([a], [a])++    -- * Indexing streams+    index,                  --  :: Stream a -> Int -> a+    findIndex,              -- :: (a -> Bool) -> Stream a -> Maybe Int+    elemIndex,              -- :: Eq a => a -> Stream a -> Maybe Int+    elemIndices,            -- :: Eq a => a -> Stream a -> Stream Int+    findIndices,            -- :: (a -> Bool) -> Stream a -> Stream Int++    -- * Zipping and unzipping streams+    zip,                    -- :: Stream a -> Stream b -> Stream (a, b)+    zip3,                   -- :: Stream a -> Stream b -> Stream c -> Stream (a, b, c)+    zip4,+    zipWith,                -- :: (a -> b -> c) -> Stream a -> Stream b -> Stream c+    zipWith3,               -- :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d+    zipWith4,++{-+    zip4, zip5, zip6, zip7,++    zipWith4, zipWith5, zipWith6, zipWith7,+-}+    unzip,                  -- :: Stream (a, b) -> (Stream a, Stream b)+{-+    unzip3,                 -- :: Stream (a, b, c) -> (Stream a, Stream b, Stream c)+    unzip4, unzip5, unzip6, unzip7,+-}++    -- * Special streams+    -- ** Functions on strings+{-+    lines,                  -- :: Stream Char -> Stream [Char]+    unlines,                -- :: Stream (Stream Char) -> Stream Char+    words,                  -- :: Stream Char -> Stream (Stream Char)+    unwords,                -- :: Stream (Stream Char) -> Stream Char+-}++{-+    -- ** \"Set\" operations+    nub,                    -- :: Eq a => Stream a -> Stream a+    delete,                 -- :: Eq a => a -> Stream a -> Stream a+    (\\),                   -- :: Eq a => Stream a -> Stream a -> Stream a+    union,                  -- :: Eq a => Stream a -> Stream a -> Stream a+    intersect,              -- :: Eq a => Stream a -> Stream a -> Stream a+-}++{-+    -- ** Ordered streams +    sort,                   -- :: Ord a => Stream a -> Stream a+    insert,                 -- :: Ord a => a -> Stream a -> Stream a+-}++{-+    -- * Generalized functions+    -- ** The \"By\" operations+    -- *** User-supplied equality (replacing an Eq context)+    nubBy,                  -- :: (a -> a -> Bool) -> Stream a -> Stream a+    deleteBy,               -- :: (a -> a -> Bool) -> a -> Stream a -> Stream a+    deleteFirstsBy,         -- :: (a -> a -> Bool) -> Stream a -> Stream a -> Stream a+    unionBy,                -- :: (a -> a -> Bool) -> Stream a -> Stream a -> Stream a+    intersectBy,            -- :: (a -> a -> Bool) -> Stream a -> Stream a -> Stream a+    groupBy,                -- :: (a -> a -> Bool) -> Stream a -> Stream (Stream a)+-}++    -- *** User-supplied comparison (replacing an Ord context)+    insertBy,               -- :: (a -> a -> Ordering) -> a -> Stream a -> Stream a+{-+    sortBy,                 -- :: (a -> a -> Ordering) -> Stream a -> Stream a+-}+    maximumBy,              -- :: (a -> a -> Ordering) -> Stream a -> a+    minimumBy,              -- :: (a -> a -> Ordering) -> Stream a -> a++    -- * The \"generic\" operations+    genericLength,          -- :: Num i => Stream b -> i+    genericTake,            -- :: Integral i => i -> Stream a -> Stream a+    genericDrop,            -- :: Integral i => i -> Stream a -> Stream a+    genericIndex,           -- :: Integral a => Stream b -> a -> b+    genericSplitAt,         -- :: Integral i => i -> Stream a -> ([a], [a])++    -- * Enum+    enumFromToInt,          -- :: Int -> Int -> Stream Int+    enumFromToChar,         -- :: Char -> Char -> Stream Char+    enumDeltaInteger,       -- :: Integer -> Integer -> Stream Integer++    -- * Monad+    foldM,                  -- :: Monad m => (b -> a -> m b) -> b -> Stream a -> m b+    foldM_,                 -- :: Monad m => (b -> a -> m b) -> b -> Stream a -> m ()++    -- * List comprehension desugaring+    return,                 -- :: a -> Stream a+    guard,                  -- :: Bool -> Stream a -> Stream a+    bind,                   -- :: (a -> Bool) -> (a -> [b]) -> [a] -> [b]+    mapFilter,              -- :: (a -> Bool) -> (a ->  b)  -> [a] -> [b]+    declare                 -- :: (a -> Stream b) -> a -> Stream b++  ) where++#ifndef EXTERNAL_PACKAGE++import {-# SOURCE #-} GHC.Err (error)+import {-# SOURCE #-} GHC.Num (Num(..),Integer)+import {-# SOURCE #-} GHC.Real (Integral(..))++import GHC.Base (Int, Char, Eq(..), Ord(..), Functor(..), Bool(..), (&&),+                 Ordering(..),+                 (||),(&&), ($),+                 seq, otherwise, ord, chr,+                 Monad((>>=), (>>)),            -- why >> ? we're not using it+                 -- for error messages:+                 String, (++))+import qualified GHC.Base as Monad (Monad(return))++import Data.Tuple  ()++#else++import Prelude (+    error,+    Num(..),+    Integral(..),+    Integer,+    Int, Char, Eq(..), Ord(..), Functor(..), Ordering(..), Bool(..),+    (&&), (||), ($),+    seq, otherwise,+    Monad((>>=)),+    -- for error messages:+    String, (++))+import qualified Prelude as Monad (Monad(return))++import Data.Char (ord,chr)++#endif++import qualified Data.Maybe (Maybe(..))+++------------------------------------------------------------------------+-- The stream data type++-- | A stream.+--+-- It is important that we never construct a bottom stream, because the+-- fusion rule is not true for bottom streams.+--+-- > (replicate 1 True) ++ (tail undefined)+--+-- The suspicion is that under fusion the append will force the bottom.+--+data Stream a = forall s. Unlifted s =>+                          Stream !(s -> Step a s)  -- ^ a stepper function+                                 !s                -- ^ an initial state++-- | A stream step.+--+--   A step either ends a stream, skips a value, or yields a value+--+data Step a s = Yield a !s+              | Skip    !s+              | Done++instance Functor Stream where fmap = map+++-- A class of strict unlifted types. The Unlifted constraint in the Stream+-- type above enforces a separation between user's types and the types used+-- in stream states.+--+class Unlifted a where++  -- This expose function needs to be called in folds/loops that consume+  -- streams to expose the structure of the stream state to the simplifier+  -- In particular, to SpecConstr.+  --+  expose :: a -> b -> b+  expose = seq++  -- This makes GHC's optimiser happier; it sometimes produces really bad+  -- code for single-method dictionaries+  --+  unlifted_dummy :: a+  unlifted_dummy = error "unlifted_dummy"++--+-- Unlifted versions of () and Bool for use in Stream states.+--+data None   = None+instance Unlifted None++data Switch = S1 | S2+instance Unlifted Switch++-- Unlifted pairs, Maybe and Either+--+data (Unlifted a, Unlifted b) => a :!: b = !a :!: !b+instance (Unlifted a, Unlifted b) => Unlifted (a :!: b) where+  expose (a :!: b) s = expose a (expose b s)+  {-# INLINE expose #-}++data Unlifted a => Maybe a = Nothing | Just !a+instance Unlifted a => Unlifted (Maybe a) where+  expose (Just a) s = expose a s+  expose  Nothing s =          s+  {-# INLINE expose #-}++data (Unlifted a, Unlifted b) => Either a b = Left !a | Right !b+instance (Unlifted a, Unlifted b) => Unlifted (Either a b) where+  expose (Left  a) s = expose a s+  expose (Right b) s = expose b s+  {-# INLINE expose #-}++-- Some stream functions (notably concatMap) need to use a stream as a state+--+instance Unlifted (Stream a) where+  expose (Stream next s0) s = seq next (seq s0 s)+  {-# INLINE expose #-}+++-- Boxes for user's state. This is the gateway for user's types into unlifted+-- stream states. The L is always safe since it's lifted/lazy, exposing/seqing+-- it does nothing.+-- S is unlifted and so is only suitable for users states that we know we can+-- be strict in. This requires attention and auditing. +--+data    L a = L a  -- lazy / lifted+newtype S a = S a  -- strict / unlifted++instance Unlifted (L a) where+  expose (L _) s = s+  {-# INLINE expose #-}++instance Unlifted (S a) where+  expose (S a) s = seq a s+  {-# INLINE expose #-}++--+-- coding conventions;+--+--  * we tag local loops with their wrapper's name, so they're easier to+--      spot in Core output+--++-- ---------------------------------------------------------------------+-- List/Stream conversion++-- | Construct an abstract stream from a list.+stream :: [a] -> Stream a+stream xs0 = Stream next (L xs0)+  where+    {-# INLINE next #-}+    next (L [])     = Done+    next (L (x:xs)) = Yield x (L xs)+{-# INLINE [0] stream #-}++-- | Flatten a stream back into a list.+unstream :: Stream a -> [a]+unstream (Stream next s0) = unfold_unstream s0+  where+    unfold_unstream !s = case next s of+      Done       -> []+      Skip    s' -> expose s' $     unfold_unstream s'+      Yield x s' -> expose s' $ x : unfold_unstream s'+{-# INLINE [0] unstream #-}++--+-- /The/ stream fusion rule+--++{-# RULES+"STREAM stream/unstream fusion" forall s.+    stream (unstream s) = s+  #-}++-- ---------------------------------------------------------------------+-- Basic stream functions++-- (++)+append :: Stream a -> Stream a -> Stream a+append (Stream next0 s01) (Stream next1 s02) = Stream next (Left s01)+  where+    {-# INLINE next #-}+    next (Left s1)  = case next0 s1 of+                          Done        -> Skip    (Right s02)+                          Skip s1'    -> Skip    (Left s1')+                          Yield x s1' -> Yield x (Left s1')+    next (Right s2) = case next1 s2 of+                          Done        -> Done+                          Skip s2'    -> Skip    (Right s2')+                          Yield x s2' -> Yield x (Right s2')+{-# INLINE [0] append #-}++-- version that can share the second list arg, really very similar+-- to unstream, but conses onto a given list rather than []:+-- unstream s = append1 s []+--+append1 :: Stream a -> [a] -> [a]+append1 (Stream next s0) xs = loop_append1 s0+  where+    loop_append1 !s = case next s of+      Done       -> xs+      Skip    s' -> expose s'       loop_append1 s'+      Yield x s' -> expose s' $ x : loop_append1 s'+{-# INLINE [0] append1 #-}++snoc :: Stream a -> a -> Stream a+snoc (Stream next0 xs0) w = Stream next (Just xs0)+  where+    {-# INLINE next #-}+    next (Just xs) = case next0 xs of+      Done        -> Yield w Nothing+      Skip xs'    -> Skip    (Just xs')+      Yield x xs' -> Yield x (Just xs')+    next Nothing = Done+{-# INLINE [0] snoc #-}++cons :: a -> Stream a -> Stream a+cons w (Stream next0 s0) = Stream next (S2 :!: s0)+  where+    {-# INLINE next #-}+    next (S2 :!: s) = Yield w (S1 :!: s)+    next (S1 :!: s) = case next0 s of+        Done       -> Done+        Skip    s' -> Skip    (S1 :!: s')+        Yield x s' -> Yield x (S1 :!: s')+{-# INLINE [0] cons #-}++-- head+head :: Stream a -> a+head (Stream next s0) = loop_head s0+  where+    loop_head !s = case next s of+        Yield x _  -> x+        Skip    s' -> expose s' $ loop_head s'+        Done       -> errorEmptyStream "head"+{-# INLINE [0] head #-}++-- last+last :: Stream a -> a+last (Stream next s0) = loop0_last s0+  where+    loop0_last !s = case next s of+      Done       -> errorEmptyStream "last"+      Skip    s' -> expose s' $ loop0_last  s'+      Yield x s' -> expose s' $ loop_last x s'+    loop_last x !s = case next s of+      Done        -> x+      Skip     s' -> expose s' $ loop_last x  s'+      Yield x' s' -> expose s' $ loop_last x' s'+{-# INLINE [0] last #-}++-- tail+tail :: Stream a -> Stream a+tail (Stream next0 s0) = Stream next (S1 :!: s0)+  where+    {-# INLINE next #-}+    next (S1 :!: s) = case next0 s of+      Done       -> errorEmptyStream "tail"+      Skip    s' -> Skip (S1 :!: s')+      Yield _ s' -> Skip (S2 :!: s') -- drop the head+    next (S2 :!: s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (S2 :!: s')+      Yield x s' -> Yield x (S2 :!: s')+{-# INLINE [0] tail #-}++-- init+init :: Stream a -> Stream a+init (Stream next0 s0) = Stream next (Nothing :!: s0)+  where+    {-# INLINE next #-}+    next (Nothing :!: s) = case next0 s of+      Done       -> errorEmptyStream "init"+      Skip    s' -> Skip (Nothing    :!: s')+      Yield x s' -> Skip (Just (L x) :!: s')+    next (Just (L x) :!: s) = case next0 s of+      Done        -> Done+      Skip     s' -> Skip    (Just (L x)  :!: s')+      Yield x' s' -> Yield x (Just (L x') :!: s')+{-# INLINE [0] init #-}++-- null+null :: Stream a -> Bool+null (Stream next s0) = loop_null s0+  where+    loop_null !s = case next s of+      Done       -> True+      Yield _ _  -> False+      Skip    s' -> expose s' $ loop_null s'+{-# INLINE [0] null #-}++-- length+length :: Stream a -> Int+length (Stream next s0) = loop_length (0::Int) s0+  where+    loop_length !z !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_length  z    s'+      Yield _ s' -> expose s' $ loop_length (z+1) s'+{-# INLINE [0] length #-}++{-+-- For lazy bytestrings+length64 :: Stream a -> Int64+length64 (Stream next s0) = loop (0::Int64) s0+  where+    loop z !s = case next s of+      Done       -> z+      Skip    s' -> loop  z    s'+      Yield _ s' -> loop (z+1) s'+{-# INLINE [0] length64 #-}+-}++-- ---------------------------------------------------------------------+-- Stream transformations++-- map+map :: (a -> b) -> Stream a -> Stream b+map f (Stream next0 s0) = Stream next s0+  where+    {-# INLINE next #-}+    next !s = case next0 s of+        Done       -> Done+        Skip    s' -> Skip        s'+        Yield x s' -> Yield (f x) s'+{-# INLINE [0] map #-}++--+-- a convenient rule for map+--+{-# RULES+    "STREAM map/map fusion" forall f g s.+        map f (map g s) = map (\x -> f (g x)) s+ #-}++--+-- relies strongly on SpecConstr+--++intersperse :: a -> Stream a -> Stream a+intersperse sep (Stream next0 s0) = Stream next (s0 :!: Nothing :!: S1)+  where+    {-# INLINE next #-}+    next (s :!: Nothing :!: S1) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip (s' :!: Nothing    :!: S1)+      Yield x s' -> Skip (s' :!: Just (L x) :!: S1)++    next (s :!: Just (L x) :!: S1) = Yield x (s :!: Nothing :!: S2)++    next (s :!: Nothing :!: S2) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip      (s' :!: Nothing    :!: S2)+      Yield x s' -> Yield sep (s' :!: Just (L x) :!: S1)++    -- next (_ :!: (Just (L _))) :!: S2 -- can't happen++{-+intersperse :: a -> Stream a -> [a]+intersperse sep (Stream next s0) = loop_intersperse_start s0+  where+    loop_intersperse_start !s = case next s of+      Done       -> []+      Skip    s' -> expose s' $     loop_intersperse_start s'+      Yield x s' -> expose s' $ x : loop_intersperse_go    s'++    loop_intersperse_go !s = case next s of+      Done       -> []+      Skip    s' -> expose s' $           loop_intersperse_go s'+      Yield x s' -> expose s' $ sep : x : loop_intersperse_go s'+-}++-- intercalate :: Stream a -> Stream (Stream a) -> Stream a+-- transpose :: Stream (Stream a) -> Stream (Stream a)++------------------------------------------------------------------------++-- * Reducing streams (folds)++foldl :: (b -> a -> b) -> b -> Stream a -> b+foldl f z0 (Stream next s0) = loop_foldl z0 s0+  where+    loop_foldl z !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_foldl z s'+      Yield x s' -> expose s' $ loop_foldl (f z x) s'+{-# INLINE [0] foldl #-}++foldl' :: (b -> a -> b) -> b -> Stream a -> b+foldl' f z0 (Stream next s0) = loop_foldl' z0 s0+  where+    loop_foldl' !z !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_foldl' z s'+      Yield x s' -> expose s' $ loop_foldl' (f z x) s'+{-# INLINE [0] foldl' #-}++foldl1 :: (a -> a -> a) -> Stream a -> a+foldl1 f (Stream next s0) = loop0_foldl1 s0+  where+    loop0_foldl1 !s = case next s of+      Skip    s' -> expose s' $ loop0_foldl1 s'+      Yield x s' -> expose s' $ loop_foldl1 x s'+      Done       -> errorEmptyStream "foldl1"++    loop_foldl1 z !s = expose s $ case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_foldl1 z s'+      Yield x s' -> expose s' $ loop_foldl1 (f z x) s'+{-# INLINE [0] foldl1 #-}++foldl1' :: (a -> a -> a) -> Stream a -> a+foldl1' f (Stream next s0) = loop0_foldl1' s0+  where+    loop0_foldl1' !s = case next s of+      Skip    s' -> expose s' $ loop0_foldl1' s'+      Yield x s' -> expose s' $ loop_foldl1' x s'+      Done       -> errorEmptyStream "foldl1"++    loop_foldl1' !z !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_foldl1' z s'+      Yield x s' -> expose s' $ loop_foldl1' (f z x) s'+{-# INLINE [0] foldl1' #-}++foldr :: (a -> b -> b) -> b -> Stream a -> b+foldr f z (Stream next s0) = loop_foldr s0+  where+    loop_foldr !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_foldr s'+      Yield x s' -> expose s' $ f x (loop_foldr s')+{-# INLINE [0] foldr #-}++foldr1 :: (a -> a -> a) -> Stream a -> a+foldr1 f (Stream next s0) = loop0_foldr1 s0+  where+    loop0_foldr1 !s = case next s of+      Done       -> errorEmptyStream "foldr1"+      Skip    s' -> expose s' $ loop0_foldr1  s'+      Yield x s' -> expose s' $ loop_foldr1 x s'++    loop_foldr1 x !s = case next s of+      Done        -> x+      Skip     s' -> expose s' $ loop_foldr1 x s'+      Yield x' s' -> expose s' $ f x (loop_foldr1 x' s')+{-# INLINE [0] foldr1 #-}++------------------------------------------------------------------------+-- ** Special folds++-- concat+--++concat :: Stream [a] -> [a]+concat (Stream next s0) = loop_concat_to s0+  where+    loop_concat_go []     !s = expose s $     loop_concat_to    s+    loop_concat_go (x:xs) !s = expose s $ x : loop_concat_go xs s++    loop_concat_to !s = case next s of+      Done        -> []+      Skip     s' -> expose s' $ loop_concat_to    s'+      Yield xs s' -> expose s' $ loop_concat_go xs s'+{-# INLINE [0] concat #-}++{-+concat :: Stream [a] -> Stream a+concat (Stream next0 s0) = Stream next (Nothing :!: s0)+  where+    {-# INLINE next #-}+    next (Just (L [])     :!: s) = expose s $ Skip    (Nothing     :!: s)+    next (Just (L (x:xs)) :!: s) = expose s $ Yield x (Just (L xs) :!: s)++    next (Nothing :!: s) = case next0 s of+      Done        -> Done+      Skip     s' -> expose s' $ Skip (Nothing     :!: s')+      Yield xs s' -> expose s' $ Skip (Just (L xs) :!: s')+-}++{-+concatMap :: (a -> [b]) -> Stream a -> [b]+concatMap f (Stream next s0) = loop_concatMap_to s0+  where+    loop_concatMap_go []     !s = expose s $     loop_concatMap_to    s+    loop_concatMap_go (b:bs) !s = expose s $ b : loop_concatMap_go bs s++    loop_concatMap_to !s = case next s of+      Done       -> []+      Skip    s' -> expose s' $ loop_concatMap_to       s'+      Yield a s' -> expose s' $ loop_concatMap_go (f a) s'+{-# INLINE [0] concatMap #-}+-}++{-+concatMap :: (a -> [b]) -> Stream a -> Stream b+concatMap f (Stream next0 s0) = Stream next (Nothing :!: s0)+  where+    {-# INLINE next #-}+    next (Just (L [])     :!: s) = expose s $ Skip    (Nothing     :!: s)+    next (Just (L (b:bs)) :!: s) = expose s $ Yield b (Just (L bs) :!: s)++    next (Nothing :!: s) = case next0 s of+      Done       -> Done+      Skip    s' -> expose s' $ Skip (Nothing        :!: s')+      Yield a s' -> expose s' $ Skip (Just (L (f a)) :!: s')++-}+{-+Here's an approach to fusing concatMap fully:+we try and match the Stream inside in the argument to concatMap and pass that+directly to a concatMap' variant. The point here is that the step function does+not depend on 'x', something which the rule below does not enforce :-)+-}++{- RULES+"dodgy concatMap rule"   forall step f.+  concatMap (\x -> unstream (Stream step (f x))) = \y -> unstream (concatMap' step f y)+  -}++{-+concatMap' :: Unlifted s => (s -> Step b s) -> (a -> s) -> Stream a -> Stream b+concatMap' nextb f (Stream nexta sa0) = Stream next (sa0 :!: Nothing)+  where+    {-# INLINE next #-}+    next (sa :!: Just sb) = case nextb sb of+      Done        -> Skip    (sa :!: Nothing)+      Skip    sb' -> Skip    (sa :!: Just sb')+      Yield b sb' -> Yield b (sa :!: Just sb')++    next (sa :!: Nothing) = case nexta sa of+      Done        -> Done+      Skip    sa' -> Skip (sa' :!: Nothing)+      Yield a sa' -> Skip (sa' :!: Just (f a))+-}++{-+-- note the nested stream is a little hard to construct in a fusible+-- manner+-- +concat :: Stream (Stream a) -> Stream a+concat (Stream next0 s0) = Stream next (Right s0)+  where+    {-# INLINE next #-}+    next (Left (Stream f t :!: s)) = case f t of+      Done       -> Skip    (Right s)+      Skip    t' -> Skip    (Left (Stream f t' :!: s))+      Yield x t' -> Yield x (Left (Stream f t' :!: s))+    next (Right s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip (Right s')+      Yield x s' -> Skip (Left (x :!: s'))+{-# INLINE [0] concat #-}+-}++concatMap :: (a -> Stream b) -> Stream a -> Stream b+concatMap f (Stream next0 s0) = Stream next (s0 :!: Nothing)+  where+    {-# INLINE next #-}+    next (s :!: Nothing) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip (s' :!: Nothing)+      Yield x s' -> Skip (s' :!: Just (f x))++    next (s :!: Just (Stream g t)) = case g t of+      Done       -> Skip    (s :!: Nothing)+      Skip    t' -> Skip    (s :!: Just (Stream g t'))+      Yield x t' -> Yield x (s :!: Just (Stream g t'))++{-# INLINE [0] concatMap #-}++and :: Stream Bool -> Bool+and = foldr (&&) True+{-# INLINE and #-}++or :: Stream Bool -> Bool+or = foldr (||) False+{-# INLINE or #-}++any :: (a -> Bool) -> Stream a -> Bool+any p (Stream next s0) = loop_any s0+  where+    loop_any !s = case next s of+      Done                   -> False+      Skip    s'             -> expose s' $ loop_any s'+      Yield x s' | p x       -> True+                 | otherwise -> expose s' $ loop_any s'+{-# INLINE [0] any #-}++all :: (a -> Bool) -> Stream a -> Bool+all p (Stream next s0) = loop_all s0+  where+    loop_all !s = case next s of+      Done                   -> True+      Skip    s'             -> expose s' $ loop_all s'+      Yield x s' | p x       -> expose s' $ loop_all s'+                 | otherwise -> False+{-# INLINE [0] all #-}++sum :: Num a => Stream a -> a+sum (Stream next s0) = loop_sum 0 s0+  where+    loop_sum !a !s = case next s of   -- note: strict in the accumulator!+      Done       -> a+      Skip    s' -> expose s' $ loop_sum a s'+      Yield x s' -> expose s' $ loop_sum (a + x) s'+{-# INLINE [0] sum #-}++product :: Num a => Stream a -> a+product (Stream next s0) = loop_product 1 s0   -- note: strict in the accumulator!+  where+    loop_product !a !s = case next s of+      Done       -> a+      Skip    s' -> expose s' $ loop_product a s'+      Yield x s' -> expose s' $ loop_product (a * x) s'+{-# INLINE [0] product #-}++maximum :: Ord a => Stream a -> a+maximum (Stream next s0) = loop0_maximum s0+  where+    loop0_maximum !s = case next s of+      Done       -> errorEmptyStream "maximum"+      Skip    s' -> expose s' $ loop0_maximum s'+      Yield x s' -> expose s' $ loop_maximum x s'+    loop_maximum z !s = case next s of               -- note, lazy in the accumulator+      Done       -> z+      Skip    s' -> expose s' $ loop_maximum z s'+      Yield x s' -> expose s' $ loop_maximum (max z x) s'+{-# INLINE [0] maximum #-}++{-# RULES+  "maximumInt"     maximum = (strictMaximum :: Stream Int  -> Int);+  "maximumChar"    maximum = (strictMaximum :: Stream Char -> Char)+  #-}++strictMaximum :: Ord a => Stream a -> a+strictMaximum (Stream next s0) = loop0_strictMaximum s0+  where+    loop0_strictMaximum !s = case next s of+      Done       -> errorEmptyStream "maximum"+      Skip    s' -> expose s' $ loop0_strictMaximum s'+      Yield x s' -> expose s' $ loop_strictMaximum x s'+    loop_strictMaximum !z !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_strictMaximum z s'+      Yield x s' -> expose s' $ loop_strictMaximum (max z x) s'+{-# INLINE [0] strictMaximum #-}++minimum :: Ord a => Stream a -> a+minimum (Stream next s0) = loop0_minimum s0+  where+    loop0_minimum !s = case next s of+      Done       -> errorEmptyStream "minimum"+      Skip    s' -> expose s' $ loop0_minimum s'+      Yield x s' -> expose s' $ loop_minimum x s'+    loop_minimum z !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_minimum z s'+      Yield x s' -> expose s' $ loop_minimum (min z x) s'+{-# INLINE [0] minimum #-}++{-# RULES+  "minimumInt"     minimum = (strictMinimum :: Stream Int  -> Int);+  "minimumChar"    minimum = (strictMinimum :: Stream Char -> Char)+  #-}++strictMinimum :: Ord a => Stream a -> a+strictMinimum (Stream next s0) = loop0_strictMinimum s0+  where+    loop0_strictMinimum !s = case next s of+      Done       -> errorEmptyStream "minimum"+      Skip    s' -> expose s' $ loop0_strictMinimum s'+      Yield x s' -> expose s' $ loop_strictMinimum x s'+    loop_strictMinimum !z !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_strictMinimum z s'+      Yield x s' -> expose s' $ loop_strictMinimum (min z x) s'+{-# INLINE [0] strictMinimum #-}++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++--+-- FIXME: not a proper scanl. expects a list one longer than the input list,+-- in order to get the z0th element+--+scanl :: (b -> a -> b) -> b -> Stream a -> Stream b+scanl f z0 (Stream next0 s0) = Stream next (L z0 :!: s0)+  where+    {-# INLINE next #-}+    next (L z :!: s) = case next0 s of+        Done        -> Done+        Skip    s'  -> Skip    (L z       :!: s')+        Yield x s'  -> Yield z (L (f z x) :!: s')+{-# INLINE [0] scanl #-}++scanl1 :: (a -> a -> a) -> Stream a -> Stream a+scanl1 f (Stream next0 s0) = Stream next (Nothing :!: s0)+  where+    {-# INLINE next #-}+    next (Nothing :!: s)      = case next0 s of+            Done       -> Done+            Skip s'    -> Skip (Nothing    :!: s')+            Yield x s' -> Skip (Just (L x) :!: s')+    next (Just (L z) :!: s)   = case next0 s of+        Done       -> Done+        Skip    s' -> Skip    (Just (L z)       :!: s')+        Yield x s' -> Yield z (Just (L (f z x)) :!: s')+{-# INLINE [0] scanl1 #-}++--+-- hmm. hard.+--++{-+scanr :: (b -> a -> b) -> b -> Stream a -> Stream b+scanr f z0 (Stream next s0) = Stream next' (Just s0)+  where+    next' (Just s) = case next s of+        Done        -> Yield z0 (Nothing, s)+        Skip s'     -> Skip (Just s')+        Yield x s'  -> -- hmm.++    next' Nothing = Done+{-# INLINE [0] scanl #-}+-}+++{-+scanr :: (a -> b -> b) -> b -> Stream a -> Stream b+scanr f z0 (Stream next s0) = Stream next' (z0, s0)     -- should be using strict pairs??+  where+    next' (z, s) = case next s of+        Done        -> Done+        Skip s'     -> Skip (z, s')+        Yield x s'  -> Yield z (f x z, s') -- flip f+{-# INLINE [0] scanr #-}+-}++{-+scanl1 :: (a -> a -> a) -> Stream a -> Stream a+scanr1 :: (a -> a -> a) -> Stream a -> Stream a+-}++------------------------------------------------------------------------+-- ** Accumulating maps++{-+--+-- not right:+--+mapAccumL :: (acc -> x -> (acc, y)) -> acc -> Stream x -> (acc, Stream y)+mapAccumL f acc (Stream step s) = Stream step' (s, acc)+  where+    step' (s, acc) = case step s of+          Done       -> Done+          Skip s'    -> Skip (s', acc)+          Yield x s' -> let (acc', y) = f acc x in Yield y (s', acc')+{-# INLINE [0] mapAccumL #-}+-}++{-+mapAccumR :: (acc -> x -> (acc, y)) -> acc -> Stream x -> (acc, Stream y)+-}++------------------------------------------------------------------------+-- ** Infinite streams++iterate :: (a -> a) -> a -> Stream a+iterate f x0 = Stream next (L x0)+  where+    {-# INLINE next #-}+    next (L x) = Yield x (L (f x))+{-# INLINE [0] iterate #-}++repeat :: a -> Stream a+repeat x = Stream next None+  where+    {-# INLINE next #-}+    next _ = Yield x None+{-# INLINE [0] repeat #-}++{-# RULES+  "map/repeat" forall f x. map f (repeat x) = repeat (f x)+  #-}++replicate :: Int -> a -> Stream a+replicate n x = Stream next (L n)+  where+    {-# INLINE next #-}+    next (L !i) | i <= 0    = Done+                | otherwise = Yield x (L (i-1))+{-# INLINE [0] replicate #-}++{-# RULES+  "map/replicate" forall f n x. map f (replicate n x) = replicate n (f x)+  #-}++--"reverse/replicate" forall n x. reverse (replicate n x) = replicate n x++cycle :: Stream a -> Stream a+cycle (Stream next0 s0) = Stream next (s0 :!: S1)+  where+    {-# INLINE next #-}+    next (s :!: S1) = case next0 s of+      Done       -> errorEmptyStream "cycle"+      Skip    s' -> Skip    (s' :!: S1)+      Yield x s' -> Yield x (s' :!: S2)+    next (s :!: S2) = case next0 s of+      Done       -> Skip    (s0 :!: S2)+      Skip    s' -> Skip    (s' :!: S2)+      Yield x s' -> Yield x (s' :!: S2)+{-# INLINE [0] cycle #-}++------------------------------------------------------------------------+-- ** Unfolding++unfoldr :: (b -> Data.Maybe.Maybe (a, b)) -> b -> Stream a+unfoldr f s0 = Stream next (L s0)+  where+    {-# INLINE next #-}+    next (L s) = case f s of+      Data.Maybe.Nothing      -> Done+      Data.Maybe.Just (w, s') -> Yield w (L s')+{-# INLINE [0] unfoldr #-}++------------------------------------------------------------------------+-- * Substreams+-- ** Extracting substreams++take :: Int -> Stream a -> Stream a+take n0 (Stream next0 s0) = Stream next (L n0 :!: s0)+  where+    {-# INLINE next #-}+    next (L !n :!: s)+      | n <= 0    = Done+      | otherwise = case next0 s of+            Done       -> Done+            Skip    s' -> Skip    (L  n    :!: s')+            Yield x s' -> Yield x (L (n-1) :!: s')+{-# INLINE [0] take #-}++drop :: Int -> Stream a -> Stream a+drop n0 (Stream next0 s0) = Stream next (Just (L (max 0 n0)) :!: s0)+  where+    {-# INLINE next #-}+    next (Just (L !n) :!: s)+      | n == 0    = Skip (Nothing :!: s)+      | otherwise = case next0 s of+          Done       -> Done+          Skip    s' -> Skip (Just (L  n)    :!: s')+          Yield _ s' -> Skip (Just (L (n-1)) :!: s')+    next (Nothing :!: s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (Nothing :!: s')+      Yield x s' -> Yield x (Nothing :!: s')+{-# INLINE [0] drop #-}++--TODO: could perhaps use 0 instead of Nothing, so long as+--      spec constr works with that++splitAt :: Int -> Stream a -> ([a], [a])+splitAt n0 (Stream next s0)+  --TODO: we should not need this special case, (n < 0) should be as+  --      cheap as pattern matching n against 0+  | n0 < 0    = ([], expose s0 $ unstream (Stream next s0))+  | otherwise = loop_splitAt n0 s0+  where+    loop_splitAt  0 !s = ([], expose s $ unstream (Stream next s))+    loop_splitAt !n !s = case next s of+      Done            -> ([], [])+      Skip    s'      -> expose s $ loop_splitAt n s'+      Yield x s'      -> (x:xs', xs'')+        where+          (xs', xs'') = expose s $ loop_splitAt (n-1) s'+{-# INLINE [0] splitAt #-}++takeWhile :: (a -> Bool) -> Stream a -> Stream a+takeWhile p (Stream next0 s0) = Stream next s0+  where+    {-# INLINE next #-}+    next !s = case next0 s of+      Done                   -> Done+      Skip    s'             -> Skip s'+      Yield x s' | p x       -> Yield x s'+                 | otherwise -> Done+{-# INLINE [0] takeWhile #-}++dropWhile :: (a -> Bool) -> Stream a -> Stream a+dropWhile p (Stream next0 s0) = Stream next (S1 :!: s0)+  where+    {-# INLINE next #-}+    next (S1 :!: s)  = case next0 s of+      Done                   -> Done+      Skip    s'             -> Skip    (S1 :!: s')+      Yield x s' | p x       -> Skip    (S1 :!: s')+                 | otherwise -> Yield x (S2 :!: s')+    next (S2 :!: s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (S2 :!: s')+      Yield x s' -> Yield x (S2 :!: s')+{-# INLINE [0] dropWhile #-}++{-+span :: (a -> Bool) -> Stream a -> (Stream a, Stream a)+break :: (a -> Bool) -> Stream a -> (Stream a, Stream a)+group :: Eq a => Stream a -> Stream (Stream a)+inits :: Stream a -> Stream (Stream a)+tails :: Stream a -> Stream (Stream a)+-}++------------------------------------------------------------------------+-- * Predicates++isPrefixOf :: Eq a => Stream a -> Stream a -> Bool+isPrefixOf (Stream stepa sa0) (Stream stepb sb0) = loop_isPrefixOf sa0 sb0 Nothing+  where+    loop_isPrefixOf !sa !sb Nothing = case stepa sa of+        Done        -> True+        Skip    sa' -> expose sa' $ loop_isPrefixOf sa' sb Nothing+        Yield x sa' -> expose sa' $ loop_isPrefixOf sa' sb (Just (L x))++    loop_isPrefixOf !sa !sb (Just (L x)) = case stepb sb of+        Done                    -> False+        Skip    sb'             -> expose sb' $ loop_isPrefixOf sa sb' (Just (L x))+        Yield y sb' | x == y    -> expose sb' $ loop_isPrefixOf sa sb' Nothing+                    | otherwise -> False+{-# INLINE [0] isPrefixOf #-}+++{-+isSuffixOf :: Eq a => Stream a -> Stream a -> Bool+isInfixOf :: Eq a => Stream a -> Stream a -> Bool+-}++------------------------------------------------------------------------+-- * Searching streams+-- ** Searching by equality++elem :: Eq a => a -> Stream a -> Bool+elem x (Stream next s0) = loop_elem s0+  where+    loop_elem !s = case next s of+      Done          -> False+      Skip    s'    -> expose s' $            loop_elem s'+      Yield y s'+        | x == y    -> True+        | otherwise -> expose s' $ loop_elem s'+{-# INLINE [0] elem #-}++{-+--+-- No need to provide notElem, as not . elem is just as fusible.+-- You can only fuse on the rhs of elem anyway.+--++notElem :: Eq a => a -> Stream a -> Bool+notElem x (Stream next s0) = loop s0+  where+    loop !s = case next s of+      Done                   -> True+      Skip    s'             -> loop s'+      Yield y s' | x == y    -> False+                 | otherwise -> loop s'+{-# INLINE [0] notElem #-}+-}++lookup :: Eq a => a -> Stream (a, b) -> Data.Maybe.Maybe b+lookup key (Stream next s0) = loop_lookup s0+  where+    loop_lookup !s = case next s of+      Done                        -> Data.Maybe.Nothing+      Skip         s'             -> expose s' $ loop_lookup s'+      Yield (x, y) s' | key == x  -> Data.Maybe.Just y+                      | otherwise -> expose s' $ loop_lookup s'+{-# INLINE [0] lookup #-}++------------------------------------------------------------------------+-- ** Searching with a predicate++find :: (a -> Bool) -> Stream a -> Data.Maybe.Maybe a+find p (Stream next s0) = loop_find s0+  where+    loop_find !s = case next s of+      Done                   -> Data.Maybe.Nothing+      Skip    s'             -> expose s' $ loop_find s'+      Yield x s' | p x       -> Data.Maybe.Just x+                 | otherwise -> expose s' $ loop_find s'+{-# INLINE [0] find #-}++filter :: (a -> Bool) -> Stream a -> Stream a+filter p (Stream next0 s0) = Stream next s0+  where+    {-# INLINE next #-}+    next !s = case next0 s of+      Done                   -> Done+      Skip    s'             -> Skip    s'+      Yield x s' | p x       -> Yield x s'+                 | otherwise -> Skip    s'+{-# INLINE [0] filter #-}++{-# RULES+    "Stream filter/filter fusion" forall p q s.+        filter p (filter q s) = filter (\x -> q x && p x) s+ #-}++--partition :: (a -> Bool) -> Stream a -> (Stream a, Stream a)++------------------------------------------------------------------------+-- * Indexing streams++index :: Stream a -> Int -> a+index (Stream next s0) n0+  | n0 < 0    = error "Stream.(!!): negative index"+  | otherwise = loop_index n0 s0+  where+    loop_index !n !s = case next s of+      Done                   -> error "Stream.(!!): index too large"+      Skip    s'             -> expose s' $ loop_index  n    s'+      Yield x s' | n == 0    -> x+                 | otherwise -> expose s' $ loop_index (n-1) s'+{-# INLINE [0] index #-}++findIndex :: (a -> Bool) -> Stream a -> Data.Maybe.Maybe Int+findIndex p (Stream next s0) = loop_findIndex 0 s0+  where+    loop_findIndex !i !s = case next s of+      Done                   -> Data.Maybe.Nothing+      Skip    s'             -> expose s' $ loop_findIndex i     s' -- hmm. not caught by QC+      Yield x s' | p x       -> Data.Maybe.Just i+                 | otherwise -> expose s' $ loop_findIndex (i+1) s'+{-# INLINE [0] findIndex #-}++elemIndex :: Eq a => a -> Stream a -> Data.Maybe.Maybe Int+elemIndex a (Stream next s0) = loop_elemIndex 0 s0+  where+    loop_elemIndex !i !s = case next s of+      Done                   -> Data.Maybe.Nothing+      Skip    s'             -> expose s' $ loop_elemIndex i     s'+      Yield x s' | a == x    -> Data.Maybe.Just i+                 | otherwise -> expose s' $ loop_elemIndex (i+1) s'+{-# INLINE [0] elemIndex #-}++elemIndices :: Eq a => a -> Stream a -> Stream Int+elemIndices a (Stream next0 s0) = Stream next (S 0 :!: s0)+  where+    {-# INLINE next #-}+    next (S n :!: s) = case next0 s of+        Done                   -> Done+        Skip    s'             -> Skip    (S n     :!: s')+        Yield x s' | x == a    -> Yield n (S (n+1) :!: s')+                   | otherwise -> Skip    (S (n+1) :!: s')+{-# INLINE [0] elemIndices #-}++findIndices :: (a -> Bool) -> Stream a -> Stream Int+findIndices p (Stream next0 s0) = Stream next (S 0 :!: s0)+  where+    {-# INLINE next #-}+    next (S n :!: s) = case next0 s of+        Done                   -> Done+        Skip    s'             -> Skip    (S n     :!: s')+        Yield x s' | p x       -> Yield n (S (n+1) :!: s')+                   | otherwise -> Skip    (S (n+1) :!: s')+{-# INLINE [0] findIndices #-}++------------------------------------------------------------------------+-- * Zipping and unzipping streams++zip :: Stream a -> Stream b -> Stream (a, b)+zip = zipWith (,)+{-# INLINE zip #-}++zip3 :: Stream a -> Stream b -> Stream c -> Stream (a, b, c)+zip3 = zipWith3 (,,)+{-# INLINE zip3 #-}++zip4 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream (a, b, c, d)+zip4 = zipWith4 (,,,)+{-# INLINE zip4 #-}++{-+zip5 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> [(a, b, c, d, e)]+zip6 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream f -> [(a, b, c, d, e, f)]+zip7 :: Stream a -> Stream b -> Stream c -> Stream d -> Stream e -> Stream f -> Stream g -> [(a, b, c, d, e, f, g)]+-}++zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c+zipWith f (Stream next0 sa0) (Stream next1 sb0) = Stream next (sa0 :!: sb0 :!: Nothing)+  where+    {-# INLINE next #-}+    next (sa :!: sb :!: Nothing)     = case next0 sa of+        Done        -> Done+        Skip    sa' -> Skip (sa' :!: sb :!: Nothing)+        Yield a sa' -> Skip (sa' :!: sb :!: Just (L a))++    next (sa' :!: sb :!: Just (L a)) = case next1 sb of+        Done        -> Done+        Skip    sb' -> Skip          (sa' :!: sb' :!: Just (L a))+        Yield b sb' -> Yield (f a b) (sa' :!: sb' :!: Nothing)+{-# INLINE [0] zipWith #-}++zipWith3 :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d+zipWith3 f (Stream nexta sa0)+           (Stream nextb sb0)+           (Stream nextc sc0) = Stream next (sa0 :!: sb0 :!: sc0 :!: Nothing)+  where+    {-# INLINE next #-}+    next (sa :!:  sb :!:  sc :!: Nothing) = case nexta sa of+      Done        -> Done+      Skip    sa' -> Skip (sa' :!: sb :!: sc :!: Nothing)+      Yield a sa' -> Skip (sa' :!: sb :!: sc :!: Just (L a :!: Nothing))++    next (sa' :!: sb :!:  sc :!: Just (L a :!: Nothing)) = case nextb sb of+      Done        -> Done+      Skip    sb' -> Skip          (sa' :!: sb' :!: sc :!: Just (L a :!: Nothing))+      Yield b sb' -> Skip          (sa' :!: sb' :!: sc :!: Just (L a :!: Just (L b)))++    next (sa' :!: sb' :!: sc :!: Just (L a :!: Just (L b))) = case nextc sc of+      Done        -> Done+      Skip    sc' -> Skip            (sa' :!: sb' :!: sc' :!: Just (L a :!: Just (L b)))+      Yield c sc' -> Yield (f a b c) (sa' :!: sb' :!: sc' :!: Nothing)+{-# INLINE [0] zipWith3 #-}++zipWith4 :: (a -> b -> c -> d -> e) -> Stream a -> Stream b -> Stream c -> Stream d -> Stream e+zipWith4 f (Stream nexta sa0)+           (Stream nextb sb0)+           (Stream nextc sc0)+           (Stream nextd sd0) = Stream next (sa0 :!: sb0 :!: sc0 :!: sd0 :!: Nothing)+  where+    {-# INLINE next #-}+    next (sa :!:  sb :!:  sc :!: sd :!: Nothing) =+        case nexta sa of+            Done        -> Done+            Skip    sa' -> Skip (sa' :!: sb :!: sc :!: sd :!: Nothing)+            Yield a sa' -> Skip (sa' :!: sb :!: sc :!: sd :!: Just (L a :!: Nothing))++    next (sa' :!: sb :!:  sc :!: sd :!: Just (L a :!: Nothing)) =+        case nextb sb of+            Done        -> Done+            Skip    sb' -> Skip (sa' :!: sb' :!: sc :!: sd :!: Just (L a :!: Nothing))+            Yield b sb' -> Skip (sa' :!: sb' :!: sc :!: sd :!: Just (L a :!: Just (L b :!: Nothing)))++    next (sa' :!: sb' :!: sc :!: sd :!: Just (L a :!: (Just (L b :!: Nothing)))) =+        case nextc sc of+            Done        -> Done+            Skip    sc' -> Skip (sa' :!: sb' :!: sc' :!: sd :!: Just (L a :!: (Just (L b :!: Nothing))))+            Yield c sc' -> Skip (sa' :!: sb' :!: sc' :!: sd :!: Just (L a :!: (Just (L b :!: Just (L c)))))++    next (sa' :!: sb' :!: sc' :!: sd :!: Just (L a :!: (Just (L b :!: Just (L c))))) =+        case nextd sd of+            Done        -> Done+            Skip    sd' -> Skip              (sa' :!: sb' :!: sc' :!: sd' :!: Just (L a :!: (Just (L b :!: Just (L c)))))+            Yield d sd' -> Yield (f a b c d) (sa' :!: sb' :!: sc' :!: sd' :!: Nothing)+{-# INLINE [0] zipWith4 #-}++unzip :: Stream (a, b) -> ([a], [b])+unzip = foldr (\(a,b) ~(as, bs) -> (a:as, b:bs)) ([], [])+{-# INLINE unzip #-}++------------------------------------------------------------------------+-- * Special streams+-- ** Functions on strings++{-+--+-- As a concatMap (snoc '\n')+--+unlines :: Stream (Stream Char) -> Stream Char+unlines (Stream next s0) = Stream next' (Right s0)+  where+    next' (Left (Stream g t, s)) = case g t of+      Done       -> Skip    (Right s)+      Skip    t' -> Skip    (Left (Stream g t', s))+      Yield x t' -> Yield x (Left (Stream g t', s))++    next' (Right s) = case next s of+      Done       -> Done+      Skip    s' -> Skip (Right s')+      Yield x s' -> Skip (Left ((snoc x '\n'), s'))+{-# INLINE [0] unlines #-}+-}++{-+--+-- As a concat . intersperse+--+unlines (Stream next s0) = Stream next' (Right s0)+  where+    -- go+    next' (Left (Stream f t, s)) = case f t of+      Done       -> Yield '\n' (Right s)+      Skip    t' -> Skip    (Left (Stream f t', s))+      Yield x t' -> Yield x (Left (Stream f t', s))++    -- to+    next' (Right s) = case next s of+      Done       -> Done+      Skip    s' -> Skip (Right s')+      Yield x s' -> Skip (Left (x, s'))+-}++{-+lines :: Stream Char -> Stream [Char]+lines (Stream next0 s0) = Stream next (Nothing :!: s0)+  where+    {-# INLINE next #-}+    next (Nothing  :!: s)     = case next0 s of+        Done           -> Done+        Skip s'        -> Skip (Nothing     :!: s')+        Yield _ _      -> Skip (Just (S []) :!: s) -- !++    next (Just (S acc) :!: s) = case next0 s of+        Done          -> Yield (reverse acc) (Nothing :!: s) -- !+        Skip s'       -> Skip (Just (S acc) :!: s')+        Yield '\n' s' -> Yield (reverse acc) (Nothing :!: s') -- reuse first state+        Yield x    s' -> Skip (Just (S (x:acc)) :!: s')++    {-# INLINE reverse #-}+    reverse :: [Char] -> [Char]+    reverse l = rev l []+      where+        rev []     a = a+        rev (x:xs) a = rev xs (x:a)+-}+{-+lines :: Stream Char -> Stream (Stream Char)+lines (Stream next s0 len) = Stream next' s0 len+  where+    next' s = case next s of+        Done    -> Done+        Skip s' -> Skip s'+-}+++{-+lines' [] = []+lines' s  = let (l, s') = break (== '\n') s+            in l : case s' of+                     []      -> []+                     (_:s'') -> lines' s''+-}++{-+words :: String -> [String]+unlines :: [String] -> String+unwords :: [String] -> String+-}++------------------------------------------------------------------------+-- ** \"Set\" operations++{-+nub :: Eq a => Stream a -> Stream a+delete :: Eq a => a -> Stream a -> Stream a+difference :: Eq a => Stream a -> Stream a -> Stream a+union :: Eq a => Stream a -> Stream a -> Stream a+intersect :: Eq a => Stream a -> Stream a -> Stream a+-}++-- ** Ordered streams ++{-+sort :: Ord a => Stream a -> Stream a+insert :: Ord a => a -> Stream a -> Stream a+-}++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++{-+nubBy :: (a -> a -> Bool) -> Stream a -> Stream a+deleteBy :: (a -> a -> Bool) -> a -> Stream a -> Stream a+deleteFirstsBy :: (a -> a -> Bool) -> Stream a -> Stream a -> Stream a+unionBy :: (a -> a -> Bool) -> Stream a -> Stream a -> Stream a+intersectBy :: (a -> a -> Bool) -> Stream a -> Stream a -> Stream a+groupBy :: (a -> a -> Bool) -> Stream a -> Stream (Stream a)+-}++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++{-+sortBy :: (a -> a -> Ordering) -> Stream a -> Stream a+-}++insertBy :: (a -> a -> Ordering) -> a -> Stream a -> Stream a+insertBy cmp x (Stream next0 s0) = Stream next (S2 :!: s0)+  where+    {-# INLINE next #-}+    -- find the insertion point+    next (S2 :!: s) = case next0 s of+        Done        -> Yield x (S1 :!: s) -- a snoc+        Skip    s'  -> Skip    (S2 :!: s')+        Yield y s' | GT == cmp x y -> Yield y (S2 :!: s')+                   | otherwise     -> Yield x (S1 :!: s)  -- insert++    -- we've inserted, now just yield the rest of the stream+    next (S1 :!: s) = case next0 s of+        Done       -> Done+        Skip    s' -> Skip    (S1 :!: s')+        Yield y s' -> Yield y (S1 :!: s')+{-# INLINE [0] insertBy #-}++maximumBy :: (a -> a -> Ordering) -> Stream a -> a+maximumBy cmp (Stream next s0) = loop0_maximumBy s0+  where+    loop0_maximumBy !s = case next s of+      Skip    s' -> expose s' $ loop0_maximumBy s'+      Yield x s' -> expose s' $ loop_maximumBy x s'+      Done       -> errorEmptyStream "maximumBy"++    loop_maximumBy z !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_maximumBy z s'+      Yield x s' -> expose s' $ loop_maximumBy (max' z x) s'++    max' x y = case cmp x y of+                    GT -> x+                    _  -> y+{-# INLINE [0] maximumBy #-}++minimumBy :: (a -> a -> Ordering) -> Stream a -> a+minimumBy cmp (Stream next s0) = loop0_minimumBy s0+  where+    loop0_minimumBy !s = case next s of+      Skip    s' -> expose s' $ loop0_minimumBy s'+      Yield x s' -> expose s' $ loop_minimumBy x s'+      Done       -> errorEmptyStream "minimum"++    loop_minimumBy z !s = case next s of+      Done       -> z+      Skip    s' -> expose s' $ loop_minimumBy z s'+      Yield x s' -> expose s' $ loop_minimumBy (min' z x) s'++    min' x y = case cmp x y of+                    GT -> y+                    _  -> x+{-# INLINE [0] minimumBy #-}++------------------------------------------------------------------------+-- * The \"generic\" operations++-- length+genericLength :: Num i => Stream b -> i+genericLength (Stream next s0) = loop_genericLength s0+  where+    loop_genericLength !s = case next s of+      Done       -> 0+      Skip    s' -> expose s' $     loop_genericLength s'+      Yield _ s' -> expose s' $ 1 + loop_genericLength s'+{-# INLINE [0] genericLength #-}++--TODO: specialised generic Length for strict/atomic and associative Num+-- instances like Int and Integer++genericTake :: Integral i => i -> Stream a -> Stream a+genericTake n0 (Stream next0 s0) = Stream next (L n0 :!: s0)+  where+    {-# INLINE next #-}+    next (L 0 :!: _)  = Done+    next (L n :!: s)  = case next0 s of+        Done          -> Done+        Skip    s'    -> Skip    (L  n    :!: s')+        Yield x s'+          | n > 0     -> Yield x (L (n-1) :!: s')+          | otherwise -> error "List.genericTake: negative argument"+{-# INLINE [0] genericTake #-}++-- genericTake is defined so bizzarely!++genericDrop :: Integral i => i -> Stream a -> Stream a+genericDrop n0 (Stream next0 s0) = Stream next (Just (L n0) :!: s0)+  where+    {-# INLINE next #-}+    next (Just (L 0) :!: s) = Skip (Nothing :!: s)+    next (Just (L n) :!: s) = case next0 s of+      Done                    -> Done+      Skip    s'              -> Skip (Just (L  n)    :!: s')+      Yield _ s' | n > 0      -> Skip (Just (L (n-1)) :!: s')+                 | otherwise  -> error "List.genericDrop: negative argument"+    next (Nothing :!: s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (Nothing :!: s')+      Yield x s' -> Yield x (Nothing :!: s')+{-# INLINE [0] genericDrop #-}++genericIndex :: Integral a => Stream b -> a -> b+genericIndex (Stream next s0) i0 = loop_genericIndex i0 s0+  where+    loop_genericIndex i !s = case next s of+      Done                   -> error "List.genericIndex: index too large."+      Skip    s'             -> expose s' $ loop_genericIndex i     s'+      Yield x s' | i == 0    -> x+                 | i > 0     -> expose s' $ loop_genericIndex (i-1) s'+                 | otherwise -> error "List.genericIndex: negative argument."+{-# INLINE [0] genericIndex #-}++-- can we pull the n > 0 test out and do it just once?+-- probably not since we don't know what n-1 does!!+-- can only specialise it for sane Integral instances :-(+++genericSplitAt :: Integral i => i -> Stream a -> ([a], [a])+genericSplitAt n0 (Stream next s0) = loop_genericSplitAt n0 s0+  where+    loop_genericSplitAt 0 !s = ([], expose s $ unstream (Stream next s))+    loop_genericSplitAt n !s = case next s of+      Done            -> ([], [])+      Skip    s'      -> expose s $ loop_genericSplitAt n s'+      Yield x s'+        | n > 0       -> (x:xs', xs'')+        | otherwise   -> error "List.genericSplitAt: negative argument"+        where+          (xs', xs'') = expose s $ loop_genericSplitAt (n-1) s'+{-# INLINE [0] genericSplitAt #-}++{-+-- No need:+genericReplicate        -- :: Integral i => i -> a -> Stream a+-}++-- ---------------------------------------------------------------------+-- Enum++{-+enumFromToNum :: (Ord a, Num a) => a -> a -> Stream a+enumFromToNum x y = Stream next (L x)+  where+    {-# INLINE next #-}+    next (L !n)+        | n > y     = Done+        | otherwise = Yield n (L (n+1))+{-# INLINE [0] enumFromToNum #-}+-}++enumFromToInt :: Int -> Int -> Stream Int+enumFromToInt x y = Stream next (L x)+  where+    {-# INLINE next #-}+    next (L !n)+        | n > y     = Done+        | otherwise = Yield n (L (n+1))+{-# INLINE [0] enumFromToInt #-}++enumDeltaInteger :: Integer -> Integer -> Stream Integer+enumDeltaInteger a d = Stream next (L a)+  where+    {-# INLINE next #-}+    next (L !x) = Yield x (L (x+d))+{-# INLINE [0] enumDeltaInteger #-}++enumFromToChar :: Char -> Char -> Stream Char+enumFromToChar x y = Stream next (L (ord x))+  where+    m = ord y++    {-# INLINE next #-}+    next (L !n)+        | n > m     = Done+        | otherwise = Yield (chr n) (L (n+1))+{-# INLINE [0] enumFromToChar #-}++-- ---------------------------------------------------------------------+-- Monadic stuff++-- Most monadic list functions can be defined in terms of foldr so don't+-- need explicit stream implementations. The one exception is foldM:+--++foldM :: Monad m => (b -> a -> m b) -> b -> Stream a -> m b+foldM f z0 (Stream next s0) = loop_foldl z0 s0+  where+    loop_foldl z !s = case next s of+      Done       -> Monad.return z+      Skip    s' -> expose s' $                  loop_foldl z  s'+      Yield x s' -> expose s' $ f z x >>= \z' -> loop_foldl z' s'+{-# INLINE [0] foldM #-}++foldM_ :: Monad m => (b -> a -> m b) -> b -> Stream a -> m ()+foldM_ f z0 (Stream next s0) = loop_foldl z0 s0+  where+    loop_foldl z !s = case next s of+      Done       -> Monad.return ()+      Skip    s' -> expose s' $                  loop_foldl z  s'+      Yield x s' -> expose s' $ f z x >>= \z' -> loop_foldl z' s'+{-# INLINE [0] foldM_ #-}+++-- ---------------------------------------------------------------------+-- List comprehension desugaring++return :: a -> Stream a+return e = Stream next S1+  where+    {-# INLINE next #-}+    next S1 = Yield e S2+    next S2 = Done+{-# INLINE [0] return #-}++guard :: Bool -> Stream a -> Stream a+guard b (Stream next0 s0) = Stream next (S1 :!: s0)+  where+    {-# INLINE next #-}+    next (S1 :!: s) = if b then Skip (S2 :!: s) else Done+    next (S2 :!: s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (S2 :!: s')+      Yield x s' -> Yield x (S2 :!: s')+{-# INLINE [0] guard #-}++bind :: (a -> Bool) -> (a -> Stream b) -> Stream a -> Stream b+bind b f (Stream next0 s0) = Stream next (s0 :!: Nothing)+  where+    {-# INLINE next #-}+    next (s :!: Nothing) = case next0 s of+      Done          -> Done+      Skip    s'    -> Skip    (s' :!: Nothing)+      Yield x s' +        | b x       -> Skip (s' :!: Just (f x))+        | otherwise -> Skip (s' :!: Nothing)++    next (s :!: Just (Stream next1 s1)) = case next1 s1 of+      Done        -> Skip    (s :!: Nothing)+      Skip    s1' -> Skip    (s :!: Just (Stream next1 s1'))+      Yield x s1' -> Yield x (s :!: Just (Stream next1 s1'))+{-# INLINE [0] bind #-}++mapFilter :: (a -> Bool) -> (a -> b) -> Stream a -> Stream b+mapFilter b f (Stream next0 s0) = Stream next s0+  where+    {-# INLINE next #-}+    next s = case next0 s of+      Done          -> Done+      Skip    s'    -> Skip        s'+      Yield x s'+        | b x       -> Yield (f x) s'+        | otherwise -> Skip        s'+{-# INLINE [0] mapFilter #-}++declare :: (a -> Stream b) -> a -> Stream b+declare f bs = Stream next (f bs)+  where+    {-# INLINE next #-}+    next (Stream next0 s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (Stream next0 s')+      Yield x s' -> Yield x (Stream next0 s')+{-# INLINE [0] declare #-}++-- ---------------------------------------------------------------------+-- Internal utilities++-- Common up near identical calls to `error' to reduce the number+-- constant strings created when compiled:+errorEmptyStream :: String -> a+errorEmptyStream fun = moduleError fun "empty list"+{-# NOINLINE errorEmptyStream #-}++moduleError :: String -> String -> a+moduleError fun msg = error ("List." ++ fun ++ ':':' ':msg)+{-# NOINLINE moduleError #-}
+ GHC_BUILD view
@@ -0,0 +1,113 @@+++            Build instructions for nobench + ghc with stream fusion+            --------------------------------------------------------++* Grab a current ghc tree (we have a local cache):++    $ scp -r /home/chakcvs/darcs/streams/ghc .++* Install our base fork into the tree:++    $ cd ghc/libraries++    $ darcs get /home/chakcvs/darcs/streams/base+    Copying patch 1730 of 1730... done!+    Finished getting.++    $ cd ../..++* Build as normal++    $ cat /home/dons/streams/build.mk +    SRC_HC_OPTS     = -H64m -O -fasm+    GhcStage1HcOpts = -O -fasm+    GhcStage2HcOpts = -O2 -fasm+    GhcLibHcOpts    = -O2 -fasm+    GhcLibWays      =+    SplitObjs       = NO++    $ cp /home/dons/streams/build.mk ./mk/++    $ autoreconf+    $ ./configure+    $ make -j2++* Get nobench:++    $ cd /tmp/+    $ darcs get http://www.cse.unsw.edu.au/~dons/code/nobench+    $ cd nobench  +    $ make boot++    Note the report generator needs the xhtml package.++* Edit the config files:++    Just needs to point to the in-place GHC, and for ghc-old to be+    your most recent non-stream ghc. Edit header.mk to have:++        COMPILERS   = ghc ghc-old ++        GHC         = /home/dons/streams/build/compiler/stage2/ghc-inplace+        GHC_OLD     = ghc-6.7.20070224++        GHC_OPTS     = -Rghc-timing -O2 -fasm -fliberate-case-threshold100 -fdicts-cheap -fno-method-sharing -ddump-simpl-stats++* Run a test:+    +    $ cd spectral/calendar +    $ make++    Test: calendar (Bird and Wadlers calendar program)+    http://www.cse.unsw.edu.au/~dons/code/nobench//calendar+    ghc                  3.79    seconds            (1.0 x)+    ghc-old              3.91    seconds            (1.0 x)++* Run just the ghc test:++    $ env ONLY=ghc make just+    Updating results database with 1 new entries.++    Test: calendar (Bird and Wadlers calendar program)+    http://www.cse.unsw.edu.au/~dons/code/nobench/spectral/calendar+    ghc                  3.84    seconds            (1.0 x)+    ghc-old              3.91    seconds            (1.0 x)++Compilation logs are kept in the 'ghc.compile' and 'ghc-old.compile' files.+You can also just run the tests by hand:++    $ /home/dons/streams/build/compiler/stage2/ghc-inplace -no-recomp+    -Rghc-timing -O2 -fasm -fliberate-case-threshold100 -fdicts-cheap+    -fno-method-sharing -ddump-simpl-stats  --make -o calendar+    calendar.hs+    [1 of 1] Compiling Main             ( calendar.hs, calendar.o )++    4 SC:$wloop_length0+    6 SC:$wloop_length1+    9 SC:$wloop_length2+    2 SC:$wloop_length3+    3 SC:$wunfold_unstream6+    2 SC:$wunfold_unstream7+    2 SC:$wunfold_unstream8+    19 SC:unfold_unstream0+    17 SC:unfold_unstream1+    2 SC:unfold_unstream10+    18 SC:unfold_unstream2+    6 SC:unfold_unstream3+    2 SC:unfold_unstream5+    6 SC:unfold_unstream8+    2 SC:unfold_unstream9+    18 STREAM stream/unstream fusion++    ...++To run a whole class of tests, cd into the directory and type 'make':++    cd spectral+    make++make at the top level runs everything.++-- Don+
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Duncan Coutts 2006-2007+Copyright (c) Don Stewart   2006-2007++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README view
@@ -0,0 +1,33 @@+                          Stream fusible lists++Faster lists using stream fusion.++The abstract from the paper:++    This paper presents an automatic deforestation system, \emph{stream+    fusion}, based on equational transformations, that fuses a wider+    range of functions than existing short-cut fusion systems. In+    particular, stream fusion is able to fuse zips, left folds and+    functions over nested lists, including list comprehensions. A+    distinguishing feature of the framework is its simplicity: by+    transforming list functions to expose their structure, intermediate+    values are eliminated by general purpose compiler optimisations.++    We have reimplemented the Haskell standard List library on top of+    our framework, providing stream fusion for Haskell lists. By+    allowing a wider range of functions to fuse, we see an increase in+    the number of occurrences of fusion in typical Haskell programs. We+    present benchmarks documenting time and space improvements.++Building:++  $ runhaskell Setup.lhs configure --prefix=/home/dons+  $ runhaskell Setup.lhs build+  $ runhaskell Setup.lhs install++Use:++  import Data.List.Stream++and use as you would for normal lists.+Compile with ghc -O2 for best results.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ TODO view
@@ -0,0 +1,170 @@++Functions that don't yet fuse:++    transpose   :: [[a]] -> [[a]]+    partition    :: (a -> Bool) -> [a] -> ([a], [a])++*   scanr       :: (a -> b -> b) -> b -> [a] -> [b]+*   scanr1      :: (a -> a -> a) -> [a] -> [a]++*?  mapAccumL   :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])+*?  mapAccumR   :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])+    span        :: (a -> Bool) -> [a] -> ([a], [a])+    inits       :: [a] -> [[a]]+    tails       :: [a] -> [[a]]+    isSuffixOf  :: Eq a => [a] -> [a] -> Bool+*   isInfixOf   :: Eq a => [a] -> [a] -> Bool++    words        :: String -> [String]+    unwords      :: [String] -> String++*   nub          :: Eq a => [a] -> [a]+*   delete       :: Eq a => a -> [a] -> [a]++*   nubBy        :: (a -> a -> Bool) -> [a] -> [a]+*   deleteBy     :: (a -> a -> Bool) -> a -> [a] -> [a]++    sort         :: Ord a => [a] -> [a]+    union        :: Eq a => [a] -> [a] -> [a]+    intersect    :: Eq a => [a] -> [a] -> [a]+    group        :: Eq a => [a] -> [[a]]++    unionBy      :: (a -> a -> Bool) -> [a] -> [a] -> [a]+    groupBy      :: (a -> a -> Bool) -> [a] -> [[a]]+    intersectBy  :: (a -> a -> Bool) -> [a] -> [a] -> [a]+    sortBy+++Internal GHC:++    * List comprehensions desugaring++Think about scanl:++    "scanl -> fusible"  [~1] forall f z xs.+        scanl f z xs = unstream (Stream.scanl f z (stream (xs ++ [bottom])))++------------------------------------------------------------------------++Ideas at the Warren View, Sun Mar 18 19:37:09 EST 2007++    * SPECCONSTR pragma (sent to spj)++    * rules with strictness annotations:+            - pick between foldl foldl' based on strictness info++    * rules matching on constraints:+            - so pick representation types for rules, e.g.+                     * bucketsort for Word8+                     * IntMap/Map for nub on Ord++    * undefineds in QuickCheck+++------------------------------------------------------------------------++TODO:++    * strict on any state we control.+    * strict pairs expose constructors to SpecConstr, removing redundant+      arguments.++-- DeepSeq context on existentials.+-- All external values that are used in state, wrapped in Lazy+-- State strict by default.++-- add test case for bottom streams.++------------------------------------------------------------------------++instance (Eq a) => Eq [a] -- Defined in GHC.Base+instance Functor [] -- Defined in GHC.Base+instance (Ord a) => Ord [a] -- Defined in GHC.Base++Enum+list comprehension desugaring++------------------------------------------------------------------------++Queries about the H98 List spec:++* intersperse (and therefore intercalate) are too strict.++* unwords is too strict.++* (genericTake :: Int -> [a] -> [a]) /= take+    perhaps it should. In particular:++    genericTake _|_ [] = []+           take _|_ [] = _|_++    genericTake 0 _|_ = _|_+           take 0 _|_ = []++    genericTake (-1) xs = _|_+           take (-1) xs = []++  It looks like the Spec is wrong here, genericTake is inconsistent+  with take, genericDrop and genericSplitAt it has the initial clauses+  this way round:+    genericTake _ []        =  []+    genericTake 0 _         =  []+  when they should be the other way around, as they are for the other+  functions.++* Data.List.partition is too strict or perhaps the spec is too lazy+    H98 says: partition p _|_ = (_|_, _|_)+    Data.List.partition p _|_ = _|_++* Data.List.splitAt is too strict or perhaps the spec is too lazy+    H98 says: splitAt _|_ _|_ = (_|_, _|_)+    Data.List.splitAt _|_ _|_ = _|_++------------------------------------------------------------------------++If we had strictness info available in rules we could say:++forall (f :: [[Char!]] -> b) xs. f (lines xs) = f (stricterLines xs)+erm that is if we're consuming lines an consuming each string in a+spine-strict way then we can use a more efficient lines implementation.+Same goes for words.++Note how you can't easily talk about structural strictness properties by+putting annotations on types since that structure isn't fully exposed in+the type.++------------------------------------------------------------------------++More stuff to stick in the paper:++Limits on fusion. We conjecture that whenever an implementation relies+on sharing that it's realy not fusible, or when you 'fuse' it anyway you+get no performance advantage since it has to allocate internally anyway.+The best that could be done is if in the internal allocation used to get+sharing is more eficient. Eg with sort we might use a heap as the internal+state and stream into it and out of it.++What does build/foldr do about sharing?++* Binary sizes, fusion opportunties v foldr/build++* Currently list comprehensions compile to build/foldr stuff.+  -- this hurts us, since that no longer fuses. We could keep+  build/foldr fusion for list comprehensions I guess?+ -- e.g. paraffins++------------------------------------------------------------------------++* imaginary/wheel_sieve1 : looks like a missing list comprehension fuse.++* spectral/atom:             some list comprehensions./e++* calendar: a lot of fusion here. should be faster.+    Still L constructors being left behind.++* circsim, same story. Either's being left behind.++* k-nucleotide, some different loops being generated.++* primes,     9 foldr/app+* sorting, some list comprehensions
+ desugar/Desugar.hs view
@@ -0,0 +1,399 @@+-- Use like so:+--+-- runghc Desugar.hs < Examples.hs > ExamplesDesugared.hs+--+-- and watch out, the pretty printer sometimes misses (..)'s (wtf!!!)++module Main (main) where++import Data.List++import Language.Haskell.Parser+import Language.Haskell.Syntax+import Language.Haskell.Pretty++main = interact $ \input ->+  let ParseOk (HsModule sl m es is decls) = parseModule input+      decls' = [ decl+               | (exp, stmts, context) <- extractListComps decls+               , let exp' = desugar [0..] exp stmts+               , decl <- [context (HsListComp exp stmts), context exp'] ]+   in prettyPrint (HsModule sl m es is decls') ++ "\n"++extractListComps :: [HsDecl] -> [(HsExp, [HsStmt], HsExp -> HsDecl)]+extractListComps decls =+    [ (exp, stmts,+       \rhs -> HsPatBind sl (HsPVar (HsIdent name))+                            (HsUnGuardedRhs rhs) [])+    | HsPatBind sl (HsPVar (HsIdent name))+                   (HsUnGuardedRhs (HsListComp exp stmts)) [] <- decls ]+ ++ [ (exp, stmts,+       \rhs -> HsFunBind [HsMatch sl name ps (HsUnGuardedRhs rhs) ds])+    | HsFunBind [HsMatch sl name ps+                         (HsUnGuardedRhs (HsListComp exp stmts)) ds] <- decls ]++{-++Streams desugaring for list comprehensions:++<< [ e | Q ] >>+++<< [ e | ] >> = return e++<< [ e | b, Q ] >> = gaurd b (<< [ e |  Q ] >>)++<< [ e | p <- l, Q ] >> = bind f g l+  where+    f p = Just (x1, ..., xn)+    f _ = Nothing++    g (x1, ..., xn) = << [ e | Q ] >>++<< [ e | let decls, Q ] >> = declare g (let decls in (x1, .., xn))+  where+    g (x1, .., xn) = << [ e | Q ] >>++We can optimise the common cases:+++<< [ e | p <- l, b ] >> = mapFilter f l+  where f p | b = Just e+        f _     = Nothing++<< [ e | p <- l, b, Q ] >> = bind f g l+  where f p | b = Just (x1, ..., xn)+        f _     = Nothing+        +        g (x1, ..., xn) = << [ e | Q ] >>+++using the auxillary definitions:++List:+-----++return e = [e]++guard True  xs = xs+guard false xs = []++concatMap' f g xs = foldr h [] xs+  where h x ys = case f x of+                  Just bs -> g bs ++ ys+                  Nothing ->         ys++declare g bs = g bs++mapFilter f xs = foldr h [] xs+  where h x ys = case f x of+                  Just y  -> y : ys+                  Nothing ->     ys+++Stream:+-------++return e = Stream next True+  where+    next True  = Yield e False+    next False = Done++guard b (Stream next0 s0) = Stream next (b, s0)+  where+    next (False, s) = Done+    next (True, s)  = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (True, s')+      Yield x s' -> Yield x (True, s')++bind f g (Stream next0 s0) = Stream next (s, Nothing)+  where+    next (s, Nothing) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (s', Nothing)+      Yield x s' -> case f x of+         Just bs -> Skip (s', Just (g bs))+         Nothing -> Skip (s', Nothing)++    next (s, Just (Stream next1 s1)) = case next1 s1 of+      Done        -> Done+      Skip    s1' -> Skip    (s, Just (Stream next1 s1'))+      Yield x s1' -> Yield x (s, Just (Stream next1 s1'))++declare g bs = Stream next (g bs)+  where next (Stream next0 s) = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    (Stream next0 s')+      Yield x s' -> Yield x (Stream next0 s')++mapFilter f (Stream next0 s0) = Stream next s0+  where+    next s = case next0 s of+      Done       -> Done+      Skip    s' -> Skip    s'+      Yield x s' -> case f x of+                  Just y  -> Yield y s'+                  Nothing -> Skip    s'++-}++hsJust       = HsVar (UnQual (HsIdent "Just"))+hsNothing    = HsVar (UnQual (HsIdent "Nothing"))++hsReturn     = HsVar (Qual (Module "L") (HsIdent "return"))+hsGuard      = HsVar (Qual (Module "L") (HsIdent "guard"))+hsConcatMap  = HsVar (Qual (Module "L") (HsIdent "concatMap"))+hsConcatMap' = HsVar (Qual (Module "L") (HsIdent "concatMap'"))+hsDeclare    = HsVar (Qual (Module "L") (HsIdent "declare"))+hsMapFilter  = HsVar (Qual (Module "L") (HsIdent "mapFilter"))+hsMap        = HsVar (Qual (Module "L") (HsIdent "map"))++desugar :: [Int] -> HsExp -> [HsStmt] -> HsExp++-- [ e | ] = return e+desugar ns e [] = HsApp hsReturn e++-- [ e | b, Q ] = gaurd b [ e | Q ]+desugar ns e (HsQualifier b : qs) = HsApp (HsApp hsGuard b)+                                           (HsParen (desugar ns e qs))++-- special case: final generator for simple irrefutable pattern p+-- [ e | p <- l ] = let f p = e+--                   in map f l+desugar (n:ns) e (HsGenerator sloc p@(HsPVar _) l : []) =+  HsLet [HsFunBind [HsMatch sloc (HsIdent (f n)) [p]+                   {- = -} (HsUnGuardedRhs e) []+                   ]+        ]+        (HsApp (HsApp hsMap (HsVar (UnQual (HsIdent (f n)))))+               (HsParen l))++-- special case: final generator+-- [ e | p <- l ] = let f p = Just e+--                      f _ = Nothing+--                   in mapFilter f l+desugar (n:ns) e (HsGenerator sloc p l : []) =+  HsLet [HsFunBind [HsMatch sloc (HsIdent (f n)) [p]+                   {- = -} (HsUnGuardedRhs (HsApp hsJust e)) []+                   ,HsMatch sloc (HsIdent (f n)) [HsPWildCard]+                   {- = -} (HsUnGuardedRhs hsNothing)       []+                   ]+        ]+        (HsApp (HsApp hsMapFilter (HsVar (UnQual (HsIdent (f n)))))+               (HsParen l))++-- special case: final generator with trailing condition+-- [ e | p <- l, b ] = let f p | b = Just e+--                         f _     = Nothing+--                      in mapFilter f l+desugar (n:ns) e (HsGenerator sloc p l : HsQualifier b : []) =+  HsLet [HsFunBind [HsMatch sloc (HsIdent (f n)) [p]+                   {- = -} (HsGuardedRhss [HsGuardedRhs sloc b+                                           (HsApp hsJust e)]) []+                   ,HsMatch sloc (HsIdent (f n)) [HsPWildCard]+                   {- = -} (HsUnGuardedRhs hsNothing) []+                   ]+        ]+        (HsApp (HsApp hsMapFilter (HsVar (UnQual (HsIdent (f n)))))+               (HsParen l))++-- special case: generator with trailing condition+-- [ e | p <- l, b, Q ] = let f p | b = Just (x1, ..., xn)+--                            f _ = Nothing+--                            g (x1, ..., xn) = [ e | Q ]+--                         in concatMap' f g l+desugar (n:ns) e (HsGenerator sloc p l : HsQualifier b : qs) =+  let xs = patBinders p+           `intersect` stmtsFV e qs -- optimisation: only bind used vars+   in HsLet [HsFunBind [HsMatch sloc (HsIdent (f n)) [p]+                       {- = -} (HsGuardedRhss+                                 [HsGuardedRhs sloc b+                                 (HsApp hsJust (mkTupleExpr xs))]) []+                       ,HsMatch sloc (HsIdent (f n)) [HsPWildCard]+                       {- = -} (HsUnGuardedRhs hsNothing) []+                       ]+            ,HsFunBind [HsMatch sloc (HsIdent (g n)) [mkTuplePat xs]+                       {- = -} (HsUnGuardedRhs (desugar ns e qs)) []+                       ]+            ]+            (HsApp (HsApp (HsApp hsConcatMap'+                                 (HsVar (UnQual (HsIdent (f n)))))+                          (HsVar (UnQual (HsIdent (g n)))))+                   (HsParen l))+++-- special case: for simple irrefutable pattern p+-- [ e | p <- l, Q ] = let g p = [ e | Q ]+--                      in concatMap g l+desugar (n:ns) e (HsGenerator sloc p@(HsPVar _) l : qs) =+  HsLet [HsFunBind [HsMatch sloc (HsIdent (g n)) [p]+                   {- = -} (HsUnGuardedRhs (desugar ns e qs)) []+                   ]+        ]+        (HsApp (HsApp hsConcatMap (HsVar (UnQual (HsIdent (g n)))))+               (HsParen l))++-- general case of a generator+-- [ e | p <- l, Q ] = let f p = Just (x1, ..., xn)+--                         f _ = Nothing+--                         g (x1, ..., xn) = [ e | Q ]+--                       in concatMap' f g l+desugar (n:ns) e (HsGenerator sloc p l : qs) =+  let xs = patBinders p +           `intersect` stmtsFV e qs -- optimisation: only bind used vars+   in HsLet [HsFunBind [HsMatch sloc (HsIdent (f n)) [p]+                       {- = -} (HsUnGuardedRhs+                                 (HsApp hsJust (mkTupleExpr xs))) []+                       ,HsMatch sloc (HsIdent (f n)) [HsPWildCard]+                       {- = -} (HsUnGuardedRhs hsNothing) []+                       ]+            ,HsFunBind [HsMatch sloc (HsIdent (g n)) [mkTuplePat xs]+                       {- = -} (HsUnGuardedRhs (desugar ns e qs)) []+                       ]+            ]+            (HsApp (HsApp hsConcatMap (HsVar (UnQual (HsIdent (g n)))))+                   (HsParen l))++{-+-- TODO: need to get binders in decls for this one:++-- [ e | let decls, Q ] = let g (x1, .., xn) = [ e | Q ]+--                         in declare g (let decls in (x1, .., xn))+desugar ns e (HsLetStmt decls : qs) =+  HsLet decls (desugar ns e qs)+-}++patBinders :: HsPat -> [HsName]+patBinders (HsPVar name)         = [name]+patBinders (HsPLit _)            = []+patBinders (HsPNeg p)            = patBinders p+patBinders (HsPInfixApp p1 _ p2) = patBinders p1 ++ patBinders p2+patBinders (HsPApp _ ps)         = concatMap patBinders ps+patBinders (HsPTuple ps)         = concatMap patBinders ps+patBinders (HsPList ps)          = concatMap patBinders ps+patBinders (HsPParen p)          = patBinders p+patBinders (HsPRec _ fields)     = concat [ patBinders p+                                          | HsPFieldPat _ p <- fields ]+patBinders (HsPAsPat _ p)        = patBinders p+patBinders (HsPWildCard)         = []+patBinders (HsPIrrPat p)         = patBinders p+++-- The following is for an optimisation, perhaps it's unnecessary.++nameFV (Qual _ _)  = []+nameFV (UnQual n)  = [n]+nameFV (Special _) = []++qopFV (HsQVarOp n) = nameFV n+qopFV _            = []++expFV :: HsExp -> [HsName]+expFV (HsVar n) = nameFV n+expFV (HsCon _) = []+expFV (HsLit _) = []+expFV (HsInfixApp e1 op e2) = qopFV op ++ expFV e1 ++ expFV e2+expFV (HsApp e1 e2) = expFV e1 ++ expFV e2+expFV (HsNegApp e) = expFV e+expFV (HsLambda _ ps e) = nub (expFV e) \\ concatMap patBinders ps+--expFV (HsLet [HsDecl] HsExp)+expFV (HsIf e1 e2 e3) = expFV e1 ++ expFV e2 ++ expFV e3+--expFV (HsCase HsExp [HsAlt])+expFV (HsDo stmts) = stmtsFV unit_con stmts+expFV (HsTuple es) = concatMap expFV es+expFV (HsList es) = concatMap expFV es+expFV (HsParen e) = expFV e+expFV (HsLeftSection e op)  = qopFV op ++ expFV e+expFV (HsRightSection op e) = qopFV op ++ expFV e+--expFV (HsRecConstr HsQName [HsFieldUpdate])	record construction expression+--expFV (HsRecUpdate HsExp [HsFieldUpdate])	record update expression+expFV (HsEnumFrom e) = expFV e+expFV (HsEnumFromTo e1 e2) = expFV e1 ++ expFV e2+expFV (HsEnumFromThen e1 e2) = expFV e1 ++ expFV e2+expFV (HsEnumFromThenTo e1 e2 e3) = expFV e1 ++ expFV e2 ++ expFV e3+expFV (HsListComp e stmts) = stmtsFV e stmts+expFV (HsExpTypeSig _ e _) = expFV e++stmtsFV :: HsExp -> [HsStmt] -> [HsName]+stmtsFV e [] = expFV e+stmtsFV e (HsGenerator _ p e' : stmts) = nub (expFV e' ++ stmtsFV e stmts) \\ patBinders p+stmtsFV e (HsQualifier     e' : stmts) = expFV e' ++ stmtsFV e stmts+--stmtsFV e (HsLetStmt decls) = ++mkTupleExpr []  = HsCon (Special HsUnitCon)+mkTupleExpr [n] = HsVar (UnQual n)+mkTupleExpr ns  = HsTuple [ HsVar (UnQual n) | n <- ns ]++mkTuplePat []  = HsPWildCard+mkTuplePat [n] = HsPVar n+mkTuplePat ns  = HsPTuple [ HsPVar n | n <- ns ]++f n = "f_" ++ show n+g n = "g_" ++ show n+++++++++++++{-++Alternative streams desugaring for list comprehensions:++<< [ e | Q ] P D >> :: Exp -> [Qual] -> (Pat -> Pat) -> Exp -> ([Clause], Exp)++Translation scheme takes the list comp's expression and list of qualifiers+and as extra args, a pattern (with a hole) that gives the state pattern and an+expression giving the state to return to when done. It returns a list of+clauses for a 'next' stepper function and an initialiser expression for the+stream's initial state.++To construct the top level we use:++[ e | Q ] = Stream (FunDef "next" clauses) init+  where (clauses, init) = << [ e | Q ] [.] Done >>+++<< [ e | ] P D >> = (next:[], True)+  where+     next P[True]  = Yield e P[False]+     next P[False] = D+++<< [ e | b, Q ] P D >> = (next:nexts, Nothing)+  where+     (nexts, init) = << [ e | Q ] P[Just[.]] D >>++     next P[Nothing] | b         = Skip (P[Just init])+                     | otherwise = D+++<< [ e | let decls, Q ] P D >> = (next:nexts, Nothing)+  where+     (nexts, init) = << [ e | Q ] P[Just((x_n_0, , x_n_m) :!: [.])] D >>++     next P[Nothing] = Skip P[Just(let decls in (x_n_0, , x_n_m) :!: init)]+     +     {x_n_0, , x_n_m} = DV (decls) -- Defined variables+++<< [ e | p <- l, Q ] P >> = (next:nexts, stream l :!: Nothing)+  where+     (nexts, init) = << [ e | Q ] P[(Stream next_n s_n :!: Just (p :!: [.]))]+                                  P[(Stream next_n s_n :!: Nothing)] >>++     next P[(Stream next_n s_n :!: Nothing)] = case next_n s_n of+       Done         -> D+       Skip    s_n' -> Skip P[(Stream next_n s_n' :!: Nothing)]+       Yield x s_n' -> case x of+                  p -> Skip P[(Stream next_n s_n' :!: Just (x :!: init))]+                  _ -> Skip P[(Stream next_n s_n' :!: Nothing)]++-}
+ desugar/Examples.hs view
@@ -0,0 +1,19 @@+module Examples where++map :: (a -> b) -> [a] -> [b]+map f as = [ f a | a <- as ]++concat :: [[a]] -> [a]+concat ass = [ a | as <- ass, a <- as ]++concatMap :: (a -> [b]) -> [a] -> [b]+concatMap f as = [ b | a <- as, b <- f a ]++filter :: (a -> Bool) -> [a] -> [a]+filter p as = [ a | a <- as, p a ]++prod xs ys = [ x * y | x <- xs, y <- ys ]++foo xs ys = [ x * y | Left (x, _) <- xs, y <- ys ]++bar xs ys zs = [ x * y | x <- xs, y <- ys, z <- zs ]
+ setup-base.sh view
@@ -0,0 +1,56 @@+#!/bin/sh++# dump (and edit) the stream/list code into a copy of base-streams +# such that the whole thing builds.++#+# assumes we're in the 'list' main repo+#++ghc_base_path=$*+if [ -z "$ghc_base_path" ] ; then+    echo "usage: ./setup-base.sh path_to_base_package"+    exit 1+fi++# Where are we sending things?+echo -n "Preparing to set up streams stuff under: "+echo $ghc_base_path++# Just double check its a base repo:+echo -n "Checking it looks like a proper base repo .... "+if [ -d "$ghc_base_path/_darcs/patches" ] ; then+    looks_ok=True+else+    looks_ok=False+fi+echo $looks_ok++if [ "$looks_ok" = "False" ] ; then+    echo "'$ghc_base_path' doesn't look like a darcs repo!"+    exit 1+fi++# Work out if we need to create the Data/List subdir+echo -n "Checking if we need to create the Data/List subdir... "+ghc_base_streams="$ghc_base_path/Data/List"+if [ ! -d "$ghc_base_streams" ] ; then+    create_streams=True+else+    create_streams=False+fi+echo $create_streams++if [ "$create_streams" = "True" ] ; then+    mkdir $ghc_base_streams+fi++# copy first+echo "{-# OPTIONS_GHC -fno-implicit-prelude #-}" > $ghc_base_streams/Stream.hs+echo "{-# OPTIONS_GHC -fno-implicit-prelude #-}" > $ghc_base_path/Data/Stream.hs++cat Data/List/Stream.hs >> $ghc_base_streams/Stream.hs+cat Data/Stream.hs      >> $ghc_base_path/Data/Stream.hs+++echo "done."
+ stream-fusion.cabal view
@@ -0,0 +1,25 @@+Name:                stream-fusion+Version:             0.1+Author:              Duncan Coutts, Don Stewart+Maintainer:          duncan.coutts@worc.ox.ac.uk, dons@galois.com+License:             BSD3+License-file:        LICENSE+Synopsis:            Faster Haskell lists using stream fusion+Homepage:            http://www.cse.unsw.edu.au/~dons/streams.html+Description:+        This package provides the standard Haskell list library+        reimplemented to allow stream fusion. This should in general+        provide faster list operations, and faster code for list-heavy+        programs.  See the paper "Stream Fusion: From Lists to Streams to Nothing at All",+        Coutts, Leshchinskiy and Stewart, 2007.+        To use, simply import Data.List.Stream in place of Data.List,+        and hide list functions from the Prelude.+Category:            Data+Build-Depends:       base+Stability:           experimental+Tested-with:         GHC==6.8+Exposed-modules:     Data.Stream+                     Data.List.Stream+                     Control.Monad.Stream+Extensions:          CPP, BangPatterns, ExistentialQuantification+ghc-options:         -fglasgow-exts -O2 -Wall -fno-warn-orphans -DEXTERNAL_PACKAGE -fliberate-case-threshold100 -fdicts-cheap -fno-method-sharing
+ tests/Bench/Fusion.hs view
@@ -0,0 +1,151 @@+{-# OPTIONS -cpp #-}+--+-- Test the results of fusion+--++--+-- N.B. make sure to disable down fusion when using only loopU fusion+--++import Data.Char+import Bench.Utils+import Text.Printf+import qualified Data.List.Stream as P -- ours++-- minimum pipelines to trigger the various fusion forms+tests =+ [("force0",          [F  (P.maximum)])+ ,("force1",          [F  (P.map (+1))])++-- non directional+ ,("map/map",+    [F  (+        P.map (*2) . P.map (+4)                             -- 1+    )])+ ,("filter/filter",+    [F  (+        P.filter (/=101) . P.filter (/=102)                 -- 1+    )])+ ,("filter/map",+    [F  (+        P.filter (/=103) . P.map (+5)                       -- 1+    )])+ ,("map/filter",+    [F  (+        P.map (*3) . P.filter (/=104)                       -- 1+    )])+ ,("map/noacc",+    [F  (+        (P.map (+1) . P.filter (/=112)) . P.map (*2)         -- 2+    )])+ ,("noacc/map",+    [F  (+        P.map (+1) . (P.map (+2) . P.filter (/=113))         -- 2+    )])+ ,("filter/noacc",+    [F  (+        (P.map (+1) . P.filter (/=101)) . P.filter (/=114)   -- 2+    )])+ ,("noacc/filter",+    [F  (+        P.filter (/=101) . (P.map (*2) . P.filter (/=115))  -- 2+    )])+ ,("noacc/noacc",+    [F  (+        (P.map (*3) . P.filter (/=108)) . (P.map (*4) . P.filter (/=109)) -- 3+    )])++-- up loops+ ,("up/up",+    [F  (+        P.foldl' (const.(+1)) (0::X) . P.scanl (flip const) (0::W) -- 1+    )])+ ,("map/up",+    [F  (+        P.foldl' (const.(+6)) (0::X) . P.map (*4) -- 1+    )])+ ,("up/map",+    [F  (+        P.map (+7) . P.scanl const (0::W) -- 1+    )])+ ,("filter/up",+    [F  (+        P.foldl' (const.(+8)) (0::X) . P.filter (/=105) -- 1+    )])+ ,("up/filter",+    [F  (+        P.filter (/=106) . P.scanl (flip const) (0::W) -- 1+    )])+ ,("noacc/up",+    [F  (+        P.foldl' (const.(+1)) (0::W) . (P.map (+1) . P.filter (/=110)) -- 2+    )])+ ,("up/noacc",+    [F  (+        (P.map (+1) . P.filter (/=111)) . P.scanl (flip const) (0::W) -- 2+    )])++-- down loops+ ,("down/down",+    [F  (+        P.foldr (const (+9))  (0::W) . P.scanl (flip const) (0::W) -- 1+    )])+ ,("map/down",+    [F  (+        P.foldr (const (+10)) (0::W) . P.map (*2) -- 1+    )]) + ,("down/map",+    [F  (+        P.map (*2) . P.scanl (flip const) (0::W) -- 1+    )])+ ,("filter/down",+    [F  (+        P.foldr (const (+11)) (0::W) . P.filter (/=106) -- 1+    )])+ ,("down/filter",+    [F  (+        P.filter (/=107) . P.scanl (flip const) (0::W) -- 1+    )])+ ,("noacc/down",+    [F  (+        P.foldr (const (+1)) (0::W) . (P.map (+1) . P.filter (/=116)) -- 2+    )])+ ,("down/noacc",+    [F  (+        (P.map (+1) . P.filter (/=101)) . P.scanl (flip const) (0::W) -- 2+    )])++-- misc+ ,("length/loop",+    [F  (+        P.length  . P.filter (/=105) -- 1+    )])+ ,("maximum/loop",+    [F  (+        P.maximum . P.map (*4) -- 1+    )])+ ,("minimum/loop",+    [F  (+        P.minimum . P.map (+6) -- 1+    )])++ ]++-- and some longer ones to see the full effect+bigtests =+ [("big map/map",+    [F  (P.map (subtract 3). P.map (+7) . P.map (*2) . P.map (+4) -- 3+    )])+ ,("big filter/filter",+    [F  (P.filter (/=103) . P.filter (/=104) . P.filter (/=101) .  P.filter (/=102) -- 3+    )])+ ,("big filter/map",+    [F  (P.map (*2) . P.filter (/=104) . P.map (+6) . P.filter (/=103) .  P.map (+5) --4 +    )])+ ]++main = do+    force (string,string)+    printf "#Byte\n"+    run 5 (map (fromIntegral.ord) string) (tests ++ bigtests)+
+ tests/Bench/ListVsBase.hs view
@@ -0,0 +1,416 @@+{-# OPTIONS -fglasgow-exts #-}+-- ^ unboxed strings+--+-- Benchmark tool.+-- Compare a function against equivalent code from other libraries for+-- space and time.+--+import Bench.Utils++import qualified Data.List        as L -- theirs+import qualified Data.List.Stream as S -- ours ++import Data.Char+import Data.Word+import Data.Int++import System.IO+import Control.Monad+import Text.Printf++main :: IO ()+main = do+    -- initialise+    let input = Input (take 1000 string) string string2 (splitEvery 1000 string2)+    force input++    putStrLn "Benchmarking Data.List.Stream <=> Data.List"+    putStrLn "===========================================\n"++    printf "# Size of test data: %dk\n" ((floor $ (fromIntegral (length string)) / 1024) :: Int)+    printf "#List\t List.Stream\n"+++    run 5 input tests++------------------------------------------------------------------------++tests =+ [+    -- * Basic interface++    ("++",  -- should be identical+        [F ( app  (uncurry ((L.++) :: S -> S -> S) )    )+        ,F ( app  (uncurry ((S.++) :: S -> S -> S) )    ) ]+    )++    , ("head",+        [F ( app  (L.head :: S -> Char) )+        ,F ( app  (S.head :: S -> Char) )]+    )++    , ("last",+        [F (     app (L.last :: S -> Char))+        ,F (     app (S.last :: S -> Char))+    ])++    , ("init",+        [F (     app (L.init :: S -> S))+        ,F (     app (S.init :: S -> S))+    ])++    , ("null",+        [F (     app (L.null :: S -> Bool))+        ,F (     app (S.null :: S -> Bool))+    ])++    , ("length",+        [F (      app  (L.length :: S -> Int))+        ,F (      app  (S.length :: S -> Int))+    ])++    -- * List transformations+    , ("map",+        [F (      app ( L.map toUpper :: S -> S ))+        ,F (      app ( S.map toUpper :: S -> S ))+    ])++    , ("reverse",+        [F (     app (L.reverse :: S -> S ))+        ,F (     app (S.reverse :: S -> S ))+    ])++    , ("intersperse",+        [F ( app  (L.intersperse 'x' :: S -> S)     )+        ,F ( app  (S.intersperse 'x' :: S -> S)     ) ]+     )++    , ("intercalate",+        [F ( app2  (L.intercalate :: S -> [S] -> S)     )+        ,F ( app2  (S.intercalate :: S -> [S] -> S)     ) ]+     )++    -- transpose is too slow.++    -- * Reducing lists (folds)++    , ("foldl'",+        [F (     app  ( L.foldl' (\a _ -> a+1) 0 :: S -> Int  ) )+        ,F (     app  ( S.foldl' (\a _ -> a+1) 0  :: S -> Int ) )+    ])++{-+    , ("foldr",+        [F (     app  ( L.foldr (\_ a -> a+1) 0 :: S -> Int  ) )+        ,F (     app  ( S.foldr (\_ a -> a+1) 0 :: S -> Int ) )+    ])+-}++    -- ** Special folds++    , ("concat",+        [F ( app   ((\ss -> L.concat (ss++ss++ss)) :: [S] -> S)               )+        ,F ( app   ((\ss -> S.concat (ss++ss++ss)) :: [S] -> S)               ) ]+     )++    , ("concatMap",+        [F ( app   (L.concatMap (\c -> L.replicate 10 c) :: S -> S))+        ,F ( app   (S.concatMap (\c -> S.replicate 10 c) :: S -> S)) ]+     )++    , ("any",+        [F (     app ( L.any (=='x') :: S -> Bool       ))+        ,F (     app ( S.any (=='x') :: S -> Bool       ))+    ])+    , ("all",+        [F (     app ( L.all (=='x') :: S -> Bool       ))+        ,F (     app ( S.all (=='x') :: S -> Bool       ))+    ])+    , ("maximum",+        [{-F (     app (L.maximum :: S -> Char) )+        ,-}F (     app (S.maximum :: S -> Char) )+    ])+    , ("minimum",+        [{-F (     app (L.minimum :: S -> Char) )+        ,-}F (     app (S.minimum :: S -> Char) )+    ])++    -- * Building lists+    -- ** Scans++    -- * Sublists+    -- ** Extracting sublists+    , ("take",+        [F (     app ( L.take 100000 :: S -> S) )+        ,F (     app ( S.take 100000 :: S -> S) )+    ])+    , ("drop",+        [F (     app ( L.drop 100000 :: S -> S) )+        ,F (     app ( S.drop 100000 :: S -> S) )+    ])++    , ("takeWhile",+        [F (     app ( L.takeWhile (/='z') :: S -> S  ))+        ,F (    app  ( S.takeWhile (=='z')  :: S -> S ))+    ])+    , ("dropWhile",+        [F (     app ( L.dropWhile (/='z')  :: S -> S ) )+        ,F (    app  ( S.dropWhile (/='z')  :: S -> S ) )+    ])++    -- * Searching lists+    -- ** Searching by equality+    , ("elem",+        [F (     app (L.elem ('Z') :: S -> Bool) )+        ,F (     app (S.elem ('Z') :: S -> Bool) )+    ])+    , ("notElem",+        [F (     app (L.notElem ('Z') :: S -> Bool) )+        ,F (     app (S.notElem ('Z') :: S -> Bool) )+    ])++    -- ** Searching with a predicate++    , ("find",+        [F (     app (L.find (=='Z') :: S -> Maybe Char) )+        ,F (     app (S.find (=='Z') :: S -> Maybe Char) )+    ])++    , ("filter",+        [F (      app ( L.filter isSpace :: S -> S ))+        ,F (      app ( S.filter isSpace :: S -> S ))+    ])++    -- * Indexing lists++    , ("index",+        [F (      app ((\x -> x L.!! 300000) ::  S -> Char  ))+        ,F (      app ((\x -> x S.!! 300000) ::  S -> Char  ))+    ])++    , ("elemIndex",+        [F (    app (L.elemIndex ('Z') :: S -> Maybe Int ) )+        ,F (    app (S.elemIndex ('Z') :: S -> Maybe Int ) )+    ])++    , ("elemIndices",+        [F (    app (L.elemIndices ('Z') :: S -> [Int] ) )+        ,F (    app (S.elemIndices ('Z') :: S -> [Int] ) )+    ])++    , ("findIndex",+        [F (    app (L.findIndex (=='Z') :: S -> Maybe Int ) )+        ,F (    app (S.findIndex (=='Z') :: S -> Maybe Int ) )+    ])++    , ("findIndices",+        [F (    app (L.findIndices (=='Z') :: S -> [Int] ) )+        ,F (    app (S.findIndices (=='Z') :: S -> [Int] ) )+    ])++    -- * Zipping and unzipping lists++    , ("zip",+        [F (     app (uncurry (L.zip) :: (S,S) -> [(Char, Char)]     ))+        ,F (     app (uncurry (S.zip) :: (S,S) -> [(Char, Char)]     ))+    ])++    , ("zipWith",+        [F (     app (uncurry (L.zipWith (,)) :: (S,S) -> [(Char, Char)]     ))+        ,F (     app (uncurry (S.zipWith (,)) :: (S,S) -> [(Char, Char)]     ))+    ])++    , ("replicate",+        [F (    const $ L.replicate 2000000 'x')+        ,F (    const $ S.replicate 2000000 'x')+    ])++ ]+++{-+++    , ("span",+        [F ({-# SCC "span"          #-}     app $ B.span (/=122))+        ,F ({-# SCC "lazy span"     #-}     app $ L.span (/=122))+    ])+    , ("break",+        [F ({-# SCC "break"         #-}     app $ B.break (==122))+        ,F ({-# SCC "lazy break"    #-}     app $ L.break (==122))+    ])+    , ("split",+        [F ({-# SCC "split"         #-}     app $ B.split 0x0a)+        ,F ({-# SCC "lazy split"    #-}     app $ L.split 0x0a)+    ])+--  , ("breakByte",+--      [F ({-# SCC "breakChar"     #-}     app $ B.breakByte 122)+--      ,F ({-# SCC "lazy breakChar" #-}    app $ L.breakByte 122)+--  ])+--  , ("spanByte",+--      [F ({-# SCC "spanChar"      #-}     app $ B.spanByte 122)+--      ,F ({-# SCC "lazy spanChar" #-}     app $ L.spanByte 122)+--  ])++    , ("cons",+        [F ({-# SCC "cons"          #-}     app $ B.cons 120)+        ,F ({-# SCC "lazy cons"     #-}     app $ L.cons 120)+    ])+    , ("snoc",+        [F ({-# SCC "snoc"          #-}     app $ flip B.snoc 120)+        ,F ({-# SCC "lazy snoc"     #-}     app $ flip L.snoc 120)+    ])+    , ("empty",+        [F ({-# SCC "empty"         #-}     const B.empty)+        ,F ({-# SCC "lazy empty"    #-}     const L.empty)+    ])+    , ("head",+        [F ({-# SCC "head"          #-}     app B.head)+        ,F ({-# SCC "lazy head"     #-}     app L.head)+    ])+    , ("tail",+        [F ({-# SCC "tail"          #-}     app B.tail)+        ,F ({-# SCC "lazy tail"     #-}     app L.tail)+    ])++    , ("count",+        [F ({-# SCC "count"         #-}     app $ B.count 10)+        ,F ({-# SCC "lazy count"    #-}     app $ L.count 10)+    ])++    , ("isPrefixOf",+        [F ({-# SCC "isPrefixOf" #-}        app $ B.isPrefixOf+                (C.pack "The Project Gutenberg eBook"))+        ,F ({-# SCC "lazy isPrefixOf" #-}   app $ L.isPrefixOf+                (L.pack [84,104,101,32,80,114,111,106,101+                           ,99,116,32,71,117,116,101,110,98+                           ,101,114,103,32,101,66,111,111,107]))+    ])+    , ("join",+        [F ({-# SCC "join"          #-}     app $ B.join (B.pack [1,2,3]))+        ,F ({-# SCC "lazy join"     #-}     app $ L.join (L.pack [1,2,3]))+    ])+--  , ("joinWithByte",+--      [F ({-# SCC "joinWithByte"  #-}     app $ uncurry (B.joinWithByte 32))+--      ,F ({-# SCC "lazy joinWithByte" #-} app $ uncurry (L.joinWithByte 32))+--  ])++    , ("elem",+        [F ({-# SCC "elem"          #-}     app $ B.elem 122)+        ,F ({-# SCC "lazy elem"     #-}     app $ L.elem 122)+    ])+    , ("notElem",+        [F ({-# SCC "notElem"       #-}     app $ B.notElem 122)+        ,F ({-# SCC "lazy notElem"  #-}     app $ L.notElem 122)+    ])+    , ("elemIndex",+        [F ({-# SCC "elemIndex"     #-}     app $ B.elemIndex 122)+        ,F ({-# SCC "lazy elemIndex" #-}    app $ L.elemIndex 122)+    ])+    , ("findIndices",+        [F ({-# SCC "findIndicies"  #-}     app $ B.findIndices (==122))+        ,F ({-# SCC "lazy findIndices" #-}  app $ L.findIndices (==122))+    ])+    , ("elemIndices",+        [F ({-# SCC "elemIndicies"  #-}     app $ B.elemIndices 122)+        ,F ({-# SCC "lazy elemIndices" #-}  app $ L.elemIndices 122)+    ])+    , ("splitAt",+        [F ({-# SCC "splitAt"       #-}     app $ B.splitAt 10000)+        ,F ({-# SCC "lazy splitAt"  #-}     app $ L.splitAt 10000)+    ])+    , ("splitWith",+        [F ({-# SCC "splitWith"     #-}     app $ B.splitWith (==122))+        ,F ({-# SCC "lazy splitWith" #-}    app $ L.splitWith (==122))+    ])++    , ("group",+        [F ({-# SCC "group"         #-}     app B.group)+        ,F ({-# SCC "lazy group"    #-}     app L.group)+    ])+    , ("groupBy",+        [F ({-# SCC "groupBy"       #-}     app $ B.groupBy (==))+        ,F ({-# SCC "lazy groupBy"  #-}     app $ L.groupBy (==))+    ])+    , ("inits",+        [F ({-# SCC "inits"         #-}     app B.inits)+    ])+    , ("tails",+        [F ({-# SCC "tails"         #-}     app B.tails)+    ])+--  , ("transpose",[F ({-# SCC "transpose" #-}B.transpose [fps,fps'])])++------------------------------------------------------------------------+--+-- Char8 or ByteString only++    , ("intersperse",+        [F ({-# SCC "intersperse"   #-}     app $ B.intersperse 120 )+    ])+    , ("sort",+        [F ({-# SCC "sort"          #-}     app B.sort)+    ])+--  , ("lineIndices",+--      [F ({-# SCC "lineIndicies"  #-}     app C.lineIndices)+--  ])+    , ("elemIndexEnd",+        [F ({-# SCC "elemIndexEnd"  #-}     app $ B.elemIndexEnd 122)+    ])+--  , ("breakSpace",+--      [F ({-# SCC "breakSpace"    #-}     app C.breakSpace)+--  ])+--  , ("dropSpace",+--      [F ({-# SCC "dropSpace"     #-}     app C.dropSpace)+--  ])+--  , ("dropSpaceEnd",+--      [F ({-# SCC "dropSpaceEnd"  #-}     app C.dropSpaceEnd)+--  ])++--  , ("zip",[F ({-# SCC "zip" #-} B.zip fps fps)])++    , ("isSubstringOf",+        [F ({-# SCC "isSubstringOf" #-}     app $ B.isSubstringOf (C.pack "email news"))+    ])+    , ("isSuffixOf",+        [F ({-# SCC "isSuffixOf"    #-}     app $ B.isSuffixOf (C.pack "new eBooks"))+    ])+    , ("spanEnd",+        [F ({-# SCC "spanEnd"       #-}     app $ B.spanEnd (/=122))+    ])+    , ("lines",+        [F ({-# SCC "lines"         #-}     app C.lines)+    ])+    , ("unlines",+        [F ({-# SCC "unlines"       #-}     app C.unlines)+    ])+    , ("words",+        [F ({-# SCC "words"         #-}     app C.words)+    ])+    , ("unwords",+        [F ({-# SCC "unwords"       #-}     app C.unwords)+    ])++ ]+-}++------------------------------------------------------------------------++data Input = Input String String String [String]++instance Forceable Input where+  force (Input s x y xs) = force s >> force x >> force y >> force xs++class (Eq a, Ord a) => Ap a where app :: (a -> b) -> Input -> b++instance Ap String            where app f (Input _ x _ _)  = f x+instance Ap [String]          where app f (Input _ _ _ xs) = f xs+instance Ap (String,String)   where app f (Input _ x y _)  = f (x, y)+instance Ap (String,[String]) where app f (Input s _ _ xs) = f (s, xs)++app2 :: Ap (a, b) => (a -> b -> c) -> Input -> c+app2 = app . uncurry++splitEvery :: Int -> [a] -> [[a]]+splitEvery n = L.unfoldr split+  where split [] = Nothing+        split s  = Just (Prelude.splitAt n s)
+ tests/Bench/StreamList.hs view
@@ -0,0 +1,390 @@+--+-- list like wrappers for abstract streams+--+-- These specify the versions used when fusion occurs.+--+-- So we can check our stream implementations, which are only used when+-- fusion happens, are fast.+--++module Bench.StreamList where++import Prelude+import qualified Prelude +import Properties.Utils++import qualified Data.Stream as Stream++-- * Basic interface+cons            :: a -> [a] -> [a]+snoc            :: [a] -> a -> [a]+append          :: [a] -> [a] -> [a]+head            :: [a] -> a+last            :: [a] -> a+tail            :: [a] -> [a]+init            :: [a] -> [a]+null            :: [a] -> Bool+length          :: [a] -> Int+++-- * List transformations+map             :: (a -> b) -> [a] -> [b]+--reverse       :: [a] -> [a]+intersperse     :: a -> [a] -> [a]+intercalate   :: [a] -> [[a]] -> [a]+--transpose     :: [[a]] -> [[a]]++-- * Reducing lists (folds)+foldl           :: (b -> a -> b) -> b -> [a] -> b+foldl'          :: (b -> a -> b) -> b -> [a] -> b+foldl1          :: (a -> a -> a) -> [a] -> a+foldl1'         :: (a -> a -> a) -> [a] -> a+foldr           :: (a -> b -> b) -> b -> [a] -> b+foldr1          :: (a -> a -> a) -> [a] -> a++-- ** Special folds+concat          :: [[a]] -> [a]+concatMap       :: (a -> [b]) -> [a] -> [b]+and             :: [Bool] -> Bool+or              :: [Bool] -> Bool+any             :: (a -> Bool) -> [a] -> Bool+all             :: (a -> Bool) -> [a] -> Bool+sum             :: [N] -> N+product         :: [N] -> N+maximum         :: Ord a => [a] -> a+minimum         :: Ord a => [a] -> a++-- * Building lists+-- ** Scans+scanl           :: (a -> b -> a) -> a -> [b] -> [a]+scanl1          :: (a -> a -> a) -> [a] -> [a]++{-+scanr           :: (a -> b -> b) -> b -> [a] -> [b]+scanr1          :: (a -> a -> a) -> [a] -> [a]++-- ** Accumulating maps+mapAccumL       :: (c -> a -> (c, b)) -> c -> [a] -> (c, [b])+mapAccumR       :: (c -> a -> (c, b)) -> c -> [a] -> (c, [b])+-}++-- ** Infinite lists+iterate         :: (a -> a) -> a -> [a]+repeat          :: a -> [a]+replicate       :: Int -> a -> [a]+cycle           :: [a] -> [a]++-- ** Unfolding+unfoldr         :: (b -> Maybe (a, b)) -> b -> [a]++-- * Sublists+-- ** Extracting sublists+take            :: Int -> [a] -> [a]+drop            :: Int -> [a] -> [a]+splitAt         :: Int -> [a] -> ([a], [a])+takeWhile       :: (a -> Bool) -> [a] -> [a]+dropWhile       :: (a -> Bool) -> [a] -> [a]++{-+span          :: (a -> Bool) -> [a] -> ([a], [a])+break           :: (a -> Bool) -> [a] -> ([a], [a])+group           :: [a] -> [[a]]+inits           :: [a] -> [[a]]+tails           :: [a] -> [[a]]+-}++-- * Predicates+isPrefixOf      :: Eq a => [a] -> [a] -> Bool+{-+isSuffixOf      :: [a] -> [a] -> Bool+isInfixOf       :: [a] -> [a] -> Bool+-}++-- * Searching lists+-- ** Searching by equality+elem            :: Eq a => a -> [a] -> Bool+--notElem       :: Eq a => a -> [a] -> Bool+lookup          :: Eq a => a -> [(a, b)] -> Maybe b++-- ** Searching with a predicate+find            :: (a -> Bool) -> [a] -> Maybe a+filter          :: (a -> Bool) -> [a] -> [a]+--partition     :: (a -> Bool) -> [a] -> ([a], [a])++-- * Indexing lists+(!!)            :: [a] -> Int -> a+findIndex       :: (a -> Bool) -> [a] -> Maybe Int+elemIndex       :: Eq a => a -> [a] -> Maybe Int+elemIndices     :: Eq a => a -> [a] -> [Int]+findIndices     :: (a -> Bool) -> [a] -> [Int]++-- * Zipping and unzipping lists+zip             :: [a] -> [b] -> [(a, b)]+zip3            :: [a] -> [b] -> [c] -> [(a, b, c)]+{-+zip4            :: [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]+zip5            :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]+zip6            :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [(a, b, c, d, e, f)]+zip7            :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [(a, b, c, d, e, f, g)]+-}++zipWith         :: (a -> b -> c) -> [a] -> [b] -> [c]+zipWith3        :: (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]+{-+zipWith4        :: (a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]+zipWith5        :: (a -> b -> c -> d -> e -> f) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f]+zipWith6        :: (a -> b -> c -> d -> e -> f -> g) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g]+zipWith7        :: (a -> b -> c -> d -> e -> f -> g -> h) -> [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> [g] -> [h]+-}++unzip           :: [(a, b)] -> ([a], [b])+{-+unzip3          :: [(a, b, c)] -> ([a], [b], [c])+unzip4          :: [(a, b, c, d)] -> ([a], [b], [c], [d])+unzip5          :: [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])+unzip6          :: [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])+unzip7          :: [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])+-}++-- * Special lists+-- ** Functions on strings+unlines         :: [String] -> String+lines           :: String -> [String]+{-+words           :: String -> [String]+unwords         :: [String] -> String++-- ** \"Set\" operations+nub             :: [a] -> [a]+delete          :: a -> [a] -> [a]+(\\)            :: [a] -> [a] -> [a]+union           :: [a] -> [a] -> [a]+intersect       :: [a] -> [a] -> [a]++-- ** Ordered lists +sort            :: [a] -> [a]+insert          :: a -> [a] -> [a]++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (a -> a -> Bool) -> [a] -> [a]+deleteBy        :: (a -> a -> Bool) -> a -> [a] -> [a]+deleteFirstsBy  :: (a -> a -> Bool) -> [a] -> [a] -> [a]+unionBy         :: (a -> a -> Bool) -> [a] -> [a] -> [a]+intersectBy     :: (a -> a -> Bool) -> [a] -> [a] -> [a]+groupBy         :: (a -> a -> Bool) -> [a] -> [[a]]+-}++-- *** User-supplied comparison (replacing an Ord context)+insertBy        :: (a -> a -> Ordering) -> a -> [a] -> [a]+{-+sortBy          :: (a -> a -> Ordering) -> [a] -> [a]+-}+maximumBy       :: (a -> a -> Ordering) -> [a] -> a+minimumBy       :: (a -> a -> Ordering) -> [a] -> a++-- * The \"generic\" operations+genericLength           :: [a] -> I+genericTake             :: I -> [a] -> [a]+genericDrop             :: I -> [a] -> [a]+genericIndex            :: [a] -> I -> a+genericSplitAt          :: I -> [a] -> ([a], [a])+genericReplicate        :: I -> a -> [a]++s = Stream.stream+u = Stream.unstream++-- * Basic interface+cons            = \x xs  -> u $ Stream.cons   x (s xs)+snoc            = \xs x  -> u $ Stream.snoc   (s xs) x+append          = \xs ys -> u $ Stream.append (s xs) (s ys)+head            = \xs    ->     Stream.head   (s xs)+last            = \xs    ->     Stream.last   (s xs)+tail            = \xs    -> u $ Stream.tail   (s xs)+init            = \xs    -> u $ Stream.init   (s xs)+null            = \xs    ->     Stream.null   (s xs)+length          = \xs    ->     Stream.length (s xs)+++-- * List transformations+map             = \f   xs -> u $ Stream.map f (s xs)+--reverse               = Stream.reverse+intersperse     = \sep xs -> u $ Stream.intersperse sep (s xs)+intercalate     = \sep xs ->     Stream.concat (Stream.intersperse sep(s xs))++--transpose     = Stream.transpose++-- * Reducing lists (folds)+foldl           = \f z xs -> Stream.foldl   f z (s xs)+foldl'          = \f z xs -> Stream.foldl'  f z (s xs)+foldl1          = \f   xs -> Stream.foldl1  f   (s xs)+foldl1'         = \f   xs -> Stream.foldl1' f   (s xs)+foldr           = \f z xs -> Stream.foldr   f z (s xs)+foldr1          = \f   xs -> Stream.foldr1  f   (s xs)++-- ** Special folds+concat          = \  xs -> Stream.concat (s xs)+concatMap       = \f xs -> Stream.concatMap f (s xs)+and             = \  xs -> Stream.and   (s xs)+or              = \  xs -> Stream.or    (s xs)+any             = \f xs -> Stream.any f (s xs)+all             = \f xs -> Stream.all f (s xs)+sum             = \  xs -> Stream.sum   (s xs)+product         = \  xs -> Stream.product   (s xs)+maximum         = \  xs -> Stream.maximum   (s xs)+{-# INLINE maximum #-}+minimum         = \  xs -> Stream.minimum   (s xs)+{-# INLINE minimum #-}++-- * Building lists+-- ** Scans+scanl           = \f z xs -> u (Stream.scanl f z (Stream.snoc (s xs) bottom))+ where+    bottom :: a+    bottom = error "StreamProperties.bottom"++scanl1          = \f xs -> u (Stream.scanl1 f (Stream.snoc (s xs) bottom))+ where+    bottom :: a+    bottom = error "StreamProperties.bottom"++{-+scanr           = \f z xs -> u (Stream.scanr f z (Stream.cons bottom (s xs)))+ where+    bottom :: a+    bottom = error "StreamProperties.bottom"+-}++{-+scanr1          = Stream.scanr1++-- ** Accumulating maps+mapAccumL       = Stream.mapAccumL+mapAccumR       = Stream.mapAccumR+-}+-- ** Infinite lists+iterate         = \f x -> u $ Stream.iterate   f x+repeat          = \  x -> u $ Stream.repeat      x+replicate       = \n x -> u $ Stream.replicate n x+cycle           = \ xs -> u $ Stream.cycle    (s xs)++-- ** Unfolding+unfoldr         = \f x -> u $ Stream.unfoldr f x++-- * Sublists+-- ** Extracting sublists+take            = \n xs -> u $ Stream.take    n (s xs)+drop            = \n xs -> u $ Stream.drop    n (s xs)+splitAt         = \n xs ->     Stream.splitAt n (s xs)+takeWhile       = \f xs -> u $ Stream.takeWhile f (s xs)+dropWhile       = \f xs -> u $ Stream.dropWhile f (s xs)+{-+span          = Stream.span+break           = Stream.break+group           = Stream.group+inits           = Stream.inits+tails           = Stream.tails+-}++-- * Predicates+isPrefixOf      = \xs ys -> Stream.isPrefixOf (s xs) (s ys)+{-+isSuffixOf      = Stream.isSuffixOf+isInfixOf       = Stream.isInfixOf+-}+-- * Searching lists+-- ** Searching by equality+elem            = \key xs -> Stream.elem   key (s xs)+--notElem               = Stream.notElem+lookup          = \key xs -> Stream.lookup key (s xs)++-- ** Searching with a predicate+find            = \p xs ->     Stream.find   p (s xs)+filter          = \p xs -> u $ Stream.filter p (s xs)+--partition     = Stream.partition++-- * Indexing lists+(!!)            = \xs n -> Stream.index (Stream.stream xs) n+--Wirdness: Stream.index needs to be eta-expanded and fully applied for the+-- code to be any good+findIndex       = \f xs -> Stream.findIndex f (s xs)+findIndices     = \p xs -> u (Stream.findIndices p (s xs))+elemIndex       = \x xs -> Stream.findIndex (x==) (s xs)+elemIndices     = \x xs -> u (Stream.findIndices (x==) (s xs))+{-# INLINE elemIndex #-}+{-# INLINE elemIndices #-}+++-- * Zipping and unzipping lists+zip  = \xs ys    -> u (Stream.zip (s xs) (s ys))+zip3 = \xs ys zs -> u (Stream.zip3 (s xs) (s ys) (s zs))++zipWith         = \f xs ys    -> u (Stream.zipWith f (s xs) (s ys))+zipWith3        = \f xs ys zs -> u (Stream.zipWith3 f (s xs) (s ys) (s zs))++unzip           = Stream.unzip . s++{-+zip4            = Stream.zip4+zip5            = Stream.zip5+zip6            = Stream.zip6+zip7            = Stream.zip7+zipWith4        = Stream.zipWith4+zipWith5        = Stream.zipWith5+zipWith6        = Stream.zipWith6+zipWith7        = Stream.zipWith7+unzip3          = Stream.unzip3+unzip4          = Stream.unzip4+unzip5          = Stream.unzip5+unzip6          = Stream.unzip6+unzip7          = Stream.unzip7+-}++-- * Special lists+-- ** Functions on strings+unlines         = \xs -> Stream.concatMap (\x -> x ++ ['\n']) (s xs)+lines           = \xs -> u (Stream.lines (s xs))++{-+words           = Stream.words+unwords         = Stream.unwords++-- ** \"Set\" operations+nub             = Stream.nub+delete          = Stream.delete+(\\)            = (Stream.\\)+union           = Stream.union+intersect       = Stream.intersect++-- ** Ordered lists +sort            = Stream.sort+insert          = Stream.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = Stream.nubBy+deleteBy        = Stream.deleteBy+deleteFirstsBy  = Stream.deleteFirstsBy+unionBy         = Stream.unionBy+intersectBy     = Stream.intersectBy+groupBy         = Stream.groupBy+-}++-- *** User-supplied comparison (replacing an Ord context)+{-+sortBy          = Stream.sortBy+-}+insertBy        = \cmp x xs -> u $ Stream.insertBy cmp x (s xs)++maximumBy       = \cmp xs -> Stream.maximumBy cmp (s xs)+minimumBy       = \cmp xs -> Stream.minimumBy cmp (s xs)++-- * The \"generic\" operations+genericLength           = \xs -> Stream.genericLength (s xs)+genericTake             = \n xs -> u $ Stream.genericTake n (s xs)+genericDrop             = \n xs -> u $ Stream.genericDrop n (s xs)+genericIndex            = \xs n -> Stream.genericIndex (s xs) n+genericSplitAt          = \n xs -> Stream.genericSplitAt n (s xs)+genericReplicate        = \n x  -> genericTake n (Prelude.repeat x)
+ tests/Bench/StreamVsList.hs view
@@ -0,0 +1,423 @@+{-# OPTIONS -fglasgow-exts #-}+-- ^ unboxed strings+--+-- Benchmark tool.+-- Compare a function against equivalent code from other libraries for+-- space and time.+--+import Bench.Utils++import qualified Data.List.Stream as L -- our list functions+import qualified Bench.StreamList as S -- our stream versions++import qualified Data.Stream as Stream++import Data.Char+import Data.Word+import Data.Int++import System.IO+import Control.Monad+import Text.Printf++main :: IO ()+main = do+    -- initialise+    let input = Input (take 1000 string) string string2 (splitEvery 1000 string2)+    force input++    putStrLn "Benchmarking Data.Stream <=> Data.List.Stream"+    putStrLn "=============================================\n"++    printf "# Size of test data: %dk\n" ((floor $ (fromIntegral (length string)) / 1024) :: Int)+    printf "#List\t List.Stream\n"+++    run 5 input tests++------------------------------------------------------------------------++s = Stream.stream+u = Stream.unstream+++tests =+ [+    -- * Basic interface++    ("++",  -- should be identical+        [F ( app  (uncurry ((L.++)     :: S -> S -> S) )    )+        ,F ( app  (uncurry ((S.append) :: S -> S -> S) )    ) ]+    )++    , ("head",+        [F ( app  (L.head :: S -> Char) )+        ,F ( app  (S.head :: S -> Char) )]+    )++    , ("last",+        [F (     app (L.last :: S -> Char))+        ,F (     app (S.last :: S -> Char))+    ])++    , ("init",+        [F (     app (L.init :: S -> S))+        ,F (     app (S.init :: S -> S))+    ])++    , ("null",+        [F (     app (L.null :: S -> Bool))+        ,F (     app (S.null :: S -> Bool))+    ])++    , ("length",+        [F (      app  (L.length :: S -> Int))+        ,F (      app  (S.length :: S -> Int))+    ])++    -- * List transformations+    , ("map",+        [F (      app ( L.map toUpper :: S -> S ))+        ,F (      app ( S.map toUpper :: S -> S ))+    ])+{-+    , ("reverse",+        [F (     app (L.reverse :: S -> S ))+        ,F (     app (S.reverse :: S -> S ))+    ])+-}+    , ("intersperse",+        [F ( app  (L.intersperse 'x' :: S -> S)     )+        ,F ( app  (S.intersperse 'x' :: S -> S)     ) ]+     )++    , ("intercalate",+        [F ( app2  (L.intercalate :: S -> [S] -> S)     )+        ,F ( app2  (S.intercalate :: S -> [S] -> S)     ) ]+     )++    -- transpose is too slow.++    -- * Reducing lists (folds)++    , ("foldl'",+        [F (     app  ( L.foldl' (\a _ -> a+1) 0 :: S -> Int  ) )+        ,F (     app  ( S.foldl' (\a _ -> a+1) 0  :: S -> Int ) )+    ])++{-+    , ("foldr",+        [F (     app  ( L.foldr (\_ a -> a+1) 0 :: S -> Int  ) )+        ,F (     app  ( S.foldr (\_ a -> a+1) 0 :: S -> Int ) )+    ])+-}++    -- ** Special folds++    , ("concat",+        [F ( app   ((\ss -> L.concat (ss++ss++ss)) :: [S] -> S)               )+        ,F ( app   ((\ss -> S.concat (ss++ss++ss)) :: [S] -> S)               ) ]+     )++    , ("concatMap",+        [F ( app   (L.concatMap (\c -> [c, c, c]) :: S -> S))+        ,F ( app   (S.concatMap (\c -> [c, c, c]) :: S -> S)) ]+     )++    , ("any",+        [F (     app ( L.any (=='x') :: S -> Bool       ))+        ,F (     app ( S.any (=='x') :: S -> Bool       ))+    ])+    , ("all",+        [F (     app ( L.all (=='x') :: S -> Bool       ))+        ,F (     app ( S.all (=='x') :: S -> Bool       ))+    ])+    , ("maximum",+        [F (     app (L.maximum :: S -> Char) )+        ,F (     app (S.maximum :: S -> Char) )+    ])+    , ("minimum",+        [F (     app (L.minimum :: S -> Char) )+        ,F (     app (S.minimum :: S -> Char) )+    ])++    -- * Building lists+    -- ** Scans++    -- * Sublists+    -- ** Extracting sublists+    , ("take",+        [F (     app ( L.take 100000 :: S -> S) )+        ,F (     app ( S.take 100000 :: S -> S) )+    ])+    , ("drop",+        [F (     app ( L.drop 100000 :: S -> S) )+        ,F (     app ( S.drop 100000 :: S -> S) )+    ])++    , ("takeWhile",+        [F (     app ( L.takeWhile (/='z') :: S -> S  ))+        ,F (    app  ( S.takeWhile (=='z')  :: S -> S ))+    ])+    , ("dropWhile",+        [F (     app ( L.dropWhile (/='z')  :: S -> S ) )+        ,F (    app  ( S.dropWhile (/='z')  :: S -> S ) )+    ])++    -- * Searching lists+    -- ** Searching by equality+    , ("elem",+        [F (     app (L.elem ('Z') :: S -> Bool) )+        ,F (     app (S.elem ('Z') :: S -> Bool) )+    ])+{-+    , ("notElem",+        [F (     app (L.notElem ('Z') :: S -> Bool) )+        ,F (     app (S.notElem ('Z') :: S -> Bool) )+    ])+-}+    -- ** Searching with a predicate++    , ("find",+        [F (     app (L.find (=='Z') :: S -> Maybe Char) )+        ,F (     app (S.find (=='Z') :: S -> Maybe Char) )+    ])++    , ("filter",+        [F (      app ( L.filter isSpace :: S -> S ))+        ,F (      app ( S.filter isSpace :: S -> S ))+    ])++    -- * Indexing lists++    , ("index",+        [F (      app ((\x -> x L.!! 300000) ::  S -> Char  ))+        ,F (      app ((\x -> x S.!! 300000) ::  S -> Char  ))+    ])++    , ("elemIndex",+        [F (    app (L.elemIndex ('Z') :: S -> Maybe Int ) )+        ,F (    app (S.elemIndex ('Z') :: S -> Maybe Int ) )+    ])++    , ("elemIndices",+        [F (    app (L.elemIndices ('Z') :: S -> [Int] ) )+        ,F (    app (S.elemIndices ('Z') :: S -> [Int] ) )+    ])++    , ("findIndex",+        [F (    app (L.findIndex (=='Z') :: S -> Maybe Int ) )+        ,F (    app (S.findIndex (=='Z') :: S -> Maybe Int ) )+    ])++    , ("findIndices",+        [F (    app (L.findIndices (=='Z') :: S -> [Int] ) )+        ,F (    app (S.findIndices (=='Z') :: S -> [Int] ) )+    ])++    -- * Zipping and unzipping lists++    , ("zip",+        [F (     app (uncurry (L.zip) :: (S,S) -> [(Char, Char)]     ))+        ,F (     app (uncurry (S.zip) :: (S,S) -> [(Char, Char)]     ))+    ])++    , ("zipWith",+        [F (     app (uncurry (L.zipWith (,)) :: (S,S) -> [(Char, Char)]     ))+        ,F (     app (uncurry (S.zipWith (,)) :: (S,S) -> [(Char, Char)]     ))+    ])++    , ("replicate",+        [F (    const $ L.replicate 2000000 'x')+        ,F (    const $ S.replicate 2000000 'x')+    ])++ ]+++{-+++    , ("span",+        [F ({-# SCC "span"          #-}     app $ B.span (/=122))+        ,F ({-# SCC "lazy span"     #-}     app $ L.span (/=122))+    ])+    , ("break",+        [F ({-# SCC "break"         #-}     app $ B.break (==122))+        ,F ({-# SCC "lazy break"    #-}     app $ L.break (==122))+    ])+    , ("split",+        [F ({-# SCC "split"         #-}     app $ B.split 0x0a)+        ,F ({-# SCC "lazy split"    #-}     app $ L.split 0x0a)+    ])+--  , ("breakByte",+--      [F ({-# SCC "breakChar"     #-}     app $ B.breakByte 122)+--      ,F ({-# SCC "lazy breakChar" #-}    app $ L.breakByte 122)+--  ])+--  , ("spanByte",+--      [F ({-# SCC "spanChar"      #-}     app $ B.spanByte 122)+--      ,F ({-# SCC "lazy spanChar" #-}     app $ L.spanByte 122)+--  ])++    , ("cons",+        [F ({-# SCC "cons"          #-}     app $ B.cons 120)+        ,F ({-# SCC "lazy cons"     #-}     app $ L.cons 120)+    ])+    , ("snoc",+        [F ({-# SCC "snoc"          #-}     app $ flip B.snoc 120)+        ,F ({-# SCC "lazy snoc"     #-}     app $ flip L.snoc 120)+    ])+    , ("empty",+        [F ({-# SCC "empty"         #-}     const B.empty)+        ,F ({-# SCC "lazy empty"    #-}     const L.empty)+    ])+    , ("head",+        [F ({-# SCC "head"          #-}     app B.head)+        ,F ({-# SCC "lazy head"     #-}     app L.head)+    ])+    , ("tail",+        [F ({-# SCC "tail"          #-}     app B.tail)+        ,F ({-# SCC "lazy tail"     #-}     app L.tail)+    ])++    , ("count",+        [F ({-# SCC "count"         #-}     app $ B.count 10)+        ,F ({-# SCC "lazy count"    #-}     app $ L.count 10)+    ])++    , ("isPrefixOf",+        [F ({-# SCC "isPrefixOf" #-}        app $ B.isPrefixOf+                (C.pack "The Project Gutenberg eBook"))+        ,F ({-# SCC "lazy isPrefixOf" #-}   app $ L.isPrefixOf+                (L.pack [84,104,101,32,80,114,111,106,101+                           ,99,116,32,71,117,116,101,110,98+                           ,101,114,103,32,101,66,111,111,107]))+    ])+    , ("join",+        [F ({-# SCC "join"          #-}     app $ B.join (B.pack [1,2,3]))+        ,F ({-# SCC "lazy join"     #-}     app $ L.join (L.pack [1,2,3]))+    ])+--  , ("joinWithByte",+--      [F ({-# SCC "joinWithByte"  #-}     app $ uncurry (B.joinWithByte 32))+--      ,F ({-# SCC "lazy joinWithByte" #-} app $ uncurry (L.joinWithByte 32))+--  ])++    , ("elem",+        [F ({-# SCC "elem"          #-}     app $ B.elem 122)+        ,F ({-# SCC "lazy elem"     #-}     app $ L.elem 122)+    ])+    , ("notElem",+        [F ({-# SCC "notElem"       #-}     app $ B.notElem 122)+        ,F ({-# SCC "lazy notElem"  #-}     app $ L.notElem 122)+    ])+    , ("elemIndex",+        [F ({-# SCC "elemIndex"     #-}     app $ B.elemIndex 122)+        ,F ({-# SCC "lazy elemIndex" #-}    app $ L.elemIndex 122)+    ])+    , ("findIndices",+        [F ({-# SCC "findIndicies"  #-}     app $ B.findIndices (==122))+        ,F ({-# SCC "lazy findIndices" #-}  app $ L.findIndices (==122))+    ])+    , ("elemIndices",+        [F ({-# SCC "elemIndicies"  #-}     app $ B.elemIndices 122)+        ,F ({-# SCC "lazy elemIndices" #-}  app $ L.elemIndices 122)+    ])+    , ("splitAt",+        [F ({-# SCC "splitAt"       #-}     app $ B.splitAt 10000)+        ,F ({-# SCC "lazy splitAt"  #-}     app $ L.splitAt 10000)+    ])+    , ("splitWith",+        [F ({-# SCC "splitWith"     #-}     app $ B.splitWith (==122))+        ,F ({-# SCC "lazy splitWith" #-}    app $ L.splitWith (==122))+    ])++    , ("group",+        [F ({-# SCC "group"         #-}     app B.group)+        ,F ({-# SCC "lazy group"    #-}     app L.group)+    ])+    , ("groupBy",+        [F ({-# SCC "groupBy"       #-}     app $ B.groupBy (==))+        ,F ({-# SCC "lazy groupBy"  #-}     app $ L.groupBy (==))+    ])+    , ("inits",+        [F ({-# SCC "inits"         #-}     app B.inits)+    ])+    , ("tails",+        [F ({-# SCC "tails"         #-}     app B.tails)+    ])+--  , ("transpose",[F ({-# SCC "transpose" #-}B.transpose [fps,fps'])])++------------------------------------------------------------------------+--+-- Char8 or ByteString only++    , ("intersperse",+        [F ({-# SCC "intersperse"   #-}     app $ B.intersperse 120 )+    ])+    , ("sort",+        [F ({-# SCC "sort"          #-}     app B.sort)+    ])+--  , ("lineIndices",+--      [F ({-# SCC "lineIndicies"  #-}     app C.lineIndices)+--  ])+    , ("elemIndexEnd",+        [F ({-# SCC "elemIndexEnd"  #-}     app $ B.elemIndexEnd 122)+    ])+--  , ("breakSpace",+--      [F ({-# SCC "breakSpace"    #-}     app C.breakSpace)+--  ])+--  , ("dropSpace",+--      [F ({-# SCC "dropSpace"     #-}     app C.dropSpace)+--  ])+--  , ("dropSpaceEnd",+--      [F ({-# SCC "dropSpaceEnd"  #-}     app C.dropSpaceEnd)+--  ])++--  , ("zip",[F ({-# SCC "zip" #-} B.zip fps fps)])++    , ("isSubstringOf",+        [F ({-# SCC "isSubstringOf" #-}     app $ B.isSubstringOf (C.pack "email news"))+    ])+    , ("isSuffixOf",+        [F ({-# SCC "isSuffixOf"    #-}     app $ B.isSuffixOf (C.pack "new eBooks"))+    ])+    , ("spanEnd",+        [F ({-# SCC "spanEnd"       #-}     app $ B.spanEnd (/=122))+    ])+    , ("lines",+        [F ({-# SCC "lines"         #-}     app C.lines)+    ])+    , ("unlines",+        [F ({-# SCC "unlines"       #-}     app C.unlines)+    ])+    , ("words",+        [F ({-# SCC "words"         #-}     app C.words)+    ])+    , ("unwords",+        [F ({-# SCC "unwords"       #-}     app C.unwords)+    ])++ ]+-}++------------------------------------------------------------------------++data Input = Input String String String [String]++instance Forceable Input where+  force (Input s x y xs) = force s >> force x >> force y >> force xs++class (Eq a, Ord a) => Ap a where app :: (a -> b) -> Input -> b++instance Ap String            where app f (Input _ x _ _)  = f x+instance Ap [String]          where app f (Input _ _ _ xs) = f xs+instance Ap (String,String)   where app f (Input _ x y _)  = f (x, y)+instance Ap (String,[String]) where app f (Input s _ _ xs) = f (s, xs)++app2 :: Ap (a, b) => (a -> b -> c) -> Input -> c+app2 = app . uncurry++splitEvery :: Int -> [a] -> [[a]]+splitEvery n = L.unfoldr split+  where split [] = Nothing+        split s  = Just (Prelude.splitAt n s)
+ tests/Bench/Utils.hs view
@@ -0,0 +1,129 @@+{-# OPTIONS -cpp -fglasgow-exts #-}+module Bench.Utils where++--+-- Benchmark tool.+-- Compare a function against equivalent code from other libraries for+-- space and time.+--++import Data.List+import Data.Char+import Data.Word+import Data.Int++import System.Mem+import Control.Concurrent++import System.IO+import System.CPUTime+import System.IO.Unsafe+import Control.Monad+import Control.Exception+import Text.Printf++import qualified Data.ByteString.Char8 as P+import qualified Data.ByteString       as S+++run :: Int -> a -> [(String, [F a])] -> IO ()+run c x tests = sequence_ $ zipWith (doit c x) [1..] tests+++doit :: Int -> a -> Int -> (String, [F a]) -> IO ()+doit count x n (s,ls) = do+    printf "%2d %s\n   " n (show s)+    fn ls+    hFlush stdout+  where fn xs = case xs of+                    [f,g]   -> runN count f x >> putStr "\n   "+                            >> runN count g x >> putStr "\n\n"+                    [f]     -> runN count f x >> putStr "\n\n"+                    _       -> return ()+        run f x = dirtyCache fps >> performGC >> threadDelay 100 >> time f x+        runN 0 f x = return ()+        runN c f x = run f x >> runN (c-1) f x+++dirtyCache x = evaluate (S.foldl1' (+) x)+{-# NOINLINE dirtyCache #-}+++time :: F a -> a -> IO ()+time (F f) a = do+    start <- getCPUTime+    v     <- force (f a)+    case v of+        B -> printf "--\t"+        _ -> do+            end   <- getCPUTime+            let diff = (fromIntegral (end - start)) / (10^12)+            printf "%0.3f  " (diff :: Double)+    hFlush stdout+++------------------------------------------------------------------------+-- +-- an existential list of testables+--+data F a = forall b . Forceable b => F (a -> b)++data Result = T | B++--+-- a bit deepSeqish+--+class Forceable a where+    force :: a -> IO Result+    force v = v `seq` return T++#if !defined(HEAD)+instance Forceable P.ByteString where+    force v = P.length v `seq` return T+#endif++instance Forceable a => Forceable (Maybe a) where+    force Nothing  = return T+    force (Just v) = force v `seq` return T++instance Forceable a => Forceable [a] where+    force xs = mapM_ force xs >> return T++instance (Forceable a, Forceable b) => Forceable (a,b) where+    force (a,b) = force a >> force b++instance Forceable Int+instance Forceable Int64+instance Forceable Bool+instance Forceable Char+instance Forceable Word8+instance Forceable Ordering++-- used to signal undefinedness+instance Forceable () where force () = return B++------------------------------------------------------------------------+--+-- some large strings to play with+--++string :: String+string = P.unpack (unsafePerformIO (P.readFile dict))+{-# NOINLINE string #-}++string2 :: String+string2 = P.unpack (unsafePerformIO (P.readFile dict2))+{-# NOINLINE string2 #-}++-- just for dirtying the cache+fps :: P.ByteString+fps = (unsafePerformIO (P.readFile dict2))+{-# NOINLINE fps #-}++dict  = "Bench/bigdata"+dict2 = "Bench/data"++-- Some short hand.+type X = Int+type W = Word8+type S = String
+ tests/Bench/data view
@@ -0,0 +1,3925 @@+The Project Gutenberg eBook, Utopia, by Thomas More, Edited by Henry Morley
+
+
+This eBook is for the use of anyone anywhere at no cost and with
+almost no restrictions whatsoever.  You may copy it, give it away or
+re-use it under the terms of the Project Gutenberg License included
+with this eBook or online at www.gutenberg.net
+
+
+
+
+
+Title: Utopia
+
+
+Author: Thomas More
+
+Release Date: April 22, 2005  [eBook #2130]
+
+Language: English
+
+Character set encoding: ISO-646-US (US-ASCII)
+
+
+***START OF THE PROJECT GUTENBERG EBOOK UTOPIA***
+
+
+
+
+
+
+Transcribed from the 1901 Cassell & Company Edition by David Price, email
+ccx074@coventry.ac.uk
+
+
+
+
+
+UTOPIA
+
+
+INTRODUCTION
+
+
+Sir Thomas More, son of Sir John More, a justice of the King's Bench, was
+born in 1478, in Milk Street, in the city of London.  After his earlier
+education at St. Anthony's School, in Threadneedle Street, he was placed,
+as a boy, in the household of Cardinal John Morton, Archbishop of
+Canterbury and Lord Chancellor.  It was not unusual for persons of wealth
+or influence and sons of good families to be so established together in a
+relation of patron and client.  The youth wore his patron's livery, and
+added to his state.  The patron used, afterwards, his wealth or influence
+in helping his young client forward in the world.  Cardinal Morton had
+been in earlier days that Bishop of Ely whom Richard III. sent to the
+Tower; was busy afterwards in hostility to Richard; and was a chief
+adviser of Henry VII., who in 1486 made him Archbishop of Canterbury, and
+nine months afterwards Lord Chancellor.  Cardinal Morton--of talk at
+whose table there are recollections in "Utopia"--delighted in the quick
+wit of young Thomas More.  He once said, "Whoever shall live to try it,
+shall see this child here waiting at table prove a notable and rare man."
+
+At the age of about nineteen, Thomas More was sent to Canterbury College,
+Oxford, by his patron, where he learnt Greek of the first men who brought
+Greek studies from Italy to England--William Grocyn and Thomas Linacre.
+Linacre, a physician, who afterwards took orders, was also the founder of
+the College of Physicians.  In 1499, More left Oxford to study law in
+London, at Lincoln's Inn, and in the next year Archbishop Morton died.
+
+More's earnest character caused him while studying law to aim at the
+subduing of the flesh, by wearing a hair shirt, taking a log for a
+pillow, and whipping himself on Fridays.  At the age of twenty-one he
+entered Parliament, and soon after he had been called to the bar he was
+made Under-Sheriff of London.  In 1503 he opposed in the House of Commons
+Henry VII.'s proposal for a subsidy on account of the marriage portion of
+his daughter Margaret; and he opposed with so much energy that the House
+refused to grant it.  One went and told the king that a beardless boy had
+disappointed all his expectations.  During the last years, therefore, of
+Henry VII.  More was under the displeasure of the king, and had thoughts
+of leaving the country.
+
+Henry VII. died in April, 1509, when More's age was a little over thirty.
+In the first years of the reign of Henry VIII. he rose to large practice
+in the law courts, where it is said he refused to plead in cases which he
+thought unjust, and took no fees from widows, orphans, or the poor.  He
+would have preferred marrying the second daughter of John Colt, of New
+Hall, in Essex, but chose her elder sister, that he might not subject her
+to the discredit of being passed over.
+
+In 1513 Thomas More, still Under-Sheriff of London, is said to have
+written his "History of the Life and Death of King Edward V., and of the
+Usurpation of Richard III."  The book, which seems to contain the
+knowledge and opinions of More's patron, Morton, was not printed until
+1557, when its writer had been twenty-two years dead.  It was then
+printed from a MS. in More's handwriting.
+
+In the year 1515 Wolsey, Archbishop of York, was made Cardinal by Leo X.;
+Henry VIII. made him Lord Chancellor, and from that year until 1523 the
+King and the Cardinal ruled England with absolute authority, and called
+no parliament.  In May of the year 1515 Thomas More--not knighted yet--was
+joined in a commission to the Low Countries with Cuthbert Tunstal and
+others to confer with the ambassadors of Charles V., then only Archduke
+of Austria, upon a renewal of alliance.  On that embassy More, aged about
+thirty-seven, was absent from England for six months, and while at
+Antwerp he established friendship with Peter Giles (Latinised AEgidius),
+a scholarly and courteous young man, who was secretary to the
+municipality of Antwerp.
+
+Cuthbert Tunstal was a rising churchman, chancellor to the Archbishop of
+Canterbury, who in that year (1515) was made Archdeacon of Chester, and
+in May of the next year (1516) Master of the Rolls.  In 1516 he was sent
+again to the Low Countries, and More then went with him to Brussels,
+where they were in close companionship with Erasmus.
+
+More's "Utopia" was written in Latin, and is in two parts, of which the
+second, describing the place ([Greek text]--or Nusquama, as he called it
+sometimes in his letters--"Nowhere"), was probably written towards the
+close of 1515; the first part, introductory, early in 1516.  The book was
+first printed at Louvain, late in 1516, under the editorship of Erasmus,
+Peter Giles, and other of More's friends in Flanders.  It was then
+revised by More, and printed by Frobenius at Basle in November, 1518.  It
+was reprinted at Paris and Vienna, but was not printed in England during
+More's lifetime.  Its first publication in this country was in the
+English translation, made in Edward's VI.'s reign (1551) by Ralph
+Robinson.  It was translated with more literary skill by Gilbert Burnet,
+in 1684, soon after he had conducted the defence of his friend Lord
+William Russell, attended his execution, vindicated his memory, and been
+spitefully deprived by James II. of his lectureship at St. Clement's.
+Burnet was drawn to the translation of "Utopia" by the same sense of
+unreason in high places that caused More to write the book.  Burnet's is
+the translation given in this volume.
+
+The name of the book has given an adjective to our language--we call an
+impracticable scheme Utopian.  Yet, under the veil of a playful fiction,
+the talk is intensely earnest, and abounds in practical suggestion.  It
+is the work of a scholarly and witty Englishman, who attacks in his own
+way the chief political and social evils of his time.  Beginning with
+fact, More tells how he was sent into Flanders with Cuthbert Tunstal,
+"whom the king's majesty of late, to the great rejoicing of all men, did
+prefer to the office of Master of the Rolls;" how the commissioners of
+Charles met them at Bruges, and presently returned to Brussels for
+instructions; and how More then went to Antwerp, where he found a
+pleasure in the society of Peter Giles which soothed his desire to see
+again his wife and children, from whom he had been four months away.  Then
+fact slides into fiction with the finding of Raphael Hythloday (whose
+name, made of two Greek words [Greek text] and [Greek text], means
+"knowing in trifles"), a man who had been with Amerigo Vespucci in the
+three last of the voyages to the new world lately discovered, of which
+the account had been first printed in 1507, only nine years before Utopia
+was written.
+
+Designedly fantastic in suggestion of details, "Utopia" is the work of a
+scholar who had read Plato's "Republic," and had his fancy quickened
+after reading Plutarch's account of Spartan life under Lycurgus.  Beneath
+the veil of an ideal communism, into which there has been worked some
+witty extravagance, there lies a noble English argument.  Sometimes More
+puts the case as of France when he means England.  Sometimes there is
+ironical praise of the good faith of Christian kings, saving the book
+from censure as a political attack on the policy of Henry VIII.  Erasmus
+wrote to a friend in 1517 that he should send for More's "Utopia," if he
+had not read it, and "wished to see the true source of all political
+evils."  And to More Erasmus wrote of his book, "A burgomaster of Antwerp
+is so pleased with it that he knows it all by heart."
+
+H. M.
+
+
+
+
+DISCOURSES OF RAPHAEL HYTHLODAY, OF THE BEST STATE OF A COMMONWEALTH
+
+
+Henry VIII., the unconquered King of England, a prince adorned with all
+the virtues that become a great monarch, having some differences of no
+small consequence with Charles the most serene Prince of Castile, sent me
+into Flanders, as his ambassador, for treating and composing matters
+between them.  I was colleague and companion to that incomparable man
+Cuthbert Tonstal, whom the King, with such universal applause, lately
+made Master of the Rolls; but of whom I will say nothing; not because I
+fear that the testimony of a friend will be suspected, but rather because
+his learning and virtues are too great for me to do them justice, and so
+well known, that they need not my commendations, unless I would,
+according to the proverb, "Show the sun with a lantern."  Those that were
+appointed by the Prince to treat with us, met us at Bruges, according to
+agreement; they were all worthy men.  The Margrave of Bruges was their
+head, and the chief man among them; but he that was esteemed the wisest,
+and that spoke for the rest, was George Temse, the Provost of Casselsee:
+both art and nature had concurred to make him eloquent: he was very
+learned in the law; and, as he had a great capacity, so, by a long
+practice in affairs, he was very dexterous at unravelling them.  After we
+had several times met, without coming to an agreement, they went to
+Brussels for some days, to know the Prince's pleasure; and, since our
+business would admit it, I went to Antwerp.  While I was there, among
+many that visited me, there was one that was more acceptable to me than
+any other, Peter Giles, born at Antwerp, who is a man of great honour,
+and of a good rank in his town, though less than he deserves; for I do
+not know if there be anywhere to be found a more learned and a better
+bred young man; for as he is both a very worthy and a very knowing
+person, so he is so civil to all men, so particularly kind to his
+friends, and so full of candour and affection, that there is not,
+perhaps, above one or two anywhere to be found, that is in all respects
+so perfect a friend: he is extraordinarily modest, there is no artifice
+in him, and yet no man has more of a prudent simplicity.  His
+conversation was so pleasant and so innocently cheerful, that his company
+in a great measure lessened any longings to go back to my country, and to
+my wife and children, which an absence of four months had quickened very
+much.  One day, as I was returning home from mass at St. Mary's, which is
+the chief church, and the most frequented of any in Antwerp, I saw him,
+by accident, talking with a stranger, who seemed past the flower of his
+age; his face was tanned, he had a long beard, and his cloak was hanging
+carelessly about him, so that, by his looks and habit, I concluded he was
+a seaman.  As soon as Peter saw me, he came and saluted me, and as I was
+returning his civility, he took me aside, and pointing to him with whom
+he had been discoursing, he said, "Do you see that man?  I was just
+thinking to bring him to you."  I answered, "He should have been very
+welcome on your account."  "And on his own too," replied he, "if you knew
+the man, for there is none alive that can give so copious an account of
+unknown nations and countries as he can do, which I know you very much
+desire."  "Then," said I, "I did not guess amiss, for at first sight I
+took him for a seaman."  "But you are much mistaken," said he, "for he
+has not sailed as a seaman, but as a traveller, or rather a philosopher.
+This Raphael, who from his family carries the name of Hythloday, is not
+ignorant of the Latin tongue, but is eminently learned in the Greek,
+having applied himself more particularly to that than to the former,
+because he had given himself much to philosophy, in which he knew that
+the Romans have left us nothing that is valuable, except what is to be
+found in Seneca and Cicero.  He is a Portuguese by birth, and was so
+desirous of seeing the world, that he divided his estate among his
+brothers, ran the same hazard as Americus Vesputius, and bore a share in
+three of his four voyages that are now published; only he did not return
+with him in his last, but obtained leave of him, almost by force, that he
+might be one of those twenty-four who were left at the farthest place at
+which they touched in their last voyage to New Castile.  The leaving him
+thus did not a little gratify one that was more fond of travelling than
+of returning home to be buried in his own country; for he used often to
+say, that the way to heaven was the same from all places, and he that had
+no grave had the heavens still over him.  Yet this disposition of mind
+had cost him dear, if God had not been very gracious to him; for after
+he, with five Castalians, had travelled over many countries, at last, by
+strange good fortune, he got to Ceylon, and from thence to Calicut, where
+he, very happily, found some Portuguese ships; and, beyond all men's
+expectations, returned to his native country."  When Peter had said this
+to me, I thanked him for his kindness in intending to give me the
+acquaintance of a man whose conversation he knew would be so acceptable;
+and upon that Raphael and I embraced each other.  After those civilities
+were past which are usual with strangers upon their first meeting, we all
+went to my house, and entering into the garden, sat down on a green bank
+and entertained one another in discourse.  He told us that when Vesputius
+had sailed away, he, and his companions that stayed behind in New
+Castile, by degrees insinuated themselves into the affections of the
+people of the country, meeting often with them and treating them gently;
+and at last they not only lived among them without danger, but conversed
+familiarly with them, and got so far into the heart of a prince, whose
+name and country I have forgot, that he both furnished them plentifully
+with all things necessary, and also with the conveniences of travelling,
+both boats when they went by water, and waggons when they trained over
+land: he sent with them a very faithful guide, who was to introduce and
+recommend them to such other princes as they had a mind to see: and after
+many days' journey, they came to towns, and cities, and to commonwealths,
+that were both happily governed and well peopled.  Under the equator, and
+as far on both sides of it as the sun moves, there lay vast deserts that
+were parched with the perpetual heat of the sun; the soil was withered,
+all things looked dismally, and all places were either quite uninhabited,
+or abounded with wild beasts and serpents, and some few men, that were
+neither less wild nor less cruel than the beasts themselves.  But, as
+they went farther, a new scene opened, all things grew milder, the air
+less burning, the soil more verdant, and even the beasts were less wild:
+and, at last, there were nations, towns, and cities, that had not only
+mutual commerce among themselves and with their neighbours, but traded,
+both by sea and land, to very remote countries.  There they found the
+conveniencies of seeing many countries on all hands, for no ship went any
+voyage into which he and his companions were not very welcome.  The first
+vessels that they saw were flat-bottomed, their sails were made of reeds
+and wicker, woven close together, only some were of leather; but,
+afterwards, they found ships made with round keels and canvas sails, and
+in all respects like our ships, and the seamen understood both astronomy
+and navigation.  He got wonderfully into their favour by showing them the
+use of the needle, of which till then they were utterly ignorant.  They
+sailed before with great caution, and only in summer time; but now they
+count all seasons alike, trusting wholly to the loadstone, in which they
+are, perhaps, more secure than safe; so that there is reason to fear that
+this discovery, which was thought would prove so much to their advantage,
+may, by their imprudence, become an occasion of much mischief to them.
+But it were too long to dwell on all that he told us he had observed in
+every place, it would be too great a digression from our present purpose:
+whatever is necessary to be told concerning those wise and prudent
+institutions which he observed among civilised nations, may perhaps be
+related by us on a more proper occasion.  We asked him many questions
+concerning all these things, to which he answered very willingly; we made
+no inquiries after monsters, than which nothing is more common; for
+everywhere one may hear of ravenous dogs and wolves, and cruel
+men-eaters, but it is not so easy to find states that are well and wisely
+governed.
+
+As he told us of many things that were amiss in those new-discovered
+countries, so he reckoned up not a few things, from which patterns might
+be taken for correcting the errors of these nations among whom we live;
+of which an account may be given, as I have already promised, at some
+other time; for, at present, I intend only to relate those particulars
+that he told us, of the manners and laws of the Utopians: but I will
+begin with the occasion that led us to speak of that commonwealth.  After
+Raphael had discoursed with great judgment on the many errors that were
+both among us and these nations, had treated of the wise institutions
+both here and there, and had spoken as distinctly of the customs and
+government of every nation through which he had past, as if he had spent
+his whole life in it, Peter, being struck with admiration, said, "I
+wonder, Raphael, how it comes that you enter into no king's service, for
+I am sure there are none to whom you would not be very acceptable; for
+your learning and knowledge, both of men and things, is such, that you
+would not only entertain them very pleasantly, but be of great use to
+them, by the examples you could set before them, and the advices you
+could give them; and by this means you would both serve your own
+interest, and be of great use to all your friends."  "As for my friends,"
+answered he, "I need not be much concerned, having already done for them
+all that was incumbent on me; for when I was not only in good health, but
+fresh and young, I distributed that among my kindred and friends which
+other people do not part with till they are old and sick: when they then
+unwillingly give that which they can enjoy no longer themselves.  I think
+my friends ought to rest contented with this, and not to expect that for
+their sakes I should enslave myself to any king whatsoever."  "Soft and
+fair!" said Peter; "I do not mean that you should be a slave to any king,
+but only that you should assist them and be useful to them."  "The change
+of the word," said he, "does not alter the matter."  "But term it as you
+will," replied Peter, "I do not see any other way in which you can be so
+useful, both in private to your friends and to the public, and by which
+you can make your own condition happier."  "Happier?" answered Raphael,
+"is that to be compassed in a way so abhorrent to my genius?  Now I live
+as I will, to which I believe, few courtiers can pretend; and there are
+so many that court the favour of great men, that there will be no great
+loss if they are not troubled either with me or with others of my
+temper."  Upon this, said I, "I perceive, Raphael, that you neither
+desire wealth nor greatness; and, indeed, I value and admire such a man
+much more than I do any of the great men in the world.  Yet I think you
+would do what would well become so generous and philosophical a soul as
+yours is, if you would apply your time and thoughts to public affairs,
+even though you may happen to find it a little uneasy to yourself; and
+this you can never do with so much advantage as by being taken into the
+council of some great prince and putting him on noble and worthy actions,
+which I know you would do if you were in such a post; for the springs
+both of good and evil flow from the prince over a whole nation, as from a
+lasting fountain.  So much learning as you have, even without practice in
+affairs, or so great a practice as you have had, without any other
+learning, would render you a very fit counsellor to any king whatsoever."
+"You are doubly mistaken," said he, "Mr. More, both in your opinion of me
+and in the judgment you make of things: for as I have not that capacity
+that you fancy I have, so if I had it, the public would not be one jot
+the better when I had sacrificed my quiet to it.  For most princes apply
+themselves more to affairs of war than to the useful arts of peace; and
+in these I neither have any knowledge, nor do I much desire it; they are
+generally more set on acquiring new kingdoms, right or wrong, than on
+governing well those they possess: and, among the ministers of princes,
+there are none that are not so wise as to need no assistance, or at
+least, that do not think themselves so wise that they imagine they need
+none; and if they court any, it is only those for whom the prince has
+much personal favour, whom by their fawning and flatteries they endeavour
+to fix to their own interests; and, indeed, nature has so made us, that
+we all love to be flattered and to please ourselves with our own notions:
+the old crow loves his young, and the ape her cubs.  Now if in such a
+court, made up of persons who envy all others and only admire themselves,
+a person should but propose anything that he had either read in history
+or observed in his travels, the rest would think that the reputation of
+their wisdom would sink, and that their interests would be much depressed
+if they could not run it down: and, if all other things failed, then they
+would fly to this, that such or such things pleased our ancestors, and it
+were well for us if we could but match them.  They would set up their
+rest on such an answer, as a sufficient confutation of all that could be
+said, as if it were a great misfortune that any should be found wiser
+than his ancestors.  But though they willingly let go all the good things
+that were among those of former ages, yet, if better things are proposed,
+they cover themselves obstinately with this excuse of reverence to past
+times.  I have met with these proud, morose, and absurd judgments of
+things in many places, particularly once in England."  "Were you ever
+there?" said I.  "Yes, I was," answered he, "and stayed some months
+there, not long after the rebellion in the West was suppressed, with a
+great slaughter of the poor people that were engaged in it.
+
+"I was then much obliged to that reverend prelate, John Morton,
+Archbishop of Canterbury, Cardinal, and Chancellor of England; a man,"
+said he, "Peter (for Mr. More knows well what he was), that was not less
+venerable for his wisdom and virtues than for the high character he bore:
+he was of a middle stature, not broken with age; his looks begot
+reverence rather than fear; his conversation was easy, but serious and
+grave; he sometimes took pleasure to try the force of those that came as
+suitors to him upon business by speaking sharply, though decently, to
+them, and by that he discovered their spirit and presence of mind; with
+which he was much delighted when it did not grow up to impudence, as
+bearing a great resemblance to his own temper, and he looked on such
+persons as the fittest men for affairs.  He spoke both gracefully and
+weightily; he was eminently skilled in the law, had a vast understanding,
+and a prodigious memory; and those excellent talents with which nature
+had furnished him were improved by study and experience.  When I was in
+England the King depended much on his counsels, and the Government seemed
+to be chiefly supported by him; for from his youth he had been all along
+practised in affairs; and, having passed through many traverses of
+fortune, he had, with great cost, acquired a vast stock of wisdom, which
+is not soon lost when it is purchased so dear.  One day, when I was
+dining with him, there happened to be at table one of the English
+lawyers, who took occasion to run out in a high commendation of the
+severe execution of justice upon thieves, 'who,' as he said, 'were then
+hanged so fast that there were sometimes twenty on one gibbet!' and, upon
+that, he said, 'he could not wonder enough how it came to pass that,
+since so few escaped, there were yet so many thieves left, who were still
+robbing in all places.'  Upon this, I (who took the boldness to speak
+freely before the Cardinal) said, 'There was no reason to wonder at the
+matter, since this way of punishing thieves was neither just in itself
+nor good for the public; for, as the severity was too great, so the
+remedy was not effectual; simple theft not being so great a crime that it
+ought to cost a man his life; no punishment, how severe soever, being
+able to restrain those from robbing who can find out no other way of
+livelihood.  In this,' said I, 'not only you in England, but a great part
+of the world, imitate some ill masters, that are readier to chastise
+their scholars than to teach them.  There are dreadful punishments
+enacted against thieves, but it were much better to make such good
+provisions by which every man might be put in a method how to live, and
+so be preserved from the fatal necessity of stealing and of dying for
+it.'  'There has been care enough taken for that,' said he; 'there are
+many handicrafts, and there is husbandry, by which they may make a shift
+to live, unless they have a greater mind to follow ill courses.'  'That
+will not serve your turn,' said I, 'for many lose their limbs in civil or
+foreign wars, as lately in the Cornish rebellion, and some time ago in
+your wars with France, who, being thus mutilated in the service of their
+king and country, can no more follow their old trades, and are too old to
+learn new ones; but since wars are only accidental things, and have
+intervals, let us consider those things that fall out every day.  There
+is a great number of noblemen among you that are themselves as idle as
+drones, that subsist on other men's labour, on the labour of their
+tenants, whom, to raise their revenues, they pare to the quick.  This,
+indeed, is the only instance of their frugality, for in all other things
+they are prodigal, even to the beggaring of themselves; but, besides
+this, they carry about with them a great number of idle fellows, who
+never learned any art by which they may gain their living; and these, as
+soon as either their lord dies, or they themselves fall sick, are turned
+out of doors; for your lords are readier to feed idle people than to take
+care of the sick; and often the heir is not able to keep together so
+great a family as his predecessor did.  Now, when the stomachs of those
+that are thus turned out of doors grow keen, they rob no less keenly; and
+what else can they do?  For when, by wandering about, they have worn out
+both their health and their clothes, and are tattered, and look ghastly,
+men of quality will not entertain them, and poor men dare not do it,
+knowing that one who has been bred up in idleness and pleasure, and who
+was used to walk about with his sword and buckler, despising all the
+neighbourhood with an insolent scorn as far below him, is not fit for the
+spade and mattock; nor will he serve a poor man for so small a hire and
+in so low a diet as he can afford to give him.'  To this he answered,
+'This sort of men ought to be particularly cherished, for in them
+consists the force of the armies for which we have occasion; since their
+birth inspires them with a nobler sense of honour than is to be found
+among tradesmen or ploughmen.'  'You may as well say,' replied I, 'that
+you must cherish thieves on the account of wars, for you will never want
+the one as long as you have the other; and as robbers prove sometimes
+gallant soldiers, so soldiers often prove brave robbers, so near an
+alliance there is between those two sorts of life.  But this bad custom,
+so common among you, of keeping many servants, is not peculiar to this
+nation.  In France there is yet a more pestiferous sort of people, for
+the whole country is full of soldiers, still kept up in time of peace (if
+such a state of a nation can be called a peace); and these are kept in
+pay upon the same account that you plead for those idle retainers about
+noblemen: this being a maxim of those pretended statesmen, that it is
+necessary for the public safety to have a good body of veteran soldiers
+ever in readiness.  They think raw men are not to be depended on, and
+they sometimes seek occasions for making war, that they may train up
+their soldiers in the art of cutting throats, or, as Sallust observed,
+"for keeping their hands in use, that they may not grow dull by too long
+an intermission."  But France has learned to its cost how dangerous it is
+to feed such beasts.  The fate of the Romans, Carthaginians, and Syrians,
+and many other nations and cities, which were both overturned and quite
+ruined by those standing armies, should make others wiser; and the folly
+of this maxim of the French appears plainly even from this, that their
+trained soldiers often find your raw men prove too hard for them, of
+which I will not say much, lest you may think I flatter the English.
+Every day's experience shows that the mechanics in the towns or the
+clowns in the country are not afraid of fighting with those idle
+gentlemen, if they are not disabled by some misfortune in their body or
+dispirited by extreme want; so that you need not fear that those well-
+shaped and strong men (for it is only such that noblemen love to keep
+about them till they spoil them), who now grow feeble with ease and are
+softened with their effeminate manner of life, would be less fit for
+action if they were well bred and well employed.  And it seems very
+unreasonable that, for the prospect of a war, which you need never have
+but when you please, you should maintain so many idle men, as will always
+disturb you in time of peace, which is ever to be more considered than
+war.  But I do not think that this necessity of stealing arises only from
+hence; there is another cause of it, more peculiar to England.'  'What is
+that?' said the Cardinal: 'The increase of pasture,' said I, 'by which
+your sheep, which are naturally mild, and easily kept in order, may be
+said now to devour men and unpeople, not only villages, but towns; for
+wherever it is found that the sheep of any soil yield a softer and richer
+wool than ordinary, there the nobility and gentry, and even those holy
+men, the dobots! not contented with the old rents which their farms
+yielded, nor thinking it enough that they, living at their ease, do no
+good to the public, resolve to do it hurt instead of good.  They stop the
+course of agriculture, destroying houses and towns, reserving only the
+churches, and enclose grounds that they may lodge their sheep in them.  As
+if forests and parks had swallowed up too little of the land, those
+worthy countrymen turn the best inhabited places into solitudes; for when
+an insatiable wretch, who is a plague to his country, resolves to enclose
+many thousand acres of ground, the owners, as well as tenants, are turned
+out of their possessions by trick or by main force, or, being wearied out
+by ill usage, they are forced to sell them; by which means those
+miserable people, both men and women, married and unmarried, old and
+young, with their poor but numerous families (since country business
+requires many hands), are all forced to change their seats, not knowing
+whither to go; and they must sell, almost for nothing, their household
+stuff, which could not bring them much money, even though they might stay
+for a buyer.  When that little money is at an end (for it will be soon
+spent), what is left for them to do but either to steal, and so to be
+hanged (God knows how justly!), or to go about and beg? and if they do
+this they are put in prison as idle vagabonds, while they would willingly
+work but can find none that will hire them; for there is no more occasion
+for country labour, to which they have been bred, when there is no arable
+ground left.  One shepherd can look after a flock, which will stock an
+extent of ground that would require many hands if it were to be ploughed
+and reaped.  This, likewise, in many places raises the price of corn.  The
+price of wool is also so risen that the poor people, who were wont to
+make cloth, are no more able to buy it; and this, likewise, makes many of
+them idle: for since the increase of pasture God has punished the avarice
+of the owners by a rot among the sheep, which has destroyed vast numbers
+of them--to us it might have seemed more just had it fell on the owners
+themselves.  But, suppose the sheep should increase ever so much, their
+price is not likely to fall; since, though they cannot be called a
+monopoly, because they are not engrossed by one person, yet they are in
+so few hands, and these are so rich, that, as they are not pressed to
+sell them sooner than they have a mind to it, so they never do it till
+they have raised the price as high as possible.  And on the same account
+it is that the other kinds of cattle are so dear, because many villages
+being pulled down, and all country labour being much neglected, there are
+none who make it their business to breed them.  The rich do not breed
+cattle as they do sheep, but buy them lean and at low prices; and, after
+they have fattened them on their grounds, sell them again at high rates.
+And I do not think that all the inconveniences this will produce are yet
+observed; for, as they sell the cattle dear, so, if they are consumed
+faster than the breeding countries from which they are brought can afford
+them, then the stock must decrease, and this must needs end in great
+scarcity; and by these means, this your island, which seemed as to this
+particular the happiest in the world, will suffer much by the cursed
+avarice of a few persons: besides this, the rising of corn makes all
+people lessen their families as much as they can; and what can those who
+are dismissed by them do but either beg or rob?  And to this last a man
+of a great mind is much sooner drawn than to the former.  Luxury likewise
+breaks in apace upon you to set forward your poverty and misery; there is
+an excessive vanity in apparel, and great cost in diet, and that not only
+in noblemen's families, but even among tradesmen, among the farmers
+themselves, and among all ranks of persons.  You have also many infamous
+houses, and, besides those that are known, the taverns and ale-houses are
+no better; add to these dice, cards, tables, football, tennis, and
+quoits, in which money runs fast away; and those that are initiated into
+them must, in the conclusion, betake themselves to robbing for a supply.
+Banish these plagues, and give orders that those who have dispeopled so
+much soil may either rebuild the villages they have pulled down or let
+out their grounds to such as will do it; restrain those engrossings of
+the rich, that are as bad almost as monopolies; leave fewer occasions to
+idleness; let agriculture be set up again, and the manufacture of the
+wool be regulated, that so there may be work found for those companies of
+idle people whom want forces to be thieves, or who now, being idle
+vagabonds or useless servants, will certainly grow thieves at last.  If
+you do not find a remedy to these evils it is a vain thing to boast of
+your severity in punishing theft, which, though it may have the
+appearance of justice, yet in itself is neither just nor convenient; for
+if you suffer your people to be ill-educated, and their manners to be
+corrupted from their infancy, and then punish them for those crimes to
+which their first education disposed them, what else is to be concluded
+from this but that you first make thieves and then punish them?'
+
+"While I was talking thus, the Counsellor, who was present, had prepared
+an answer, and had resolved to resume all I had said, according to the
+formality of a debate, in which things are generally repeated more
+faithfully than they are answered, as if the chief trial to be made were
+of men's memories.  'You have talked prettily, for a stranger,' said he,
+'having heard of many things among us which you have not been able to
+consider well; but I will make the whole matter plain to you, and will
+first repeat in order all that you have said; then I will show how much
+your ignorance of our affairs has misled you; and will, in the last
+place, answer all your arguments.  And, that I may begin where I
+promised, there were four things--'  'Hold your peace!' said the
+Cardinal; 'this will take up too much time; therefore we will, at
+present, ease you of the trouble of answering, and reserve it to our next
+meeting, which shall be to-morrow, if Raphael's affairs and yours can
+admit of it.  But, Raphael,' said he to me, 'I would gladly know upon
+what reason it is that you think theft ought not to be punished by death:
+would you give way to it? or do you propose any other punishment that
+will be more useful to the public? for, since death does not restrain
+theft, if men thought their lives would be safe, what fear or force could
+restrain ill men?  On the contrary, they would look on the mitigation of
+the punishment as an invitation to commit more crimes.'  I answered, 'It
+seems to me a very unjust thing to take away a man's life for a little
+money, for nothing in the world can be of equal value with a man's life:
+and if it be said, "that it is not for the money that one suffers, but
+for his breaking the law," I must say, extreme justice is an extreme
+injury: for we ought not to approve of those terrible laws that make the
+smallest offences capital, nor of that opinion of the Stoics that makes
+all crimes equal; as if there were no difference to be made between the
+killing a man and the taking his purse, between which, if we examine
+things impartially, there is no likeness nor proportion.  God has
+commanded us not to kill, and shall we kill so easily for a little money?
+But if one shall say, that by that law we are only forbid to kill any
+except when the laws of the land allow of it, upon the same grounds, laws
+may be made, in some cases, to allow of adultery and perjury: for God
+having taken from us the right of disposing either of our own or of other
+people's lives, if it is pretended that the mutual consent of men in
+making laws can authorise man-slaughter in cases in which God has given
+us no example, that it frees people from the obligation of the divine
+law, and so makes murder a lawful action, what is this, but to give a
+preference to human laws before the divine? and, if this is once
+admitted, by the same rule men may, in all other things, put what
+restrictions they please upon the laws of God.  If, by the Mosaical law,
+though it was rough and severe, as being a yoke laid on an obstinate and
+servile nation, men were only fined, and not put to death for theft, we
+cannot imagine, that in this new law of mercy, in which God treats us
+with the tenderness of a father, He has given us a greater licence to
+cruelty than He did to the Jews.  Upon these reasons it is, that I think
+putting thieves to death is not lawful; and it is plain and obvious that
+it is absurd and of ill consequence to the commonwealth that a thief and
+a murderer should be equally punished; for if a robber sees that his
+danger is the same if he is convicted of theft as if he were guilty of
+murder, this will naturally incite him to kill the person whom otherwise
+he would only have robbed; since, if the punishment is the same, there is
+more security, and less danger of discovery, when he that can best make
+it is put out of the way; so that terrifying thieves too much provokes
+them to cruelty.
+
+"But as to the question, 'What more convenient way of punishment can be
+found?' I think it much easier to find out that than to invent anything
+that is worse; why should we doubt but the way that was so long in use
+among the old Romans, who understood so well the arts of government, was
+very proper for their punishment?  They condemned such as they found
+guilty of great crimes to work their whole lives in quarries, or to dig
+in mines with chains about them.  But the method that I liked best was
+that which I observed in my travels in Persia, among the Polylerits, who
+are a considerable and well-governed people: they pay a yearly tribute to
+the King of Persia, but in all other respects they are a free nation, and
+governed by their own laws: they lie far from the sea, and are environed
+with hills; and, being contented with the productions of their own
+country, which is very fruitful, they have little commerce with any other
+nation; and as they, according to the genius of their country, have no
+inclination to enlarge their borders, so their mountains and the pension
+they pay to the Persian, secure them from all invasions.  Thus they have
+no wars among them; they live rather conveniently than with splendour,
+and may be rather called a happy nation than either eminent or famous;
+for I do not think that they are known, so much as by name, to any but
+their next neighbours.  Those that are found guilty of theft among them
+are bound to make restitution to the owner, and not, as it is in other
+places, to the prince, for they reckon that the prince has no more right
+to the stolen goods than the thief; but if that which was stolen is no
+more in being, then the goods of the thieves are estimated, and
+restitution being made out of them, the remainder is given to their wives
+and children; and they themselves are condemned to serve in the public
+works, but are neither imprisoned nor chained, unless there happens to be
+some extraordinary circumstance in their crimes.  They go about loose and
+free, working for the public: if they are idle or backward to work they
+are whipped, but if they work hard they are well used and treated without
+any mark of reproach; only the lists of them are called always at night,
+and then they are shut up.  They suffer no other uneasiness but this of
+constant labour; for, as they work for the public, so they are well
+entertained out of the public stock, which is done differently in
+different places: in some places whatever is bestowed on them is raised
+by a charitable contribution; and, though this way may seem uncertain,
+yet so merciful are the inclinations of that people, that they are
+plentifully supplied by it; but in other places public revenues are set
+aside for them, or there is a constant tax or poll-money raised for their
+maintenance.  In some places they are set to no public work, but every
+private man that has occasion to hire workmen goes to the market-places
+and hires them of the public, a little lower than he would do a freeman.
+If they go lazily about their task he may quicken them with the whip.  By
+this means there is always some piece of work or other to be done by
+them; and, besides their livelihood, they earn somewhat still to the
+public.  They all wear a peculiar habit, of one certain colour, and their
+hair is cropped a little above their ears, and a piece of one of their
+ears is cut off.  Their friends are allowed to give them either meat,
+drink, or clothes, so they are of their proper colour; but it is death,
+both to the giver and taker, if they give them money; nor is it less
+penal for any freeman to take money from them upon any account
+whatsoever: and it is also death for any of these slaves (so they are
+called) to handle arms.  Those of every division of the country are
+distinguished by a peculiar mark, which it is capital for them to lay
+aside, to go out of their bounds, or to talk with a slave of another
+jurisdiction, and the very attempt of an escape is no less penal than an
+escape itself.  It is death for any other slave to be accessory to it;
+and if a freeman engages in it he is condemned to slavery.  Those that
+discover it are rewarded--if freemen, in money; and if slaves, with
+liberty, together with a pardon for being accessory to it; that so they
+might find their account rather in repenting of their engaging in such a
+design than in persisting in it.
+
+"These are their laws and rules in relation to robbery, and it is obvious
+that they are as advantageous as they are mild and gentle; since vice is
+not only destroyed and men preserved, but they are treated in such a
+manner as to make them see the necessity of being honest and of employing
+the rest of their lives in repairing the injuries they had formerly done
+to society.  Nor is there any hazard of their falling back to their old
+customs; and so little do travellers apprehend mischief from them that
+they generally make use of them for guides from one jurisdiction to
+another; for there is nothing left them by which they can rob or be the
+better for it, since, as they are disarmed, so the very having of money
+is a sufficient conviction: and as they are certainly punished if
+discovered, so they cannot hope to escape; for their habit being in all
+the parts of it different from what is commonly worn, they cannot fly
+away, unless they would go naked, and even then their cropped ear would
+betray them.  The only danger to be feared from them is their conspiring
+against the government; but those of one division and neighbourhood can
+do nothing to any purpose unless a general conspiracy were laid amongst
+all the slaves of the several jurisdictions, which cannot be done, since
+they cannot meet or talk together; nor will any venture on a design where
+the concealment would be so dangerous and the discovery so profitable.
+None are quite hopeless of recovering their freedom, since by their
+obedience and patience, and by giving good grounds to believe that they
+will change their manner of life for the future, they may expect at last
+to obtain their liberty, and some are every year restored to it upon the
+good character that is given of them.  When I had related all this, I
+added that I did not see why such a method might not be followed with
+more advantage than could ever be expected from that severe justice which
+the Counsellor magnified so much.  To this he answered, 'That it could
+never take place in England without endangering the whole nation.'  As he
+said this he shook his head, made some grimaces, and held his peace,
+while all the company seemed of his opinion, except the Cardinal, who
+said, 'That it was not easy to form a judgment of its success, since it
+was a method that never yet had been tried; but if,' said he, 'when
+sentence of death were passed upon a thief, the prince would reprieve him
+for a while, and make the experiment upon him, denying him the privilege
+of a sanctuary; and then, if it had a good effect upon him, it might take
+place; and, if it did not succeed, the worst would be to execute the
+sentence on the condemned persons at last; and I do not see,' added he,
+'why it would be either unjust, inconvenient, or at all dangerous to
+admit of such a delay; in my opinion the vagabonds ought to be treated in
+the same manner, against whom, though we have made many laws, yet we have
+not been able to gain our end.'  When the Cardinal had done, they all
+commended the motion, though they had despised it when it came from me,
+but more particularly commended what related to the vagabonds, because it
+was his own observation.
+
+"I do not know whether it be worth while to tell what followed, for it
+was very ridiculous; but I shall venture at it, for as it is not foreign
+to this matter, so some good use may be made of it.  There was a Jester
+standing by, that counterfeited the fool so naturally that he seemed to
+be really one; the jests which he offered were so cold and dull that we
+laughed more at him than at them, yet sometimes he said, as it were by
+chance, things that were not unpleasant, so as to justify the old
+proverb, 'That he who throws the dice often, will sometimes have a lucky
+hit.'  When one of the company had said that I had taken care of the
+thieves, and the Cardinal had taken care of the vagabonds, so that there
+remained nothing but that some public provision might be made for the
+poor whom sickness or old age had disabled from labour, 'Leave that to
+me,' said the Fool, 'and I shall take care of them, for there is no sort
+of people whose sight I abhor more, having been so often vexed with them
+and with their sad complaints; but as dolefully soever as they have told
+their tale, they could never prevail so far as to draw one penny from me;
+for either I had no mind to give them anything, or, when I had a mind to
+do it, I had nothing to give them; and they now know me so well that they
+will not lose their labour, but let me pass without giving me any
+trouble, because they hope for nothing--no more, in faith, than if I were
+a priest; but I would have a law made for sending all these beggars to
+monasteries, the men to the Benedictines, to be made lay-brothers, and
+the women to be nuns.'  The Cardinal smiled, and approved of it in jest,
+but the rest liked it in earnest.  There was a divine present, who,
+though he was a grave morose man, yet he was so pleased with this
+reflection that was made on the priests and the monks that he began to
+play with the Fool, and said to him, 'This will not deliver you from all
+beggars, except you take care of us Friars.'  'That is done already,'
+answered the Fool, 'for the Cardinal has provided for you by what he
+proposed for restraining vagabonds and setting them to work, for I know
+no vagabonds like you.'  This was well entertained by the whole company,
+who, looking at the Cardinal, perceived that he was not ill-pleased at
+it; only the Friar himself was vexed, as may be easily imagined, and fell
+into such a passion that he could not forbear railing at the Fool, and
+calling him knave, slanderer, backbiter, and son of perdition, and then
+cited some dreadful threatenings out of the Scriptures against him.  Now
+the Jester thought he was in his element, and laid about him freely.
+'Good Friar,' said he, 'be not angry, for it is written, "In patience
+possess your soul."'  The Friar answered (for I shall give you his own
+words), 'I am not angry, you hangman; at least, I do not sin in it, for
+the Psalmist says, "Be ye angry and sin not."'  Upon this the Cardinal
+admonished him gently, and wished him to govern his passions.  'No, my
+lord,' said he, 'I speak not but from a good zeal, which I ought to have,
+for holy men have had a good zeal, as it is said, "The zeal of thy house
+hath eaten me up;" and we sing in our church that those who mocked Elisha
+as he went up to the house of God felt the effects of his zeal, which
+that mocker, that rogue, that scoundrel, will perhaps feel.'  'You do
+this, perhaps, with a good intention,' said the Cardinal, 'but, in my
+opinion, it were wiser in you, and perhaps better for you, not to engage
+in so ridiculous a contest with a Fool.'  'No, my lord,' answered he,
+'that were not wisely done, for Solomon, the wisest of men, said, "Answer
+a Fool according to his folly," which I now do, and show him the ditch
+into which he will fall, if he is not aware of it; for if the many
+mockers of Elisha, who was but one bald man, felt the effect of his zeal,
+what will become of the mocker of so many Friars, among whom there are so
+many bald men?  We have, likewise, a bull, by which all that jeer us are
+excommunicated.'  When the Cardinal saw that there was no end of this
+matter he made a sign to the Fool to withdraw, turned the discourse
+another way, and soon after rose from the table, and, dismissing us, went
+to hear causes.
+
+"Thus, Mr. More, I have run out into a tedious story, of the length of
+which I had been ashamed, if (as you earnestly begged it of me) I had not
+observed you to hearken to it as if you had no mind to lose any part of
+it.  I might have contracted it, but I resolved to give it you at large,
+that you might observe how those that despised what I had proposed, no
+sooner perceived that the Cardinal did not dislike it but presently
+approved of it, fawned so on him and flattered him to such a degree, that
+they in good earnest applauded those things that he only liked in jest;
+and from hence you may gather how little courtiers would value either me
+or my counsels."
+
+To this I answered, "You have done me a great kindness in this relation;
+for as everything has been related by you both wisely and pleasantly, so
+you have made me imagine that I was in my own country and grown young
+again, by recalling that good Cardinal to my thoughts, in whose family I
+was bred from my childhood; and though you are, upon other accounts, very
+dear to me, yet you are the dearer because you honour his memory so much;
+but, after all this, I cannot change my opinion, for I still think that
+if you could overcome that aversion which you have to the courts of
+princes, you might, by the advice which it is in your power to give, do a
+great deal of good to mankind, and this is the chief design that every
+good man ought to propose to himself in living; for your friend Plato
+thinks that nations will be happy when either philosophers become kings
+or kings become philosophers.  It is no wonder if we are so far from that
+happiness while philosophers will not think it their duty to assist kings
+with their counsels."  "They are not so base-minded," said he, "but that
+they would willingly do it; many of them have already done it by their
+books, if those that are in power would but hearken to their good advice.
+But Plato judged right, that except kings themselves became philosophers,
+they who from their childhood are corrupted with false notions would
+never fall in entirely with the counsels of philosophers, and this he
+himself found to be true in the person of Dionysius.
+
+"Do not you think that if I were about any king, proposing good laws to
+him, and endeavouring to root out all the cursed seeds of evil that I
+found in him, I should either be turned out of his court, or, at least,
+be laughed at for my pains?  For instance, what could I signify if I were
+about the King of France, and were called into his cabinet council, where
+several wise men, in his hearing, were proposing many expedients; as, by
+what arts and practices Milan may be kept, and Naples, that has so often
+slipped out of their hands, recovered; how the Venetians, and after them
+the rest of Italy, may be subdued; and then how Flanders, Brabant, and
+all Burgundy, and some other kingdoms which he has swallowed already in
+his designs, may be added to his empire?  One proposes a league with the
+Venetians, to be kept as long as he finds his account in it, and that he
+ought to communicate counsels with them, and give them some share of the
+spoil till his success makes him need or fear them less, and then it will
+be easily taken out of their hands; another proposes the hiring the
+Germans and the securing the Switzers by pensions; another proposes the
+gaining the Emperor by money, which is omnipotent with him; another
+proposes a peace with the King of Arragon, and, in order to cement it,
+the yielding up the King of Navarre's pretensions; another thinks that
+the Prince of Castile is to be wrought on by the hope of an alliance, and
+that some of his courtiers are to be gained to the French faction by
+pensions.  The hardest point of all is, what to do with England; a treaty
+of peace is to be set on foot, and, if their alliance is not to be
+depended on, yet it is to be made as firm as possible, and they are to be
+called friends, but suspected as enemies: therefore the Scots are to be
+kept in readiness to be let loose upon England on every occasion; and
+some banished nobleman is to be supported underhand (for by the League it
+cannot be done avowedly) who has a pretension to the crown, by which
+means that suspected prince may be kept in awe.  Now when things are in
+so great a fermentation, and so many gallant men are joining counsels how
+to carry on the war, if so mean a man as I should stand up and wish them
+to change all their counsels--to let Italy alone and stay at home, since
+the kingdom of France was indeed greater than could be well governed by
+one man; that therefore he ought not to think of adding others to it; and
+if, after this, I should propose to them the resolutions of the
+Achorians, a people that lie on the south-east of Utopia, who long ago
+engaged in war in order to add to the dominions of their prince another
+kingdom, to which he had some pretensions by an ancient alliance: this
+they conquered, but found that the trouble of keeping it was equal to
+that by which it was gained; that the conquered people were always either
+in rebellion or exposed to foreign invasions, while they were obliged to
+be incessantly at war, either for or against them, and consequently could
+never disband their army; that in the meantime they were oppressed with
+taxes, their money went out of the kingdom, their blood was spilt for the
+glory of their king without procuring the least advantage to the people,
+who received not the smallest benefit from it even in time of peace; and
+that, their manners being corrupted by a long war, robbery and murders
+everywhere abounded, and their laws fell into contempt; while their king,
+distracted with the care of two kingdoms, was the less able to apply his
+mind to the interest of either.  When they saw this, and that there would
+be no end to these evils, they by joint counsels made an humble address
+to their king, desiring him to choose which of the two kingdoms he had
+the greatest mind to keep, since he could not hold both; for they were
+too great a people to be governed by a divided king, since no man would
+willingly have a groom that should be in common between him and another.
+Upon which the good prince was forced to quit his new kingdom to one of
+his friends (who was not long after dethroned), and to be contented with
+his old one.  To this I would add that after all those warlike attempts,
+the vast confusions, and the consumption both of treasure and of people
+that must follow them, perhaps upon some misfortune they might be forced
+to throw up all at last; therefore it seemed much more eligible that the
+king should improve his ancient kingdom all he could, and make it
+flourish as much as possible; that he should love his people, and be
+beloved of them; that he should live among them, govern them gently and
+let other kingdoms alone, since that which had fallen to his share was
+big enough, if not too big, for him:--pray, how do you think would such a
+speech as this be heard?"
+
+"I confess," said I, "I think not very well."
+
+"But what," said he, "if I should sort with another kind of ministers,
+whose chief contrivances and consultations were by what art the prince's
+treasures might be increased? where one proposes raising the value of
+specie when the king's debts are large, and lowering it when his revenues
+were to come in, that so he might both pay much with a little, and in a
+little receive a great deal.  Another proposes a pretence of a war, that
+money might be raised in order to carry it on, and that a peace be
+concluded as soon as that was done; and this with such appearances of
+religion as might work on the people, and make them impute it to the
+piety of their prince, and to his tenderness for the lives of his
+subjects.  A third offers some old musty laws that have been antiquated
+by a long disuse (and which, as they had been forgotten by all the
+subjects, so they had also been broken by them), and proposes the levying
+the penalties of these laws, that, as it would bring in a vast treasure,
+so there might be a very good pretence for it, since it would look like
+the executing a law and the doing of justice.  A fourth proposes the
+prohibiting of many things under severe penalties, especially such as
+were against the interest of the people, and then the dispensing with
+these prohibitions, upon great compositions, to those who might find
+their advantage in breaking them.  This would serve two ends, both of
+them acceptable to many; for as those whose avarice led them to
+transgress would be severely fined, so the selling licences dear would
+look as if a prince were tender of his people, and would not easily, or
+at low rates, dispense with anything that might be against the public
+good.  Another proposes that the judges must be made sure, that they may
+declare always in favour of the prerogative; that they must be often sent
+for to court, that the king may hear them argue those points in which he
+is concerned; since, how unjust soever any of his pretensions may be, yet
+still some one or other of them, either out of contradiction to others,
+or the pride of singularity, or to make their court, would find out some
+pretence or other to give the king a fair colour to carry the point.  For
+if the judges but differ in opinion, the clearest thing in the world is
+made by that means disputable, and truth being once brought in question,
+the king may then take advantage to expound the law for his own profit;
+while the judges that stand out will be brought over, either through fear
+or modesty; and they being thus gained, all of them may be sent to the
+Bench to give sentence boldly as the king would have it; for fair
+pretences will never be wanting when sentence is to be given in the
+prince's favour.  It will either be said that equity lies of his side, or
+some words in the law will be found sounding that way, or some forced
+sense will be put on them; and, when all other things fail, the king's
+undoubted prerogative will be pretended, as that which is above all law,
+and to which a religious judge ought to have a special regard.  Thus all
+consent to that maxim of Crassus, that a prince cannot have treasure
+enough, since he must maintain his armies out of it; that a king, even
+though he would, can do nothing unjustly; that all property is in him,
+not excepting the very persons of his subjects; and that no man has any
+other property but that which the king, out of his goodness, thinks fit
+to leave him.  And they think it is the prince's interest that there be
+as little of this left as may be, as if it were his advantage that his
+people should have neither riches nor liberty, since these things make
+them less easy and willing to submit to a cruel and unjust government.
+Whereas necessity and poverty blunts them, makes them patient, beats them
+down, and breaks that height of spirit that might otherwise dispose them
+to rebel.  Now what if, after all these propositions were made, I should
+rise up and assert that such counsels were both unbecoming a king and
+mischievous to him; and that not only his honour, but his safety,
+consisted more in his people's wealth than in his own; if I should show
+that they choose a king for their own sake, and not for his; that, by his
+care and endeavours, they may be both easy and safe; and that, therefore,
+a prince ought to take more care of his people's happiness than of his
+own, as a shepherd is to take more care of his flock than of himself?  It
+is also certain that they are much mistaken that think the poverty of a
+nation is a mean of the public safety.  Who quarrel more than beggars?
+who does more earnestly long for a change than he that is uneasy in his
+present circumstances? and who run to create confusions with so desperate
+a boldness as those who, having nothing to lose, hope to gain by them?  If
+a king should fall under such contempt or envy that he could not keep his
+subjects in their duty but by oppression and ill usage, and by rendering
+them poor and miserable, it were certainly better for him to quit his
+kingdom than to retain it by such methods as make him, while he keeps the
+name of authority, lose the majesty due to it.  Nor is it so becoming the
+dignity of a king to reign over beggars as over rich and happy subjects.
+And therefore Fabricius, a man of a noble and exalted temper, said 'he
+would rather govern rich men than be rich himself; since for one man to
+abound in wealth and pleasure when all about him are mourning and
+groaning, is to be a gaoler and not a king.'  He is an unskilful
+physician that cannot cure one disease without casting his patient into
+another.  So he that can find no other way for correcting the errors of
+his people but by taking from them the conveniences of life, shows that
+he knows not what it is to govern a free nation.  He himself ought rather
+to shake off his sloth, or to lay down his pride, for the contempt or
+hatred that his people have for him takes its rise from the vices in
+himself.  Let him live upon what belongs to him without wronging others,
+and accommodate his expense to his revenue.  Let him punish crimes, and,
+by his wise conduct, let him endeavour to prevent them, rather than be
+severe when he has suffered them to be too common.  Let him not rashly
+revive laws that are abrogated by disuse, especially if they have been
+long forgotten and never wanted.  And let him never take any penalty for
+the breach of them to which a judge would not give way in a private man,
+but would look on him as a crafty and unjust person for pretending to it.
+To these things I would add that law among the Macarians--a people that
+live not far from Utopia--by which their king, on the day on which he
+began to reign, is tied by an oath, confirmed by solemn sacrifices, never
+to have at once above a thousand pounds of gold in his treasures, or so
+much silver as is equal to that in value.  This law, they tell us, was
+made by an excellent king who had more regard to the riches of his
+country than to his own wealth, and therefore provided against the
+heaping up of so much treasure as might impoverish the people.  He
+thought that moderate sum might be sufficient for any accident, if either
+the king had occasion for it against the rebels, or the kingdom against
+the invasion of an enemy; but that it was not enough to encourage a
+prince to invade other men's rights--a circumstance that was the chief
+cause of his making that law.  He also thought that it was a good
+provision for that free circulation of money so necessary for the course
+of commerce and exchange.  And when a king must distribute all those
+extraordinary accessions that increase treasure beyond the due pitch, it
+makes him less disposed to oppress his subjects.  Such a king as this
+will be the terror of ill men, and will be beloved by all the good.
+
+"If, I say, I should talk of these or such-like things to men that had
+taken their bias another way, how deaf would they be to all I could say!"
+"No doubt, very deaf," answered I; "and no wonder, for one is never to
+offer propositions or advice that we are certain will not be entertained.
+Discourses so much out of the road could not avail anything, nor have any
+effect on men whose minds were prepossessed with different sentiments.
+This philosophical way of speculation is not unpleasant among friends in
+a free conversation; but there is no room for it in the courts of
+princes, where great affairs are carried on by authority."  "That is what
+I was saying," replied he, "that there is no room for philosophy in the
+courts of princes."  "Yes, there is," said I, "but not for this
+speculative philosophy, that makes everything to be alike fitting at all
+times; but there is another philosophy that is more pliable, that knows
+its proper scene, accommodates itself to it, and teaches a man with
+propriety and decency to act that part which has fallen to his share.  If
+when one of Plautus' comedies is upon the stage, and a company of
+servants are acting their parts, you should come out in the garb of a
+philosopher, and repeat, out of _Octavia_, a discourse of Seneca's to
+Nero, would it not be better for you to say nothing than by mixing things
+of such different natures to make an impertinent tragi-comedy? for you
+spoil and corrupt the play that is in hand when you mix with it things of
+an opposite nature, even though they are much better.  Therefore go
+through with the play that is acting the best you can, and do not
+confound it because another that is pleasanter comes into your thoughts.
+It is even so in a commonwealth and in the councils of princes; if ill
+opinions cannot be quite rooted out, and you cannot cure some received
+vice according to your wishes, you must not, therefore, abandon the
+commonwealth, for the same reasons as you should not forsake the ship in
+a storm because you cannot command the winds.  You are not obliged to
+assault people with discourses that are out of their road, when you see
+that their received notions must prevent your making an impression upon
+them: you ought rather to cast about and to manage things with all the
+dexterity in your power, so that, if you are not able to make them go
+well, they may be as little ill as possible; for, except all men were
+good, everything cannot be right, and that is a blessing that I do not at
+present hope to see."  "According to your argument," answered he, "all
+that I could be able to do would be to preserve myself from being mad
+while I endeavoured to cure the madness of others; for, if I speak with,
+I must repeat what I have said to you; and as for lying, whether a
+philosopher can do it or not I cannot tell: I am sure I cannot do it.  But
+though these discourses may be uneasy and ungrateful to them, I do not
+see why they should seem foolish or extravagant; indeed, if I should
+either propose such things as Plato has contrived in his 'Commonwealth,'
+or as the Utopians practise in theirs, though they might seem better, as
+certainly they are, yet they are so different from our establishment,
+which is founded on property (there being no such thing among them), that
+I could not expect that it would have any effect on them.  But such
+discourses as mine, which only call past evils to mind and give warning
+of what may follow, leave nothing in them that is so absurd that they may
+not be used at any time, for they can only be unpleasant to those who are
+resolved to run headlong the contrary way; and if we must let alone
+everything as absurd or extravagant--which, by reason of the wicked lives
+of many, may seem uncouth--we must, even among Christians, give over
+pressing the greatest part of those things that Christ hath taught us,
+though He has commanded us not to conceal them, but to proclaim on the
+housetops that which He taught in secret.  The greatest parts of His
+precepts are more opposite to the lives of the men of this age than any
+part of my discourse has been, but the preachers seem to have learned
+that craft to which you advise me: for they, observing that the world
+would not willingly suit their lives to the rules that Christ has given,
+have fitted His doctrine, as if it had been a leaden rule, to their
+lives, that so, some way or other, they might agree with one another.  But
+I see no other effect of this compliance except it be that men become
+more secure in their wickedness by it; and this is all the success that I
+can have in a court, for I must always differ from the rest, and then I
+shall signify nothing; or, if I agree with them, I shall then only help
+forward their madness.  I do not comprehend what you mean by your
+'casting about,' or by 'the bending and handling things so dexterously
+that, if they go not well, they may go as little ill as may be;' for in
+courts they will not bear with a man's holding his peace or conniving at
+what others do: a man must barefacedly approve of the worst counsels and
+consent to the blackest designs, so that he would pass for a spy, or,
+possibly, for a traitor, that did but coldly approve of such wicked
+practices; and therefore when a man is engaged in such a society, he will
+be so far from being able to mend matters by his 'casting about,' as you
+call it, that he will find no occasions of doing any good--the ill
+company will sooner corrupt him than be the better for him; or if,
+notwithstanding all their ill company, he still remains steady and
+innocent, yet their follies and knavery will be imputed to him; and, by
+mixing counsels with them, he must bear his share of all the blame that
+belongs wholly to others.
+
+"It was no ill simile by which Plato set forth the unreasonableness of a
+philosopher's meddling with government.  'If a man,' says he, 'were to
+see a great company run out every day into the rain and take delight in
+being wet--if he knew that it would be to no purpose for him to go and
+persuade them to return to their houses in order to avoid the storm, and
+that all that could be expected by his going to speak to them would be
+that he himself should be as wet as they, it would be best for him to
+keep within doors, and, since he had not influence enough to correct
+other people's folly, to take care to preserve himself.'
+
+"Though, to speak plainly my real sentiments, I must freely own that as
+long as there is any property, and while money is the standard of all
+other things, I cannot think that a nation can be governed either justly
+or happily: not justly, because the best things will fall to the share of
+the worst men; nor happily, because all things will be divided among a
+few (and even these are not in all respects happy), the rest being left
+to be absolutely miserable.  Therefore, when I reflect on the wise and
+good constitution of the Utopians, among whom all things are so well
+governed and with so few laws, where virtue hath its due reward, and yet
+there is such an equality that every man lives in plenty--when I compare
+with them so many other nations that are still making new laws, and yet
+can never bring their constitution to a right regulation; where,
+notwithstanding every one has his property, yet all the laws that they
+can invent have not the power either to obtain or preserve it, or even to
+enable men certainly to distinguish what is their own from what is
+another's, of which the many lawsuits that every day break out, and are
+eternally depending, give too plain a demonstration--when, I say, I
+balance all these things in my thoughts, I grow more favourable to Plato,
+and do not wonder that he resolved not to make any laws for such as would
+not submit to a community of all things; for so wise a man could not but
+foresee that the setting all upon a level was the only way to make a
+nation happy; which cannot be obtained so long as there is property, for
+when every man draws to himself all that he can compass, by one title or
+another, it must needs follow that, how plentiful soever a nation may be,
+yet a few dividing the wealth of it among themselves, the rest must fall
+into indigence.  So that there will be two sorts of people among them,
+who deserve that their fortunes should be interchanged--the former
+useless, but wicked and ravenous; and the latter, who by their constant
+industry serve the public more than themselves, sincere and modest
+men--from whence I am persuaded that till property is taken away, there
+can be no equitable or just distribution of things, nor can the world be
+happily governed; for as long as that is maintained, the greatest and the
+far best part of mankind, will be still oppressed with a load of cares
+and anxieties.  I confess, without taking it quite away, those pressures
+that lie on a great part of mankind may be made lighter, but they can
+never be quite removed; for if laws were made to determine at how great
+an extent in soil, and at how much money, every man must stop--to limit
+the prince, that he might not grow too great; and to restrain the people,
+that they might not become too insolent--and that none might factiously
+aspire to public employments, which ought neither to be sold nor made
+burdensome by a great expense, since otherwise those that serve in them
+would be tempted to reimburse themselves by cheats and violence, and it
+would become necessary to find out rich men for undergoing those
+employments, which ought rather to be trusted to the wise.  These laws, I
+say, might have such effect as good diet and care might have on a sick
+man whose recovery is desperate; they might allay and mitigate the
+disease, but it could never be quite healed, nor the body politic be
+brought again to a good habit as long as property remains; and it will
+fall out, as in a complication of diseases, that by applying a remedy to
+one sore you will provoke another, and that which removes the one ill
+symptom produces others, while the strengthening one part of the body
+weakens the rest."  "On the contrary," answered I, "it seems to me that
+men cannot live conveniently where all things are common.  How can there
+be any plenty where every man will excuse himself from labour? for as the
+hope of gain doth not excite him, so the confidence that he has in other
+men's industry may make him slothful.  If people come to be pinched with
+want, and yet cannot dispose of anything as their own, what can follow
+upon this but perpetual sedition and bloodshed, especially when the
+reverence and authority due to magistrates falls to the ground? for I
+cannot imagine how that can be kept up among those that are in all things
+equal to one another."  "I do not wonder," said he, "that it appears so
+to you, since you have no notion, or at least no right one, of such a
+constitution; but if you had been in Utopia with me, and had seen their
+laws and rules, as I did, for the space of five years, in which I lived
+among them, and during which time I was so delighted with them that
+indeed I should never have left them if it had not been to make the
+discovery of that new world to the Europeans, you would then confess that
+you had never seen a people so well constituted as they."  "You will not
+easily persuade me," said Peter, "that any nation in that new world is
+better governed than those among us; for as our understandings are not
+worse than theirs, so our government (if I mistake not) being more
+ancient, a long practice has helped us to find out many conveniences of
+life, and some happy chances have discovered other things to us which no
+man's understanding could ever have invented."  "As for the antiquity
+either of their government or of ours," said he, "you cannot pass a true
+judgment of it unless you had read their histories; for, if they are to
+be believed, they had towns among them before these parts were so much as
+inhabited; and as for those discoveries that have been either hit on by
+chance or made by ingenious men, these might have happened there as well
+as here.  I do not deny but we are more ingenious than they are, but they
+exceed us much in industry and application.  They knew little concerning
+us before our arrival among them.  They call us all by a general name of
+'The nations that lie beyond the equinoctial line;' for their chronicle
+mentions a shipwreck that was made on their coast twelve hundred years
+ago, and that some Romans and Egyptians that were in the ship, getting
+safe ashore, spent the rest of their days amongst them; and such was
+their ingenuity that from this single opportunity they drew the advantage
+of learning from those unlooked-for guests, and acquired all the useful
+arts that were then among the Romans, and which were known to these
+shipwrecked men; and by the hints that they gave them they themselves
+found out even some of those arts which they could not fully explain, so
+happily did they improve that accident of having some of our people cast
+upon their shore.  But if such an accident has at any time brought any
+from thence into Europe, we have been so far from improving it that we do
+not so much as remember it, as, in aftertimes perhaps, it will be forgot
+by our people that I was ever there; for though they, from one such
+accident, made themselves masters of all the good inventions that were
+among us, yet I believe it would be long before we should learn or put in
+practice any of the good institutions that are among them.  And this is
+the true cause of their being better governed and living happier than we,
+though we come not short of them in point of understanding or outward
+advantages."  Upon this I said to him, "I earnestly beg you would
+describe that island very particularly to us; be not too short, but set
+out in order all things relating to their soil, their rivers, their
+towns, their people, their manners, constitution, laws, and, in a word,
+all that you imagine we desire to know; and you may well imagine that we
+desire to know everything concerning them of which we are hitherto
+ignorant."  "I will do it very willingly," said he, "for I have digested
+the whole matter carefully, but it will take up some time."  "Let us go,
+then," said I, "first and dine, and then we shall have leisure enough."
+He consented; we went in and dined, and after dinner came back and sat
+down in the same place.  I ordered my servants to take care that none
+might come and interrupt us, and both Peter and I desired Raphael to be
+as good as his word.  When he saw that we were very intent upon it he
+paused a little to recollect himself, and began in this manner:--
+
+"The island of Utopia is in the middle two hundred miles broad, and holds
+almost at the same breadth over a great part of it, but it grows narrower
+towards both ends.  Its figure is not unlike a crescent.  Between its
+horns the sea comes in eleven miles broad, and spreads itself into a
+great bay, which is environed with land to the compass of about five
+hundred miles, and is well secured from winds.  In this bay there is no
+great current; the whole coast is, as it were, one continued harbour,
+which gives all that live in the island great convenience for mutual
+commerce.  But the entry into the bay, occasioned by rocks on the one
+hand and shallows on the other, is very dangerous.  In the middle of it
+there is one single rock which appears above water, and may, therefore,
+easily be avoided; and on the top of it there is a tower, in which a
+garrison is kept; the other rocks lie under water, and are very
+dangerous.  The channel is known only to the natives; so that if any
+stranger should enter into the bay without one of their pilots he would
+run great danger of shipwreck.  For even they themselves could not pass
+it safe if some marks that are on the coast did not direct their way; and
+if these should be but a little shifted, any fleet that might come
+against them, how great soever it were, would be certainly lost.  On the
+other side of the island there are likewise many harbours; and the coast
+is so fortified, both by nature and art, that a small number of men can
+hinder the descent of a great army.  But they report (and there remains
+good marks of it to make it credible) that this was no island at first,
+but a part of the continent.  Utopus, that conquered it (whose name it
+still carries, for Abraxa was its first name), brought the rude and
+uncivilised inhabitants into such a good government, and to that measure
+of politeness, that they now far excel all the rest of mankind.  Having
+soon subdued them, he designed to separate them from the continent, and
+to bring the sea quite round them.  To accomplish this he ordered a deep
+channel to be dug, fifteen miles long; and that the natives might not
+think he treated them like slaves, he not only forced the inhabitants,
+but also his own soldiers, to labour in carrying it on.  As he set a vast
+number of men to work, he, beyond all men's expectations, brought it to a
+speedy conclusion.  And his neighbours, who at first laughed at the folly
+of the undertaking, no sooner saw it brought to perfection than they were
+struck with admiration and terror.
+
+"There are fifty-four cities in the island, all large and well built, the
+manners, customs, and laws of which are the same, and they are all
+contrived as near in the same manner as the ground on which they stand
+will allow.  The nearest lie at least twenty-four miles' distance from
+one another, and the most remote are not so far distant but that a man
+can go on foot in one day from it to that which lies next it.  Every city
+sends three of their wisest senators once a year to Amaurot, to consult
+about their common concerns; for that is the chief town of the island,
+being situated near the centre of it, so that it is the most convenient
+place for their assemblies.  The jurisdiction of every city extends at
+least twenty miles, and, where the towns lie wider, they have much more
+ground.  No town desires to enlarge its bounds, for the people consider
+themselves rather as tenants than landlords.  They have built, over all
+the country, farmhouses for husbandmen, which are well contrived, and
+furnished with all things necessary for country labour.  Inhabitants are
+sent, by turns, from the cities to dwell in them; no country family has
+fewer than forty men and women in it, besides two slaves.  There is a
+master and a mistress set over every family, and over thirty families
+there is a magistrate.  Every year twenty of this family come back to the
+town after they have stayed two years in the country, and in their room
+there are other twenty sent from the town, that they may learn country
+work from those that have been already one year in the country, as they
+must teach those that come to them the next from the town.  By this means
+such as dwell in those country farms are never ignorant of agriculture,
+and so commit no errors which might otherwise be fatal and bring them
+under a scarcity of corn.  But though there is every year such a shifting
+of the husbandmen to prevent any man being forced against his will to
+follow that hard course of life too long, yet many among them take such
+pleasure in it that they desire leave to continue in it many years.  These
+husbandmen till the ground, breed cattle, hew wood, and convey it to the
+towns either by land or water, as is most convenient.  They breed an
+infinite multitude of chickens in a very curious manner; for the hens do
+not sit and hatch them, but a vast number of eggs are laid in a gentle
+and equal heat in order to be hatched, and they are no sooner out of the
+shell, and able to stir about, but they seem to consider those that feed
+them as their mothers, and follow them as other chickens do the hen that
+hatched them.  They breed very few horses, but those they have are full
+of mettle, and are kept only for exercising their youth in the art of
+sitting and riding them; for they do not put them to any work, either of
+ploughing or carriage, in which they employ oxen.  For though their
+horses are stronger, yet they find oxen can hold out longer; and as they
+are not subject to so many diseases, so they are kept upon a less charge
+and with less trouble.  And even when they are so worn out that they are
+no more fit for labour, they are good meat at last.  They sow no corn but
+that which is to be their bread; for they drink either wine, cider or
+perry, and often water, sometimes boiled with honey or liquorice, with
+which they abound; and though they know exactly how much corn will serve
+every town and all that tract of country which belongs to it, yet they
+sow much more and breed more cattle than are necessary for their
+consumption, and they give that overplus of which they make no use to
+their neighbours.  When they want anything in the country which it does
+not produce, they fetch that from the town, without carrying anything in
+exchange for it.  And the magistrates of the town take care to see it
+given them; for they meet generally in the town once a month, upon a
+festival day.  When the time of harvest comes, the magistrates in the
+country send to those in the towns and let them know how many hands they
+will need for reaping the harvest; and the number they call for being
+sent to them, they commonly despatch it all in one day.
+
+
+
+OF THEIR TOWNS, PARTICULARLY OF AMAUROT
+
+
+"He that knows one of their towns knows them all--they are so like one
+another, except where the situation makes some difference.  I shall
+therefore describe one of them, and none is so proper as Amaurot; for as
+none is more eminent (all the rest yielding in precedence to this,
+because it is the seat of their supreme council), so there was none of
+them better known to me, I having lived five years all together in it.
+
+"It lies upon the side of a hill, or, rather, a rising ground.  Its
+figure is almost square, for from the one side of it, which shoots up
+almost to the top of the hill, it runs down, in a descent for two miles,
+to the river Anider; but it is a little broader the other way that runs
+along by the bank of that river.  The Anider rises about eighty miles
+above Amaurot, in a small spring at first.  But other brooks falling into
+it, of which two are more considerable than the rest, as it runs by
+Amaurot it is grown half a mile broad; but, it still grows larger and
+larger, till, after sixty miles' course below it, it is lost in the
+ocean.  Between the town and the sea, and for some miles above the town,
+it ebbs and flows every six hours with a strong current.  The tide comes
+up about thirty miles so full that there is nothing but salt water in the
+river, the fresh water being driven back with its force; and above that,
+for some miles, the water is brackish; but a little higher, as it runs by
+the town, it is quite fresh; and when the tide ebbs, it continues fresh
+all along to the sea.  There is a bridge cast over the river, not of
+timber, but of fair stone, consisting of many stately arches; it lies at
+that part of the town which is farthest from the sea, so that the ships,
+without any hindrance, lie all along the side of the town.  There is,
+likewise, another river that runs by it, which, though it is not great,
+yet it runs pleasantly, for it rises out of the same hill on which the
+town stands, and so runs down through it and falls into the Anider.  The
+inhabitants have fortified the fountain-head of this river, which springs
+a little without the towns; that so, if they should happen to be
+besieged, the enemy might not be able to stop or divert the course of the
+water, nor poison it; from thence it is carried, in earthen pipes, to the
+lower streets.  And for those places of the town to which the water of
+that small river cannot be conveyed, they have great cisterns for
+receiving the rain-water, which supplies the want of the other.  The town
+is compassed with a high and thick wall, in which there are many towers
+and forts; there is also a broad and deep dry ditch, set thick with
+thorns, cast round three sides of the town, and the river is instead of a
+ditch on the fourth side.  The streets are very convenient for all
+carriage, and are well sheltered from the winds.  Their buildings are
+good, and are so uniform that a whole side of a street looks like one
+house.  The streets are twenty feet broad; there lie gardens behind all
+their houses.  These are large, but enclosed with buildings, that on all
+hands face the streets, so that every house has both a door to the street
+and a back door to the garden.  Their doors have all two leaves, which,
+as they are easily opened, so they shut of their own accord; and, there
+being no property among them, every man may freely enter into any house
+whatsoever.  At every ten years' end they shift their houses by lots.
+They cultivate their gardens with great care, so that they have both
+vines, fruits, herbs, and flowers in them; and all is so well ordered and
+so finely kept that I never saw gardens anywhere that were both so
+fruitful and so beautiful as theirs.  And this humour of ordering their
+gardens so well is not only kept up by the pleasure they find in it, but
+also by an emulation between the inhabitants of the several streets, who
+vie with each other.  And there is, indeed, nothing belonging to the
+whole town that is both more useful and more pleasant.  So that he who
+founded the town seems to have taken care of nothing more than of their
+gardens; for they say the whole scheme of the town was designed at first
+by Utopus, but he left all that belonged to the ornament and improvement
+of it to be added by those that should come after him, that being too
+much for one man to bring to perfection.  Their records, that contain the
+history of their town and State, are preserved with an exact care, and
+run backwards seventeen hundred and sixty years.  From these it appears
+that their houses were at first low and mean, like cottages, made of any
+sort of timber, and were built with mud walls and thatched with straw.
+But now their houses are three storeys high, the fronts of them are faced
+either with stone, plastering, or brick, and between the facings of their
+walls they throw in their rubbish.  Their roofs are flat, and on them
+they lay a sort of plaster, which costs very little, and yet is so
+tempered that it is not apt to take fire, and yet resists the weather
+more than lead.  They have great quantities of glass among them, with
+which they glaze their windows; they use also in their windows a thin
+linen cloth, that is so oiled or gummed that it both keeps out the wind
+and gives free admission to the light.
+
+
+
+OF THEIR MAGISTRATES
+
+
+"Thirty families choose every year a magistrate, who was anciently called
+the Syphogrant, but is now called the Philarch; and over every ten
+Syphogrants, with the families subject to them, there is another
+magistrate, who was anciently called the Tranibore, but of late the
+Archphilarch.  All the Syphogrants, who are in number two hundred, choose
+the Prince out of a list of four who are named by the people of the four
+divisions of the city; but they take an oath, before they proceed to an
+election, that they will choose him whom they think most fit for the
+office: they give him their voices secretly, so that it is not known for
+whom every one gives his suffrage.  The Prince is for life, unless he is
+removed upon suspicion of some design to enslave the people.  The
+Tranibors are new chosen every year, but yet they are, for the most part,
+continued; all their other magistrates are only annual.  The Tranibors
+meet every third day, and oftener if necessary, and consult with the
+Prince either concerning the affairs of the State in general, or such
+private differences as may arise sometimes among the people, though that
+falls out but seldom.  There are always two Syphogrants called into the
+council chamber, and these are changed every day.  It is a fundamental
+rule of their government, that no conclusion can be made in anything that
+relates to the public till it has been first debated three several days
+in their council.  It is death for any to meet and consult concerning the
+State, unless it be either in their ordinary council, or in the assembly
+of the whole body of the people.
+
+"These things have been so provided among them that the Prince and the
+Tranibors may not conspire together to change the government and enslave
+the people; and therefore when anything of great importance is set on
+foot, it is sent to the Syphogrants, who, after they have communicated it
+to the families that belong to their divisions, and have considered it
+among themselves, make report to the senate; and, upon great occasions,
+the matter is referred to the council of the whole island.  One rule
+observed in their council is, never to debate a thing on the same day in
+which it is first proposed; for that is always referred to the next
+meeting, that so men may not rashly and in the heat of discourse engage
+themselves too soon, which might bias them so much that, instead of
+consulting the good of the public, they might rather study to support
+their first opinions, and by a perverse and preposterous sort of shame
+hazard their country rather than endanger their own reputation, or
+venture the being suspected to have wanted foresight in the expedients
+that they at first proposed; and therefore, to prevent this, they take
+care that they may rather be deliberate than sudden in their motions.
+
+
+
+OF THEIR TRADES, AND MANNER OF LIFE
+
+
+"Agriculture is that which is so universally understood among them that
+no person, either man or woman, is ignorant of it; they are instructed in
+it from their childhood, partly by what they learn at school, and partly
+by practice, they being led out often into the fields about the town,
+where they not only see others at work but are likewise exercised in it
+themselves.  Besides agriculture, which is so common to them all, every
+man has some peculiar trade to which he applies himself; such as the
+manufacture of wool or flax, masonry, smith's work, or carpenter's work;
+for there is no sort of trade that is in great esteem among them.
+Throughout the island they wear the same sort of clothes, without any
+other distinction except what is necessary to distinguish the two sexes
+and the married and unmarried.  The fashion never alters, and as it is
+neither disagreeable nor uneasy, so it is suited to the climate, and
+calculated both for their summers and winters.  Every family makes their
+own clothes; but all among them, women as well as men, learn one or other
+of the trades formerly mentioned.  Women, for the most part, deal in wool
+and flax, which suit best with their weakness, leaving the ruder trades
+to the men.  The same trade generally passes down from father to son,
+inclinations often following descent: but if any man's genius lies
+another way he is, by adoption, translated into a family that deals in
+the trade to which he is inclined; and when that is to be done, care is
+taken, not only by his father, but by the magistrate, that he may be put
+to a discreet and good man: and if, after a person has learned one trade,
+he desires to acquire another, that is also allowed, and is managed in
+the same manner as the former.  When he has learned both, he follows that
+which he likes best, unless the public has more occasion for the other.
+
+The chief, and almost the only, business of the Syphogrants is to take
+care that no man may live idle, but that every one may follow his trade
+diligently; yet they do not wear themselves out with perpetual toil from
+morning to night, as if they were beasts of burden, which as it is indeed
+a heavy slavery, so it is everywhere the common course of life amongst
+all mechanics except the Utopians: but they, dividing the day and night
+into twenty-four hours, appoint six of these for work, three of which are
+before dinner and three after; they then sup, and at eight o'clock,
+counting from noon, go to bed and sleep eight hours: the rest of their
+time, besides that taken up in work, eating, and sleeping, is left to
+every man's discretion; yet they are not to abuse that interval to luxury
+and idleness, but must employ it in some proper exercise, according to
+their various inclinations, which is, for the most part, reading.  It is
+ordinary to have public lectures every morning before daybreak, at which
+none are obliged to appear but those who are marked out for literature;
+yet a great many, both men and women, of all ranks, go to hear lectures
+of one sort or other, according to their inclinations: but if others that
+are not made for contemplation, choose rather to employ themselves at
+that time in their trades, as many of them do, they are not hindered, but
+are rather commended, as men that take care to serve their country.  After
+supper they spend an hour in some diversion, in summer in their gardens,
+and in winter in the halls where they eat, where they entertain each
+other either with music or discourse.  They do not so much as know dice,
+or any such foolish and mischievous games.  They have, however, two sorts
+of games not unlike our chess; the one is between several numbers, in
+which one number, as it were, consumes another; the other resembles a
+battle between the virtues and the vices, in which the enmity in the
+vices among themselves, and their agreement against virtue, is not
+unpleasantly represented; together with the special opposition between
+the particular virtues and vices; as also the methods by which vice
+either openly assaults or secretly undermines virtue; and virtue, on the
+other hand, resists it.  But the time appointed for labour is to be
+narrowly examined, otherwise you may imagine that since there are only
+six hours appointed for work, they may fall under a scarcity of necessary
+provisions: but it is so far from being true that this time is not
+sufficient for supplying them with plenty of all things, either necessary
+or convenient, that it is rather too much; and this you will easily
+apprehend if you consider how great a part of all other nations is quite
+idle.  First, women generally do little, who are the half of mankind; and
+if some few women are diligent, their husbands are idle: then consider
+the great company of idle priests, and of those that are called religious
+men; add to these all rich men, chiefly those that have estates in land,
+who are called noblemen and gentlemen, together with their families, made
+up of idle persons, that are kept more for show than use; add to these
+all those strong and lusty beggars that go about pretending some disease
+in excuse for their begging; and upon the whole account you will find
+that the number of those by whose labours mankind is supplied is much
+less than you perhaps imagined: then consider how few of those that work
+are employed in labours that are of real service, for we, who measure all
+things by money, give rise to many trades that are both vain and
+superfluous, and serve only to support riot and luxury: for if those who
+work were employed only in such things as the conveniences of life
+require, there would be such an abundance of them that the prices of them
+would so sink that tradesmen could not be maintained by their gains; if
+all those who labour about useless things were set to more profitable
+employments, and if all they that languish out their lives in sloth and
+idleness (every one of whom consumes as much as any two of the men that
+are at work) were forced to labour, you may easily imagine that a small
+proportion of time would serve for doing all that is either necessary,
+profitable, or pleasant to mankind, especially while pleasure is kept
+within its due bounds: this appears very plainly in Utopia; for there, in
+a great city, and in all the territory that lies round it, you can scarce
+find five hundred, either men or women, by their age and strength capable
+of labour, that are not engaged in it.  Even the Syphogrants, though
+excused by the law, yet do not excuse themselves, but work, that by their
+examples they may excite the industry of the rest of the people; the like
+exemption is allowed to those who, being recommended to the people by the
+priests, are, by the secret suffrages of the Syphogrants, privileged from
+labour, that they may apply themselves wholly to study; and if any of
+these fall short of those hopes that they seemed at first to give, they
+are obliged to return to work; and sometimes a mechanic that so employs
+his leisure hours as to make a considerable advancement in learning is
+eased from being a tradesman and ranked among their learned men.  Out of
+these they choose their ambassadors, their priests, their Tranibors, and
+the Prince himself, anciently called their Barzenes, but is called of
+late their Ademus.
+
+"And thus from the great numbers among them that are neither suffered to
+be idle nor to be employed in any fruitless labour, you may easily make
+the estimate how much may be done in those few hours in which they are
+obliged to labour.  But, besides all that has been already said, it is to
+be considered that the needful arts among them are managed with less
+labour than anywhere else.  The building or the repairing of houses among
+us employ many hands, because often a thriftless heir suffers a house
+that his father built to fall into decay, so that his successor must, at
+a great cost, repair that which he might have kept up with a small
+charge; it frequently happens that the same house which one person built
+at a vast expense is neglected by another, who thinks he has a more
+delicate sense of the beauties of architecture, and he, suffering it to
+fall to ruin, builds another at no less charge.  But among the Utopians
+all things are so regulated that men very seldom build upon a new piece
+of ground, and are not only very quick in repairing their houses, but
+show their foresight in preventing their decay, so that their buildings
+are preserved very long with but very little labour, and thus the
+builders, to whom that care belongs, are often without employment, except
+the hewing of timber and the squaring of stones, that the materials may
+be in readiness for raising a building very suddenly when there is any
+occasion for it.  As to their clothes, observe how little work is spent
+in them; while they are at labour they are clothed with leather and
+skins, cut carelessly about them, which will last seven years, and when
+they appear in public they put on an upper garment which hides the other;
+and these are all of one colour, and that is the natural colour of the
+wool.  As they need less woollen cloth than is used anywhere else, so
+that which they make use of is much less costly; they use linen cloth
+more, but that is prepared with less labour, and they value cloth only by
+the whiteness of the linen or the cleanness of the wool, without much
+regard to the fineness of the thread.  While in other places four or five
+upper garments of woollen cloth of different colours, and as many vests
+of silk, will scarce serve one man, and while those that are nicer think
+ten too few, every man there is content with one, which very often serves
+him two years; nor is there anything that can tempt a man to desire more,
+for if he had them he would neither be the, warmer nor would he make one
+jot the better appearance for it.  And thus, since they are all employed
+in some useful labour, and since they content themselves with fewer
+things, it falls out that there is a great abundance of all things among
+them; so that it frequently happens that, for want of other work, vast
+numbers are sent out to mend the highways; but when no public undertaking
+is to be performed, the hours of working are lessened.  The magistrates
+never engage the people in unnecessary labour, since the chief end of the
+constitution is to regulate labour by the necessities of the public, and
+to allow the people as much time as is necessary for the improvement of
+their minds, in which they think the happiness of life consists.
+
+
+
+OF THEIR TRAFFIC
+
+
+"But it is now time to explain to you the mutual intercourse of this
+people, their commerce, and the rules by which all things are distributed
+among them.
+
+"As their cities are composed of families, so their families are made up
+of those that are nearly related to one another.  Their women, when they
+grow up, are married out, but all the males, both children and
+grand-children, live still in the same house, in great obedience to their
+common parent, unless age has weakened his understanding, and in that
+case he that is next to him in age comes in his room; but lest any city
+should become either too great, or by any accident be dispeopled,
+provision is made that none of their cities may contain above six
+thousand families, besides those of the country around it.  No family may
+have less than ten and more than sixteen persons in it, but there can be
+no determined number for the children under age; this rule is easily
+observed by removing some of the children of a more fruitful couple to
+any other family that does not abound so much in them.  By the same rule
+they supply cities that do not increase so fast from others that breed
+faster; and if there is any increase over the whole island, then they
+draw out a number of their citizens out of the several towns and send
+them over to the neighbouring continent, where, if they find that the
+inhabitants have more soil than they can well cultivate, they fix a
+colony, taking the inhabitants into their society if they are willing to
+live with them; and where they do that of their own accord, they quickly
+enter into their method of life and conform to their rules, and this
+proves a happiness to both nations; for, according to their constitution,
+such care is taken of the soil that it becomes fruitful enough for both,
+though it might be otherwise too narrow and barren for any one of them.
+But if the natives refuse to conform themselves to their laws they drive
+them out of those bounds which they mark out for themselves, and use
+force if they resist, for they account it a very just cause of war for a
+nation to hinder others from possessing a part of that soil of which they
+make no use, but which is suffered to lie idle and uncultivated, since
+every man has, by the law of nature, a right to such a waste portion of
+the earth as is necessary for his subsistence.  If an accident has so
+lessened the number of the inhabitants of any of their towns that it
+cannot be made up from the other towns of the island without diminishing
+them too much (which is said to have fallen out but twice since they were
+first a people, when great numbers were carried off by the plague), the
+loss is then supplied by recalling as many as are wanted from their
+colonies, for they will abandon these rather than suffer the towns in the
+island to sink too low.
+
+"But to return to their manner of living in society: the oldest man of
+every family, as has been already said, is its governor; wives serve
+their husbands, and children their parents, and always the younger serves
+the elder.  Every city is divided into four equal parts, and in the
+middle of each there is a market-place.  What is brought thither, and
+manufactured by the several families, is carried from thence to houses
+appointed for that purpose, in which all things of a sort are laid by
+themselves; and thither every father goes, and takes whatsoever he or his
+family stand in need of, without either paying for it or leaving anything
+in exchange.  There is no reason for giving a denial to any person, since
+there is such plenty of everything among them; and there is no danger of
+a man's asking for more than he needs; they have no inducements to do
+this, since they are sure they shall always be supplied: it is the fear
+of want that makes any of the whole race of animals either greedy or
+ravenous; but, besides fear, there is in man a pride that makes him fancy
+it a particular glory to excel others in pomp and excess; but by the laws
+of the Utopians, there is no room for this.  Near these markets there are
+others for all sorts of provisions, where there are not only herbs,
+fruits, and bread, but also fish, fowl, and cattle.  There are also,
+without their towns, places appointed near some running water for killing
+their beasts and for washing away their filth, which is done by their
+slaves; for they suffer none of their citizens to kill their cattle,
+because they think that pity and good-nature, which are among the best of
+those affections that are born with us, are much impaired by the
+butchering of animals; nor do they suffer anything that is foul or
+unclean to be brought within their towns, lest the air should be infected
+by ill-smells, which might prejudice their health.  In every street there
+are great halls, that lie at an equal distance from each other,
+distinguished by particular names.  The Syphogrants dwell in those that
+are set over thirty families, fifteen lying on one side of it, and as
+many on the other.  In these halls they all meet and have their repasts;
+the stewards of every one of them come to the market-place at an
+appointed hour, and according to the number of those that belong to the
+hall they carry home provisions.  But they take more care of their sick
+than of any others; these are lodged and provided for in public
+hospitals.  They have belonging to every town four hospitals, that are
+built without their walls, and are so large that they may pass for little
+towns; by this means, if they had ever such a number of sick persons,
+they could lodge them conveniently, and at such a distance that such of
+them as are sick of infectious diseases may be kept so far from the rest
+that there can be no danger of contagion.  The hospitals are furnished
+and stored with all things that are convenient for the ease and recovery
+of the sick; and those that are put in them are looked after with such
+tender and watchful care, and are so constantly attended by their skilful
+physicians, that as none is sent to them against their will, so there is
+scarce one in a whole town that, if he should fall ill, would not choose
+rather to go thither than lie sick at home.
+
+"After the steward of the hospitals has taken for the sick whatsoever the
+physician prescribes, then the best things that are left in the market
+are distributed equally among the halls in proportion to their numbers;
+only, in the first place, they serve the Prince, the Chief Priest, the
+Tranibors, the Ambassadors, and strangers, if there are any, which,
+indeed, falls out but seldom, and for whom there are houses, well
+furnished, particularly appointed for their reception when they come
+among them.  At the hours of dinner and supper the whole Syphogranty
+being called together by sound of trumpet, they meet and eat together,
+except only such as are in the hospitals or lie sick at home.  Yet, after
+the halls are served, no man is hindered to carry provisions home from
+the market-place, for they know that none does that but for some good
+reason; for though any that will may eat at home, yet none does it
+willingly, since it is both ridiculous and foolish for any to give
+themselves the trouble to make ready an ill dinner at home when there is
+a much more plentiful one made ready for him so near hand.  All the
+uneasy and sordid services about these halls are performed by their
+slaves; but the dressing and cooking their meat, and the ordering their
+tables, belong only to the women, all those of every family taking it by
+turns.  They sit at three or more tables, according to their number; the
+men sit towards the wall, and the women sit on the other side, that if
+any of them should be taken suddenly ill, which is no uncommon case
+amongst women with child, she may, without disturbing the rest, rise and
+go to the nurses' room (who are there with the sucking children), where
+there is always clean water at hand and cradles, in which they may lay
+the young children if there is occasion for it, and a fire, that they may
+shift and dress them before it.  Every child is nursed by its own mother
+if death or sickness does not intervene; and in that case the
+Syphogrants' wives find out a nurse quickly, which is no hard matter, for
+any one that can do it offers herself cheerfully; for as they are much
+inclined to that piece of mercy, so the child whom they nurse considers
+the nurse as its mother.  All the children under five years old sit among
+the nurses; the rest of the younger sort of both sexes, till they are fit
+for marriage, either serve those that sit at table, or, if they are not
+strong enough for that, stand by them in great silence and eat what is
+given them; nor have they any other formality of dining.  In the middle
+of the first table, which stands across the upper end of the hall, sit
+the Syphogrant and his wife, for that is the chief and most conspicuous
+place; next to him sit two of the most ancient, for there go always four
+to a mess.  If there is a temple within the Syphogranty, the Priest and
+his wife sit with the Syphogrant above all the rest; next them there is a
+mixture of old and young, who are so placed that as the young are set
+near others, so they are mixed with the more ancient; which, they say,
+was appointed on this account: that the gravity of the old people, and
+the reverence that is due to them, might restrain the younger from all
+indecent words and gestures.  Dishes are not served up to the whole table
+at first, but the best are first set before the old, whose seats are
+distinguished from the young, and, after them, all the rest are served
+alike.  The old men distribute to the younger any curious meats that
+happen to be set before them, if there is not such an abundance of them
+that the whole company may be served alike.
+
+"Thus old men are honoured with a particular respect, yet all the rest
+fare as well as they.  Both dinner and supper are begun with some lecture
+of morality that is read to them; but it is so short that it is not
+tedious nor uneasy to them to hear it.  From hence the old men take
+occasion to entertain those about them with some useful and pleasant
+enlargements; but they do not engross the whole discourse so to
+themselves during their meals that the younger may not put in for a
+share; on the contrary, they engage them to talk, that so they may, in
+that free way of conversation, find out the force of every one's spirit
+and observe his temper.  They despatch their dinners quickly, but sit
+long at supper, because they go to work after the one, and are to sleep
+after the other, during which they think the stomach carries on the
+concoction more vigorously.  They never sup without music, and there is
+always fruit served up after meat; while they are at table some burn
+perfumes and sprinkle about fragrant ointments and sweet waters--in
+short, they want nothing that may cheer up their spirits; they give
+themselves a large allowance that way, and indulge themselves in all such
+pleasures as are attended with no inconvenience.  Thus do those that are
+in the towns live together; but in the country, where they live at a
+great distance, every one eats at home, and no family wants any necessary
+sort of provision, for it is from them that provisions are sent unto
+those that live in the towns.
+
+
+
+OF THE TRAVELLING OF THE UTOPIANS
+
+
+If any man has a mind to visit his friends that live in some other town,
+or desires to travel and see the rest of the country, he obtains leave
+very easily from the Syphogrant and Tranibors, when there is no
+particular occasion for him at home.  Such as travel carry with them a
+passport from the Prince, which both certifies the licence that is
+granted for travelling, and limits the time of their return.  They are
+furnished with a waggon and a slave, who drives the oxen and looks after
+them; but, unless there are women in the company, the waggon is sent back
+at the end of the journey as a needless encumbrance.  While they are on
+the road they carry no provisions with them, yet they want for nothing,
+but are everywhere treated as if they were at home.  If they stay in any
+place longer than a night, every one follows his proper occupation, and
+is very well used by those of his own trade; but if any man goes out of
+the city to which he belongs without leave, and is found rambling without
+a passport, he is severely treated, he is punished as a fugitive, and
+sent home disgracefully; and, if he falls again into the like fault, is
+condemned to slavery.  If any man has a mind to travel only over the
+precinct of his own city, he may freely do it, with his father's
+permission and his wife's consent; but when he comes into any of the
+country houses, if he expects to be entertained by them, he must labour
+with them and conform to their rules; and if he does this, he may freely
+go over the whole precinct, being then as useful to the city to which he
+belongs as if he were still within it.  Thus you see that there are no
+idle persons among them, nor pretences of excusing any from labour.  There
+are no taverns, no ale-houses, nor stews among them, nor any other
+occasions of corrupting each other, of getting into corners, or forming
+themselves into parties; all men live in full view, so that all are
+obliged both to perform their ordinary task and to employ themselves well
+in their spare hours; and it is certain that a people thus ordered must
+live in great abundance of all things, and these being equally
+distributed among them, no man can want or be obliged to beg.
+
+"In their great council at Amaurot, to which there are three sent from
+every town once a year, they examine what towns abound in provisions and
+what are under any scarcity, that so the one may be furnished from the
+other; and this is done freely, without any sort of exchange; for,
+according to their plenty or scarcity, they supply or are supplied from
+one another, so that indeed the whole island is, as it were, one family.
+When they have thus taken care of their whole country, and laid up stores
+for two years (which they do to prevent the ill consequences of an
+unfavourable season), they order an exportation of the overplus, both of
+corn, honey, wool, flax, wood, wax, tallow, leather, and cattle, which
+they send out, commonly in great quantities, to other nations.  They
+order a seventh part of all these goods to be freely given to the poor of
+the countries to which they send them, and sell the rest at moderate
+rates; and by this exchange they not only bring back those few things
+that they need at home (for, indeed, they scarce need anything but iron),
+but likewise a great deal of gold and silver; and by their driving this
+trade so long, it is not to be imagined how vast a treasure they have got
+among them, so that now they do not much care whether they sell off their
+merchandise for money in hand or upon trust.  A great part of their
+treasure is now in bonds; but in all their contracts no private man
+stands bound, but the writing runs in the name of the town; and the towns
+that owe them money raise it from those private hands that owe it to
+them, lay it up in their public chamber, or enjoy the profit of it till
+the Utopians call for it; and they choose rather to let the greatest part
+of it lie in their hands, who make advantage by it, than to call for it
+themselves; but if they see that any of their other neighbours stand more
+in need of it, then they call it in and lend it to them.  Whenever they
+are engaged in war, which is the only occasion in which their treasure
+can be usefully employed, they make use of it themselves; in great
+extremities or sudden accidents they employ it in hiring foreign troops,
+whom they more willingly expose to danger than their own people; they
+give them great pay, knowing well that this will work even on their
+enemies; that it will engage them either to betray their own side, or, at
+least, to desert it; and that it is the best means of raising mutual
+jealousies among them.  For this end they have an incredible treasure;
+but they do not keep it as a treasure, but in such a manner as I am
+almost afraid to tell, lest you think it so extravagant as to be hardly
+credible.  This I have the more reason to apprehend because, if I had not
+seen it myself, I could not have been easily persuaded to have believed
+it upon any man's report.
+
+"It is certain that all things appear incredible to us in proportion as
+they differ from known customs; but one who can judge aright will not
+wonder to find that, since their constitution differs so much from ours,
+their value of gold and silver should be measured by a very different
+standard; for since they have no use for money among themselves, but keep
+it as a provision against events which seldom happen, and between which
+there are generally long intervening intervals, they value it no farther
+than it deserves--that is, in proportion to its use.  So that it is plain
+they must prefer iron either to gold or silver, for men can no more live
+without iron than without fire or water; but Nature has marked out no use
+for the other metals so essential as not easily to be dispensed with.  The
+folly of men has enhanced the value of gold and silver because of their
+scarcity; whereas, on the contrary, it is their opinion that Nature, as
+an indulgent parent, has freely given us all the best things in great
+abundance, such as water and earth, but has laid up and hid from us the
+things that are vain and useless.
+
+"If these metals were laid up in any tower in the kingdom it would raise
+a jealousy of the Prince and Senate, and give birth to that foolish
+mistrust into which the people are apt to fall--a jealousy of their
+intending to sacrifice the interest of the public to their own private
+advantage.  If they should work it into vessels, or any sort of plate,
+they fear that the people might grow too fond of it, and so be unwilling
+to let the plate be run down, if a war made it necessary, to employ it in
+paying their soldiers.  To prevent all these inconveniences they have
+fallen upon an expedient which, as it agrees with their other policy, so
+is it very different from ours, and will scarce gain belief among us who
+value gold so much, and lay it up so carefully.  They eat and drink out
+of vessels of earth or glass, which make an agreeable appearance, though
+formed of brittle materials; while they make their chamber-pots and close-
+stools of gold and silver, and that not only in their public halls but in
+their private houses.  Of the same metals they likewise make chains and
+fetters for their slaves, to some of which, as a badge of infamy, they
+hang an earring of gold, and make others wear a chain or a coronet of the
+same metal; and thus they take care by all possible means to render gold
+and silver of no esteem; and from hence it is that while other nations
+part with their gold and silver as unwillingly as if one tore out their
+bowels, those of Utopia would look on their giving in all they possess of
+those metals (when there were any use for them) but as the parting with a
+trifle, or as we would esteem the loss of a penny!  They find pearls on
+their coasts, and diamonds and carbuncles on their rocks; they do not
+look after them, but, if they find them by chance, they polish them, and
+with them they adorn their children, who are delighted with them, and
+glory in them during their childhood; but when they grow to years, and
+see that none but children use such baubles, they of their own accord,
+without being bid by their parents, lay them aside, and would be as much
+ashamed to use them afterwards as children among us, when they come to
+years, are of their puppets and other toys.
+
+"I never saw a clearer instance of the opposite impressions that
+different customs make on people than I observed in the ambassadors of
+the Anemolians, who came to Amaurot when I was there.  As they came to
+treat of affairs of great consequence, the deputies from several towns
+met together to wait for their coming.  The ambassadors of the nations
+that lie near Utopia, knowing their customs, and that fine clothes are in
+no esteem among them, that silk is despised, and gold is a badge of
+infamy, used to come very modestly clothed; but the Anemolians, lying
+more remote, and having had little commerce with them, understanding that
+they were coarsely clothed, and all in the same manner, took it for
+granted that they had none of those fine things among them of which they
+made no use; and they, being a vainglorious rather than a wise people,
+resolved to set themselves out with so much pomp that they should look
+like gods, and strike the eyes of the poor Utopians with their splendour.
+Thus three ambassadors made their entry with a hundred attendants, all
+clad in garments of different colours, and the greater part in silk; the
+ambassadors themselves, who were of the nobility of their country, were
+in cloth-of-gold, and adorned with massy chains, earrings and rings of
+gold; their caps were covered with bracelets set full of pearls and other
+gems--in a word, they were set out with all those things that among the
+Utopians were either the badges of slavery, the marks of infamy, or the
+playthings of children.  It was not unpleasant to see, on the one side,
+how they looked big, when they compared their rich habits with the plain
+clothes of the Utopians, who were come out in great numbers to see them
+make their entry; and, on the other, to observe how much they were
+mistaken in the impression which they hoped this pomp would have made on
+them.  It appeared so ridiculous a show to all that had never stirred out
+of their country, and had not seen the customs of other nations, that
+though they paid some reverence to those that were the most meanly clad,
+as if they had been the ambassadors, yet when they saw the ambassadors
+themselves so full of gold and chains, they looked upon them as slaves,
+and forbore to treat them with reverence.  You might have seen the
+children who were grown big enough to despise their playthings, and who
+had thrown away their jewels, call to their mothers, push them gently,
+and cry out, 'See that great fool, that wears pearls and gems as if he
+were yet a child!' while their mothers very innocently replied, 'Hold
+your peace! this, I believe, is one of the ambassadors' fools.'  Others
+censured the fashion of their chains, and observed, 'That they were of no
+use, for they were too slight to bind their slaves, who could easily
+break them; and, besides, hung so loose about them that they thought it
+easy to throw their away, and so get from them."  But after the
+ambassadors had stayed a day among them, and saw so vast a quantity of
+gold in their houses (which was as much despised by them as it was
+esteemed in other nations), and beheld more gold and silver in the chains
+and fetters of one slave than all their ornaments amounted to, their
+plumes fell, and they were ashamed of all that glory for which they had
+formed valued themselves, and accordingly laid it aside--a resolution
+that they immediately took when, on their engaging in some free discourse
+with the Utopians, they discovered their sense of such things and their
+other customs.  The Utopians wonder how any man should be so much taken
+with the glaring doubtful lustre of a jewel or a stone, that can look up
+to a star or to the sun himself; or how any should value himself because
+his cloth is made of a finer thread; for, how fine soever that thread may
+be, it was once no better than the fleece of a sheep, and that sheep, was
+a sheep still, for all its wearing it.  They wonder much to hear that
+gold, which in itself is so useless a thing, should be everywhere so much
+esteemed that even man, for whom it was made, and by whom it has its
+value, should yet be thought of less value than this metal; that a man of
+lead, who has no more sense than a log of wood, and is as bad as he is
+foolish, should have many wise and good men to serve him, only because he
+has a great heap of that metal; and that if it should happen that by some
+accident or trick of law (which, sometimes produces as great changes as
+chance itself) all this wealth should pass from the master to the meanest
+varlet of his whole family, he himself would very soon become one of his
+servants, as if he were a thing that belonged to his wealth, and so were
+bound to follow its fortune!  But they much more admire and detest the
+folly of those who, when they see a rich man, though they neither owe him
+anything, nor are in any sort dependent on his bounty, yet, merely
+because he is rich, give him little less than divine honours, even though
+they know him to be so covetous and base-minded that, notwithstanding all
+his wealth, he will not part with one farthing of it to them as long as
+he lives!
+
+"These and such like notions have that people imbibed, partly from their
+education, being bred in a country whose customs and laws are opposite to
+all such foolish maxims, and partly from their learning and studies--for
+though there are but few in any town that are so wholly excused from
+labour as to give themselves entirely up to their studies (these being
+only such persons as discover from their childhood an extraordinary
+capacity and disposition for letters), yet their children and a great
+part of the nation, both men and women, are taught to spend those hours
+in which they are not obliged to work in reading; and this they do
+through the whole progress of life.  They have all their learning in
+their own tongue, which is both a copious and pleasant language, and in
+which a man can fully express his mind; it runs over a great tract of
+many countries, but it is not equally pure in all places.  They had never
+so much as heard of the names of any of those philosophers that are so
+famous in these parts of the world, before we went among them; and yet
+they had made the same discoveries as the Greeks, both in music, logic,
+arithmetic, and geometry.  But as they are almost in everything equal to
+the ancient philosophers, so they far exceed our modern logicians for
+they have never yet fallen upon the barbarous niceties that our youth are
+forced to learn in those trifling logical schools that are among us.  They
+are so far from minding chimeras and fantastical images made in the mind
+that none of them could comprehend what we meant when we talked to them
+of a man in the abstract as common to all men in particular (so that
+though we spoke of him as a thing that we could point at with our
+fingers, yet none of them could perceive him) and yet distinct from every
+one, as if he were some monstrous Colossus or giant; yet, for all this
+ignorance of these empty notions, they knew astronomy, and were perfectly
+acquainted with the motions of the heavenly bodies; and have many
+instruments, well contrived and divided, by which they very accurately
+compute the course and positions of the sun, moon, and stars.  But for
+the cheat of divining by the stars, by their oppositions or conjunctions,
+it has not so much as entered into their thoughts.  They have a
+particular sagacity, founded upon much observation, in judging of the
+weather, by which they know when they may look for rain, wind, or other
+alterations in the air; but as to the philosophy of these things, the
+cause of the saltness of the sea, of its ebbing and flowing, and of the
+original and nature both of the heavens and the earth, they dispute of
+them partly as our ancient philosophers have done, and partly upon some
+new hypothesis, in which, as they differ from them, so they do not in all
+things agree among themselves.
+
+"As to moral philosophy, they have the same disputes among them as we
+have here.  They examine what are properly good, both for the body and
+the mind; and whether any outward thing can be called truly _good_, or if
+that term belong only to the endowments of the soul.  They inquire,
+likewise, into the nature of virtue and pleasure.  But their chief
+dispute is concerning the happiness of a man, and wherein it
+consists--whether in some one thing or in a great many.  They seem,
+indeed, more inclinable to that opinion that places, if not the whole,
+yet the chief part, of a man's happiness in pleasure; and, what may seem
+more strange, they make use of arguments even from religion,
+notwithstanding its severity and roughness, for the support of that
+opinion so indulgent to pleasure; for they never dispute concerning
+happiness without fetching some arguments from the principles of religion
+as well as from natural reason, since without the former they reckon that
+all our inquiries after happiness must be but conjectural and defective.
+
+"These are their religious principles:--That the soul of man is immortal,
+and that God of His goodness has designed that it should be happy; and
+that He has, therefore, appointed rewards for good and virtuous actions,
+and punishments for vice, to be distributed after this life.  Though
+these principles of religion are conveyed down among them by tradition,
+they think that even reason itself determines a man to believe and
+acknowledge them; and freely confess that if these were taken away, no
+man would be so insensible as not to seek after pleasure by all possible
+means, lawful or unlawful, using only this caution--that a lesser
+pleasure might not stand in the way of a greater, and that no pleasure
+ought to be pursued that should draw a great deal of pain after it; for
+they think it the maddest thing in the world to pursue virtue, that is a
+sour and difficult thing, and not only to renounce the pleasures of life,
+but willingly to undergo much pain and trouble, if a man has no prospect
+of a reward.  And what reward can there be for one that has passed his
+whole life, not only without pleasure, but in pain, if there is nothing
+to be expected after death?  Yet they do not place happiness in all sorts
+of pleasures, but only in those that in themselves are good and honest.
+There is a party among them who place happiness in bare virtue; others
+think that our natures are conducted by virtue to happiness, as that
+which is the chief good of man.  They define virtue thus--that it is a
+living according to Nature, and think that we are made by God for that
+end; they believe that a man then follows the dictates of Nature when he
+pursues or avoids things according to the direction of reason.  They say
+that the first dictate of reason is the kindling in us a love and
+reverence for the Divine Majesty, to whom we owe both all that we have
+and, all that we can ever hope for.  In the next place, reason directs us
+to keep our minds as free from passion and as cheerful as we can, and
+that we should consider ourselves as bound by the ties of good-nature and
+humanity to use our utmost endeavours to help forward the happiness of
+all other persons; for there never was any man such a morose and severe
+pursuer of virtue, such an enemy to pleasure, that though he set hard
+rules for men to undergo, much pain, many watchings, and other rigors,
+yet did not at the same time advise them to do all they could in order to
+relieve and ease the miserable, and who did not represent gentleness and
+good-nature as amiable dispositions.  And from thence they infer that if
+a man ought to advance the welfare and comfort of the rest of mankind
+(there being no virtue more proper and peculiar to our nature than to
+ease the miseries of others, to free from trouble and anxiety, in
+furnishing them with the comforts of life, in which pleasure consists)
+Nature much more vigorously leads them to do all this for himself.  A
+life of pleasure is either a real evil, and in that case we ought not to
+assist others in their pursuit of it, but, on the contrary, to keep them
+from it all we can, as from that which is most hurtful and deadly; or if
+it is a good thing, so that we not only may but ought to help others to
+it, why, then, ought not a man to begin with himself? since no man can be
+more bound to look after the good of another than after his own; for
+Nature cannot direct us to be good and kind to others, and yet at the
+same time to be unmerciful and cruel to ourselves.  Thus as they define
+virtue to be living according to Nature, so they imagine that Nature
+prompts all people on to seek after pleasure as the end of all they do.
+They also observe that in order to our supporting the pleasures of life,
+Nature inclines us to enter into society; for there is no man so much
+raised above the rest of mankind as to be the only favourite of Nature,
+who, on the contrary, seems to have placed on a level all those that
+belong to the same species.  Upon this they infer that no man ought to
+seek his own conveniences so eagerly as to prejudice others; and
+therefore they think that not only all agreements between private persons
+ought to be observed, but likewise that all those laws ought to be kept
+which either a good prince has published in due form, or to which a
+people that is neither oppressed with tyranny nor circumvented by fraud
+has consented, for distributing those conveniences of life which afford
+us all our pleasures.
+
+"They think it is an evidence of true wisdom for a man to pursue his own
+advantage as far as the laws allow it, they account it piety to prefer
+the public good to one's private concerns, but they think it unjust for a
+man to seek for pleasure by snatching another man's pleasures from him;
+and, on the contrary, they think it a sign of a gentle and good soul for
+a man to dispense with his own advantage for the good of others, and that
+by this means a good man finds as much pleasure one way as he parts with
+another; for as he may expect the like from others when he may come to
+need it, so, if that should fail him, yet the sense of a good action, and
+the reflections that he makes on the love and gratitude of those whom he
+has so obliged, gives the mind more pleasure than the body could have
+found in that from which it had restrained itself.  They are also
+persuaded that God will make up the loss of those small pleasures with a
+vast and endless joy, of which religion easily convinces a good soul.
+
+"Thus, upon an inquiry into the whole matter, they reckon that all our
+actions, and even all our virtues, terminate in pleasure, as in our chief
+end and greatest happiness; and they call every motion or state, either
+of body or mind, in which Nature teaches us to delight, a pleasure.  Thus
+they cautiously limit pleasure only to those appetites to which Nature
+leads us; for they say that Nature leads us only to those delights to
+which reason, as well as sense, carries us, and by which we neither
+injure any other person nor lose the possession of greater pleasures, and
+of such as draw no troubles after them.  But they look upon those
+delights which men by a foolish, though common, mistake call pleasure, as
+if they could change as easily the nature of things as the use of words,
+as things that greatly obstruct their real happiness, instead of
+advancing it, because they so entirely possess the minds of those that
+are once captivated by them with a false notion of pleasure that there is
+no room left for pleasures of a truer or purer kind.
+
+"There are many things that in themselves have nothing that is truly
+delightful; on the contrary, they have a good deal of bitterness in them;
+and yet, from our perverse appetites after forbidden objects, are not
+only ranked among the pleasures, but are made even the greatest designs,
+of life.  Among those who pursue these sophisticated pleasures they
+reckon such as I mentioned before, who think themselves really the better
+for having fine clothes; in which they think they are doubly mistaken,
+both in the opinion they have of their clothes, and in that they have of
+themselves.  For if you consider the use of clothes, why should a fine
+thread be thought better than a coarse one?  And yet these men, as if
+they had some real advantages beyond others, and did not owe them wholly
+to their mistakes, look big, seem to fancy themselves to be more
+valuable, and imagine that a respect is due to them for the sake of a
+rich garment, to which they would not have pretended if they had been
+more meanly clothed, and even resent it as an affront if that respect is
+not paid them.  It is also a great folly to be taken with outward marks
+of respect, which signify nothing; for what true or real pleasure can one
+man find in another's standing bare or making legs to him?  Will the
+bending another man's knees give ease to yours? and will the head's being
+bare cure the madness of yours?  And yet it is wonderful to see how this
+false notion of pleasure bewitches many who delight themselves with the
+fancy of their nobility, and are pleased with this conceit--that they are
+descended from ancestors who have been held for some successions rich,
+and who have had great possessions; for this is all that makes nobility
+at present.  Yet they do not think themselves a whit the less noble,
+though their immediate parents have left none of this wealth to them, or
+though they themselves have squandered it away.  The Utopians have no
+better opinion of those who are much taken with gems and precious stones,
+and who account it a degree of happiness next to a divine one if they can
+purchase one that is very extraordinary, especially if it be of that sort
+of stones that is then in greatest request, for the same sort is not at
+all times universally of the same value, nor will men buy it unless it be
+dismounted and taken out of the gold.  The jeweller is then made to give
+good security, and required solemnly to swear that the stone is true,
+that, by such an exact caution, a false one might not be bought instead
+of a true; though, if you were to examine it, your eye could find no
+difference between the counterfeit and that which is true; so that they
+are all one to you, as much as if you were blind.  Or can it be thought
+that they who heap up a useless mass of wealth, not for any use that it
+is to bring them, but merely to please themselves with the contemplation
+of it, enjoy any true pleasure in it?  The delight they find is only a
+false shadow of joy.  Those are no better whose error is somewhat
+different from the former, and who hide it out of their fear of losing
+it; for what other name can fit the hiding it in the earth, or, rather,
+the restoring it to it again, it being thus cut off from being useful
+either to its owner or to the rest of mankind?  And yet the owner, having
+hid it carefully, is glad, because he thinks he is now sure of it.  If it
+should be stole, the owner, though he might live perhaps ten years after
+the theft, of which he knew nothing, would find no difference between his
+having or losing it, for both ways it was equally useless to him.
+
+"Among those foolish pursuers of pleasure they reckon all that delight in
+hunting, in fowling, or gaming, of whose madness they have only heard,
+for they have no such things among them.  But they have asked us, 'What
+sort of pleasure is it that men can find in throwing the dice?' (for if
+there were any pleasure in it, they think the doing it so often should
+give one a surfeit of it); 'and what pleasure can one find in hearing the
+barking and howling of dogs, which seem rather odious than pleasant
+sounds?'  Nor can they comprehend the pleasure of seeing dogs run after a
+hare, more than of seeing one dog run after another; for if the seeing
+them run is that which gives the pleasure, you have the same
+entertainment to the eye on both these occasions, since that is the same
+in both cases.  But if the pleasure lies in seeing the hare killed and
+torn by the dogs, this ought rather to stir pity, that a weak, harmless,
+and fearful hare should be devoured by strong, fierce, and cruel dogs.
+Therefore all this business of hunting is, among the Utopians, turned
+over to their butchers, and those, as has been already said, are all
+slaves, and they look on hunting as one of the basest parts of a
+butcher's work, for they account it both more profitable and more decent
+to kill those beasts that are more necessary and useful to mankind,
+whereas the killing and tearing of so small and miserable an animal can
+only attract the huntsman with a false show of pleasure, from which he
+can reap but small advantage.  They look on the desire of the bloodshed,
+even of beasts, as a mark of a mind that is already corrupted with
+cruelty, or that at least, by too frequent returns of so brutal a
+pleasure, must degenerate into it.
+
+"Thus though the rabble of mankind look upon these, and on innumerable
+other things of the same nature, as pleasures, the Utopians, on the
+contrary, observing that there is nothing in them truly pleasant,
+conclude that they are not to be reckoned among pleasures; for though
+these things may create some tickling in the senses (which seems to be a
+true notion of pleasure), yet they imagine that this does not arise from
+the thing itself, but from a depraved custom, which may so vitiate a
+man's taste that bitter things may pass for sweet, as women with child
+think pitch or tallow taste sweeter than honey; but as a man's sense,
+when corrupted either by a disease or some ill habit, does not change the
+nature of other things, so neither can it change the nature of pleasure.
+
+"They reckon up several sorts of pleasures, which they call true ones;
+some belong to the body, and others to the mind.  The pleasures of the
+mind lie in knowledge, and in that delight which the contemplation of
+truth carries with it; to which they add the joyful reflections on a well-
+spent life, and the assured hopes of a future happiness.  They divide the
+pleasures of the body into two sorts--the one is that which gives our
+senses some real delight, and is performed either by recruiting Nature
+and supplying those parts which feed the internal heat of life by eating
+and drinking, or when Nature is eased of any surcharge that oppresses it,
+when we are relieved from sudden pain, or that which arises from
+satisfying the appetite which Nature has wisely given to lead us to the
+propagation of the species.  There is another kind of pleasure that
+arises neither from our receiving what the body requires, nor its being
+relieved when overcharged, and yet, by a secret unseen virtue, affects
+the senses, raises the passions, and strikes the mind with generous
+impressions--this is, the pleasure that arises from music.  Another kind
+of bodily pleasure is that which results from an undisturbed and vigorous
+constitution of body, when life and active spirits seem to actuate every
+part.  This lively health, when entirely free from all mixture of pain,
+of itself gives an inward pleasure, independent of all external objects
+of delight; and though this pleasure does not so powerfully affect us,
+nor act so strongly on the senses as some of the others, yet it may be
+esteemed as the greatest of all pleasures; and almost all the Utopians
+reckon it the foundation and basis of all the other joys of life, since
+this alone makes the state of life easy and desirable, and when this is
+wanting, a man is really capable of no other pleasure.  They look upon
+freedom from pain, if it does not rise from perfect health, to be a state
+of stupidity rather than of pleasure.  This subject has been very
+narrowly canvassed among them, and it has been debated whether a firm and
+entire health could be called a pleasure or not.  Some have thought that
+there was no pleasure but what was 'excited' by some sensible motion in
+the body.  But this opinion has been long ago excluded from among them;
+so that now they almost universally agree that health is the greatest of
+all bodily pleasures; and that as there is a pain in sickness which is as
+opposite in its nature to pleasure as sickness itself is to health, so
+they hold that health is accompanied with pleasure.  And if any should
+say that sickness is not really pain, but that it only carries pain along
+with it, they look upon that as a fetch of subtlety that does not much
+alter the matter.  It is all one, in their opinion, whether it be said
+that health is in itself a pleasure, or that it begets a pleasure, as
+fire gives heat, so it be granted that all those whose health is entire
+have a true pleasure in the enjoyment of it.  And they reason thus:--'What
+is the pleasure of eating, but that a man's health, which had been
+weakened, does, with the assistance of food, drive away hunger, and so
+recruiting itself, recovers its former vigour?  And being thus refreshed
+it finds a pleasure in that conflict; and if the conflict is pleasure,
+the victory must yet breed a greater pleasure, except we fancy that it
+becomes stupid as soon as it has obtained that which it pursued, and so
+neither knows nor rejoices in its own welfare.'  If it is said that
+health cannot be felt, they absolutely deny it; for what man is in
+health, that does not perceive it when he is awake?  Is there any man
+that is so dull and stupid as not to acknowledge that he feels a delight
+in health?  And what is delight but another name for pleasure?
+
+"But, of all pleasures, they esteem those to be most valuable that lie in
+the mind, the chief of which arise out of true virtue and the witness of
+a good conscience.  They account health the chief pleasure that belongs
+to the body; for they think that the pleasure of eating and drinking, and
+all the other delights of sense, are only so far desirable as they give
+or maintain health; but they are not pleasant in themselves otherwise
+than as they resist those impressions that our natural infirmities are
+still making upon us.  For as a wise man desires rather to avoid diseases
+than to take physic, and to be freed from pain rather than to find ease
+by remedies, so it is more desirable not to need this sort of pleasure
+than to be obliged to indulge it.  If any man imagines that there is a
+real happiness in these enjoyments, he must then confess that he would be
+the happiest of all men if he were to lead his life in perpetual hunger,
+thirst, and itching, and, by consequence, in perpetual eating, drinking,
+and scratching himself; which any one may easily see would be not only a
+base, but a miserable, state of a life.  These are, indeed, the lowest of
+pleasures, and the least pure, for we can never relish them but when they
+are mixed with the contrary pains.  The pain of hunger must give us the
+pleasure of eating, and here the pain out-balances the pleasure.  And as
+the pain is more vehement, so it lasts much longer; for as it begins
+before the pleasure, so it does not cease but with the pleasure that
+extinguishes it, and both expire together.  They think, therefore, none
+of those pleasures are to be valued any further than as they are
+necessary; yet they rejoice in them, and with due gratitude acknowledge
+the tenderness of the great Author of Nature, who has planted in us
+appetites, by which those things that are necessary for our preservation
+are likewise made pleasant to us.  For how miserable a thing would life
+be if those daily diseases of hunger and thirst were to be carried off by
+such bitter drugs as we must use for those diseases that return seldomer
+upon us!  And thus these pleasant, as well as proper, gifts of Nature
+maintain the strength and the sprightliness of our bodies.
+
+"They also entertain themselves with the other delights let in at their
+eyes, their ears, and their nostrils as the pleasant relishes and
+seasoning of life, which Nature seems to have marked out peculiarly for
+man, since no other sort of animals contemplates the figure and beauty of
+the universe, nor is delighted with smells any further than as they
+distinguish meats by them; nor do they apprehend the concords or discords
+of sound.  Yet, in all pleasures whatsoever, they take care that a lesser
+joy does not hinder a greater, and that pleasure may never breed pain,
+which they think always follows dishonest pleasures.  But they think it
+madness for a man to wear out the beauty of his face or the force of his
+natural strength, to corrupt the sprightliness of his body by sloth and
+laziness, or to waste it by fasting; that it is madness to weaken the
+strength of his constitution and reject the other delights of life,
+unless by renouncing his own satisfaction he can either serve the public
+or promote the happiness of others, for which he expects a greater
+recompense from God.  So that they look on such a course of life as the
+mark of a mind that is both cruel to itself and ungrateful to the Author
+of Nature, as if we would not be beholden to Him for His favours, and
+therefore rejects all His blessings; as one who should afflict himself
+for the empty shadow of virtue, or for no better end than to render
+himself capable of bearing those misfortunes which possibly will never
+happen.
+
+"This is their notion of virtue and of pleasure: they think that no man's
+reason can carry him to a truer idea of them unless some discovery from
+heaven should inspire him with sublimer notions.  I have not now the
+leisure to examine whether they think right or wrong in this matter; nor
+do I judge it necessary, for I have only undertaken to give you an
+account of their constitution, but not to defend all their principles.  I
+am sure that whatever may be said of their notions, there is not in the
+whole world either a better people or a happier government.  Their bodies
+are vigorous and lively; and though they are but of a middle stature, and
+have neither the fruitfullest soil nor the purest air in the world; yet
+they fortify themselves so well, by their temperate course of life,
+against the unhealthiness of their air, and by their industry they so
+cultivate their soil, that there is nowhere to be seen a greater
+increase, both of corn and cattle, nor are there anywhere healthier men
+and freer from diseases; for one may there see reduced to practice not
+only all the art that the husbandman employs in manuring and improving an
+ill soil, but whole woods plucked up by the roots, and in other places
+new ones planted, where there were none before.  Their principal motive
+for this is the convenience of carriage, that their timber may be either
+near their towns or growing on the banks of the sea, or of some rivers,
+so as to be floated to them; for it is a harder work to carry wood at any
+distance over land than corn.  The people are industrious, apt to learn,
+as well as cheerful and pleasant, and none can endure more labour when it
+is necessary; but, except in that case, they love their ease.  They are
+unwearied pursuers of knowledge; for when we had given them some hints of
+the learning and discipline of the Greeks, concerning whom we only
+instructed them (for we know that there was nothing among the Romans,
+except their historians and their poets, that they would value much), it
+was strange to see how eagerly they were set on learning that language:
+we began to read a little of it to them, rather in compliance with their
+importunity than out of any hopes of their reaping from it any great
+advantage: but, after a very short trial, we found they made such
+progress, that we saw our labour was like to be more successful than we
+could have expected: they learned to write their characters and to
+pronounce their language so exactly, had so quick an apprehension, they
+remembered it so faithfully, and became so ready and correct in the use
+of it, that it would have looked like a miracle if the greater part of
+those whom we taught had not been men both of extraordinary capacity and
+of a fit age for instruction: they were, for the greatest part, chosen
+from among their learned men by their chief council, though some studied
+it of their own accord.  In three years' time they became masters of the
+whole language, so that they read the best of the Greek authors very
+exactly.  I am, indeed, apt to think that they learned that language the
+more easily from its having some relation to their own.  I believe that
+they were a colony of the Greeks; for though their language comes nearer
+the Persian, yet they retain many names, both for their towns and
+magistrates, that are of Greek derivation.  I happened to carry a great
+many books with me, instead of merchandise, when I sailed my fourth
+voyage; for I was so far from thinking of soon coming back, that I rather
+thought never to have returned at all, and I gave them all my books,
+among which were many of Plato's and some of Aristotle's works: I had
+also Theophrastus on Plants, which, to my great regret, was imperfect;
+for having laid it carelessly by, while we were at sea, a monkey had
+seized upon it, and in many places torn out the leaves.  They have no
+books of grammar but Lascares, for I did not carry Theodorus with me; nor
+have they any dictionaries but Hesichius and Dioscerides.  They esteem
+Plutarch highly, and were much taken with Lucian's wit and with his
+pleasant way of writing.  As for the poets, they have Aristophanes,
+Homer, Euripides, and Sophocles of Aldus's edition; and for historians,
+Thucydides, Herodotus, and Herodian.  One of my companions, Thricius
+Apinatus, happened to carry with him some of Hippocrates's works and
+Galen's Microtechne, which they hold in great estimation; for though
+there is no nation in the world that needs physic so little as they do,
+yet there is not any that honours it so much; they reckon the knowledge
+of it one of the pleasantest and most profitable parts of philosophy, by
+which, as they search into the secrets of nature, so they not only find
+this study highly agreeable, but think that such inquiries are very
+acceptable to the Author of nature; and imagine, that as He, like the
+inventors of curious engines amongst mankind, has exposed this great
+machine of the universe to the view of the only creatures capable of
+contemplating it, so an exact and curious observer, who admires His
+workmanship, is much more acceptable to Him than one of the herd, who,
+like a beast incapable of reason, looks on this glorious scene with the
+eyes of a dull and unconcerned spectator.
+
+"The minds of the Utopians, when fenced with a love for learning, are
+very ingenious in discovering all such arts as are necessary to carry it
+to perfection.  Two things they owe to us, the manufacture of paper and
+the art of printing; yet they are not so entirely indebted to us for
+these discoveries but that a great part of the invention was their own.
+We showed them some books printed by Aldus, we explained to them the way
+of making paper and the mystery of printing; but, as we had never
+practised these arts, we described them in a crude and superficial
+manner.  They seized the hints we gave them; and though at first they
+could not arrive at perfection, yet by making many essays they at last
+found out and corrected all their errors and conquered every difficulty.
+Before this they only wrote on parchment, on reeds, or on the barks of
+trees; but now they have established the manufactures of paper and set up
+printing presses, so that, if they had but a good number of Greek
+authors, they would be quickly supplied with many copies of them: at
+present, though they have no more than those I have mentioned, yet, by
+several impressions, they have multiplied them into many thousands.  If
+any man was to go among them that had some extraordinary talent, or that
+by much travelling had observed the customs of many nations (which made
+us to be so well received), he would receive a hearty welcome, for they
+are very desirous to know the state of the whole world.  Very few go
+among them on the account of traffic; for what can a man carry to them
+but iron, or gold, or silver? which merchants desire rather to export
+than import to a strange country: and as for their exportation, they
+think it better to manage that themselves than to leave it to foreigners,
+for by this means, as they understand the state of the neighbouring
+countries better, so they keep up the art of navigation which cannot be
+maintained but by much practice.
+
+
+
+OF THEIR SLAVES, AND OF THEIR MARRIAGES
+
+
+"They do not make slaves of prisoners of war, except those that are taken
+in battle, nor of the sons of their slaves, nor of those of other
+nations: the slaves among them are only such as are condemned to that
+state of life for the commission of some crime, or, which is more common,
+such as their merchants find condemned to die in those parts to which
+they trade, whom they sometimes redeem at low rates, and in other places
+have them for nothing.  They are kept at perpetual labour, and are always
+chained, but with this difference, that their own natives are treated
+much worse than others: they are considered as more profligate than the
+rest, and since they could not be restrained by the advantages of so
+excellent an education, are judged worthy of harder usage.  Another sort
+of slaves are the poor of the neighbouring countries, who offer of their
+own accord to come and serve them: they treat these better, and use them
+in all other respects as well as their own countrymen, except their
+imposing more labour upon them, which is no hard task to those that have
+been accustomed to it; and if any of these have a mind to go back to
+their own country, which, indeed, falls out but seldom, as they do not
+force them to stay, so they do not send them away empty-handed.
+
+"I have already told you with what care they look after their sick, so
+that nothing is left undone that can contribute either to their case or
+health; and for those who are taken with fixed and incurable diseases,
+they use all possible ways to cherish them and to make their lives as
+comfortable as possible.  They visit them often and take great pains to
+make their time pass off easily; but when any is taken with a torturing
+and lingering pain, so that there is no hope either of recovery or ease,
+the priests and magistrates come and exhort them, that, since they are
+now unable to go on with the business of life, are become a burden to
+themselves and to all about them, and they have really out-lived
+themselves, they should no longer nourish such a rooted distemper, but
+choose rather to die since they cannot live but in much misery; being
+assured that if they thus deliver themselves from torture, or are willing
+that others should do it, they shall be happy after death: since, by
+their acting thus, they lose none of the pleasures, but only the troubles
+of life, they think they behave not only reasonably but in a manner
+consistent with religion and piety; because they follow the advice given
+them by their priests, who are the expounders of the will of God.  Such
+as are wrought on by these persuasions either starve themselves of their
+own accord, or take opium, and by that means die without pain.  But no
+man is forced on this way of ending his life; and if they cannot be
+persuaded to it, this does not induce them to fail in their attendance
+and care of them: but as they believe that a voluntary death, when it is
+chosen upon such an authority, is very honourable, so if any man takes
+away his own life without the approbation of the priests and the senate,
+they give him none of the honours of a decent funeral, but throw his body
+into a ditch.
+
+"Their women are not married before eighteen nor their men before two-and-
+twenty, and if any of them run into forbidden embraces before marriage
+they are severely punished, and the privilege of marriage is denied them
+unless they can obtain a special warrant from the Prince.  Such disorders
+cast a great reproach upon the master and mistress of the family in which
+they happen, for it is supposed that they have failed in their duty.  The
+reason of punishing this so severely is, because they think that if they
+were not strictly restrained from all vagrant appetites, very few would
+engage in a state in which they venture the quiet of their whole lives,
+by being confined to one person, and are obliged to endure all the
+inconveniences with which it is accompanied.  In choosing their wives
+they use a method that would appear to us very absurd and ridiculous, but
+it is constantly observed among them, and is accounted perfectly
+consistent with wisdom.  Before marriage some grave matron presents the
+bride, naked, whether she is a virgin or a widow, to the bridegroom, and
+after that some grave man presents the bridegroom, naked, to the bride.
+We, indeed, both laughed at this, and condemned it as very indecent.  But
+they, on the other hand, wondered at the folly of the men of all other
+nations, who, if they are but to buy a horse of a small value, are so
+cautious that they will see every part of him, and take off both his
+saddle and all his other tackle, that there may be no secret ulcer hid
+under any of them, and that yet in the choice of a wife, on which depends
+the happiness or unhappiness of the rest of his life, a man should
+venture upon trust, and only see about a handsbreadth of the face, all
+the rest of the body being covered, under which may lie hid what may be
+contagious as well as loathsome.  All men are not so wise as to choose a
+woman only for her good qualities, and even wise men consider the body as
+that which adds not a little to the mind, and it is certain there may be
+some such deformity covered with clothes as may totally alienate a man
+from his wife, when it is too late to part with her; if such a thing is
+discovered after marriage a man has no remedy but patience; they,
+therefore, think it is reasonable that there should be good provision
+made against such mischievous frauds.
+
+"There was so much the more reason for them to make a regulation in this
+matter, because they are the only people of those parts that neither
+allow of polygamy nor of divorces, except in the case of adultery or
+insufferable perverseness, for in these cases the Senate dissolves the
+marriage and grants the injured person leave to marry again; but the
+guilty are made infamous and are never allowed the privilege of a second
+marriage.  None are suffered to put away their wives against their wills,
+from any great calamity that may have fallen on their persons, for they
+look on it as the height of cruelty and treachery to abandon either of
+the married persons when they need most the tender care of their consort,
+and that chiefly in the case of old age, which, as it carries many
+diseases along with it, so it is a disease of itself.  But it frequently
+falls out that when a married couple do not well agree, they, by mutual
+consent, separate, and find out other persons with whom they hope they
+may live more happily; yet this is not done without obtaining leave of
+the Senate, which never admits of a divorce but upon a strict inquiry
+made, both by the senators and their wives, into the grounds upon which
+it is desired, and even when they are satisfied concerning the reasons of
+it they go on but slowly, for they imagine that too great easiness in
+granting leave for new marriages would very much shake the kindness of
+married people.  They punish severely those that defile the marriage bed;
+if both parties are married they are divorced, and the injured persons
+may marry one another, or whom they please, but the adulterer and the
+adulteress are condemned to slavery, yet if either of the injured persons
+cannot shake off the love of the married person they may live with them
+still in that state, but they must follow them to that labour to which
+the slaves are condemned, and sometimes the repentance of the condemned,
+together with the unshaken kindness of the innocent and injured person,
+has prevailed so far with the Prince that he has taken off the sentence;
+but those that relapse after they are once pardoned are punished with
+death.
+
+"Their law does not determine the punishment for other crimes, but that
+is left to the Senate, to temper it according to the circumstances of the
+fact.  Husbands have power to correct their wives and parents to chastise
+their children, unless the fault is so great that a public punishment is
+thought necessary for striking terror into others.  For the most part
+slavery is the punishment even of the greatest crimes, for as that is no
+less terrible to the criminals themselves than death, so they think the
+preserving them in a state of servitude is more for the interest of the
+commonwealth than killing them, since, as their labour is a greater
+benefit to the public than their death could be, so the sight of their
+misery is a more lasting terror to other men than that which would be
+given by their death.  If their slaves rebel, and will not bear their
+yoke and submit to the labour that is enjoined them, they are treated as
+wild beasts that cannot be kept in order, neither by a prison nor by
+their chains, and are at last put to death.  But those who bear their
+punishment patiently, and are so much wrought on by that pressure that
+lies so hard on them, that it appears they are really more troubled for
+the crimes they have committed than for the miseries they suffer, are not
+out of hope, but that, at last, either the Prince will, by his
+prerogative, or the people, by their intercession, restore them again to
+their liberty, or, at least, very much mitigate their slavery.  He that
+tempts a married woman to adultery is no less severely punished than he
+that commits it, for they believe that a deliberate design to commit a
+crime is equal to the fact itself, since its not taking effect does not
+make the person that miscarried in his attempt at all the less guilty.
+
+"They take great pleasure in fools, and as it is thought a base and
+unbecoming thing to use them ill, so they do not think it amiss for
+people to divert themselves with their folly; and, in their opinion, this
+is a great advantage to the fools themselves; for if men were so sullen
+and severe as not at all to please themselves with their ridiculous
+behaviour and foolish sayings, which is all that they can do to recommend
+themselves to others, it could not be expected that they would be so well
+provided for nor so tenderly used as they must otherwise be.  If any man
+should reproach another for his being misshaped or imperfect in any part
+of his body, it would not at all be thought a reflection on the person so
+treated, but it would be accounted scandalous in him that had upbraided
+another with what he could not help.  It is thought a sign of a sluggish
+and sordid mind not to preserve carefully one's natural beauty; but it is
+likewise infamous among them to use paint.  They all see that no beauty
+recommends a wife so much to her husband as the probity of her life and
+her obedience; for as some few are caught and held only by beauty, so all
+are attracted by the other excellences which charm all the world.
+
+"As they fright men from committing crimes by punishments, so they invite
+them to the love of virtue by public honours; therefore they erect
+statues to the memories of such worthy men as have deserved well of their
+country, and set these in their market-places, both to perpetuate the
+remembrance of their actions and to be an incitement to their posterity
+to follow their example.
+
+"If any man aspires to any office he is sure never to compass it.  They
+all live easily together, for none of the magistrates are either insolent
+or cruel to the people; they affect rather to be called fathers, and, by
+being really so, they well deserve the name; and the people pay them all
+the marks of honour the more freely because none are exacted from them.
+The Prince himself has no distinction, either of garments or of a crown;
+but is only distinguished by a sheaf of corn carried before him; as the
+High Priest is also known by his being preceded by a person carrying a
+wax light.
+
+"They have but few laws, and such is their constitution that they need
+not many.  They very much condemn other nations whose laws, together with
+the commentaries on them, swell up to so many volumes; for they think it
+an unreasonable thing to oblige men to obey a body of laws that are both
+of such a bulk, and so dark as not to be read and understood by every one
+of the subjects.
+
+"They have no lawyers among them, for they consider them as a sort of
+people whose profession it is to disguise matters and to wrest the laws,
+and, therefore, they think it is much better that every man should plead
+his own cause, and trust it to the judge, as in other places the client
+trusts it to a counsellor; by this means they both cut off many delays
+and find out truth more certainly; for after the parties have laid open
+the merits of the cause, without those artifices which lawyers are apt to
+suggest, the judge examines the whole matter, and supports the simplicity
+of such well-meaning persons, whom otherwise crafty men would be sure to
+run down; and thus they avoid those evils which appear very remarkably
+among all those nations that labour under a vast load of laws.  Every one
+of them is skilled in their law; for, as it is a very short study, so the
+plainest meaning of which words are capable is always the sense of their
+laws; and they argue thus: all laws are promulgated for this end, that
+every man may know his duty; and, therefore, the plainest and most
+obvious sense of the words is that which ought to be put upon them, since
+a more refined exposition cannot be easily comprehended, and would only
+serve to make the laws become useless to the greater part of mankind, and
+especially to those who need most the direction of them; for it is all
+one not to make a law at all or to couch it in such terms that, without a
+quick apprehension and much study, a man cannot find out the true meaning
+of it, since the generality of mankind are both so dull, and so much
+employed in their several trades, that they have neither the leisure nor
+the capacity requisite for such an inquiry.
+
+"Some of their neighbours, who are masters of their own liberties (having
+long ago, by the assistance of the Utopians, shaken off the yoke of
+tyranny, and being much taken with those virtues which they observe among
+them), have come to desire that they would send magistrates to govern
+them, some changing them every year, and others every five years; at the
+end of their government they bring them back to Utopia, with great
+expressions of honour and esteem, and carry away others to govern in
+their stead.  In this they seem to have fallen upon a very good expedient
+for their own happiness and safety; for since the good or ill condition
+of a nation depends so much upon their magistrates, they could not have
+made a better choice than by pitching on men whom no advantages can bias;
+for wealth is of no use to them, since they must so soon go back to their
+own country, and they, being strangers among them, are not engaged in any
+of their heats or animosities; and it is certain that when public
+judicatories are swayed, either by avarice or partial affections, there
+must follow a dissolution of justice, the chief sinew of society.
+
+"The Utopians call those nations that come and ask magistrates from them
+Neighbours; but those to whom they have been of more particular service,
+Friends; and as all other nations are perpetually either making leagues
+or breaking them, they never enter into an alliance with any state.  They
+think leagues are useless things, and believe that if the common ties of
+humanity do not knit men together, the faith of promises will have no
+great effect; and they are the more confirmed in this by what they see
+among the nations round about them, who are no strict observers of
+leagues and treaties.  We know how religiously they are observed in
+Europe, more particularly where the Christian doctrine is received, among
+whom they are sacred and inviolable! which is partly owing to the justice
+and goodness of the princes themselves, and partly to the reverence they
+pay to the popes, who, as they are the most religious observers of their
+own promises, so they exhort all other princes to perform theirs, and,
+when fainter methods do not prevail, they compel them to it by the
+severity of the pastoral censure, and think that it would be the most
+indecent thing possible if men who are particularly distinguished by the
+title of 'The Faithful' should not religiously keep the faith of their
+treaties.  But in that new-found world, which is not more distant from us
+in situation than the people are in their manners and course of life,
+there is no trusting to leagues, even though they were made with all the
+pomp of the most sacred ceremonies; on the contrary, they are on this
+account the sooner broken, some slight pretence being found in the words
+of the treaties, which are purposely couched in such ambiguous terms that
+they can never be so strictly bound but they will always find some
+loophole to escape at, and thus they break both their leagues and their
+faith; and this is done with such impudence, that those very men who
+value themselves on having suggested these expedients to their princes
+would, with a haughty scorn, declaim against such craft; or, to speak
+plainer, such fraud and deceit, if they found private men make use of it
+in their bargains, and would readily say that they deserved to be hanged.
+
+"By this means it is that all sort of justice passes in the world for a
+low-spirited and vulgar virtue, far below the dignity of royal
+greatness--or at least there are set up two sorts of justice; the one is
+mean and creeps on the ground, and, therefore, becomes none but the lower
+part of mankind, and so must be kept in severely by many restraints, that
+it may not break out beyond the bounds that are set to it; the other is
+the peculiar virtue of princes, which, as it is more majestic than that
+which becomes the rabble, so takes a freer compass, and thus lawful and
+unlawful are only measured by pleasure and interest.  These practices of
+the princes that lie about Utopia, who make so little account of their
+faith, seem to be the reasons that determine them to engage in no
+confederacy.  Perhaps they would change their mind if they lived among
+us; but yet, though treaties were more religiously observed, they would
+still dislike the custom of making them, since the world has taken up a
+false maxim upon it, as if there were no tie of nature uniting one nation
+to another, only separated perhaps by a mountain or a river, and that all
+were born in a state of hostility, and so might lawfully do all that
+mischief to their neighbours against which there is no provision made by
+treaties; and that when treaties are made they do not cut off the enmity
+or restrain the licence of preying upon each other, if, by the
+unskilfulness of wording them, there are not effectual provisoes made
+against them; they, on the other hand, judge that no man is to be
+esteemed our enemy that has never injured us, and that the partnership of
+human nature is instead of a league; and that kindness and good nature
+unite men more effectually and with greater strength than any agreements
+whatsoever, since thereby the engagements of men's hearts become stronger
+than the bond and obligation of words.
+
+
+
+OF THEIR MILITARY DISCIPLINE
+
+
+They detest war as a very brutal thing, and which, to the reproach of
+human nature, is more practised by men than by any sort of beasts.  They,
+in opposition to the sentiments of almost all other nations, think that
+there is nothing more inglorious than that glory that is gained by war;
+and therefore, though they accustom themselves daily to military
+exercises and the discipline of war, in which not only their men, but
+their women likewise, are trained up, that, in cases of necessity, they
+may not be quite useless, yet they do not rashly engage in war, unless it
+be either to defend themselves or their friends from any unjust
+aggressors, or, out of good nature or in compassion, assist an oppressed
+nation in shaking off the yoke of tyranny.  They, indeed, help their
+friends not only in defensive but also in offensive wars; but they never
+do that unless they had been consulted before the breach was made, and,
+being satisfied with the grounds on which they went, they had found that
+all demands of reparation were rejected, so that a war was unavoidable.
+This they think to be not only just when one neighbour makes an inroad on
+another by public order, and carries away the spoils, but when the
+merchants of one country are oppressed in another, either under pretence
+of some unjust laws, or by the perverse wresting of good ones.  This they
+count a juster cause of war than the other, because those injuries are
+done under some colour of laws.  This was the only ground of that war in
+which they engaged with the Nephelogetes against the Aleopolitanes, a
+little before our time; for the merchants of the former having, as they
+thought, met with great injustice among the latter, which (whether it was
+in itself right or wrong) drew on a terrible war, in which many of their
+neighbours were engaged; and their keenness in carrying it on being
+supported by their strength in maintaining it, it not only shook some
+very flourishing states and very much afflicted others, but, after a
+series of much mischief ended in the entire conquest and slavery of the
+Aleopolitanes, who, though before the war they were in all respects much
+superior to the Nephelogetes, were yet subdued; but, though the Utopians
+had assisted them in the war, yet they pretended to no share of the
+spoil.
+
+"But, though they so vigorously assist their friends in obtaining
+reparation for the injuries they have received in affairs of this nature,
+yet, if any such frauds were committed against themselves, provided no
+violence was done to their persons, they would only, on their being
+refused satisfaction, forbear trading with such a people.  This is not
+because they consider their neighbours more than their own citizens; but,
+since their neighbours trade every one upon his own stock, fraud is a
+more sensible injury to them than it is to the Utopians, among whom the
+public, in such a case, only suffers, as they expect no thing in return
+for the merchandise they export but that in which they so much abound,
+and is of little use to them, the loss does not much affect them.  They
+think, therefore, it would be too severe to revenge a loss attended with
+so little inconvenience, either to their lives or their subsistence, with
+the death of many persons; but if any of their people are either killed
+or wounded wrongfully, whether it be done by public authority, or only by
+private men, as soon as they hear of it they send ambassadors, and demand
+that the guilty persons may be delivered up to them, and if that is
+denied, they declare war; but if it be complied with, the offenders are
+condemned either to death or slavery.
+
+"They would be both troubled and ashamed of a bloody victory over their
+enemies; and think it would be as foolish a purchase as to buy the most
+valuable goods at too high a rate.  And in no victory do they glory so
+much as in that which is gained by dexterity and good conduct without
+bloodshed.  In such cases they appoint public triumphs, and erect
+trophies to the honour of those who have succeeded; for then do they
+reckon that a man acts suitably to his nature, when he conquers his enemy
+in such a way as that no other creature but a man could be capable of,
+and that is by the strength of his understanding.  Bears, lions, boars,
+wolves, and dogs, and all other animals, employ their bodily force one
+against another, in which, as many of them are superior to men, both in
+strength and fierceness, so they are all subdued by his reason and
+understanding.
+
+"The only design of the Utopians in war is to obtain that by force which,
+if it had been granted them in time, would have prevented the war; or, if
+that cannot be done, to take so severe a revenge on those that have
+injured them that they may be terrified from doing the like for the time
+to come.  By these ends they measure all their designs, and manage them
+so, that it is visible that the appetite of fame or vainglory does not
+work so much on there as a just care of their own security.
+
+"As soon as they declare war, they take care to have a great many
+schedules, that are sealed with their common seal, affixed in the most
+conspicuous places of their enemies' country.  This is carried secretly,
+and done in many places all at once.  In these they promise great rewards
+to such as shall kill the prince, and lesser in proportion to such as
+shall kill any other persons who are those on whom, next to the prince
+himself, they cast the chief balance of the war.  And they double the sum
+to him that, instead of killing the person so marked out, shall take him
+alive, and put him in their hands.  They offer not only indemnity, but
+rewards, to such of the persons themselves that are so marked, if they
+will act against their countrymen.  By this means those that are named in
+their schedules become not only distrustful of their fellow-citizens, but
+are jealous of one another, and are much distracted by fear and danger;
+for it has often fallen out that many of them, and even the prince
+himself, have been betrayed, by those in whom they have trusted most; for
+the rewards that the Utopians offer are so immeasurably great, that there
+is no sort of crime to which men cannot be drawn by them.  They consider
+the risk that those run who undertake such services, and offer a
+recompense proportioned to the danger--not only a vast deal of gold, but
+great revenues in lands, that lie among other nations that are their
+friends, where they may go and enjoy them very securely; and they observe
+the promises they make of their kind most religiously.  They very much
+approve of this way of corrupting their enemies, though it appears to
+others to be base and cruel; but they look on it as a wise course, to
+make an end of what would be otherwise a long war, without so much as
+hazarding one battle to decide it.  They think it likewise an act of
+mercy and love to mankind to prevent the great slaughter of those that
+must otherwise be killed in the progress of the war, both on their own
+side and on that of their enemies, by the death of a few that are most
+guilty; and that in so doing they are kind even to their enemies, and
+pity them no less than their own people, as knowing that the greater part
+of them do not engage in the war of their own accord, but are driven into
+it by the passions of their prince.
+
+"If this method does not succeed with them, then they sow seeds of
+contention among their enemies, and animate the prince's brother, or some
+of the nobility, to aspire to the crown.  If they cannot disunite them by
+domestic broils, then they engage their neighbours against them, and make
+them set on foot some old pretensions, which are never wanting to princes
+when they have occasion for them.  These they plentifully supply with
+money, though but very sparingly with any auxiliary troops; for they are
+so tender of their own people that they would not willingly exchange one
+of them, even with the prince of their enemies' country.
+
+"But as they keep their gold and silver only for such an occasion, so,
+when that offers itself, they easily part with it; since it would be no
+convenience to them, though they should reserve nothing of it to
+themselves.  For besides the wealth that they have among them at home,
+they have a vast treasure abroad; many nations round about them being
+deep in their debt: so that they hire soldiers from all places for
+carrying on their wars; but chiefly from the Zapolets, who live five
+hundred miles east of Utopia.  They are a rude, wild, and fierce nation,
+who delight in the woods and rocks, among which they were born and bred
+up.  They are hardened both against heat, cold, and labour, and know
+nothing of the delicacies of life.  They do not apply themselves to
+agriculture, nor do they care either for their houses or their clothes:
+cattle is all that they look after; and for the greatest part they live
+either by hunting or upon rapine; and are made, as it were, only for war.
+They watch all opportunities of engaging in it, and very readily embrace
+such as are offered them.  Great numbers of them will frequently go out,
+and offer themselves for a very low pay, to serve any that will employ
+them: they know none of the arts of life, but those that lead to the
+taking it away; they serve those that hire them, both with much courage
+and great fidelity; but will not engage to serve for any determined time,
+and agree upon such terms, that the next day they may go over to the
+enemies of those whom they serve if they offer them a greater
+encouragement; and will, perhaps, return to them the day after that upon
+a higher advance of their pay.  There are few wars in which they make not
+a considerable part of the armies of both sides: so it often falls out
+that they who are related, and were hired in the same country, and so
+have lived long and familiarly together, forgetting both their relations
+and former friendship, kill one another upon no other consideration than
+that of being hired to it for a little money by princes of different
+interests; and such a regard have they for money that they are easily
+wrought on by the difference of one penny a day to change sides.  So
+entirely does their avarice influence them; and yet this money, which
+they value so highly, is of little use to them; for what they purchase
+thus with their blood they quickly waste on luxury, which among them is
+but of a poor and miserable form.
+
+"This nation serves the Utopians against all people whatsoever, for they
+pay higher than any other.  The Utopians hold this for a maxim, that as
+they seek out the best sort of men for their own use at home, so they
+make use of this worst sort of men for the consumption of war; and
+therefore they hire them with the offers of vast rewards to expose
+themselves to all sorts of hazards, out of which the greater part never
+returns to claim their promises; yet they make them good most religiously
+to such as escape.  This animates them to adventure again, whenever there
+is occasion for it; for the Utopians are not at all troubled how many of
+these happen to be killed, and reckon it a service done to mankind if
+they could be a means to deliver the world from such a lewd and vicious
+sort of people, that seem to have run together, as to the drain of human
+nature.  Next to these, they are served in their wars with those upon
+whose account they undertake them, and with the auxiliary troops of their
+other friends, to whom they join a few of their own people, and send some
+man of eminent and approved virtue to command in chief.  There are two
+sent with him, who, during his command, are but private men, but the
+first is to succeed him if he should happen to be either killed or taken;
+and, in case of the like misfortune to him, the third comes in his place;
+and thus they provide against all events, that such accidents as may
+befall their generals may not endanger their armies.  When they draw out
+troops of their own people, they take such out of every city as freely
+offer themselves, for none are forced to go against their wills, since
+they think that if any man is pressed that wants courage, he will not
+only act faintly, but by his cowardice dishearten others.  But if an
+invasion is made on their country, they make use of such men, if they
+have good bodies, though they are not brave; and either put them aboard
+their ships, or place them on the walls of their towns, that being so
+posted, they may find no opportunity of flying away; and thus either
+shame, the heat of action, or the impossibility of flying, bears down
+their cowardice; they often make a virtue of necessity, and behave
+themselves well, because nothing else is left them.  But as they force no
+man to go into any foreign war against his will, so they do not hinder
+those women who are willing to go along with their husbands; on the
+contrary, they encourage and praise them, and they stand often next their
+husbands in the front of the army.  They also place together those who
+are related, parents, and children, kindred, and those that are mutually
+allied, near one another; that those whom nature has inspired with the
+greatest zeal for assisting one another may be the nearest and readiest
+to do it; and it is matter of great reproach if husband or wife survive
+one another, or if a child survives his parent, and therefore when they
+come to be engaged in action, they continue to fight to the last man, if
+their enemies stand before them: and as they use all prudent methods to
+avoid the endangering their own men, and if it is possible let all the
+action and danger fall upon the troops that they hire, so if it becomes
+necessary for themselves to engage, they then charge with as much courage
+as they avoided it before with prudence: nor is it a fierce charge at
+first, but it increases by degrees; and as they continue in action, they
+grow more obstinate, and press harder upon the enemy, insomuch that they
+will much sooner die than give ground; for the certainty that their
+children will be well looked after when they are dead frees them from all
+that anxiety concerning them which often masters men of great courage;
+and thus they are animated by a noble and invincible resolution.  Their
+skill in military affairs increases their courage: and the wise
+sentiments which, according to the laws of their country, are instilled
+into them in their education, give additional vigour to their minds: for
+as they do not undervalue life so as prodigally to throw it away, they
+are not so indecently fond of it as to preserve it by base and unbecoming
+methods.  In the greatest heat of action the bravest of their youth, who
+have devoted themselves to that service, single out the general of their
+enemies, set on him either openly or by ambuscade; pursue him everywhere,
+and when spent and wearied out, are relieved by others, who never give
+over the pursuit, either attacking him with close weapons when they can
+get near him, or with those which wound at a distance, when others get in
+between them.  So that, unless he secures himself by flight, they seldom
+fail at last to kill or to take him prisoner.  When they have obtained a
+victory, they kill as few as possible, and are much more bent on taking
+many prisoners than on killing those that fly before them.  Nor do they
+ever let their men so loose in the pursuit of their enemies as not to
+retain an entire body still in order; so that if they have been forced to
+engage the last of their battalions before they could gain the day, they
+will rather let their enemies all escape than pursue them when their own
+army is in disorder; remembering well what has often fallen out to
+themselves, that when the main body of their army has been quite defeated
+and broken, when their enemies, imagining the victory obtained, have let
+themselves loose into an irregular pursuit, a few of them that lay for a
+reserve, waiting a fit opportunity, have fallen on them in their chase,
+and when straggling in disorder, and apprehensive of no danger, but
+counting the day their own, have turned the whole action, and, wresting
+out of their hands a victory that seemed certain and undoubted, while the
+vanquished have suddenly become victorious.
+
+"It is hard to tell whether they are more dexterous in laying or avoiding
+ambushes.  They sometimes seem to fly when it is far from their thoughts;
+and when they intend to give ground, they do it so that it is very hard
+to find out their design.  If they see they are ill posted, or are like
+to be overpowered by numbers, they then either march off in the night
+with great silence, or by some stratagem delude their enemies.  If they
+retire in the day-time, they do it in such order that it is no less
+dangerous to fall upon them in a retreat than in a march.  They fortify
+their camps with a deep and large trench; and throw up the earth that is
+dug out of it for a wall; nor do they employ only their slaves in this,
+but the whole army works at it, except those that are then upon the
+guard; so that when so many hands are at work, a great line and a strong
+fortification is finished in so short a time that it is scarce credible.
+Their armour is very strong for defence, and yet is not so heavy as to
+make them uneasy in their marches; they can even swim with it.  All that
+are trained up to war practise swimming.  Both horse and foot make great
+use of arrows, and are very expert.  They have no swords, but fight with
+a pole-axe that is both sharp and heavy, by which they thrust or strike
+down an enemy.  They are very good at finding out warlike machines, and
+disguise them so well that the enemy does not perceive them till he feels
+the use of them; so that he cannot prepare such a defence as would render
+them useless; the chief consideration had in the making them is that they
+may be easily carried and managed.
+
+"If they agree to a truce, they observe it so religiously that no
+provocations will make them break it.  They never lay their enemies'
+country waste nor burn their corn, and even in their marches they take
+all possible care that neither horse nor foot may tread it down, for they
+do not know but that they may have use for it themselves.  They hurt no
+man whom they find disarmed, unless he is a spy.  When a town is
+surrendered to them, they take it into their protection; and when they
+carry a place by storm they never plunder it, but put those only to the
+sword that oppose the rendering of it up, and make the rest of the
+garrison slaves, but for the other inhabitants, they do them no hurt; and
+if any of them had advised a surrender, they give them good rewards out
+of the estates of those that they condemn, and distribute the rest among
+their auxiliary troops, but they themselves take no share of the spoil.
+
+"When a war is ended, they do not oblige their friends to reimburse their
+expenses; but they obtain them of the conquered, either in money, which
+they keep for the next occasion, or in lands, out of which a constant
+revenue is to be paid them; by many increases the revenue which they draw
+out from several countries on such occasions is now risen to above
+700,000 ducats a year.  They send some of their own people to receive
+these revenues, who have orders to live magnificently and like princes,
+by which means they consume much of it upon the place; and either bring
+over the rest to Utopia or lend it to that nation in which it lies.  This
+they most commonly do, unless some great occasion, which falls out but
+very seldom, should oblige them to call for it all.  It is out of these
+lands that they assign rewards to such as they encourage to adventure on
+desperate attempts.  If any prince that engages in war with them is
+making preparations for invading their country, they prevent him, and
+make his country the seat of the war; for they do not willingly suffer
+any war to break in upon their island; and if that should happen, they
+would only defend themselves by their own people; but would not call for
+auxiliary troops to their assistance.
+
+
+
+OF THE RELIGIONS OF THE UTOPIANS
+
+
+"There are several sorts of religions, not only in different parts of the
+island, but even in every town; some worshipping the sun, others the moon
+or one of the planets.  Some worship such men as have been eminent in
+former times for virtue or glory, not only as ordinary deities, but as
+the supreme god.  Yet the greater and wiser sort of them worship none of
+these, but adore one eternal, invisible, infinite, and incomprehensible
+Deity; as a Being that is far above all our apprehensions, that is spread
+over the whole universe, not by His bulk, but by His power and virtue;
+Him they call the Father of All, and acknowledge that the beginnings, the
+increase, the progress, the vicissitudes, and the end of all things come
+only from Him; nor do they offer divine honours to any but to Him alone.
+And, indeed, though they differ concerning other things, yet all agree in
+this: that they think there is one Supreme Being that made and governs
+the world, whom they call, in the language of their country, Mithras.
+They differ in this: that one thinks the god whom he worships is this
+Supreme Being, and another thinks that his idol is that god; but they all
+agree in one principle, that whoever is this Supreme Being, He is also
+that great essence to whose glory and majesty all honours are ascribed by
+the consent of all nations.
+
+"By degrees they fall off from the various superstitions that are among
+them, and grow up to that one religion that is the best and most in
+request; and there is no doubt to be made, but that all the others had
+vanished long ago, if some of those who advised them to lay aside their
+superstitions had not met with some unhappy accidents, which, being
+considered as inflicted by heaven, made them afraid that the god whose
+worship had like to have been abandoned had interposed and revenged
+themselves on those who despised their authority.
+
+"After they had heard from us an account of the doctrine, the course of
+life, and the miracles of Christ, and of the wonderful constancy of so
+many martyrs, whose blood, so willingly offered up by them, was the chief
+occasion of spreading their religion over a vast number of nations, it is
+not to be imagined how inclined they were to receive it.  I shall not
+determine whether this proceeded from any secret inspiration of God, or
+whether it was because it seemed so favourable to that community of
+goods, which is an opinion so particular as well as so dear to them;
+since they perceived that Christ and His followers lived by that rule,
+and that it was still kept up in some communities among the sincerest
+sort of Christians.  From whichsoever of these motives it might be, true
+it is, that many of them came over to our religion, and were initiated
+into it by baptism.  But as two of our number were dead, so none of the
+four that survived were in priests' orders, we, therefore, could only
+baptise them, so that, to our great regret, they could not partake of the
+other sacraments, that can only be administered by priests, but they are
+instructed concerning them and long most vehemently for them.  They have
+had great disputes among themselves, whether one chosen by them to be a
+priest would not be thereby qualified to do all the things that belong to
+that character, even though he had no authority derived from the Pope,
+and they seemed to be resolved to choose some for that employment, but
+they had not done it when I left them.
+
+"Those among them that have not received our religion do not fright any
+from it, and use none ill that goes over to it, so that all the while I
+was there one man was only punished on this occasion.  He being newly
+baptised did, notwithstanding all that we could say to the contrary,
+dispute publicly concerning the Christian religion, with more zeal than
+discretion, and with so much heat, that he not only preferred our worship
+to theirs, but condemned all their rites as profane, and cried out
+against all that adhered to them as impious and sacrilegious persons,
+that were to be damned to everlasting burnings.  Upon his having
+frequently preached in this manner he was seized, and after trial he was
+condemned to banishment, not for having disparaged their religion, but
+for his inflaming the people to sedition; for this is one of their most
+ancient laws, that no man ought to be punished for his religion.  At the
+first constitution of their government, Utopus having understood that
+before his coming among them the old inhabitants had been engaged in
+great quarrels concerning religion, by which they were so divided among
+themselves, that he found it an easy thing to conquer them, since,
+instead of uniting their forces against him, every different party in
+religion fought by themselves.  After he had subdued them he made a law
+that every man might be of what religion he pleased, and might endeavour
+to draw others to it by the force of argument and by amicable and modest
+ways, but without bitterness against those of other opinions; but that he
+ought to use no other force but that of persuasion, and was neither to
+mix with it reproaches nor violence; and such as did otherwise were to be
+condemned to banishment or slavery.
+
+"This law was made by Utopus, not only for preserving the public peace,
+which he saw suffered much by daily contentions and irreconcilable heats,
+but because he thought the interest of religion itself required it.  He
+judged it not fit to determine anything rashly; and seemed to doubt
+whether those different forms of religion might not all come from God,
+who might inspire man in a different manner, and be pleased with this
+variety; he therefore thought it indecent and foolish for any man to
+threaten and terrify another to make him believe what did not appear to
+him to be true.  And supposing that only one religion was really true,
+and the rest false, he imagined that the native force of truth would at
+last break forth and shine bright, if supported only by the strength of
+argument, and attended to with a gentle and unprejudiced mind; while, on
+the other hand, if such debates were carried on with violence and
+tumults, as the most wicked are always the most obstinate, so the best
+and most holy religion might be choked with superstition, as corn is with
+briars and thorns; he therefore left men wholly to their liberty, that
+they might be free to believe as they should see cause; only he made a
+solemn and severe law against such as should so far degenerate from the
+dignity of human nature, as to think that our souls died with our bodies,
+or that the world was governed by chance, without a wise overruling
+Providence: for they all formerly believed that there was a state of
+rewards and punishments to the good and bad after this life; and they now
+look on those that think otherwise as scarce fit to be counted men, since
+they degrade so noble a being as the soul, and reckon it no better than a
+beast's: thus they are far from looking on such men as fit for human
+society, or to be citizens of a well-ordered commonwealth; since a man of
+such principles must needs, as oft as he dares do it, despise all their
+laws and customs: for there is no doubt to be made, that a man who is
+afraid of nothing but the law, and apprehends nothing after death, will
+not scruple to break through all the laws of his country, either by fraud
+or force, when by this means he may satisfy his appetites.  They never
+raise any that hold these maxims, either to honours or offices, nor
+employ them in any public trust, but despise them, as men of base and
+sordid minds.  Yet they do not punish them, because they lay this down as
+a maxim, that a man cannot make himself believe anything he pleases; nor
+do they drive any to dissemble their thoughts by threatenings, so that
+men are not tempted to lie or disguise their opinions; which being a sort
+of fraud, is abhorred by the Utopians: they take care indeed to prevent
+their disputing in defence of these opinions, especially before the
+common people: but they suffer, and even encourage them to dispute
+concerning them in private with their priest, and other grave men, being
+confident that they will be cured of those mad opinions by having reason
+laid before them.  There are many among them that run far to the other
+extreme, though it is neither thought an ill nor unreasonable opinion,
+and therefore is not at all discouraged.  They think that the souls of
+beasts are immortal, though far inferior to the dignity of the human
+soul, and not capable of so great a happiness.  They are almost all of
+them very firmly persuaded that good men will be infinitely happy in
+another state: so that though they are compassionate to all that are
+sick, yet they lament no man's death, except they see him loath to part
+with life; for they look on this as a very ill presage, as if the soul,
+conscious to itself of guilt, and quite hopeless, was afraid to leave the
+body, from some secret hints of approaching misery.  They think that such
+a man's appearance before God cannot be acceptable to Him, who being
+called on, does not go out cheerfully, but is backward and unwilling, and
+is as it were dragged to it.  They are struck with horror when they see
+any die in this manner, and carry them out in silence and with sorrow,
+and praying God that He would be merciful to the errors of the departed
+soul, they lay the body in the ground: but when any die cheerfully, and
+full of hope, they do not mourn for them, but sing hymns when they carry
+out their bodies, and commending their souls very earnestly to God: their
+whole behaviour is then rather grave than sad, they burn the body, and
+set up a pillar where the pile was made, with an inscription to the
+honour of the deceased.  When they come from the funeral, they discourse
+of his good life, and worthy actions, but speak of nothing oftener and
+with more pleasure than of his serenity at the hour of death.  They think
+such respect paid to the memory of good men is both the greatest
+incitement to engage others to follow their example, and the most
+acceptable worship that can be offered them; for they believe that though
+by the imperfection of human sight they are invisible to us, yet they are
+present among us, and hear those discourses that pass concerning
+themselves.  They believe it inconsistent with the happiness of departed
+souls not to be at liberty to be where they will: and do not imagine them
+capable of the ingratitude of not desiring to see those friends with whom
+they lived on earth in the strictest bonds of love and kindness: besides,
+they are persuaded that good men, after death, have these affections; and
+all other good dispositions increased rather than diminished, and
+therefore conclude that they are still among the living, and observe all
+they say or do.  From hence they engage in all their affairs with the
+greater confidence of success, as trusting to their protection; while
+this opinion of the presence of their ancestors is a restraint that
+prevents their engaging in ill designs.
+
+"They despise and laugh at auguries, and the other vain and superstitious
+ways of divination, so much observed among other nations; but have great
+reverence for such miracles as cannot flow from any of the powers of
+nature, and look on them as effects and indications of the presence of
+the Supreme Being, of which they say many instances have occurred among
+them; and that sometimes their public prayers, which upon great and
+dangerous occasions they have solemnly put up to God, with assured
+confidence of being heard, have been answered in a miraculous manner.
+
+"They think the contemplating God in His works, and the adoring Him for
+them, is a very acceptable piece of worship to Him.
+
+"There are many among them that upon a motive of religion neglect
+learning, and apply themselves to no sort of study; nor do they allow
+themselves any leisure time, but are perpetually employed, believing that
+by the good things that a man does he secures to himself that happiness
+that comes after death.  Some of these visit the sick; others mend
+highways, cleanse ditches, repair bridges, or dig turf, gravel, or stone.
+Others fell and cleave timber, and bring wood, corn, and other
+necessaries, on carts, into their towns; nor do these only serve the
+public, but they serve even private men, more than the slaves themselves
+do: for if there is anywhere a rough, hard, and sordid piece of work to
+be done, from which many are frightened by the labour and loathsomeness
+of it, if not the despair of accomplishing it, they cheerfully, and of
+their own accord, take that to their share; and by that means, as they
+ease others very much, so they afflict themselves, and spend their whole
+life in hard labour: and yet they do not value themselves upon this, nor
+lessen other people's credit to raise their own; but by their stooping to
+such servile employments they are so far from being despised, that they
+are so much the more esteemed by the whole nation.
+
+"Of these there are two sorts: some live unmarried and chaste, and
+abstain from eating any sort of flesh; and thus weaning themselves from
+all the pleasures of the present life, which they account hurtful, they
+pursue, even by the hardest and painfullest methods possible, that
+blessedness which they hope for hereafter; and the nearer they approach
+to it, they are the more cheerful and earnest in their endeavours after
+it.  Another sort of them is less willing to put themselves to much toil,
+and therefore prefer a married state to a single one; and as they do not
+deny themselves the pleasure of it, so they think the begetting of
+children is a debt which they owe to human nature, and to their country;
+nor do they avoid any pleasure that does not hinder labour; and therefore
+eat flesh so much the more willingly, as they find that by this means
+they are the more able to work: the Utopians look upon these as the wiser
+sect, but they esteem the others as the most holy.  They would indeed
+laugh at any man who, from the principles of reason, would prefer an
+unmarried state to a married, or a life of labour to an easy life: but
+they reverence and admire such as do it from the motives of religion.
+There is nothing in which they are more cautious than in giving their
+opinion positively concerning any sort of religion.  The men that lead
+those severe lives are called in the language of their country
+Brutheskas, which answers to those we call Religious Orders.
+
+"Their priests are men of eminent piety, and therefore they are but few,
+for there are only thirteen in every town, one for every temple; but when
+they go to war, seven of these go out with their forces, and seven others
+are chosen to supply their room in their absence; but these enter again
+upon their employments when they return; and those who served in their
+absence, attend upon the high priest, till vacancies fall by death; for
+there is one set over the rest.  They are chosen by the people as the
+other magistrates are, by suffrages given in secret, for preventing of
+factions: and when they are chosen, they are consecrated by the college
+of priests.  The care of all sacred things, the worship of God, and an
+inspection into the manners of the people, are committed to them.  It is
+a reproach to a man to be sent for by any of them, or for them to speak
+to him in secret, for that always gives some suspicion: all that is
+incumbent on them is only to exhort and admonish the people; for the
+power of correcting and punishing ill men belongs wholly to the Prince,
+and to the other magistrates: the severest thing that the priest does is
+the excluding those that are desperately wicked from joining in their
+worship: there is not any sort of punishment more dreaded by them than
+this, for as it loads them with infamy, so it fills them with secret
+horrors, such is their reverence to their religion; nor will their bodies
+be long exempted from their share of trouble; for if they do not very
+quickly satisfy the priests of the truth of their repentance, they are
+seized on by the Senate, and punished for their impiety.  The education
+of youth belongs to the priests, yet they do not take so much care of
+instructing them in letters, as in forming their minds and manners
+aright; they use all possible methods to infuse, very early, into the
+tender and flexible minds of children, such opinions as are both good in
+themselves and will be useful to their country, for when deep impressions
+of these things are made at that age, they follow men through the whole
+course of their lives, and conduce much to preserve the peace of the
+government, which suffers by nothing more than by vices that rise out of
+ill opinions.  The wives of their priests are the most extraordinary
+women of the whole country; sometimes the women themselves are made
+priests, though that falls out but seldom, nor are any but ancient widows
+chosen into that order.
+
+"None of the magistrates have greater honour paid them than is paid the
+priests; and if they should happen to commit any crime, they would not be
+questioned for it; their punishment is left to God, and to their own
+consciences; for they do not think it lawful to lay hands on any man, how
+wicked soever he is, that has been in a peculiar manner dedicated to God;
+nor do they find any great inconvenience in this, both because they have
+so few priests, and because these are chosen with much caution, so that
+it must be a very unusual thing to find one who, merely out of regard to
+his virtue, and for his being esteemed a singularly good man, was raised
+up to so great a dignity, degenerate into corruption and vice; and if
+such a thing should fall out, for man is a changeable creature, yet,
+there being few priests, and these having no authority but what rises out
+of the respect that is paid them, nothing of great consequence to the
+public can proceed from the indemnity that the priests enjoy.
+
+"They have, indeed, very few of them, lest greater numbers sharing in the
+same honour might make the dignity of that order, which they esteem so
+highly, to sink in its reputation; they also think it difficult to find
+out many of such an exalted pitch of goodness as to be equal to that
+dignity, which demands the exercise of more than ordinary virtues.  Nor
+are the priests in greater veneration among them than they are among
+their neighbouring nations, as you may imagine by that which I think
+gives occasion for it.
+
+"When the Utopians engage in battle, the priests who accompany them to
+the war, apparelled in their sacred vestments, kneel down during the
+action (in a place not far from the field), and, lifting up their hands
+to heaven, pray, first for peace, and then for victory to their own side,
+and particularly that it may be gained without the effusion of much blood
+on either side; and when the victory turns to their side, they run in
+among their own men to restrain their fury; and if any of their enemies
+see them or call to them, they are preserved by that means; and such as
+can come so near them as to touch their garments have not only their
+lives, but their fortunes secured to them; it is upon this account that
+all the nations round about consider them so much, and treat them with
+such reverence, that they have been often no less able to preserve their
+own people from the fury of their enemies than to save their enemies from
+their rage; for it has sometimes fallen out, that when their armies have
+been in disorder and forced to fly, so that their enemies were running
+upon the slaughter and spoil, the priests by interposing have separated
+them from one another, and stopped the effusion of more blood; so that,
+by their mediation, a peace has been concluded on very reasonable terms;
+nor is there any nation about them so fierce, cruel, or barbarous, as not
+to look upon their persons as sacred and inviolable.
+
+"The first and the last day of the month, and of the year, is a festival;
+they measure their months by the course of the moon, and their years by
+the course of the sun: the first days are called in their language the
+Cynemernes, and the last the Trapemernes, which answers in our language,
+to the festival that begins or ends the season.
+
+"They have magnificent temples, that are not only nobly built, but
+extremely spacious, which is the more necessary as they have so few of
+them; they are a little dark within, which proceeds not from any error in
+the architecture, but is done with design; for their priests think that
+too much light dissipates the thoughts, and that a more moderate degree
+of it both recollects the mind and raises devotion.  Though there are
+many different forms of religion among them, yet all these, how various
+soever, agree in the main point, which is the worshipping the Divine
+Essence; and, therefore, there is nothing to be seen or heard in their
+temples in which the several persuasions among them may not agree; for
+every sect performs those rites that are peculiar to it in their private
+houses, nor is there anything in the public worship that contradicts the
+particular ways of those different sects.  There are no images for God in
+their temples, so that every one may represent Him to his thoughts
+according to the way of his religion; nor do they call this one God by
+any other name but that of Mithras, which is the common name by which
+they all express the Divine Essence, whatsoever otherwise they think it
+to be; nor are there any prayers among them but such as every one of them
+may use without prejudice to his own opinion.
+
+"They meet in their temples on the evening of the festival that concludes
+a season, and not having yet broke their fast, they thank God for their
+good success during that year or month which is then at an end; and the
+next day, being that which begins the new season, they meet early in
+their temples, to pray for the happy progress of all their affairs during
+that period upon which they then enter.  In the festival which concludes
+the period, before they go to the temple, both wives and children fall on
+their knees before their husbands or parents and confess everything in
+which they have either erred or failed in their duty, and beg pardon for
+it.  Thus all little discontents in families are removed, that they may
+offer up their devotions with a pure and serene mind; for they hold it a
+great impiety to enter upon them with disturbed thoughts, or with a
+consciousness of their bearing hatred or anger in their hearts to any
+person whatsoever; and think that they should become liable to severe
+punishments if they presumed to offer sacrifices without cleansing their
+hearts, and reconciling all their differences.  In the temples the two
+sexes are separated, the men go to the right hand, and the women to the
+left; and the males and females all place themselves before the head and
+master or mistress of the family to which they belong, so that those who
+have the government of them at home may see their deportment in public.
+And they intermingle them so, that the younger and the older may be set
+by one another; for if the younger sort were all set together, they
+would, perhaps, trifle away that time too much in which they ought to
+beget in themselves that religious dread of the Supreme Being which is
+the greatest and almost the only incitement to virtue.
+
+"They offer up no living creature in sacrifice, nor do they think it
+suitable to the Divine Being, from whose bounty it is that these
+creatures have derived their lives, to take pleasure in their deaths, or
+the offering up their blood.  They burn incense and other sweet odours,
+and have a great number of wax lights during their worship, not out of
+any imagination that such oblations can add anything to the divine nature
+(which even prayers cannot do), but as it is a harmless and pure way of
+worshipping God; so they think those sweet savours and lights, together
+with some other ceremonies, by a secret and unaccountable virtue, elevate
+men's souls, and inflame them with greater energy and cheerfulness during
+the divine worship.
+
+"All the people appear in the temples in white garments; but the priest's
+vestments are parti-coloured, and both the work and colours are
+wonderful.  They are made of no rich materials, for they are neither
+embroidered nor set with precious stones; but are composed of the plumes
+of several birds, laid together with so much art, and so neatly, that the
+true value of them is far beyond the costliest materials.  They say, that
+in the ordering and placing those plumes some dark mysteries are
+represented, which pass down among their priests in a secret tradition
+concerning them; and that they are as hieroglyphics, putting them in mind
+of the blessing that they have received from God, and of their duties,
+both to Him and to their neighbours.  As soon as the priest appears in
+those ornaments, they all fall prostrate on the ground, with so much
+reverence and so deep a silence, that such as look on cannot but be
+struck with it, as if it were the effect of the appearance of a deity.
+After they have been for some time in this posture, they all stand up,
+upon a sign given by the priest, and sing hymns to the honour of God,
+some musical instruments playing all the while.  These are quite of
+another form than those used among us; but, as many of them are much
+sweeter than ours, so others are made use of by us.  Yet in one thing
+they very much exceed us: all their music, both vocal and instrumental,
+is adapted to imitate and express the passions, and is so happily suited
+to every occasion, that, whether the subject of the hymn be cheerful, or
+formed to soothe or trouble the mind, or to express grief or remorse, the
+music takes the impression of whatever is represented, affects and
+kindles the passions, and works the sentiments deep into the hearts of
+the hearers.  When this is done, both priests and people offer up very
+solemn prayers to God in a set form of words; and these are so composed,
+that whatsoever is pronounced by the whole assembly may be likewise
+applied by every man in particular to his own condition.  In these they
+acknowledge God to be the author and governor of the world, and the
+fountain of all the good they receive, and therefore offer up to him
+their thanksgiving; and, in particular, bless him for His goodness in
+ordering it so, that they are born under the happiest government in the
+world, and are of a religion which they hope is the truest of all others;
+but, if they are mistaken, and if there is either a better government, or
+a religion more acceptable to God, they implore His goodness to let them
+know it, vowing that they resolve to follow him whithersoever he leads
+them; but if their government is the best, and their religion the truest,
+then they pray that He may fortify them in it, and bring all the world
+both to the same rules of life, and to the same opinions concerning
+Himself, unless, according to the unsearchableness of His mind, He is
+pleased with a variety of religions.  Then they pray that God may give
+them an easy passage at last to Himself, not presuming to set limits to
+Him, how early or late it should be; but, if it may be wished for without
+derogating from His supreme authority, they desire to be quickly
+delivered, and to be taken to Himself, though by the most terrible kind
+of death, rather than to be detained long from seeing Him by the most
+prosperous course of life.  When this prayer is ended, they all fall down
+again upon the ground; and, after a little while, they rise up, go home
+to dinner, and spend the rest of the day in diversion or military
+exercises.
+
+"Thus have I described to you, as particularly as I could, the
+Constitution of that commonwealth, which I do not only think the best in
+the world, but indeed the only commonwealth that truly deserves that
+name.  In all other places it is visible that, while people talk of a
+commonwealth, every man only seeks his own wealth; but there, where no
+man has any property, all men zealously pursue the good of the public,
+and, indeed, it is no wonder to see men act so differently, for in other
+commonwealths every man knows that, unless he provides for himself, how
+flourishing soever the commonwealth may be, he must die of hunger, so
+that he sees the necessity of preferring his own concerns to the public;
+but in Utopia, where every man has a right to everything, they all know
+that if care is taken to keep the public stores full no private man can
+want anything; for among them there is no unequal distribution, so that
+no man is poor, none in necessity, and though no man has anything, yet
+they are all rich; for what can make a man so rich as to lead a serene
+and cheerful life, free from anxieties; neither apprehending want
+himself, nor vexed with the endless complaints of his wife?  He is not
+afraid of the misery of his children, nor is he contriving how to raise a
+portion for his daughters; but is secure in this, that both he and his
+wife, his children and grand-children, to as many generations as he can
+fancy, will all live both plentifully and happily; since, among them,
+there is no less care taken of those who were once engaged in labour, but
+grow afterwards unable to follow it, than there is, elsewhere, of these
+that continue still employed.  I would gladly hear any man compare the
+justice that is among them with that of all other nations; among whom,
+may I perish, if I see anything that looks either like justice or equity;
+for what justice is there in this: that a nobleman, a goldsmith, a
+banker, or any other man, that either does nothing at all, or, at best,
+is employed in things that are of no use to the public, should live in
+great luxury and splendour upon what is so ill acquired, and a mean man,
+a carter, a smith, or a ploughman, that works harder even than the beasts
+themselves, and is employed in labours so necessary, that no commonwealth
+could hold out a year without them, can only earn so poor a livelihood
+and must lead so miserable a life, that the condition of the beasts is
+much better than theirs?  For as the beasts do not work so constantly, so
+they feed almost as well, and with more pleasure, and have no anxiety
+about what is to come, whilst these men are depressed by a barren and
+fruitless employment, and tormented with the apprehensions of want in
+their old age; since that which they get by their daily labour does but
+maintain them at present, and is consumed as fast as it comes in, there
+is no overplus left to lay up for old age.
+
+"Is not that government both unjust and ungrateful, that is so prodigal
+of its favours to those that are called gentlemen, or goldsmiths, or such
+others who are idle, or live either by flattery or by contriving the arts
+of vain pleasure, and, on the other hand, takes no care of those of a
+meaner sort, such as ploughmen, colliers, and smiths, without whom it
+could not subsist?  But after the public has reaped all the advantage of
+their service, and they come to be oppressed with age, sickness, and
+want, all their labours and the good they have done is forgotten, and all
+the recompense given them is that they are left to die in great misery.
+The richer sort are often endeavouring to bring the hire of labourers
+lower, not only by their fraudulent practices, but by the laws which they
+procure to be made to that effect, so that though it is a thing most
+unjust in itself to give such small rewards to those who deserve so well
+of the public, yet they have given those hardships the name and colour of
+justice, by procuring laws to be made for regulating them.
+
+"Therefore I must say that, as I hope for mercy, I can have no other
+notion of all the other governments that I see or know, than that they
+are a conspiracy of the rich, who, on pretence of managing the public,
+only pursue their private ends, and devise all the ways and arts they can
+find out; first, that they may, without danger, preserve all that they
+have so ill-acquired, and then, that they may engage the poor to toil and
+labour for them at as low rates as possible, and oppress them as much as
+they please; and if they can but prevail to get these contrivances
+established by the show of public authority, which is considered as the
+representative of the whole people, then they are accounted laws; yet
+these wicked men, after they have, by a most insatiable covetousness,
+divided that among themselves with which all the rest might have been
+well supplied, are far from that happiness that is enjoyed among the
+Utopians; for the use as well as the desire of money being extinguished,
+much anxiety and great occasions of mischief is cut off with it, and who
+does not see that the frauds, thefts, robberies, quarrels, tumults,
+contentions, seditions, murders, treacheries, and witchcrafts, which are,
+indeed, rather punished than restrained by the seventies of law, would
+all fall off, if money were not any more valued by the world?  Men's
+fears, solicitudes, cares, labours, and watchings would all perish in the
+same moment with the value of money; even poverty itself, for the relief
+of which money seems most necessary, would fall.  But, in order to the
+apprehending this aright, take one instance:--
+
+"Consider any year, that has been so unfruitful that many thousands have
+died of hunger; and yet if, at the end of that year, a survey was made of
+the granaries of all the rich men that have hoarded up the corn, it would
+be found that there was enough among them to have prevented all that
+consumption of men that perished in misery; and that, if it had been
+distributed among them, none would have felt the terrible effects of that
+scarcity: so easy a thing would it be to supply all the necessities of
+life, if that blessed thing called money, which is pretended to be
+invented for procuring them was not really the only thing that obstructed
+their being procured!
+
+"I do not doubt but rich men are sensible of this, and that they well
+know how much a greater happiness it is to want nothing necessary, than
+to abound in many superfluities; and to be rescued out of so much misery,
+than to abound with so much wealth: and I cannot think but the sense of
+every man's interest, added to the authority of Christ's commands, who,
+as He was infinitely wise, knew what was best, and was not less good in
+discovering it to us, would have drawn all the world over to the laws of
+the Utopians, if pride, that plague of human nature, that source of so
+much misery, did not hinder it; for this vice does not measure happiness
+so much by its own conveniences, as by the miseries of others; and would
+not be satisfied with being thought a goddess, if none were left that
+were miserable, over whom she might insult.  Pride thinks its own
+happiness shines the brighter, by comparing it with the misfortunes of
+other persons; that by displaying its own wealth they may feel their
+poverty the more sensibly.  This is that infernal serpent that creeps
+into the breasts of mortals, and possesses them too much to be easily
+drawn out; and, therefore, I am glad that the Utopians have fallen upon
+this form of government, in which I wish that all the world could be so
+wise as to imitate them; for they have, indeed, laid down such a scheme
+and foundation of policy, that as men live happily under it, so it is
+like to be of great continuance; for they having rooted out of the minds
+of their people all the seeds, both of ambition and faction, there is no
+danger of any commotions at home; which alone has been the ruin of many
+states that seemed otherwise to be well secured; but as long as they live
+in peace at home, and are governed by such good laws, the envy of all
+their neighbouring princes, who have often, though in vain, attempted
+their ruin, will never be able to put their state into any commotion or
+disorder."
+
+When Raphael had thus made an end of speaking, though many things
+occurred to me, both concerning the manners and laws of that people, that
+seemed very absurd, as well in their way of making war, as in their
+notions of religion and divine matters--together with several other
+particulars, but chiefly what seemed the foundation of all the rest,
+their living in common, without the use of money, by which all nobility,
+magnificence, splendour, and majesty, which, according to the common
+opinion, are the true ornaments of a nation, would be quite taken
+away--yet since I perceived that Raphael was weary, and was not sure
+whether he could easily bear contradiction, remembering that he had taken
+notice of some, who seemed to think they were bound in honour to support
+the credit of their own wisdom, by finding out something to censure in
+all other men's inventions, besides their own, I only commended their
+Constitution, and the account he had given of it in general; and so,
+taking him by the hand, carried him to supper, and told him I would find
+out some other time for examining this subject more particularly, and for
+discoursing more copiously upon it.  And, indeed, I shall be glad to
+embrace an opportunity of doing it.  In the meanwhile, though it must be
+confessed that he is both a very learned man and a person who has
+obtained a great knowledge of the world, I cannot perfectly agree to
+everything he has related.  However, there are many things in the
+commonwealth of Utopia that I rather wish, than hope, to see followed in
+our governments.
+
+
+
+***END OF THE PROJECT GUTENBERG EBOOK UTOPIA***
+
+
+******* This file should be named 2130.txt or 2130.zip *******
+
+
+This and all associated files of various formats will be found in:
+http://www.gutenberg.org/dirs/2/1/3/2130
+
+
+
+Updated editions will replace the previous one--the old editions
+will be renamed.
+
+Creating the works from public domain print editions means that no
+one owns a United States copyright in these works, so the Foundation
+(and you!) can copy and distribute it in the United States without
+permission and without paying copyright royalties.  Special rules,
+set forth in the General Terms of Use part of this license, apply to
+copying and distributing Project Gutenberg-tm electronic works to
+protect the PROJECT GUTENBERG-tm concept and trademark.  Project
+Gutenberg is a registered trademark, and may not be used if you
+charge for the eBooks, unless you receive specific permission.  If you
+do not charge anything for copies of this eBook, complying with the
+rules is very easy.  You may use this eBook for nearly any purpose
+such as creation of derivative works, reports, performances and
+research.  They may be modified and printed and given away--you may do
+practically ANYTHING with public domain eBooks.  Redistribution is
+subject to the trademark license, especially commercial
+redistribution.
+
+
+
+*** START: FULL LICENSE ***
+
+THE FULL PROJECT GUTENBERG LICENSE
+PLEASE READ THIS BEFORE YOU DISTRIBUTE OR USE THIS WORK
+
+To protect the Project Gutenberg-tm mission of promoting the free
+distribution of electronic works, by using or distributing this work
+(or any other work associated in any way with the phrase "Project
+Gutenberg"), you agree to comply with all the terms of the Full Project
+Gutenberg-tm License (available with this file or online at
+http://gutenberg.net/license).
+
+
+Section 1.  General Terms of Use and Redistributing Project Gutenberg-tm
+electronic works
+
+1.A.  By reading or using any part of this Project Gutenberg-tm
+electronic work, you indicate that you have read, understand, agree to
+and accept all the terms of this license and intellectual property
+(trademark/copyright) agreement.  If you do not agree to abide by all
+the terms of this agreement, you must cease using and return or destroy
+all copies of Project Gutenberg-tm electronic works in your possession.
+If you paid a fee for obtaining a copy of or access to a Project
+Gutenberg-tm electronic work and you do not agree to be bound by the
+terms of this agreement, you may obtain a refund from the person or
+entity to whom you paid the fee as set forth in paragraph 1.E.8.
+
+1.B.  "Project Gutenberg" is a registered trademark.  It may only be
+used on or associated in any way with an electronic work by people who
+agree to be bound by the terms of this agreement.  There are a few
+things that you can do with most Project Gutenberg-tm electronic works
+even without complying with the full terms of this agreement.  See
+paragraph 1.C below.  There are a lot of things you can do with Project
+Gutenberg-tm electronic works if you follow the terms of this agreement
+and help preserve free future access to Project Gutenberg-tm electronic
+works.  See paragraph 1.E below.
+
+1.C.  The Project Gutenberg Literary Archive Foundation ("the Foundation"
+or PGLAF), owns a compilation copyright in the collection of Project
+Gutenberg-tm electronic works.  Nearly all the individual works in the
+collection are in the public domain in the United States.  If an
+individual work is in the public domain in the United States and you are
+located in the United States, we do not claim a right to prevent you from
+copying, distributing, performing, displaying or creating derivative
+works based on the work as long as all references to Project Gutenberg
+are removed.  Of course, we hope that you will support the Project
+Gutenberg-tm mission of promoting free access to electronic works by
+freely sharing Project Gutenberg-tm works in compliance with the terms of
+this agreement for keeping the Project Gutenberg-tm name associated with
+the work.  You can easily comply with the terms of this agreement by
+keeping this work in the same format with its attached full Project
+Gutenberg-tm License when you share it without charge with others.
+
+1.D.  The copyright laws of the place where you are located also govern
+what you can do with this work.  Copyright laws in most countries are in
+a constant state of change.  If you are outside the United States, check
+the laws of your country in addition to the terms of this agreement
+before downloading, copying, displaying, performing, distributing or
+creating derivative works based on this work or any other Project
+Gutenberg-tm work.  The Foundation makes no representations concerning
+the copyright status of any work in any country outside the United
+States.
+
+1.E.  Unless you have removed all references to Project Gutenberg:
+
+1.E.1.  The following sentence, with active links to, or other immediate
+access to, the full Project Gutenberg-tm License must appear prominently
+whenever any copy of a Project Gutenberg-tm work (any work on which the
+phrase "Project Gutenberg" appears, or with which the phrase "Project
+Gutenberg" is associated) is accessed, displayed, performed, viewed,
+copied or distributed:
+
+This eBook is for the use of anyone anywhere at no cost and with
+almost no restrictions whatsoever.  You may copy it, give it away or
+re-use it under the terms of the Project Gutenberg License included
+with this eBook or online at www.gutenberg.net
+
+1.E.2.  If an individual Project Gutenberg-tm electronic work is derived
+from the public domain (does not contain a notice indicating that it is
+posted with permission of the copyright holder), the work can be copied
+and distributed to anyone in the United States without paying any fees
+or charges.  If you are redistributing or providing access to a work
+with the phrase "Project Gutenberg" associated with or appearing on the
+work, you must comply either with the requirements of paragraphs 1.E.1
+through 1.E.7 or obtain permission for the use of the work and the
+Project Gutenberg-tm trademark as set forth in paragraphs 1.E.8 or
+1.E.9.
+
+1.E.3.  If an individual Project Gutenberg-tm electronic work is posted
+with the permission of the copyright holder, your use and distribution
+must comply with both paragraphs 1.E.1 through 1.E.7 and any additional
+terms imposed by the copyright holder.  Additional terms will be linked
+to the Project Gutenberg-tm License for all works posted with the
+permission of the copyright holder found at the beginning of this work.
+
+1.E.4.  Do not unlink or detach or remove the full Project Gutenberg-tm
+License terms from this work, or any files containing a part of this
+work or any other work associated with Project Gutenberg-tm.
+
+1.E.5.  Do not copy, display, perform, distribute or redistribute this
+electronic work, or any part of this electronic work, without
+prominently displaying the sentence set forth in paragraph 1.E.1 with
+active links or immediate access to the full terms of the Project
+Gutenberg-tm License.
+
+1.E.6.  You may convert to and distribute this work in any binary,
+compressed, marked up, nonproprietary or proprietary form, including any
+word processing or hypertext form.  However, if you provide access to or
+distribute copies of a Project Gutenberg-tm work in a format other than
+"Plain Vanilla ASCII" or other format used in the official version
+posted on the official Project Gutenberg-tm web site (www.gutenberg.net),
+you must, at no additional cost, fee or expense to the user, provide a
+copy, a means of exporting a copy, or a means of obtaining a copy upon
+request, of the work in its original "Plain Vanilla ASCII" or other
+form.  Any alternate format must include the full Project Gutenberg-tm
+License as specified in paragraph 1.E.1.
+
+1.E.7.  Do not charge a fee for access to, viewing, displaying,
+performing, copying or distributing any Project Gutenberg-tm works
+unless you comply with paragraph 1.E.8 or 1.E.9.
+
+1.E.8.  You may charge a reasonable fee for copies of or providing
+access to or distributing Project Gutenberg-tm electronic works provided
+that
+
+- You pay a royalty fee of 20% of the gross profits you derive from
+     the use of Project Gutenberg-tm works calculated using the method
+     you already use to calculate your applicable taxes.  The fee is
+     owed to the owner of the Project Gutenberg-tm trademark, but he
+     has agreed to donate royalties under this paragraph to the
+     Project Gutenberg Literary Archive Foundation.  Royalty payments
+     must be paid within 60 days following each date on which you
+     prepare (or are legally required to prepare) your periodic tax
+     returns.  Royalty payments should be clearly marked as such and
+     sent to the Project Gutenberg Literary Archive Foundation at the
+     address specified in Section 4, "Information about donations to
+     the Project Gutenberg Literary Archive Foundation."
+
+- You provide a full refund of any money paid by a user who notifies
+     you in writing (or by e-mail) within 30 days of receipt that s/he
+     does not agree to the terms of the full Project Gutenberg-tm
+     License.  You must require such a user to return or
+     destroy all copies of the works possessed in a physical medium
+     and discontinue all use of and all access to other copies of
+     Project Gutenberg-tm works.
+
+- You provide, in accordance with paragraph 1.F.3, a full refund of any
+     money paid for a work or a replacement copy, if a defect in the
+     electronic work is discovered and reported to you within 90 days
+     of receipt of the work.
+
+- You comply with all other terms of this agreement for free
+     distribution of Project Gutenberg-tm works.
+
+1.E.9.  If you wish to charge a fee or distribute a Project Gutenberg-tm
+electronic work or group of works on different terms than are set
+forth in this agreement, you must obtain permission in writing from
+both the Project Gutenberg Literary Archive Foundation and Michael
+Hart, the owner of the Project Gutenberg-tm trademark.  Contact the
+Foundation as set forth in Section 3 below.
+
+1.F.
+
+1.F.1.  Project Gutenberg volunteers and employees expend considerable
+effort to identify, do copyright research on, transcribe and proofread
+public domain works in creating the Project Gutenberg-tm
+collection.  Despite these efforts, Project Gutenberg-tm electronic
+works, and the medium on which they may be stored, may contain
+"Defects," such as, but not limited to, incomplete, inaccurate or
+corrupt data, transcription errors, a copyright or other intellectual
+property infringement, a defective or damaged disk or other medium, a
+computer virus, or computer codes that damage or cannot be read by
+your equipment.
+
+1.F.2.  LIMITED WARRANTY, DISCLAIMER OF DAMAGES - Except for the "Right
+of Replacement or Refund" described in paragraph 1.F.3, the Project
+Gutenberg Literary Archive Foundation, the owner of the Project
+Gutenberg-tm trademark, and any other party distributing a Project
+Gutenberg-tm electronic work under this agreement, disclaim all
+liability to you for damages, costs and expenses, including legal
+fees.  YOU AGREE THAT YOU HAVE NO REMEDIES FOR NEGLIGENCE, STRICT
+LIABILITY, BREACH OF WARRANTY OR BREACH OF CONTRACT EXCEPT THOSE
+PROVIDED IN PARAGRAPH F3.  YOU AGREE THAT THE FOUNDATION, THE
+TRADEMARK OWNER, AND ANY DISTRIBUTOR UNDER THIS AGREEMENT WILL NOT BE
+LIABLE TO YOU FOR ACTUAL, DIRECT, INDIRECT, CONSEQUENTIAL, PUNITIVE OR
+INCIDENTAL DAMAGES EVEN IF YOU GIVE NOTICE OF THE POSSIBILITY OF SUCH
+DAMAGE.
+
+1.F.3.  LIMITED RIGHT OF REPLACEMENT OR REFUND - If you discover a
+defect in this electronic work within 90 days of receiving it, you can
+receive a refund of the money (if any) you paid for it by sending a
+written explanation to the person you received the work from.  If you
+received the work on a physical medium, you must return the medium with
+your written explanation.  The person or entity that provided you with
+the defective work may elect to provide a replacement copy in lieu of a
+refund.  If you received the work electronically, the person or entity
+providing it to you may choose to give you a second opportunity to
+receive the work electronically in lieu of a refund.  If the second copy
+is also defective, you may demand a refund in writing without further
+opportunities to fix the problem.
+
+1.F.4.  Except for the limited right of replacement or refund set forth
+in paragraph 1.F.3, this work is provided to you 'AS-IS', WITH NO OTHER
+WARRANTIES OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO
+WARRANTIES OF MERCHANTIBILITY OR FITNESS FOR ANY PURPOSE.
+
+1.F.5.  Some states do not allow disclaimers of certain implied
+warranties or the exclusion or limitation of certain types of damages.
+If any disclaimer or limitation set forth in this agreement violates the
+law of the state applicable to this agreement, the agreement shall be
+interpreted to make the maximum disclaimer or limitation permitted by
+the applicable state law.  The invalidity or unenforceability of any
+provision of this agreement shall not void the remaining provisions.
+
+1.F.6.  INDEMNITY - You agree to indemnify and hold the Foundation, the
+trademark owner, any agent or employee of the Foundation, anyone
+providing copies of Project Gutenberg-tm electronic works in accordance
+with this agreement, and any volunteers associated with the production,
+promotion and distribution of Project Gutenberg-tm electronic works,
+harmless from all liability, costs and expenses, including legal fees,
+that arise directly or indirectly from any of the following which you do
+or cause to occur: (a) distribution of this or any Project Gutenberg-tm
+work, (b) alteration, modification, or additions or deletions to any
+Project Gutenberg-tm work, and (c) any Defect you cause.
+
+
+Section  2.  Information about the Mission of Project Gutenberg-tm
+
+Project Gutenberg-tm is synonymous with the free distribution of
+electronic works in formats readable by the widest variety of computers
+including obsolete, old, middle-aged and new computers.  It exists
+because of the efforts of hundreds of volunteers and donations from
+people in all walks of life.
+
+Volunteers and financial support to provide volunteers with the
+assistance they need, is critical to reaching Project Gutenberg-tm's
+goals and ensuring that the Project Gutenberg-tm collection will
+remain freely available for generations to come.  In 2001, the Project
+Gutenberg Literary Archive Foundation was created to provide a secure
+and permanent future for Project Gutenberg-tm and future generations.
+To learn more about the Project Gutenberg Literary Archive Foundation
+and how your efforts and donations can help, see Sections 3 and 4
+and the Foundation web page at http://www.gutenberg.net/fundraising/pglaf.
+
+
+Section 3.  Information about the Project Gutenberg Literary Archive
+Foundation
+
+The Project Gutenberg Literary Archive Foundation is a non profit
+501(c)(3) educational corporation organized under the laws of the
+state of Mississippi and granted tax exempt status by the Internal
+Revenue Service.  The Foundation's EIN or federal tax identification
+number is 64-6221541.  Contributions to the Project Gutenberg
+Literary Archive Foundation are tax deductible to the full extent
+permitted by U.S. federal laws and your state's laws.
+
+The Foundation's principal office is located at 4557 Melan Dr. S.
+Fairbanks, AK, 99712., but its volunteers and employees are scattered
+throughout numerous locations.  Its business office is located at
+809 North 1500 West, Salt Lake City, UT 84116, (801) 596-1887, email
+business@pglaf.org.  Email contact links and up to date contact
+information can be found at the Foundation's web site and official
+page at http://www.gutenberg.net/about/contact
+
+For additional contact information:
+     Dr. Gregory B. Newby
+     Chief Executive and Director
+     gbnewby@pglaf.org
+
+Section 4.  Information about Donations to the Project Gutenberg
+Literary Archive Foundation
+
+Project Gutenberg-tm depends upon and cannot survive without wide
+spread public support and donations to carry out its mission of
+increasing the number of public domain and licensed works that can be
+freely distributed in machine readable form accessible by the widest
+array of equipment including outdated equipment.  Many small donations
+($1 to $5,000) are particularly important to maintaining tax exempt
+status with the IRS.
+
+The Foundation is committed to complying with the laws regulating
+charities and charitable donations in all 50 states of the United
+States.  Compliance requirements are not uniform and it takes a
+considerable effort, much paperwork and many fees to meet and keep up
+with these requirements.  We do not solicit donations in locations
+where we have not received written confirmation of compliance.  To
+SEND DONATIONS or determine the status of compliance for any
+particular state visit http://www.gutenberg.net/fundraising/donate
+
+While we cannot and do not solicit contributions from states where we
+have not met the solicitation requirements, we know of no prohibition
+against accepting unsolicited donations from donors in such states who
+approach us with offers to donate.
+
+International donations are gratefully accepted, but we cannot make
+any statements concerning tax treatment of donations received from
+outside the United States.  U.S. laws alone swamp our small staff.
+
+Please check the Project Gutenberg Web pages for current donation
+methods and addresses.  Donations are accepted in a number of other
+ways including including checks, online payments and credit card
+donations.  To donate, please visit:
+http://www.gutenberg.net/fundraising/donate
+
+
+Section 5.  General Information About Project Gutenberg-tm electronic
+works.
+
+Professor Michael S. Hart is the originator of the Project Gutenberg-tm
+concept of a library of electronic works that could be freely shared
+with anyone.  For thirty years, he produced and distributed Project
+Gutenberg-tm eBooks with only a loose network of volunteer support.
+
+Project Gutenberg-tm eBooks are often created from several printed
+editions, all of which are confirmed as Public Domain in the U.S.
+unless a copyright notice is included.  Thus, we do not necessarily
+keep eBooks in compliance with any particular paper edition.
+
+Most people start at our Web site which has the main PG search facility:
+
+     http://www.gutenberg.net
+
+This Web site includes information about Project Gutenberg-tm,
+including how to make donations to the Project Gutenberg Literary
+Archive Foundation, how to help produce our new eBooks, and how to
+subscribe to our email newsletter to hear about new eBooks.
+ tests/Examples/ConcatMap.hs view
@@ -0,0 +1,8 @@+module M where+import Char++import Data.List.Stream as L++foo :: [Char] -> [Char]+foo xs = (L.concatMap (L.replicate 10000)) ( map toUpper xs)+
+ tests/Examples/Enum.hs view
@@ -0,0 +1,9 @@++import Data.List.Stream+import Prelude hiding (map,sum,head)+import System.Environment++main = do+    n <- getArgs >>= readIO . head+    print (sum (map (+1) [1..(n::Int)])) -- 1 fusion site.+    print (sum (map (+1) [1..(10::Int)])) -- 2 fusion site.
+ tests/Examples/Sum.hs view
@@ -0,0 +1,4 @@+import Data.List++main = print . sum . map read . lines =<< getContents+
+ tests/Examples/SumReplicate.hs view
@@ -0,0 +1,6 @@+module FuseTest where++import Data.List.Stream as L++foo :: Int -> Int+foo n = L.sum (L.replicate n 1)
+ tests/FuseTest.hs view
@@ -0,0 +1,6 @@+module FuseTest where++import Data.List.Stream as L++foo :: Int -> Int+foo n = L.sum (L.replicate n 1)
+ tests/Makefile view
@@ -0,0 +1,90 @@++GHC_FLAGS=-cpp -DEXTERNAL_PACKAGE -i.. -O2 -fglasgow-exts -fbang-patterns+#GHC_FLAGS="-hide-package arrows-0.2"+GHC=ghc++# run everything!+all :: internal list stream strictness list-compiled stream-compiled internal-compiled strictness-compiled++# ---------------------------------------------------------------+# testing++list ::+	runghc  $(GHC_FLAGS) Properties/ListVsSpec.hs+	runghc  $(GHC_FLAGS) Properties/ListVsBase.hs+stream ::+	runghc  $(GHC_FLAGS) Properties/StreamListVsSpec.hs+	runghc  $(GHC_FLAGS) Properties/StreamListVsBase.hs+	runghc  $(GHC_FLAGS) Properties/StreamVsSpecStream.hs+internal ::+	runghc  $(GHC_FLAGS) Properties/Internal.hs+strictness ::+	runghc  $(GHC_FLAGS) Strictness/ListVsSpec.hs+	runghc  $(GHC_FLAGS) Strictness/ListVsBase.hs+	runghc  $(GHC_FLAGS) Strictness/BaseVsSpec.hs+	runghc  $(GHC_FLAGS) Strictness/StreamListVsList.hs++list-compiled ::+	ghc  $(GHC_FLAGS) --make -frules-off -o lp Properties/ListVsSpec.hs+	ghc  $(GHC_FLAGS) --make -frules-off -o lp2 Properties/ListVsBase.hs+	time ./lp+	time ./lp2+stream-compiled ::+	ghc  $(GHC_FLAGS) --make -frules-off -o sp Properties/StreamListVsSpec.hs+	ghc  $(GHC_FLAGS) --make -frules-off -o sp2 Properties/StreamListVsBase.hs+	ghc  $(GHC_FLAGS) --make -frules-off -o sp3 Properties/StreamVsSpecStream.hs+	time ./sp+	time ./sp2+	time ./sp3+internal-compiled ::+	ghc  $(GHC_FLAGS) --make -frules-off -o ip Properties/Internal.hs+	time ./ip+strictness-compiled ::+	ghc  $(GHC_FLAGS) --make -frules-off -o strp Strictness/ListVsSpec.hs+	ghc  $(GHC_FLAGS) --make -frules-off -o strp2 Strictness/ListVsBase.hs+	ghc  $(GHC_FLAGS) --make -frules-off -o strp3 Strictness/BaseVsSpec.hs+	ghc  $(GHC_FLAGS) --make -frules-off -o strp4 Strictness/StreamListVsList.hs+	time ./strp+	time ./strp2+	time ./strp3+	time ./strp4++# ---------------------------------------------------------------+# benchmarking++bench ::+	$(GHC) $(GHC_FLAGS) --make Bench/ListVsBase.hs -o bench+	$(GHC) $(GHC_FLAGS) --make Bench/StreamVsList.hs -o bench2+	./bench+	./bench2++fusetest :: compiled+	$(GHC) $(GHC_FLAGS) -c -no-recomp -ddump-simpl-stats \+		 FuseTest.hs++compiled :: ../Data/Stream.hs ../Data/List/Stream.hs \+	Bench/Utils.hs Properties/Utils.hs Strictness/Utils.hs \+	Spec/List.hs Spec/ListExts.hs Spec/PreludeList.hs \+	Properties/Monomorphic/Base.hs \+	Properties/Monomorphic/List.hs \+	Properties/Monomorphic/Spec.hs \+	Properties/Monomorphic/SpecStream.hs \+	Properties/Monomorphic/Stream.hs \+	Properties/Monomorphic/StreamList.hs \+	Strictness/Monomorphic/Base.hs \+	Strictness/Monomorphic/List.hs \+	Strictness/Monomorphic/Spec.hs \+	Strictness/Monomorphic/StreamList.hs+	$(GHC) $(GHC_FLAGS) --make $^++Bench/bigdata :+	cat Bench/data Bench/data Bench/data Bench/data Bench/data > Bench/bigdata++# ---------------------------------------------------------------+# cleaning++clean :+	rm -f *.hi *.o ../Data/*.o ../Data/*.hi ../Data/List/*.o ../Data/List/*.hi+	rm -f Spec/*.o Spec/*.hi Bench/*.o Bench/*.hi+	rm -f Properties/*.o Properties/*.hi Strictness/*.o Strictness/*.hi+	rm -f bench bench2 lp lp2 sp sp2 sp3 ip strp strp2 strp3
+ tests/Properties/Internal.hs view
@@ -0,0 +1,358 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++--+-- Test the new list implementation for internal properties+--+import Prelude (($),(.),(&&),(||),(+),Int,(==),Bool(..),not,flip,uncurry)++import Properties.Utils+import System.IO++import Data.Maybe+import qualified Data.List.Stream as T++------------------------------------------------------------------------+-- * Basic interface++-- map fusion+prop_mapmap = (\(f  :: B -> C)+                (g  :: A -> B)+                (xs) -> T.map f . T.map g $ xs) `eq3`++                 (\f g xs -> T.map (f.g)       $ xs)++prop_maprepeat n = (\(f :: A -> B)+                   (x :: A) -> T.map f (T.take n $ T.repeat x)) `eq2` (\f x -> T.take n $ T.repeat (f x))++prop_mapreplicate n = (\(f :: A -> B)+                   (x :: A) -> T.map f (T.replicate n x)) `eq2` (\f x -> T.replicate n (f x))++------------------------------------------------------------------------+-- * List transformations++prop_reverse = T.foldl (flip (:)) [] `eq1` (\(x :: [A]) -> T.reverse  x)++------------------------------------------------------------------------+-- * Reducing lists (folds)++------------------------------------------------------------------------+-- ** Special folds++prop_concatfoldr = (\(xs :: [[A]]) -> T.concat xs) `eq1` (T.foldr (T.++) [])++prop_concatmap = (\(f :: A -> [B]) (xs :: [A]) -> T.concatMap f xs) `eq2` +                                            (\f -> T.concat . T.map f)++prop_and       = (T.foldr (&&) True) `eq1` T.and+prop_or        = (T.foldr (||) False) `eq1` T.or+prop_sum       = (T.foldl (+) 0)     `eq1`  (T.sum :: [Int] -> Int)++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++-- (a -> b -> a) -> a -> [b] -> [a]+prop_scanlfold = (\(f :: A -> B -> A)+                   (z :: A)+                   (xs::[B]) ->+                        T.last (T.scanl f z xs)) `eq3`+                 (\f z xs ->+                        T.foldl f z xs)++-- (a -> b -> a) -> a -> [b] -> [a]+prop_scanrfold = (\(f :: A -> B -> B)+                   (z :: B)+                   (xs::[A]) ->+                        T.head (T.scanr f z xs)) `eq3`+                 (\f z xs ->+                        T.foldr f z xs)++------------------------------------------------------------------------+-- ** Accumulating maps++------------------------------------------------------------------------+-- ** Infinite lists++prop_replicate = T.replicate `eq2` (\n (x :: A) -> T.take n (T.repeat x))++------------------------------------------------------------------------+-- ** Unfolding++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_break_span = T.break `eq2` (\(p :: A -> Bool) -> T.span (not . p))++------------------------------------------------------------------------+-- * Predicates++{-+--+-- not true, has to take the minimum of the two, not the first only.+--+prop_isPrefixOfzip = (\(xs:: [A]) ys ->+                               (T.isPrefixOf xs ys)) `eq2`+                     (\xs ys ->+                               (T.all (uncurry (==)) (T.zip xs ys)))+-}++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_filterfilter = (\(p :: A -> Bool)+                      (q :: A -> Bool)+                      (s :: [A] ) ->+                             T.filter p (T.filter q s))         `eq3`+                    (\p q s ->+                             T.filter (\x -> q x && p x) s)++------------------------------------------------------------------------+-- * Indexing lists++prop_findIndexfilter = (\p (xs ::[A]) ->+                             T.findIndex p xs) `eq2`+                       (\p xs         ->+                             listToMaybe [ n | (n,x) <- T.zip [0..] xs, p x ])++prop_elemIndexfilter = (\x (xs ::[A]) ->+                             T.elemIndex x xs) `eq2`+                       (\x xs         ->+                             listToMaybe [ n | (n,a) <- T.zip [0..] xs, a==x ])++prop_elemfindIndex   = (\x (xs ::[A]) ->+                             T.findIndex (==x) xs) `eq2`+                       (\x xs         ->+                             T.elemIndex x     xs)++prop_filterelemIndices = (\a (xs :: [A]) ->+                             T.length (T.filter (==a) xs)) `eq2`+                         (\a xs ->+                             T.length (T.elemIndices a xs))++prop_filterfindIndices = (\p (xs :: [A]) ->+                             T.length (T.filter p xs)) `eq2`+                         (\p xs ->+                             T.length (T.findIndices p xs))++------------------------------------------------------------------------+-- * Zipping and unzipping lists++------------------------------------------------------------------------++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings++prop_unlinesconcat    = T.unlines `eqnotnull1` (\xs -> T.concat (T.intersperse "\n" xs) T.++ "\n")+prop_unlinesconcatMap = T.unlines `eq1`        (\xs -> T.concatMap (T.++ "\n") xs)++------------------------------------------------------------------------+-- ** \"Set\" operations++prop_nubsort    = (\(xs :: [OrdA]) -> T.sort . T.nub $ xs )  `eq1`+                  (\xs       -> T.map T.head . T.group . T.sort $ xs)++------------------------------------------------------------------------+-- ** Ordered lists ++prop_headsort = (T.head . T.sort) `eqnotnull1` (\x -> T.minimum (x :: [OrdA]))+prop_lastsort = (T.last . T.sort) `eqnotnull1` (\x -> T.maximum (x :: [OrdA]))++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++prop_nubsortby    = (\f g (xs :: [OrdA]) -> T.sortBy f . T.nubBy g $ xs )  `eq3`+                    (\f g xs       -> T.map T.head . T.groupBy g . T.sortBy f $ xs)++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++------------------------------------------------------------------------+-- * The \"generic\" operations++------------------------------------------------------------------------++main = do+  hSetBuffering stdout NoBuffering++  runTests "Basic interface" opts+    [ run prop_mapmap+    , run prop_maprepeat+    , run prop_mapreplicate+    ]++  runTests "List transformations" opts+    [ run prop_reverse+    ]++{-+  runTests "Reducing lists (folds)" opts+    [+    ]+-}++  runTests "Special folds" opts+    [ run prop_concatfoldr+    , run prop_concatmap+    , run prop_and+    , run prop_or+    , run prop_sum+    ]++  runTests "Scans" opts+    [ run prop_scanlfold+    , run prop_scanrfold+    ]++{-+  runTests "Accumulating maps" opts+    [+    ]+-}++  runTests "Infinite lists" opts+    [ run prop_replicate+    ]++{-+  runTests "Unfolding" opts+    [+    ]+-}++  runTests "Extracting sublists" opts+    [ run prop_break_span+    ]++{-+  runTests "Predicates" opts+    [ run prop_isPrefixOfzip+    ]+-}++{-+  runTests "Searching by equality" opts+    [+    ]+-}++  runTests "Searching by a predicate" opts+    [ run prop_filterfilter+    ]++  runTests "Indexing lists" opts+    [ run prop_filterelemIndices+    , run prop_filterfindIndices+    , run prop_findIndexfilter+    , run prop_elemIndexfilter+    , run prop_elemfindIndex+    ]++{-+  runTests "Zipping" opts+    [+    ]+-}++{-+  runTests "Unzipping" opts+    [+    ]+-}++  runTests "Functions on strings" opts+    [ run prop_unlinesconcat+    , run prop_unlinesconcatMap+    ]++  runTests "\"Set\" operations" opts+    [ run prop_nubsort+    ]++  runTests "Ordered lists" opts+    [ run prop_headsort+    , run prop_lastsort+    ]+++  runTests "Eq style \"By\" operations" opts+    [ run prop_nubsortby     -- same issue as prop_sortBy in ListProperties+    ]+{-+  runTests "Ord style \"By\" operations" opts+    [+    ]++  runTests "The \"generic\" operations" opts+    [+    ]+-}++------------------------------------------------------------------------++{-+  runTests "Searching by equality" opts+    [+    ]+-}++  runTests "Searching by a predicate" opts+    [ run prop_filterfilter+    ]++  runTests "Indexing lists" opts+    [ run prop_filterelemIndices+    , run prop_filterfindIndices+    , run prop_findIndexfilter+    , run prop_elemIndexfilter+    , run prop_elemfindIndex+    ]++{-+  runTests "Zipping" opts+    [+    ]+-}++{-+  runTests "Unzipping" opts+    [+    ]+-}++  runTests "Functions on strings" opts+    [ run prop_unlinesconcat+    , run prop_unlinesconcatMap+    ]++  runTests "\"Set\" operations" opts+    [ run prop_nubsort+    ]++  runTests "Ordered lists" opts+    [ run prop_headsort+    , run prop_lastsort+    ]+++  runTests "Eq style \"By\" operations" opts+    [ run prop_nubsortby     -- same issue as prop_sortBy in ListProperties+    ]+{-+  runTests "Ord style \"By\" operations" opts+    [+    ]++  runTests "The \"generic\" operations" opts+    [+    ]+-}++------------------------------------------------------------------------
+ tests/Properties/ListVsBase.hs view
@@ -0,0 +1,402 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++--+-- Test the new list implementation against Data.List.+--++import Properties.Utils+import System.IO++import qualified Properties.Monomorphic.List as Test        -- our implementation+import qualified Properties.Monomorphic.Base as Spec        -- current Data.List++--+-- Data.List.Stream <=> Data.List+--++------------------------------------------------------------------------+-- * Basic interface++prop_append     = (Test.++)     `eq2`           (Spec.++)+prop_head       = Test.head     `eqnotnull1`    Spec.head+prop_last       = Test.last     `eqnotnull1`    Spec.last+prop_tail       = Test.tail     `eqnotnull1`    Spec.tail+prop_init       = Test.init     `eqnotnull1`    Spec.init+prop_null       = Test.null     `eq1`           Spec.null+prop_length     = Test.length   `eq1`           Spec.length++------------------------------------------------------------------------+-- * List transformations++prop_map                = Test.map              `eq2`   Spec.map+prop_reverse            = Test.reverse          `eq1`   Spec.reverse+prop_intersperse        = Test.intersperse      `eq2`   Spec.intersperse+prop_intercalate        = Test.intercalate      `eq2`   Spec.intercalate+prop_transpose          = Test.transpose        `eq1`   Spec.transpose++------------------------------------------------------------------------+-- * Reducing lists (folds)++prop_foldl      = Test.foldl            `eq3`   Spec.foldl+prop_foldl'     = Test.foldl'           `eq3`   Spec.foldl'+prop_foldl1     = Test.foldl1   `eqnotnull2`    Spec.foldl1+prop_foldl1'    = Test.foldl1'  `eqnotnull2`    Spec.foldl1'+prop_foldr      = Test.foldr            `eq3`   Spec.foldr+prop_foldr1     = Test.foldr1   `eqnotnull2`    Spec.foldr1++------------------------------------------------------------------------+-- ** Special folds++prop_concat     = Test.concat           `eq1`   Spec.concat+prop_concatMap  = Test.concatMap        `eq2`   Spec.concatMap+prop_and        = Test.and              `eq1`   Spec.and+prop_or         = Test.or               `eq1`   Spec.or+prop_any        = Test.any              `eq2`   Spec.any+prop_all        = Test.all              `eq2`   Spec.all+prop_sum        = Test.sum              `eq1`   Spec.sum+prop_product    = Test.product          `eq1`   Spec.product+prop_maximum    = Test.maximum  `eqnotnull1`    Spec.maximum+prop_minimum    = Test.minimum  `eqnotnull1`    Spec.minimum++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++prop_scanl      = Test.scanl            `eq3`   Spec.scanl+prop_scanl1     = Test.scanl1           `eq2`   Spec.scanl1+prop_scanr      = Test.scanr            `eq3`   Spec.scanr+prop_scanr1     = Test.scanr1           `eq2`   Spec.scanr1++------------------------------------------------------------------------+-- ** Accumulating maps++prop_mapAccumL  = Test.mapAccumL        `eq3`   Spec.mapAccumL+prop_mapAccumR  = Test.mapAccumR        `eq3`   Spec.mapAccumR++------------------------------------------------------------------------+-- ** Infinite lists++prop_iterate    = Test.iterate          `eqfinite2`     Spec.iterate+prop_repeat     = Test.repeat           `eqfinite1`     Spec.repeat+prop_replicate  = Test.replicate        `eq2`           Spec.replicate+prop_cycle      = \x -> not (null x) ==>+                  (Test.cycle           `eqfinite1`     Spec.cycle) x++------------------------------------------------------------------------+-- ** Unfolding++prop_unfoldr    = Test.unfoldr          `eqfinite2`     Spec.unfoldr++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_take       = Test.take             `eq2`   Spec.take+prop_drop       = Test.drop             `eq2`   Spec.drop+prop_splitAt    = Test.splitAt          `eq2`   Spec.splitAt+prop_takeWhile  = Test.takeWhile        `eq2`   Spec.takeWhile+prop_dropWhile  = Test.dropWhile        `eq2`   Spec.dropWhile+prop_span       = Test.span             `eq2`   Spec.span+prop_break      = Test.break            `eq2`   Spec.break+prop_group      = Test.group            `eq1`   Spec.group+prop_inits      = Test.inits            `eq1`   Spec.inits+prop_tails      = Test.tails            `eq1`   Spec.tails++------------------------------------------------------------------------+-- * Predicates++prop_isPrefixOf  = Test.isPrefixOf       `eq2`   Spec.isPrefixOf+prop_isSuffixOf  = Test.isSuffixOf       `eq2`   Spec.isSuffixOf+prop_isInfixOf   = Test.isInfixOf        `eq2`   Spec.isInfixOf++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++prop_elem       = Test.elem             `eq2`   Spec.elem+prop_notElem    = Test.notElem          `eq2`   Spec.notElem+prop_lookup     = Test.lookup           `eq2`   Spec.lookup++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_find       = Test.find             `eq2`   Spec.find+prop_filter     = Test.filter           `eq2`   Spec.filter+prop_partition  = Test.partition        `eq2`   Spec.partition++------------------------------------------------------------------------+-- * Indexing lists++prop_index              = \xs n -> n >= 0 && n < length xs ==>+                          ((Test.!!)            `eq2`   (Spec.!!)) xs n+prop_elemIndex          = Test.elemIndex        `eq2`   Spec.elemIndex+prop_elemIndices        = Test.elemIndices      `eq2`   Spec.elemIndices+prop_findIndex          = Test.findIndex        `eq2`   Spec.findIndex+prop_findIndices        = Test.findIndices      `eq2`   Spec.findIndices++------------------------------------------------------------------------+-- * Zipping and unzipping lists++prop_zip        = Test.zip              `eq2`   Spec.zip+prop_zip3       = Test.zip3             `eq3`   Spec.zip3+prop_zip4       = Test.zip4             `eq4`   Spec.zip4+prop_zip5       = Test.zip5             `eq5`   Spec.zip5+prop_zip6       = Test.zip6             `eq6`   Spec.zip6+prop_zip7       = Test.zip7             `eq7`   Spec.zip7+prop_zipWith    = Test.zipWith          `eq3`   Spec.zipWith+prop_zipWith3   = Test.zipWith3         `eq4`   Spec.zipWith3+prop_zipWith4   = Test.zipWith4         `eq5`   Spec.zipWith4+prop_zipWith5   = Test.zipWith5         `eq6`   Spec.zipWith5+prop_zipWith6   = Test.zipWith6         `eq7`   Spec.zipWith6+prop_zipWith7   = Test.zipWith7         `eq8`   Spec.zipWith7++------------------------------------------------------------------------++prop_unzip      = Test.unzip            `eq1`   Spec.unzip+prop_unzip3     = Test.unzip3           `eq1`   Spec.unzip3+prop_unzip4     = Test.unzip4           `eq1`   Spec.unzip4+prop_unzip5     = Test.unzip5           `eq1`   Spec.unzip5+prop_unzip6     = Test.unzip6           `eq1`   Spec.unzip6+prop_unzip7     = Test.unzip7           `eq1`   Spec.unzip7++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings++prop_lines      = Test.lines            `eq1`   Spec.lines+prop_words      = Test.words            `eq1`   Spec.words+prop_unlines    = Test.unlines          `eq1`   Spec.unlines+prop_unwords    = Test.unwords          `eq1`   Spec.unwords++------------------------------------------------------------------------+-- ** \"Set\" operations++prop_nub        = Test.nub              `eq1`   Spec.nub+prop_delete     = Test.delete           `eq2`   Spec.delete+prop_difference = (Test.\\)             `eq2`   (Spec.\\)+prop_union      = Test.union            `eq2`   Spec.union+prop_intersect  = Test.intersect        `eq2`   Spec.intersect++------------------------------------------------------------------------+-- ** Ordered lists ++prop_sort       = Test.sort             `eq1`   Spec.sort+prop_insert     = Test.insert           `eq2`   Spec.insert++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++prop_nubBy              = Test.nubBy            `eq2`   Spec.nubBy+prop_deleteBy           = Test.deleteBy         `eq3`   Spec.deleteBy+prop_deleteFirstsBy     = Test.deleteFirstsBy   `eq3`   Spec.deleteFirstsBy+prop_unionBy            = Test.unionBy          `eq3`   Spec.unionBy+prop_intersectBy        = Test.intersectBy      `eq3`   Spec.intersectBy+prop_groupBy            = Test.groupBy          `eq2`   Spec.groupBy++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++prop_sortBy             = Test.sortBy           `eq2`           Spec.sortBy+prop_insertBy           = Test.insertBy         `eq3`           Spec.insertBy+prop_maximumBy          = Test.maximumBy        `eqnotnull2`    Spec.maximumBy+prop_minimumBy          = Test.minimumBy        `eqnotnull2`    Spec.minimumBy++------------------------------------------------------------------------+-- * The \"generic\" operations++prop_genericLength      = Test.genericLength    `eq1`   Spec.genericLength+prop_genericTake        = \i -> i >= I 0 ==>+                          (Test.genericTake     `eq2`   Spec.genericTake) i+prop_genericDrop        = \i -> i >= I 0 ==>+                          (Test.genericDrop     `eq2`   Spec.genericDrop) i+prop_genericSplitAt     = \i -> i >= I 0 ==>+                          (Test.genericSplitAt  `eq2`   Spec.genericSplitAt) i+prop_genericIndex       = \xs i -> i >= I 0 && i < Spec.genericLength xs ==>+                          (Test.genericIndex    `eq2`   Spec.genericIndex) xs i+prop_genericReplicate   = \i -> i >= I 0 ==>+                          (Test.genericReplicate        `eq2`   Spec.genericReplicate) i++------------------------------------------------------------------------++main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Testing: Data.List.Stream <=> Data.List"+  putStrLn "=======================================\n"++  runTests "Basic interface" opts+    [run prop_append+    ,run prop_head+    ,run prop_last+    ,run prop_tail+    ,run prop_init+    ,run prop_null+    ,run prop_length+    ]++  runTests "List transformations" opts+    [run prop_map+    ,run prop_reverse+    ,run prop_intersperse+    ,run prop_intercalate+    ,run prop_transpose+    ]++  runTests "Reducing lists (folds)" opts+    [run prop_foldl+    ,run prop_foldl'+    ,run prop_foldl1+    ,run prop_foldl1'+    ,run prop_foldr+    ,run prop_foldr1+    ]++  runTests "Special folds" opts+    [run prop_concat+    ,run prop_concatMap+    ,run prop_and+    ,run prop_or+    ,run prop_any+    ,run prop_all+    ,run prop_sum+    ,run prop_product+    ,run prop_maximum+    ,run prop_minimum+    ]++  runTests "Scans" opts+    [run prop_scanl+    ,run prop_scanl1+    ,run prop_scanr+    ,run prop_scanr1+    ]++  runTests "Accumulating maps" opts+    [run prop_mapAccumL+    ,run prop_mapAccumR+    ]++  runTests "Infinite lists" opts+    [run prop_iterate+    ,run prop_repeat+    ,run prop_replicate+    ,run prop_cycle+    ]++  runTests "Unfolding" opts+    [run prop_unfoldr+    ]++  runTests "Extracting sublists" opts+    [run prop_take+    ,run prop_drop+    ,run prop_splitAt+    ,run prop_takeWhile+    ,run prop_dropWhile+    ,run prop_span+    ,run prop_break+    ,run prop_group+    ,run prop_inits+    ,run prop_tails+    ]++  runTests "Predicates" opts+    [run prop_isPrefixOf+    ,run prop_isSuffixOf+    ,run prop_isInfixOf+    ]++  runTests "Searching by equality" opts+    [run prop_elem+    ,run prop_notElem+    ,run prop_lookup+    ]++  runTests "Searching by a predicate" opts+    [run prop_find+    ,run prop_filter+    ,run prop_partition+    ]++  runTests "Indexing lists" opts+    [run prop_index+    ,run prop_elemIndex+    ,run prop_elemIndices+    ,run prop_findIndex+    ,run prop_findIndices+    ]++  runTests "Zipping" opts+    [run prop_zip+    ,run prop_zip3+    ,run prop_zip4+    ,run prop_zip5+    ,run prop_zip6+    ,run prop_zip7+    ,run prop_zipWith+    ,run prop_zipWith3+    ,run prop_zipWith4+    ,run prop_zipWith5+    ,run prop_zipWith6+    ,run prop_zipWith7+    ]++  runTests "Unzipping" opts+    [run prop_unzip+    ,run prop_unzip3+    ,run prop_unzip4+    ,run prop_unzip5+    ,run prop_unzip6+    ,run prop_unzip7+    ]++  runTests "Functions on strings" opts+    [run prop_lines+    ,run prop_words+    ,run prop_unlines+    ,run prop_unwords+    ]++  runTests "\"Set\" operations" opts+    [run prop_nub+    ,run prop_delete+    ,run prop_difference+    ,run prop_union+    ,run prop_intersect+    ]++  runTests "Ordered lists" opts+    [run prop_sort+    ,run prop_insert+    ]++  runTests "Eq style \"By\" operations" opts+    [run prop_nubBy+    ,run prop_deleteBy+    ,run prop_deleteFirstsBy+    ,run prop_unionBy+    ,run prop_intersectBy+    ,run prop_groupBy+    ]++  runTests "Ord style \"By\" operations" opts+    [run prop_sortBy        -- note issue here.+    ,run prop_insertBy+    ,run prop_maximumBy+    ,run prop_minimumBy+    ]++  runTests "The \"generic\" operations" opts+    [run prop_genericLength+    ,run prop_genericTake+    ,run prop_genericDrop+    ,run prop_genericSplitAt+    ,run prop_genericIndex+    ,run prop_genericReplicate+    ]
+ tests/Properties/ListVsSpec.hs view
@@ -0,0 +1,402 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++--+-- Test the new list implementation against h98 lists.+--++import Properties.Utils+import System.IO++import qualified Properties.Monomorphic.List as Test        -- our implementation+import qualified Properties.Monomorphic.Spec as Spec        -- H98 spec++--+-- Data.List.Stream <=> Spec.List+--++------------------------------------------------------------------------+-- * Basic interface++prop_append     = (Test.++)     `eq2`           (Spec.++)+prop_head       = Test.head     `eqnotnull1`    Spec.head+prop_last       = Test.last     `eqnotnull1`    Spec.last+prop_tail       = Test.tail     `eqnotnull1`    Spec.tail+prop_init       = Test.init     `eqnotnull1`    Spec.init+prop_null       = Test.null     `eq1`           Spec.null+prop_length     = Test.length   `eq1`           Spec.length++------------------------------------------------------------------------+-- * List transformations++prop_map                = Test.map              `eq2`   Spec.map+prop_reverse            = Test.reverse          `eq1`   Spec.reverse+prop_intersperse        = Test.intersperse      `eq2`   Spec.intersperse+prop_intercalate        = Test.intercalate      `eq2`   Spec.intercalate+prop_transpose          = Test.transpose        `eq1`   Spec.transpose++------------------------------------------------------------------------+-- * Reducing lists (folds)++prop_foldl      = Test.foldl            `eq3`   Spec.foldl+prop_foldl'     = Test.foldl'           `eq3`   Spec.foldl'+prop_foldl1     = Test.foldl1   `eqnotnull2`    Spec.foldl1+prop_foldl1'    = Test.foldl1'  `eqnotnull2`    Spec.foldl1'+prop_foldr      = Test.foldr            `eq3`   Spec.foldr+prop_foldr1     = Test.foldr1   `eqnotnull2`    Spec.foldr1++------------------------------------------------------------------------+-- ** Special folds++prop_concat     = Test.concat           `eq1`   Spec.concat+prop_concatMap  = Test.concatMap        `eq2`   Spec.concatMap+prop_and        = Test.and              `eq1`   Spec.and+prop_or         = Test.or               `eq1`   Spec.or+prop_any        = Test.any              `eq2`   Spec.any+prop_all        = Test.all              `eq2`   Spec.all+prop_sum        = Test.sum              `eq1`   Spec.sum+prop_product    = Test.product          `eq1`   Spec.product+prop_maximum    = Test.maximum  `eqnotnull1`    Spec.maximum+prop_minimum    = Test.minimum  `eqnotnull1`    Spec.minimum++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++prop_scanl      = Test.scanl            `eq3`   Spec.scanl+prop_scanl1     = Test.scanl1           `eq2`   Spec.scanl1+prop_scanr      = Test.scanr            `eq3`   Spec.scanr+prop_scanr1     = Test.scanr1           `eq2`   Spec.scanr1++------------------------------------------------------------------------+-- ** Accumulating maps++prop_mapAccumL  = Test.mapAccumL        `eq3`   Spec.mapAccumL+prop_mapAccumR  = Test.mapAccumR        `eq3`   Spec.mapAccumR++------------------------------------------------------------------------+-- ** Infinite lists++prop_iterate    = Test.iterate          `eqfinite2`     Spec.iterate+prop_repeat     = Test.repeat           `eqfinite1`     Spec.repeat+prop_replicate  = Test.replicate        `eq2`           Spec.replicate+prop_cycle      = \x -> not (null x) ==>+                  (Test.cycle           `eqfinite1`     Spec.cycle) x++------------------------------------------------------------------------+-- ** Unfolding++prop_unfoldr    = Test.unfoldr          `eqfinite2`     Spec.unfoldr++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_take       = Test.take             `eq2`   Spec.take+prop_drop       = Test.drop             `eq2`   Spec.drop+prop_splitAt    = Test.splitAt          `eq2`   Spec.splitAt+prop_takeWhile  = Test.takeWhile        `eq2`   Spec.takeWhile+prop_dropWhile  = Test.dropWhile        `eq2`   Spec.dropWhile+prop_span       = Test.span             `eq2`   Spec.span+prop_break      = Test.break            `eq2`   Spec.break+prop_group      = Test.group            `eq1`   Spec.group+prop_inits      = Test.inits            `eq1`   Spec.inits+prop_tails      = Test.tails            `eq1`   Spec.tails++------------------------------------------------------------------------+-- * Predicates++prop_isPrefixOf  = Test.isPrefixOf       `eq2`   Spec.isPrefixOf+prop_isSuffixOf  = Test.isSuffixOf       `eq2`   Spec.isSuffixOf+prop_isInfixOf   = Test.isInfixOf        `eq2`   Spec.isInfixOf++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++prop_elem       = Test.elem             `eq2`   Spec.elem+prop_notElem    = Test.notElem          `eq2`   Spec.notElem+prop_lookup     = Test.lookup           `eq2`   Spec.lookup++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_find       = Test.find             `eq2`   Spec.find+prop_filter     = Test.filter           `eq2`   Spec.filter+prop_partition  = Test.partition        `eq2`   Spec.partition++------------------------------------------------------------------------+-- * Indexing lists++prop_index              = \xs n -> n >= 0 && n < length xs ==>+                          ((Test.!!)            `eq2`   (Spec.!!)) xs n+prop_elemIndex          = Test.elemIndex        `eq2`   Spec.elemIndex+prop_elemIndices        = Test.elemIndices      `eq2`   Spec.elemIndices+prop_findIndex          = Test.findIndex        `eq2`   Spec.findIndex+prop_findIndices        = Test.findIndices      `eq2`   Spec.findIndices++------------------------------------------------------------------------+-- * Zipping and unzipping lists++prop_zip        = Test.zip              `eq2`   Spec.zip+prop_zip3       = Test.zip3             `eq3`   Spec.zip3+prop_zip4       = Test.zip4             `eq4`   Spec.zip4+prop_zip5       = Test.zip5             `eq5`   Spec.zip5+prop_zip6       = Test.zip6             `eq6`   Spec.zip6+prop_zip7       = Test.zip7             `eq7`   Spec.zip7+prop_zipWith    = Test.zipWith          `eq3`   Spec.zipWith+prop_zipWith3   = Test.zipWith3         `eq4`   Spec.zipWith3+prop_zipWith4   = Test.zipWith4         `eq5`   Spec.zipWith4+prop_zipWith5   = Test.zipWith5         `eq6`   Spec.zipWith5+prop_zipWith6   = Test.zipWith6         `eq7`   Spec.zipWith6+prop_zipWith7   = Test.zipWith7         `eq8`   Spec.zipWith7++------------------------------------------------------------------------++prop_unzip      = Test.unzip            `eq1`   Spec.unzip+prop_unzip3     = Test.unzip3           `eq1`   Spec.unzip3+prop_unzip4     = Test.unzip4           `eq1`   Spec.unzip4+prop_unzip5     = Test.unzip5           `eq1`   Spec.unzip5+prop_unzip6     = Test.unzip6           `eq1`   Spec.unzip6+prop_unzip7     = Test.unzip7           `eq1`   Spec.unzip7++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings++prop_lines      = Test.lines            `eq1`   Spec.lines+prop_words      = Test.words            `eq1`   Spec.words+prop_unlines    = Test.unlines          `eq1`   Spec.unlines+prop_unwords    = Test.unwords          `eq1`   Spec.unwords++------------------------------------------------------------------------+-- ** \"Set\" operations++prop_nub        = Test.nub              `eq1`   Spec.nub+prop_delete     = Test.delete           `eq2`   Spec.delete+prop_difference = (Test.\\)             `eq2`   (Spec.\\)+prop_union      = Test.union            `eq2`   Spec.union+prop_intersect  = Test.intersect        `eq2`   Spec.intersect++------------------------------------------------------------------------+-- ** Ordered lists ++prop_sort       = Test.sort             `eq1`   Spec.sort+prop_insert     = Test.insert           `eq2`   Spec.insert++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++prop_nubBy              = Test.nubBy            `eq2`   Spec.nubBy+prop_deleteBy           = Test.deleteBy         `eq3`   Spec.deleteBy+prop_deleteFirstsBy     = Test.deleteFirstsBy   `eq3`   Spec.deleteFirstsBy+prop_unionBy            = Test.unionBy          `eq3`   Spec.unionBy+prop_intersectBy        = Test.intersectBy      `eq3`   Spec.intersectBy+prop_groupBy            = Test.groupBy          `eq2`   Spec.groupBy++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++prop_sortBy             = Test.sortBy           `eq2`           Spec.sortBy+prop_insertBy           = Test.insertBy         `eq3`           Spec.insertBy+prop_maximumBy          = Test.maximumBy        `eqnotnull2`    Spec.maximumBy+prop_minimumBy          = Test.minimumBy        `eqnotnull2`    Spec.minimumBy++------------------------------------------------------------------------+-- * The \"generic\" operations++prop_genericLength      = Test.genericLength    `eq1`   Spec.genericLength+prop_genericTake        = \i -> i >= I 0 ==>+                          (Test.genericTake     `eq2`   Spec.genericTake) i+prop_genericDrop        = \i -> i >= I 0 ==>+                          (Test.genericDrop     `eq2`   Spec.genericDrop) i+prop_genericSplitAt     = \i -> i >= I 0 ==>+                          (Test.genericSplitAt  `eq2`   Spec.genericSplitAt) i+prop_genericIndex       = \xs i -> i >= I 0 && i < Spec.genericLength xs ==>+                          (Test.genericIndex    `eq2`   Spec.genericIndex) xs i+prop_genericReplicate   = \i -> i >= I 0 ==>+                          (Test.genericReplicate        `eq2`   Spec.genericReplicate) i++------------------------------------------------------------------------++main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Testing: Data.List.Stream <=> Spec.List"+  putStrLn "=======================================\n"++  runTests "Basic interface" opts+    [run prop_append+    ,run prop_head+    ,run prop_last+    ,run prop_tail+    ,run prop_init+    ,run prop_null+    ,run prop_length+    ]++  runTests "List transformations" opts+    [run prop_map+    ,run prop_reverse+    ,run prop_intersperse+    ,run prop_intercalate+    ,run prop_transpose+    ]++  runTests "Reducing lists (folds)" opts+    [run prop_foldl+    ,run prop_foldl'+    ,run prop_foldl1+    ,run prop_foldl1'+    ,run prop_foldr+    ,run prop_foldr1+    ]++  runTests "Special folds" opts+    [run prop_concat+    ,run prop_concatMap+    ,run prop_and+    ,run prop_or+    ,run prop_any+    ,run prop_all+    ,run prop_sum+    ,run prop_product+    ,run prop_maximum+    ,run prop_minimum+    ]++  runTests "Scans" opts+    [run prop_scanl+    ,run prop_scanl1+    ,run prop_scanr+    ,run prop_scanr1+    ]++  runTests "Accumulating maps" opts+    [run prop_mapAccumL+    ,run prop_mapAccumR+    ]++  runTests "Infinite lists" opts+    [run prop_iterate+    ,run prop_repeat+    ,run prop_replicate+    ,run prop_cycle+    ]++  runTests "Unfolding" opts+    [run prop_unfoldr+    ]++  runTests "Extracting sublists" opts+    [run prop_take+    ,run prop_drop+    ,run prop_splitAt+    ,run prop_takeWhile+    ,run prop_dropWhile+    ,run prop_span+    ,run prop_break+    ,run prop_group+    ,run prop_inits+    ,run prop_tails+    ]++  runTests "Predicates" opts+    [run prop_isPrefixOf+    ,run prop_isSuffixOf+    ,run prop_isInfixOf+    ]++  runTests "Searching by equality" opts+    [run prop_elem+    ,run prop_notElem+    ,run prop_lookup+    ]++  runTests "Searching by a predicate" opts+    [run prop_find+    ,run prop_filter+    ,run prop_partition+    ]++  runTests "Indexing lists" opts+    [run prop_index+    ,run prop_elemIndex+    ,run prop_elemIndices+    ,run prop_findIndex+    ,run prop_findIndices+    ]++  runTests "Zipping" opts+    [run prop_zip+    ,run prop_zip3+    ,run prop_zip4+    ,run prop_zip5+    ,run prop_zip6+    ,run prop_zip7+    ,run prop_zipWith+    ,run prop_zipWith3+    ,run prop_zipWith4+    ,run prop_zipWith5+    ,run prop_zipWith6+    ,run prop_zipWith7+    ]++  runTests "Unzipping" opts+    [run prop_unzip+    ,run prop_unzip3+    ,run prop_unzip4+    ,run prop_unzip5+    ,run prop_unzip6+    ,run prop_unzip7+    ]++  runTests "Functions on strings" opts+    [run prop_lines+    ,run prop_words+    ,run prop_unlines+    ,run prop_unwords+    ]++  runTests "\"Set\" operations" opts+    [run prop_nub+    ,run prop_delete+    ,run prop_difference+    ,run prop_union+    ,run prop_intersect+    ]++  runTests "Ordered lists" opts+    [run prop_sort+    ,run prop_insert+    ]++  runTests "Eq style \"By\" operations" opts+    [run prop_nubBy+    ,run prop_deleteBy+    ,run prop_deleteFirstsBy+    ,run prop_unionBy+    ,run prop_intersectBy+    ,run prop_groupBy+    ]++  runTests "Ord style \"By\" operations" opts+    [run prop_sortBy        -- note issue here.+    ,run prop_insertBy+    ,run prop_maximumBy+    ,run prop_minimumBy+    ]++  runTests "The \"generic\" operations" opts+    [run prop_genericLength+    ,run prop_genericTake+    ,run prop_genericDrop+    ,run prop_genericSplitAt+    ,run prop_genericIndex+    ,run prop_genericReplicate+    ]
+ tests/Properties/Monomorphic/Base.hs view
@@ -0,0 +1,321 @@+--+-- The Data.List api+--+module Properties.Monomorphic.Base where++import Properties.Utils++import qualified Data.List as Spec++-- * Basic interface+(++)            :: [A] -> [A] -> [A]+head            :: [A] -> A+last            :: [A] -> A+tail            :: [A] -> [A]+init            :: [A] -> [A]+null            :: [A] -> Bool+length          :: [A] -> Int++-- * List transformations+map             :: (A -> B) -> [A] -> [B]+reverse         :: [A] -> [A]+intersperse     :: A -> [A] -> [A]+intercalate     :: [A] -> [[A]] -> [A]+transpose       :: [[A]] -> [[A]]++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> [A] -> B+foldl'          :: (B -> A -> B) -> B -> [A] -> B+foldl1          :: (A -> A -> A) -> [A] -> A+foldl1'         :: (A -> A -> A) -> [A] -> A+foldr           :: (A -> B -> B) -> B -> [A] -> B+foldr1          :: (A -> A -> A) -> [A] -> A++-- ** Special folds+concat          :: [[A]] -> [A]+concatMap       :: (A -> [B]) -> [A] -> [B]+and             :: [Bool] -> Bool+or              :: [Bool] -> Bool+any             :: (A -> Bool) -> [A] -> Bool+all             :: (A -> Bool) -> [A] -> Bool+sum             :: [N] -> N+product         :: [N] -> N+maximum         :: [OrdA] -> OrdA+minimum         :: [OrdA] -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> [B] -> [A]+scanl1          :: (A -> A -> A) -> [A] -> [A]+scanr           :: (A -> B -> B) -> B -> [A] -> [B]+scanr1          :: (A -> A -> A) -> [A] -> [A]++-- ** Accumulating maps+mapAccumL       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+mapAccumR       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])++-- ** Infinite lists+iterate         :: (A -> A) -> A -> [A]+repeat          :: A -> [A]+replicate       :: Int -> A -> [A]+cycle           :: [A] -> [A]++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> [A]++-- * Sublists+-- ** Extracting sublists+take            :: Int -> [A] -> [A]+drop            :: Int -> [A] -> [A]+splitAt         :: Int -> [A] -> ([A], [A])+takeWhile       :: (A -> Bool) -> [A] -> [A]+dropWhile       :: (A -> Bool) -> [A] -> [A]+span            :: (A -> Bool) -> [A] -> ([A], [A])+break           :: (A -> Bool) -> [A] -> ([A], [A])+group           :: [A] -> [[A]]+inits           :: [A] -> [[A]]+tails           :: [A] -> [[A]]++-- * Predicates+isPrefixOf      :: [A] -> [A] -> Bool+isSuffixOf      :: [A] -> [A] -> Bool+isInfixOf       :: [A] -> [A] -> Bool++-- * Searching lists+-- ** Searching by equality+elem            :: A -> [A] -> Bool+notElem         :: A -> [A] -> Bool+lookup          :: A -> [(A, B)] -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> [A] -> Maybe A+filter          :: (A -> Bool) -> [A] -> [A]+partition       :: (A -> Bool) -> [A] -> ([A], [A])++-- * Indexing lists+(!!)            :: [A] -> Int -> A+elemIndex       :: A -> [A] -> Maybe Int+elemIndices     :: A -> [A] -> [Int]+findIndex       :: (A -> Bool) -> [A] -> Maybe Int+findIndices     :: (A -> Bool) -> [A] -> [Int]++-- * Zipping and unzipping lists+zip             :: [A] -> [B] -> [(A, B)]+zip3            :: [A] -> [B] -> [C] -> [(A, B, C)]+zip4            :: [A] -> [B] -> [C] -> [D] -> [(A, B, C, D)]+zip5            :: [A] -> [B] -> [C] -> [D] -> [E] -> [(A, B, C, D, E)]+zip6            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [(A, B, C, D, E, F)]+zip7            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [(A, B, C, D, E, F, G)]+zipWith         :: (A -> B -> C) -> [A] -> [B] -> [C]+zipWith3        :: (A -> B -> C -> D) -> [A] -> [B] -> [C] -> [D]+zipWith4        :: (A -> B -> C -> D -> E) -> [A] -> [B] -> [C] -> [D] -> [E]+zipWith5        :: (A -> B -> C -> D -> E -> F) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F]+zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G]+zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [H]+unzip           :: [(A, B)] -> ([A], [B])+unzip3          :: [(A, B, C)] -> ([A], [B], [C])+unzip4          :: [(A, B, C, D)] -> ([A], [B], [C], [D])+unzip5          :: [(A, B, C, D, E)] -> ([A], [B], [C], [D], [E])+unzip6          :: [(A, B, C, D, E, F)] -> ([A], [B], [C], [D], [E], [F])+unzip7          :: [(A, B, C, D, E, F, G)] -> ([A], [B], [C], [D], [E], [F], [G])++-- * Special lists+-- ** Functions on strings+lines           :: String -> [String]+words           :: String -> [String]+unlines         :: [String] -> String+unwords         :: [String] -> String++-- ** \"Set\" operations+nub             :: [A] -> [A]+delete          :: A -> [A] -> [A]+(\\)            :: [A] -> [A] -> [A]+union           :: [A] -> [A] -> [A]+intersect       :: [A] -> [A] -> [A]++-- ** Ordered lists +sort            :: [OrdA] -> [OrdA]+insert          :: OrdA -> [OrdA] -> [OrdA]++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (A -> A -> Bool) -> [A] -> [A]+deleteBy        :: (A -> A -> Bool) -> A -> [A] -> [A]+deleteFirstsBy  :: (A -> A -> Bool) -> [A] -> [A] -> [A]+unionBy         :: (A -> A -> Bool) -> [A] -> [A] -> [A]+intersectBy     :: (A -> A -> Bool) -> [A] -> [A] -> [A]+groupBy         :: (A -> A -> Bool) -> [A] -> [[A]]++-- *** User-supplied comparison (replacing an Ord context)+sortBy          :: (A -> A -> Ordering) -> [A] -> [A]+insertBy        :: (A -> A -> Ordering) -> A -> [A] -> [A]+maximumBy       :: (A -> A -> Ordering) -> [A] -> A+minimumBy       :: (A -> A -> Ordering) -> [A] -> A++-- * The \"generic\" operations+genericLength           :: [A] -> I+genericTake             :: I -> [A] -> [A]+genericDrop             :: I -> [A] -> [A]+genericSplitAt          :: I -> [A] -> ([A], [A])+genericIndex            :: [A] -> I -> A+genericReplicate        :: I -> A -> [A]++++-- * Basic interface+(++)            = (Spec.++)+head            = Spec.head+last            = Spec.last+tail            = Spec.tail+init            = Spec.init+null            = Spec.null+length          = Spec.length++-- * List transformations+map             = Spec.map+reverse         = Spec.reverse+intersperse     = Spec.intersperse++-- intercalate     = -- Spec.intercalate+intercalate xs xss = Spec.concat (Spec.intersperse xs xss)++transpose       = Spec.transpose++-- * Reducing lists (folds)+foldl           = Spec.foldl+foldl'          = Spec.foldl'+foldl1          = Spec.foldl1+foldl1'         = Spec.foldl1'+foldr           = Spec.foldr+foldr1          = Spec.foldr1++-- ** Special folds+concat          = Spec.concat+concatMap       = Spec.concatMap+and             = Spec.and+or              = Spec.or+any             = Spec.any+all             = Spec.all+sum             = Spec.sum+product         = Spec.product+maximum         = Spec.maximum+minimum         = Spec.minimum++-- * Building lists+-- ** Scans+scanl           = Spec.scanl+scanl1          = Spec.scanl1+scanr           = Spec.scanr+scanr1          = Spec.scanr1++-- ** Accumulating maps+mapAccumL       = Spec.mapAccumL+mapAccumR       = Spec.mapAccumR++-- ** Infinite lists+iterate         = Spec.iterate+repeat          = Spec.repeat+replicate       = Spec.replicate+cycle           = Spec.cycle++-- ** Unfolding+unfoldr         = Spec.unfoldr++-- * Sublists+-- ** Extracting sublists+take            = Spec.take+drop            = Spec.drop+splitAt         = Spec.splitAt+takeWhile       = Spec.takeWhile+dropWhile       = Spec.dropWhile+span            = Spec.span+break           = Spec.break+group           = Spec.group+inits           = Spec.inits+tails           = Spec.tails++-- * Predicates+isPrefixOf      = Spec.isPrefixOf+isSuffixOf      = Spec.isSuffixOf+isInfixOf       = Spec.isInfixOf++-- * Searching lists+-- ** Searching by equality+elem            = Spec.elem+notElem         = Spec.notElem+lookup          = Spec.lookup++-- ** Searching with a predicate+find            = Spec.find+filter          = Spec.filter+partition       = Spec.partition++-- * Indexing lists+(!!)            = (Spec.!!)+elemIndex       = Spec.elemIndex+elemIndices     = Spec.elemIndices+findIndex       = Spec.findIndex+findIndices     = Spec.findIndices++-- * Zipping and unzipping lists+zip             = Spec.zip+zip3            = Spec.zip3+zip4            = Spec.zip4+zip5            = Spec.zip5+zip6            = Spec.zip6+zip7            = Spec.zip7+zipWith         = Spec.zipWith+zipWith3        = Spec.zipWith3+zipWith4        = Spec.zipWith4+zipWith5        = Spec.zipWith5+zipWith6        = Spec.zipWith6+zipWith7        = Spec.zipWith7+unzip           = Spec.unzip+unzip3          = Spec.unzip3+unzip4          = Spec.unzip4+unzip5          = Spec.unzip5+unzip6          = Spec.unzip6+unzip7          = Spec.unzip7++-- * Special lists+-- ** Functions on strings+lines           = Spec.lines+words           = Spec.words+unlines         = Spec.unlines+unwords         = Spec.unwords++-- ** \"Set\" operations+nub             = Spec.nub+delete          = Spec.delete+(\\)            = (Spec.\\)+union           = Spec.union+intersect       = Spec.intersect++-- ** Ordered lists +sort            = Spec.sort+insert          = Spec.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = Spec.nubBy+deleteBy        = Spec.deleteBy+deleteFirstsBy  = Spec.deleteFirstsBy+unionBy         = Spec.unionBy+intersectBy     = Spec.intersectBy+groupBy         = Spec.groupBy++-- *** User-supplied comparison (replacing an Ord context)+sortBy          = Spec.sortBy+insertBy        = Spec.insertBy+maximumBy       = Spec.maximumBy+minimumBy       = Spec.minimumBy++-- * The \"generic\" operations+genericLength           = Spec.genericLength+genericTake             = Spec.genericTake+genericDrop             = Spec.genericDrop+genericSplitAt          = Spec.genericSplitAt+genericIndex            = Spec.genericIndex+genericReplicate        = Spec.genericReplicate
+ tests/Properties/Monomorphic/List.hs view
@@ -0,0 +1,319 @@+module Properties.Monomorphic.List where++--+-- just test the List api+--++import Properties.Utils++import qualified Data.List.Stream as List++-- * Basic interface+(++)            :: [A] -> [A] -> [A]+head            :: [A] -> A+last            :: [A] -> A+tail            :: [A] -> [A]+init            :: [A] -> [A]+null            :: [A] -> Bool+length          :: [A] -> Int++-- * List transformations+map             :: (A -> B) -> [A] -> [B]+reverse         :: [A] -> [A]+intersperse     :: A -> [A] -> [A]+intercalate     :: [A] -> [[A]] -> [A]+transpose       :: [[A]] -> [[A]]++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> [A] -> B+foldl'          :: (B -> A -> B) -> B -> [A] -> B+foldl1          :: (A -> A -> A) -> [A] -> A+foldl1'         :: (A -> A -> A) -> [A] -> A+foldr           :: (A -> B -> B) -> B -> [A] -> B+foldr1          :: (A -> A -> A) -> [A] -> A++-- ** Special folds+concat          :: [[A]] -> [A]+concatMap       :: (A -> [B]) -> [A] -> [B]+and             :: [Bool] -> Bool+or              :: [Bool] -> Bool+any             :: (A -> Bool) -> [A] -> Bool+all             :: (A -> Bool) -> [A] -> Bool+sum             :: [N] -> N+product         :: [N] -> N+maximum         :: [OrdA] -> OrdA+minimum         :: [OrdA] -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> [B] -> [A]+scanl1          :: (A -> A -> A) -> [A] -> [A]+scanr           :: (A -> B -> B) -> B -> [A] -> [B]+scanr1          :: (A -> A -> A) -> [A] -> [A]++-- ** Accumulating maps+mapAccumL       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+mapAccumR       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])++-- ** Infinite lists+iterate         :: (A -> A) -> A -> [A]+repeat          :: A -> [A]+replicate       :: Int -> A -> [A]+cycle           :: [A] -> [A]++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> [A]++-- * Sublists+-- ** Extracting sublists+take            :: Int -> [A] -> [A]+drop            :: Int -> [A] -> [A]+splitAt         :: Int -> [A] -> ([A], [A])+takeWhile       :: (A -> Bool) -> [A] -> [A]+dropWhile       :: (A -> Bool) -> [A] -> [A]+span            :: (A -> Bool) -> [A] -> ([A], [A])+break           :: (A -> Bool) -> [A] -> ([A], [A])+group           :: [A] -> [[A]]+inits           :: [A] -> [[A]]+tails           :: [A] -> [[A]]++-- * Predicates+isPrefixOf      :: [A] -> [A] -> Bool+isSuffixOf      :: [A] -> [A] -> Bool+isInfixOf       :: [A] -> [A] -> Bool++-- * Searching lists+-- ** Searching by equality+elem            :: A -> [A] -> Bool+notElem         :: A -> [A] -> Bool+lookup          :: A -> [(A, B)] -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> [A] -> Maybe A+filter          :: (A -> Bool) -> [A] -> [A]+partition       :: (A -> Bool) -> [A] -> ([A], [A])++-- * Indexing lists+(!!)            :: [A] -> Int -> A+elemIndex       :: A -> [A] -> Maybe Int+elemIndices     :: A -> [A] -> [Int]+findIndex       :: (A -> Bool) -> [A] -> Maybe Int+findIndices     :: (A -> Bool) -> [A] -> [Int]++-- * Zipping and unzipping lists+zip             :: [A] -> [B] -> [(A, B)]+zip3            :: [A] -> [B] -> [C] -> [(A, B, C)]+zip4            :: [A] -> [B] -> [C] -> [D] -> [(A, B, C, D)]+zip5            :: [A] -> [B] -> [C] -> [D] -> [E] -> [(A, B, C, D, E)]+zip6            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [(A, B, C, D, E, F)]+zip7            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [(A, B, C, D, E, F, G)]+zipWith         :: (A -> B -> C) -> [A] -> [B] -> [C]+zipWith3        :: (A -> B -> C -> D) -> [A] -> [B] -> [C] -> [D]+zipWith4        :: (A -> B -> C -> D -> E) -> [A] -> [B] -> [C] -> [D] -> [E]+zipWith5        :: (A -> B -> C -> D -> E -> F) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F]+zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G]+zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [H]+unzip           :: [(A, B)] -> ([A], [B])+unzip3          :: [(A, B, C)] -> ([A], [B], [C])+unzip4          :: [(A, B, C, D)] -> ([A], [B], [C], [D])+unzip5          :: [(A, B, C, D, E)] -> ([A], [B], [C], [D], [E])+unzip6          :: [(A, B, C, D, E, F)] -> ([A], [B], [C], [D], [E], [F])+unzip7          :: [(A, B, C, D, E, F, G)] -> ([A], [B], [C], [D], [E], [F], [G])++-- * Special lists+-- ** Functions on strings+lines           :: String -> [String]+words           :: String -> [String]+unlines         :: [String] -> String+unwords         :: [String] -> String++-- ** \"Set\" operations+nub             :: [A] -> [A]+delete          :: A -> [A] -> [A]+(\\)            :: [A] -> [A] -> [A]+union           :: [A] -> [A] -> [A]+intersect       :: [A] -> [A] -> [A]++-- ** Ordered lists +sort            :: [OrdA] -> [OrdA]+insert          :: OrdA -> [OrdA] -> [OrdA]++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (A -> A -> Bool) -> [A] -> [A]+deleteBy        :: (A -> A -> Bool) -> A -> [A] -> [A]+deleteFirstsBy  :: (A -> A -> Bool) -> [A] -> [A] -> [A]+unionBy         :: (A -> A -> Bool) -> [A] -> [A] -> [A]+intersectBy     :: (A -> A -> Bool) -> [A] -> [A] -> [A]+groupBy         :: (A -> A -> Bool) -> [A] -> [[A]]++-- *** User-supplied comparison (replacing an Ord context)+sortBy          :: (A -> A -> Ordering) -> [A] -> [A]+insertBy        :: (A -> A -> Ordering) -> A -> [A] -> [A]+maximumBy       :: (A -> A -> Ordering) -> [A] -> A+minimumBy       :: (A -> A -> Ordering) -> [A] -> A++-- * The \"generic\" operations+genericLength           :: [A] -> I+genericTake             :: I -> [A] -> [A]+genericDrop             :: I -> [A] -> [A]+genericSplitAt          :: I -> [A] -> ([A], [A])+genericIndex            :: [A] -> I -> A+genericReplicate        :: I -> A -> [A]++++-- * Basic interface+(++)            = (List.++)+head            = List.head+last            = List.last+tail            = List.tail+init            = List.init+null            = List.null+length          = List.length++-- * List transformations+map             = List.map+reverse         = List.reverse+intersperse     = List.intersperse+intercalate     = List.intercalate+transpose       = List.transpose++-- * Reducing lists (folds)+foldl           = List.foldl+foldl'          = List.foldl'+foldl1          = List.foldl1+foldl1'         = List.foldl1'+foldr           = List.foldr+foldr1          = List.foldr1++-- ** Special folds+concat          = List.concat+concatMap       = List.concatMap+and             = List.and+or              = List.or+any             = List.any+all             = List.all+sum             = List.sum+product         = List.product+maximum         = List.maximum+minimum         = List.minimum++-- * Building lists+-- ** Scans+scanl           = List.scanl+scanl1          = List.scanl1+scanr           = List.scanr+scanr1          = List.scanr1++-- ** Accumulating maps+mapAccumL       = List.mapAccumL+mapAccumR       = List.mapAccumR++-- ** Infinite lists+iterate         = List.iterate+repeat          = List.repeat+replicate       = List.replicate+cycle           = List.cycle++-- ** Unfolding+unfoldr         = List.unfoldr++-- * Sublists+-- ** Extracting sublists+take            = List.take+drop            = List.drop+splitAt         = List.splitAt+takeWhile       = List.takeWhile+dropWhile       = List.dropWhile+span            = List.span+break           = List.break+group           = List.group+inits           = List.inits+tails           = List.tails++-- * Predicates+isPrefixOf      = List.isPrefixOf+isSuffixOf      = List.isSuffixOf+isInfixOf       = List.isInfixOf++-- * Searching lists+-- ** Searching by equality+elem            = List.elem+notElem         = List.notElem+lookup          = List.lookup++-- ** Searching with a predicate+find            = List.find+filter          = List.filter+partition       = List.partition++-- * Indexing lists+(!!)            = (List.!!)+elemIndex       = List.elemIndex+elemIndices     = List.elemIndices+findIndex       = List.findIndex+findIndices     = List.findIndices++-- * Zipping and unzipping lists+zip             = List.zip+zip3            = List.zip3+zip4            = List.zip4+zip5            = List.zip5+zip6            = List.zip6+zip7            = List.zip7+zipWith         = List.zipWith+zipWith3        = List.zipWith3+zipWith4        = List.zipWith4+zipWith5        = List.zipWith5+zipWith6        = List.zipWith6+zipWith7        = List.zipWith7+unzip           = List.unzip+unzip3          = List.unzip3+unzip4          = List.unzip4+unzip5          = List.unzip5+unzip6          = List.unzip6+unzip7          = List.unzip7++-- * Special lists+-- ** Functions on strings+lines           = List.lines+words           = List.words+unlines         = List.unlines+unwords         = List.unwords++-- ** \"Set\" operations+nub             = List.nub+delete          = List.delete+(\\)            = (List.\\)+union           = List.union+intersect       = List.intersect++-- ** Ordered lists +sort            = List.sort+insert          = List.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = List.nubBy+deleteBy        = List.deleteBy+deleteFirstsBy  = List.deleteFirstsBy+unionBy         = List.unionBy+intersectBy     = List.intersectBy+groupBy         = List.groupBy++-- *** User-supplied comparison (replacing an Ord context)+sortBy          = List.sortBy+insertBy        = List.insertBy+maximumBy       = List.maximumBy+minimumBy       = List.minimumBy++-- * The \"generic\" operations+genericLength           = List.genericLength+genericTake             = List.genericTake+genericDrop             = List.genericDrop+genericSplitAt          = List.genericSplitAt+genericIndex            = List.genericIndex+genericReplicate        = List.genericReplicate
+ tests/Properties/Monomorphic/Spec.hs view
@@ -0,0 +1,316 @@+module Properties.Monomorphic.Spec where++import Properties.Utils++import qualified Spec.List as Spec+import qualified Spec.ListExts as Spec++-- * Basic interface+(++)            :: [A] -> [A] -> [A]+head            :: [A] -> A+last            :: [A] -> A+tail            :: [A] -> [A]+init            :: [A] -> [A]+null            :: [A] -> Bool+length          :: [A] -> Int++-- * List transformations+map             :: (A -> B) -> [A] -> [B]+reverse         :: [A] -> [A]+intersperse     :: A -> [A] -> [A]+intercalate     :: [A] -> [[A]] -> [A]+transpose       :: [[A]] -> [[A]]++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> [A] -> B+foldl'          :: (B -> A -> B) -> B -> [A] -> B+foldl1          :: (A -> A -> A) -> [A] -> A+foldl1'         :: (A -> A -> A) -> [A] -> A+foldr           :: (A -> B -> B) -> B -> [A] -> B+foldr1          :: (A -> A -> A) -> [A] -> A++-- ** Special folds+concat          :: [[A]] -> [A]+concatMap       :: (A -> [B]) -> [A] -> [B]+and             :: [Bool] -> Bool+or              :: [Bool] -> Bool+any             :: (A -> Bool) -> [A] -> Bool+all             :: (A -> Bool) -> [A] -> Bool+sum             :: [N] -> N+product         :: [N] -> N+maximum         :: [OrdA] -> OrdA+minimum         :: [OrdA] -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> [B] -> [A]+scanl1          :: (A -> A -> A) -> [A] -> [A]+scanr           :: (A -> B -> B) -> B -> [A] -> [B]+scanr1          :: (A -> A -> A) -> [A] -> [A]++-- ** Accumulating maps+mapAccumL       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+mapAccumR       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])++-- ** Infinite lists+iterate         :: (A -> A) -> A -> [A]+repeat          :: A -> [A]+replicate       :: Int -> A -> [A]+cycle           :: [A] -> [A]++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> [A]++-- * Sublists+-- ** Extracting sublists+take            :: Int -> [A] -> [A]+drop            :: Int -> [A] -> [A]+splitAt         :: Int -> [A] -> ([A], [A])+takeWhile       :: (A -> Bool) -> [A] -> [A]+dropWhile       :: (A -> Bool) -> [A] -> [A]+span            :: (A -> Bool) -> [A] -> ([A], [A])+break           :: (A -> Bool) -> [A] -> ([A], [A])+group           :: [A] -> [[A]]+inits           :: [A] -> [[A]]+tails           :: [A] -> [[A]]++-- * Predicates+isPrefixOf      :: [A] -> [A] -> Bool+isSuffixOf      :: [A] -> [A] -> Bool+isInfixOf       :: [A] -> [A] -> Bool++-- * Searching lists+-- ** Searching by equality+elem            :: A -> [A] -> Bool+notElem         :: A -> [A] -> Bool+lookup          :: A -> [(A, B)] -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> [A] -> Maybe A+filter          :: (A -> Bool) -> [A] -> [A]+partition       :: (A -> Bool) -> [A] -> ([A], [A])++-- * Indexing lists+(!!)            :: [A] -> Int -> A+elemIndex       :: A -> [A] -> Maybe Int+elemIndices     :: A -> [A] -> [Int]+findIndex       :: (A -> Bool) -> [A] -> Maybe Int+findIndices     :: (A -> Bool) -> [A] -> [Int]++-- * Zipping and unzipping lists+zip             :: [A] -> [B] -> [(A, B)]+zip3            :: [A] -> [B] -> [C] -> [(A, B, C)]+zip4            :: [A] -> [B] -> [C] -> [D] -> [(A, B, C, D)]+zip5            :: [A] -> [B] -> [C] -> [D] -> [E] -> [(A, B, C, D, E)]+zip6            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [(A, B, C, D, E, F)]+zip7            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [(A, B, C, D, E, F, G)]+zipWith         :: (A -> B -> C) -> [A] -> [B] -> [C]+zipWith3        :: (A -> B -> C -> D) -> [A] -> [B] -> [C] -> [D]+zipWith4        :: (A -> B -> C -> D -> E) -> [A] -> [B] -> [C] -> [D] -> [E]+zipWith5        :: (A -> B -> C -> D -> E -> F) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F]+zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G]+zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [H]+unzip           :: [(A, B)] -> ([A], [B])+unzip3          :: [(A, B, C)] -> ([A], [B], [C])+unzip4          :: [(A, B, C, D)] -> ([A], [B], [C], [D])+unzip5          :: [(A, B, C, D, E)] -> ([A], [B], [C], [D], [E])+unzip6          :: [(A, B, C, D, E, F)] -> ([A], [B], [C], [D], [E], [F])+unzip7          :: [(A, B, C, D, E, F, G)] -> ([A], [B], [C], [D], [E], [F], [G])++-- * Special lists+-- ** Functions on strings+lines           :: String -> [String]+words           :: String -> [String]+unlines         :: [String] -> String+unwords         :: [String] -> String++-- ** \"Set\" operations+nub             :: [A] -> [A]+delete          :: A -> [A] -> [A]+(\\)            :: [A] -> [A] -> [A]+union           :: [A] -> [A] -> [A]+intersect       :: [A] -> [A] -> [A]++-- ** Ordered lists +sort            :: [OrdA] -> [OrdA]+insert          :: OrdA -> [OrdA] -> [OrdA]++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (A -> A -> Bool) -> [A] -> [A]+deleteBy        :: (A -> A -> Bool) -> A -> [A] -> [A]+deleteFirstsBy  :: (A -> A -> Bool) -> [A] -> [A] -> [A]+unionBy         :: (A -> A -> Bool) -> [A] -> [A] -> [A]+intersectBy     :: (A -> A -> Bool) -> [A] -> [A] -> [A]+groupBy         :: (A -> A -> Bool) -> [A] -> [[A]]++-- *** User-supplied comparison (replacing an Ord context)+sortBy          :: (A -> A -> Ordering) -> [A] -> [A]+insertBy        :: (A -> A -> Ordering) -> A -> [A] -> [A]+maximumBy       :: (A -> A -> Ordering) -> [A] -> A+minimumBy       :: (A -> A -> Ordering) -> [A] -> A++-- * The \"generic\" operations+genericLength           :: [A] -> I+genericTake             :: I -> [A] -> [A]+genericDrop             :: I -> [A] -> [A]+genericSplitAt          :: I -> [A] -> ([A], [A])+genericIndex            :: [A] -> I -> A+genericReplicate        :: I -> A -> [A]++++-- * Basic interface+(++)            = (Spec.++)+head            = Spec.head+last            = Spec.last+tail            = Spec.tail+init            = Spec.init+null            = Spec.null+length          = Spec.length++-- * List transformations+map             = Spec.map+reverse         = Spec.reverse+intersperse     = Spec.intersperse+intercalate     = Spec.intercalate+transpose       = Spec.transpose++-- * Reducing lists (folds)+foldl           = Spec.foldl+foldl'          = Spec.foldl'+foldl1          = Spec.foldl1+foldl1'         = Spec.foldl1'+foldr           = Spec.foldr+foldr1          = Spec.foldr1++-- ** Special folds+concat          = Spec.concat+concatMap       = Spec.concatMap+and             = Spec.and+or              = Spec.or+any             = Spec.any+all             = Spec.all+sum             = Spec.sum+product         = Spec.product+maximum         = Spec.maximum+minimum         = Spec.minimum++-- * Building lists+-- ** Scans+scanl           = Spec.scanl+scanl1          = Spec.scanl1+scanr           = Spec.scanr+scanr1          = Spec.scanr1++-- ** Accumulating maps+mapAccumL       = Spec.mapAccumL+mapAccumR       = Spec.mapAccumR++-- ** Infinite lists+iterate         = Spec.iterate+repeat          = Spec.repeat+replicate       = Spec.replicate+cycle           = Spec.cycle++-- ** Unfolding+unfoldr         = Spec.unfoldr++-- * Sublists+-- ** Extracting sublists+take            = Spec.take+drop            = Spec.drop+splitAt         = Spec.splitAt+takeWhile       = Spec.takeWhile+dropWhile       = Spec.dropWhile+span            = Spec.span+break           = Spec.break+group           = Spec.group+inits           = Spec.inits+tails           = Spec.tails++-- * Predicates+isPrefixOf      = Spec.isPrefixOf+isSuffixOf      = Spec.isSuffixOf+isInfixOf       = Spec.isInfixOf++-- * Searching lists+-- ** Searching by equality+elem            = Spec.elem+notElem         = Spec.notElem+lookup          = Spec.lookup++-- ** Searching with a predicate+find            = Spec.find+filter          = Spec.filter+partition       = Spec.partition++-- * Indexing lists+(!!)            = (Spec.!!)+elemIndex       = Spec.elemIndex+elemIndices     = Spec.elemIndices+findIndex       = Spec.findIndex+findIndices     = Spec.findIndices++-- * Zipping and unzipping lists+zip             = Spec.zip+zip3            = Spec.zip3+zip4            = Spec.zip4+zip5            = Spec.zip5+zip6            = Spec.zip6+zip7            = Spec.zip7+zipWith         = Spec.zipWith+zipWith3        = Spec.zipWith3+zipWith4        = Spec.zipWith4+zipWith5        = Spec.zipWith5+zipWith6        = Spec.zipWith6+zipWith7        = Spec.zipWith7+unzip           = Spec.unzip+unzip3          = Spec.unzip3+unzip4          = Spec.unzip4+unzip5          = Spec.unzip5+unzip6          = Spec.unzip6+unzip7          = Spec.unzip7++-- * Special lists+-- ** Functions on strings+lines           = Spec.lines+words           = Spec.words+unlines         = Spec.unlines+unwords         = Spec.unwords++-- ** \"Set\" operations+nub             = Spec.nub+delete          = Spec.delete+(\\)            = (Spec.\\)+union           = Spec.union+intersect       = Spec.intersect++-- ** Ordered lists +sort            = Spec.sort+insert          = Spec.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = Spec.nubBy+deleteBy        = Spec.deleteBy+deleteFirstsBy  = Spec.deleteFirstsBy+unionBy         = Spec.unionBy+intersectBy     = Spec.intersectBy+groupBy         = Spec.groupBy++-- *** User-supplied comparison (replacing an Ord context)+sortBy          = Spec.sortBy+insertBy        = Spec.insertBy+maximumBy       = Spec.maximumBy+minimumBy       = Spec.minimumBy++-- * The \"generic\" operations+genericLength           = Spec.genericLength+genericTake             = Spec.genericTake+genericDrop             = Spec.genericDrop+genericSplitAt          = Spec.genericSplitAt+genericIndex            = Spec.genericIndex+genericReplicate        = Spec.genericReplicate
+ tests/Properties/Monomorphic/SpecStream.hs view
@@ -0,0 +1,335 @@+-- Haskell98 list spec wrapped in a stream interface so we can compare it to+-- the stream implementation and test using streams that contain Skips.++module Properties.Monomorphic.SpecStream where++import Properties.Utils++import qualified Spec.List as Spec+import qualified Spec.ListExts as Spec+import Data.Stream as Stream (Stream, stream, unstream)++-- * Basic interface+cons            :: A -> Stream A -> Stream A+snoc            :: Stream A -> A -> Stream A+(++)            :: Stream A -> Stream A -> Stream A+head            :: Stream A -> A+last            :: Stream A -> A+tail            :: Stream A -> Stream A+init            :: Stream A -> Stream A+null            :: Stream A -> Bool+length          :: Stream A -> Int++-- * List transformations+map             :: (A -> B) -> Stream A -> Stream B+reverse         :: Stream A -> Stream A+intersperse     :: A -> Stream A -> Stream A+intercalate     :: Stream A -> Stream (Stream A) -> Stream A+transpose       :: Stream (Stream A) -> Stream (Stream A)++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> Stream A -> B+foldl'          :: (B -> A -> B) -> B -> Stream A -> B+foldl1          :: (A -> A -> A) -> Stream A -> A+foldl1'         :: (A -> A -> A) -> Stream A -> A+foldr           :: (A -> B -> B) -> B -> Stream A -> B+foldr1          :: (A -> A -> A) -> Stream A -> A++-- ** Special folds+concat          :: Stream (Stream A) -> Stream A+concatMap       :: (A -> Stream B) -> Stream A -> Stream B+and             :: Stream Bool -> Bool+or              :: Stream Bool -> Bool+any             :: (A -> Bool) -> Stream A -> Bool+all             :: (A -> Bool) -> Stream A -> Bool+sum             :: Stream N -> N+product         :: Stream N -> N+maximum         :: Stream OrdA -> OrdA+minimum         :: Stream OrdA -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> Stream B -> Stream A+scanl1          :: (A -> A -> A) -> Stream A -> Stream A+scanr           :: (A -> B -> B) -> B -> Stream A -> Stream B+scanr1          :: (A -> A -> A) -> Stream A -> Stream A++-- ** Accumulating maps+mapAccumL       :: (C -> A -> (C, B)) -> C -> Stream A -> (C, Stream B)+mapAccumR       :: (C -> A -> (C, B)) -> C -> Stream A -> (C, Stream B)++-- ** Infinite lists+iterate         :: (A -> A) -> A -> Stream A+repeat          :: A -> Stream A+replicate       :: Int -> A -> Stream A+cycle           :: Stream A -> Stream A++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> Stream A++-- * Sublists+-- ** Extracting sublists+take            :: Int -> Stream A -> Stream A+drop            :: Int -> Stream A -> Stream A+splitAt         :: Int -> Stream A -> ([A], [A])+takeWhile       :: (A -> Bool) -> Stream A -> Stream A+dropWhile       :: (A -> Bool) -> Stream A -> Stream A+span            :: (A -> Bool) -> Stream A -> ([A], [A])+break           :: (A -> Bool) -> Stream A -> ([A], [A])+group           :: Stream A -> Stream (Stream A)+inits           :: Stream A -> Stream (Stream A)+tails           :: Stream A -> Stream (Stream A)++-- * Predicates+isPrefixOf      :: Stream A -> Stream A -> Bool+isSuffixOf      :: Stream A -> Stream A -> Bool+isInfixOf       :: Stream A -> Stream A -> Bool++-- * Searching lists+-- ** Searching by equality+elem            :: A -> Stream A -> Bool+notElem         :: A -> Stream A -> Bool+lookup          :: A -> Stream (A, B) -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> Stream A -> Maybe A+filter          :: (A -> Bool) -> Stream A -> Stream A+partition       :: (A -> Bool) -> Stream A -> ([A], [A])++-- * Indexing lists+(!!)            :: Stream A -> Int -> A+elemIndex       :: A -> Stream A -> Maybe Int+elemIndices     :: A -> Stream A -> Stream Int+findIndex       :: (A -> Bool) -> Stream A -> Maybe Int+findIndices     :: (A -> Bool) -> Stream A -> Stream Int++-- * Zipping and unzipping lists+zip             :: Stream A -> Stream B -> Stream (A, B)+zip3            :: Stream A -> Stream B -> Stream C -> Stream (A, B, C)+zip4            :: Stream A -> Stream B -> Stream C -> Stream D -> Stream (A, B, C, D)+zip5            :: Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream (A, B, C, D, E)+zip6            :: Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F -> Stream (A, B, C, D, E, F)+zip7            :: Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F -> Stream G -> Stream (A, B, C, D, E, F, G)+zipWith         :: (A -> B -> C) -> Stream A -> Stream B -> Stream C+zipWith3        :: (A -> B -> C -> D) -> Stream A -> Stream B -> Stream C -> Stream D+zipWith4        :: (A -> B -> C -> D -> E) -> Stream A -> Stream B -> Stream C -> Stream D -> Stream E+zipWith5        :: (A -> B -> C -> D -> E -> F) -> Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F+zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F -> Stream G+zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F -> Stream G -> Stream H+unzip           :: Stream (A, B) -> ([A], [B])+unzip3          :: Stream (A, B, C) -> (Stream A, Stream B, Stream C)+unzip4          :: Stream (A, B, C, D) -> (Stream A, Stream B, Stream C, Stream D)+unzip5          :: Stream (A, B, C, D, E) -> (Stream A, Stream B, Stream C, Stream D, Stream E)+unzip6          :: Stream (A, B, C, D, E, F) -> (Stream A, Stream B, Stream C, Stream D, Stream E, Stream F)+unzip7          :: Stream (A, B, C, D, E, F, G) -> (Stream A, Stream B, Stream C, Stream D, Stream E, Stream F, Stream G)++-- * Special lists+-- ** Functions on strings+lines           :: Stream Char -> Stream String+words           :: Stream Char -> Stream String+unlines         :: Stream String -> Stream Char+unwords         :: Stream String -> Stream Char++-- ** \"Set\" operations+nub             :: Stream A -> Stream A+delete          :: A -> Stream A -> Stream A+(\\)            :: Stream A -> Stream A -> Stream A+union           :: Stream A -> Stream A -> Stream A+intersect       :: Stream A -> Stream A -> Stream A++-- ** Ordered lists+sort            :: Stream OrdA -> Stream OrdA+insert          :: OrdA -> Stream OrdA -> Stream OrdA++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (A -> A -> Bool) -> Stream A -> Stream A+deleteBy        :: (A -> A -> Bool) -> A -> Stream A -> Stream A+deleteFirstsBy  :: (A -> A -> Bool) -> Stream A -> Stream A -> Stream A+unionBy         :: (A -> A -> Bool) -> Stream A -> Stream A -> Stream A+intersectBy     :: (A -> A -> Bool) -> Stream A -> Stream A -> Stream A+groupBy         :: (A -> A -> Bool) -> Stream A -> Stream (Stream A)++-- *** User-supplied comparison (replacing an Ord context)+sortBy          :: (A -> A -> Ordering) -> Stream A -> Stream A+insertBy        :: (A -> A -> Ordering) -> A -> Stream A -> Stream A+maximumBy       :: (A -> A -> Ordering) -> Stream A -> A+minimumBy       :: (A -> A -> Ordering) -> Stream A -> A++-- * The \"generic\" operations+genericLength           :: Stream A -> I+genericTake             :: I -> Stream A -> Stream A+genericDrop             :: I -> Stream A -> Stream A+genericSplitAt          :: I -> Stream A -> ([A], [A])+genericIndex            :: Stream A -> I -> A+genericReplicate        :: I -> A -> Stream A+++s :: [a] -> Stream a+s = Stream.stream++u :: Stream a -> [a]+u = Stream.unstream++ss :: [[a]] -> Stream (Stream a)+ss = s . Spec.map s++uu :: Stream (Stream a) -> [[a]]+uu = Spec.map u . u++-- * Basic interface+cons            = \x  xs -> s $ (:)       x (u xs)+snoc            = \xs x  -> s $ (u xs) Spec.++ [x]+(++)            = \xs ys -> s $ (Spec.++)   (u xs) (u ys)+head            = \xs    ->     Spec.head   (u xs)+last            = \xs    ->     Spec.last   (u xs)+tail            = \xs    -> s $ Spec.tail   (u xs)+init            = \xs    -> s $ Spec.init   (u xs)+null            = \xs    ->     Spec.null   (u xs)+length          = \xs    ->     Spec.length (u xs)++-- * List transformations+map             = \f xs     -> s  $ Spec.map         f (u xs)+reverse         = \  xs     -> s  $ Spec.reverse       (u xs)+intersperse     = \x xs     -> s  $ Spec.intersperse x (u xs)+intercalate     = \  xs xss -> s  $ Spec.intercalate   (u xs) (uu xss)+transpose       = \     xss -> ss $ Spec.transpose            (uu xss)++-- * Reducing lists (folds)+foldl           = \f z xs -> Spec.foldl   f z (u xs)+foldl'          = \f z xs -> Spec.foldl'  f z (u xs)+foldl1          = \f   xs -> Spec.foldl1  f   (u xs)+foldl1'         = \f   xs -> Spec.foldl1' f   (u xs)+foldr           = \f z xs -> Spec.foldr   f z (u xs)+foldr1          = \f   xs -> Spec.foldr1  f   (u xs)++-- ** Special folds+concat          = \ xss -> s $ Spec.concat    (uu xss)+concatMap       = \f xs -> s $ Spec.concatMap (u . f) (u xs)+and             = \  xs ->     Spec.and       (u xs)+or              = \  xs ->     Spec.or        (u xs)+any             = \f xs ->     Spec.any     f (u xs)+all             = \f xs ->     Spec.all     f (u xs)+sum             = \  xs ->     Spec.sum       (u xs)+product         = \  xs ->     Spec.product   (u xs)+maximum         = \  xs ->     Spec.maximum   (u xs)+minimum         = \  xs ->     Spec.minimum   (u xs)++-- * Building lists+-- ** Scans+scanl           = \f z xs -> s $ Spec.scanl  f z (u xs)+scanl1          = \f   xs -> s $ Spec.scanl1 f   (u xs)+scanr           = \f z xs -> s $ Spec.scanr  f z (u xs)+scanr1          = \f   xs -> s $ Spec.scanr1 f   (u xs)++-- ** Accumulating maps+mapAccumL       = \f z xs -> (\(a,b)->(a,s b)) $ Spec.mapAccumL f z (u xs)+mapAccumR       = \f z xs -> (\(a,b)->(a,s b)) $ Spec.mapAccumR f z (u xs)++-- ** Infinite lists+iterate         = \f x -> s $ Spec.iterate   f x+repeat          = \  x -> s $ Spec.repeat      x+replicate       = \n x -> s $ Spec.replicate n x+cycle           = \ xs -> s $ Spec.cycle     (u xs)++-- ** Unfolding+unfoldr         = \f x -> s $ Spec.unfoldr f x++-- * Sublists+-- ** Extracting sublists+take            = \n xs -> s  $ Spec.take      n (u xs)+drop            = \n xs -> s  $ Spec.drop      n (u xs)+splitAt         = \n xs ->      Spec.splitAt   n (u xs)+takeWhile       = \f xs -> s  $ Spec.takeWhile f (u xs)+dropWhile       = \f xs -> s  $ Spec.dropWhile f (u xs)+span            = \f xs ->      Spec.span      f (u xs)+break           = \f xs ->      Spec.break     f (u xs)+group           = \  xs -> ss $ Spec.group       (u xs)+inits           = \  xs -> ss $ Spec.inits       (u xs)+tails           = \  xs -> ss $ Spec.tails       (u xs)++-- * Predicates+isPrefixOf      = \xs ys -> Spec.isPrefixOf (u xs) (u ys)+isSuffixOf      = \xs ys -> Spec.isSuffixOf (u xs) (u ys)+isInfixOf       = \xs ys -> Spec.isInfixOf  (u xs) (u ys)++-- * Searching lists+-- ** Searching by equality+elem            = \x xs -> Spec.elem    x (u xs)+notElem         = \x xs -> Spec.notElem x (u xs)+lookup          = \x xs -> Spec.lookup  x (u xs)++-- ** Searching with a predicate+find            = \f xs ->      Spec.find      f (u xs)+filter          = \f xs -> s  $ Spec.filter    f (u xs)+partition       = \f xs ->      Spec.partition f (u xs)++-- * Indexing lists+(!!)            = \xs n ->     (Spec.!!)          (u xs) n+elemIndex       = \x xs ->     Spec.elemIndex   x (u xs)+elemIndices     = \x xs -> s $ Spec.elemIndices x (u xs)+findIndex       = \f xs ->     Spec.findIndex   f (u xs)+findIndices     = \f xs -> s $ Spec.findIndices f (u xs)++-- * Zipping and unzipping lists+zip             = \a b -> s $ Spec.zip (u a) (u b)+zip3            = \a b c -> s $ Spec.zip3 (u a) (u b) (u c)+zip4            = \a b c d -> s $ Spec.zip4 (u a) (u b) (u c) (u d)+zip5            = \a b c d e -> s $ Spec.zip5 (u a) (u b) (u c) (u d) (u e)+zip6            = \a b c d e f -> s $ Spec.zip6 (u a) (u b) (u c) (u d) (u e) (u f)+zip7            = \a b c d e f g -> s $ Spec.zip7 (u a) (u b) (u c) (u d) (u e) (u f) (u g)+zipWith         = \h a b -> s $ Spec.zipWith h (u a) (u b)+zipWith3        = \h a b c -> s $ Spec.zipWith3 h (u a) (u b) (u c)+zipWith4        = \h a b c d -> s $ Spec.zipWith4 h (u a) (u b) (u c) (u d)+zipWith5        = \h a b c d e -> s $ Spec.zipWith5 h (u a) (u b) (u c) (u d) (u e)+zipWith6        = \h a b c d e f -> s $ Spec.zipWith6 h (u a) (u b) (u c) (u d) (u e) (u f)+zipWith7        = \h a b c d e f g -> s $ Spec.zipWith7 h (u a) (u b) (u c) (u d) (u e) (u f) (u g)+unzip           = \xs -> {-(\(a,b)->(s a,s b)) $-} Spec.unzip (u xs)+unzip3          = \xs -> (\(a,b,c)->(s a,s b,s c)) $ Spec.unzip3 (u xs)+unzip4          = \xs -> (\(a,b,c,d)->(s a,s b,s c,s d)) $ Spec.unzip4 (u xs)+unzip5          = \xs -> (\(a,b,c,d,e)->(s a,s b,s c,s d,s e)) $ Spec.unzip5 (u xs)+unzip6          = \xs -> (\(a,b,c,d,e,f)->(s a,s b,s c,s d,s e,s f)) $ Spec.unzip6 (u xs)+unzip7          = \xs -> (\(a,b,c,d,e,f,g)->(s a,s b,s c,s d,s e,s f,s g)) $ Spec.unzip7 (u xs)++-- * Special lists+-- ** Functions on strings+lines           = \x -> s $ Spec.lines (u x)+words           = \x -> s $ Spec.words (u x)+unlines         = \x -> s $ Spec.unlines (u x)+unwords         = \x -> s $ Spec.unwords (u x)++-- ** \"Set\" operations+nub             = \  xs    -> s $ Spec.nub       (u xs)+delete          = \x xs    -> s $ Spec.delete x  (u xs)+(\\)            = \  xs ys -> s $ (Spec.\\)      (u xs) (u ys)+union           = \  xs ys -> s $ Spec.union     (u xs) (u ys)+intersect       = \  xs ys -> s $ Spec.intersect (u xs) (u ys)++-- ** Ordered lists+sort            = \  xs -> s $ Spec.sort     (u xs)+insert          = \x xs -> s $ Spec.insert x (u xs)++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = \f   xs    -> s  $ Spec.nubBy          f   (u xs)+deleteBy        = \f x xs    -> s  $ Spec.deleteBy       f x (u xs)+deleteFirstsBy  = \f   xs ys -> s  $ Spec.deleteFirstsBy f   (u xs) (u ys)+unionBy         = \f   xs ys -> s  $ Spec.unionBy        f   (u xs) (u ys)+intersectBy     = \f   xs ys -> s  $ Spec.intersectBy    f   (u xs) (u ys)+groupBy         = \f   xs    -> ss $ Spec.groupBy        f   (u xs)++-- *** User-supplied comparison (replacing an Ord context)+sortBy          = \f   xs -> s $ Spec.sortBy    f   (u xs)+insertBy        = \f x xs -> s $ Spec.insertBy  f x (u xs)+maximumBy       = \f   xs ->     Spec.maximumBy f   (u xs)+minimumBy       = \f   xs ->     Spec.minimumBy f   (u xs)++-- * The \"generic\" operations+genericLength           = \  xs ->      Spec.genericLength      (u xs)+genericTake             = \n xs -> s  $ Spec.genericTake      n (u xs)+genericDrop             = \n xs -> s  $ Spec.genericDrop      n (u xs)+genericSplitAt          = \n xs ->      Spec.genericSplitAt   n (u xs)+genericIndex            = \xs n ->      Spec.genericIndex       (u xs) n+genericReplicate        = \n x  -> s  $ Spec.genericReplicate n x
+ tests/Properties/Monomorphic/Stream.hs view
@@ -0,0 +1,362 @@+--+-- raw stream interface, no list wrappers+--+-- These specify the versions used when fusion occurs.+--+-- So we can check our stream implementations, which are only used when+-- fusion happens, are correct.+--++module Properties.Monomorphic.Stream where++import Prelude +import qualified Prelude ++import Properties.Utils++import qualified Data.Stream as Stream+import Data.Stream (Stream)+++-- * Basic interface+cons            :: A -> Stream A -> Stream A+snoc            :: Stream A -> A -> Stream A+append          :: Stream A -> Stream A -> Stream A+head            :: Stream A -> A+last            :: Stream A -> A+tail            :: Stream A -> Stream A+init            :: Stream A -> Stream A+null            :: Stream A -> Bool+length          :: Stream A -> Int++-- * List transformations+map             :: (A -> B) -> Stream A -> Stream B+--reverse         :: Stream A -> Stream A+intersperse     :: A -> Stream A -> Stream A+--intercalate     :: Stream A -> Stream (Stream A) -> Stream A+--transpose       :: Stream (Stream A) -> Stream (Stream A)++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> Stream A -> B+foldl'          :: (B -> A -> B) -> B -> Stream A -> B+foldl1          :: (A -> A -> A) -> Stream A -> A+foldl1'         :: (A -> A -> A) -> Stream A -> A+foldr           :: (A -> B -> B) -> B -> Stream A -> B+foldr1          :: (A -> A -> A) -> Stream A -> A++-- ** Special folds+-- concat          :: Stream (Stream A) -> Stream A+concatMap       :: (A -> Stream B) -> Stream A -> Stream B+and             :: Stream Bool -> Bool+or              :: Stream Bool -> Bool+any             :: (A -> Bool) -> Stream A -> Bool+all             :: (A -> Bool) -> Stream A -> Bool+sum             :: Stream N -> N+product         :: Stream N -> N+maximum         :: Stream OrdA -> OrdA+minimum         :: Stream OrdA -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> Stream B -> Stream A+scanl1          :: (A -> A -> A) -> Stream A -> Stream A+--scanr           :: (A -> B -> B) -> B -> Stream A -> Stream B+--scanr1          :: (A -> A -> A) -> Stream A -> Stream A++-- ** Accumulating maps+--mapAccumL       :: (C -> A -> (C, B)) -> C -> Stream A -> (C, Stream B)+--mapAccumR       :: (C -> A -> (C, B)) -> C -> Stream A -> (C, Stream B)++-- ** Infinite lists+iterate         :: (A -> A) -> A -> Stream A+repeat          :: A -> Stream A+replicate       :: Int -> A -> Stream A+cycle           :: Stream A -> Stream A++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> Stream A++-- * Sublists+-- ** Extracting sublists+take            :: Int -> Stream A -> Stream A+drop            :: Int -> Stream A -> Stream A+splitAt         :: Int -> Stream A -> ([A], [A])+takeWhile       :: (A -> Bool) -> Stream A -> Stream A+dropWhile       :: (A -> Bool) -> Stream A -> Stream A+--span            :: (A -> Bool) -> Stream A -> (Stream A, Stream A)+--break           :: (A -> Bool) -> Stream A -> (Stream A, Stream A)+--group           :: Stream A -> Stream (Stream A)+--inits           :: Stream A -> Stream (Stream A)+--tails           :: Stream A -> Stream (Stream A)++-- * Predicates+isPrefixOf      :: Stream A -> Stream A -> Bool+--isSuffixOf      :: Stream A -> Stream A -> Bool+--isInfixOf       :: Stream A -> Stream A -> Bool++-- * Searching lists+-- ** Searching by equality+elem            :: A -> Stream A -> Bool+--notElem         :: A -> Stream A -> Bool+lookup          :: A -> Stream (A, B) -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> Stream A -> Maybe A+filter          :: (A -> Bool) -> Stream A -> Stream A+--partition       :: (A -> Bool) -> Stream A -> (Stream A, Stream A)++-- * Indexing lists+(!!)            :: Stream A -> Int -> A+elemIndex       :: A -> Stream A -> Maybe Int+findIndex       :: (A -> Bool) -> Stream A -> Maybe Int+elemIndices     :: A -> Stream A -> Stream Int+findIndices     :: (A -> Bool) -> Stream A -> Stream Int++-- * Zipping and unzipping lists+zip             :: Stream A -> Stream B -> Stream (A, B)+zip3            :: Stream A -> Stream B -> Stream C -> Stream (A, B, C)++--zip4            :: Stream A -> Stream B -> Stream C -> Stream D -> Stream (A, B, C, D)+--zip5            :: Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream (A, B, C, D, E)+--zip6            :: Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F -> Stream (A, B, C, D, E, F)+--zip7            :: Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F -> Stream G -> Stream (A, B, C, D, E, F, G)++zipWith         :: (A -> B -> C) -> Stream A -> Stream B -> Stream C+zipWith3        :: (A -> B -> C -> D) -> Stream A -> Stream B -> Stream C -> Stream D++--zipWith4        :: (A -> B -> C -> D -> E) -> Stream A -> Stream B -> Stream C -> Stream D -> Stream E+--zipWith5        :: (A -> B -> C -> D -> E -> F) -> Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F+--zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F -> Stream G+--zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> Stream A -> Stream B -> Stream C -> Stream D -> Stream E -> Stream F -> Stream G -> Stream H++unzip           :: Stream (A, B) -> ([A], [B])++{-+--unzip3          :: Stream (A, B, C) -> (Stream A, Stream B, Stream C)+--unzip4          :: Stream (A, B, C, D) -> (Stream A, Stream B, Stream C, Stream D)+--unzip5          :: Stream (A, B, C, D, E) -> (Stream A, Stream B, Stream C, Stream D, Stream E)+--unzip6          :: Stream (A, B, C, D, E, F) -> (Stream A, Stream B, Stream C, Stream D, Stream E, Stream F)+--unzip7          :: Stream (A, B, C, D, E, F, G) -> (Stream A, Stream B, Stream C, Stream D, Stream E, Stream F, Stream G)+-}++-- * Special lists+-- ** Functions on strings+--lines           :: Stream Char -> Stream [Char]+++--words           :: String -> Stream String+--unlines         :: Stream String -> String+--unwords         :: Stream String -> String++-- ** \"Set\" operations+--nub             :: Stream A -> Stream A+--delete          :: A -> Stream A -> Stream A+--(\\)            :: Stream A -> Stream A -> Stream A+--union           :: Stream A -> Stream A -> Stream A+--intersect       :: Stream A -> Stream A -> Stream A++-- ** Ordered lists +--sort            :: Stream OrdA -> Stream OrdA+--insert          :: OrdA -> Stream OrdA -> Stream OrdA++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+--nubBy           :: (A -> A -> Bool) -> Stream A -> Stream A+--deleteBy        :: (A -> A -> Bool) -> A -> Stream A -> Stream A+--deleteFirstsBy  :: (A -> A -> Bool) -> Stream A -> Stream A -> Stream A+--unionBy         :: (A -> A -> Bool) -> Stream A -> Stream A -> Stream A+--intersectBy     :: (A -> A -> Bool) -> Stream A -> Stream A -> Stream A+--groupBy         :: (A -> A -> Bool) -> Stream A -> Stream (Stream A)++-- *** User-supplied comparison (replacing an Ord context)+--sortBy          :: (A -> A -> Ordering) -> Stream A -> Stream A++insertBy        :: (A -> A -> Ordering) -> A -> Stream A -> Stream A+maximumBy       :: (A -> A -> Ordering) -> Stream A -> A+minimumBy       :: (A -> A -> Ordering) -> Stream A -> A++-- * The \"generic\" operations++genericLength           :: Stream A -> I+genericTake             :: I -> Stream A -> Stream A+genericDrop             :: I -> Stream A -> Stream A+genericSplitAt          :: I -> Stream A -> ([A], [A])+genericIndex            :: Stream A -> I -> A++--genericReplicate        :: I -> A -> Stream A++-- * Basic interface+cons            = Stream.cons+snoc            = Stream.snoc+append          = Stream.append+head            = Stream.head+last            = Stream.last+tail            = Stream.tail+init            = Stream.init+null            = Stream.null+length          = Stream.length+++-- * List transformations+map             = Stream.map+--reverse       = Stream.reverse+intersperse     = Stream.intersperse+--intercalate   = Stream.intercalate+--transpose     = Stream.transpose++-- * Reducing lists (folds)+foldl           = Stream.foldl+foldl'          = Stream.foldl'+foldl1          = Stream.foldl1+foldl1'         = Stream.foldl1'+foldr           = Stream.foldr+foldr1          = Stream.foldr1++-- ** Special folds+-- concat          = Stream.concat+concatMap       = Stream.concatMap+and             = Stream.and+or              = Stream.or+any             = Stream.any+all             = Stream.all+sum             = Stream.sum+product         = Stream.product+maximum         = Stream.maximum+minimum         = Stream.minimum++-- * Building lists+-- ** Scans+scanl           = \f z xs -> Stream.scanl f z (Stream.snoc xs bottom)+  where+     bottom :: a+     bottom = error "bottom"++scanl1          = \f xs    -> Stream.scanl1 f (Stream.snoc xs bottom)+  where+     bottom :: a+     bottom = error "bottom"++{-+scanr           = Stream.scanr+scanr1          = Stream.scanr1++-- ** Accumulating maps+mapAccumL       = Stream.mapAccumL+mapAccumR       = Stream.mapAccumR+-}+-- ** Infinite lists+iterate         = Stream.iterate+repeat          = Stream.repeat+replicate       = Stream.replicate+cycle           = Stream.cycle++-- ** Unfolding+unfoldr         = Stream.unfoldr++-- * Sublists+-- ** Extracting sublists+take            = Stream.take+drop            = Stream.drop+splitAt         = Stream.splitAt+takeWhile       = Stream.takeWhile+dropWhile       = Stream.dropWhile+{-+span          = Stream.span+break           = Stream.break+group           = Stream.group+inits           = Stream.inits+tails           = Stream.tails+-}++-- * Predicates+isPrefixOf      = Stream.isPrefixOf+{-+isSuffixOf      = Stream.isSuffixOf+isInfixOf       = Stream.isInfixOf+-}+-- * Searching lists+-- ** Searching by equality+elem            = Stream.elem+--notElem       = Stream.notElem+lookup          = Stream.lookup++-- ** Searching with a predicate+find            = Stream.find+filter          = Stream.filter+--partition     = Stream.partition++-- * Indexing lists+(!!)            = Stream.index+findIndex       = Stream.findIndex+elemIndex       = Stream.elemIndex+elemIndices     = Stream.elemIndices+findIndices     = Stream.findIndices++-- * Zipping and unzipping lists+zip             = Stream.zip+zip3            = Stream.zip3+--zip4            = Stream.zip4+--zip5            = Stream.zip5+--zip6            = Stream.zip6+--zip7            = Stream.zip7+zipWith         = Stream.zipWith+zipWith3        = Stream.zipWith3+--zipWith4        = Stream.zipWith4+--zipWith5        = Stream.zipWith5+--zipWith6        = Stream.zipWith6+--zipWith7        = Stream.zipWith7+unzip           = Stream.unzip+--unzip3          = Stream.unzip3+--unzip4          = Stream.unzip4+--unzip5          = Stream.unzip5+--unzip6          = Stream.unzip6+--unzip7          = Stream.unzip7++-- * Special lists+-- ** Functions on strings++{-+lines           = Stream.lines+words           = Stream.words+unlines         = Stream.unlines+unwords         = Stream.unwords++-- ** \"Set\" operations+nub             = Stream.nub+delete          = Stream.delete+(\\)            = (Stream.\\)+union           = Stream.union+intersect       = Stream.intersect++-- ** Ordered lists +sort            = Stream.sort+insert          = Stream.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = Stream.nubBy+deleteBy        = Stream.deleteBy+deleteFirstsBy  = Stream.deleteFirstsBy+unionBy         = Stream.unionBy+intersectBy     = Stream.intersectBy+groupBy         = Stream.groupBy+-}++-- *** User-supplied comparison (replacing an Ord context)+insertBy        = Stream.insertBy+{-+sortBy          = Stream.sortBy+-}++maximumBy       = Stream.maximumBy+minimumBy       = Stream.minimumBy++-- * The \"generic\" operations+genericLength           = Stream.genericLength+genericTake             = Stream.genericTake+genericDrop             = Stream.genericDrop+genericIndex            = Stream.genericIndex+genericSplitAt          = Stream.genericSplitAt+--genericReplicate        = Stream.genericReplicate
+ tests/Properties/Monomorphic/StreamList.hs view
@@ -0,0 +1,385 @@+--+-- list like wrappers for abstract streams+--+-- These specify the versions used when fusion occurs.+--+-- So we can check our stream implementations, which are only used when+-- fusion happens, are correct.+--++module Properties.Monomorphic.StreamList where++import Prelude+import qualified Prelude +import Properties.Utils++import qualified Data.Stream as Stream++-- * Basic interface+cons            :: A -> [A] -> [A]+snoc            :: [A] -> A -> [A]+append          :: [A] -> [A] -> [A]+head            :: [A] -> A+last            :: [A] -> A+tail            :: [A] -> [A]+init            :: [A] -> [A]+null            :: [A] -> Bool+length          :: [A] -> Int+++-- * List transformations+map             :: (A -> B) -> [A] -> [B]+--reverse       :: [A] -> [A]+intersperse     :: A -> [A] -> [A]+intercalate   :: [A] -> [[A]] -> [A]+--transpose     :: [[A]] -> [[A]]++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> [A] -> B+foldl'          :: (B -> A -> B) -> B -> [A] -> B+foldl1          :: (A -> A -> A) -> [A] -> A+foldl1'         :: (A -> A -> A) -> [A] -> A+foldr           :: (A -> B -> B) -> B -> [A] -> B+foldr1          :: (A -> A -> A) -> [A] -> A++-- ** Special folds+--concat          :: [[A]] -> [A]+concatMap       :: (A -> [B]) -> [A] -> [B]+and             :: [Bool] -> Bool+or              :: [Bool] -> Bool+any             :: (A -> Bool) -> [A] -> Bool+all             :: (A -> Bool) -> [A] -> Bool+sum             :: [N] -> N+product         :: [N] -> N+maximum         :: [OrdA] -> OrdA+minimum         :: [OrdA] -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> [B] -> [A]+scanl1          :: (A -> A -> A) -> [A] -> [A]++{-+scanr           :: (A -> B -> B) -> B -> [A] -> [B]+scanr1          :: (A -> A -> A) -> [A] -> [A]++-- ** Accumulating maps+mapAccumL       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+mapAccumR       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+-}++-- ** Infinite lists+iterate         :: (A -> A) -> A -> [A]+repeat          :: A -> [A]+replicate       :: Int -> A -> [A]+cycle           :: [A] -> [A]++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> [A]++-- * Sublists+-- ** Extracting sublists+take            :: Int -> [A] -> [A]+drop            :: Int -> [A] -> [A]+splitAt         :: Int -> [A] -> ([A], [A])+takeWhile       :: (A -> Bool) -> [A] -> [A]+dropWhile       :: (A -> Bool) -> [A] -> [A]++{-+span          :: (A -> Bool) -> [A] -> ([A], [A])+break           :: (A -> Bool) -> [A] -> ([A], [A])+group           :: [A] -> [[A]]+inits           :: [A] -> [[A]]+tails           :: [A] -> [[A]]+-}++-- * Predicates+isPrefixOf      :: [A] -> [A] -> Bool+{-+isSuffixOf      :: [A] -> [A] -> Bool+isInfixOf       :: [A] -> [A] -> Bool+-}++-- * Searching lists+-- ** Searching by equality+elem            :: A -> [A] -> Bool+--notElem               :: A -> [A] -> Bool+lookup          :: A -> [(A, B)] -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> [A] -> Maybe A+filter          :: (A -> Bool) -> [A] -> [A]+--partition     :: (A -> Bool) -> [A] -> ([A], [A])++-- * Indexing lists+(!!)            :: [A] -> Int -> A+findIndex       :: (A -> Bool) -> [A] -> Maybe Int+elemIndex       :: A -> [A] -> Maybe Int+elemIndices     :: A -> [A] -> [Int]+findIndices     :: (A -> Bool) -> [A] -> [Int]++-- * Zipping and unzipping lists+zip             :: [A] -> [B] -> [(A, B)]+zip3            :: [A] -> [B] -> [C] -> [(A, B, C)]+{-+zip4            :: [A] -> [B] -> [C] -> [D] -> [(A, B, C, D)]+zip5            :: [A] -> [B] -> [C] -> [D] -> [E] -> [(A, B, C, D, E)]+zip6            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [(A, B, C, D, E, F)]+zip7            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [(A, B, C, D, E, F, G)]+-}++zipWith         :: (A -> B -> C) -> [A] -> [B] -> [C]+zipWith3        :: (A -> B -> C -> D) -> [A] -> [B] -> [C] -> [D]+{-+zipWith4        :: (A -> B -> C -> D -> E) -> [A] -> [B] -> [C] -> [D] -> [E]+zipWith5        :: (A -> B -> C -> D -> E -> F) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F]+zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G]+zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [H]+-}++unzip           :: [(A, B)] -> ([A], [B])+{-+unzip3          :: [(A, B, C)] -> ([A], [B], [C])+unzip4          :: [(A, B, C, D)] -> ([A], [B], [C], [D])+unzip5          :: [(A, B, C, D, E)] -> ([A], [B], [C], [D], [E])+unzip6          :: [(A, B, C, D, E, F)] -> ([A], [B], [C], [D], [E], [F])+unzip7          :: [(A, B, C, D, E, F, G)] -> ([A], [B], [C], [D], [E], [F], [G])+-}++-- * Special lists+-- ** Functions on strings+unlines         :: [String] -> String+-- lines           :: String -> [String]+{-+words           :: String -> [String]+unwords         :: [String] -> String++-- ** \"Set\" operations+nub             :: [A] -> [A]+delete          :: A -> [A] -> [A]+(\\)            :: [A] -> [A] -> [A]+union           :: [A] -> [A] -> [A]+intersect       :: [A] -> [A] -> [A]++-- ** Ordered lists +sort            :: [OrdA] -> [OrdA]+insert          :: OrdA -> [OrdA] -> [OrdA]++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (A -> A -> Bool) -> [A] -> [A]+deleteBy        :: (A -> A -> Bool) -> A -> [A] -> [A]+deleteFirstsBy  :: (A -> A -> Bool) -> [A] -> [A] -> [A]+unionBy         :: (A -> A -> Bool) -> [A] -> [A] -> [A]+intersectBy     :: (A -> A -> Bool) -> [A] -> [A] -> [A]+groupBy         :: (A -> A -> Bool) -> [A] -> [[A]]+-}++-- *** User-supplied comparison (replacing an Ord context)+insertBy        :: (A -> A -> Ordering) -> A -> [A] -> [A]+{-+sortBy          :: (A -> A -> Ordering) -> [A] -> [A]+-}+maximumBy       :: (A -> A -> Ordering) -> [A] -> A+minimumBy       :: (A -> A -> Ordering) -> [A] -> A++-- * The \"generic\" operations+genericLength           :: [A] -> I+genericTake             :: I -> [A] -> [A]+genericDrop             :: I -> [A] -> [A]+genericIndex            :: [A] -> I -> A+genericSplitAt          :: I -> [A] -> ([A], [A])+genericReplicate        :: I -> A -> [A]++s = Stream.stream+u = Stream.unstream++-- * Basic interface+cons            = \x xs  -> u $ Stream.cons   x (s xs)+snoc            = \xs x  -> u $ Stream.snoc   (s xs) x+append          = \xs ys -> u $ Stream.append (s xs) (s ys)+head            = \xs    ->     Stream.head   (s xs)+last            = \xs    ->     Stream.last   (s xs)+tail            = \xs    -> u $ Stream.tail   (s xs)+init            = \xs    -> u $ Stream.init   (s xs)+null            = \xs    ->     Stream.null   (s xs)+length          = \xs    ->     Stream.length (s xs)+++-- * List transformations+map             = \f   xs -> u $ Stream.map f (s xs)+--reverse               = Stream.reverse+intersperse     = \sep xs -> u $ Stream.intersperse sep (s xs)+intercalate     = \sep xs -> u $ Stream.concatMap s (Stream.intersperse sep(s xs))++--transpose     = Stream.transpose++-- * Reducing lists (folds)+foldl           = \f z xs -> Stream.foldl   f z (s xs)+foldl'          = \f z xs -> Stream.foldl'  f z (s xs)+foldl1          = \f   xs -> Stream.foldl1  f   (s xs)+foldl1'         = \f   xs -> Stream.foldl1' f   (s xs)+foldr           = \f z xs -> Stream.foldr   f z (s xs)+foldr1          = \f   xs -> Stream.foldr1  f   (s xs)++-- ** Special folds+-- concat          = \  xs -> Stream.concat xs+concatMap       = \f xs -> u $ Stream.concatMap (s . f) (s xs)+and             = \  xs -> Stream.and   (s xs)+or              = \  xs -> Stream.or    (s xs)+any             = \f xs -> Stream.any f (s xs)+all             = \f xs -> Stream.all f (s xs)+sum             = \  xs -> Stream.sum   (s xs)+product         = \  xs -> Stream.product   (s xs)+maximum         = \  xs -> Stream.maximum   (s xs)+minimum         = \  xs -> Stream.minimum   (s xs)++-- * Building lists+-- ** Scans+scanl           = \f z xs -> u (Stream.scanl f z (Stream.snoc (s xs) bottom))+ where+    bottom :: a+    bottom = error "StreamProperties.bottom"++scanl1          = \f xs -> u (Stream.scanl1 f (Stream.snoc (s xs) bottom))+ where+    bottom :: a+    bottom = error "StreamProperties.bottom"++{-+scanr           = \f z xs -> u (Stream.scanr f z (Stream.cons bottom (s xs)))+ where+    bottom :: a+    bottom = error "StreamProperties.bottom"+-}++{-+scanr1          = Stream.scanr1++-- ** Accumulating maps+mapAccumL       = Stream.mapAccumL+mapAccumR       = Stream.mapAccumR+-}+-- ** Infinite lists+iterate         = \f x -> u $ Stream.iterate   f x+repeat          = \  x -> u $ Stream.repeat      x+replicate       = \n x -> u $ Stream.replicate n x+cycle           = \ xs -> u $ Stream.cycle    (s xs)++-- ** Unfolding+unfoldr         = \f x -> u $ Stream.unfoldr f x++-- * Sublists+-- ** Extracting sublists+take            = \n xs -> u $ Stream.take    n (s xs)+drop            = \n xs -> u $ Stream.drop    n (s xs)+splitAt         = \n xs ->     Stream.splitAt n (s xs)+takeWhile       = \f xs -> u $ Stream.takeWhile f (s xs)+dropWhile       = \f xs -> u $ Stream.dropWhile f (s xs)+{-+span          = Stream.span+break           = Stream.break+group           = Stream.group+inits           = Stream.inits+tails           = Stream.tails+-}++-- * Predicates+isPrefixOf      = \xs ys -> Stream.isPrefixOf (s xs) (s ys)+{-+isSuffixOf      = Stream.isSuffixOf+isInfixOf       = Stream.isInfixOf+-}+-- * Searching lists+-- ** Searching by equality+elem            = \key xs -> Stream.elem   key (s xs)+--notElem               = Stream.notElem+lookup          = \key xs -> Stream.lookup key (s xs)++-- ** Searching with a predicate+find            = \p xs ->     Stream.find   p (s xs)+filter          = \p xs -> u $ Stream.filter p (s xs)+--partition     = Stream.partition++-- * Indexing lists+(!!)            = \xs -> Stream.index (s xs)+findIndex       = \f xs -> Stream.findIndex f (s xs)+elemIndex       = \x xs -> Stream.elemIndex x (s xs)+elemIndices     = \x xs -> u (Stream.elemIndices x (s xs))+findIndices     = \p xs -> u (Stream.findIndices p (s xs))+++-- * Zipping and unzipping lists+zip  = \xs ys    -> u (Stream.zip (s xs) (s ys))+zip3 = \xs ys zs -> u (Stream.zip3 (s xs) (s ys) (s zs))++zipWith         = \f xs ys    -> u (Stream.zipWith f (s xs) (s ys))+zipWith3        = \f xs ys zs -> u (Stream.zipWith3 f (s xs) (s ys) (s zs))++unzip           = Stream.unzip . s++{-+zip4            = Stream.zip4+zip5            = Stream.zip5+zip6            = Stream.zip6+zip7            = Stream.zip7+zipWith4        = Stream.zipWith4+zipWith5        = Stream.zipWith5+zipWith6        = Stream.zipWith6+zipWith7        = Stream.zipWith7+unzip3          = Stream.unzip3+unzip4          = Stream.unzip4+unzip5          = Stream.unzip5+unzip6          = Stream.unzip6+unzip7          = Stream.unzip7+-}++-- * Special lists+-- ** Functions on strings+unlines         = \xs -> u (Stream.concatMap (\x -> Stream.snoc (s x) '\n') (s xs))+-- lines           = \xs -> u (Stream.lines (s xs))++{-+words           = Stream.words+unwords         = Stream.unwords++-- ** \"Set\" operations+nub             = Stream.nub+delete          = Stream.delete+(\\)            = (Stream.\\)+union           = Stream.union+intersect       = Stream.intersect++-- ** Ordered lists +sort            = Stream.sort+insert          = Stream.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = Stream.nubBy+deleteBy        = Stream.deleteBy+deleteFirstsBy  = Stream.deleteFirstsBy+unionBy         = Stream.unionBy+intersectBy     = Stream.intersectBy+groupBy         = Stream.groupBy+-}++-- *** User-supplied comparison (replacing an Ord context)+{-+sortBy          = Stream.sortBy+-}+insertBy        = \cmp x xs -> u $ Stream.insertBy cmp x (s xs)++maximumBy       = \cmp xs -> Stream.maximumBy cmp (s xs)+minimumBy       = \cmp xs -> Stream.minimumBy cmp (s xs)++-- * The \"generic\" operations+genericLength           = \xs -> Stream.genericLength (s xs)+genericTake             = \n xs -> u $ Stream.genericTake n (s xs)+genericDrop             = \n xs -> u $ Stream.genericDrop n (s xs)+genericIndex            = \xs n -> Stream.genericIndex (s xs) n+genericSplitAt          = \n xs -> Stream.genericSplitAt n (s xs)+genericReplicate        = \n x  -> genericTake n (Prelude.repeat x)+
+ tests/Properties/StreamListVsBase.hs view
@@ -0,0 +1,459 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++import System.IO+import Properties.Utils++import qualified Properties.Monomorphic.StreamList  as Test         -- stream functions+import qualified Properties.Monomorphic.Base        as Spec         -- Data.List++--+-- Data.Stream <=> Data.List+--++------------------------------------------------------------------------+-- * Basic interface++prop_cons       = Test.cons     `eq2`           (:)+prop_snoc       = Test.snoc     `eq2`           (\xs x -> xs Spec.++ [x])+prop_append     = Test.append   `eq2`           (Spec.++)+prop_head       = Test.head     `eqnotnull1`    Spec.head+prop_last       = Test.last     `eqnotnull1`    Spec.last+prop_tail       = Test.tail     `eqnotnull1`    Spec.tail+prop_init       = Test.init     `eqnotnull1`    Spec.init+prop_null       = Test.null     `eq1`           Spec.null+prop_length     = Test.length   `eq1`           Spec.length++------------------------------------------------------------------------+-- * List transformations++prop_map                = Test.map              `eq2`   Spec.map+-- prop_reverse            = Test.reverse          `eq1`   Spec.reverse+prop_intersperse        = Test.intersperse      `eq2`   Spec.intersperse+prop_intercalate        = Test.intercalate      `eq2`   Spec.intercalate+-- prop_transpose          = Test.transpose        `eq1`   Spec.transpose++------------------------------------------------------------------------+-- * Reducing lists (folds)++prop_foldl      = Test.foldl            `eq3`   Spec.foldl+prop_foldl'     = Test.foldl'           `eq3`   Spec.foldl'++prop_foldl1     = Test.foldl1   `eqnotnull2`    Spec.foldl1 -- n.b.+prop_foldl1'    = Test.foldl1'  `eqnotnull2`    Spec.foldl1' -- n.b.++prop_foldr      = Test.foldr            `eq3`   Spec.foldr+prop_foldr1     = Test.foldr1   `eqnotnull2`    Spec.foldr1++------------------------------------------------------------------------+-- ** Special folds++-- prop_concat     = Test.concat           `eq1`   Spec.concat+prop_concatMap  = Test.concatMap        `eq2`   Spec.concatMap+prop_and        = Test.and              `eq1`   Spec.and+prop_or         = Test.or               `eq1`   Spec.or+prop_any        = Test.any              `eq2`   Spec.any+prop_all        = Test.all              `eq2`   Spec.all+prop_sum        = Test.sum              `eq1`   Spec.sum+prop_product    = Test.product          `eq1`   Spec.product+prop_maximum    = Test.maximum  `eqnotnull1`    Spec.maximum+prop_minimum    = Test.minimum  `eqnotnull1`    Spec.minimum++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++prop_scanl      = Test.scanl            `eq3`   Spec.scanl+prop_scanl1     = Test.scanl1           `eq2`   Spec.scanl1+-- prop_scanr      = Test.scanr            `eq3`   Spec.scanr++{-+prop_scanr1     = Test.scanr1           `eq2`   Spec.scanr1+-}++------------------------------------------------------------------------+-- ** Accumulating maps++{-+prop_mapAccumL  = Test.mapAccumL        `eq3`   Spec.mapAccumL+prop_mapAccumR  = Test.mapAccumR        `eq3`   Spec.mapAccumR+-}++------------------------------------------------------------------------+-- ** Infinite lists++prop_iterate    = Test.iterate          `eqfinite2`     Spec.iterate+prop_repeat     = Test.repeat           `eqfinite1`     Spec.repeat+prop_replicate  = Test.replicate        `eq2`           Spec.replicate+prop_cycle      = \x -> not (null x) ==>+                  (Test.cycle           `eqfinite1`     Spec.cycle) x++------------------------------------------------------------------------+-- ** Unfolding++prop_unfoldr    = Test.unfoldr          `eqfinite2`     Spec.unfoldr++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_take       = Test.take             `eq2`   Spec.take+prop_drop       = Test.drop             `eq2`   Spec.drop+prop_splitAt    = Test.splitAt          `eq2`   Spec.splitAt+prop_takeWhile  = Test.takeWhile        `eq2`   Spec.takeWhile+prop_dropWhile  = Test.dropWhile        `eq2`   Spec.dropWhile++{-+prop_span       = Test.span             `eq2`   Spec.span+prop_break      = Test.break            `eq2`   Spec.break+prop_group      = Test.group            `eq1`   Spec.group+prop_inits      = Test.inits            `eq1`   Spec.inits+prop_tails      = Test.tails            `eq1`   Spec.tails+-}++------------------------------------------------------------------------+-- * Predicates++prop_isPrefixOf  = Test.isPrefixOf       `eq2`   Spec.isPrefixOf+{-+prop_isSuffixOf  = Test.isSuffixOf       `eq2`   Spec.isSuffixOf+prop_isInfixOf   = Test.isInfixOf        `eq2`   Spec.isInfixOf+-}++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++prop_elem       = Test.elem             `eq2`   Spec.elem+-- prop_notElem    = Test.notElem          `eq2`   Spec.notElem -- no specific implementation+prop_lookup     = Test.lookup           `eq2`   Spec.lookup++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_find       = Test.find             `eq2`   Spec.find+prop_filter     = Test.filter           `eq2`   Spec.filter+-- prop_partition  = Test.partition        `eq2`   Spec.partition++------------------------------------------------------------------------+-- * Indexing lists++prop_index              = \xs n -> n >= 0 && n < length xs ==>+                          ((Test.!!)            `eq2`   (Spec.!!)) xs n+prop_findIndex          = Test.findIndex        `eq2`   Spec.findIndex+prop_elemIndex          = Test.elemIndex        `eq2`   Spec.elemIndex+prop_elemIndices        = Test.elemIndices      `eq2`   Spec.elemIndices+prop_findIndices        = Test.findIndices      `eq2`   Spec.findIndices++------------------------------------------------------------------------+-- * Zipping and unzipping lists++prop_zip        = Test.zip              `eq2`   Spec.zip+prop_zip3       = Test.zip3             `eq3`   Spec.zip3++prop_zipWith    = Test.zipWith          `eq3`   Spec.zipWith+prop_zipWith3   = Test.zipWith3         `eq4`   Spec.zipWith3++{-+prop_zip4       = Test.zip4             `eq4`   Spec.zip4+prop_zip5       = Test.zip5             `eq5`   Spec.zip5+prop_zip6       = Test.zip6             `eq6`   Spec.zip6+prop_zip7       = Test.zip7             `eq7`   Spec.zip7+prop_zipWith4   = Test.zipWith4         `eq5`   Spec.zipWith4+prop_zipWith5   = Test.zipWith5         `eq6`   Spec.zipWith5+prop_zipWith6   = Test.zipWith6         `eq7`   Spec.zipWith6+prop_zipWith7   = Test.zipWith7         `eq8`   Spec.zipWith7+-}++------------------------------------------------------------------------++prop_unzip      = Test.unzip            `eq1`   Spec.unzip++{-+prop_unzip3     = Test.unzip3           `eq1`   Spec.unzip3+prop_unzip4     = Test.unzip4           `eq1`   Spec.unzip4+prop_unzip5     = Test.unzip5           `eq1`   Spec.unzip5+prop_unzip6     = Test.unzip6           `eq1`   Spec.unzip6+prop_unzip7     = Test.unzip7           `eq1`   Spec.unzip7+-}++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings+prop_unlines    = Test.unlines          `eq1`   Spec.unlines+-- prop_lines      = Test.lines            `eq1`   Spec.lines++{-+prop_words      = Test.words            `eq1`   Spec.words+prop_unwords    = Test.unwords          `eq1`   Spec.unwords+-}++------------------------------------------------------------------------+-- ** \"Set\" operations++{-+prop_nub        = Test.nub              `eq1`   Spec.nub+prop_delete     = Test.delete           `eq2`   Spec.delete+prop_difference = (Test.\\)             `eq2`   (Spec.\\)+prop_union      = Test.union            `eq2`   Spec.union+prop_intersect  = Test.intersect        `eq2`   Spec.intersect+-}++------------------------------------------------------------------------+-- ** Ordered lists ++{-+prop_sort       = Test.sort             `eq1`   Spec.sort+prop_insert     = Test.insert           `eq2`   Spec.insert+-}++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++{-+prop_nubBy              = Test.nubBy            `eq2`   Spec.nubBy+prop_deleteBy           = Test.deleteBy         `eq3`   Spec.deleteBy+prop_deleteFirstsBy     = Test.deleteFirstsBy   `eq3`   Spec.deleteFirstsBy+prop_unionBy            = Test.unionBy          `eq3`   Spec.unionBy+prop_intersectBy        = Test.intersectBy      `eq3`   Spec.intersectBy+prop_groupBy            = Test.groupBy          `eq2`   Spec.groupBy+-}++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++{-+prop_sortBy             = Test.sortBy           `eq2`           Spec.sortBy+-}+prop_insertBy           = Test.insertBy         `eq3`           Spec.insertBy+prop_maximumBy          = Test.maximumBy        `eqnotnull2`    Spec.maximumBy+prop_minimumBy          = Test.minimumBy        `eqnotnull2`    Spec.minimumBy++------------------------------------------------------------------------+-- * The \"generic\" operations++prop_genericLength      = Test.genericLength    `eq1`   Spec.genericLength+prop_genericTake        = \i -> i >= I 0 ==>+                          (Test.genericTake     `eq2`   Spec.genericTake) i+prop_genericDrop        = \i -> i >= I 0 ==>+                          (Test.genericDrop     `eq2`   Spec.genericDrop) i+prop_genericIndex       = \xs i -> i >= I 0 && i < Spec.genericLength xs ==>+                          (Test.genericIndex    `eq2`   Spec.genericIndex) xs i+prop_genericSplitAt     = \i -> i >= I 0 ==>+                          (Test.genericSplitAt  `eq2`   Spec.genericSplitAt) i+prop_genericReplicate   = \i -> i >= I 0 ==>+                          (Test.genericReplicate        `eq2`   Spec.genericReplicate) i++------------------------------------------------------------------------++main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Testing: Data.Stream <=> Data.List"+  putStrLn "==================================\n"++  runTests "Basic interface" opts+    [run prop_cons+    ,run prop_snoc+    ,run prop_append+    ,run prop_head+    ,run prop_last+    ,run prop_tail+    ,run prop_init+    ,run prop_null+    ,run prop_length+    ]++  runTests "List transformations" opts+    [run prop_map+--  ,run prop_reverse+    ,run prop_intersperse+    ,run prop_intercalate+--  ,run prop_transpose+    ]++  runTests "Reducing lists (folds)" opts+    [run prop_foldl+    ,run prop_foldl'+    ,run prop_foldr++    ,run prop_foldl1+    ,run prop_foldl1'+    ,run prop_foldr1+    ]++  runTests "Special folds" opts+    [+--   run prop_concat,+     run prop_concatMap+    ,run prop_and+    ,run prop_or+    ,run prop_any+    ,run prop_all+    ,run prop_sum+    ,run prop_product+    ,run prop_maximum+    ,run prop_minimum+    ]++  runTests "Scans" opts+    [run prop_scanl+    ,run prop_scanl1+{-+    ,run prop_scanr+    ,run prop_scanr1+-}+    ]++{-+  runTests "Accumulating maps" opts+    [run prop_mapAccumL+    ,run prop_mapAccumR+    ]+-}++  runTests "Infinite lists" opts+    [run prop_iterate+    ,run prop_repeat+    ,run prop_replicate+    ,run prop_cycle+    ]++  runTests "Unfolding" opts+    [run prop_unfoldr+    ]++  runTests "Extracting sublists" opts+    [run prop_take+    ,run prop_drop+    ,run prop_splitAt+    ,run prop_takeWhile+    ,run prop_dropWhile++{-+    ,run prop_span+    ,run prop_break+    ,run prop_group+    ,run prop_inits+    ,run prop_tails+-}+    ]++  runTests "Predicates" opts+    [run prop_isPrefixOf+{-+    ,run prop_isSuffixOf+    ,run prop_isInfixOf+-}+    ]++  runTests "Searching by equality" opts+    [run prop_elem+--  ,run prop_notElem-- no specific implementation+    ,run prop_lookup+    ]++  runTests "Searching by a predicate" opts+    [run prop_find+    ,run prop_filter+--  ,run prop_partition+    ]++  runTests "Indexing lists" opts+    [run prop_index+    ,run prop_findIndex+    ,run prop_elemIndex+    ,run prop_elemIndices+    ,run prop_findIndices+    ]++  runTests "Zipping" opts+    [+     run prop_zip+    ,run prop_zip3+{-+    ,run prop_zip4+    ,run prop_zip5+    ,run prop_zip6+    ,run prop_zip7+-}+    ,run prop_zipWith+    ,run prop_zipWith3+{-+    ,run prop_zipWith4+    ,run prop_zipWith5+    ,run prop_zipWith6+    ,run prop_zipWith7+-}+    ]++  runTests "Unzipping" opts+    [run prop_unzip+{-+    ,run prop_unzip3+    ,run prop_unzip4+    ,run prop_unzip5+    ,run prop_unzip6+    ,run prop_unzip7+-}+    ]++  runTests "Functions on strings" opts+    [run prop_unlines+{-+    ,run prop_lines+    ,run prop_words+    ,run prop_unwords+-}+    ]++{-+  runTests "\"Set\" operations" opts+    [run prop_nub+    ,run prop_delete+    ,run prop_difference+    ,run prop_union+    ,run prop_intersect+    ]+-}++{-+  runTests "Ordered lists" opts+    [run prop_sort+    ,run prop_insert+    ]+-}++{-+  runTests "Eq style \"By\" operations" opts+    [run prop_nubBy+    ,run prop_deleteBy+    ,run prop_deleteFirstsBy+    ,run prop_unionBy+    ,run prop_intersectBy+    ,run prop_groupBy+    ]+-}++  runTests "Ord style \"By\" operations" opts+{-+     run prop_sortBy        -- note issue here.+-}+    [run prop_insertBy+    ,run prop_maximumBy+    ,run prop_minimumBy+    ]++  runTests "The \"generic\" operations" opts+    [run prop_genericLength+    ,run prop_genericTake+    ,run prop_genericDrop+    ,run prop_genericIndex+    ,run prop_genericSplitAt+    ,run prop_genericReplicate+    ]
+ tests/Properties/StreamListVsSpec.hs view
@@ -0,0 +1,463 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++import System.IO+import Properties.Utils++import qualified Properties.Monomorphic.StreamList  as Test         -- stream functions+import qualified Properties.Monomorphic.Spec        as Spec         -- H98++--+-- Data.Stream <=> Spec.List+--++------------------------------------------------------------------------+-- * Basic interface++prop_cons       = Test.cons     `eq2`           (:)+prop_snoc       = Test.snoc     `eq2`           (\xs x -> xs Spec.++ [x])+prop_append     = Test.append   `eq2`           (Spec.++)+prop_head       = Test.head     `eqnotnull1`    Spec.head+prop_last       = Test.last     `eqnotnull1`    Spec.last+prop_tail       = Test.tail     `eqnotnull1`    Spec.tail+prop_init       = Test.init     `eqnotnull1`    Spec.init+prop_null       = Test.null     `eq1`           Spec.null+prop_length     = Test.length   `eq1`           Spec.length++------------------------------------------------------------------------+-- * List transformations++prop_map                = Test.map              `eq2`   Spec.map+-- prop_reverse            = Test.reverse          `eq1`   Spec.reverse+prop_intersperse        = Test.intersperse      `eq2`   Spec.intersperse+prop_intercalate        = Test.intercalate      `eq2`   Spec.intercalate+-- prop_transpose          = Test.transpose        `eq1`   Spec.transpose++------------------------------------------------------------------------+-- * Reducing lists (folds)++prop_foldl      = Test.foldl            `eq3`   Spec.foldl+prop_foldl'     = Test.foldl'           `eq3`   Spec.foldl'++prop_foldl1     = Test.foldl1   `eqnotnull2`    Spec.foldl1 -- n.b.+prop_foldl1'    = Test.foldl1'  `eqnotnull2`    Spec.foldl1' -- n.b.++prop_foldr      = Test.foldr            `eq3`   Spec.foldr+prop_foldr1     = Test.foldr1   `eqnotnull2`    Spec.foldr1++------------------------------------------------------------------------+-- ** Special folds++-- prop_concat     = Test.concat           `eq1`   Spec.concat+prop_concatMap  = Test.concatMap        `eq2`   Spec.concatMap+prop_and        = Test.and              `eq1`   Spec.and+prop_or         = Test.or               `eq1`   Spec.or+prop_any        = Test.any              `eq2`   Spec.any+prop_all        = Test.all              `eq2`   Spec.all+prop_sum        = Test.sum              `eq1`   Spec.sum+prop_product    = Test.product          `eq1`   Spec.product+prop_maximum    = Test.maximum  `eqnotnull1`    Spec.maximum+prop_minimum    = Test.minimum  `eqnotnull1`    Spec.minimum++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++prop_scanl      = Test.scanl            `eq3`   Spec.scanl+prop_scanl1     = Test.scanl1           `eq2`   Spec.scanl1+-- prop_scanr      = Test.scanr            `eq3`   Spec.scanr++{-+prop_scanr1     = Test.scanr1           `eq2`   Spec.scanr1+-}++------------------------------------------------------------------------+-- ** Accumulating maps++{-+prop_mapAccumL  = Test.mapAccumL        `eq3`   Spec.mapAccumL+prop_mapAccumR  = Test.mapAccumR        `eq3`   Spec.mapAccumR+-}++------------------------------------------------------------------------+-- ** Infinite lists++prop_iterate    = Test.iterate          `eqfinite2`     Spec.iterate+prop_repeat     = Test.repeat           `eqfinite1`     Spec.repeat+prop_replicate  = Test.replicate        `eq2`           Spec.replicate+prop_cycle      = \x -> not (null x) ==>+                  (Test.cycle           `eqfinite1`     Spec.cycle) x++------------------------------------------------------------------------+-- ** Unfolding++prop_unfoldr    = Test.unfoldr          `eqfinite2`     Spec.unfoldr++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_take       = Test.take             `eq2`   Spec.take+prop_drop       = Test.drop             `eq2`   Spec.drop+prop_splitAt    = Test.splitAt          `eq2`   Spec.splitAt+prop_takeWhile  = Test.takeWhile        `eq2`   Spec.takeWhile+prop_dropWhile  = Test.dropWhile        `eq2`   Spec.dropWhile++{-+prop_span       = Test.span             `eq2`   Spec.span+prop_break      = Test.break            `eq2`   Spec.break+prop_group      = Test.group            `eq1`   Spec.group+prop_inits      = Test.inits            `eq1`   Spec.inits+prop_tails      = Test.tails            `eq1`   Spec.tails+-}++------------------------------------------------------------------------+-- * Predicates++prop_isPrefixOf  = Test.isPrefixOf       `eq2`   Spec.isPrefixOf+{-+prop_isSuffixOf  = Test.isSuffixOf       `eq2`   Spec.isSuffixOf+prop_isInfixOf   = Test.isInfixOf        `eq2`   Spec.isInfixOf+-}++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++prop_elem       = Test.elem             `eq2`   Spec.elem+-- prop_notElem    = Test.notElem          `eq2`   Spec.notElem -- no specific implementation+prop_lookup     = Test.lookup           `eq2`   Spec.lookup++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_find       = Test.find             `eq2`   Spec.find+prop_filter     = Test.filter           `eq2`   Spec.filter+-- prop_partition  = Test.partition        `eq2`   Spec.partition++------------------------------------------------------------------------+-- * Indexing lists++prop_index              = \xs n -> n >= 0 && n < length xs ==>+                          ((Test.!!)            `eq2`   (Spec.!!)) xs n+prop_findIndex          = Test.findIndex        `eq2`   Spec.findIndex+prop_elemIndex          = Test.elemIndex        `eq2`   Spec.elemIndex+prop_elemIndices        = Test.elemIndices      `eq2`   Spec.elemIndices+prop_findIndices        = Test.findIndices      `eq2`   Spec.findIndices++------------------------------------------------------------------------+-- * Zipping and unzipping lists++prop_zip        = Test.zip              `eq2`   Spec.zip+prop_zip3       = Test.zip3             `eq3`   Spec.zip3++prop_zipWith    = Test.zipWith          `eq3`   Spec.zipWith+prop_zipWith3   = Test.zipWith3         `eq4`   Spec.zipWith3++{-+prop_zip4       = Test.zip4             `eq4`   Spec.zip4+prop_zip5       = Test.zip5             `eq5`   Spec.zip5+prop_zip6       = Test.zip6             `eq6`   Spec.zip6+prop_zip7       = Test.zip7             `eq7`   Spec.zip7+prop_zipWith4   = Test.zipWith4         `eq5`   Spec.zipWith4+prop_zipWith5   = Test.zipWith5         `eq6`   Spec.zipWith5+prop_zipWith6   = Test.zipWith6         `eq7`   Spec.zipWith6+prop_zipWith7   = Test.zipWith7         `eq8`   Spec.zipWith7+-}++------------------------------------------------------------------------++prop_unzip      = Test.unzip            `eq1`   Spec.unzip++{-+prop_unzip3     = Test.unzip3           `eq1`   Spec.unzip3+prop_unzip4     = Test.unzip4           `eq1`   Spec.unzip4+prop_unzip5     = Test.unzip5           `eq1`   Spec.unzip5+prop_unzip6     = Test.unzip6           `eq1`   Spec.unzip6+prop_unzip7     = Test.unzip7           `eq1`   Spec.unzip7+-}++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings+prop_unlines    = Test.unlines          `eq1`   Spec.unlines+-- prop_lines      = Test.lines            `eq1`   Spec.lines++{-+prop_words      = Test.words            `eq1`   Spec.words+prop_unwords    = Test.unwords          `eq1`   Spec.unwords+-}++------------------------------------------------------------------------+-- ** \"Set\" operations++{-+prop_nub        = Test.nub              `eq1`   Spec.nub+prop_delete     = Test.delete           `eq2`   Spec.delete+prop_difference = (Test.\\)             `eq2`   (Spec.\\)+prop_union      = Test.union            `eq2`   Spec.union+prop_intersect  = Test.intersect        `eq2`   Spec.intersect+-}++------------------------------------------------------------------------+-- ** Ordered lists ++{-+prop_sort       = Test.sort             `eq1`   Spec.sort+prop_insert     = Test.insert           `eq2`   Spec.insert+-}++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++{-+prop_nubBy              = Test.nubBy            `eq2`   Spec.nubBy+prop_deleteBy           = Test.deleteBy         `eq3`   Spec.deleteBy+prop_deleteFirstsBy     = Test.deleteFirstsBy   `eq3`   Spec.deleteFirstsBy+prop_unionBy            = Test.unionBy          `eq3`   Spec.unionBy+prop_intersectBy        = Test.intersectBy      `eq3`   Spec.intersectBy+prop_groupBy            = Test.groupBy          `eq2`   Spec.groupBy+-}++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++{-+prop_sortBy             = Test.sortBy           `eq2`           Spec.sortBy+-}+prop_insertBy           = Test.insertBy         `eq3`           Spec.insertBy+prop_maximumBy          = Test.maximumBy        `eqnotnull2`    Spec.maximumBy+prop_minimumBy          = Test.minimumBy        `eqnotnull2`    Spec.minimumBy++------------------------------------------------------------------------+-- * The \"generic\" operations++prop_genericLength      = Test.genericLength    `eq1`   Spec.genericLength+prop_genericTake        = \i -> i >= I 0 ==>+                          (Test.genericTake     `eq2`   Spec.genericTake) i+prop_genericDrop        = \i -> i >= I 0 ==>+                          (Test.genericDrop     `eq2`   Spec.genericDrop) i+prop_genericIndex       = \xs i -> i >= I 0 && i < Spec.genericLength xs ==>+                          (Test.genericIndex    `eq2`   Spec.genericIndex) xs i+prop_genericSplitAt     = \i -> i >= I 0 ==>+                          (Test.genericSplitAt  `eq2`   Spec.genericSplitAt) i+prop_genericReplicate   = \i -> i >= I 0 ==>+                          (Test.genericReplicate        `eq2`   Spec.genericReplicate) i++------------------------------------------------------------------------++{-# RULES+"main/error" main = error "RULES are on!"+  #-}++main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Testing: Data.Stream <=> Spec.List"+  putStrLn "==================================\n"++  runTests "Basic interface" opts+    [run prop_cons+    ,run prop_snoc+    ,run prop_append+    ,run prop_head+    ,run prop_last+    ,run prop_tail+    ,run prop_init+    ,run prop_null+    ,run prop_length+    ]++  runTests "List transformations" opts+    [run prop_map+--  ,run prop_reverse+    ,run prop_intersperse+    ,run prop_intercalate+--  ,run prop_transpose+    ]++  runTests "Reducing lists (folds)" opts+    [run prop_foldl+    ,run prop_foldl'+    ,run prop_foldr++    ,run prop_foldl1+    ,run prop_foldl1'+    ,run prop_foldr1+    ]++  runTests "Special folds" opts+    [+--   run prop_concat,+     run prop_concatMap+    ,run prop_and+    ,run prop_or+    ,run prop_any+    ,run prop_all+    ,run prop_sum+    ,run prop_product+    ,run prop_maximum+    ,run prop_minimum+    ]++  runTests "Scans" opts+    [run prop_scanl+    ,run prop_scanl1+{-+    ,run prop_scanr+    ,run prop_scanr1+-}+    ]++{-+  runTests "Accumulating maps" opts+    [run prop_mapAccumL+    ,run prop_mapAccumR+    ]+-}++  runTests "Infinite lists" opts+    [run prop_iterate+    ,run prop_repeat+    ,run prop_replicate+    ,run prop_cycle+    ]++  runTests "Unfolding" opts+    [run prop_unfoldr+    ]++  runTests "Extracting sublists" opts+    [run prop_take+    ,run prop_drop+    ,run prop_splitAt+    ,run prop_takeWhile+    ,run prop_dropWhile++{-+    ,run prop_span+    ,run prop_break+    ,run prop_group+    ,run prop_inits+    ,run prop_tails+-}+    ]++  runTests "Predicates" opts+    [run prop_isPrefixOf+{-+    ,run prop_isSuffixOf+    ,run prop_isInfixOf+-}+    ]++  runTests "Searching by equality" opts+    [run prop_elem+--  ,run prop_notElem-- no specific implementation+    ,run prop_lookup+    ]++  runTests "Searching by a predicate" opts+    [run prop_find+    ,run prop_filter+--  ,run prop_partition+    ]++  runTests "Indexing lists" opts+    [run prop_index+    ,run prop_findIndex+    ,run prop_elemIndex+    ,run prop_elemIndices+    ,run prop_findIndices+    ]++  runTests "Zipping" opts+    [+     run prop_zip+    ,run prop_zip3+{-+    ,run prop_zip4+    ,run prop_zip5+    ,run prop_zip6+    ,run prop_zip7+-}+    ,run prop_zipWith+    ,run prop_zipWith3+{-+    ,run prop_zipWith4+    ,run prop_zipWith5+    ,run prop_zipWith6+    ,run prop_zipWith7+-}+    ]++  runTests "Unzipping" opts+    [run prop_unzip+{-+    ,run prop_unzip3+    ,run prop_unzip4+    ,run prop_unzip5+    ,run prop_unzip6+    ,run prop_unzip7+-}+    ]++  runTests "Functions on strings" opts+    [run prop_unlines+{-+    ,run prop_lines+    ,run prop_words+    ,run prop_unwords+-}+    ]++{-+  runTests "\"Set\" operations" opts+    [run prop_nub+    ,run prop_delete+    ,run prop_difference+    ,run prop_union+    ,run prop_intersect+    ]+-}++{-+  runTests "Ordered lists" opts+    [run prop_sort+    ,run prop_insert+    ]+-}++{-+  runTests "Eq style \"By\" operations" opts+    [run prop_nubBy+    ,run prop_deleteBy+    ,run prop_deleteFirstsBy+    ,run prop_unionBy+    ,run prop_intersectBy+    ,run prop_groupBy+    ]+-}++  runTests "Ord style \"By\" operations" opts+{-+     run prop_sortBy        -- note issue here.+-}+    [run prop_insertBy+    ,run prop_maximumBy+    ,run prop_minimumBy+    ]++  runTests "The \"generic\" operations" opts+    [run prop_genericLength+    ,run prop_genericTake+    ,run prop_genericDrop+    ,run prop_genericIndex+    ,run prop_genericSplitAt+    ,run prop_genericReplicate+    ]
+ tests/Properties/StreamVsSpecStream.hs view
@@ -0,0 +1,475 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++import System.IO+import Properties.Utils hiding (eqnotnull1, eqnotnull2, eqnotnull3+                               ,eqfinite1, eqfinite2, eqfinite1)++import qualified Properties.Monomorphic.Stream      as Test         -- stream functions+import qualified Properties.Monomorphic.SpecStream  as Spec         -- H98++import qualified Data.Stream as Stream (Stream(Stream), Step(..), null, take, length)++--+-- Data.Stream <=> Spec.List+--++------------------------------------------------------------------------+-- * Basic interface++prop_cons       = Test.cons     `eq2`           Spec.cons+prop_snoc       = Test.snoc     `eq2`           Spec.snoc+prop_append     = Test.append   `eq2`           (Spec.++)+prop_head       = Test.head     `eqnotnull1`    Spec.head+prop_last       = Test.last     `eqnotnull1`    Spec.last+prop_tail       = Test.tail     `eqnotnull1`    Spec.tail+prop_init       = Test.init     `eqnotnull1`    Spec.init+prop_null       = Test.null     `eq1`           Spec.null+prop_length     = Test.length   `eq1`           Spec.length++------------------------------------------------------------------------+-- * List transformations++prop_map                = Test.map              `eq2`   Spec.map+-- prop_reverse            = Test.reverse          `eq1`   Spec.reverse+prop_intersperse        = Test.intersperse      `eq2`   Spec.intersperse+-- prop_intercalate        = Test.intercalate      `eq2`   Spec.intercalate+-- prop_transpose          = Test.transpose        `eq1`   Spec.transpose++------------------------------------------------------------------------+-- * Reducing lists (folds)++prop_foldl      = Test.foldl            `eq3`   Spec.foldl+prop_foldl'     = Test.foldl'           `eq3`   Spec.foldl'++prop_foldl1     = Test.foldl1   `eqnotnull2`    Spec.foldl1 -- n.b.+prop_foldl1'    = Test.foldl1'  `eqnotnull2`    Spec.foldl1' -- n.b.++prop_foldr      = Test.foldr            `eq3`   Spec.foldr+prop_foldr1     = Test.foldr1   `eqnotnull2`    Spec.foldr1++------------------------------------------------------------------------+-- ** Special folds++-- prop_concat     = Test.concat           `eq1`   Spec.concat+prop_concatMap  = Test.concatMap        `eq2`   Spec.concatMap+prop_and        = Test.and              `eq1`   Spec.and+prop_or         = Test.or               `eq1`   Spec.or+prop_any        = Test.any              `eq2`   Spec.any+prop_all        = Test.all              `eq2`   Spec.all+prop_sum        = Test.sum              `eq1`   Spec.sum+prop_product    = Test.product          `eq1`   Spec.product+prop_maximum    = Test.maximum  `eqnotnull1`    Spec.maximum+prop_minimum    = Test.minimum  `eqnotnull1`    Spec.minimum++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++prop_scanl      = Test.scanl            `eq3`   Spec.scanl+prop_scanl1     = Test.scanl1           `eq2`   Spec.scanl1++{-+prop_scanr1     = Test.scanr1           `eq2`   Spec.scanr1+prop_scanr      = Test.scanr            `eq3`   Spec.scanr+-}++------------------------------------------------------------------------+-- ** Accumulating maps++{-+prop_mapAccumL  = Test.mapAccumL        `eq3`   Spec.mapAccumL+prop_mapAccumR  = Test.mapAccumR        `eq3`   Spec.mapAccumR+-}++------------------------------------------------------------------------+-- ** Infinite lists++prop_iterate    = Test.iterate          `eqfinite2`     Spec.iterate+prop_repeat     = Test.repeat           `eqfinite1`     Spec.repeat+prop_replicate  = Test.replicate        `eq2`           Spec.replicate+prop_cycle      = \x -> not (Stream.null x) ==>+                  (Test.cycle           `eqfinite1`     Spec.cycle) x++------------------------------------------------------------------------+-- ** Unfolding++prop_unfoldr    = Test.unfoldr          `eqfinite2`     Spec.unfoldr++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_take       = Test.take             `eq2`   Spec.take+prop_drop       = Test.drop             `eq2`   Spec.drop+prop_splitAt    = Test.splitAt          `eq2`   Spec.splitAt+prop_takeWhile  = Test.takeWhile        `eq2`   Spec.takeWhile+prop_dropWhile  = Test.dropWhile        `eq2`   Spec.dropWhile++{-+prop_span       = Test.span             `eq2`   Spec.span+prop_break      = Test.break            `eq2`   Spec.break+prop_group      = Test.group            `eq1`   Spec.group+prop_inits      = Test.inits            `eq1`   Spec.inits+prop_tails      = Test.tails            `eq1`   Spec.tails+-}++------------------------------------------------------------------------+-- * Predicates++prop_isPrefixOf  = Test.isPrefixOf       `eq2`   Spec.isPrefixOf+{-+prop_isSuffixOf  = Test.isSuffixOf       `eq2`   Spec.isSuffixOf+prop_isInfixOf   = Test.isInfixOf        `eq2`   Spec.isInfixOf+-}++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++prop_elem       = Test.elem             `eq2`   Spec.elem+-- prop_notElem    = Test.notElem          `eq2`   Spec.notElem -- no specific implementation+prop_lookup     = Test.lookup           `eq2`   Spec.lookup++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_find       = Test.find             `eq2`   Spec.find+prop_filter     = Test.filter           `eq2`   Spec.filter+-- prop_partition  = Test.partition        `eq2`   Spec.partition++------------------------------------------------------------------------+-- * Indexing lists++prop_index              = \xs n -> n >= 0 && n < Stream.length xs ==>+                          ((Test.!!)            `eq2`   (Spec.!!)) xs n+prop_findIndex          = Test.findIndex        `eq2`   Spec.findIndex+prop_elemIndex          = Test.elemIndex        `eq2`   Spec.elemIndex+prop_elemIndices        = Test.elemIndices      `eq2`   Spec.elemIndices+prop_findIndices        = Test.findIndices      `eq2`   Spec.findIndices++------------------------------------------------------------------------+-- * Zipping and unzipping lists++prop_zip        = Test.zip              `eq2`   Spec.zip+prop_zip3       = Test.zip3             `eq3`   Spec.zip3++prop_zipWith    = Test.zipWith          `eq3`   Spec.zipWith+prop_zipWith3   = Test.zipWith3         `eq4`   Spec.zipWith3++{-+prop_zip4       = Test.zip4             `eq4`   Spec.zip4+prop_zip5       = Test.zip5             `eq5`   Spec.zip5+prop_zip6       = Test.zip6             `eq6`   Spec.zip6+prop_zip7       = Test.zip7             `eq7`   Spec.zip7+prop_zipWith4   = Test.zipWith4         `eq5`   Spec.zipWith4+prop_zipWith5   = Test.zipWith5         `eq6`   Spec.zipWith5+prop_zipWith6   = Test.zipWith6         `eq7`   Spec.zipWith6+prop_zipWith7   = Test.zipWith7         `eq8`   Spec.zipWith7+-}++------------------------------------------------------------------------++prop_unzip      = Test.unzip            `eq1`   Spec.unzip++{-+prop_unzip3     = Test.unzip3           `eq1`   Spec.unzip3+prop_unzip4     = Test.unzip4           `eq1`   Spec.unzip4+prop_unzip5     = Test.unzip5           `eq1`   Spec.unzip5+prop_unzip6     = Test.unzip6           `eq1`   Spec.unzip6+prop_unzip7     = Test.unzip7           `eq1`   Spec.unzip7+-}++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings++-- hmm?+{-+prop_lines      = Test.lines            `eq1`   Spec.lines+prop_words      = Test.words            `eq1`   Spec.words+prop_unlines    = Test.unlines          `eq1`   Spec.unlines+prop_unwords    = Test.unwords          `eq1`   Spec.unwords+-}++------------------------------------------------------------------------+-- ** \"Set\" operations++{-+prop_nub        = Test.nub              `eq1`   Spec.nub+prop_delete     = Test.delete           `eq2`   Spec.delete+prop_difference = (Test.\\)             `eq2`   (Spec.\\)+prop_union      = Test.union            `eq2`   Spec.union+prop_intersect  = Test.intersect        `eq2`   Spec.intersect+-}++------------------------------------------------------------------------+-- ** Ordered lists ++{-+prop_sort       = Test.sort             `eq1`   Spec.sort+prop_insert     = Test.insert           `eq2`   Spec.insert+-}++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++{-+prop_nubBy              = Test.nubBy            `eq2`   Spec.nubBy+prop_deleteBy           = Test.deleteBy         `eq3`   Spec.deleteBy+prop_deleteFirstsBy     = Test.deleteFirstsBy   `eq3`   Spec.deleteFirstsBy+prop_unionBy            = Test.unionBy          `eq3`   Spec.unionBy+prop_intersectBy        = Test.intersectBy      `eq3`   Spec.intersectBy+prop_groupBy            = Test.groupBy          `eq2`   Spec.groupBy+-}++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++{-+prop_sortBy             = Test.sortBy           `eq2`           Spec.sortBy+prop_insertBy           = Test.insertBy         `eq3`           Spec.insertBy+-}+prop_maximumBy          = Test.maximumBy        `eqnotnull2`    Spec.maximumBy+prop_minimumBy          = Test.minimumBy        `eqnotnull2`    Spec.minimumBy++------------------------------------------------------------------------+-- * The \"generic\" operations++prop_genericLength      = Test.genericLength    `eq1`   Spec.genericLength+prop_genericTake        = \i -> i >= I 0 ==>+                          (Test.genericTake     `eq2`   Spec.genericTake) i+prop_genericDrop        = \i -> i >= I 0 ==>+                          (Test.genericDrop     `eq2`   Spec.genericDrop) i+prop_genericIndex       = \xs i -> i >= I 0 && i < Spec.genericLength xs ==>+                          (Test.genericIndex    `eq2`   Spec.genericIndex) xs i+prop_genericSplitAt     = \i -> i >= I 0 ==>+                          (Test.genericSplitAt  `eq2`   Spec.genericSplitAt) i+--prop_genericReplicate   = \i -> i >= I 0 ==>+--                          (Test.genericReplicate        `eq2`   Spec.genericReplicate) i++------------------------------------------------------------------------++main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Testing: Data.Stream <=> Spec.List"+  putStrLn "==================================\n"++  runTests "Basic interface" opts+    [run prop_cons+    ,run prop_snoc+    ,run prop_append+    ,run prop_head+    ,run prop_last+    ,run prop_tail+    ,run prop_init+    ,run prop_null+    ,run prop_length+    ]++  runTests "List transformations" opts+    [run prop_map+--  ,run prop_reverse+    ,run prop_intersperse+--  ,run prop_intercalate+--  ,run prop_transpose+    ]++  runTests "Reducing lists (folds)" opts+    [run prop_foldl+    ,run prop_foldl'+    ,run prop_foldr++    ,run prop_foldl1+    ,run prop_foldl1'+    ,run prop_foldr1+    ]++  runTests "Special folds" opts+    [+--   run prop_concat,+     run prop_concatMap+    ,run prop_and+    ,run prop_or+    ,run prop_any+    ,run prop_all+    ,run prop_sum+    ,run prop_product+    ,run prop_maximum+    ,run prop_minimum+    ]++  runTests "Scans" opts+    [run prop_scanl+    ,run prop_scanl1+{-+--  ,run prop_scanr+    ,run prop_scanr1+-}+    ]++{-+  runTests "Accumulating maps" opts+    [run prop_mapAccumL+    ,run prop_mapAccumR+    ]+-}++  runTests "Infinite lists" opts+    [run prop_iterate+    ,run prop_repeat+    ,run prop_replicate+    ,run prop_cycle+    ]++  runTests "Unfolding" opts+    [run prop_unfoldr+    ]++  runTests "Extracting sublists" opts+    [run prop_take+    ,run prop_drop+    ,run prop_splitAt+    ,run prop_takeWhile+    ,run prop_dropWhile++{-+    ,run prop_span+    ,run prop_break+    ,run prop_group+    ,run prop_inits+    ,run prop_tails+-}+    ]++  runTests "Predicates" opts+    [run prop_isPrefixOf+{-+    ,run prop_isSuffixOf+    ,run prop_isInfixOf+-}+    ]++  runTests "Searching by equality" opts+    [run prop_elem+--  ,run prop_notElem-- no specific implementation+    ,run prop_lookup+    ]++  runTests "Searching by a predicate" opts+    [run prop_find+    ,run prop_filter+--  ,run prop_partition+    ]++  runTests "Indexing lists" opts+    [run prop_index+    ,run prop_findIndex+    ,run prop_elemIndex+    ,run prop_elemIndices+    ,run prop_findIndices+    ]++  runTests "Zipping" opts+    [+     run prop_zip+    ,run prop_zip3+{-+    ,run prop_zip4+    ,run prop_zip5+    ,run prop_zip6+    ,run prop_zip7+-}+    ,run prop_zipWith+    ,run prop_zipWith3+{-+    ,run prop_zipWith4+    ,run prop_zipWith5+    ,run prop_zipWith6+    ,run prop_zipWith7+-}+    ]++  runTests "Unzipping" opts+    [run prop_unzip+{-+    ,run prop_unzip3+    ,run prop_unzip4+    ,run prop_unzip5+    ,run prop_unzip6+    ,run prop_unzip7+-}+    ]++  runTests "Functions on strings" opts+    [+{-   +     run prop_unlines+    ,run prop_lines+    ,run prop_words+    ,run prop_unwords+-}+    ]++{-+  runTests "\"Set\" operations" opts+    [run prop_nub+    ,run prop_delete+    ,run prop_difference+    ,run prop_union+    ,run prop_intersect+    ]+-}++{-+  runTests "Ordered lists" opts+    [run prop_sort+    ,run prop_insert+    ]+-}++{-+  runTests "Eq style \"By\" operations" opts+    [run prop_nubBy+    ,run prop_deleteBy+    ,run prop_deleteFirstsBy+    ,run prop_unionBy+    ,run prop_intersectBy+    ,run prop_groupBy+    ]+-}++  runTests "Ord style \"By\" operations" opts+    [+{-+     run prop_sortBy        -- note issue here.+    ,run prop_insertBy+-}+     run prop_maximumBy+    ,run prop_minimumBy+    ]++  runTests "The \"generic\" operations" opts+    [run prop_genericLength+    ,run prop_genericTake+    ,run prop_genericDrop+    ,run prop_genericIndex+    ,run prop_genericSplitAt+--  ,run prop_genericReplicate+    ]++------------------------------------------------------------------------++eqnotnull1 f g = \x     -> (not (Stream.null x)) ==> eq1 f g x+eqnotnull2 f g = \x y   -> (not (Stream.null y)) ==> eq2 f g x y+eqnotnull3 f g = \x y z -> (not (Stream.null z)) ==> eq3 f g x y z++eqfinite1 f g = \x     -> forAll arbitrary $ \n -> Stream.take n (f x)     == Stream.take n (g x)+eqfinite2 f g = \x y   -> forAll arbitrary $ \n -> Stream.take n (f x y)   == Stream.take n (g x y)+eqfinite3 f g = \x y z -> forAll arbitrary $ \n -> Stream.take n (f x y z) == Stream.take n (g x y z)
+ tests/Properties/Utils.hs view
@@ -0,0 +1,162 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++module Properties.Utils (+  module Properties.Utils,+  module Test.QuickCheck,+  module Test.QuickCheck.Batch,+  ) where++import Test.QuickCheck+import Test.QuickCheck.Batch+import Text.Show.Functions++import Control.Monad (liftM,liftM5)++import qualified Data.Stream as S++opts = TestOptions {+         no_of_tests     = 200,+         length_of_tests = 0,+         debug_tests = False+       }++eq1 :: (Eq a) => (t -> a) -> (t -> a) -> t -> Property+eq2 :: (Eq a) => (t -> t1 -> a) -> (t -> t1 -> a) -> t -> t1 -> Property+eq3 :: (Eq a) => (t -> t1 -> t2 -> a)+    -> (t -> t1 -> t2 -> a)+    -> t -> t1 -> t2 -> Property+eq4 :: (Eq a) => (t -> t1 -> t2 -> t3 -> a)+    -> (t -> t1 -> t2 -> t3 -> a)+    -> t -> t1 -> t2 -> t3 -> Property+eq5 :: (Eq a) => (t -> t1 -> t2 -> t3 -> t4 -> a)+    -> (t -> t1 -> t2 -> t3 -> t4 -> a)+    -> t -> t1 -> t2 -> t3 -> t4 -> Property+eq6 :: (Eq a) => (t -> t1 -> t2 -> t3 -> t4 -> t5 -> a)+    -> (t -> t1 -> t2 -> t3 -> t4 -> t5 -> a)+    -> t -> t1 -> t2 -> t3 -> t4 -> t5 -> Property+eq7 :: (Eq a) => (t -> t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> a)+    -> (t -> t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> a)+    -> t -> t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> Property+eq8 :: (Eq a) => (t -> t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> t7 -> a)+    -> (t -> t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> t7 -> a)+    -> t -> t1 -> t2 -> t3 -> t4 -> t5 -> t6 -> t7 -> Property++eq1 f g = \x               -> property $ f x               == g x+eq2 f g = \x y             -> property $ f x y             == g x y+eq3 f g = \x y z           -> property $ f x y z           == g x y z+eq4 f g = \x y z a         -> property $ f x y z a         == g x y z a+eq5 f g = \x y z a b       -> property $ f x y z a b       == g x y z a b+eq6 f g = \x y z a b c     -> property $ f x y z a b c     == g x y z a b c+eq7 f g = \x y z a b c d   -> property $ f x y z a b c d   == g x y z a b c d+eq8 f g = \x y z a b c d e -> property $ f x y z a b c d e == g x y z a b c d e++eqnotnull1 :: (Eq a1) => ([a] -> a1) -> ([a] -> a1) -> [a] -> Property+eqnotnull2 :: (Eq a1) => (t -> [a] -> a1)+           -> (t -> [a] -> a1) -> t -> [a] -> Property+eqnotnull3 :: (Eq a1) => (t -> t1 -> [a] -> a1)+           -> (t -> t1 -> [a] -> a1) -> t -> t1 -> [a] -> Property++eqnotnull1 f g = \x     -> (not (null x)) ==> eq1 f g x+eqnotnull2 f g = \x y   -> (not (null y)) ==> eq2 f g x y+eqnotnull3 f g = \x y z -> (not (null z)) ==> eq3 f g x y z++eqfinite1 f g = \x     -> forAll arbitrary $ \n -> Prelude.take n (f x)     == Prelude.take n (g x)+eqfinite2 f g = \x y   -> forAll arbitrary $ \n -> Prelude.take n (f x y)   == Prelude.take n (g x y)+eqfinite3 f g = \x y z -> forAll arbitrary $ \n -> Prelude.take n (f x y z) == Prelude.take n (g x y z)+++newtype A = A Int deriving (Eq, Show, Arbitrary)+newtype B = B Int deriving (Eq, Show, Arbitrary)+newtype C = C Int deriving (Eq, Show, Arbitrary)+type D = A+type E = B+type F = C+type G = A+type H = B++newtype OrdA = OrdA Int deriving (Eq, Ord, Show, Arbitrary)++newtype N = N Int deriving (Eq, Ord, Num, Show, Arbitrary)+newtype I = I Int deriving (Eq, Ord, Num, Enum, Real, Integral, Show, Arbitrary)++instance Arbitrary Char where+    arbitrary     = elements ([' ', '\n', '\0'] ++ ['a'..'h'])+    coarbitrary c = variant (fromEnum c `rem` 4)++instance Arbitrary Ordering where+    arbitrary      = elements [LT, EQ, GT]+    coarbitrary LT = variant 0+    coarbitrary EQ = variant 1+    coarbitrary GT = variant 2++{-+instance Arbitrary a => Arbitrary (Maybe a) where+    arbitrary            = frequency [ (1, return Nothing)+                                     , (3, liftM Just arbitrary) ]+    coarbitrary Nothing  = variant 0+    coarbitrary (Just a) = variant 1 . coarbitrary a+        -}++instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e)+      => Arbitrary (a, b, c, d ,e )+ where+  arbitrary = liftM5 (,,,,) arbitrary arbitrary arbitrary arbitrary arbitrary+  coarbitrary (a, b, c, d, e) =+    coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d .  coarbitrary e++instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e, Arbitrary f)+      => Arbitrary (a, b, c, d, e, f)+ where+  arbitrary = liftM6 (,,,,,) arbitrary arbitrary arbitrary arbitrary arbitrary arbitrary+  coarbitrary (a, b, c, d, e, f) =+    coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d .  coarbitrary e . coarbitrary f++liftM6  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m a6 -> m r+liftM6 f m1 m2 m3 m4 m5 m6 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; return (f x1 x2 x3 x4 x5 x6) }++instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e, Arbitrary f, Arbitrary g)+      => Arbitrary (a, b, c, d, e, f, g)+ where+  arbitrary = liftM7 (,,,,,,) arbitrary arbitrary arbitrary arbitrary arbitrary arbitrary arbitrary+  coarbitrary (a, b, c, d, e, f, g) =+    coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d .  coarbitrary e . coarbitrary f . coarbitrary g++liftM7  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m a6 -> m a7 -> m r+liftM7 f m1 m2 m3 m4 m5 m6 m7 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; x6 <- m6; x7 <- m7 ; return (f x1 x2 x3 x4 x5 x6 x7) }+++------------------------------------------------------------------------+-- Arbitrary instance for Stream++{-+instance (Arbitrary a, Arbitrary s) => Arbitrary (S.Step a s)  where+    arbitrary = do x <- arbitrary+                   a <- arbitrary+                   s <- arbitrary+                   return $ case x of+                        LT -> S.Yield a s+                        EQ -> S.Skip s+                        GT -> S.Done+    coarbitrary = error "No coarbitrary for Step a s"+-}++-- existential state type+instance (Arbitrary a) => Arbitrary (S.Stream a)  where+    coarbitrary = error "No coarbitrary for Streams"+    arbitrary = do xs    <- arbitrary :: Gen [a]+                   skips <- arbitrary :: Gen [Bool] -- random Skips+                   return (stream' (zip xs skips))+      where+        -- | Construct an abstract stream from a list, with Steps in it.+        stream' :: [(a,Bool)] -> S.Stream a+        stream' xs0 = S.Stream next (S.L xs0)+          where+            next (S.L [])             = S.Done+            next (S.L ((x,True ):xs)) = S.Yield x (S.L xs)+            next (S.L ((_,False):xs)) = S.Skip    (S.L xs)++instance Show a => Show (S.Stream a) where+  show = show . S.unstream++instance Eq a => Eq (S.Stream a) where+  xs == ys = S.unstream xs == S.unstream ys
+ tests/Spec/List.hs view
@@ -0,0 +1,289 @@+-- Taken from the Haskell 98 Report:+-- http://haskell.org/onlinereport/++-- Modifications to make it compile:+--   changed module name+--   limited import list from the real Prelude+--   copied listToMaybe from the Maybe module++module Spec.List (+    elemIndex, elemIndices,+    find, findIndex, findIndices,+    nub, nubBy, delete, deleteBy, (\\), deleteFirstsBy,+    union, unionBy, intersect, intersectBy,+    intersperse, transpose, partition, group, groupBy,+    inits, tails, isPrefixOf, isSuffixOf,+    mapAccumL, mapAccumR,+    sort, sortBy, insert, insertBy, maximumBy, minimumBy,+    genericLength, genericTake, genericDrop,+    genericSplitAt, genericIndex, genericReplicate,+    zip4, zip5, zip6, zip7,+    zipWith4, zipWith5, zipWith6, zipWith7,+    unzip4, unzip5, unzip6, unzip7, unfoldr,++    -- ...and what the Prelude exports+    -- []((:), []), -- This is built-in syntax+    map, (++), concat, filter,+    head, last, tail, init, null, length, (!!),+    foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,+    iterate, repeat, replicate, cycle,+    take, drop, splitAt, takeWhile, dropWhile, span, break,+    lines, words, unlines, unwords, reverse, and, or,+    any, all, elem, notElem, lookup,+    sum, product, maximum, minimum, concatMap, +    zip, zip3, zipWith, zipWith3, unzip, unzip3+    ) where++import Prelude (Int, Integer, Integral, Num(..), Eq(..), Ord(..), Ordering(..),+                Bool(..), (&&), (||), not, Maybe(..), String, +                (.), error, seq, otherwise, flip)+import Spec.PreludeList++infix 5 \\ -- for cpp++-- copied from the Maybe module++listToMaybe            :: [a] -> Maybe a+listToMaybe []         =  Nothing+listToMaybe (a:_)      =  Just a++++elemIndex               :: Eq a => a -> [a] -> Maybe Int+elemIndex x             =  findIndex (x ==)+        +elemIndices             :: Eq a => a -> [a] -> [Int]+elemIndices x           =  findIndices (x ==)+                        +find                    :: (a -> Bool) -> [a] -> Maybe a+find p                  =  listToMaybe . filter p++findIndex               :: (a -> Bool) -> [a] -> Maybe Int+findIndex p             =  listToMaybe . findIndices p++findIndices             :: (a -> Bool) -> [a] -> [Int]+findIndices p xs        =  [ i | (x,i) <- zip xs [0..], p x ]++nub                     :: Eq a => [a] -> [a]+nub                     =  nubBy (==)++nubBy                   :: (a -> a -> Bool) -> [a] -> [a]+nubBy eq []             =  []+nubBy eq (x:xs)         =  x : nubBy eq (filter (\y -> not (eq x y)) xs)++delete                  :: Eq a => a -> [a] -> [a]+delete                  =  deleteBy (==)++deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]+deleteBy eq x []        = []+deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys++(\\)                    :: Eq a => [a] -> [a] -> [a]+(\\)                    =  foldl (flip delete)++deleteFirstsBy          :: (a -> a -> Bool) -> [a] -> [a] -> [a]+deleteFirstsBy eq       =  foldl (flip (deleteBy eq))++union                   :: Eq a => [a] -> [a] -> [a]+union                   =  unionBy (==)    ++unionBy                 :: (a -> a -> Bool) -> [a] -> [a] -> [a]+unionBy eq xs ys        =  xs ++ deleteFirstsBy eq (nubBy eq ys) xs++intersect               :: Eq a => [a] -> [a] -> [a]+intersect               =  intersectBy (==)++intersectBy             :: (a -> a -> Bool) -> [a] -> [a] -> [a]+intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]++intersperse             :: a -> [a] -> [a]+intersperse sep []      =  []+intersperse sep [x]     =  [x]+intersperse sep (x:xs)  =  x : sep : intersperse sep xs++-- transpose is lazy in both rows and columns,+--       and works for non-rectangular 'matrices'+-- For example, transpose [[1,2],[3,4,5],[]]  =  [[1,3],[2,4],[5]]+-- Note that [h | (h:t) <- xss] is not the same as (map head xss)+--      because the former discards empty sublists inside xss+transpose                :: [[a]] -> [[a]]+transpose []             = []+transpose ([]     : xss) = transpose xss+transpose ((x:xs) : xss) = (x : [h | (h:t) <- xss]) : +                           transpose (xs : [t | (h:t) <- xss])++partition               :: (a -> Bool) -> [a] -> ([a],[a])+partition p xs          =  (filter p xs, filter (not . p) xs)++-- group splits its list argument into a list of lists of equal, adjacent+-- elements.  e.g.,+-- group "Mississippi" == ["M","i","ss","i","ss","i","pp","i"]+group                   :: Eq a => [a] -> [[a]]+group                   =  groupBy (==)++groupBy                 :: (a -> a -> Bool) -> [a] -> [[a]]+groupBy eq []           =  []+groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs+                           where (ys,zs) = span (eq x) xs++-- inits xs returns the list of initial segments of xs, shortest first.+-- e.g., inits "abc" == ["","a","ab","abc"]+inits                   :: [a] -> [[a]]+inits []                =  [[]]+inits (x:xs)            =  [[]] ++ map (x:) (inits xs)++-- tails xs returns the list of all final segments of xs, longest first.+-- e.g., tails "abc" == ["abc", "bc", "c",""]+tails                   :: [a] -> [[a]]+tails []                =  [[]]+tails xxs@(_:xs)        =  xxs : tails xs++isPrefixOf               :: Eq a => [a] -> [a] -> Bool+isPrefixOf []     _      =  True+isPrefixOf _      []     =  False+isPrefixOf (x:xs) (y:ys) =  x == y && isPrefixOf xs ys++isSuffixOf              :: Eq a => [a] -> [a] -> Bool+isSuffixOf x y          =  reverse x `isPrefixOf` reverse y++mapAccumL               :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])+mapAccumL f s []        =  (s, [])+mapAccumL f s (x:xs)    =  (s'',y:ys)+                           where (s', y ) = f s x+                                 (s'',ys) = mapAccumL f s' xs++mapAccumR               :: (a -> b -> (a, c)) -> a -> [b] -> (a, [c])+mapAccumR f s []        =  (s, [])+mapAccumR f s (x:xs)    =  (s'', y:ys)+                           where (s'',y ) = f s' x+                                 (s', ys) = mapAccumR f s xs++unfoldr                 :: (b -> Maybe (a,b)) -> b -> [a]+unfoldr f b             = case f b of+                                Nothing    -> []+                                Just (a,b) -> a : unfoldr f b++sort                    :: (Ord a) => [a] -> [a]+sort                    =  sortBy compare++sortBy                  :: (a -> a -> Ordering) -> [a] -> [a]+sortBy cmp              =  foldr (insertBy cmp) []++insert                  :: (Ord a) => a -> [a] -> [a]+insert                  = insertBy compare++insertBy                :: (a -> a -> Ordering) -> a -> [a] -> [a]+insertBy cmp x []       =  [x]+insertBy cmp x ys@(y:ys')+                        =  case cmp x y of+                                GT -> y : insertBy cmp x ys'+                                _  -> x : ys++maximumBy               :: (a -> a -> Ordering) -> [a] -> a+maximumBy cmp []        =  error "List.maximumBy: empty list"+maximumBy cmp xs        =  foldl1 max xs+                        where+                           max x y = case cmp x y of+                                        GT -> x+                                        _  -> y++minimumBy               :: (a -> a -> Ordering) -> [a] -> a+minimumBy cmp []        =  error "List.minimumBy: empty list"+minimumBy cmp xs        =  foldl1 min xs+                        where+                           min x y = case cmp x y of+                                        GT -> y+                                        _  -> x++genericLength           :: (Integral a) => [b] -> a+genericLength []        =  0+genericLength (x:xs)    =  1 + genericLength xs++genericTake             :: (Integral a) => a -> [b] -> [b]+genericTake _ []        =  []+genericTake 0 _         =  []+genericTake n (x:xs) +   | n > 0              =  x : genericTake (n-1) xs+   | otherwise          =  error "List.genericTake: negative argument"++genericDrop             :: (Integral a) => a -> [b] -> [b]+genericDrop 0 xs        =  xs+genericDrop _ []        =  []+genericDrop n (_:xs) +   | n > 0              =  genericDrop (n-1) xs+   | otherwise          =  error "List.genericDrop: negative argument"++genericSplitAt          :: (Integral a) => a -> [b] -> ([b],[b])+genericSplitAt 0 xs     =  ([],xs)+genericSplitAt _ []     =  ([],[])+genericSplitAt n (x:xs) +   | n > 0              =  (x:xs',xs'')+   | otherwise          =  error "List.genericSplitAt: negative argument"+       where (xs',xs'') =  genericSplitAt (n-1) xs++genericIndex            :: (Integral a) => [b] -> a -> b+genericIndex (x:_)  0   =  x+genericIndex (_:xs) n +        | n > 0         =  genericIndex xs (n-1)+        | otherwise     =  error "List.genericIndex: negative argument"+genericIndex _ _        =  error "List.genericIndex: index too large"++genericReplicate        :: (Integral a) => a -> b -> [b]+genericReplicate n x    =  genericTake n (repeat x)+ +zip4                    :: [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]+zip4                    =  zipWith4 (,,,)++zip5                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]+zip5                    =  zipWith5 (,,,,)++zip6                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] -> +                              [(a,b,c,d,e,f)]+zip6                    =  zipWith6 (,,,,,)++zip7                    :: [a] -> [b] -> [c] -> [d] -> [e] -> [f] ->+                              [g] -> [(a,b,c,d,e,f,g)]+zip7                    =  zipWith7 (,,,,,,)++zipWith4                :: (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]+zipWith4 z (a:as) (b:bs) (c:cs) (d:ds)+                        =  z a b c d : zipWith4 z as bs cs ds+zipWith4 _ _ _ _ _      =  []++zipWith5                :: (a->b->c->d->e->f) -> +                           [a]->[b]->[c]->[d]->[e]->[f]+zipWith5 z (a:as) (b:bs) (c:cs) (d:ds) (e:es)+                        =  z a b c d e : zipWith5 z as bs cs ds es+zipWith5 _ _ _ _ _ _    =  []++zipWith6                :: (a->b->c->d->e->f->g) ->+                           [a]->[b]->[c]->[d]->[e]->[f]->[g]+zipWith6 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs)+                        =  z a b c d e f : zipWith6 z as bs cs ds es fs+zipWith6 _ _ _ _ _ _ _  =  []++zipWith7                :: (a->b->c->d->e->f->g->h) ->+                           [a]->[b]->[c]->[d]->[e]->[f]->[g]->[h]+zipWith7 z (a:as) (b:bs) (c:cs) (d:ds) (e:es) (f:fs) (g:gs)+                   =  z a b c d e f g : zipWith7 z as bs cs ds es fs gs+zipWith7 _ _ _ _ _ _ _ _ = []++unzip4                  :: [(a,b,c,d)] -> ([a],[b],[c],[d])+unzip4                  =  foldr (\(a,b,c,d) ~(as,bs,cs,ds) ->+                                        (a:as,b:bs,c:cs,d:ds))+                                 ([],[],[],[])++unzip5                  :: [(a,b,c,d,e)] -> ([a],[b],[c],[d],[e])+unzip5                  =  foldr (\(a,b,c,d,e) ~(as,bs,cs,ds,es) ->+                                        (a:as,b:bs,c:cs,d:ds,e:es))+                                 ([],[],[],[],[])++unzip6                  :: [(a,b,c,d,e,f)] -> ([a],[b],[c],[d],[e],[f])+unzip6                  =  foldr (\(a,b,c,d,e,f) ~(as,bs,cs,ds,es,fs) ->+                                        (a:as,b:bs,c:cs,d:ds,e:es,f:fs))+                                 ([],[],[],[],[],[])++unzip7          :: [(a,b,c,d,e,f,g)] -> ([a],[b],[c],[d],[e],[f],[g])+unzip7          =  foldr (\(a,b,c,d,e,f,g) ~(as,bs,cs,ds,es,fs,gs) ->+                                (a:as,b:bs,c:cs,d:ds,e:es,f:fs,g:gs))+                         ([],[],[],[],[],[],[])
+ tests/Spec/ListExts.hs view
@@ -0,0 +1,33 @@+-- Spececifications of things in Data.List but not in the H98 List module+++module Spec.ListExts (+  foldl',+  foldl1',+  +  intercalate,++  isInfixOf,+  ) where++import Prelude (Int, Integer, Integral, Num(..), Eq(..), Ord(..), Ordering(..),+                Bool(..), (&&), (||), not, Maybe(..), String, +                (.), error, seq, otherwise, flip)+import Spec.List++foldl'            :: (a -> b -> a) -> a -> [b] -> a+foldl' f z []     =  z+foldl' f z (x:xs) =  let z' = f z x in z' `seq` foldl f z' xs+++foldl1'           :: (a -> a -> a) -> [a] -> a+foldl1' f (x:xs)  =  foldl' f x xs+foldl1' _ []      =  error "Prelude.foldl1: empty list"+++isInfixOf :: Eq a => [a] -> [a] -> Bool+isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)+++intercalate :: [a] -> [[a]] -> [a]+intercalate xs xss = concat (intersperse xs xss)
+ tests/Spec/PreludeList.hs view
@@ -0,0 +1,358 @@+-- Taken from the Haskell 98 Report:+-- http://haskell.org/onlinereport/++-- Modifications to make it compile:+--   changed module name+--   limited import list from the real Prelude++module Spec.PreludeList (+    map, (++), filter, concat, concatMap, +    head, last, tail, init, null, length, (!!), +    foldl, foldl1, scanl, scanl1, foldr, foldr1, scanr, scanr1,+    iterate, repeat, replicate, cycle,+    take, drop, splitAt, takeWhile, dropWhile, span, break,+    lines, words, unlines, unwords, reverse, and, or,+    any, all, elem, notElem, lookup,+    sum, product, maximum, minimum, +    zip, zip3, zipWith, zipWith3, unzip, unzip3)+  where++import Prelude (Int, Integer, Integral, Num(..), Eq(..), Ord(..), Ordering(..),+                Bool(..), (&&), (||), not, Maybe(..), String, +                (.), error, seq, otherwise, flip)+import qualified Char(isSpace)++infixl 9  !!+infixr 5  +++infix  4  `elem`, `notElem`++-- Map and append++map :: (a -> b) -> [a] -> [b]+map f []     = []+map f (x:xs) = f x : map f xs+++(++) :: [a] -> [a] -> [a]+[]     ++ ys = ys+(x:xs) ++ ys = x : (xs ++ ys)+++filter :: (a -> Bool) -> [a] -> [a]+filter p []                 = []+filter p (x:xs) | p x       = x : filter p xs+                | otherwise = filter p xs+++concat :: [[a]] -> [a]+concat xss = foldr (++) [] xss+++concatMap :: (a -> [b]) -> [a] -> [b]+concatMap f = concat . map f++-- head and tail extract the first element and remaining elements,+-- respectively, of a list, which must be non-empty.  last and init+-- are the dual functions working from the end of a finite list,+-- rather than the beginning.+++head             :: [a] -> a+head (x:_)       =  x+head []          =  error "Prelude.head: empty list"+++tail             :: [a] -> [a]+tail (_:xs)      =  xs+tail []          =  error "Prelude.tail: empty list"+++last             :: [a] -> a+last [x]         =  x+last (_:xs)      =  last xs+last []          =  error "Prelude.last: empty list"+++init             :: [a] -> [a]+init [x]         =  []+init (x:xs)      =  x : init xs+init []          =  error "Prelude.init: empty list"+++null             :: [a] -> Bool+null []          =  True+null (_:_)       =  False++-- length returns the length of a finite list as an Int.++length           :: [a] -> Int+length []        =  0+length (_:l)     =  1 + length l++-- List index (subscript) operator, 0-origin++(!!)                :: [a] -> Int -> a+xs     !! n | n < 0 =  error "Prelude.!!: negative index"+[]     !! _         =  error "Prelude.!!: index too large"+(x:_)  !! 0         =  x+(_:xs) !! n         =  xs !! (n-1)++-- foldl, applied to a binary operator, a starting value (typically the+-- left-identity of the operator), and a list, reduces the list using+-- the binary operator, from left to right:+--  foldl f z [x1, x2, ..., xn] == (...((z `f` x1) `f` x2) `f`...) `f` xn+-- foldl1 is a variant that has no starting value argument, and  thus must+-- be applied to non-empty lists.  scanl is similar to foldl, but returns+-- a list of successive reduced values from the left:+--      scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+-- Note that  last (scanl f z xs) == foldl f z xs.+-- scanl1 is similar, again without the starting element:+--      scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+++foldl            :: (a -> b -> a) -> a -> [b] -> a+foldl f z []     =  z+foldl f z (x:xs) =  foldl f (f z x) xs+++foldl1           :: (a -> a -> a) -> [a] -> a+foldl1 f (x:xs)  =  foldl f x xs+foldl1 _ []      =  error "Prelude.foldl1: empty list"+++scanl            :: (a -> b -> a) -> a -> [b] -> [a]+scanl f q xs     =  q : (case xs of+                            []   -> []+                            x:xs -> scanl f (f q x) xs)+++scanl1           :: (a -> a -> a) -> [a] -> [a]+scanl1 f (x:xs)  =  scanl f x xs+scanl1 _ []      =  []++-- foldr, foldr1, scanr, and scanr1 are the right-to-left duals of the+-- above functions.+++foldr            :: (a -> b -> b) -> b -> [a] -> b+foldr f z []     =  z+foldr f z (x:xs) =  f x (foldr f z xs)+++foldr1           :: (a -> a -> a) -> [a] -> a+foldr1 f [x]     =  x+foldr1 f (x:xs)  =  f x (foldr1 f xs)+foldr1 _ []      =  error "Prelude.foldr1: empty list"+++scanr             :: (a -> b -> b) -> b -> [a] -> [b]+scanr f q0 []     =  [q0]+scanr f q0 (x:xs) =  f x q : qs+                     where qs@(q:_) = scanr f q0 xs +++scanr1          :: (a -> a -> a) -> [a] -> [a]+scanr1 f []     =  []+scanr1 f [x]    =  [x]+scanr1 f (x:xs) =  f x q : qs+                   where qs@(q:_) = scanr1 f xs ++-- iterate f x returns an infinite list of repeated applications of f to x:+-- iterate f x == [x, f x, f (f x), ...]++iterate          :: (a -> a) -> a -> [a]+iterate f x      =  x : iterate f (f x)++-- repeat x is an infinite list, with x the value of every element.++repeat           :: a -> [a]+repeat x         =  xs where xs = x:xs++-- replicate n x is a list of length n with x the value of every element++replicate        :: Int -> a -> [a]+replicate n x    =  take n (repeat x)++-- cycle ties a finite list into a circular one, or equivalently,+-- the infinite repetition of the original list.  It is the identity+-- on infinite lists.+++cycle            :: [a] -> [a]+cycle []         =  error "Prelude.cycle: empty list"+cycle xs         =  xs' where xs' = xs ++ xs'++-- take n, applied to a list xs, returns the prefix of xs of length n,+-- or xs itself if n > length xs.  drop n xs returns the suffix of xs+-- after the first n elements, or [] if n > length xs.  splitAt n xs+-- is equivalent to (take n xs, drop n xs).+++take                   :: Int -> [a] -> [a]+take n _      | n <= 0 =  []+take _ []              =  []+take n (x:xs)          =  x : take (n-1) xs+++drop                   :: Int -> [a] -> [a]+drop n xs     | n <= 0 =  xs+drop _ []              =  []+drop n (_:xs)          =  drop (n-1) xs+++splitAt                  :: Int -> [a] -> ([a],[a])+splitAt n xs             =  (take n xs, drop n xs)++-- takeWhile, applied to a predicate p and a list xs, returns the longest+-- prefix (possibly empty) of xs of elements that satisfy p.  dropWhile p xs+-- returns the remaining suffix.  span p xs is equivalent to +-- (takeWhile p xs, dropWhile p xs), while break p uses the negation of p.+++takeWhile               :: (a -> Bool) -> [a] -> [a]+takeWhile p []          =  []+takeWhile p (x:xs) +            | p x       =  x : takeWhile p xs+            | otherwise =  []+++dropWhile               :: (a -> Bool) -> [a] -> [a]+dropWhile p []          =  []+dropWhile p xs@(x:xs')+            | p x       =  dropWhile p xs'+            | otherwise =  xs+++span, break             :: (a -> Bool) -> [a] -> ([a],[a])+span p []            = ([],[])+span p xs@(x:xs') +            | p x       =  (x:ys,zs) +            | otherwise =  ([],xs)+                           where (ys,zs) = span p xs'++break p                 =  span (not . p)++-- lines breaks a string up into a list of strings at newline characters.+-- The resulting strings do not contain newlines.  Similary, words+-- breaks a string up into a list of words, which were delimited by+-- white space.  unlines and unwords are the inverse operations.+-- unlines joins lines with terminating newlines, and unwords joins+-- words with separating spaces.+++lines            :: String -> [String]+lines ""         =  []+lines s          =  let (l, s') = break (== '\n') s+                      in  l : case s' of+                                []      -> []+                                (_:s'') -> lines s''+++words            :: String -> [String]+words s          =  case dropWhile Char.isSpace s of+                      "" -> []+                      s' -> w : words s''+                            where (w, s'') = break Char.isSpace s'+++unlines          :: [String] -> String+unlines          =  concatMap (++ "\n")+++unwords          :: [String] -> String+unwords []       =  ""+unwords ws       =  foldr1 (\w s -> w ++ ' ':s) ws++-- reverse xs returns the elements of xs in reverse order.  xs must be finite.++reverse          :: [a] -> [a]+reverse          =  foldl (flip (:)) []++-- and returns the conjunction of a Boolean list.  For the result to be+-- True, the list must be finite; False, however, results from a False+-- value at a finite index of a finite or infinite list.  or is the+-- disjunctive dual of and.++and, or          :: [Bool] -> Bool+and              =  foldr (&&) True+or               =  foldr (||) False++-- Applied to a predicate and a list, any determines if any element+-- of the list satisfies the predicate.  Similarly, for all.++any, all         :: (a -> Bool) -> [a] -> Bool+any p            =  or . map p+all p            =  and . map p++-- elem is the list membership predicate, usually written in infix form,+-- e.g., x `elem` xs.  notElem is the negation.++elem, notElem    :: (Eq a) => a -> [a] -> Bool+elem x           =  any (== x)+notElem x        =  all (/= x)++-- lookup key assocs looks up a key in an association list.++lookup           :: (Eq a) => a -> [(a,b)] -> Maybe b+lookup key []    =  Nothing+lookup key ((x,y):xys)+    | key == x   =  Just y+    | otherwise  =  lookup key xys++-- sum and product compute the sum or product of a finite list of numbers.++sum, product     :: (Num a) => [a] -> a+sum              =  foldl (+) 0  +product          =  foldl (*) 1++-- maximum and minimum return the maximum or minimum value from a list,+-- which must be non-empty, finite, and of an ordered type.++maximum, minimum :: (Ord a) => [a] -> a+maximum []       =  error "Prelude.maximum: empty list"+maximum xs       =  foldl1 max xs++minimum []       =  error "Prelude.minimum: empty list"+minimum xs       =  foldl1 min xs++-- zip takes two lists and returns a list of corresponding pairs.  If one+-- input list is short, excess elements of the longer list are discarded.+-- zip3 takes three lists and returns a list of triples.  Zips for larger+-- tuples are in the List library+++zip              :: [a] -> [b] -> [(a,b)]+zip              =  zipWith (,)+++zip3             :: [a] -> [b] -> [c] -> [(a,b,c)]+zip3             =  zipWith3 (,,)++-- The zipWith family generalises the zip family by zipping with the+-- function given as the first argument, instead of a tupling function.+-- For example, zipWith (+) is applied to two lists to produce the list+-- of corresponding sums.+++zipWith          :: (a->b->c) -> [a]->[b]->[c]+zipWith z (a:as) (b:bs)+                 =  z a b : zipWith z as bs+zipWith _ _ _    =  []+++zipWith3         :: (a->b->c->d) -> [a]->[b]->[c]->[d]+zipWith3 z (a:as) (b:bs) (c:cs)+                 =  z a b c : zipWith3 z as bs cs+zipWith3 _ _ _ _ =  []+++-- unzip transforms a list of pairs into a pair of lists.  +++unzip            :: [(a,b)] -> ([a],[b])+unzip            =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])+++unzip3           :: [(a,b,c)] -> ([a],[b],[c])+unzip3           =  foldr (\(a,b,c) ~(as,bs,cs) -> (a:as,b:bs,c:cs))+                          ([],[],[])
+ tests/Strictness/BaseVsSpec.hs view
@@ -0,0 +1,391 @@++--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++import Prelude hiding (null)+import Strictness.Utils+import System.IO++import qualified Strictness.Monomorphic.Base     as Test        -- base implementation+import qualified Strictness.Monomorphic.Spec     as Spec        -- H98 spec++--+-- Data.List <=> Spec.List+--++------------------------------------------------------------------------+-- * Basic interface++prop_append     = (Test.++)     `eq2`           (Spec.++)+prop_head       = Test.head     `eq1`           Spec.head+prop_last       = Test.last     `eq1`           Spec.last+prop_tail       = Test.tail     `eq1`           Spec.tail+prop_init       = Test.init     `eq1`           Spec.init+prop_null       = Test.null     `eq1`           Spec.null+prop_length     = Test.length   `eq1`           Spec.length++------------------------------------------------------------------------+-- * List transformations++prop_map                = Test.map              `eq2`   Spec.map+prop_reverse            = Test.reverse          `eq1`   Spec.reverse+prop_intersperse        = Test.intersperse      `eq2`   Spec.intersperse+prop_intercalate        = Test.intercalate      `eq2`   Spec.intercalate+prop_transpose          = Test.transpose        `eq1`   Spec.transpose++------------------------------------------------------------------------+-- * Reducing lists (folds)++prop_foldl      = Test.foldl            `eq3`   Spec.foldl+prop_foldl'     = Test.foldl'           `eq3`   Spec.foldl'+prop_foldl1     = Test.foldl1           `eq2`   Spec.foldl1+prop_foldl1'    = Test.foldl1'          `eq2`   Spec.foldl1'+prop_foldr      = Test.foldr            `eq3`   Spec.foldr+prop_foldr1     = Test.foldr1           `eq2`   Spec.foldr1++------------------------------------------------------------------------+-- ** Special folds++prop_concat     = Test.concat           `eq1`   Spec.concat+prop_concatMap  = Test.concatMap        `eq2`   Spec.concatMap+prop_and        = Test.and              `eq1`   Spec.and+prop_or         = Test.or               `eq1`   Spec.or+prop_any        = Test.any              `eq2`   Spec.any+prop_all        = Test.all              `eq2`   Spec.all+prop_sum        = Test.sum              `eq1`   Spec.sum+prop_product    = Test.product          `eq1`   Spec.product+prop_maximum    = Test.maximum          `eq1`   Spec.maximum+prop_minimum    = Test.minimum          `eq1`   Spec.minimum++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++prop_scanl      = Test.scanl            `eq3`   Spec.scanl+prop_scanl1     = Test.scanl1           `eq2`   Spec.scanl1+prop_scanr      = Test.scanr            `eq3`   Spec.scanr+prop_scanr1     = Test.scanr1           `eq2`   Spec.scanr1++------------------------------------------------------------------------+-- ** Accumulating maps++prop_mapAccumL  = Test.mapAccumL        `eq3`   Spec.mapAccumL+prop_mapAccumR  = Test.mapAccumR        `eq3`   Spec.mapAccumR++------------------------------------------------------------------------+-- ** Infinite lists++prop_iterate    = Test.iterate    `eqfinite2`   Spec.iterate+prop_repeat     = Test.repeat     `eqfinite1`   Spec.repeat+prop_replicate  = Test.replicate  `eqfinite2`   Spec.replicate+prop_cycle      = Test.cycle      `eqfinite1`   Spec.cycle++------------------------------------------------------------------------+-- ** Unfolding++prop_unfoldr    = Test.unfoldr    `eqfinite2`   Spec.unfoldr++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_take       = Test.take             `eq2`   Spec.take+prop_drop       = Test.drop             `eq2`   Spec.drop+prop_splitAt    = Test.splitAt          `eq2`   Spec.splitAt  -- base is stricter than the spec+prop_takeWhile  = Test.takeWhile        `eq2`   Spec.takeWhile+prop_dropWhile  = Test.dropWhile        `eq2`   Spec.dropWhile+prop_span       = Test.span             `eq2`   Spec.span+prop_break      = Test.break            `eq2`   Spec.break+prop_group      = Test.group            `eq1`   Spec.group+prop_inits      = Test.inits            `eq1`   Spec.inits+prop_tails      = Test.tails            `eq1`   Spec.tails++------------------------------------------------------------------------+-- * Predicates++prop_isPrefixOf  = Test.isPrefixOf       `eq2`   Spec.isPrefixOf+prop_isSuffixOf  = Test.isSuffixOf       `eq2`   Spec.isSuffixOf+prop_isInfixOf   = Test.isInfixOf        `eq2`   Spec.isInfixOf++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++prop_elem       = Test.elem             `eq2`   Spec.elem+prop_notElem    = Test.notElem          `eq2`   Spec.notElem+prop_lookup     = Test.lookup           `eq2`   Spec.lookup++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_find       = Test.find             `eq2`   Spec.find+prop_filter     = Test.filter           `eq2`   Spec.filter+prop_partition  = Test.partition        `eq2`   Spec.partition  -- base is stricter than the spec++------------------------------------------------------------------------+-- * Indexing lists++prop_index              = (Test.!!)             `eq2`   (Spec.!!)+prop_elemIndex          = Test.elemIndex        `eq2`   Spec.elemIndex+prop_elemIndices        = Test.elemIndices      `eq2`   Spec.elemIndices+prop_findIndex          = Test.findIndex        `eq2`   Spec.findIndex+prop_findIndices        = Test.findIndices      `eq2`   Spec.findIndices++------------------------------------------------------------------------+-- * Zipping and unzipping lists++prop_zip        = Test.zip              `eq2`   Spec.zip+--prop_zip3       = Test.zip3             `eq3`   Spec.zip3+--prop_zip4       = Test.zip4             `eq4`   Spec.zip4+--prop_zip5       = Test.zip5             `eq5`   Spec.zip5+--prop_zip6       = Test.zip6             `eq6`   Spec.zip6+--prop_zip7       = Test.zip7             `eq7`   Spec.zip7+prop_zipWith    = Test.zipWith          `eq3`   Spec.zipWith+prop_zipWith3   = Test.zipWith3         `eq4`   Spec.zipWith3+prop_zipWith4   = Test.zipWith4         `eq5`   Spec.zipWith4+prop_zipWith5   = Test.zipWith5         `eq6`   Spec.zipWith5+prop_zipWith6   = Test.zipWith6         `eq7`   Spec.zipWith6+prop_zipWith7   = Test.zipWith7         `eq8`   Spec.zipWith7++------------------------------------------------------------------------++prop_unzip      = Test.unzip            `eq1`   Spec.unzip+--prop_unzip3     = Test.unzip3           `eq1`   Spec.unzip3+--prop_unzip4     = Test.unzip4           `eq1`   Spec.unzip4+--prop_unzip5     = Test.unzip5           `eq1`   Spec.unzip5+--prop_unzip6     = Test.unzip6           `eq1`   Spec.unzip6+--prop_unzip7     = Test.unzip7           `eq1`   Spec.unzip7++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings++prop_lines      = Test.lines            `eq1`   Spec.lines+prop_words      = Test.words            `eq1`   Spec.words+prop_unlines    = Test.unlines          `eq1`   Spec.unlines+prop_unwords    = Test.unwords          `eq1`   Spec.unwords++------------------------------------------------------------------------+-- ** \"Set\" operations++prop_nub        = Test.nub              `eq1`   Spec.nub+prop_delete     = Test.delete           `eq2`   Spec.delete+prop_difference = (Test.\\)             `eq2`   (Spec.\\)+prop_union      = Test.union            `eq2`   Spec.union+prop_intersect  = Test.intersect        `eq2`   Spec.intersect++------------------------------------------------------------------------+-- ** Ordered lists ++prop_sort       = Test.sort             `eq1`   Spec.sort+prop_insert     = Test.insert           `eq2`   Spec.insert++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++prop_nubBy              = Test.nubBy            `eq2`   Spec.nubBy+prop_deleteBy           = Test.deleteBy         `eq3`   Spec.deleteBy+prop_deleteFirstsBy     = Test.deleteFirstsBy   `eq3`   Spec.deleteFirstsBy+prop_unionBy            = Test.unionBy          `eq3`   Spec.unionBy+prop_intersectBy        = Test.intersectBy      `eq3`   Spec.intersectBy+prop_groupBy            = Test.groupBy          `eq2`   Spec.groupBy++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++prop_sortBy             = Test.sortBy           `eq2`    Spec.sortBy     --need to generate total orders+prop_insertBy           = Test.insertBy         `eq3`    Spec.insertBy+prop_maximumBy          = Test.maximumBy        `eq2`    Spec.maximumBy+prop_minimumBy          = Test.minimumBy        `eq2`    Spec.minimumBy++------------------------------------------------------------------------+-- * The \"generic\" operations++prop_genericLength      = Test.genericLength    `eq1`    Spec.genericLength+prop_genericTake        = Test.genericTake      `eq2`    Spec.genericTake    -- we disagree with the spec+prop_genericDrop        = Test.genericDrop      `eq2`    Spec.genericDrop+prop_genericSplitAt     = Test.genericSplitAt   `eq2`    Spec.genericSplitAt+prop_genericIndex       = Test.genericIndex     `eq2`    Spec.genericIndex+prop_genericReplicate   = Test.genericReplicate `eqfinite2`    Spec.genericReplicate++------------------------------------------------------------------------++main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Testing Data.List <=> Spec.List"+  putStrLn "===============================\n"++  runTests "Basic interface" opts+    [run prop_append+    ,run prop_head+    ,run prop_last+    ,run prop_tail+    ,run prop_init+    ,run prop_null+    ,run prop_length+    ]++  runTests "List transformations" opts+    [run prop_map+    ,run prop_reverse+    ,run prop_intersperse+    ,run prop_intercalate+    ,run prop_transpose+    ]++  runTests "Reducing lists (folds)" opts+    [run prop_foldl+    ,run prop_foldl'+    ,run prop_foldl1+    ,run prop_foldl1'+    ,run prop_foldr+    ,run prop_foldr1+    ]++  runTests "Special folds" opts+    [run prop_concat+    ,run prop_concatMap+    ,run prop_and+    ,run prop_or+    ,run prop_any+    ,run prop_all+    ,run prop_sum+    ,run prop_product+    ,run prop_maximum+    ,run prop_minimum+    ]++  runTests "Scans" opts+    [run prop_scanl+    ,run prop_scanl1+    ,run prop_scanr+    ,run prop_scanr1+    ]++  runTests "Accumulating maps" opts+    [run prop_mapAccumL+    ,run prop_mapAccumR+    ]++  runTests "Infinite lists" opts+    [run prop_iterate+    ,run prop_repeat+    ,run prop_replicate+    ,run prop_cycle+    ]++  runTests "Unfolding" opts+    [run prop_unfoldr+    ]++  runTests "Extracting sublists" opts+    [run prop_take+    ,run prop_drop+    ,run prop_splitAt+    ,run prop_takeWhile+    ,run prop_dropWhile+    ,run prop_span+    ,run prop_break+    ,run prop_group+    ,run prop_inits+    ,run prop_tails+    ]++  runTests "Predicates" opts+    [run prop_isPrefixOf+    ,run prop_isSuffixOf+    ,run prop_isInfixOf+    ]++  runTests "Searching by equality" opts+    [run prop_elem+    ,run prop_notElem+    ,run prop_lookup+    ]++  runTests "Searching by a predicate" opts+    [run prop_find+    ,run prop_filter+    ,run prop_partition+    ]++  runTests "Indexing lists" opts+    [run prop_index+    ,run prop_elemIndex+    ,run prop_elemIndices+    ,run prop_findIndex+    ,run prop_findIndices+    ]++  runTests "Zipping" opts { testDepth = 6, maxTests = 100000 }+    [run prop_zip+--    ,run prop_zip3+--    ,run prop_zip4+--    ,run prop_zip5+--    ,run prop_zip6+--    ,run prop_zip7+    ,run prop_zipWith+    ,run prop_zipWith3+    ,run prop_zipWith4+    ,run prop_zipWith5+    ,run prop_zipWith6+    ,run prop_zipWith7+    ]++  runTests "Unzipping" opts+    [run prop_unzip+--    ,run prop_unzip3+--    ,run prop_unzip4+--    ,run prop_unzip5+--    ,run prop_unzip6+--    ,run prop_unzip7+    ]++  runTests "Functions on strings" opts+    [run prop_lines+    ,run prop_words+    ,run prop_unlines+    ,run prop_unwords+    ]++  runTests "\"Set\" operations" opts+    [run prop_nub+    ,run prop_delete+    ,run prop_difference+    ,run prop_union+    ,run prop_intersect+    ]++  runTests "Ordered lists" opts+    [run prop_sort+    ,run prop_insert+    ]++  runTests "Eq style \"By\" operations" opts+    [run prop_nubBy+    ,run prop_deleteBy+    ,run prop_deleteFirstsBy+    ,run prop_unionBy+    ,run prop_intersectBy+    ,run prop_groupBy+    ]++  runTests "Ord style \"By\" operations" opts+    [run prop_sortBy        -- note issue here.+    ,run prop_insertBy+    ,run prop_maximumBy+    ,run prop_minimumBy+    ]++  runTests "The \"generic\" operations" opts+    [run prop_genericLength+    ,run prop_genericTake+    ,run prop_genericDrop+    ,run prop_genericSplitAt+    ,run prop_genericIndex+    ,run prop_genericReplicate+    ]
+ tests/Strictness/ListVsBase.hs view
@@ -0,0 +1,400 @@++--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++import Prelude hiding (null)+import Strictness.Utils+import System.IO++import qualified Strictness.Monomorphic.List     as Test        -- our implementation+import qualified Strictness.Monomorphic.Base     as Spec        -- base implementation++--+-- Data.List.Stream <=> Data.List+--++------------------------------------------------------------------------+-- * Basic interface++prop_append     = (Test.++)     `eq2`           (Spec.++)+prop_head       = Test.head     `eq1`           Spec.head+prop_last       = Test.last     `eq1`           Spec.last+prop_tail       = Test.tail     `eq1`           Spec.tail+prop_init       = Test.init     `eq1`           Spec.init+prop_null       = Test.null     `eq1`           Spec.null+prop_length     = Test.length   `eq1`           Spec.length++------------------------------------------------------------------------+-- * List transformations++prop_map                = Test.map              `eq2`   Spec.map+prop_reverse            = Test.reverse          `eq1`   Spec.reverse+prop_intersperse        = Test.intersperse `refines2`   Spec.intersperse+prop_intercalate        = Test.intercalate `refines2`   Spec.intercalate+prop_transpose          = Test.transpose        `eq1`   Spec.transpose++------------------------------------------------------------------------+-- * Reducing lists (folds)++prop_foldl      = Test.foldl            `eq3`   Spec.foldl+prop_foldl'     = Test.foldl'           `eq3`   Spec.foldl'   -- we're stricter than the 'spec'+prop_foldl1     = Test.foldl1           `eq2`   Spec.foldl1+prop_foldl1'    = Test.foldl1'          `eq2`   Spec.foldl1'  -- we're stricter than the 'spec'+prop_foldr      = Test.foldr            `eq3`   Spec.foldr+prop_foldr1     = Test.foldr1           `eq2`   Spec.foldr1++------------------------------------------------------------------------+-- ** Special folds++prop_concat     = Test.concat           `eq1`   Spec.concat+prop_concatMap  = Test.concatMap        `eq2`   Spec.concatMap+prop_and        = Test.and              `eq1`   Spec.and+prop_or         = Test.or               `eq1`   Spec.or+prop_any        = Test.any              `eq2`   Spec.any+prop_all        = Test.all              `eq2`   Spec.all+prop_sum        = Test.sum              `eq1`   Spec.sum+prop_product    = Test.product          `eq1`   Spec.product+prop_maximum    = Test.maximum          `eq1`   Spec.maximum+prop_minimum    = Test.minimum          `eq1`   Spec.minimum++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++prop_scanl      = Test.scanl            `eq3`   Spec.scanl+prop_scanl1     = Test.scanl1           `eq2`   Spec.scanl1+prop_scanr      = Test.scanr            `eq3`   Spec.scanr+prop_scanr1     = Test.scanr1           `eq2`   Spec.scanr1++------------------------------------------------------------------------+-- ** Accumulating maps++prop_mapAccumL  = Test.mapAccumL        `eq3`   Spec.mapAccumL+prop_mapAccumR  = Test.mapAccumR        `eq3`   Spec.mapAccumR++------------------------------------------------------------------------+-- ** Infinite lists++prop_iterate    = Test.iterate    `eqfinite2`   Spec.iterate+prop_repeat     = Test.repeat     `eqfinite1`   Spec.repeat+prop_replicate  = Test.replicate  `eqfinite2`   Spec.replicate+prop_cycle      = Test.cycle      `eqfinite1`   Spec.cycle++------------------------------------------------------------------------+-- ** Unfolding++prop_unfoldr    = Test.unfoldr    `eqfinite2`   Spec.unfoldr++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_take       = Test.take             `eq2`   Spec.take+prop_drop       = Test.drop             `eq2`   Spec.drop+prop_splitAt    = Test.splitAt          `eq2`   Spec.splitAt  -- we're stricter than the spec+prop_takeWhile  = Test.takeWhile        `eq2`   Spec.takeWhile+prop_dropWhile  = Test.dropWhile        `eq2`   Spec.dropWhile+prop_span       = Test.span             `eq2`   Spec.span+prop_break      = Test.break            `eq2`   Spec.break+prop_group      = Test.group            `eq1`   Spec.group+prop_inits      = Test.inits            `eq1`   Spec.inits+prop_tails      = Test.tails            `eq1`   Spec.tails++------------------------------------------------------------------------+-- * Predicates++prop_isPrefixOf  = Test.isPrefixOf       `eq2`   Spec.isPrefixOf+prop_isSuffixOf  = Test.isSuffixOf       `eq2`   Spec.isSuffixOf+prop_isInfixOf   = Test.isInfixOf        `eq2`   Spec.isInfixOf++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++prop_elem       = Test.elem             `eq2`   Spec.elem+prop_notElem    = Test.notElem          `eq2`   Spec.notElem+prop_lookup     = Test.lookup           `eq2`   Spec.lookup++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_find       = Test.find             `eq2`   Spec.find+prop_filter     = Test.filter           `eq2`   Spec.filter+prop_partition  = Test.partition        `eq2`   Spec.partition  -- we're stricter than the spec++------------------------------------------------------------------------+-- * Indexing lists++prop_index              = (Test.!!)             `eq2`   (Spec.!!)+prop_elemIndex          = Test.elemIndex        `eq2`   Spec.elemIndex+prop_elemIndices        = Test.elemIndices      `eq2`   Spec.elemIndices+prop_findIndex          = Test.findIndex        `eq2`   Spec.findIndex+prop_findIndices        = Test.findIndices      `eq2`   Spec.findIndices++------------------------------------------------------------------------+-- * Zipping and unzipping lists++prop_zip        = Test.zip              `eq2`   Spec.zip+--prop_zip3       = Test.zip3             `eq3`   Spec.zip3+--prop_zip4       = Test.zip4             `eq4`   Spec.zip4+--prop_zip5       = Test.zip5             `eq5`   Spec.zip5+--prop_zip6       = Test.zip6             `eq6`   Spec.zip6+--prop_zip7       = Test.zip7             `eq7`   Spec.zip7+prop_zipWith    = Test.zipWith          `eq3`   Spec.zipWith+prop_zipWith3   = Test.zipWith3         `eq4`   Spec.zipWith3+prop_zipWith4   = Test.zipWith4         `eq5`   Spec.zipWith4+prop_zipWith5   = Test.zipWith5         `eq6`   Spec.zipWith5+prop_zipWith6   = Test.zipWith6         `eq7`   Spec.zipWith6+prop_zipWith7   = Test.zipWith7         `eq8`   Spec.zipWith7++------------------------------------------------------------------------++prop_unzip      = Test.unzip            `eq1`   Spec.unzip+--prop_unzip3     = Test.unzip3           `eq1`   Spec.unzip3+--prop_unzip4     = Test.unzip4           `eq1`   Spec.unzip4+--prop_unzip5     = Test.unzip5           `eq1`   Spec.unzip5+--prop_unzip6     = Test.unzip6           `eq1`   Spec.unzip6+--prop_unzip7     = Test.unzip7           `eq1`   Spec.unzip7++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings++prop_lines      = Test.lines            `eq1`   Spec.lines+prop_words      = Test.words            `eq1`   Spec.words+prop_unlines    = Test.unlines          `eq1`   Spec.unlines+prop_unwords    = Test.unwords     `refines1`   Spec.unwords++------------------------------------------------------------------------+-- ** \"Set\" operations++prop_nub        = Test.nub              `eq1`   Spec.nub+prop_delete     = Test.delete           `eq2`   Spec.delete+prop_difference = (Test.\\)             `eq2`   (Spec.\\)+prop_union      = Test.union            `eq2`   Spec.union+prop_intersect  = Test.intersect        `eq2`   Spec.intersect++------------------------------------------------------------------------+-- ** Ordered lists ++prop_sort       = Test.sort             `eq1`   Spec.sort+prop_insert     = Test.insert           `eq2`   Spec.insert++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++prop_nubBy              = Test.nubBy            `eq2`   Spec.nubBy+prop_deleteBy           = Test.deleteBy         `eq3`   Spec.deleteBy+prop_deleteFirstsBy     = Test.deleteFirstsBy   `eq3`   Spec.deleteFirstsBy+prop_unionBy            = Test.unionBy          `eq3`   Spec.unionBy+prop_intersectBy        = Test.intersectBy      `eq3`   Spec.intersectBy+prop_groupBy            = Test.groupBy          `eq2`   Spec.groupBy++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++prop_sortBy             = Test.sortBy           `eq2`    Spec.sortBy     --need to generate total orders+prop_insertBy           = Test.insertBy         `eq3`    Spec.insertBy+prop_maximumBy          = Test.maximumBy        `eq2`    Spec.maximumBy+prop_minimumBy          = Test.minimumBy        `eq2`    Spec.minimumBy++------------------------------------------------------------------------+-- * The \"generic\" operations++prop_genericLength      = Test.genericLength    `eq1`    Spec.genericLength+prop_genericTake        = Test.genericTake      `eq2`    Spec.genericTake    -- we disagree with the spec+prop_genericDrop        = Test.genericDrop      `eq2`    Spec.genericDrop+prop_genericSplitAt     = Test.genericSplitAt   `eq2`    Spec.genericSplitAt+prop_genericIndex       = Test.genericIndex     `eq2`    Spec.genericIndex+prop_genericReplicate   = Test.genericReplicate `eqfinite2`    Spec.genericReplicate++------------------------------------------------------------------------++main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Testing Data.List.Stream <=> Data.List"+  putStrLn "======================================\n"++  runTests "Basic interface" opts+    [run prop_append+    ,run prop_head+    ,run prop_last+    ,run prop_tail+    ,run prop_init+    ,run prop_null+    ,run prop_length+    ]++  runTests "List transformations" opts+    [run prop_map+    ,run prop_reverse+    ,run prop_intersperse+    ,run prop_intercalate+    ,run prop_transpose+    ]++  runTests "Reducing lists (folds)" opts+    [run prop_foldl+    ,run prop_foldl'+    ,run prop_foldl1+    ,run prop_foldl1'+    ,run prop_foldr+    ,run prop_foldr1+    ]++  runTests "Special folds" opts+    [run prop_concat+    ,run prop_concatMap+    ,run prop_and+    ,run prop_or+    ,run prop_any+    ,run prop_all+    ,run prop_sum+    ,run prop_product+    ,run prop_maximum+    ,run prop_minimum+    ]++  runTests "Scans" opts+    [run prop_scanl+    ,run prop_scanl1+    ,run prop_scanr+    ,run prop_scanr1+    ]++  runTests "Accumulating maps" opts+    [run prop_mapAccumL+    ,run prop_mapAccumR+    ]++  runTests "Infinite lists" opts+    [run prop_iterate+    ,run prop_repeat+    ,run prop_replicate+    ,run prop_cycle+    ]++  runTests "Unfolding" opts+    [run prop_unfoldr+    ]++  runTests "Extracting sublists" opts+    [run prop_take+    ,run prop_drop+    ,run prop_splitAt+    ,run prop_takeWhile+    ,run prop_dropWhile+    ,run prop_span+    ,run prop_break+    ,run prop_group+    ,run prop_inits+    ,run prop_tails+    ]++  runTests "Predicates" opts+    [run prop_isPrefixOf+    ,run prop_isSuffixOf+    ,run prop_isInfixOf+    ]++  runTests "Searching by equality" opts+    [run prop_elem+    ,run prop_notElem+    ,run prop_lookup+    ]++  runTests "Searching by a predicate" opts+    [run prop_find+    ,run prop_filter+    ,run prop_partition+    ]++  runTests "Indexing lists" opts+    [run prop_index+    ,run prop_elemIndex+    ,run prop_elemIndices+    ,run prop_findIndex+    ,run prop_findIndices+    ]++  runTests "Zipping" opts { testDepth = 6, maxTests = 100000 }+    [run prop_zip+--    ,run prop_zip3+--    ,run prop_zip4+--    ,run prop_zip5+--    ,run prop_zip6+--    ,run prop_zip7+    ,run prop_zipWith+    ,run prop_zipWith3+    ,run prop_zipWith4+    ,run prop_zipWith5+    ,run prop_zipWith6+    ,run prop_zipWith7+    ]++  runTests "Unzipping" opts+    [run prop_unzip+--    ,run prop_unzip3+--    ,run prop_unzip4+--    ,run prop_unzip5+--    ,run prop_unzip6+--    ,run prop_unzip7+    ]++  runTests "Functions on strings" opts+    [run prop_lines+    ,run prop_words+    ,run prop_unlines+    ,run prop_unwords+    ]++  runTests "\"Set\" operations" opts+    [run prop_nub+    ,run prop_delete+    ,run prop_difference+    ,run prop_union+    ,run prop_intersect+    ]++  runTests "Ordered lists" opts+    [run prop_sort+    ,run prop_insert+    ]++  runTests "Eq style \"By\" operations" opts+    [run prop_nubBy+    ,run prop_deleteBy+    ,run prop_deleteFirstsBy+    ,run prop_unionBy+    ,run prop_intersectBy+    ,run prop_groupBy+    ]++  runTests "Ord style \"By\" operations" opts+    [run prop_sortBy        -- note issue here.+    ,run prop_insertBy+    ,run prop_maximumBy+    ,run prop_minimumBy+    ]++  runTests "The \"generic\" operations" opts+    [run prop_genericLength+    ,run prop_genericTake+    ,run prop_genericDrop+    ,run prop_genericSplitAt+    ,run prop_genericIndex+    ,run prop_genericReplicate+    ]+{-+run :: Testable a => a -> Int -> IO ()+run = flip depthCheck++runTests :: String -> [Int -> IO ()] -> IO ()+runTests name tests = do+  putStrLn name+  mapM_ ($ 6) tests+-}
+ tests/Strictness/ListVsSpec.hs view
@@ -0,0 +1,400 @@++--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++import Prelude hiding (null)+import Strictness.Utils+import System.IO++import qualified Strictness.Monomorphic.List     as Test        -- our implementation+import qualified Strictness.Monomorphic.Spec     as Spec        -- H98 spec++--+-- Data.List.Stream <=> Spec.List+--++------------------------------------------------------------------------+-- * Basic interface++prop_append     = (Test.++)     `eq2`           (Spec.++)+prop_head       = Test.head     `eq1`           Spec.head+prop_last       = Test.last     `eq1`           Spec.last+prop_tail       = Test.tail     `eq1`           Spec.tail+prop_init       = Test.init     `eq1`           Spec.init+prop_null       = Test.null     `eq1`           Spec.null+prop_length     = Test.length   `eq1`           Spec.length++------------------------------------------------------------------------+-- * List transformations++prop_map                = Test.map              `eq2`   Spec.map+prop_reverse            = Test.reverse          `eq1`   Spec.reverse+prop_intersperse        = Test.intersperse `refines2`   Spec.intersperse+prop_intercalate        = Test.intercalate `refines2`   Spec.intercalate+prop_transpose          = Test.transpose        `eq1`   Spec.transpose++------------------------------------------------------------------------+-- * Reducing lists (folds)++prop_foldl      = Test.foldl            `eq3`   Spec.foldl+prop_foldl'     = Test.foldl'           `eq3`   Spec.foldl'   -- we're stricter than the 'spec'+prop_foldl1     = Test.foldl1           `eq2`   Spec.foldl1+prop_foldl1'    = Test.foldl1'          `eq2`   Spec.foldl1'  -- we're stricter than the 'spec'+prop_foldr      = Test.foldr            `eq3`   Spec.foldr+prop_foldr1     = Test.foldr1           `eq2`   Spec.foldr1++------------------------------------------------------------------------+-- ** Special folds++prop_concat     = Test.concat           `eq1`   Spec.concat+prop_concatMap  = Test.concatMap        `eq2`   Spec.concatMap+prop_and        = Test.and              `eq1`   Spec.and+prop_or         = Test.or               `eq1`   Spec.or+prop_any        = Test.any              `eq2`   Spec.any+prop_all        = Test.all              `eq2`   Spec.all+prop_sum        = Test.sum              `eq1`   Spec.sum+prop_product    = Test.product          `eq1`   Spec.product+prop_maximum    = Test.maximum          `eq1`   Spec.maximum+prop_minimum    = Test.minimum          `eq1`   Spec.minimum++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++prop_scanl      = Test.scanl            `eq3`   Spec.scanl+prop_scanl1     = Test.scanl1           `eq2`   Spec.scanl1+prop_scanr      = Test.scanr            `eq3`   Spec.scanr+prop_scanr1     = Test.scanr1           `eq2`   Spec.scanr1++------------------------------------------------------------------------+-- ** Accumulating maps++prop_mapAccumL  = Test.mapAccumL        `eq3`   Spec.mapAccumL+prop_mapAccumR  = Test.mapAccumR        `eq3`   Spec.mapAccumR++------------------------------------------------------------------------+-- ** Infinite lists++prop_iterate    = Test.iterate    `eqfinite2`   Spec.iterate+prop_repeat     = Test.repeat     `eqfinite1`   Spec.repeat+prop_replicate  = Test.replicate  `eqfinite2`   Spec.replicate+prop_cycle      = Test.cycle      `eqfinite1`   Spec.cycle++------------------------------------------------------------------------+-- ** Unfolding++prop_unfoldr    = Test.unfoldr    `eqfinite2`   Spec.unfoldr++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_take       = Test.take             `eq2`   Spec.take+prop_drop       = Test.drop             `eq2`   Spec.drop+prop_splitAt    = Test.splitAt          `eq2`   Spec.splitAt  -- we're stricter than the spec+prop_takeWhile  = Test.takeWhile        `eq2`   Spec.takeWhile+prop_dropWhile  = Test.dropWhile        `eq2`   Spec.dropWhile+prop_span       = Test.span             `eq2`   Spec.span+prop_break      = Test.break            `eq2`   Spec.break+prop_group      = Test.group            `eq1`   Spec.group+prop_inits      = Test.inits            `eq1`   Spec.inits+prop_tails      = Test.tails            `eq1`   Spec.tails++------------------------------------------------------------------------+-- * Predicates++prop_isPrefixOf  = Test.isPrefixOf       `eq2`   Spec.isPrefixOf+prop_isSuffixOf  = Test.isSuffixOf       `eq2`   Spec.isSuffixOf+prop_isInfixOf   = Test.isInfixOf        `eq2`   Spec.isInfixOf++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++prop_elem       = Test.elem             `eq2`   Spec.elem+prop_notElem    = Test.notElem          `eq2`   Spec.notElem+prop_lookup     = Test.lookup           `eq2`   Spec.lookup++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_find       = Test.find             `eq2`   Spec.find+prop_filter     = Test.filter           `eq2`   Spec.filter+prop_partition  = Test.partition        `eq2`   Spec.partition  -- we're stricter than the spec++------------------------------------------------------------------------+-- * Indexing lists++prop_index              = (Test.!!)             `eq2`   (Spec.!!)+prop_elemIndex          = Test.elemIndex        `eq2`   Spec.elemIndex+prop_elemIndices        = Test.elemIndices      `eq2`   Spec.elemIndices+prop_findIndex          = Test.findIndex        `eq2`   Spec.findIndex+prop_findIndices        = Test.findIndices      `eq2`   Spec.findIndices++------------------------------------------------------------------------+-- * Zipping and unzipping lists++prop_zip        = Test.zip              `eq2`   Spec.zip+--prop_zip3       = Test.zip3             `eq3`   Spec.zip3+--prop_zip4       = Test.zip4             `eq4`   Spec.zip4+--prop_zip5       = Test.zip5             `eq5`   Spec.zip5+--prop_zip6       = Test.zip6             `eq6`   Spec.zip6+--prop_zip7       = Test.zip7             `eq7`   Spec.zip7+prop_zipWith    = Test.zipWith          `eq3`   Spec.zipWith+prop_zipWith3   = Test.zipWith3         `eq4`   Spec.zipWith3+prop_zipWith4   = Test.zipWith4         `eq5`   Spec.zipWith4+prop_zipWith5   = Test.zipWith5         `eq6`   Spec.zipWith5+prop_zipWith6   = Test.zipWith6         `eq7`   Spec.zipWith6+prop_zipWith7   = Test.zipWith7         `eq8`   Spec.zipWith7++------------------------------------------------------------------------++prop_unzip      = Test.unzip            `eq1`   Spec.unzip+--prop_unzip3     = Test.unzip3           `eq1`   Spec.unzip3+--prop_unzip4     = Test.unzip4           `eq1`   Spec.unzip4+--prop_unzip5     = Test.unzip5           `eq1`   Spec.unzip5+--prop_unzip6     = Test.unzip6           `eq1`   Spec.unzip6+--prop_unzip7     = Test.unzip7           `eq1`   Spec.unzip7++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings++prop_lines      = Test.lines            `eq1`   Spec.lines+prop_words      = Test.words            `eq1`   Spec.words+prop_unlines    = Test.unlines          `eq1`   Spec.unlines+prop_unwords    = Test.unwords     `refines1`   Spec.unwords++------------------------------------------------------------------------+-- ** \"Set\" operations++prop_nub        = Test.nub              `eq1`   Spec.nub+prop_delete     = Test.delete           `eq2`   Spec.delete+prop_difference = (Test.\\)             `eq2`   (Spec.\\)+prop_union      = Test.union            `eq2`   Spec.union+prop_intersect  = Test.intersect        `eq2`   Spec.intersect++------------------------------------------------------------------------+-- ** Ordered lists ++prop_sort       = Test.sort             `eq1`   Spec.sort+prop_insert     = Test.insert           `eq2`   Spec.insert++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++prop_nubBy              = Test.nubBy            `eq2`   Spec.nubBy+prop_deleteBy           = Test.deleteBy         `eq3`   Spec.deleteBy+prop_deleteFirstsBy     = Test.deleteFirstsBy   `eq3`   Spec.deleteFirstsBy+prop_unionBy            = Test.unionBy          `eq3`   Spec.unionBy+prop_intersectBy        = Test.intersectBy      `eq3`   Spec.intersectBy+prop_groupBy            = Test.groupBy          `eq2`   Spec.groupBy++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++prop_sortBy             = Test.sortBy           `eq2`    Spec.sortBy     --need to generate total orders+prop_insertBy           = Test.insertBy         `eq3`    Spec.insertBy+prop_maximumBy          = Test.maximumBy        `eq2`    Spec.maximumBy+prop_minimumBy          = Test.minimumBy        `eq2`    Spec.minimumBy++------------------------------------------------------------------------+-- * The \"generic\" operations++prop_genericLength      = Test.genericLength    `eq1`    Spec.genericLength+prop_genericTake        = Test.genericTake      `eq2`    Spec.genericTake    -- we disagree with the spec+prop_genericDrop        = Test.genericDrop      `eq2`    Spec.genericDrop+prop_genericSplitAt     = Test.genericSplitAt   `eq2`    Spec.genericSplitAt+prop_genericIndex       = Test.genericIndex     `eq2`    Spec.genericIndex+prop_genericReplicate   = Test.genericReplicate `eqfinite2`    Spec.genericReplicate++------------------------------------------------------------------------++main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Testing Data.List.Stream <=> Spec.List"+  putStrLn "======================================\n"++  runTests "Basic interface" opts+    [run prop_append+    ,run prop_head+    ,run prop_last+    ,run prop_tail+    ,run prop_init+    ,run prop_null+    ,run prop_length+    ]++  runTests "List transformations" opts+    [run prop_map+    ,run prop_reverse+    ,run prop_intersperse+    ,run prop_intercalate+    ,run prop_transpose+    ]++  runTests "Reducing lists (folds)" opts+    [run prop_foldl+    ,run prop_foldl'+    ,run prop_foldl1+    ,run prop_foldl1'+    ,run prop_foldr+    ,run prop_foldr1+    ]++  runTests "Special folds" opts+    [run prop_concat+    ,run prop_concatMap+    ,run prop_and+    ,run prop_or+    ,run prop_any+    ,run prop_all+    ,run prop_sum+    ,run prop_product+    ,run prop_maximum+    ,run prop_minimum+    ]++  runTests "Scans" opts+    [run prop_scanl+    ,run prop_scanl1+    ,run prop_scanr+    ,run prop_scanr1+    ]++  runTests "Accumulating maps" opts+    [run prop_mapAccumL+    ,run prop_mapAccumR+    ]++  runTests "Infinite lists" opts+    [run prop_iterate+    ,run prop_repeat+    ,run prop_replicate+    ,run prop_cycle+    ]++  runTests "Unfolding" opts+    [run prop_unfoldr+    ]++  runTests "Extracting sublists" opts+    [run prop_take+    ,run prop_drop+    ,run prop_splitAt+    ,run prop_takeWhile+    ,run prop_dropWhile+    ,run prop_span+    ,run prop_break+    ,run prop_group+    ,run prop_inits+    ,run prop_tails+    ]++  runTests "Predicates" opts+    [run prop_isPrefixOf+    ,run prop_isSuffixOf+    ,run prop_isInfixOf+    ]++  runTests "Searching by equality" opts+    [run prop_elem+    ,run prop_notElem+    ,run prop_lookup+    ]++  runTests "Searching by a predicate" opts+    [run prop_find+    ,run prop_filter+    ,run prop_partition+    ]++  runTests "Indexing lists" opts+    [run prop_index+    ,run prop_elemIndex+    ,run prop_elemIndices+    ,run prop_findIndex+    ,run prop_findIndices+    ]++  runTests "Zipping" opts { testDepth = 6, maxTests = 100000 }+    [run prop_zip+--    ,run prop_zip3+--    ,run prop_zip4+--    ,run prop_zip5+--    ,run prop_zip6+--    ,run prop_zip7+    ,run prop_zipWith+    ,run prop_zipWith3+    ,run prop_zipWith4+    ,run prop_zipWith5+    ,run prop_zipWith6+    ,run prop_zipWith7+    ]++  runTests "Unzipping" opts+    [run prop_unzip+--    ,run prop_unzip3+--    ,run prop_unzip4+--    ,run prop_unzip5+--    ,run prop_unzip6+--    ,run prop_unzip7+    ]++  runTests "Functions on strings" opts+    [run prop_lines+    ,run prop_words+    ,run prop_unlines+    ,run prop_unwords+    ]++  runTests "\"Set\" operations" opts+    [run prop_nub+    ,run prop_delete+    ,run prop_difference+    ,run prop_union+    ,run prop_intersect+    ]++  runTests "Ordered lists" opts+    [run prop_sort+    ,run prop_insert+    ]++  runTests "Eq style \"By\" operations" opts+    [run prop_nubBy+    ,run prop_deleteBy+    ,run prop_deleteFirstsBy+    ,run prop_unionBy+    ,run prop_intersectBy+    ,run prop_groupBy+    ]++  runTests "Ord style \"By\" operations" opts+    [run prop_sortBy        -- note issue here.+    ,run prop_insertBy+    ,run prop_maximumBy+    ,run prop_minimumBy+    ]++  runTests "The \"generic\" operations" opts+    [run prop_genericLength+    ,run prop_genericTake+    ,run prop_genericDrop+    ,run prop_genericSplitAt+    ,run prop_genericIndex+    ,run prop_genericReplicate+    ]+{-+run :: Testable a => a -> Int -> IO ()+run = flip depthCheck++runTests :: String -> [Int -> IO ()] -> IO ()+runTests name tests = do+  putStrLn name+  mapM_ ($ 6) tests+-}
+ tests/Strictness/Monomorphic/Base.hs view
@@ -0,0 +1,321 @@+--+-- The Data.List api+--+module Strictness.Monomorphic.Base where++import Strictness.Utils++import qualified Data.List as Spec++-- * Basic interface+(++)            :: [A] -> [A] -> [A]+head            :: [A] -> A+last            :: [A] -> A+tail            :: [A] -> [A]+init            :: [A] -> [A]+null            :: [A] -> Bool+length          :: [A] -> Int++-- * List transformations+map             :: (A -> B) -> [A] -> [B]+reverse         :: [A] -> [A]+intersperse     :: A -> [A] -> [A]+intercalate     :: [A] -> [[A]] -> [A]+transpose       :: [[A]] -> [[A]]++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> [A] -> B+foldl'          :: (B -> A -> B) -> B -> [A] -> B+foldl1          :: (A -> A -> A) -> [A] -> A+foldl1'         :: (A -> A -> A) -> [A] -> A+foldr           :: (A -> B -> B) -> B -> [A] -> B+foldr1          :: (A -> A -> A) -> [A] -> A++-- ** Special folds+concat          :: [[A]] -> [A]+concatMap       :: (A -> [B]) -> [A] -> [B]+and             :: [Bool] -> Bool+or              :: [Bool] -> Bool+any             :: (A -> Bool) -> [A] -> Bool+all             :: (A -> Bool) -> [A] -> Bool+sum             :: [N] -> N+product         :: [N] -> N+maximum         :: [OrdA] -> OrdA+minimum         :: [OrdA] -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> [B] -> [A]+scanl1          :: (A -> A -> A) -> [A] -> [A]+scanr           :: (A -> B -> B) -> B -> [A] -> [B]+scanr1          :: (A -> A -> A) -> [A] -> [A]++-- ** Accumulating maps+mapAccumL       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+mapAccumR       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])++-- ** Infinite lists+iterate         :: (A -> A) -> A -> [A]+repeat          :: A -> [A]+replicate       :: Int -> A -> [A]+cycle           :: [A] -> [A]++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> [A]++-- * Sublists+-- ** Extracting sublists+take            :: Int -> [A] -> [A]+drop            :: Int -> [A] -> [A]+splitAt         :: Int -> [A] -> ([A], [A])+takeWhile       :: (A -> Bool) -> [A] -> [A]+dropWhile       :: (A -> Bool) -> [A] -> [A]+span            :: (A -> Bool) -> [A] -> ([A], [A])+break           :: (A -> Bool) -> [A] -> ([A], [A])+group           :: [A] -> [[A]]+inits           :: [A] -> [[A]]+tails           :: [A] -> [[A]]++-- * Predicates+isPrefixOf      :: [A] -> [A] -> Bool+isSuffixOf      :: [A] -> [A] -> Bool+isInfixOf       :: [A] -> [A] -> Bool++-- * Searching lists+-- ** Searching by equality+elem            :: A -> [A] -> Bool+notElem         :: A -> [A] -> Bool+lookup          :: A -> [(A, B)] -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> [A] -> Maybe A+filter          :: (A -> Bool) -> [A] -> [A]+partition       :: (A -> Bool) -> [A] -> ([A], [A])++-- * Indexing lists+(!!)            :: [A] -> Int -> A+elemIndex       :: A -> [A] -> Maybe Int+elemIndices     :: A -> [A] -> [Int]+findIndex       :: (A -> Bool) -> [A] -> Maybe Int+findIndices     :: (A -> Bool) -> [A] -> [Int]++-- * Zipping and unzipping lists+zip             :: [A] -> [B] -> [(A, B)]+zip3            :: [A] -> [B] -> [C] -> [(A, B, C)]+zip4            :: [A] -> [B] -> [C] -> [D] -> [(A, B, C, D)]+zip5            :: [A] -> [B] -> [C] -> [D] -> [E] -> [(A, B, C, D, E)]+zip6            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [(A, B, C, D, E, F)]+zip7            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [(A, B, C, D, E, F, G)]+zipWith         :: (A -> B -> C) -> [A] -> [B] -> [C]+zipWith3        :: (A -> B -> C -> D) -> [A] -> [B] -> [C] -> [D]+zipWith4        :: (A -> B -> C -> D -> E) -> [A] -> [B] -> [C] -> [D] -> [E]+zipWith5        :: (A -> B -> C -> D -> E -> F) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F]+zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G]+zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [H]+unzip           :: [(A, B)] -> ([A], [B])+unzip3          :: [(A, B, C)] -> ([A], [B], [C])+unzip4          :: [(A, B, C, D)] -> ([A], [B], [C], [D])+unzip5          :: [(A, B, C, D, E)] -> ([A], [B], [C], [D], [E])+unzip6          :: [(A, B, C, D, E, F)] -> ([A], [B], [C], [D], [E], [F])+unzip7          :: [(A, B, C, D, E, F, G)] -> ([A], [B], [C], [D], [E], [F], [G])++-- * Special lists+-- ** Functions on strings+lines           :: String -> [String]+words           :: String -> [String]+unlines         :: [String] -> String+unwords         :: [String] -> String++-- ** \"Set\" operations+nub             :: [A] -> [A]+delete          :: A -> [A] -> [A]+(\\)            :: [A] -> [A] -> [A]+union           :: [A] -> [A] -> [A]+intersect       :: [A] -> [A] -> [A]++-- ** Ordered lists +sort            :: [OrdA] -> [OrdA]+insert          :: OrdA -> [OrdA] -> [OrdA]++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (A -> A -> Bool) -> [A] -> [A]+deleteBy        :: (A -> A -> Bool) -> A -> [A] -> [A]+deleteFirstsBy  :: (A -> A -> Bool) -> [A] -> [A] -> [A]+unionBy         :: (A -> A -> Bool) -> [A] -> [A] -> [A]+intersectBy     :: (A -> A -> Bool) -> [A] -> [A] -> [A]+groupBy         :: (A -> A -> Bool) -> [A] -> [[A]]++-- *** User-supplied comparison (replacing an Ord context)+sortBy          :: (A -> A -> Ordering) -> [A] -> [A]+insertBy        :: (A -> A -> Ordering) -> A -> [A] -> [A]+maximumBy       :: (A -> A -> Ordering) -> [A] -> A+minimumBy       :: (A -> A -> Ordering) -> [A] -> A++-- * The \"generic\" operations+genericLength           :: [A] -> I+genericTake             :: I -> [A] -> [A]+genericDrop             :: I -> [A] -> [A]+genericSplitAt          :: I -> [A] -> ([A], [A])+genericIndex            :: [A] -> I -> A+genericReplicate        :: I -> A -> [A]++++-- * Basic interface+(++)            = (Spec.++)+head            = Spec.head+last            = Spec.last+tail            = Spec.tail+init            = Spec.init+null            = Spec.null+length          = Spec.length++-- * List transformations+map             = Spec.map+reverse         = Spec.reverse+intersperse     = Spec.intersperse++-- intercalate     = -- Spec.intercalate+intercalate xs xss = Spec.concat (Spec.intersperse xs xss)++transpose       = Spec.transpose++-- * Reducing lists (folds)+foldl           = Spec.foldl+foldl'          = Spec.foldl'+foldl1          = Spec.foldl1+foldl1'         = Spec.foldl1'+foldr           = Spec.foldr+foldr1          = Spec.foldr1++-- ** Special folds+concat          = Spec.concat+concatMap       = Spec.concatMap+and             = Spec.and+or              = Spec.or+any             = Spec.any+all             = Spec.all+sum             = Spec.sum+product         = Spec.product+maximum         = Spec.maximum+minimum         = Spec.minimum++-- * Building lists+-- ** Scans+scanl           = Spec.scanl+scanl1          = Spec.scanl1+scanr           = Spec.scanr+scanr1          = Spec.scanr1++-- ** Accumulating maps+mapAccumL       = Spec.mapAccumL+mapAccumR       = Spec.mapAccumR++-- ** Infinite lists+iterate         = Spec.iterate+repeat          = Spec.repeat+replicate       = Spec.replicate+cycle           = Spec.cycle++-- ** Unfolding+unfoldr         = Spec.unfoldr++-- * Sublists+-- ** Extracting sublists+take            = Spec.take+drop            = Spec.drop+splitAt         = Spec.splitAt+takeWhile       = Spec.takeWhile+dropWhile       = Spec.dropWhile+span            = Spec.span+break           = Spec.break+group           = Spec.group+inits           = Spec.inits+tails           = Spec.tails++-- * Predicates+isPrefixOf      = Spec.isPrefixOf+isSuffixOf      = Spec.isSuffixOf+isInfixOf       = Spec.isInfixOf++-- * Searching lists+-- ** Searching by equality+elem            = Spec.elem+notElem         = Spec.notElem+lookup          = Spec.lookup++-- ** Searching with a predicate+find            = Spec.find+filter          = Spec.filter+partition       = Spec.partition++-- * Indexing lists+(!!)            = (Spec.!!)+elemIndex       = Spec.elemIndex+elemIndices     = Spec.elemIndices+findIndex       = Spec.findIndex+findIndices     = Spec.findIndices++-- * Zipping and unzipping lists+zip             = Spec.zip+zip3            = Spec.zip3+zip4            = Spec.zip4+zip5            = Spec.zip5+zip6            = Spec.zip6+zip7            = Spec.zip7+zipWith         = Spec.zipWith+zipWith3        = Spec.zipWith3+zipWith4        = Spec.zipWith4+zipWith5        = Spec.zipWith5+zipWith6        = Spec.zipWith6+zipWith7        = Spec.zipWith7+unzip           = Spec.unzip+unzip3          = Spec.unzip3+unzip4          = Spec.unzip4+unzip5          = Spec.unzip5+unzip6          = Spec.unzip6+unzip7          = Spec.unzip7++-- * Special lists+-- ** Functions on strings+lines           = Spec.lines+words           = Spec.words+unlines         = Spec.unlines+unwords         = Spec.unwords++-- ** \"Set\" operations+nub             = Spec.nub+delete          = Spec.delete+(\\)            = (Spec.\\)+union           = Spec.union+intersect       = Spec.intersect++-- ** Ordered lists +sort            = Spec.sort+insert          = Spec.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = Spec.nubBy+deleteBy        = Spec.deleteBy+deleteFirstsBy  = Spec.deleteFirstsBy+unionBy         = Spec.unionBy+intersectBy     = Spec.intersectBy+groupBy         = Spec.groupBy++-- *** User-supplied comparison (replacing an Ord context)+sortBy          = Spec.sortBy+insertBy        = Spec.insertBy+maximumBy       = Spec.maximumBy+minimumBy       = Spec.minimumBy++-- * The \"generic\" operations+genericLength           = Spec.genericLength+genericTake             = Spec.genericTake+genericDrop             = Spec.genericDrop+genericSplitAt          = Spec.genericSplitAt+genericIndex            = Spec.genericIndex+genericReplicate        = Spec.genericReplicate
+ tests/Strictness/Monomorphic/List.hs view
@@ -0,0 +1,319 @@+module Strictness.Monomorphic.List where++--+-- just test the List api+--++import Strictness.Utils++import qualified Data.List.Stream as List++-- * Basic interface+(++)            :: [A] -> [A] -> [A]+head            :: [A] -> A+last            :: [A] -> A+tail            :: [A] -> [A]+init            :: [A] -> [A]+null            :: [A] -> Bool+length          :: [A] -> Int++-- * List transformations+map             :: (A -> B) -> [A] -> [B]+reverse         :: [A] -> [A]+intersperse     :: A -> [A] -> [A]+intercalate     :: [A] -> [[A]] -> [A]+transpose       :: [[A]] -> [[A]]++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> [A] -> B+foldl'          :: (B -> A -> B) -> B -> [A] -> B+foldl1          :: (A -> A -> A) -> [A] -> A+foldl1'         :: (A -> A -> A) -> [A] -> A+foldr           :: (A -> B -> B) -> B -> [A] -> B+foldr1          :: (A -> A -> A) -> [A] -> A++-- ** Special folds+concat          :: [[A]] -> [A]+concatMap       :: (A -> [B]) -> [A] -> [B]+and             :: [Bool] -> Bool+or              :: [Bool] -> Bool+any             :: (A -> Bool) -> [A] -> Bool+all             :: (A -> Bool) -> [A] -> Bool+sum             :: [N] -> N+product         :: [N] -> N+maximum         :: [OrdA] -> OrdA+minimum         :: [OrdA] -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> [B] -> [A]+scanl1          :: (A -> A -> A) -> [A] -> [A]+scanr           :: (A -> B -> B) -> B -> [A] -> [B]+scanr1          :: (A -> A -> A) -> [A] -> [A]++-- ** Accumulating maps+mapAccumL       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+mapAccumR       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])++-- ** Infinite lists+iterate         :: (A -> A) -> A -> [A]+repeat          :: A -> [A]+replicate       :: Int -> A -> [A]+cycle           :: [A] -> [A]++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> [A]++-- * Sublists+-- ** Extracting sublists+take            :: Int -> [A] -> [A]+drop            :: Int -> [A] -> [A]+splitAt         :: Int -> [A] -> ([A], [A])+takeWhile       :: (A -> Bool) -> [A] -> [A]+dropWhile       :: (A -> Bool) -> [A] -> [A]+span            :: (A -> Bool) -> [A] -> ([A], [A])+break           :: (A -> Bool) -> [A] -> ([A], [A])+group           :: [A] -> [[A]]+inits           :: [A] -> [[A]]+tails           :: [A] -> [[A]]++-- * Predicates+isPrefixOf      :: [A] -> [A] -> Bool+isSuffixOf      :: [A] -> [A] -> Bool+isInfixOf       :: [A] -> [A] -> Bool++-- * Searching lists+-- ** Searching by equality+elem            :: A -> [A] -> Bool+notElem         :: A -> [A] -> Bool+lookup          :: A -> [(A, B)] -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> [A] -> Maybe A+filter          :: (A -> Bool) -> [A] -> [A]+partition       :: (A -> Bool) -> [A] -> ([A], [A])++-- * Indexing lists+(!!)            :: [A] -> Int -> A+elemIndex       :: A -> [A] -> Maybe Int+elemIndices     :: A -> [A] -> [Int]+findIndex       :: (A -> Bool) -> [A] -> Maybe Int+findIndices     :: (A -> Bool) -> [A] -> [Int]++-- * Zipping and unzipping lists+zip             :: [A] -> [B] -> [(A, B)]+zip3            :: [A] -> [B] -> [C] -> [(A, B, C)]+zip4            :: [A] -> [B] -> [C] -> [D] -> [(A, B, C, D)]+zip5            :: [A] -> [B] -> [C] -> [D] -> [E] -> [(A, B, C, D, E)]+zip6            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [(A, B, C, D, E, F)]+zip7            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [(A, B, C, D, E, F, G)]+zipWith         :: (A -> B -> C) -> [A] -> [B] -> [C]+zipWith3        :: (A -> B -> C -> D) -> [A] -> [B] -> [C] -> [D]+zipWith4        :: (A -> B -> C -> D -> E) -> [A] -> [B] -> [C] -> [D] -> [E]+zipWith5        :: (A -> B -> C -> D -> E -> F) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F]+zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G]+zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [H]+unzip           :: [(A, B)] -> ([A], [B])+unzip3          :: [(A, B, C)] -> ([A], [B], [C])+unzip4          :: [(A, B, C, D)] -> ([A], [B], [C], [D])+unzip5          :: [(A, B, C, D, E)] -> ([A], [B], [C], [D], [E])+unzip6          :: [(A, B, C, D, E, F)] -> ([A], [B], [C], [D], [E], [F])+unzip7          :: [(A, B, C, D, E, F, G)] -> ([A], [B], [C], [D], [E], [F], [G])++-- * Special lists+-- ** Functions on strings+lines           :: String -> [String]+words           :: String -> [String]+unlines         :: [String] -> String+unwords         :: [String] -> String++-- ** \"Set\" operations+nub             :: [A] -> [A]+delete          :: A -> [A] -> [A]+(\\)            :: [A] -> [A] -> [A]+union           :: [A] -> [A] -> [A]+intersect       :: [A] -> [A] -> [A]++-- ** Ordered lists +sort            :: [OrdA] -> [OrdA]+insert          :: OrdA -> [OrdA] -> [OrdA]++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (A -> A -> Bool) -> [A] -> [A]+deleteBy        :: (A -> A -> Bool) -> A -> [A] -> [A]+deleteFirstsBy  :: (A -> A -> Bool) -> [A] -> [A] -> [A]+unionBy         :: (A -> A -> Bool) -> [A] -> [A] -> [A]+intersectBy     :: (A -> A -> Bool) -> [A] -> [A] -> [A]+groupBy         :: (A -> A -> Bool) -> [A] -> [[A]]++-- *** User-supplied comparison (replacing an Ord context)+sortBy          :: (A -> A -> Ordering) -> [A] -> [A]       --fixme: need to use Bool domain for order+insertBy        :: (A -> A -> Ordering) -> A -> [A] -> [A]+maximumBy       :: (A -> A -> Ordering) -> [A] -> A+minimumBy       :: (A -> A -> Ordering) -> [A] -> A++-- * The \"generic\" operations+genericLength           :: [A] -> I+genericTake             :: I -> [A] -> [A]+genericDrop             :: I -> [A] -> [A]+genericSplitAt          :: I -> [A] -> ([A], [A])+genericIndex            :: [A] -> I -> A+genericReplicate        :: I -> A -> [A]++++-- * Basic interface+(++)            = (List.++)+head            = List.head+last            = List.last+tail            = List.tail+init            = List.init+null            = List.null+length          = List.length++-- * List transformations+map             = List.map+reverse         = List.reverse+intersperse     = List.intersperse+intercalate     = List.intercalate+transpose       = List.transpose++-- * Reducing lists (folds)+foldl           = List.foldl+foldl'          = List.foldl'+foldl1          = List.foldl1+foldl1'         = List.foldl1'+foldr           = List.foldr+foldr1          = List.foldr1++-- ** Special folds+concat          = List.concat+concatMap       = List.concatMap+and             = List.and+or              = List.or+any             = List.any+all             = List.all+sum             = List.sum+product         = List.product+maximum         = List.maximum+minimum         = List.minimum++-- * Building lists+-- ** Scans+scanl           = List.scanl+scanl1          = List.scanl1+scanr           = List.scanr+scanr1          = List.scanr1++-- ** Accumulating maps+mapAccumL       = List.mapAccumL+mapAccumR       = List.mapAccumR++-- ** Infinite lists+iterate         = List.iterate+repeat          = List.repeat+replicate       = List.replicate+cycle           = List.cycle++-- ** Unfolding+unfoldr         = List.unfoldr++-- * Sublists+-- ** Extracting sublists+take            = List.take+drop            = List.drop+splitAt         = List.splitAt+takeWhile       = List.takeWhile+dropWhile       = List.dropWhile+span            = List.span+break           = List.break+group           = List.group+inits           = List.inits+tails           = List.tails++-- * Predicates+isPrefixOf      = List.isPrefixOf+isSuffixOf      = List.isSuffixOf+isInfixOf       = List.isInfixOf++-- * Searching lists+-- ** Searching by equality+elem            = List.elem+notElem         = List.notElem+lookup          = List.lookup++-- ** Searching with a predicate+find            = List.find+filter          = List.filter+partition       = List.partition++-- * Indexing lists+(!!)            = (List.!!)+elemIndex       = List.elemIndex+elemIndices     = List.elemIndices+findIndex       = List.findIndex+findIndices     = List.findIndices++-- * Zipping and unzipping lists+zip             = List.zip+zip3            = List.zip3+zip4            = List.zip4+zip5            = List.zip5+zip6            = List.zip6+zip7            = List.zip7+zipWith         = List.zipWith+zipWith3        = List.zipWith3+zipWith4        = List.zipWith4+zipWith5        = List.zipWith5+zipWith6        = List.zipWith6+zipWith7        = List.zipWith7+unzip           = List.unzip+unzip3          = List.unzip3+unzip4          = List.unzip4+unzip5          = List.unzip5+unzip6          = List.unzip6+unzip7          = List.unzip7++-- * Special lists+-- ** Functions on strings+lines           = List.lines+words           = List.words+unlines         = List.unlines+unwords         = List.unwords++-- ** \"Set\" operations+nub             = List.nub+delete          = List.delete+(\\)            = (List.\\)+union           = List.union+intersect       = List.intersect++-- ** Ordered lists +sort            = List.sort+insert          = List.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = List.nubBy+deleteBy        = List.deleteBy+deleteFirstsBy  = List.deleteFirstsBy+unionBy         = List.unionBy+intersectBy     = List.intersectBy+groupBy         = List.groupBy++-- *** User-supplied comparison (replacing an Ord context)+sortBy          = List.sortBy+insertBy        = List.insertBy+maximumBy       = List.maximumBy+minimumBy       = List.minimumBy++-- * The \"generic\" operations+genericLength           = List.genericLength+genericTake             = List.genericTake+genericDrop             = List.genericDrop+genericSplitAt          = List.genericSplitAt+genericIndex            = List.genericIndex+genericReplicate        = List.genericReplicate
+ tests/Strictness/Monomorphic/Spec.hs view
@@ -0,0 +1,321 @@+module Strictness.Monomorphic.Spec where++--+-- just test the List api+--++import Strictness.Utils++import qualified Spec.List     as Spec+import qualified Spec.ListExts as Spec+++-- * Basic interface+(++)            :: [A] -> [A] -> [A]+head            :: [A] -> A+last            :: [A] -> A+tail            :: [A] -> [A]+init            :: [A] -> [A]+null            :: [A] -> Bool+length          :: [A] -> Int++-- * List transformations+map             :: (A -> B) -> [A] -> [B]+reverse         :: [A] -> [A]+intersperse     :: A -> [A] -> [A]+intercalate     :: [A] -> [[A]] -> [A]+transpose       :: [[A]] -> [[A]]++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> [A] -> B+foldl'          :: (B -> A -> B) -> B -> [A] -> B+foldl1          :: (A -> A -> A) -> [A] -> A+foldl1'         :: (A -> A -> A) -> [A] -> A+foldr           :: (A -> B -> B) -> B -> [A] -> B+foldr1          :: (A -> A -> A) -> [A] -> A++-- ** Special folds+concat          :: [[A]] -> [A]+concatMap       :: (A -> [B]) -> [A] -> [B]+and             :: [Bool] -> Bool+or              :: [Bool] -> Bool+any             :: (A -> Bool) -> [A] -> Bool+all             :: (A -> Bool) -> [A] -> Bool+sum             :: [N] -> N+product         :: [N] -> N+maximum         :: [OrdA] -> OrdA+minimum         :: [OrdA] -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> [B] -> [A]+scanl1          :: (A -> A -> A) -> [A] -> [A]+scanr           :: (A -> B -> B) -> B -> [A] -> [B]+scanr1          :: (A -> A -> A) -> [A] -> [A]++-- ** Accumulating maps+mapAccumL       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+mapAccumR       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])++-- ** Infinite lists+iterate         :: (A -> A) -> A -> [A]+repeat          :: A -> [A]+replicate       :: Int -> A -> [A]+cycle           :: [A] -> [A]++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> [A]++-- * Sublists+-- ** Extracting sublists+take            :: Int -> [A] -> [A]+drop            :: Int -> [A] -> [A]+splitAt         :: Int -> [A] -> ([A], [A])+takeWhile       :: (A -> Bool) -> [A] -> [A]+dropWhile       :: (A -> Bool) -> [A] -> [A]+span            :: (A -> Bool) -> [A] -> ([A], [A])+break           :: (A -> Bool) -> [A] -> ([A], [A])+group           :: [A] -> [[A]]+inits           :: [A] -> [[A]]+tails           :: [A] -> [[A]]++-- * Predicates+isPrefixOf      :: [A] -> [A] -> Bool+isSuffixOf      :: [A] -> [A] -> Bool+isInfixOf       :: [A] -> [A] -> Bool++-- * Searching lists+-- ** Searching by equality+elem            :: A -> [A] -> Bool+notElem         :: A -> [A] -> Bool+lookup          :: A -> [(A, B)] -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> [A] -> Maybe A+filter          :: (A -> Bool) -> [A] -> [A]+partition       :: (A -> Bool) -> [A] -> ([A], [A])++-- * Indexing lists+(!!)            :: [A] -> Int -> A+elemIndex       :: A -> [A] -> Maybe Int+elemIndices     :: A -> [A] -> [Int]+findIndex       :: (A -> Bool) -> [A] -> Maybe Int+findIndices     :: (A -> Bool) -> [A] -> [Int]++-- * Zipping and unzipping lists+zip             :: [A] -> [B] -> [(A, B)]+zip3            :: [A] -> [B] -> [C] -> [(A, B, C)]+zip4            :: [A] -> [B] -> [C] -> [D] -> [(A, B, C, D)]+zip5            :: [A] -> [B] -> [C] -> [D] -> [E] -> [(A, B, C, D, E)]+zip6            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [(A, B, C, D, E, F)]+zip7            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [(A, B, C, D, E, F, G)]+zipWith         :: (A -> B -> C) -> [A] -> [B] -> [C]+zipWith3        :: (A -> B -> C -> D) -> [A] -> [B] -> [C] -> [D]+zipWith4        :: (A -> B -> C -> D -> E) -> [A] -> [B] -> [C] -> [D] -> [E]+zipWith5        :: (A -> B -> C -> D -> E -> F) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F]+zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G]+zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [H]+unzip           :: [(A, B)] -> ([A], [B])+unzip3          :: [(A, B, C)] -> ([A], [B], [C])+unzip4          :: [(A, B, C, D)] -> ([A], [B], [C], [D])+unzip5          :: [(A, B, C, D, E)] -> ([A], [B], [C], [D], [E])+unzip6          :: [(A, B, C, D, E, F)] -> ([A], [B], [C], [D], [E], [F])+unzip7          :: [(A, B, C, D, E, F, G)] -> ([A], [B], [C], [D], [E], [F], [G])++-- * Special lists+-- ** Functions on strings+lines           :: String -> [String]+words           :: String -> [String]+unlines         :: [String] -> String+unwords         :: [String] -> String++-- ** \"Set\" operations+nub             :: [A] -> [A]+delete          :: A -> [A] -> [A]+(\\)            :: [A] -> [A] -> [A]+union           :: [A] -> [A] -> [A]+intersect       :: [A] -> [A] -> [A]++-- ** Ordered lists +sort            :: [OrdA] -> [OrdA]+insert          :: OrdA -> [OrdA] -> [OrdA]++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (A -> A -> Bool) -> [A] -> [A]+deleteBy        :: (A -> A -> Bool) -> A -> [A] -> [A]+deleteFirstsBy  :: (A -> A -> Bool) -> [A] -> [A] -> [A]+unionBy         :: (A -> A -> Bool) -> [A] -> [A] -> [A]+intersectBy     :: (A -> A -> Bool) -> [A] -> [A] -> [A]+groupBy         :: (A -> A -> Bool) -> [A] -> [[A]]++-- *** User-supplied comparison (replacing an Ord context)+sortBy          :: (A -> A -> Ordering) -> [A] -> [A]+insertBy        :: (A -> A -> Ordering) -> A -> [A] -> [A]+maximumBy       :: (A -> A -> Ordering) -> [A] -> A+minimumBy       :: (A -> A -> Ordering) -> [A] -> A++-- * The \"generic\" operations+genericLength           :: [A] -> I+genericTake             :: I -> [A] -> [A]+genericDrop             :: I -> [A] -> [A]+genericSplitAt          :: I -> [A] -> ([A], [A])+genericIndex            :: [A] -> I -> A+genericReplicate        :: I -> A -> [A]++++-- * Basic interface+(++)            = (Spec.++)+head            = Spec.head+last            = Spec.last+tail            = Spec.tail+init            = Spec.init+null            = Spec.null+length          = Spec.length++-- * List transformations+map             = Spec.map+reverse         = Spec.reverse+intersperse     = Spec.intersperse+intercalate     = Spec.intercalate+transpose       = Spec.transpose++-- * Reducing lists (folds)+foldl           = Spec.foldl+foldl'          = Spec.foldl'+foldl1          = Spec.foldl1+foldl1'         = Spec.foldl1'+foldr           = Spec.foldr+foldr1          = Spec.foldr1++-- ** Special folds+concat          = Spec.concat+concatMap       = Spec.concatMap+and             = Spec.and+or              = Spec.or+any             = Spec.any+all             = Spec.all+sum             = Spec.sum+product         = Spec.product+maximum         = Spec.maximum+minimum         = Spec.minimum++-- * Building lists+-- ** Scans+scanl           = Spec.scanl+scanl1          = Spec.scanl1+scanr           = Spec.scanr+scanr1          = Spec.scanr1++-- ** Accumulating maps+mapAccumL       = Spec.mapAccumL+mapAccumR       = Spec.mapAccumR++-- ** Infinite lists+iterate         = Spec.iterate+repeat          = Spec.repeat+replicate       = Spec.replicate+cycle           = Spec.cycle++-- ** Unfolding+unfoldr         = Spec.unfoldr++-- * Sublists+-- ** Extracting sublists+take            = Spec.take+drop            = Spec.drop+splitAt         = Spec.splitAt+takeWhile       = Spec.takeWhile+dropWhile       = Spec.dropWhile+span            = Spec.span+break           = Spec.break+group           = Spec.group+inits           = Spec.inits+tails           = Spec.tails++-- * Predicates+isPrefixOf      = Spec.isPrefixOf+isSuffixOf      = Spec.isSuffixOf+isInfixOf       = Spec.isInfixOf++-- * Searching lists+-- ** Searching by equality+elem            = Spec.elem+notElem         = Spec.notElem+lookup          = Spec.lookup++-- ** Searching with a predicate+find            = Spec.find+filter          = Spec.filter+partition       = Spec.partition++-- * Indexing lists+(!!)            = (Spec.!!)+elemIndex       = Spec.elemIndex+elemIndices     = Spec.elemIndices+findIndex       = Spec.findIndex+findIndices     = Spec.findIndices++-- * Zipping and unzipping lists+zip             = Spec.zip+zip3            = Spec.zip3+zip4            = Spec.zip4+zip5            = Spec.zip5+zip6            = Spec.zip6+zip7            = Spec.zip7+zipWith         = Spec.zipWith+zipWith3        = Spec.zipWith3+zipWith4        = Spec.zipWith4+zipWith5        = Spec.zipWith5+zipWith6        = Spec.zipWith6+zipWith7        = Spec.zipWith7+unzip           = Spec.unzip+unzip3          = Spec.unzip3+unzip4          = Spec.unzip4+unzip5          = Spec.unzip5+unzip6          = Spec.unzip6+unzip7          = Spec.unzip7++-- * Special lists+-- ** Functions on strings+lines           = Spec.lines+words           = Spec.words+unlines         = Spec.unlines+unwords         = Spec.unwords++-- ** \"Set\" operations+nub             = Spec.nub+delete          = Spec.delete+(\\)            = (Spec.\\)+union           = Spec.union+intersect       = Spec.intersect++-- ** Ordered lists +sort            = Spec.sort+insert          = Spec.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = Spec.nubBy+deleteBy        = Spec.deleteBy+deleteFirstsBy  = Spec.deleteFirstsBy+unionBy         = Spec.unionBy+intersectBy     = Spec.intersectBy+groupBy         = Spec.groupBy++-- *** User-supplied comparison (replacing an Ord context)+sortBy          = Spec.sortBy+insertBy        = Spec.insertBy+maximumBy       = Spec.maximumBy+minimumBy       = Spec.minimumBy++-- * The \"generic\" operations+genericLength           = Spec.genericLength+genericTake             = Spec.genericTake+genericDrop             = Spec.genericDrop+genericSplitAt          = Spec.genericSplitAt+genericIndex            = Spec.genericIndex+genericReplicate        = Spec.genericReplicate
+ tests/Strictness/Monomorphic/StreamList.hs view
@@ -0,0 +1,385 @@+--+-- list like wrappers for abstract streams+--+-- These specify the versions used when fusion occurs.+--+-- So we can check our stream implementations, which are only used when+-- fusion happens, are correct.+--++module Strictness.Monomorphic.StreamList where++import Strictness.Utils++import qualified Data.Stream as Stream++-- * Basic interface+cons            :: A -> [A] -> [A]+snoc            :: [A] -> A -> [A]+append          :: [A] -> [A] -> [A]+head            :: [A] -> A+last            :: [A] -> A+tail            :: [A] -> [A]+init            :: [A] -> [A]+null            :: [A] -> Bool+length          :: [A] -> Int+++-- * List transformations+map             :: (A -> B) -> [A] -> [B]+--reverse       :: [A] -> [A]+intersperse     :: A -> [A] -> [A]+intercalate   :: [A] -> [[A]] -> [A]+--transpose     :: [[A]] -> [[A]]++-- * Reducing lists (folds)+foldl           :: (B -> A -> B) -> B -> [A] -> B+foldl'          :: (B -> A -> B) -> B -> [A] -> B+foldl1          :: (A -> A -> A) -> [A] -> A+foldl1'         :: (A -> A -> A) -> [A] -> A+foldr           :: (A -> B -> B) -> B -> [A] -> B+foldr1          :: (A -> A -> A) -> [A] -> A++-- ** Special folds+concat          :: [[A]] -> [A]+concatMap       :: (A -> [B]) -> [A] -> [B]+and             :: [Bool] -> Bool+or              :: [Bool] -> Bool+any             :: (A -> Bool) -> [A] -> Bool+all             :: (A -> Bool) -> [A] -> Bool+sum             :: [N] -> N+product         :: [N] -> N+maximum         :: [OrdA] -> OrdA+minimum         :: [OrdA] -> OrdA++-- * Building lists+-- ** Scans+scanl           :: (A -> B -> A) -> A -> [B] -> [A]+scanl1          :: (A -> A -> A) -> [A] -> [A]++{-+scanr           :: (A -> B -> B) -> B -> [A] -> [B]+scanr1          :: (A -> A -> A) -> [A] -> [A]++-- ** Accumulating maps+mapAccumL       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+mapAccumR       :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B])+-}++-- ** Infinite lists+iterate         :: (A -> A) -> A -> [A]+repeat          :: A -> [A]+replicate       :: Int -> A -> [A]+cycle           :: [A] -> [A]++-- ** Unfolding+unfoldr         :: (B -> Maybe (A, B)) -> B -> [A]++-- * Sublists+-- ** Extracting sublists+take            :: Int -> [A] -> [A]+drop            :: Int -> [A] -> [A]+splitAt         :: Int -> [A] -> ([A], [A])+takeWhile       :: (A -> Bool) -> [A] -> [A]+dropWhile       :: (A -> Bool) -> [A] -> [A]++{-+span          :: (A -> Bool) -> [A] -> ([A], [A])+break           :: (A -> Bool) -> [A] -> ([A], [A])+group           :: [A] -> [[A]]+inits           :: [A] -> [[A]]+tails           :: [A] -> [[A]]+-}++-- * Predicates+isPrefixOf      :: [A] -> [A] -> Bool+{-+isSuffixOf      :: [A] -> [A] -> Bool+isInfixOf       :: [A] -> [A] -> Bool+-}++-- * Searching lists+-- ** Searching by equality+elem            :: A -> [A] -> Bool+--notElem               :: A -> [A] -> Bool+lookup          :: A -> [(A, B)] -> Maybe B++-- ** Searching with A predicate+find            :: (A -> Bool) -> [A] -> Maybe A+filter          :: (A -> Bool) -> [A] -> [A]+--partition     :: (A -> Bool) -> [A] -> ([A], [A])++-- * Indexing lists+(!!)            :: [A] -> Int -> A+findIndex       :: (A -> Bool) -> [A] -> Maybe Int+elemIndex       :: A -> [A] -> Maybe Int+elemIndices     :: A -> [A] -> [Int]+findIndices     :: (A -> Bool) -> [A] -> [Int]++-- * Zipping and unzipping lists+zip             :: [A] -> [B] -> [(A, B)]+zip3            :: [A] -> [B] -> [C] -> [(A, B, C)]+{-+zip4            :: [A] -> [B] -> [C] -> [D] -> [(A, B, C, D)]+zip5            :: [A] -> [B] -> [C] -> [D] -> [E] -> [(A, B, C, D, E)]+zip6            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [(A, B, C, D, E, F)]+zip7            :: [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [(A, B, C, D, E, F, G)]+-}++zipWith         :: (A -> B -> C) -> [A] -> [B] -> [C]+zipWith3        :: (A -> B -> C -> D) -> [A] -> [B] -> [C] -> [D]+{-+zipWith4        :: (A -> B -> C -> D -> E) -> [A] -> [B] -> [C] -> [D] -> [E]+zipWith5        :: (A -> B -> C -> D -> E -> F) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F]+zipWith6        :: (A -> B -> C -> D -> E -> F -> G) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G]+zipWith7        :: (A -> B -> C -> D -> E -> F -> G -> H) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [H]+-}++unzip           :: [(A, B)] -> ([A], [B])+{-+unzip3          :: [(A, B, C)] -> ([A], [B], [C])+unzip4          :: [(A, B, C, D)] -> ([A], [B], [C], [D])+unzip5          :: [(A, B, C, D, E)] -> ([A], [B], [C], [D], [E])+unzip6          :: [(A, B, C, D, E, F)] -> ([A], [B], [C], [D], [E], [F])+unzip7          :: [(A, B, C, D, E, F, G)] -> ([A], [B], [C], [D], [E], [F], [G])+-}++-- * Special lists+-- ** Functions on strings+--unlines         :: [String] -> String+--lines           :: String -> [String]+{-+words           :: String -> [String]+unwords         :: [String] -> String++-- ** \"Set\" operations+nub             :: [A] -> [A]+delete          :: A -> [A] -> [A]+(\\)            :: [A] -> [A] -> [A]+union           :: [A] -> [A] -> [A]+intersect       :: [A] -> [A] -> [A]++-- ** Ordered lists +sort            :: [OrdA] -> [OrdA]+insert          :: OrdA -> [OrdA] -> [OrdA]++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           :: (A -> A -> Bool) -> [A] -> [A]+deleteBy        :: (A -> A -> Bool) -> A -> [A] -> [A]+deleteFirstsBy  :: (A -> A -> Bool) -> [A] -> [A] -> [A]+unionBy         :: (A -> A -> Bool) -> [A] -> [A] -> [A]+intersectBy     :: (A -> A -> Bool) -> [A] -> [A] -> [A]+groupBy         :: (A -> A -> Bool) -> [A] -> [[A]]+-}++-- *** User-supplied comparison (replacing an Ord context)+insertBy        :: (A -> A -> Ordering) -> A -> [A] -> [A]+{-+sortBy          :: (A -> A -> Ordering) -> [A] -> [A]+-}+maximumBy       :: (A -> A -> Ordering) -> [A] -> A+minimumBy       :: (A -> A -> Ordering) -> [A] -> A++-- * The \"generic\" operations+genericLength           :: [A] -> I+genericTake             :: I -> [A] -> [A]+genericDrop             :: I -> [A] -> [A]+genericIndex            :: [A] -> I -> A+genericSplitAt          :: I -> [A] -> ([A], [A])+genericReplicate        :: I -> A -> [A]++s = Stream.stream+u = Stream.unstream++-- * Basic interface+cons            = \x xs  -> u $ Stream.cons   x (s xs)+snoc            = \xs x  -> u $ Stream.snoc   (s xs) x+append          = \xs ys -> u $ Stream.append (s xs) (s ys)+head            = \xs    ->     Stream.head   (s xs)+last            = \xs    ->     Stream.last   (s xs)+tail            = \xs    -> u $ Stream.tail   (s xs)+init            = \xs    -> u $ Stream.init   (s xs)+null            = \xs    ->     Stream.null   (s xs)+length          = \xs    ->     Stream.length (s xs)+++-- * List transformations+map             = \f   xs -> u $ Stream.map f (s xs)+--reverse               = Stream.reverse+intersperse     = \sep xs -> u $ Stream.intersperse sep (s xs)+intercalate     = \sep xs -> Stream.concat (Stream.intersperse sep(s xs))++--transpose     = Stream.transpose++-- * Reducing lists (folds)+foldl           = \f z xs -> Stream.foldl   f z (s xs)+foldl'          = \f z xs -> Stream.foldl'  f z (s xs)+foldl1          = \f   xs -> Stream.foldl1  f   (s xs)+foldl1'         = \f   xs -> Stream.foldl1' f   (s xs)+foldr           = \f z xs -> Stream.foldr   f z (s xs)+foldr1          = \f   xs -> Stream.foldr1  f   (s xs)++-- ** Special folds+concat          = \  xs -> Stream.concat (s xs)+concatMap       = \f xs -> u $ Stream.concatMap (s . f) (s xs)+and             = \  xs -> Stream.and   (s xs)+or              = \  xs -> Stream.or    (s xs)+any             = \f xs -> Stream.any f (s xs)+all             = \f xs -> Stream.all f (s xs)+sum             = \  xs -> Stream.sum   (s xs)+product         = \  xs -> Stream.product   (s xs)+maximum         = \  xs -> Stream.maximum   (s xs)+minimum         = \  xs -> Stream.minimum   (s xs)++-- * Building lists+-- ** Scans+scanl           = \f z xs -> u (Stream.scanl f z (Stream.snoc (s xs) bottom))+ where+    bottom :: a+    bottom = error "StreamProperties.bottom"++scanl1          = \f xs -> u (Stream.scanl1 f (Stream.snoc (s xs) bottom))+ where+    bottom :: a+    bottom = error "StreamProperties.bottom"++{-+scanr           = \f z xs -> u (Stream.scanr f z (Stream.cons bottom (s xs)))+ where+    bottom :: a+    bottom = error "StreamProperties.bottom"+-}++{-+scanr1          = Stream.scanr1++-- ** Accumulating maps+mapAccumL       = Stream.mapAccumL+mapAccumR       = Stream.mapAccumR+-}+-- ** Infinite lists+iterate         = \f x -> u $ Stream.iterate   f x+repeat          = \  x -> u $ Stream.repeat      x+replicate       = \n x -> u $ Stream.replicate n x+cycle           = \ xs -> u $ Stream.cycle    (s xs)++-- ** Unfolding+unfoldr         = \f x -> u $ Stream.unfoldr f x++-- * Sublists+-- ** Extracting sublists+take            = \n xs -> u $ Stream.take    n (s xs)+drop            = \n xs -> u $ Stream.drop    n (s xs)+splitAt         = \n xs ->     Stream.splitAt n (s xs)+takeWhile       = \f xs -> u $ Stream.takeWhile f (s xs)+dropWhile       = \f xs -> u $ Stream.dropWhile f (s xs)+{-+span          = Stream.span+break           = Stream.break+group           = Stream.group+inits           = Stream.inits+tails           = Stream.tails+-}++-- * Predicates+isPrefixOf      = \xs ys -> Stream.isPrefixOf (s xs) (s ys)+{-+isSuffixOf      = Stream.isSuffixOf+isInfixOf       = Stream.isInfixOf+-}+-- * Searching lists+-- ** Searching by equality+elem            = \key xs -> Stream.elem   key (s xs)+--notElem               = Stream.notElem+lookup          = \key xs -> Stream.lookup key (s xs)++-- ** Searching with a predicate+find            = \p xs ->     Stream.find   p (s xs)+filter          = \p xs -> u $ Stream.filter p (s xs)+--partition     = Stream.partition++-- * Indexing lists+(!!)            = \xs -> Stream.index (s xs)+findIndex       = \f xs -> Stream.findIndex f (s xs)+elemIndex       = \x xs -> Stream.elemIndex x (s xs)+elemIndices     = \x xs -> u (Stream.elemIndices x (s xs))+findIndices     = \p xs -> u (Stream.findIndices p (s xs))+++-- * Zipping and unzipping lists+zip  = \xs ys       -> u (Stream.zip (s xs) (s ys))+zip3 = \xs ys zs    -> u (Stream.zip3 (s xs) (s ys) (s zs))+zip4 = \xs ys zs as -> u (Stream.zip4 (s xs) (s ys) (s zs) (s as))++zipWith         = \f xs ys       -> u (Stream.zipWith f (s xs) (s ys))+zipWith3        = \f xs ys zs    -> u (Stream.zipWith3 f (s xs) (s ys) (s zs))+zipWith4        = \f xs ys zs as -> u (Stream.zipWith4 f (s xs) (s ys) (s zs) (s as))++unzip           = Stream.unzip . s++{-+zip4            = Stream.zip4+zip5            = Stream.zip5+zip6            = Stream.zip6+zip7            = Stream.zip7+zipWith4        = Stream.zipWith4+zipWith5        = Stream.zipWith5+zipWith6        = Stream.zipWith6+zipWith7        = Stream.zipWith7+unzip3          = Stream.unzip3+unzip4          = Stream.unzip4+unzip5          = Stream.unzip5+unzip6          = Stream.unzip6+unzip7          = Stream.unzip7+-}++-- * Special lists+-- ** Functions on strings+--unlines         = \xs -> u (Stream.concatMap (\x -> Stream.snoc (s x) '\n') (s xs))+--lines           = \xs -> u (Stream.lines (s xs))++{-+words           = Stream.words+unwords         = Stream.unwords++-- ** \"Set\" operations+nub             = Stream.nub+delete          = Stream.delete+(\\)            = (Stream.\\)+union           = Stream.union+intersect       = Stream.intersect++-- ** Ordered lists +sort            = Stream.sort+insert          = Stream.insert++-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)+nubBy           = Stream.nubBy+deleteBy        = Stream.deleteBy+deleteFirstsBy  = Stream.deleteFirstsBy+unionBy         = Stream.unionBy+intersectBy     = Stream.intersectBy+groupBy         = Stream.groupBy+-}++-- *** User-supplied comparison (replacing an Ord context)+{-+sortBy          = Stream.sortBy+-}+insertBy        = \cmp x xs -> u $ Stream.insertBy cmp x (s xs)++maximumBy       = \cmp xs -> Stream.maximumBy cmp (s xs)+minimumBy       = \cmp xs -> Stream.minimumBy cmp (s xs)++-- * The \"generic\" operations+genericLength           = \xs -> Stream.genericLength (s xs)+genericTake             = \n xs -> u $ Stream.genericTake n (s xs)+genericDrop             = \n xs -> u $ Stream.genericDrop n (s xs)+genericIndex            = \xs n -> Stream.genericIndex (s xs) n+genericSplitAt          = \n xs -> Stream.genericSplitAt n (s xs)+genericReplicate        = \n x  -> genericTake n (Prelude.repeat x)+
+ tests/Strictness/StreamListVsList.hs view
@@ -0,0 +1,391 @@++--+-- Must have rules off, otherwise the fusion rules will replace the rhs+-- with the lhs, and we only end up testing lhs == lhs+--++import Prelude hiding (null)+import Strictness.Utils+import System.IO++import qualified Strictness.Monomorphic.StreamList as Test        -- our stream implementation+import qualified Strictness.Monomorphic.List       as Spec        -- our list implementation++--+-- Data.Stream <=> Data.List.Stream+--++------------------------------------------------------------------------+-- * Basic interface++prop_append     = Test.append   `eq2`           (Spec.++)+prop_head       = Test.head     `eq1`           Spec.head+prop_last       = Test.last     `eq1`           Spec.last+prop_tail       = Test.tail     `eq1`           Spec.tail+prop_init       = Test.init     `eq1`           Spec.init+prop_null       = Test.null     `eq1`           Spec.null+prop_length     = Test.length   `eq1`           Spec.length++------------------------------------------------------------------------+-- * List transformations++prop_map                = Test.map              `eq2`   Spec.map+--prop_reverse            = Test.reverse          `eq1`   Spec.reverse+prop_intersperse        = Test.intersperse      `eq2`   Spec.intersperse+prop_intercalate        = Test.intercalate      `eq2`   Spec.intercalate+--prop_transpose          = Test.transpose        `eq1`   Spec.transpose++------------------------------------------------------------------------+-- * Reducing lists (folds)++prop_foldl      = Test.foldl            `eq3`   Spec.foldl+prop_foldl'     = Test.foldl'           `eq3`   Spec.foldl'+prop_foldl1     = Test.foldl1           `eq2`   Spec.foldl1+prop_foldl1'    = Test.foldl1'          `eq2`   Spec.foldl1'+prop_foldr      = Test.foldr            `eq3`   Spec.foldr+prop_foldr1     = Test.foldr1           `eq2`   Spec.foldr1++------------------------------------------------------------------------+-- ** Special folds++prop_concat     = Test.concat           `eq1`   Spec.concat+prop_concatMap  = Test.concatMap        `eq2`   Spec.concatMap+prop_and        = Test.and              `eq1`   Spec.and+prop_or         = Test.or               `eq1`   Spec.or+prop_any        = Test.any              `eq2`   Spec.any+prop_all        = Test.all              `eq2`   Spec.all+prop_sum        = Test.sum              `eq1`   Spec.sum+prop_product    = Test.product          `eq1`   Spec.product+prop_maximum    = Test.maximum          `eq1`   Spec.maximum+prop_minimum    = Test.minimum          `eq1`   Spec.minimum++------------------------------------------------------------------------+-- * Building lists+-- ** Scans++prop_scanl      = Test.scanl            `eq3`   Spec.scanl+prop_scanl1     = Test.scanl1           `eq2`   Spec.scanl1+--prop_scanr      = Test.scanr            `eq3`   Spec.scanr+--prop_scanr1     = Test.scanr1           `eq2`   Spec.scanr1++------------------------------------------------------------------------+-- ** Accumulating maps++--prop_mapAccumL  = Test.mapAccumL        `eq3`   Spec.mapAccumL+--prop_mapAccumR  = Test.mapAccumR        `eq3`   Spec.mapAccumR++------------------------------------------------------------------------+-- ** Infinite lists++prop_iterate    = Test.iterate    `eqfinite2`   Spec.iterate+prop_repeat     = Test.repeat     `eqfinite1`   Spec.repeat+prop_replicate  = Test.replicate  `eqfinite2`   Spec.replicate+prop_cycle      = Test.cycle      `eqfinite1`   Spec.cycle++------------------------------------------------------------------------+-- ** Unfolding++prop_unfoldr    = Test.unfoldr    `eqfinite2`   Spec.unfoldr++------------------------------------------------------------------------+-- * Sublists+-- ** Extracting sublists++prop_take       = Test.take             `eq2`   Spec.take+prop_drop       = Test.drop             `eq2`   Spec.drop+prop_splitAt    = Test.splitAt          `eq2`   Spec.splitAt+prop_takeWhile  = Test.takeWhile        `eq2`   Spec.takeWhile+prop_dropWhile  = Test.dropWhile        `eq2`   Spec.dropWhile+--prop_span       = Test.span             `eq2`   Spec.span+--prop_break      = Test.break            `eq2`   Spec.break+--prop_group      = Test.group            `eq1`   Spec.group+--prop_inits      = Test.inits            `eq1`   Spec.inits+--prop_tails      = Test.tails            `eq1`   Spec.tails++------------------------------------------------------------------------+-- * Predicates++prop_isPrefixOf  = Test.isPrefixOf       `eq2`   Spec.isPrefixOf+--prop_isSuffixOf  = Test.isSuffixOf       `eq2`   Spec.isSuffixOf+--prop_isInfixOf   = Test.isInfixOf        `eq2`   Spec.isInfixOf++------------------------------------------------------------------------+-- * Searching lists+-- ** Searching by equality++prop_elem       = Test.elem             `eq2`   Spec.elem+--prop_notElem    = Test.notElem          `eq2`   Spec.notElem+prop_lookup     = Test.lookup           `eq2`   Spec.lookup++------------------------------------------------------------------------+-- ** Searching with a predicate++prop_find       = Test.find             `eq2`   Spec.find+prop_filter     = Test.filter           `eq2`   Spec.filter+--prop_partition  = Test.partition        `eq2`   Spec.partition++------------------------------------------------------------------------+-- * Indexing lists++prop_index              = (Test.!!)             `eq2`   (Spec.!!)+prop_elemIndex          = Test.elemIndex        `eq2`   Spec.elemIndex+prop_elemIndices        = Test.elemIndices      `eq2`   Spec.elemIndices+prop_findIndex          = Test.findIndex        `eq2`   Spec.findIndex+prop_findIndices        = Test.findIndices      `eq2`   Spec.findIndices++------------------------------------------------------------------------+-- * Zipping and unzipping lists++prop_zip        = Test.zip              `eq2`   Spec.zip+prop_zip3       = Test.zip3             `eq3`   Spec.zip3+prop_zip4       = Test.zip4             `eq4`   Spec.zip4+--prop_zip5       = Test.zip5             `eq5`   Spec.zip5+--prop_zip6       = Test.zip6             `eq6`   Spec.zip6+--prop_zip7       = Test.zip7             `eq7`   Spec.zip7+prop_zipWith    = Test.zipWith          `eq3`   Spec.zipWith+prop_zipWith3   = Test.zipWith3         `eq4`   Spec.zipWith3+prop_zipWith4   = Test.zipWith4         `eq5`   Spec.zipWith4+--prop_zipWith5   = Test.zipWith5         `eq6`   Spec.zipWith5+--prop_zipWith6   = Test.zipWith6         `eq7`   Spec.zipWith6+--prop_zipWith7   = Test.zipWith7         `eq8`   Spec.zipWith7++------------------------------------------------------------------------++prop_unzip      = Test.unzip            `eq1`   Spec.unzip+--prop_unzip3     = Test.unzip3           `eq1`   Spec.unzip3+--prop_unzip4     = Test.unzip4           `eq1`   Spec.unzip4+--prop_unzip5     = Test.unzip5           `eq1`   Spec.unzip5+--prop_unzip6     = Test.unzip6           `eq1`   Spec.unzip6+--prop_unzip7     = Test.unzip7           `eq1`   Spec.unzip7++------------------------------------------------------------------------+-- * Special lists+-- ** Functions on strings++--prop_lines      = Test.lines            `eq1`   Spec.lines+--prop_words      = Test.words            `eq1`   Spec.words+--prop_unlines    = Test.unlines          `eq1`   Spec.unlines+--prop_unwords    = Test.unwords          `eq1`   Spec.unwords++------------------------------------------------------------------------+-- ** \"Set\" operations++--prop_nub        = Test.nub              `eq1`   Spec.nub+--prop_delete     = Test.delete           `eq2`   Spec.delete+--prop_difference = (Test.\\)             `eq2`   (Spec.\\)+--prop_union      = Test.union            `eq2`   Spec.union+--prop_intersect  = Test.intersect        `eq2`   Spec.intersect++------------------------------------------------------------------------+-- ** Ordered lists ++--prop_sort       = Test.sort             `eq1`   Spec.sort+--prop_insert     = Test.insert           `eq2`   Spec.insert++------------------------------------------------------------------------+-- * Generalized functions+-- ** The \"By\" operations+-- *** User-supplied equality (replacing an Eq context)++--prop_nubBy              = Test.nubBy            `eq2`   Spec.nubBy+--prop_deleteBy           = Test.deleteBy         `eq3`   Spec.deleteBy+--prop_deleteFirstsBy     = Test.deleteFirstsBy   `eq3`   Spec.deleteFirstsBy+--prop_unionBy            = Test.unionBy          `eq3`   Spec.unionBy+--prop_intersectBy        = Test.intersectBy      `eq3`   Spec.intersectBy+--prop_groupBy            = Test.groupBy          `eq2`   Spec.groupBy++------------------------------------------------------------------------+-- *** User-supplied comparison (replacing an Ord context)++--prop_sortBy             = Test.sortBy           `eq2`    Spec.sortBy     --need to generate total orders+prop_insertBy           = Test.insertBy         `eq3`    Spec.insertBy+prop_maximumBy          = Test.maximumBy        `eq2`    Spec.maximumBy+prop_minimumBy          = Test.minimumBy        `eq2`    Spec.minimumBy++------------------------------------------------------------------------+-- * The \"generic\" operations++prop_genericLength      = Test.genericLength    `eq1`    Spec.genericLength+prop_genericTake        = Test.genericTake      `eq2`    Spec.genericTake+prop_genericDrop        = Test.genericDrop      `eq2`    Spec.genericDrop+prop_genericSplitAt     = Test.genericSplitAt   `eq2`    Spec.genericSplitAt+prop_genericIndex       = Test.genericIndex     `eq2`    Spec.genericIndex+prop_genericReplicate   = Test.genericReplicate `eqfinite2`    Spec.genericReplicate++------------------------------------------------------------------------++main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Testing Data.Stream <=> Data.List.Stream"+  putStrLn "========================================\n"+  +  runTests "Basic interface" opts+    [run prop_append+    ,run prop_head+    ,run prop_last+    ,run prop_tail+    ,run prop_init+    ,run prop_null+    ,run prop_length+    ]++  runTests "List transformations" opts+    [run prop_map+--    ,run prop_reverse+    ,run prop_intersperse+    ,run prop_intercalate+--    ,run prop_transpose+    ]++  runTests "Reducing lists (folds)" opts+    [run prop_foldl+    ,run prop_foldl'+    ,run prop_foldl1+    ,run prop_foldl1'+    ,run prop_foldr+    ,run prop_foldr1+    ]++  runTests "Special folds" opts+    [run prop_concat+    ,run prop_concatMap+    ,run prop_and+    ,run prop_or+    ,run prop_any+    ,run prop_all+    ,run prop_sum+    ,run prop_product+    ,run prop_maximum+    ,run prop_minimum+    ]++  runTests "Scans" opts+    [run prop_scanl+    ,run prop_scanl1+--    ,run prop_scanr+--    ,run prop_scanr1+    ]++  runTests "Accumulating maps" opts+    [--run prop_mapAccumL+--    ,run prop_mapAccumR+    ]++  runTests "Infinite lists" opts+    [run prop_iterate+    ,run prop_repeat+    ,run prop_replicate+    ,run prop_cycle+    ]++  runTests "Unfolding" opts+    [run prop_unfoldr+    ]++  runTests "Extracting sublists" opts+    [run prop_take+    ,run prop_drop+    ,run prop_splitAt+    ,run prop_takeWhile+    ,run prop_dropWhile+--    ,run prop_span+--    ,run prop_break+--    ,run prop_group+--    ,run prop_inits+--    ,run prop_tails+    ]++  runTests "Predicates" opts+    [run prop_isPrefixOf+--    ,run prop_isSuffixOf+--    ,run prop_isInfixOf+    ]++  runTests "Searching by equality" opts+    [run prop_elem+--    ,run prop_notElem+    ,run prop_lookup+    ]++  runTests "Searching by a predicate" opts+    [run prop_find+    ,run prop_filter+--    ,run prop_partition+    ]++  runTests "Indexing lists" opts+    [run prop_index+    ,run prop_elemIndex+    ,run prop_elemIndices+    ,run prop_findIndex+    ,run prop_findIndices+    ]++  runTests "Zipping" opts { testDepth = 6, maxTests = 100000 }+    [run prop_zip+    ,run prop_zip3+    ,run prop_zip4+--    ,run prop_zip5+--    ,run prop_zip6+--    ,run prop_zip7+    ,run prop_zipWith+    ,run prop_zipWith3+    ,run prop_zipWith4+--    ,run prop_zipWith5+--    ,run prop_zipWith6+--    ,run prop_zipWith7+    ]++  runTests "Unzipping" opts+    [run prop_unzip+--    ,run prop_unzip3+--    ,run prop_unzip4+--    ,run prop_unzip5+--    ,run prop_unzip6+--    ,run prop_unzip7+    ]++--  runTests "Functions on strings" opts+--    [run prop_lines+--    ,run prop_words+--    ,run prop_unlines+--    ,run prop_unwords+--    ]++  runTests "\"Set\" operations" opts+    [--run prop_nub+    --,run prop_delete+    --,run prop_difference+    --,run prop_union+    --,run prop_intersect+    ]++  runTests "Ordered lists" opts+    [--run prop_sort+--    ,run prop_insert+    ]++  runTests "Eq style \"By\" operations" opts+    [--run prop_nubBy+--    ,run prop_deleteBy+--    ,run prop_deleteFirstsBy+--    ,run prop_unionBy+--    ,run prop_intersectBy+--    ,run prop_groupBy+    ]++  runTests "Ord style \"By\" operations" opts+    [--run prop_sortBy        -- note issue here.+    run prop_insertBy+    ,run prop_maximumBy+    ,run prop_minimumBy+    ]++  runTests "The \"generic\" operations" opts+    [run prop_genericLength+    ,run prop_genericTake+    ,run prop_genericDrop+    ,run prop_genericSplitAt+    ,run prop_genericIndex+    ,run prop_genericReplicate+    ]
+ tests/Strictness/Utils.hs view
@@ -0,0 +1,74 @@+module Strictness.Utils (+  module Strictness.Utils,+  module Test.SmallCheck.Partial+  ) where++import Prelude hiding (null)+import qualified Prelude++import Test.SmallCheck.Partial hiding (PositiveIntegral(N))+import Test.ChasingBottoms+import Data.Generics++-- some types to use when testing at polymorphic values++newtype A = A () deriving (Eq, Show, Serial, Typeable, Data)+newtype B = B () deriving (Eq, Show, Serial, Typeable, Data)+newtype C = C () deriving (Eq, Show, Serial, Typeable, Data)++type D = A+type E = B+type F = C+type G = A+type H = B++newtype OrdA = OrdA Bool deriving (Eq, Ord, Show, Serial, Typeable, Data)++newtype N = N Int deriving (Eq, Ord, Show, Serial, Typeable, Data)+newtype I = I Int deriving (Eq, Ord, Enum, Real, Integral, Show, Serial, Typeable, Data)++-- to catch cases where we rely on associativity or comutativity of+-- (+) or (*)... make them neither! Mwahahaha :-)++instance Num N where+  N x + N y = N (2 * x + y)+  N x * N y = N (2 * x + y + 1)+  fromInteger = N . fromInteger+  negate (N n) = N (negate n)+  abs (N n) = N (abs n)+  signum (N n) = N (signum n)++instance Num I where+  I x + I y = I (2 * x + y)+  I x * I y = I (2 * x + y + 1)+  fromInteger = I . fromInteger+  negate (I i) = I (negate i)+  abs (I i) = I (abs i)+  signum (I i) = I (signum i)+++eq1 f g = \x               -> f x               ==! g x+eq2 f g = \x y             -> f x y             ==! g x y+eq3 f g = \x y z           -> f x y z           ==! g x y z+eq4 f g = \x y z a         -> f x y z a         ==! g x y z a+eq5 f g = \x y z a b       -> f x y z a b       ==! g x y z a b+eq6 f g = \x y z a b c     -> f x y z a b c     ==! g x y z a b c+eq7 f g = \x y z a b c d   -> f x y z a b c d   ==! g x y z a b c d+eq8 f g = \x y z a b c d e -> f x y z a b c d e ==! g x y z a b c d e++eqfinite1 f g = \x         -> semanticEq limit (f x)   (g x)+eqfinite2 f g = \x y       -> semanticEq limit (f x y) (g x y)++limit = Tweak { approxDepth = Just 1000, timeOutLimit = Nothing }+++refines1 f g = \x               -> f x               >=! g x+refines2 f g = \x y             -> f x y             >=! g x y+refines3 f g = \x y z           -> f x y z           >=! g x y z+refines4 f g = \x y z a         -> f x y z a         >=! g x y z a+refines5 f g = \x y z a b       -> f x y z a b       >=! g x y z a b+refines6 f g = \x y z a b c     -> f x y z a b c     >=! g x y z a b c+refines7 f g = \x y z a b c d   -> f x y z a b c d   >=! g x y z a b c d+refines8 f g = \x y z a b c d e -> f x y z a b c d e >=! g x y z a b c d e++opts = TestOptions 8 10000
+ tests/Test/SmallCheck/Partial.hs view
@@ -0,0 +1,527 @@+{-# OPTIONS_GHC -fallow-incoherent-instances -fallow-undecidable-instances #-}++---------------------------------------------------------------------+-- SmallCheck: another lightweight testing library.+-- Colin Runciman, August 2006+-- Version 0.2 (November 2006)+--+-- After QuickCheck, by Koen Claessen and John Hughes (2000-2004).+---------------------------------------------------------------------++module Test.SmallCheck.Partial (+  smallCheck, smallCheckI, depthCheck, test,+  Property, Testable,+  forAll, forAllElem,+  exists, existsDeeperBy, thereExists, thereExistsElem,+  (==>),+  Series, Serial(..),+  (\/), (><), two, three, four,+  cons0, cons1, cons2, cons3, cons4,+  alts0, alts1, alts2, alts3, alts4,+  PositiveIntegral(..), Nat, Natural,+  depth, inc, dec,+  +  run, runTests, TestOptions(..)+  ) where++import List (intersperse)+import Monad (when)+import IO (stdout, hFlush)+import Foreign (unsafePerformIO)  -- used only for Testable (IO a)++import qualified Test.ChasingBottoms as Bottoms++------------------ <Series of depth-bounded values> -----------------++-- Series arguments should be interpreted as a depth bound (>=0)+-- Series results should have finite length++type Series a = Int -> [a]++-- sum+infixr 7 \/+(\/) :: Series a -> Series a -> Series a+(s1 \/ s2) 0 = bottom : []+(s1 \/ s2) d = bottom : s1 (d-1) ++ s2 (d-1)++-- product+infixr 8 ><+(><) :: Series a -> Series b -> Series (a,b)+(s1 >< s2) 0 = bottom : []+(s1 >< s2) d = bottom : [(x,y) | x <- s1 (d-1), y <- s2 (d-1)]+++------------------- <methods for type enumeration> ------------------++-- enumerated data values should be finite and fully defined+-- enumerated functional values should be total and strict++bottom :: a+bottom = error "_|_"++-- bounds:+-- for data values, the depth of nested constructor applications+-- for functional values, both the depth of nested case analysis+-- and the depth of results+ +class Serial a where+  series   :: Series a+  coseries :: Serial b => Series (a->b)++instance Serial () where+  series   d = take (d+1) [bottom, ()]+  coseries d = [ \() -> b+               | b <- series d ]++instance Serial Int where+  series   d = seq 0+    where seq n | n > d = []+          seq n@0       = bottom         : seq (n+1)+          seq n@1       = 0              : seq (n+1)+          seq n         = -(n-1) : (n-1) : seq (n+1)+  coseries d = [ \i -> if i > 0 then f (N (i - 1))+                       else if i < 0 then g (N (abs i - 1))+                       else z+               | z <- alts0 d, f <- alts1 d, g <- alts1 d ]++instance Serial Integer where+  series   d = [ toInteger (i :: Int)+               | i <- series d ]+  coseries d = [ f . (fromInteger :: Integer->Int)+               | f <- series d ]++newtype PositiveIntegral a = N a++instance Show a => Show (PositiveIntegral a) where+  show (N i) = show i++instance (Integral a, Serial a) => Serial (PositiveIntegral a) where+  series   d = map N [0..d']+               where+               d' = fromInteger (toInteger d)+  coseries d = [ \(N i) -> if i > 0 then f (N (i - 1))+                           else z+               | z <- alts0 d, f <- alts1 d ]++type Nat = PositiveIntegral Int+type Natural = PositiveIntegral Integer++instance Serial Float where+  series d   = [ encodeFloat sig exp+               | (sig,exp) <- series d,+                 odd sig || sig==0 && exp==0 ]+  coseries d = [ f . decodeFloat+               | f <- series d ]+             +instance Serial Double where+  series   d = [ frac (x :: Float)+               | x <- series d ]+  coseries d = [ f . (frac :: Double->Float)+               | f <- series d ]++frac :: (Real a, Fractional a, Real b, Fractional b) => a -> b+frac = fromRational . toRational++instance Serial Char where+  series d   = take (d+1) " \nab\0cd,ef"+  coseries d = [ \c -> f (N (fromEnum c - fromEnum 'a'))+               | f <- series d ]++instance (Serial a, Serial b) =>+         Serial (a,b) where+  series   = series >< series+  coseries = map uncurry . coseries++instance (Serial a, Serial b, Serial c) =>+         Serial (a,b,c) where+  series   = \d -> bottom+                 : [ (x,y,z)+                   | x <- series (d-1)+                   , y <- series (d-1)+                   , z <- series (d-1)]+  coseries = map uncurry3 . coseries++instance (Serial a, Serial b, Serial c, Serial d) =>+         Serial (a,b,c,d) where+  series   = \d -> bottom+                 : [ (x,y,z,a)+                   | x <- series (d-1)+                   , y <- series (d-1)+                   , z <- series (d-1)+                   , a <- series (d-1)]+  coseries = map uncurry4 . coseries++uncurry3 :: (a->b->c->d) -> ((a,b,c)->d)+uncurry3 f (x,y,z) = f x y z++uncurry4 :: (a->b->c->d->e) -> ((a,b,c,d)->e)+uncurry4 f (w,x,y,z) = f w x y z++two   :: Series a -> Series (a,a)+two   s = s >< s++three :: Series a -> Series (a,a,a)+three s = \d -> [(x,y,z) | (x,(y,z)) <- (s >< s >< s) d]++four  :: Series a -> Series (a,a,a,a)+four  s = \d -> [(w,x,y,z) | (w,(x,(y,z))) <- (s >< s >< s >< s) d]++cons0 :: +         a -> Series a+cons0 c _ = [c]++cons1 :: Serial a =>+         (a->b) -> Series b+cons1 c d = [c z | d > 0, z <- series (d-1)]++cons2 :: (Serial a, Serial b) =>+         (a->b->c) -> Series c+cons2 c d = [c y z | d > 0, y <- series (d-1), z <- series (d-1)]++cons3 :: (Serial a, Serial b, Serial c) =>+         (a->b->c->d) -> Series d+cons3 c d = [c x y z | d > 0, (x,y,z) <- series (d-1)]++cons4 :: (Serial a, Serial b, Serial c, Serial d) =>+         (a->b->c->d->e) -> Series e+cons4 c d = [c w x y z | d > 0, (w,x,y,z) <- series (d-1)]++alts0 ::  Serial a =>+            Series a+alts0 d = series d++alts1 ::  (Serial a, Serial b) =>+            Series (a->b)+alts1 d = if d > 0 then series (dec d)+          else [\_ -> x | x <- series d]++alts2 ::  (Serial a, Serial b, Serial c) =>+            Series (a->b->c)+alts2 d = if d > 0 then series (dec d)+          else [\_ _ -> x | x <- series d]++alts3 ::  (Serial a, Serial b, Serial c, Serial d) =>+            Series (a->b->c->d)+alts3 d = if d > 0 then series (dec d)+          else [\_ _ _ -> x | x <- series d]++alts4 ::  (Serial a, Serial b, Serial c, Serial d, Serial e) =>+            Series (a->b->c->d->e)+alts4 d = if d > 0 then series (dec d)+          else [\_ _ _ _ -> x | x <- series d]++instance Serial Bool where+  series     = cons0 False \/ cons0 True+  coseries d = [ \x -> if x then b1 else b2+               | b1 <- series d, b2 <- series d ]++instance Serial Ordering where+  series     = cons0 EQ \/ cons0 LT \/ cons0 GT+  coseries d = [ \m -> case m of+                       LT -> x+                       EQ -> y+                       GT -> z+               |  x <- alts0 d ,+                  y <- alts0 d ,+                  z <- alts0 d ]++instance Serial a => Serial (Maybe a) where+  series     = cons0 Nothing \/ cons1 Just+  coseries d = [ \m -> case m of+                       Nothing -> z+                       Just x  -> f x+               |  z <- alts0 d ,+                  f <- alts1 d ]++instance (Serial a, Serial b) => Serial (Either a b) where+  series     = cons1 Left \/ cons1 Right+  coseries d = [ \e -> case e of+                       Left x  -> f x+                       Right y -> g y+               |  f <- alts1 d ,+                  g <- alts1 d ]++instance Serial a => Serial [a] where+  series     = cons0 [] \/ cons2 (:)+  coseries d = [ \xs -> case xs of+                        []      -> y+                        (x:xs') -> f x xs'+               |   y <- alts0 d ,+                   f <- alts2 d ]++-- Warning: the coseries instance here may generate duplicates.+instance (Serial a, Serial b) => Serial (a->b) where+  series 0     = bottom : []+  series (d+1) = bottom : [ \_ -> x | x <- series d ] ++ tail (coseries d)+  coseries d = [ \f -> g [f x | x <- series d]+               | g <- series d ]++-- For customising the depth measure.  Use with care!++depth :: Int -> Int -> Int+depth d d' | d >= 0    = d'+1-d+           | otherwise = error "SmallCheck.depth: argument < 0"++dec :: Int -> Int+dec d | d > 0     = d-1+      | otherwise = error "SmallCheck.dec: argument <= 0"++inc :: Int -> Int+inc d = d+1+{-+-- show the extension of a function (in part, bounded both by+-- the number and depth of arguments)+instance (Serial a, Show a, Show b) => Show (a->b) where+  show f = +    if maxarheight == 1+    && sumarwidth + length ars * length "->;" < widthLimit then+      "{"++(+      concat $ intersperse ";" $ [a++"->"++r | (a,r) <- ars]+      )++"}"+    else+      concat $ [a++"->\n"++indent r | (a,r) <- ars]+    where+    ars = take lengthLimit [ (show x, show (f x))+                           | x <- series depthLimit ]+    maxarheight = maximum  [ max (height a) (height r)+                           | (a,r) <- ars ]+    sumarwidth = sum       [ length a + length r +                           | (a,r) <- ars]+    indent = unlines . map ("  "++) . lines+    height = length . lines+    (widthLimit,lengthLimit,depthLimit) = (80,20,3)::(Int,Int,Int)+-}+instance (Serial a, Bottoms.ApproxShow a, Bottoms.ApproxShow b) => Show (a->b) where+  show f+    | Bottoms.isBottom f = "_|_"+    | otherwise =+    if maxarheight == 1+    && sumarwidth + length ars * length "->;" < widthLimit then+      "{"++(+      concat $ intersperse ";" $ [a++"->"++r | (a,r) <- ars]+      )++"}"+    else+      concat $ [a++"->\n"++indent r | (a,r) <- ars]+    where+    ars = take lengthLimit [ (Bottoms.approxShow 1000 x, Bottoms.approxShow 1000 (f x))+                           | x <- series depthLimit ]+    maxarheight = maximum  [ max (height a) (height r)+                           | (a,r) <- ars ]+    sumarwidth = sum       [ length a + length r +                           | (a,r) <- ars]+    indent = unlines . map ("  "++) . lines+    height = length . lines+    (widthLimit,lengthLimit,depthLimit) = (80,20,3)::(Int,Int,Int)+++---------------- <properties and their evaluation> ------------------++-- adapted from QuickCheck originals: here results come in lists,+-- properties have depth arguments, stamps (for classifying random+-- tests) are omitted, existentials are introduced++newtype PR = Prop [Result]++data Result = Result {ok :: Maybe Bool, arguments :: [String]}++nothing :: Result+nothing = Result {ok = Nothing, arguments = []}++result :: Result -> PR+result res = Prop [res]++newtype Property = Property (Int -> PR)++class Testable a where+  property :: a -> Int -> PR++instance Testable Bool where+  property b _ = Prop [Result (Just b) []]++instance Testable PR where+  property prop _ = prop++instance (Serial a, Bottoms.ApproxShow a, Testable b) => Testable (a->b) where+  property f = f' where Property f' = forAll series f++instance Testable Property where+  property (Property f) d = f d++-- For testing properties involving IO.  Unsafe, so use with care!+instance Testable a => Testable (IO a) where+  property = property . unsafePerformIO++evaluate :: Testable a => a -> Series Result+evaluate x d = rs where Prop rs = property x d++forAll :: (Bottoms.ApproxShow a, Testable b) => Series a -> (a->b) -> Property+forAll xs f = Property $ \d -> Prop $+  [ r{arguments = Bottoms.approxShow 1000 x : arguments r}+  | x <- xs d, r <- evaluate (f x) d ]++forAllElem :: (Bottoms.ApproxShow a, Testable b) => [a] -> (a->b) -> Property+forAllElem xs = forAll (const xs)++thereExists :: Testable b => Series a -> (a->b) -> Property+thereExists xs f = Property $ \d -> Prop $+  [ Result+      ( Just $ or [ all pass (evaluate (f x) d)+                  | x <- xs d ] )+      [] ] +  where+  pass (Result Nothing _)  = True+  pass (Result (Just b) _) = b++thereExistsElem :: Testable b => [a] -> (a->b) -> Property+thereExistsElem xs = thereExists (const xs)++exists :: (Serial a, Testable b) =>+            (a->b) -> Property+exists = thereExists series++existsDeeperBy :: (Serial a, Testable b) =>+                    (Int->Int) -> (a->b) -> Property+existsDeeperBy f = thereExists (series . f)+ +infixr 0 ==>++(==>) :: Testable a => Bool -> a -> Property+True ==>  x = Property (property x)+False ==> x = Property (const (result nothing))++--------------------- <top-level test drivers> ----------------------++-- similar in spirit to QuickCheck but with iterative deepening++test :: Testable a => a -> IO ()+test = smallCheckI++-- test for values of depths 0..d stopping when a property+-- fails or when it has been checked for all these values+smallCheck :: Testable a => Int -> a -> IO ()+smallCheck d = iterCheck 0 (Just d)++-- interactive variant, asking the user whether testing should+-- continue/go deeper after a failure/completed iteration+smallCheckI :: Testable a => a -> IO ()+smallCheckI = iterCheck 0 Nothing++depthCheck :: Testable a => Int -> a -> IO ()+depthCheck d = iterCheck d (Just d)++iterCheck :: Testable a => Int -> Maybe Int -> a -> IO ()+iterCheck dFrom mdTo t = iter dFrom+  where+  iter d = do+    putStrLn ("Depth "++show d++":")+    let Prop results = property t d+    ok <- check (mdTo==Nothing) 0 0 True results+    maybe (whenUserWishes "  Deeper" () $ iter (d+1))+          (\dTo -> when (ok && d < dTo) $ iter (d+1))+          mdTo++check :: Bool -> Int -> Int -> Bool -> [Result] -> IO Bool+check i n x ok rs | null rs = do+  putStr ("  Completed "++show n++" test(s)")+  putStrLn (if ok then " without failure." else ".")+  when (x > 0) $+    putStrLn ("  But "++show x++" did not meet ==> condition.")+  return ok+check i n x ok (Result Nothing _ : rs) = do+  progressReport i n x+  check i (n+1) (x+1) ok rs+check i n x f (Result (Just True) _ : rs) = do+  progressReport i n x+  check i (n+1) x f rs+check i n x f (Result (Just False) args : rs) = do+  putStrLn ("  Failed test no. "++show (n+1)++". Test values follow.")+  mapM_ (putStrLn . ("  "++)) args+  ( if i then+      whenUserWishes "  Continue" False $ check i (n+1) x False rs+    else+      return False )++whenUserWishes :: String -> a -> IO a -> IO a+whenUserWishes wish x action = do+  putStr (wish++"? ")+  hFlush stdout+  reply <- getLine+  ( if (null reply || reply=="y") then action+    else return x )++progressReport :: Bool -> Int -> Int -> IO ()+progressReport i n x | n >= x = do+  when i $ ( putStr (n' ++ replicate (length n') '\b') >>+             hFlush stdout )+  where+  n' = show n+++run :: Testable a => a -> Property+run p = Property (property p)++data TestResult = TestOk        Int+                | TestExhausted Int+                | TestFailed    Int [String]++data TestOptions = TestOptions {+                     testDepth :: Int,+                     maxTests  :: Int+                   }++runTest :: TestOptions -> Property -> TestResult+runTest TestOptions { testDepth = depth, maxTests = max } p =+  let Prop results = property p depth+   in check 0 results+  +  where check n _ | n >= max                    = TestExhausted n+        check n                             []  = TestOk n+        check n (Result Nothing      _    : rs) = check (n+1) rs+        check n (Result (Just True ) _    : rs) = check (n+1) rs+        check n (Result (Just False) args : rs) = TestFailed n args+  ++runTests :: String -> TestOptions -> [Property] -> IO ()+runTests name opts props =++  do putStr (rjustify 25 name ++ " : ")+     failures <- tr 1 props [] 0+     mapM fa (reverse failures)+     return ()+  where+	rjustify n s = replicate (max 0 (n - length s)) ' ' ++ s++	tr n [] xs c = do+			putStr (rjustify (max 0 (35-n)) " (" ++ show c ++ ")\n")+			return xs+	tr n (prop:props) failures c = +	   case runTest opts prop of+		TestOk m+			-> do { putStr "." ;+			       tr (n+1) props failures (c+m) }+		TestExhausted m+			-> do { putStr "?" ;+			       tr (n+1) props failures (c+m) }+	  	TestFailed m args+			-> do { putStr "#" ;+			        tr (n+1) props ((args,n,m):failures) c }++	fa :: ([String],Int,Int) -> IO ()+	fa (f,n,m) = +	  do putStr "\n"+	     putStr ("    ** test " +			++ show (n  :: Int)+			++ " of "+			++ name+			++ " failed (after " ++ show m ++ " steps) with the binding(s)\n")+	     sequence_ [putStr ("    **   " ++ v ++ "\n")+			| v <- f ]+  	     putStr "\n"+++------------------------------------------------------------------------+--+-- foldl'+-- lines too strict+-- structure of domain, insert bottoms in correct position.+--