packages feed

EdisonCore 1.2.1.1 → 1.2.1.2

raw patch · 27 files changed

+1294/−1258 lines, 27 filesdep −haskell98dep ~QuickCheck

Dependencies removed: haskell98

Dependency ranges changed: QuickCheck

Files

EdisonCore.cabal view
@@ -1,7 +1,7 @@ Name:           EdisonCore Cabal-Version:  >= 1.2 Build-Type:     Simple-Version:        1.2.1.1+Version:        1.2.1.2 License:        OtherLicense License-File:   COPYRIGHT Author:         Chris Okasaki@@ -47,7 +47,8 @@      Data.Edison.Seq.SimpleQueue      Data.Edison.Seq.SizedSeq   Build-Depends:-     base, haskell98, mtl, QuickCheck,+     base, mtl,+     QuickCheck >= 1.0 && < 2,      EdisonAPI == 1.2.1   if impl( ghc >= 6.8 )      Build-Depends:
src/Data/Edison/Assoc/AssocList.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Assoc.AssocList---   Copyright   :  Copyright (c) 1998 Chris Okasaki+--   Copyright   :  Copyright (c) 1998, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -8,7 +8,7 @@ --   Portability :  GHC, Hugs (MPTC and FD) -- --   This module implements finite maps as simple association lists.---  +-- --   Duplicates are removed conceptually, but not physically.  The first --   occurrence of a given key is the one that is considered to be in the map. --@@ -29,7 +29,7 @@      -- * OrdAssocX operations     minView, minElem, deleteMin, unsafeInsertMin, maxView, maxElem, deleteMax,-    unsafeInsertMax, foldr, foldr', foldl, foldl', foldr1, foldr1', +    unsafeInsertMax, foldr, foldr', foldl, foldl', foldr1, foldr1',     foldl1, foldl1', unsafeFromOrdSeq, unsafeAppend,     filterLT, filterLE, filterGT, filterGE,     partitionLT_GE, partitionLE_GT, partitionLT_GT,@@ -58,7 +58,6 @@ import qualified Prelude import Data.Monoid import Control.Monad.Identity-import Data.Edison.Prelude import qualified Data.Edison.Assoc as A import qualified Data.Edison.Seq as S import qualified Data.Edison.Seq.BinaryRandList as RL@@ -105,24 +104,24 @@ partition     :: Eq k => (a -> Bool) -> FM k a -> (FM k a, FM k a) elements      :: (Eq k,S.Sequence seq) => FM k a -> seq a -fromSeqWith      :: (Eq k,S.Sequence seq) => +fromSeqWith      :: (Eq k,S.Sequence seq) =>                         (a -> a -> a) -> seq (k,a) -> FM k a fromSeqWithKey   :: (Eq k,S.Sequence seq) => (k -> a -> a -> a) -> seq (k,a) -> FM k a insertWith       :: Eq k => (a -> a -> a) -> k -> a -> FM k a -> FM k a insertWithKey    :: Eq k => (k -> a -> a -> a) -> k -> a -> FM k a -> FM k a-insertSeqWith    :: (Eq k,S.Sequence seq) => +insertSeqWith    :: (Eq k,S.Sequence seq) =>                         (a -> a -> a) -> seq (k,a) -> FM k a -> FM k a-insertSeqWithKey :: (Eq k,S.Sequence seq) => +insertSeqWithKey :: (Eq k,S.Sequence seq) =>                         (k -> a -> a -> a) -> seq (k,a) -> FM k a -> FM k a unionl           :: Eq k => FM k a -> FM k a -> FM k a unionr           :: Eq k => FM k a -> FM k a -> FM k a unionWith        :: Eq k => (a -> a -> a) -> FM k a -> FM k a -> FM k a-unionSeqWith     :: (Eq k,S.Sequence seq) => +unionSeqWith     :: (Eq k,S.Sequence seq) =>                         (a -> a -> a) -> seq (FM k a) -> FM k a intersectionWith :: Eq k => (a -> b -> c) -> FM k a -> FM k b -> FM k c difference       :: Eq k => FM k a -> FM k b -> FM k a-properSubset     :: Eq k => FM k a -> FM k b -> Bool    -subset           :: Eq k => FM k a -> FM k b -> Bool    +properSubset     :: Eq k => FM k a -> FM k b -> Bool+subset           :: Eq k => FM k a -> FM k b -> Bool properSubmapBy   :: Eq k => (a -> a -> Bool) -> FM k a -> FM k a -> Bool submapBy         :: Eq k => (a -> a -> Bool) -> FM k a -> FM k a -> Bool sameMapBy        :: Eq k => (a -> a -> Bool) -> FM k a -> FM k a -> Bool@@ -139,7 +138,7 @@ partitionWithKey :: Eq k => (k -> a -> Bool) -> FM k a -> (FM k a, FM k a)  unionWithKey     :: Eq k => (k -> a -> a -> a) -> FM k a -> FM k a -> FM k a-unionSeqWithKey  :: (Eq k,S.Sequence seq) => +unionSeqWithKey  :: (Eq k,S.Sequence seq) =>                         (k -> a -> a -> a) -> seq (FM k a) -> FM k a intersectionWithKey :: Eq k => (k -> a -> b -> c) -> FM k a -> FM k b -> FM k c @@ -193,10 +192,12 @@ -- some unexported utility functions  -- uncurried insert.+uinsert :: (t, t1) -> FM t t1 -> FM t t1 uinsert (k,x) = I k x   -- left biased merge.+mergeFM :: (Ord t) => FM t t1 -> FM t t1 -> FM t t1 mergeFM E m = m mergeFM m E = m mergeFM o1@(I k1 a1 m1) o2@(I k2 a2 m2) =@@ -205,67 +206,69 @@       GT -> I k2 a2 (mergeFM o1 m2)       EQ -> I k1 a1 (mergeFM m1 m2) +toRandList :: FM t t1 -> RL.Seq (FM t t1) toRandList E = RL.empty toRandList (I k a m) = RL.lcons (I k a E) (toRandList m) +mergeSortFM :: (Ord t) => FM t t1 -> FM t t1 mergeSortFM m = RL.reducer mergeFM E (toRandList m)  foldrFM :: Eq k => (a -> b -> b) -> b -> FM k a -> b-foldrFM f z E = z+foldrFM _ z E = z foldrFM f z (I k a m) = f a (foldrFM f z (delete k m))  foldr1FM :: Eq k => (a -> a -> a) -> FM k a -> a-foldr1FM f (I k a E) = a+foldr1FM _ (I _ a E) = a foldr1FM f (I k a m) = f a (foldr1FM f (delete k m))-foldr1FM f _ = error "invalid call to foldr1FM on empty map"+foldr1FM _ _ = error "invalid call to foldr1FM on empty map"  foldrFM' :: Eq k => (a -> b -> b) -> b -> FM k a -> b-foldrFM' f z E = z+foldrFM' _ z E = z foldrFM' f z (I k a m) = f a $! (foldrFM' f z (delete k m))  foldr1FM' :: Eq k => (a -> a -> a) -> FM k a -> a-foldr1FM' f (I k a E) = a+foldr1FM' _ (I _ a E) = a foldr1FM' f (I k a m) = f a $! (foldr1FM' f (delete k m))-foldr1FM' f _ = error "invalid call to foldr1FM' on empty map"+foldr1FM' _ _ = error "invalid call to foldr1FM' on empty map"  foldlFM :: Eq k => (b -> a -> b) -> b -> FM k a -> b-foldlFM f x E = x+foldlFM _ x E = x foldlFM f x (I k a m) = foldlFM f (f x a) (delete k m)  foldlFM' :: Eq k => (b -> a -> b) -> b -> FM k a -> b-foldlFM' f x E = x+foldlFM' _ x E = x foldlFM' f x (I k a m) = x `seq` foldlFM' f (f x a) (delete k m)  foldrWithKeyFM :: Eq k => (k -> a -> b -> b) -> b -> FM k a -> b-foldrWithKeyFM f z E = z+foldrWithKeyFM _ z E = z foldrWithKeyFM f z (I k a m) = f k a (foldrWithKeyFM f z (delete k m))  foldrWithKeyFM' :: Eq k => (k -> a -> b -> b) -> b -> FM k a -> b-foldrWithKeyFM' f z E = z+foldrWithKeyFM' _ z E = z foldrWithKeyFM' f z (I k a m) = f k a $! (foldrWithKeyFM' f z (delete k m))  foldlWithKeyFM :: Eq k => (b -> k -> a -> b) -> b -> FM k a -> b-foldlWithKeyFM f x E = x+foldlWithKeyFM _ x E = x foldlWithKeyFM f x (I k a m) = foldlWithKeyFM f (f x k a) (delete k m)  foldlWithKeyFM' :: Eq k => (b -> k -> a -> b) -> b -> FM k a -> b-foldlWithKeyFM' f x E = x+foldlWithKeyFM' _ x E = x foldlWithKeyFM' f x (I k a m) = x `seq` foldlWithKeyFM' f (f x k a) (delete k m)  takeWhileFM :: (k -> Bool) -> FM k a -> FM k a-takeWhileFM p E = E+takeWhileFM _ E = E takeWhileFM p (I k a m)    | p k       = I k a (takeWhileFM p m)    | otherwise = E  dropWhileFM :: (k -> Bool) -> FM k a -> FM k a-dropWhileFM p E = E-dropWhileFM p o@(I k a m)+dropWhileFM _ E = E+dropWhileFM p o@(I k _ m)    | p k       = dropWhileFM p m    | otherwise = o  spanFM :: (k -> Bool) -> FM k a -> (FM k a,FM k a)-spanFM p E = (E,E)+spanFM _ E = (E,E) spanFM p o@(I k a m)    | p k       = let (x,y) = spanFM p m in (I k a x,y)    | otherwise = (E,o)@@ -286,63 +289,63 @@  unionSeq = S.foldr union E -deleteAll key E = E-deleteAll key (I k x m) | key == k  = deleteAll key m +deleteAll _ E = E+deleteAll key (I k x m) | key == k  = deleteAll key m                         | otherwise = I k x (deleteAll key m)  delete = deleteAll  null E = True-null (I k x m) = False+null (I _ _ _) = False  size E = 0-size (I k x m) = 1 + size (delete k m)+size (I k _ m) = 1 + size (delete k m) -member key E = False-member key (I k x m) = key == k || member key m+member _ E = False+member key (I k _ m) = key == k || member key m -count key E = 0-count key (I k x m) | key == k  = 1+count _ E = 0+count key (I k _ m) | key == k  = 1                     | otherwise = count key m  lookup key m = runIdentity (lookupM key m) -lookupM key E = fail "AssocList.lookup: lookup failed"+lookupM _ E = fail "AssocList.lookup: lookup failed" lookupM key (I k x m) | key == k  = return x                       | otherwise = lookupM key m -lookupAll key E = S.empty-lookupAll key (I k x m) | key == k  = S.singleton x +lookupAll _ E = S.empty+lookupAll key (I k x m) | key == k  = S.singleton x                         | otherwise = lookupAll key m  lookupAndDelete key m = runIdentity (lookupAndDeleteM key m) -lookupAndDeleteM key E = fail "AssocList.lookupAndDeleteM: lookup failed"+lookupAndDeleteM _ E = fail "AssocList.lookupAndDeleteM: lookup failed" lookupAndDeleteM key (I k x m)    | key == k  = return (x,delete k m)-   | otherwise = lookupAndDeleteM key m >>= +   | otherwise = lookupAndDeleteM key m >>=                     \ (z, m') -> return (z, I k x m') -lookupAndDeleteAll key m = +lookupAndDeleteAll key m =    case lookupAndDeleteM key m of       Nothing     -> (S.empty,m)       Just (z,m') -> (S.singleton z,m')  -lookupWithDefault d key E = d+lookupWithDefault d _ E = d lookupWithDefault d key (I k x m) | key == k = x                                   | otherwise = lookupWithDefault d key m  elements E = S.empty elements (I k x m) = S.lcons x (elements (delete k m)) -adjust f key E = E+adjust _ _ E = E adjust f key (I k x m) | key == k  = I key (f x) m                        | otherwise = I k x (adjust f key m)  adjustAll = adjust -adjustOrInsert f z key E = singleton key z+adjustOrInsert _ z key E = singleton key z adjustOrInsert f z key (I k x m)     | key == k  = I key (f x) m     | otherwise = I k x (adjustOrInsert f z key m)@@ -352,26 +355,26 @@ adjustOrDelete = adjustOrDeleteDefault adjustOrDeleteAll = adjustOrDeleteAllDefault -map f E = E+map _ E = E map f (I k x m) = I k (f x) (map f m) -fold f c E = c+fold _ c E = c fold f c (I k x m) = fold f (f x c) (delete k m) -fold' f c E = c+fold' _ c E = c fold' f c (I k x m) = c `seq` fold' f (f x c) (delete k m) -fold1 f E = error "AssocList.fold1: empty map"+fold1 _ E = error "AssocList.fold1: empty map" fold1 f (I k x m) = fold f x (delete k m) -fold1' f E = error "AssocList.fold1': empty map"+fold1' _ E = error "AssocList.fold1': empty map" fold1' f (I k x m) = fold' f x (delete k m) -filter p E = E+filter _ E = E filter p (I k x m) | p x = I k x (filter p (delete k m))                    | otherwise = filter p (delete k m) -partition p E = (E, E)+partition _ E = (E, E) partition p (I k x m)     | p x       = (I k x m1,m2)     | otherwise = (m1,I k x m2)@@ -382,23 +385,23 @@ toSeq (I k x m) = S.lcons (k,x) (toSeq (delete k m))  keys E = S.empty-keys (I k x m) = S.lcons k (keys (delete k m))+keys (I k _ m) = S.lcons k (keys (delete k m)) -mapWithKey f E = E+mapWithKey _ E = E mapWithKey f (I k x m) = I k (f k x) (mapWithKey f m) -foldWithKey f c E = c+foldWithKey _ c E = c foldWithKey f c (I k x m) = foldWithKey f (f k x c) (delete k m) -foldWithKey' f c E = c+foldWithKey' _ c E = c foldWithKey' f c (I k x m) = c `seq` foldWithKey' f (f k x c) (delete k m) -filterWithKey p E = E-filterWithKey p (I k x m) +filterWithKey _ E = E+filterWithKey p (I k x m)     | p k x = I k x (filterWithKey p (delete k m))     | otherwise = filterWithKey p (delete k m) -partitionWithKey p E = (E, E)+partitionWithKey _ E = (E, E) partitionWithKey p (I k x m)     | p k x     = (I k x m1,m2)     | otherwise = (m1,I k x m2)@@ -408,11 +411,13 @@ unionr = flip union  +findMin :: (Ord t) => t -> t1 -> FM t t1 -> (t, t1) findMin k0 x E = (k0,x) findMin k0 a0 (I k a m)         | k < k0    = findMin k  a  (delete k m)         | otherwise = findMin k0 a0 (delete k m) +findMax ::( Ord t) => t -> t1 -> FM t t1 -> (t, t1) findMax k0 x E = (k0,x) findMax k0 a0 (I k a m)         | k > k0    = findMax k  a  (delete k m)@@ -446,25 +451,25 @@ foldr1 f m =   case mergeSortFM m of     E -> error $ moduleName++".foldlr1: empty map"-    m -> foldr1FM f m+    n -> foldr1FM f n  foldr1' f m =   case mergeSortFM m of     E -> error $ moduleName++".foldlr1': empty map"-    m -> foldr1FM' f m-   +    n -> foldr1FM' f n+ foldl  f x m = foldlFM  f x (mergeSortFM m) foldl' f x m = foldlFM' f x (mergeSortFM m)  foldl1 f m =   case mergeSortFM m of     E -> error $ moduleName++".foldl1: empty map"-    I k a m -> foldlFM f a (delete k m)+    I k a n -> foldlFM f a (delete k n)  foldl1' f m =   case mergeSortFM m of     E -> error $ moduleName++".foldl1': empty map"-    I k a m -> foldlFM' f a (delete k m)+    I k a n -> foldlFM' f a (delete k n)  unsafeFromOrdSeq   = fromSeq unsafeAppend       = union@@ -496,10 +501,10 @@   strict n@E = n-strict n@(I k a m) = strict m `seq` n+strict n@(I _ _ m) = strict m `seq` n -strictWith f n@E = n-strictWith f n@(I k a m) = f a `seq` strictWith f m `seq` n+strictWith _ n@E = n+strictWith f n@(I _ a m) = f a `seq` strictWith f m `seq` n   -- defaults@@ -530,21 +535,21 @@ -- instance declarations  instance Eq k  => A.AssocX (FM k) k where-  {empty = empty; singleton = singleton; fromSeq = fromSeq; insert = insert; -   insertSeq = insertSeq; union = union; unionSeq = unionSeq; -   delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; -   null = null; size = size; member = member; count = count; -   lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; +  {empty = empty; singleton = singleton; fromSeq = fromSeq; insert = insert;+   insertSeq = insertSeq; union = union; unionSeq = unionSeq;+   delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;+   null = null; size = size; member = member; count = count;+   lookup = lookup; lookupM = lookupM; lookupAll = lookupAll;    lookupAndDelete = lookupAndDelete; lookupAndDeleteM = lookupAndDeleteM;    lookupAndDeleteAll = lookupAndDeleteAll;-   lookupWithDefault = lookupWithDefault; adjust = adjust; +   lookupWithDefault = lookupWithDefault; adjust = adjust;    adjustAll = adjustAll; adjustOrInsert = adjustOrInsert;    adjustAllOrInsert = adjustAllOrInsert;    adjustOrDelete = adjustOrDelete; adjustOrDeleteAll = adjustOrDeleteAll;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; elements = elements;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName m = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Ord k => A.OrdAssocX (FM k) k where   {minView = minView; minElem = minElem; deleteMin = deleteMin;@@ -558,11 +563,11 @@    partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}  instance Eq k => A.FiniteMapX (FM k) k where-  {fromSeqWith = fromSeqWith; fromSeqWithKey = fromSeqWithKey; -   insertWith  = insertWith; insertWithKey = insertWithKey; -   insertSeqWith = insertSeqWith; insertSeqWithKey = insertSeqWithKey; -   unionl = unionl; unionr = unionr; unionWith = unionWith; -   unionSeqWith = unionSeqWith; intersectionWith = intersectionWith; +  {fromSeqWith = fromSeqWith; fromSeqWithKey = fromSeqWithKey;+   insertWith  = insertWith; insertWithKey = insertWithKey;+   insertSeqWith = insertSeqWith; insertSeqWithKey = insertSeqWithKey;+   unionl = unionl; unionr = unionr; unionWith = unionWith;+   unionSeqWith = unionSeqWith; intersectionWith = intersectionWith;    difference = difference; properSubset = properSubset; subset = subset;    properSubmapBy = properSubmapBy; submapBy = submapBy;    sameMapBy = sameMapBy}@@ -570,9 +575,9 @@ instance Ord k => A.OrdFiniteMapX (FM k) k  instance Eq k  => A.Assoc (FM k) k where-  {toSeq = toSeq; keys = keys; mapWithKey = mapWithKey; +  {toSeq = toSeq; keys = keys; mapWithKey = mapWithKey;    foldWithKey = foldWithKey; foldWithKey' = foldWithKey';-   filterWithKey = filterWithKey; +   filterWithKey = filterWithKey;    partitionWithKey = partitionWithKey}  instance Ord k => A.OrdAssoc (FM k) k where@@ -583,7 +588,7 @@    toOrdSeq = toOrdSeq}  instance Eq k => A.FiniteMap (FM k) k where-  {unionWithKey = unionWithKey; unionSeqWithKey = unionSeqWithKey; +  {unionWithKey = unionWithKey; unionSeqWithKey = unionSeqWithKey;    intersectionWithKey = intersectionWithKey}  instance Ord k => A.OrdFiniteMap (FM k) k
src/Data/Edison/Assoc/Defaults.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Assoc.Defaults---   Copyright   :  Copyright (c) 1998 Chris Okasaki+--   Copyright   :  Copyright (c) 1998, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -14,7 +14,6 @@ module Data.Edison.Assoc.Defaults where  import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter)-import Data.Maybe (fromJust)  import Data.Edison.Assoc import qualified Data.Edison.Seq as S@@ -27,7 +26,7 @@ fromSeqUsingInsertSeq :: (AssocX m k,S.Sequence seq) => seq (k,a) -> m a fromSeqUsingInsertSeq kvs = insertSeq kvs empty -insertSeqUsingFoldr :: +insertSeqUsingFoldr ::     (AssocX m k,S.Sequence seq) => seq (k,a) -> m a -> m a insertSeqUsingFoldr kvs m = S.foldr (uncurry insert) m kvs @@ -40,8 +39,8 @@ memberUsingLookupM :: (AssocX m k) => k -> m a -> Bool memberUsingLookupM k m   = case lookupM k m of-  	Just _  -> True-	Nothing -> False+        Just _  -> True+        Nothing -> False  sizeUsingElements :: (AssocX m k) => m a -> Int sizeUsingElements m = length (elements m)@@ -71,10 +70,10 @@ nullUsingElements :: (AssocX m k) => m a -> Bool nullUsingElements m   = case elements m of-  	[] -> True-  	_  -> False+        [] -> True+        _  -> False -insertWithUsingLookupM :: +insertWithUsingLookupM ::     FiniteMapX m k => (a -> a -> a) -> k -> a -> m a -> m a insertWithUsingLookupM f k x m =     case lookupM k m of@@ -85,31 +84,31 @@     (FiniteMapX m k,S.Sequence seq) => (a -> a -> a) -> seq (k,a) -> m a fromSeqWithUsingInsertSeqWith f kvs = insertSeqWith f kvs empty -fromSeqWithKeyUsingInsertSeqWithKey :: +fromSeqWithKeyUsingInsertSeqWithKey ::     (FiniteMapX m k,S.Sequence seq) => (k -> a -> a -> a) -> seq (k,a) -> m a fromSeqWithKeyUsingInsertSeqWithKey f kvs = insertSeqWithKey f kvs empty -insertWithKeyUsingInsertWith :: +insertWithKeyUsingInsertWith ::     FiniteMapX m k => (k -> a -> a -> a) -> k -> a -> m a -> m a insertWithKeyUsingInsertWith f k = insertWith (f k) k -insertSeqWithUsingInsertWith :: -    (FiniteMapX m k,S.Sequence seq) => +insertSeqWithUsingInsertWith ::+    (FiniteMapX m k,S.Sequence seq) =>       (a -> a -> a) -> seq (k,a) -> m a -> m a insertSeqWithUsingInsertWith f kvs m =     S.foldr (uncurry (insertWith f)) m kvs  insertSeqWithKeyUsingInsertWithKey ::-    (FiniteMapX m k,S.Sequence seq) => +    (FiniteMapX m k,S.Sequence seq) =>       (k -> a -> a -> a) -> seq (k,a) -> m a -> m a insertSeqWithKeyUsingInsertWithKey f kvs m =     S.foldr (uncurry (insertWithKey f)) m kvs -unionSeqWithUsingReduce :: +unionSeqWithUsingReduce ::     (FiniteMapX m k,S.Sequence seq) => (a -> a -> a) -> seq (m a) -> m a unionSeqWithUsingReduce f ms = S.reducel (unionWith f) empty ms -unionSeqWithUsingFoldr :: +unionSeqWithUsingFoldr ::     (FiniteMapX m k,S.Sequence seq) => (a -> a -> a) -> seq (m a) -> m a unionSeqWithUsingFoldr f ms = S.foldr (unionWith f) empty ms @@ -119,34 +118,34 @@  keysUsingFoldWithKey :: (Assoc m k,S.Sequence seq) => m a -> seq k keysUsingFoldWithKey = foldWithKey conskey S.empty-  where conskey k v ks = S.lcons k ks+  where conskey k _ ks = S.lcons k ks -unionWithUsingInsertWith :: +unionWithUsingInsertWith ::     FiniteMap m k => (a -> a -> a) -> m a -> m a -> m a unionWithUsingInsertWith f m1 m2 = foldWithKey (insertWith f) m2 m1 -unionWithKeyUsingInsertWithKey :: +unionWithKeyUsingInsertWithKey ::     FiniteMap m k => (k -> a -> a -> a) -> m a -> m a -> m a unionWithKeyUsingInsertWithKey f m1 m2 = foldWithKey (insertWithKey f) m2 m1 -unionSeqWithKeyUsingReduce :: -    (FiniteMap m k,S.Sequence seq) => +unionSeqWithKeyUsingReduce ::+    (FiniteMap m k,S.Sequence seq) =>       (k -> a -> a -> a) -> seq (m a) -> m a unionSeqWithKeyUsingReduce f ms = S.reducel (unionWithKey f) empty ms -unionSeqWithKeyUsingFoldr :: -    (FiniteMap m k,S.Sequence seq) => +unionSeqWithKeyUsingFoldr ::+    (FiniteMap m k,S.Sequence seq) =>       (k -> a -> a -> a) -> seq (m a) -> m a unionSeqWithKeyUsingFoldr f ms = S.foldr (unionWithKey f) empty ms -intersectionWithUsingLookupM :: +intersectionWithUsingLookupM ::     FiniteMap m k => (a -> b -> c) -> m a -> m b -> m c intersectionWithUsingLookupM f m1 m2 = foldWithKey ins empty m1   where ins k x m = case lookupM k m2 of                       Nothing -> m                       Just y  -> insert k (f x y) m -intersectionWithKeyUsingLookupM :: +intersectionWithKeyUsingLookupM ::     FiniteMap m k => (k -> a -> b -> c) -> m a -> m b -> m c intersectionWithKeyUsingLookupM f m1 m2 = foldWithKey ins empty m1   where ins k x m = case lookupM k m2 of@@ -164,7 +163,7 @@ subsetUsingMember m1 m2 = foldWithKey mem True m1   where mem k _ b = member k m2 && b -submapByUsingLookupM :: FiniteMap m k +submapByUsingLookupM :: FiniteMap m k                      => (a -> a -> Bool) -> m a -> m a -> Bool submapByUsingLookupM  f m1 m2 = foldWithKey aux True m1   where aux k x b =@@ -172,7 +171,7 @@              Nothing -> False              Just y  -> f x y && b -properSubmapByUsingSubmapBy :: FiniteMapX m k +properSubmapByUsingSubmapBy :: FiniteMapX m k                             => (a -> a -> Bool) -> m a -> m a -> Bool properSubmapByUsingSubmapBy f m1 m2 = size m1 < size m2 && submapBy f m1 m2 @@ -213,8 +212,8 @@ adjustOrDeleteDefault f k m =   case lookupAndDeleteM k m of     Nothing -> m-    Just (elem,m') ->-      case f elem of+    Just (element,m') ->+      case f element of          Nothing -> m'          Just x  -> insert k x m' @@ -222,8 +221,8 @@ adjustOrDeleteAllDefault f k m =   let (elems,m') = lookupAndDeleteAll k m       adjSeq = S.map f elems-      ins Nothing  m = m-      ins (Just x) m = insert k x m+      ins Nothing  n = n+      ins (Just x) n = insert k x n   in L.foldr ins m' adjSeq  minElemUsingMinView :: OrdAssocX m k => m a -> a@@ -271,9 +270,9 @@    | otherwise = concat ["(",instanceName xs,".fromSeq ",showsPrec 10 (toList xs) (')':rest)]  readsPrecUsingFromList :: (Read k, Read a, AssocX m k) => Int -> ReadS (m a)-readsPrecUsingFromList i xs =+readsPrecUsingFromList _ xs =    let result = maybeParens p xs-       p xs = tokenMatch ((instanceName x)++".fromSeq") xs+       p ys = tokenMatch ((instanceName x)++".fromSeq") ys                 >>= readsPrec 10                 >>= \(l,rest) -> return (fromList l,rest) @@ -291,7 +290,7 @@ readsPrecUsingUnsafeFromOrdSeq :: (Read k,Read a,OrdAssoc m k) => Int -> ReadS (m a) readsPrecUsingUnsafeFromOrdSeq i xs =    let result = maybeParens p xs-       p xs = tokenMatch ((instanceName x)++".unsafeFromOrdSeq") xs+       p ys = tokenMatch ((instanceName x)++".unsafeFromOrdSeq") ys                 >>= readsPrec i                 >>= \(l,rest) -> return (unsafeFromOrdList l,rest) @@ -307,7 +306,7 @@   cmp [] [] = EQ   cmp [] _  = LT   cmp _  [] = GT-  cmp (x:xs) (y:ys) =-      case compare x y of-         EQ -> cmp xs ys+  cmp (v:vs) (z:zs) =+      case compare v z of+         EQ -> cmp vs zs          c -> c
src/Data/Edison/Assoc/PatriciaLoMap.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Assoc.PatriciaLoMap---   Copyright   :  Copyright (c) 1998 Chris Okasaki+--   Copyright   :  Copyright (c) 1998, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -57,7 +57,6 @@ import qualified Prelude import Control.Monad.Identity (runIdentity) import Data.Monoid-import Data.Edison.Prelude import qualified Data.Edison.Assoc as A import qualified Data.Edison.Seq as S import qualified Data.Edison.Seq.ListSeq as L@@ -66,6 +65,7 @@ import Data.Bits import Test.QuickCheck (Arbitrary(..), variant) +moduleName :: String moduleName = "Data.Edison.Assoc.PatriciaLoMap"  data FM a@@ -83,12 +83,12 @@  structuralInvariant :: FM a -> Bool structuralInvariant E = True-structuralInvariant (L k x) = True+structuralInvariant (L _ _) = True structuralInvariant x = inv 0 0 x  inv :: Int -> Int -> FM a -> Bool-inv pre msk E = False-inv pre msk (L k x) = k .&. msk == pre+inv _ _ E = False+inv pre msk (L k _) = k .&. msk == pre inv pre msk (B p m t0 t1) =     (p .&. msk == pre) &&     (bitcount 0 m == 1) &&@@ -106,21 +106,24 @@  -- auxiliary functions -makeB p m E t = t-makeB p m t E = t+makeB :: Int -> Int -> FM t -> FM t -> FM t+makeB _ _ E t = t+makeB _ _ t E = t makeB p m t0 t1 = B p m t0 t1 -lmakeB p m E t = t+lmakeB :: Int -> Int -> FM t -> FM t -> FM t+lmakeB _ _ E t = t lmakeB p m t0 t1 = B p m t0 t1 -rmakeB p m t E = t+rmakeB :: Int -> Int -> FM a -> FM a -> FM a+rmakeB _ _ t E = t rmakeB p m t0 t1 = B p m t0 t1  lowestBit :: Int32 -> Int32 lowestBit x = x .&. (-x)  branchingBit :: Int -> Int -> Int-branchingBit p0 p1 = +branchingBit p0 p1 =   fromIntegral (lowestBit (fromIntegral p0 `xor` fromIntegral p1))  mask :: Int -> Int -> Int@@ -132,12 +135,14 @@ matchPrefix :: Int -> Int -> Int -> Bool matchPrefix k p m = mask k m == p +join :: Int -> FM a -> Int -> FM a -> FM a join p0 t0 p1 t1 =   let m = branchingBit p0 p1   in if zeroBit p0 m then B (mask p0 m) m t0 t1                      else B (mask p0 m) m t1 t0 -keepR x y = y+keepR :: forall t t1. t -> t1 -> t1+keepR _ y = y  -- end auxiliary functions @@ -152,7 +157,7 @@  insert :: Int -> a -> FM a -> FM a insert k x E = L k x-insert k x t@(L j y) = if j == k then L k x else join k (L k x) j t+insert k x t@(L j _) = if j == k then L k x else join k (L k x) j t insert k x t@(B p m t0 t1) =     if matchPrefix k p m then       if zeroBit k m then B p m (insert k x t0) t1@@ -181,8 +186,8 @@ union E t = t  delete :: Int -> FM a -> FM a-delete k E = E-delete k t@(L j x) = if k == j then E else t+delete _ E = E+delete k t@(L j _) = if k == j then E else t delete k t@(B p m t0 t1) =     if matchPrefix k p m then       if zeroBit k m then lmakeB p m (delete k t0) t1@@ -199,22 +204,22 @@ size (B _ _ t0 t1) = size t0 + size t1  member :: Int -> FM a -> Bool-member k E = False-member k (L j x) = (j == k)-member k (B p m t0 t1) = if zeroBit k m then member k t0 else member k t1+member _ E = False+member k (L j _) = (j == k)+member k (B _ m t0 t1) = if zeroBit k m then member k t0 else member k t1  lookup :: Int -> FM a -> a lookup k m = runIdentity (lookupM k m)  lookupM :: (Monad rm) => Int -> FM a -> rm a-lookupM k E = fail "PatriciaLoMap.lookup: lookup failed"+lookupM _ E = fail "PatriciaLoMap.lookup: lookup failed" lookupM k (L j x)   | j == k    = return x   | otherwise = fail "PatriciaLoMap.lookup: lookup failed"-lookupM k (B p m t0 t1) = if zeroBit k m then lookupM k t0 else lookupM k t1+lookupM k (B _ m t0 t1) = if zeroBit k m then lookupM k t0 else lookupM k t1  doLookupAndDelete :: z -> (a -> FM a -> z) -> Int -> FM a -> z-doLookupAndDelete onFail cont k E = onFail+doLookupAndDelete onFail _ _ E = onFail doLookupAndDelete onFail cont k (L j x)      | j == k    = cont x E      | otherwise = onFail@@ -223,12 +228,12 @@      | otherwise   = doLookupAndDelete onFail (\x t1' -> cont x (makeB p m t0 t1')) k t1  lookupAndDelete :: Int -> FM a -> (a, FM a)-lookupAndDelete        = doLookupAndDelete -                           (error "PatriciaLoMap.lookupAndDelete: lookup failed") +lookupAndDelete        = doLookupAndDelete+                           (error "PatriciaLoMap.lookupAndDelete: lookup failed")                            (,)  lookupAndDeleteM :: Monad m => Int -> FM a -> m (a, FM a)-lookupAndDeleteM       = doLookupAndDelete +lookupAndDeleteM       = doLookupAndDelete                            (fail "PatriciaLoMap.lookupAndDelete: lookup failed")                            (\x m -> return (x,m)) @@ -240,7 +245,7 @@   adjust :: (a -> a) -> Int -> FM a -> FM a-adjust f k E = E+adjust _ _ E = E adjust f k t@(L j x) = if k == j then L k (f x) else t adjust f k t@(B p m t0 t1) =     if matchPrefix k p m then@@ -262,48 +267,48 @@ adjustOrDeleteAll = adjustOrDeleteDefault  map :: (a -> b) -> FM a -> FM b-map f E = E+map _ E = E map f (L k x) = L k (f x) map f (B p m t0 t1) = B p m (map f t0) (map f t1)  fold :: (a -> b -> b) -> b -> FM a -> b-fold f c E = c-fold f c (L k x) = f x c-fold f c (B p m t0 t1) = fold f (fold f c t1) t0+fold _ c E = c+fold f c (L _ x) = f x c+fold f c (B _ _ t0 t1) = fold f (fold f c t1) t0  fold' :: (a -> b -> b) -> b -> FM a -> b-fold' f c E = c-fold' f c (L k x) = c `seq` f x c-fold' f c (B p m t0 t1) = c `seq` (fold f $! (fold f c t1)) t0+fold' _ c E = c+fold' f c (L _ x) = c `seq` f x c+fold' f c (B _ _ t0 t1) = c `seq` (fold f $! (fold f c t1)) t0  fold1 :: (a -> a -> a) -> FM a -> a-fold1 f E = error "PatriciaLoMap.fold1: empty map"-fold1 f (L k x) = x-fold1 f (B p m t0 t1) = f (fold1 f t0) (fold1 f t1)+fold1 _ E = error "PatriciaLoMap.fold1: empty map"+fold1 _ (L _ x) = x+fold1 f (B _ _ t0 t1) = f (fold1 f t0) (fold1 f t1)  fold1' :: (a -> a -> a) -> FM a -> a-fold1' f E = error "PatriciaLoMap.fold1: empty map"-fold1' f (L k x) = x-fold1' f (B p m t0 t1) = f (fold1' f t0) $! (fold1' f t1)+fold1' _ E = error "PatriciaLoMap.fold1: empty map"+fold1' _ (L _ x) = x+fold1' f (B _ _ t0 t1) = f (fold1' f t0) $! (fold1' f t1)  filter :: (a -> Bool) -> FM a -> FM a-filter g E = E-filter g t@(L k x) = if g x then t else E+filter _ E = E+filter g t@(L _ x) = if g x then t else E filter g (B p m t0 t1) = makeB p m (filter g t0) (filter g t1)  partition :: (a -> Bool) -> FM a -> (FM a, FM a)-partition g E = (E, E)-partition g t@(L k x) = if g x then (t, E) else (E, t)+partition _ E = (E, E)+partition g t@(L _ x) = if g x then (t, E) else (E, t) partition g (B p m t0 t1) =   let (t0',t0'') = partition g t0       (t1',t1'') = partition g t1   in (makeB p m t0' t1', makeB p m t0'' t1'')-  + fromSeqWith :: S.Sequence seq => (a -> a -> a) -> seq (Int,a) -> FM a fromSeqWith f = S.foldl (\t (k, x) -> insertWith f k x t) E  insertWith :: (a -> a -> a) -> Int -> a -> FM a -> FM a-insertWith f k x E = L k x+insertWith _ k x E = L k x insertWith f k x t@(L j y) = if j == k then L k (f x y) else join k (L k x) j t insertWith f k x t@(B p m t0 t1) =     if matchPrefix k p m then@@ -370,9 +375,9 @@       if zeroBit k m then B p m (insertWith (flip f) k x s0) s1                      else B p m s0 (insertWith (flip f) k x s1)     else join k (L k x) p s-unionWith f s@(B _ _ _ _) E = s+unionWith _ s@(B _ _ _ _) E = s unionWith f (L k x) t = insertWith f k x t-unionWith f E t = t+unionWith _ E t = t  intersectionWith :: (a -> b -> c) -> FM a -> FM b -> FM c intersectionWith f s@(B p m s0 s1) t@(B q n t0 t1)@@ -386,16 +391,16 @@                 else E   | otherwise = if p /= q then E                 else makeB p m (intersectionWith f s0 t0) (intersectionWith f s1 t1)-intersectionWith f (B p m s0 s1) (L k y) =+intersectionWith f (B _ m s0 s1) (L k y) =     case lookupM k (if zeroBit k m then s0 else s1) of       Just x  -> L k (f x y)       Nothing -> E-intersectionWith f s@(B _ _ _ _) E = E+intersectionWith _ (B _ _ _ _) E = E intersectionWith f (L k x) t =     case lookupM k t of       Just y  -> L k (f x y)       Nothing -> E-intersectionWith f E t = E+intersectionWith _ E _ = E  difference :: FM a -> FM b -> FM a difference s@(B p m s0 s1) t@(B q n t0 t1)@@ -409,19 +414,20 @@                 else s   | otherwise = if p /= q then s                 else makeB p m (difference s0 t0) (difference s1 t1)-difference s@(B p m s0 s1) (L k y) =+difference s@(B p m s0 s1) (L k _) =     if matchPrefix k p m then       if zeroBit k m then lmakeB p m (delete k s0) s1                      else rmakeB p m s0 (delete k s1)     else s difference s@(B _ _ _ _) E = s-difference s@(L k x) t = if member k t then E else s-difference E t = E+difference s@(L k _) t = if member k t then E else s+difference E _ = E  properSubset :: FM a -> FM b -> Bool properSubset s t = case subset' s t of {LT -> True; _ -> False} -subset' s@(B p m s0 s1) t@(B q n t0 t1)+subset' :: FM t -> FM t1 -> Ordering+subset' s@(B p m s0 s1) (B q n t0 t1)   | m < n    = GT   | m > n    = if matchPrefix p q n then                   if zeroBit p n then subset' s t0@@ -433,21 +439,21 @@                                   (EQ,EQ) -> EQ                                   (_,_)   -> LT                 else GT-subset' (B p m s0 s1) _ = GT-subset' (L k x) (L j y) = if k == j then EQ else GT-subset' (L k x) t = if member k t then LT else GT+subset' (B _ _ _ _) _ = GT+subset' (L k _) (L j _) = if k == j then EQ else GT+subset' (L k _) t = if member k t then LT else GT subset' E E = EQ subset' E _ = LT  subset :: FM a -> FM b -> Bool-subset s@(B p m s0 s1) t@(B q n t0 t1)+subset s@(B p m s0 s1) (B q n t0 t1)   | m < n    = False   | m > n    = matchPrefix p q n && (if zeroBit p n then subset s t0                                                      else subset s t1)   | otherwise = (p == q) && subset s0 t0 && subset s1 t1-subset (B p m s0 s1) _ = False-subset (L k x) t = member k t-subset E t = True+subset (B _ _ _ _) _ = False+subset (L k _) t = member k t+subset E _ = True  properSubmapBy :: (a -> a -> Bool) -> FM a -> FM a -> Bool properSubmapBy = properSubmapByUsingSubmapBy@@ -468,29 +474,29 @@ sameMap = A.sameMap  mapWithKey :: (Int -> a -> b) -> FM a -> FM b-mapWithKey f E = E+mapWithKey _ E = E mapWithKey f (L k x) = L k (f k x) mapWithKey f (B p m t0 t1) = B p m (mapWithKey f t0) (mapWithKey f t1)  foldWithKey :: (Int -> a -> b -> b) -> b -> FM a -> b-foldWithKey f c E = c+foldWithKey _ c E = c foldWithKey f c (L k x) = f k x c-foldWithKey f c (B p m t0 t1) = foldWithKey f (foldWithKey f c t1) t0+foldWithKey f c (B _ _ t0 t1) = foldWithKey f (foldWithKey f c t1) t0  foldWithKey' :: (Int -> a -> b -> b) -> b -> FM a -> b-foldWithKey' f c E = c+foldWithKey' _ c E = c foldWithKey' f c (L k x) = c `seq` f k x c-foldWithKey' f c (B p m t0 t1) = c `seq` (foldWithKey f $! (foldWithKey f c t1)) t0+foldWithKey' f c (B _ _ t0 t1) = c `seq` (foldWithKey f $! (foldWithKey f c t1)) t0   filterWithKey :: (Int -> a -> Bool) -> FM a -> FM a-filterWithKey g E = E+filterWithKey _ E = E filterWithKey g t@(L k x) = if g k x then t else E-filterWithKey g (B p m t0 t1) = +filterWithKey g (B p m t0 t1) =   makeB p m (filterWithKey g t0) (filterWithKey g t1)  partitionWithKey :: (Int -> a -> Bool) -> FM a -> (FM a, FM a)-partitionWithKey g E = (E, E)+partitionWithKey _ E = (E, E) partitionWithKey g t@(L k x) = if g k x then (t, E) else (E, t) partitionWithKey g (B p m t0 t1) =   let (t0',t0'') = partitionWithKey g t0@@ -514,9 +520,9 @@       if zeroBit k m then B p m (insertWith (flip (f k)) k x s0) s1                      else B p m s0 (insertWith (flip (f k)) k x s1)     else join k (L k x) p s-unionWithKey f s@(B _ _ _ _) E = s+unionWithKey _ s@(B _ _ _ _) E = s unionWithKey f (L k x) t = insertWith (f k) k x t-unionWithKey f E t = t+unionWithKey _ E t = t  intersectionWithKey :: (Int -> a -> b -> c) -> FM a -> FM b -> FM c intersectionWithKey f s@(B p m s0 s1) t@(B q n t0 t1)@@ -530,30 +536,32 @@                 else E   | otherwise = if p /= q then E                 else makeB p m (intersectionWithKey f s0 t0) (intersectionWithKey f s1 t1)-intersectionWithKey f (B p m s0 s1) (L k y) =+intersectionWithKey f (B _ m s0 s1) (L k y) =     case lookupM k (if zeroBit k m then s0 else s1) of       Just x  -> L k (f k x y)       Nothing -> E-intersectionWithKey f s@(B _ _ _ _) E = E+intersectionWithKey _ (B _ _ _ _) E = E intersectionWithKey f (L k x) t =     case lookupM k t of       Just y  -> L k (f k x y)       Nothing -> E-intersectionWithKey f E t = E+intersectionWithKey _ E _ = E  -- Datastructure definition is strict in all submaps, -- no forcing required+strict :: t -> t strict n = n -strictWith f n@E = n-strictWith f n@(L i x) = f x `seq` n-strictWith f n@(B i j m1 m2) = strictWith f m1 `seq` strictWith f m2 `seq` n+strictWith :: (t -> a) -> FM t -> FM t+strictWith _ n@E = n+strictWith f n@(L _ x) = f x `seq` n+strictWith f n@(B _ _ m1 m2) = strictWith f m1 `seq` strictWith f m2 `seq` n   ordListFM :: FM a -> [(Int,a)] ordListFM E = [] ordListFM (L k x) = [(k,x)]-ordListFM (B p m t0 t1) = merge (ordListFM t0) (ordListFM t1)+ordListFM (B _ _ t0 t1) = merge (ordListFM t0) (ordListFM t1)   where merge [] ys = ys         merge xs [] = xs         merge (x@(k1,_):xs) (y@(k2,_):ys) =@@ -565,7 +573,7 @@ ordListFM_rev :: FM a -> [(Int,a)] ordListFM_rev E = [] ordListFM_rev (L k x) = [(k,x)]-ordListFM_rev (B p m t0 t1) = merge (ordListFM_rev t0) (ordListFM_rev t1)+ordListFM_rev (B _ _ t0 t1) = merge (ordListFM_rev t0) (ordListFM_rev t1)   where merge [] ys = ys         merge xs [] = xs         merge (x@(k1,_):xs) (y@(k2,_):ys) =@@ -575,7 +583,7 @@             EQ -> error "PatriciaLoMap: bug in ordListFM_rev"  minView :: Monad m => FM a -> m (a, FM a)-minView fm = +minView fm =    case ordListFM fm of      [] -> fail $ moduleName++".minView: empty map"      ((k,x):_) -> return (x,delete k fm)@@ -653,10 +661,10 @@ foldrWithKey' f z fm = L.foldl' (flip (uncurry f)) z . ordListFM_rev $ fm  foldlWithKey :: (b -> Int -> a -> b) -> b -> FM a -> b-foldlWithKey f z fm = L.foldr (\ (k,x) z -> f z k x) z . ordListFM_rev $ fm+foldlWithKey f z fm = L.foldr (\(k,x) a -> f a k x) z . ordListFM_rev $ fm  foldlWithKey' :: (b -> Int -> a -> b) -> b -> FM a -> b-foldlWithKey' f z fm = L.foldl' (\ z (k,x) -> f z k x) z . ordListFM $ fm+foldlWithKey' f z fm = L.foldl' (\a (k,x) -> f a k x) z . ordListFM $ fm   unsafeFromOrdSeq :: S.Sequence seq => seq (Int,a) -> FM a@@ -715,19 +723,19 @@ elements :: S.Sequence seq => FM a -> seq a elements = elementsUsingFold -fromSeqWithKey :: +fromSeqWithKey ::     S.Sequence seq => (Int -> a -> a -> a) -> seq (Int,a) -> FM a fromSeqWithKey = fromSeqWithKeyUsingInsertSeqWithKey  insertWithKey :: (Int -> a -> a -> a) -> Int -> a -> FM a -> FM a insertWithKey = insertWithKeyUsingInsertWith -insertSeqWith :: +insertSeqWith ::     S.Sequence seq => (a -> a -> a) -> seq (Int,a) -> FM a -> FM a insertSeqWith = insertSeqWithUsingInsertWith -insertSeqWithKey :: -    S.Sequence seq => +insertSeqWithKey ::+    S.Sequence seq =>       (Int -> a -> a -> a) -> seq (Int,a) -> FM a -> FM a insertSeqWithKey = insertSeqWithKeyUsingInsertWithKey @@ -742,18 +750,18 @@  keys :: S.Sequence seq => FM a -> seq Int keys = keysUsingFoldWithKey-  -unionSeqWithKey :: ++unionSeqWithKey ::     S.Sequence seq => (Int -> a -> a -> a) -> seq (FM a) -> FM a unionSeqWithKey = unionSeqWithKeyUsingReduce  -- instance declarations  instance A.AssocX FM Int where-  {empty = empty; singleton = singleton; fromSeq = fromSeq; insert = insert; -   insertSeq = insertSeq; union = union; unionSeq = unionSeq; -   delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; -   null = null; size = size; member = member; count = count; +  {empty = empty; singleton = singleton; fromSeq = fromSeq; insert = insert;+   insertSeq = insertSeq; union = union; unionSeq = unionSeq;+   delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;+   null = null; size = size; member = member; count = count;    lookup = lookup; lookupM = lookupM; lookupAll = lookupAll;    lookupAndDelete = lookupAndDelete; lookupAndDeleteM = lookupAndDeleteM;    lookupAndDeleteAll = lookupAndDeleteAll;@@ -764,26 +772,26 @@    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; elements = elements;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName m = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance A.Assoc FM Int where-  {toSeq = toSeq; keys = keys; mapWithKey = mapWithKey; +  {toSeq = toSeq; keys = keys; mapWithKey = mapWithKey;    foldWithKey = foldWithKey; foldWithKey' = foldWithKey';-   filterWithKey = filterWithKey; +   filterWithKey = filterWithKey;    partitionWithKey = partitionWithKey}  instance A.FiniteMapX FM Int where-  {fromSeqWith = fromSeqWith; fromSeqWithKey = fromSeqWithKey; -   insertWith = insertWith; insertWithKey = insertWithKey; -   insertSeqWith = insertSeqWith; insertSeqWithKey = insertSeqWithKey; -   unionl = unionl; unionr = unionr; unionWith = unionWith; -   unionSeqWith = unionSeqWith; intersectionWith = intersectionWith; +  {fromSeqWith = fromSeqWith; fromSeqWithKey = fromSeqWithKey;+   insertWith = insertWith; insertWithKey = insertWithKey;+   insertSeqWith = insertSeqWith; insertSeqWithKey = insertSeqWithKey;+   unionl = unionl; unionr = unionr; unionWith = unionWith;+   unionSeqWith = unionSeqWith; intersectionWith = intersectionWith;    difference = difference; properSubset = properSubset; subset = subset;    properSubmapBy = properSubmapBy; submapBy = submapBy;    sameMapBy = sameMapBy}  instance A.FiniteMap FM Int where-  {unionWithKey = unionWithKey; unionSeqWithKey = unionSeqWithKey; +  {unionWithKey = unionWithKey; unionSeqWithKey = unionSeqWithKey;    intersectionWithKey = intersectionWithKey}  instance A.OrdAssocX FM Int where
src/Data/Edison/Assoc/StandardMap.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Assoc.AssocList---   Copyright   :  Copyright (c) 2006 Robert Dockins+--   Copyright   :  Copyright (c) 2006, 2008 Robert Dockins --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -51,14 +51,11 @@  import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter) import qualified Prelude-import Control.Monad.Identity (runIdentity)-import Data.Edison.Prelude import qualified Data.Edison.Assoc as A import qualified Data.Edison.Seq as S import qualified Data.Edison.Seq.ListSeq as L import Data.Edison.Assoc.Defaults import Data.Int-import Data.Bits import Test.QuickCheck (Arbitrary(..))  import qualified Data.Map as DM@@ -132,12 +129,12 @@ partitionLE_GT    :: Ord k => k -> FM k a -> (FM k a,FM k a) partitionLT_GT    :: Ord k => k -> FM k a -> (FM k a,FM k a) -fromSeqWith       :: (Ord k,S.Sequence seq) => (a -> a -> a) +fromSeqWith       :: (Ord k,S.Sequence seq) => (a -> a -> a)                          -> seq (k,a) -> FM k a fromSeqWithKey    :: (Ord k,S.Sequence seq) => (k -> a -> a -> a)                          -> seq (k,a) -> FM k a insertWith        :: Ord k => (a -> a -> a) -> k -> a-	                 -> FM k a -> FM k a+                         -> FM k a -> FM k a insertWithKey     :: Ord k => (k -> a -> a -> a) -> k -> a                          -> FM k a -> FM k a insertSeqWith     :: (Ord k,S.Sequence seq) => (a -> a -> a) -> seq (k,a)@@ -229,14 +226,14 @@  minView m          = if DM.null m                        then fail (moduleName ++ ".minView: failed")-                       else let ((k,x),m') = DM.deleteFindMin m +                       else let ((_,x),m') = DM.deleteFindMin m                             in return (x,m') minElem            = snd . DM.findMin deleteMin          = DM.deleteMin unsafeInsertMin    = DM.insert maxView m          = if DM.null m                        then fail (moduleName ++ ".maxView: failed")-                       else let ((k,x),m') = DM.deleteFindMax m +                       else let ((_,x),m') = DM.deleteFindMax m                             in return (x,m') maxElem            = snd . DM.findMax deleteMax          = DM.deleteMax@@ -289,11 +286,11 @@  minViewWithKey m   = if DM.null m                         then fail (moduleName ++ ".minViewWithKey: failed")-	                else return (DM.deleteFindMin m)+                        else return (DM.deleteFindMin m) minElemWithKey     = DM.findMin maxViewWithKey m   = if DM.null m                         then fail (moduleName ++ ".maxViewWithKey: failed")-	                else return (DM.deleteFindMax m)+                        else return (DM.deleteFindMax m) maxElemWithKey     = DM.findMax foldrWithKey        = DM.foldWithKey foldrWithKey' f x m = L.foldr' (\(k,a) b -> f k a b) x (DM.toAscList m)@@ -321,7 +318,7 @@    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; elements = elements;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName m = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Ord k => A.OrdAssocX (FM k) k where   {minView = minView; minElem = minElem; deleteMin = deleteMin;@@ -369,4 +366,4 @@    arbitrary = do xs <- arbitrary                   return (Prelude.foldr (uncurry insert) empty xs) -   coarbitrary map = coarbitrary (A.toList map)+   coarbitrary mp = coarbitrary (A.toList mp)
src/Data/Edison/Assoc/TernaryTrie.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Assoc.TernaryTrie---   Copyright   :  Copyright (c) 2002 Andrew Bromage+--   Copyright   :  Copyright (c) 2002, 2008 Andrew Bromage --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -54,16 +54,16 @@  import Prelude hiding (null,map,lookup,foldr,foldl,foldr1,foldl1,filter) import qualified Prelude-import Data.Edison.Prelude import qualified Data.Edison.Assoc as A import qualified Data.Edison.Seq as S import qualified Data.List as L import Control.Monad.Identity import Data.Monoid+import Data.Maybe (isNothing)+ import Data.Edison.Assoc.Defaults-import Test.QuickCheck (Arbitrary(..), variant)+import Test.QuickCheck (Arbitrary(..), Gen(), variant) -import Maybe (isNothing)  -- signatures for exported functions moduleName    :: String@@ -105,24 +105,24 @@ partition     :: Ord k => (a -> Bool) -> FM k a -> (FM k a, FM k a) elements      :: (Ord k,S.Sequence seq) => FM k a -> seq a -fromSeqWith      :: (Ord k,S.Sequence seq) => +fromSeqWith      :: (Ord k,S.Sequence seq) =>                         (a -> a -> a) -> seq ([k],a) -> FM k a fromSeqWithKey   :: (Ord k,S.Sequence seq) => ([k] -> a -> a -> a) -> seq ([k],a) -> FM k a insertWith       :: Ord k => (a -> a -> a) -> [k] -> a -> FM k a -> FM k a insertWithKey    :: Ord k => ([k] -> a -> a -> a) -> [k] -> a -> FM k a -> FM k a-insertSeqWith    :: (Ord k,S.Sequence seq) => +insertSeqWith    :: (Ord k,S.Sequence seq) =>                         (a -> a -> a) -> seq ([k],a) -> FM k a -> FM k a-insertSeqWithKey :: (Ord k,S.Sequence seq) => +insertSeqWithKey :: (Ord k,S.Sequence seq) =>                         ([k] -> a -> a -> a) -> seq ([k],a) -> FM k a -> FM k a unionl           :: Ord k => FM k a -> FM k a -> FM k a unionr           :: Ord k => FM k a -> FM k a -> FM k a unionWith        :: Ord k => (a -> a -> a) -> FM k a -> FM k a -> FM k a-unionSeqWith     :: (Ord k,S.Sequence seq) => +unionSeqWith     :: (Ord k,S.Sequence seq) =>                         (a -> a -> a) -> seq (FM k a) -> FM k a intersectionWith :: Ord k => (a -> b -> c) -> FM k a -> FM k b -> FM k c difference       :: Ord k => FM k a -> FM k b -> FM k a-properSubset     :: Ord k => FM k a -> FM k b -> Bool    -subset           :: Ord k => FM k a -> FM k b -> Bool    +properSubset     :: Ord k => FM k a -> FM k b -> Bool+subset           :: Ord k => FM k a -> FM k b -> Bool properSubmapBy   :: Ord k => (a -> a -> Bool) -> FM k a -> FM k a -> Bool submapBy         :: Ord k => (a -> a -> Bool) -> FM k a -> FM k a -> Bool sameMapBy        :: Ord k => (a -> a -> Bool) -> FM k a -> FM k a -> Bool@@ -138,7 +138,7 @@ filterWithKey    :: Ord k => ([k] -> a -> Bool) -> FM k a -> FM k a partitionWithKey :: Ord k => ([k] -> a -> Bool) -> FM k a -> (FM k a, FM k a) unionWithKey     :: Ord k => ([k] -> a -> a -> a) -> FM k a -> FM k a -> FM k a-unionSeqWithKey  :: (Ord k,S.Sequence seq) => +unionSeqWithKey  :: (Ord k,S.Sequence seq) =>                        ([k] -> a -> a -> a) -> seq (FM k a) -> FM k a intersectionWithKey :: Ord k => ([k] -> a -> b -> c) -> FM k a -> FM k b -> FM k c @@ -180,9 +180,9 @@ lookupFMB :: (Ord k) => [k] -> FMB k v -> Maybe v lookupFMB []        _   = Nothing-lookupFMB nk@(x:xs) E+lookupFMB (_:_) E   = Nothing-lookupFMB nk@(x:xs) (I _ k v l m@(FMB' fmbm) r)+lookupFMB nk@(x:xs) (I _ k v l (FMB' fmbm) r)   = case compare x k of         LT -> lookupFMB nk l         GT -> lookupFMB nk r@@ -212,7 +212,7 @@   = FM n (addToFMB xs combiner fmb)  lookupAndDelFromFMB :: (Ord k) => z -> (v -> FMB k v -> z) -> [k] -> FMB k v -> z-lookupAndDelFromFMB onFail cont xs E = onFail+lookupAndDelFromFMB onFail _ _ E = onFail lookupAndDelFromFMB onFail cont nk@(x:xs) (I size k v l m@(FMB' fmbm) r)   = case compare x k of         LT -> lookupAndDelFromFMB onFail (\w l' -> cont w (mkBalancedFMB k v l' m r)) nk l@@ -227,14 +227,14 @@ lookupAndDelFromFMB _ _ _ _ = error "TernaryTrie.lookupAndDelFromFMB: bug!"  lookupAndDelFromFM :: (Ord k) => z -> (v -> FM k v -> z) -> [k] -> FM k v -> z-lookupAndDelFromFM onFail cont [] (FM Nothing fmb)  = onFail-lookupAndDelFromFM onFail cont [] (FM (Just v) fmb) = cont v (FM Nothing fmb)+lookupAndDelFromFM onFail _ [] (FM Nothing _)  = onFail+lookupAndDelFromFM _ cont [] (FM (Just v) fmb) = cont v (FM Nothing fmb) lookupAndDelFromFM onFail cont xs (FM n fmb) =    lookupAndDelFromFMB onFail (\w fmb' -> cont w (FM n fmb')) xs fmb   delFromFMB :: (Ord k) => [k] -> FMB k v -> FMB k v-delFromFMB xs E+delFromFMB _ E   = E delFromFMB nk@(x:xs) (I size k v l m@(FMB' fmbm) r)   = case compare x k of@@ -249,7 +249,7 @@   delFromFM :: (Ord k) => [k] -> FM k v -> FM k v-delFromFM [] (FM n fmb)+delFromFM [] (FM _ fmb)   = FM Nothing fmb delFromFM xs (FM n fmb)   = FM n (delFromFMB xs fmb)@@ -303,9 +303,9 @@ mkVBalancedFMB :: k -> Maybe v -> FMB k v -> FMB' k v -> FMB k v -> FMB k v mkVBalancedFMB k v E m E   = mkFMB k v E m E-mkVBalancedFMB k v l@E m r@(I _ kr vr rl rm rr)+mkVBalancedFMB k v l@E m (I _ kr vr rl rm rr)   = mkBalancedFMB kr vr (mkVBalancedFMB k v l m rl) rm rr-mkVBalancedFMB k v l@(I _ kl vl ll lm lr) m r@E+mkVBalancedFMB k v (I _ kl vl ll lm lr) m r@E   = mkBalancedFMB kl vl ll lm (mkVBalancedFMB k v lr m r) mkVBalancedFMB k v l@(I _ kl vl ll lm lr) m r@(I _ kr vr rl rm rr)   | balance * size_l < size_r@@ -349,7 +349,7 @@   = FM (f [] n) (mapKVFMB [] fmb)   where         mapKVFMB _ E = E-        mapKVFMB ks (I size k v l (FMB' m) r)+        mapKVFMB ks (I _ k v l (FMB' m) r)           = mkVBalancedFMB k (f (reverse (k:ks)) v)               (mapKVFMB ks l)               (FMB' (mapKVFMB (k:ks) m))@@ -377,7 +377,7 @@   where     splaydown ctx E       = splayup ctx Nothing E (FMB' E) E-    splaydown ctx y@(I _ k v l m r)+    splaydown ctx (I _ k v l m r)       = case compare key k of             LT -> splaydown (L k v ctx m r) l             GT -> splaydown (R k v l m ctx) r@@ -400,9 +400,9 @@   where     mergeVFMB' E E       = E-    mergeVFMB' E fmby@(I _ k v l (FMB' m) r)+    mergeVFMB' E fmby@(I _ _ _ _ (FMB' _) _)       = mapVFMB (\v -> f Nothing v) fmby-    mergeVFMB' fmbx@(I _ k v l (FMB' m) r) E+    mergeVFMB' fmbx@(I _ _ _ _ (FMB' _) _) E       = mapVFMB (\v -> f v Nothing) fmbx     mergeVFMB' fmbx@(I sizex kx vx lx (FMB' mx) rx)                fmby@(I sizey ky vy ly (FMB' my) ry)@@ -434,7 +434,7 @@ mergeKVFMB f fmbx fmby   = mergeKVFMB' [] fmbx fmby   where-    mergeKVFMB' ks E E+    mergeKVFMB' _ E E       = E     mergeKVFMB' ks E fmby       = mergeKVFMBs (\k v -> f k Nothing v) ks fmby@@ -468,9 +468,9 @@     mergeKVFMBs f ks fmb       = mergeKVFMBs' ks fmb       where-          mergeKVFMBs' ks E+          mergeKVFMBs' _ E             = E-          mergeKVFMBs' ks (I s k v l (FMB' m) r)+          mergeKVFMBs' ks (I _ k v l (FMB' m) r)             = case (mergeKVFMBs' (k:ks) m, f (reverse (k:ks)) v) of                 (E, Nothing) -> appendFMB                                     (mergeKVFMBs' ks l)@@ -487,7 +487,7 @@   -- The public interface.---  +--  -- AssocX @@ -514,7 +514,7 @@  null = nullFM -size (FM k fmb) +size (FM k fmb)     | isNothing k = fmb_size fmb 0     | otherwise   = fmb_size fmb 1     where fmb_size E k = k@@ -540,11 +540,11 @@ lookupAll = lookupAllUsingLookupM  lookupAndDelete =-    lookupAndDelFromFM +    lookupAndDelFromFM       (error "TernaryTrie.lookupAndDelete: lookup failed")       (,) -lookupAndDeleteM = +lookupAndDeleteM =     lookupAndDelFromFM       (fail  "TernaryTrie.lookupAndDeleteM: lookup failed")       (\w m -> return (w,m))@@ -564,7 +564,7 @@  adjustAll = adjust -adjustOrInsert f z k +adjustOrInsert f z k   = addToFM k (\mv -> case mv of                         Nothing -> Just z                         Just v  -> Just (f v))@@ -600,10 +600,10 @@ foldrWithKey f z (FM n fmb)   = foldMV [] n . foldFMB id fmb $ z   where-     foldMV ks Nothing  = id+     foldMV _ Nothing  = id      foldMV ks (Just v) = f ks v -     foldFMB kf E = id+     foldFMB _ E = id      foldFMB kf (I _ k mv l (FMB' m) r)        = foldFMB kf l . foldMV (kf [k]) mv . foldFMB (kf . (k:)) m . foldFMB kf r @@ -612,19 +612,20 @@   where      g k x a = f a k x -     foldMV ks Nothing  = id+     foldMV _ Nothing  = id      foldMV ks (Just v) = g ks v -     foldFMB kf E = id+     foldFMB _ E = id      foldFMB kf (I _ k mv l (FMB' m) r)        = foldFMB kf r . foldFMB (kf . (k:)) m . foldMV (kf [k]) mv . foldFMB kf l  foldrWithKey' = foldrWithKey foldlWithKey' = foldlWithKey +foldl :: (a -> b -> a) -> a -> FM t b -> a foldl op z (FM n fmb)   = foldFMB fmb . foldMV n $ z-  where +  where     foldMV Nothing  = id     foldMV (Just v) = (flip op) v @@ -635,22 +636,31 @@  -- FIXME, undestand this code to strictify it foldr' = foldr+foldl' :: (a -> b -> a) -> a -> FM t b -> a foldl' = foldl -foldr1 f fm = +foldr1 f fm =   case maxView fm of      Just (z,fm') -> foldr f z fm'      Nothing      -> error $ moduleName++".foldr1: empty map" +foldl1 :: (b -> b -> b) -> FM k b -> b foldl1 f fm =   case minView fm of      Just (z,fm') -> foldl f z fm'      Nothing      -> error $ moduleName++".foldl1: empty map"  -basecase Nothing  = \j n -> n-basecase (Just x) = \j n -> j x+basecase :: Maybe t1 -> (t1 -> t) -> t -> t+basecase Nothing  = \_ n -> n+basecase (Just x) = \j _ -> j x +comb ::                                (t1 -> t1 -> t1)+                                    -> ((t1 -> t2) -> t2 -> t3)+                                    -> ((t1 -> t) -> t -> t2)+                                    -> (t1 -> t)+                                    -> t+                                    -> t3 comb f p1 p2    = \j n -> p1 (\x -> p2 (\y -> j (f x y)) (j x)) (p2 j n) @@ -658,7 +668,7 @@   = comb f (basecase mv) (fold1FMB fmb) id (error $ moduleName++".fold1: empty map")   where       fold1FMB E-        = \j n -> n+        = \_ n -> n       fold1FMB (I _ _ mv l (FMB' m) r)         = comb f (basecase mv) $ comb f (fold1FMB l) $ comb f (fold1FMB m) $ (fold1FMB r) @@ -689,6 +699,7 @@  -- FIXME, undestand this code to strictify it foldr1' = foldr1+foldl1' :: (b -> b -> b) -> FM k b -> b foldl1' = foldl1  @@ -700,9 +711,9 @@  elements = elementsUsingFold -strict z@(FM v fmb) = strictFMB fmb `seq` z+strict z@(FM _ fmb) = strictFMB fmb `seq` z  where strictFMB n@E = n-       strictFMB n@(I i k v l (FMB' m) r) =+       strictFMB n@(I _ _ _ l (FMB' m) r) =            strictFMB l `seq` strictFMB m `seq` strictFMB r `seq` n  strictWith f z@(FM v fmb) = f' v `seq` strictWithFMB fmb `seq` z@@ -710,7 +721,7 @@          f' v@(Just x) = f x `seq` v           strictWithFMB n@E = n-         strictWithFMB n@(I i k v l (FMB' m) r) =+         strictWithFMB n@(I _ _ v l (FMB' m) r) =            f' v `seq` strictWithFMB l `seq` strictWithFMB m `seq` strictWithFMB r `seq` n  @@ -795,10 +806,10 @@ foldWithKey op r (FM n fmb)   = foldWithKeyB [] n . foldWithKeyFM [] fmb $ r   where-      foldWithKeyB k Nothing = id+      foldWithKeyB _ Nothing = id       foldWithKeyB k (Just v) = op k v -      foldWithKeyFM ks E = id+      foldWithKeyFM _ E = id       foldWithKeyFM ks (I _ k v l (FMB' m) r)         = foldWithKeyFM ks l         . foldWithKeyB (reverse (k:ks)) v@@ -843,23 +854,23 @@ -- OrdAssocX  minViewFMB :: Monad m => FMB k a -> (FMB k a -> FM k a) -> m (a, FM k a)-minViewFMB E f = fail $ moduleName++".minView: empty map"+minViewFMB E _ = fail $ moduleName++".minView: empty map" minViewFMB (I i k (Just v) E m r)        f = return (v, f (I i k Nothing E m r))-minViewFMB (I i k Nothing  E (FMB' E) r) f = error $ moduleName++".minView: bug!"-minViewFMB (I i k Nothing  E (FMB' m) r) f = minViewFMB m (\m' -> f (mkVBalancedFMB k Nothing E (FMB' m') r))-minViewFMB (I i k mv l m r)              f = minViewFMB l (\l' -> f (mkVBalancedFMB k mv l' m r))+minViewFMB (I _ _ Nothing  E (FMB' E) _) _ = error $ moduleName++".minView: bug!"+minViewFMB (I _ k Nothing  E (FMB' m) r) f = minViewFMB m (\m' -> f (mkVBalancedFMB k Nothing E (FMB' m') r))+minViewFMB (I _ k mv l m r)              f = minViewFMB l (\l' -> f (mkVBalancedFMB k mv l' m r))  minView :: Monad m => FM k a -> m (a,FM k a) minView (FM (Just v) fmb) = return (v, FM Nothing fmb) minView (FM Nothing fmb)  = minViewFMB fmb (FM Nothing)  minViewWithKeyFMB :: Monad m => FMB k a -> ([k] -> [k]) -> (FMB k a -> FM k a) -> m (([k],a),FM k a)-minViewWithKeyFMB E fk f = fail $ moduleName++".minView: empty map"+minViewWithKeyFMB E _ _ = fail $ moduleName++".minView: empty map" minViewWithKeyFMB (I i k (Just v) E m r)        kf f = return ((kf [k],v),f (I i k Nothing E m r))-minViewWithKeyFMB (I i k Nothing  E (FMB' E) r) kf f = error $ moduleName++".minViewWithKey: bug!"-minViewWithKeyFMB (I i k Nothing  E (FMB' m) r) kf f = minViewWithKeyFMB m (kf . (k:)) -	                                                (\m' -> f (mkVBalancedFMB k Nothing E (FMB' m') r))-minViewWithKeyFMB (I i k mv l m r)              kf f = minViewWithKeyFMB l kf+minViewWithKeyFMB (I _ _ Nothing  E (FMB' E) _) _ _ = error $ moduleName++".minViewWithKey: bug!"+minViewWithKeyFMB (I _ k Nothing  E (FMB' m) r) kf f = minViewWithKeyFMB m (kf . (k:))+                                                        (\m' -> f (mkVBalancedFMB k Nothing E (FMB' m') r))+minViewWithKeyFMB (I _ k mv l m r)              kf f = minViewWithKeyFMB l kf                                                         (\l' -> f (mkVBalancedFMB k mv l' m r))  minViewWithKey :: Monad m => FM k a -> m (([k],a),FM k a)@@ -869,22 +880,23 @@  minElemFMB :: FMB k a -> a minElemFMB E = error $ moduleName++".minElem: empty map"-minElemFMB (I i k (Just v) E m r)        = v-minElemFMB (I i k Nothing  E (FMB' m) r) = minElemFMB m-minElemFMB (I i k mv l m r)              = minElemFMB l+minElemFMB (I _ _ (Just v) E _ _)        = v+minElemFMB (I _ _ Nothing  E (FMB' m) _) = minElemFMB m+minElemFMB (I _ _ _ l _ _)              = minElemFMB l -minElem (FM (Just v) fmb) = v+minElem :: FM t1 t -> t+minElem (FM (Just v) _) = v minElem (FM Nothing  fmb) = minElemFMB fmb   minElemWithKeyFMB :: ([k] -> [k]) -> FMB k a -> ([k],a)-minElemWithKeyFMB kf E = error $ moduleName++".minElemWithKey: empty map"-minElemWithKeyFMB kf (I i k (Just v) E m r)        = (kf [k],v)-minElemWithKeyFMB kf (I i k Nothing  E (FMB' m) r) = minElemWithKeyFMB (kf . (k:)) m-minElemWithKeyFMB kf (I i k mv l m r)              = minElemWithKeyFMB kf l+minElemWithKeyFMB _ E = error $ moduleName++".minElemWithKey: empty map"+minElemWithKeyFMB kf (I _ k (Just v) E _ _)        = (kf [k],v)+minElemWithKeyFMB kf (I _ k Nothing  E (FMB' m) _) = minElemWithKeyFMB (kf . (k:)) m+minElemWithKeyFMB kf (I _ _ _ l _ _)              = minElemWithKeyFMB kf l  minElemWithKey :: FM k a -> ([k],a)-minElemWithKey (FM (Just v) fmb) = ([],v)+minElemWithKey (FM (Just v) _) = ([],v) minElemWithKey (FM Nothing  fmb) = minElemWithKeyFMB id fmb  deleteMin :: Ord k => FM k a -> FM k a@@ -894,12 +906,12 @@ unsafeInsertMin = insert  maxViewFMB :: Monad m => FMB k a -> (FMB k a -> FM k a) -> m (a, FM k a)-maxViewFMB (I i k (Just v) l (FMB' E) E) f = return (v, f l)+maxViewFMB (I _ _ (Just v) l (FMB' E) E) f = return (v, f l) --maxViewFMB (I i k (Just v) l (FMB' E) E) f = return (v, f (I i k Nothing l (FMB' E) E))-maxViewFMB (I i k Nothing  l (FMB' E) E) f = error $ moduleName++".maxView: bug!"+maxViewFMB (I _ _ Nothing  _ (FMB' E) E) _ = error $ moduleName++".maxView: bug!" maxViewFMB (I i k mv l (FMB' m) E)       f = maxViewFMB m (\m' -> f (I i k mv l (FMB' m') E))-maxViewFMB (I i k mv l m r)              f = maxViewFMB r (\r' -> f (mkVBalancedFMB k mv l m r'))-maxViewFMB E                             f = error $ moduleName++".maxView: bug!"+maxViewFMB (I _ k mv l m r)              f = maxViewFMB r (\r' -> f (mkVBalancedFMB k mv l m r'))+maxViewFMB E                             _ = error $ moduleName++".maxView: bug!"  maxView :: Monad m => FM k a -> m (a, FM k a) maxView (FM Nothing E)  = fail $ moduleName++".maxView: empty map"@@ -908,13 +920,13 @@   maxViewWithKeyFMB :: Monad m => FMB k a -> ([k] -> [k]) -> (FMB k a -> FM k a) -> m (([k],a),FM k a)-maxViewWithKeyFMB (I i k (Just v) l (FMB' E) E) kf f = return ((kf [k],v),f l)-maxViewWithKeyFMB (I i k Nothing  l (FMB' E) E) kf f = error $ moduleName++".maxViewWithKey: bug!"+maxViewWithKeyFMB (I _ k (Just v) l (FMB' E) E) kf f = return ((kf [k],v),f l)+maxViewWithKeyFMB (I _ _ Nothing  _ (FMB' E) E) _ _ = error $ moduleName++".maxViewWithKey: bug!" maxViewWithKeyFMB (I i k mv l (FMB' m) E)       kf f = maxViewWithKeyFMB m (kf . (k:))                                                         (\m' -> f (I i k mv l (FMB' m') E))-maxViewWithKeyFMB (I i k mv l m r)              kf f = maxViewWithKeyFMB r kf+maxViewWithKeyFMB (I _ k mv l m r)              kf f = maxViewWithKeyFMB r kf                                                         (\r' -> f (mkVBalancedFMB k mv l m r'))-maxViewWithKeyFMB E                             kf f = error $ moduleName++".maxViewWithKey: bug!"+maxViewWithKeyFMB E                             _ _ = error $ moduleName++".maxViewWithKey: bug!"   maxViewWithKey :: Monad m => FM k a -> m (([k],a), FM k a)@@ -925,10 +937,10 @@   maxElemFMB :: FMB k a -> a-maxElemFMB (I i k (Just v) l (FMB' E) E) = v-maxElemFMB (I i k Nothing  l (FMB' E) E) = error $ moduleName++".maxElem: bug!"-maxElemFMB (I i k mv l (FMB' m) E)       = maxElemFMB m-maxElemFMB (I i k mv l m r)              = maxElemFMB r+maxElemFMB (I _ _ (Just v) _ (FMB' E) E) = v+maxElemFMB (I _ _ Nothing  _ (FMB' E) E) = error $ moduleName++".maxElem: bug!"+maxElemFMB (I _ _ _ _ (FMB' m) E)       = maxElemFMB m+maxElemFMB (I _ _ _ _ _ r)              = maxElemFMB r maxElemFMB E                             = error $ moduleName++".maxElem: bug!"  maxElem :: FM k a -> a@@ -937,11 +949,11 @@ maxElem (FM _ fmb)      = maxElemFMB fmb  maxElemWithKeyFMB :: FMB k a -> ([k] -> [k]) -> ([k],a)-maxElemWithKeyFMB (I i k (Just v) l (FMB' E) E) kf = (kf [k],v)-maxElemWithKeyFMB (I i k Nothing  l (FMB' E) E) kf = error $ moduleName++".maxElemWithKey: bug!"-maxElemWithKeyFMB (I i k mv l (FMB' m) E)       kf = maxElemWithKeyFMB m (kf . (k:))-maxElemWithKeyFMB (I i k mv l m r)              kf = maxElemWithKeyFMB r kf-maxElemWithKeyFMB E                             kf = error $ moduleName++".maxElemWithKey: bug!"+maxElemWithKeyFMB (I _ k (Just v) _ (FMB' E) E) kf = (kf [k],v)+maxElemWithKeyFMB (I _ _ Nothing  _ (FMB' E) E) _ = error $ moduleName++".maxElemWithKey: bug!"+maxElemWithKeyFMB (I _ k _ _ (FMB' m) E)       kf = maxElemWithKeyFMB m (kf . (k:))+maxElemWithKeyFMB (I _ _ _ _ _ r)              kf = maxElemWithKeyFMB r kf+maxElemWithKeyFMB E                             _ = error $ moduleName++".maxElemWithKey: bug!"   maxElemWithKey :: FM k a -> ([k],a)@@ -970,8 +982,8 @@ -}  filterL_FMB :: Ord k => (k -> Maybe a -> FMB k a -> FMB k a) -> k -> [k] -> FMB k a -> FMB k a-filterL_FMB f k ks E = E-filterL_FMB f k ks (I i key mv l (FMB' m) r)+filterL_FMB _ _ _ E = E+filterL_FMB f k ks (I _ key mv l (FMB' m) r)     | key < k   = mkVBalancedFMB key mv l (FMB' m) (filterL_FMB f k ks r)     | key > k   = filterL_FMB f k ks l     | otherwise = case ks of@@ -980,7 +992,7 @@  filterLT :: Ord k => [k] -> FM k a -> FM k a filterLT [] _               = FM Nothing E-filterLT (k:ks) (FM mv fmb) = FM mv (filterL_FMB (\k mv l -> l) k ks fmb)+filterLT (k:ks) (FM mv fmb) = FM mv (filterL_FMB (\_ _ l -> l) k ks fmb)  filterLE :: Ord k => [k] -> FM k a -> FM k a filterLE [] (FM mv _)       = FM mv E@@ -989,8 +1001,8 @@   filterG_FMB :: Ord k => (k -> Maybe a -> FMB k a -> FMB k a -> FMB k a) -> k -> [k] -> FMB k a -> FMB k a-filterG_FMB f k ks E = E-filterG_FMB f k ks (I i key mv l (FMB' m) r)+filterG_FMB _ _ _ E = E+filterG_FMB f k ks (I _ key mv l (FMB' m) r)     | key < k   = filterG_FMB f k ks r     | key > k   = mkVBalancedFMB key mv (filterG_FMB f k ks l) (FMB' m) r     | otherwise = case ks of@@ -999,11 +1011,11 @@  filterGT :: Ord k => [k] -> FM k a -> FM k a filterGT []     (FM _  fmb) = FM Nothing fmb-filterGT (k:ks) (FM mv fmb) = FM Nothing (filterG_FMB (\k mv m r -> mkVBalancedFMB k Nothing E (FMB' m) r) k ks fmb)+filterGT (k:ks) (FM _ fmb) = FM Nothing (filterG_FMB (\k _ m r -> mkVBalancedFMB k Nothing E (FMB' m) r) k ks fmb)  filterGE :: Ord k => [k] -> FM k a -> FM k a filterGE []     fm          = fm-filterGE (k:ks) (FM mv fmb) = FM Nothing (filterG_FMB (\k mv m r -> mkVBalancedFMB k mv E (FMB' m) r) k ks fmb)+filterGE (k:ks) (FM _ fmb) = FM Nothing (filterG_FMB (\k mv m r -> mkVBalancedFMB k mv E (FMB' m) r) k ks fmb)  --FIXME do better... partitionLT_GE :: Ord k => [k] -> FM k a -> (FM k a,FM k a)@@ -1020,40 +1032,40 @@ -- instance declarations  instance Ord k  => A.AssocX (FM k) [k] where-  {empty = empty; singleton = singleton; fromSeq = fromSeq; insert = insert; -   insertSeq = insertSeq; union = union; unionSeq = unionSeq; -   delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq; -   null = null; size = size; member = member; count = count; -   lookup = lookup; lookupM = lookupM; lookupAll = lookupAll; +  {empty = empty; singleton = singleton; fromSeq = fromSeq; insert = insert;+   insertSeq = insertSeq; union = union; unionSeq = unionSeq;+   delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;+   null = null; size = size; member = member; count = count;+   lookup = lookup; lookupM = lookupM; lookupAll = lookupAll;    lookupAndDelete = lookupAndDelete; lookupAndDeleteM = lookupAndDeleteM;    lookupAndDeleteAll = lookupAndDeleteAll;-   lookupWithDefault = lookupWithDefault; adjust = adjust; +   lookupWithDefault = lookupWithDefault; adjust = adjust;    adjustAll = adjustAll; adjustOrInsert = adjustOrInsert;    adjustAllOrInsert = adjustAllOrInsert;    adjustOrDelete = adjustOrDelete; adjustOrDeleteAll = adjustOrDeleteAll;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; elements = elements;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName m = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Ord k  => A.Assoc (FM k) [k] where-  {toSeq = toSeq; keys = keys; mapWithKey = mapWithKey; +  {toSeq = toSeq; keys = keys; mapWithKey = mapWithKey;    foldWithKey = foldWithKey; foldWithKey' = foldWithKey';-   filterWithKey = filterWithKey; +   filterWithKey = filterWithKey;    partitionWithKey = partitionWithKey}  instance Ord k => A.FiniteMapX (FM k) [k] where-  {fromSeqWith = fromSeqWith; fromSeqWithKey = fromSeqWithKey; -   insertWith  = insertWith; insertWithKey = insertWithKey; -   insertSeqWith = insertSeqWith; insertSeqWithKey = insertSeqWithKey; -   unionl = unionl; unionr = unionr; unionWith = unionWith; -   unionSeqWith = unionSeqWith; intersectionWith = intersectionWith; +  {fromSeqWith = fromSeqWith; fromSeqWithKey = fromSeqWithKey;+   insertWith  = insertWith; insertWithKey = insertWithKey;+   insertSeqWith = insertSeqWith; insertSeqWithKey = insertSeqWithKey;+   unionl = unionl; unionr = unionr; unionWith = unionWith;+   unionSeqWith = unionSeqWith; intersectionWith = intersectionWith;    difference = difference; properSubset = properSubset; subset = subset;    properSubmapBy = properSubmapBy; submapBy = submapBy;    sameMapBy = sameMapBy}  instance Ord k => A.FiniteMap (FM k) [k] where-  {unionWithKey = unionWithKey; unionSeqWithKey = unionSeqWithKey; +  {unionWithKey = unionWithKey; unionSeqWithKey = unionSeqWithKey;    intersectionWithKey = intersectionWithKey}  instance Ord k => A.OrdAssocX (FM k) [k] where@@ -1074,7 +1086,7 @@    foldlWithKey = foldlWithKey; foldlWithKey' = foldlWithKey';    toOrdSeq = toOrdSeq} -instance Ord k => A.OrdFiniteMapX (FM k) [k] +instance Ord k => A.OrdFiniteMapX (FM k) [k] instance Ord k => A.OrdFiniteMap (FM k) [k]  @@ -1098,7 +1110,7 @@ --  keyInvariantFMB :: Ord k => (k -> Bool) -> FMB k a -> Bool-keyInvariantFMB p E = True+keyInvariantFMB _ E = True keyInvariantFMB p (I _ k _ l _ r)   =    p k     && keyInvariantFMB p l@@ -1124,26 +1136,28 @@       sizer = sizeFMB r  structuralInvariant :: Ord k => FM k a -> Bool-structuralInvariant (FM k fmb) = structuralInvariantFMB fmb+structuralInvariant (FM _ fmb) = structuralInvariantFMB fmb   instance (Ord k,Arbitrary k,Arbitrary a) => Arbitrary (FM k a) where   arbitrary = do xs <- arbitrary                  return (Prelude.foldr (uncurry insert) empty xs)--  coarbitrary (FM x fmb)  = coarbitrary_maybe x . coarbitrary_fmb fmb+  coarbitrary (FM x fmb) = coarbitrary_maybe x . coarbitrary_fmb fmb  +coarbitrary_maybe :: (Arbitrary t) => Maybe t    -> Test.QuickCheck.Gen b+                                                 -> Test.QuickCheck.Gen b coarbitrary_maybe Nothing = variant 0 coarbitrary_maybe (Just x) = variant 1 . coarbitrary x +coarbitrary_fmb :: (Arbitrary t1, Arbitrary t) => FMB t t1 -> Gen a -> Gen a coarbitrary_fmb E = variant 0 coarbitrary_fmb (I _ k x l (FMB' m) r) =-	variant 1 . coarbitrary k . coarbitrary_maybe x .+        variant 1 . coarbitrary k . coarbitrary_maybe x .         coarbitrary_fmb l . coarbitrary_fmb m . coarbitrary_fmb r  instance Ord k => Monoid (FM k a) where    mempty  = empty    mappend = union    mconcat = unionSeq-   +
src/Data/Edison/Coll/Defaults.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Coll.Defaults---   Copyright   :  Copyright (c) 1998 Chris Okasaki+--   Copyright   :  Copyright (c) 1998, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -67,29 +67,29 @@ toOrdSeqUsingFoldr :: (OrdColl c a,S.Sequence seq) => c -> seq a toOrdSeqUsingFoldr = foldr S.lcons S.empty -unsafeFromOrdSeqUsingUnsafeInsertMin :: +unsafeFromOrdSeqUsingUnsafeInsertMin ::     (OrdCollX c a,S.Sequence seq) => seq a -> c unsafeFromOrdSeqUsingUnsafeInsertMin = S.foldr unsafeInsertMin empty  disjointUsingToOrdList :: OrdColl c a => c -> c -> Bool disjointUsingToOrdList xs ys = disj (toOrdList xs) (toOrdList ys)-  where disj a@(x:xs) b@(y:ys) =-          case compare x y of-            LT -> disj xs b+  where disj a@(c:cs) b@(d:ds) =+          case compare c d of+            LT -> disj cs b             EQ -> False-            GT -> disj a ys+            GT -> disj a ds         disj _ _ = True  intersectWitnessUsingToOrdList ::-	(OrdColl c a, Monad m) => c -> c -> m (a,a)-intersectWitnessUsingToOrdList xs ys = witness (toOrdList xs) (toOrdList ys)+        (OrdColl c a, Monad m) => c -> c -> m (a,a)+intersectWitnessUsingToOrdList as bs = witness (toOrdList as) (toOrdList bs)   where witness a@(x:xs) b@(y:ys) =           case compare x y of             LT -> witness xs b             EQ -> return (x, y)             GT -> witness a ys-	-- XXX-        witness _ _ = fail $ instanceName xs ++ ".intersect: failed"+        -- XXX+        witness _ _ = fail $ instanceName as ++ ".intersect: failed"  lookupUsingLookupM :: Coll c a => a -> c -> a lookupUsingLookupM x ys = runIdentity (lookupM x ys)@@ -128,10 +128,10 @@ fromSeqWithUsingInsertWith c = S.foldr (insertWith c) empty  insertUsingInsertWith :: Set c a => a -> c -> c-insertUsingInsertWith = insertWith (\x y -> x)+insertUsingInsertWith = insertWith (\x _ -> x)  unionUsingUnionWith :: Set c a => c -> c -> c-unionUsingUnionWith = unionWith (\x y -> x)+unionUsingUnionWith = unionWith (\x _ -> x)  filterUsingOrdLists :: OrdColl c a => (a -> Bool) -> c -> c filterUsingOrdLists p = unsafeFromOrdList . L.filter p . toOrdList@@ -141,10 +141,10 @@   where (ys,zs) = L.partition p (toOrdList xs)  intersectionUsingIntersectionWith :: Set c a => c -> c -> c-intersectionUsingIntersectionWith = intersectionWith (\x y -> x)+intersectionUsingIntersectionWith = intersectionWith (\x _ -> x)  differenceUsingOrdLists :: OrdSet c a => c -> c -> c-differenceUsingOrdLists xs ys = unsafeFromOrdList (diff (toOrdList xs) (toOrdList ys))+differenceUsingOrdLists as bs = unsafeFromOrdList $ diff (toOrdList as) (toOrdList bs)   where diff a@(x:xs) b@(y:ys) =           case compare x y of             LT -> x : diff xs b@@ -161,6 +161,7 @@ subsetUsingOrdLists :: OrdSet c a => c -> c -> Bool subsetUsingOrdLists xs ys = subsetOnOrdLists (toOrdList xs) (toOrdList ys) +properSubsetOnOrdLists :: (Ord t) => [t] -> [t] -> Bool properSubsetOnOrdLists [] [] = False properSubsetOnOrdLists [] (_:_) = True properSubsetOnOrdLists (_:_) [] = False@@ -170,6 +171,7 @@     EQ -> properSubsetOnOrdLists xs ys     GT -> subsetOnOrdLists a ys +subsetOnOrdLists :: (Ord t) => [t] -> [t] -> Bool subsetOnOrdLists [] _ = True subsetOnOrdLists (_:_) [] = False subsetOnOrdLists a@(x:xs) (y:ys) =@@ -182,26 +184,26 @@ insertSeqWithUsingInsertWith c xs s = S.foldr (insertWith c) s xs  unionlUsingUnionWith :: Set c a => c -> c -> c-unionlUsingUnionWith xs ys = unionWith (\x y -> x) xs ys+unionlUsingUnionWith xs ys = unionWith (\x _ -> x) xs ys  unionrUsingUnionWith :: Set c a => c -> c -> c-unionrUsingUnionWith xs ys = unionWith (\x y -> y) xs ys+unionrUsingUnionWith xs ys = unionWith (\_ y -> y) xs ys  unionWithUsingOrdLists :: OrdSet c a => (a -> a -> a) -> c -> c -> c-unionWithUsingOrdLists c xs ys = unsafeFromOrdList (merge (toOrdList xs) (toOrdList ys))+unionWithUsingOrdLists c as bs = unsafeFromOrdList $ merge (toOrdList as) (toOrdList bs)   where merge a@(x:xs) b@(y:ys) =           case compare x y of             LT -> x : merge xs b             EQ -> c x y : merge xs ys             GT -> y : merge a ys-        merge a@(x:xs) [] = a+        merge a [] = a         merge [] b = b  unionSeqWithUsingReducer :: (Set c a,S.Sequence seq) => (a -> a -> a) -> seq c -> c unionSeqWithUsingReducer c = S.reducer (unionWith c) empty  intersectionWithUsingOrdLists :: OrdSet c a => (a -> a -> a) -> c -> c -> c-intersectionWithUsingOrdLists c xs ys = unsafeFromOrdList (inter (toOrdList xs) (toOrdList ys))+intersectionWithUsingOrdLists c as bs = unsafeFromOrdList $ inter (toOrdList as) (toOrdList bs)   where inter a@(x:xs) b@(y:ys) =           case compare x y of             LT -> inter xs b@@ -219,9 +221,9 @@   | otherwise = concat ["(",instanceName xs,".fromSeq ",showsPrec 10 (toList xs) (')':rest)]  readsPrecUsingFromList :: (Coll c a, Read a) => Int -> ReadS c-readsPrecUsingFromList i xs =+readsPrecUsingFromList _ xs =     let result = maybeParens p xs-        p xs = tokenMatch ((instanceName x)++".fromSeq") xs+        p ys = tokenMatch ((instanceName x) ++ ".fromSeq") ys                  >>= readsPrec 10                  >>= \(l,rest) -> return (fromList l,rest) @@ -232,7 +234,7 @@     in result  compareUsingToOrdList :: OrdColl c a => c -> c -> Ordering-compareUsingToOrdList xs ys = cmp (toOrdList xs) (toOrdList ys)+compareUsingToOrdList as bs = cmp (toOrdList as) (toOrdList bs)  where   cmp [] [] = EQ   cmp [] _  = LT
src/Data/Edison/Coll/EnumSet.hs view
@@ -22,10 +22,10 @@ -- Also, the number of distinct elements of @A@ must be less than or equal -- to the number of bits in @Word@. ----- The @Enum A@ instance must be consistent with the @Eq A@ instance. +-- The @Enum A@ instance must be consistent with the @Eq A@ instance. -- That is, we must have: ----- > forall x y::A, x == y <==> toEnum x == toEnum y +-- > forall x y::A, x == y <==> toEnum x == toEnum y -- -- Additionally, for operations that require an @Ord A@ context, we require that -- toEnum be monotonic with respect to comparison.  That is, we must have:@@ -36,14 +36,14 @@ -- the enumerated type has sufficently few constructors.  {--Copyright (c) 2006, David F. Place+Copyright (c) 2006, 2008, David F. Place All rights reserved.  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -    + * Redistributions of source code must retain the above copyright     notice, this list of conditions and the following disclaimer. @@ -67,13 +67,13 @@ 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.--} +-}  module Data.Edison.Coll.EnumSet (             -- * Set type-            Set          +            Set -	    -- * CollX operations+            -- * CollX operations             , empty             , singleton             , fromSeq@@ -135,6 +135,7 @@              -- * Set operations             , fromSeqWith+            , fromOrdSeq             , insertWith             , insertSeqWith             , unionl@@ -160,30 +161,28 @@ import Data.Bits hiding (complement) import Data.Word import Data.Monoid (Monoid(..))-import Data.Array -import Data.Edison.Prelude import qualified Data.Edison.Seq as S import qualified Data.Edison.Coll as C-import qualified Data.Edison.Seq.ListSeq as L import Data.Edison.Coll.Defaults import Test.QuickCheck hiding (check) +moduleName :: String moduleName = "Data.Edison.Coll.EnumSet"  {--------------------------------------------------------------------   Sets are bit strings of width wordLength. --------------------------------------------------------------------} -- | A set of values @a@ implemented as bitwise operations.  Useful--- for members of class Enum with no more elements than there are bits +-- for members of class Enum with no more elements than there are bits -- in @Word@. newtype Set a = Set Word deriving (Eq)  wordLength :: Int wordLength = bitSize (0::Word) -check :: String -> Int -> Int -check msg x  +check :: String -> Int -> Int+check msg x     | x < wordLength = x     | otherwise = error $ "EnumSet."++msg++": element beyond word size." @@ -280,12 +279,12 @@  -- given the preconditions, we can just ignore the combining function insertWith :: (Eq a, Enum a) => (a -> a -> a) -> a -> Set a -> Set a-insertWith f x (Set w) =+insertWith _ x (Set w) =     Set $ setBit w $ check "insertWith" $ fromEnum x  -- | /O(1)/. Delete an element from a set. delete :: (Eq a, Enum a) => a -> Set a -> Set a-delete x (Set w) = +delete x (Set w) =     Set $ clearBit w $ fromEnum x  deleteAll :: (Eq a, Enum a) => a -> Set a -> Set a@@ -312,7 +311,7 @@  -- | /O(1)/. The minimal element of a set. minElem :: (Enum a) => Set a -> a-minElem (Set w) +minElem (Set w)    | w == 0    = error $ moduleName++".minElem: empty set"    | otherwise = toEnum $ lsb w @@ -324,7 +323,7 @@  -- | /O(1)/. Delete the minimal element. deleteMin :: (Enum a) => Set a -> Set a-deleteMin (Set w) +deleteMin (Set w)    | w == 0    = empty    | otherwise = Set $ clearBit w $ lsb w @@ -379,7 +378,7 @@   {---------------------------------------------------------------------  Union. +  Union. --------------------------------------------------------------------} -- | The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@). unionSeq :: (Eq a, Enum a, S.Sequence s) => s (Set a) -> Set a@@ -397,15 +396,15 @@  -- given the preconditions, we can just ignore the combining function unionWith :: (a -> a -> a) -> Set a -> Set a -> Set a-unionWith f = union+unionWith _ = union  unionSeqWith :: (Eq a, Enum a, S.Sequence s) => (a -> a -> a) -> s (Set a) -> Set a-unionSeqWith f = unionSeq+unionSeqWith _ = unionSeq  {--------------------------------------------------------------------   Difference --------------------------------------------------------------------}--- | /O(1)/. Difference of two sets. +-- | /O(1)/. Difference of two sets. difference :: Set a -> Set a -> Set a difference (Set x) (Set y) = Set $ (x .|. y) `xor` y @@ -420,7 +419,7 @@ intersection (Set x) (Set y) = Set $ x .&. y  intersectionWith :: (a -> a -> a) -> Set a -> Set a -> Set a-intersectionWith f = intersection+intersectionWith _ = intersection  {--------------------------------------------------------------------   Complement@@ -438,8 +437,8 @@ -- | /O(n)/. Filter all elements that satisfy the predicate. filter :: (Eq a, Enum a) => (a -> Bool) -> Set a -> Set a filter p (Set w) = Set $ foldlBits' f 0 w-    where -      f z i +    where+      f z i         | p $ toEnum i = setBit z i         | otherwise = z @@ -448,7 +447,7 @@ -- See also 'split'. partition :: (Eq a, Enum a) => (a -> Bool) -> Set a -> (Set a,Set a) partition p (Set w) = (Set yay,Set nay)-    where +    where       (yay,nay) = foldlBits' f (0,0) w       f (x,y) i           | p $ toEnum i = (setBit x i,y)@@ -458,9 +457,9 @@ {----------------------------------------------------------------------   Map ----------------------------------------------------------------------}--- | /O(n)/. +-- | /O(n)/. -- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.--- +-- -- It's worth noting that the size of the result may be smaller if, -- for some @(x,y)@, @x \/= y && f x == f y@ map :: (Enum a,Enum b) => (a -> b) -> Set a -> Set b@@ -494,72 +493,72 @@  fold :: (Eq a, Enum a) => (a -> c -> c) -> c -> Set a -> c fold f z (Set w) = foldrBits folder z w-  where folder i z = f (toEnum i) z+  where folder i = f (toEnum i)  fold' :: (Eq a, Enum a) => (a -> c -> c) -> c -> Set a -> c fold' f z (Set w) = foldrBits' folder z w-  where folder i z = f (toEnum i) z+  where folder i = f (toEnum i)  fold1 :: (Eq a, Enum a) => (a -> a -> a) -> Set a -> a-fold1 f (Set 0) = error (moduleName++".fold1: empty set")-fold1 f (Set w) = foldrBits folder (toEnum max) (clearBit w max)+fold1 _ (Set 0) = error (moduleName++".fold1: empty set")+fold1 f (Set w) = foldrBits folder (toEnum maxi) (clearBit w maxi)     where-      max = msb w+      maxi = msb w       folder i z = f (toEnum i) z  fold1' :: (Eq a, Enum a) => (a -> a -> a) -> Set a -> a-fold1' f (Set 0) = error (moduleName++".fold1': empty set")-fold1' f (Set w) = foldrBits folder (toEnum max) (clearBit w max)+fold1' _ (Set 0) = error (moduleName++".fold1': empty set")+fold1' f (Set w) = foldrBits folder (toEnum maxi) (clearBit w maxi)     where-      max = msb w+      maxi = msb w       folder i z = f (toEnum i) z  foldr :: (Ord a, Enum a) => (a -> b -> b) -> b -> Set a -> b foldr f z (Set w) = foldrBits folder z w-  where folder i z = f (toEnum i) z+  where folder i = f (toEnum i)  foldr' :: (Ord a, Enum a) => (a -> b -> b) -> b -> Set a -> b foldr' f z (Set w) = foldrBits' folder z w-  where folder i z = f (toEnum i) z+  where folder i j = f (toEnum i) j  foldr1 :: (Ord a, Enum a) => (a -> a -> a) -> Set a -> a-foldr1 f (Set 0) = error (moduleName++".foldr1: empty set")-foldr1 f (Set w) = foldrBits folder (toEnum max) (clearBit w max)+foldr1 _ (Set 0) = error (moduleName ++ ".foldr1: empty set")+foldr1 f (Set w) = foldrBits folder (toEnum maxi) (clearBit w maxi)     where-      max = msb w+      maxi = msb w       folder i z = f (toEnum i) z  foldr1' :: (Ord a, Enum a) => (a -> a -> a) -> Set a -> a-foldr1' f (Set 0) = error (moduleName++".foldr1': empty set")-foldr1' f (Set w) = foldrBits folder (toEnum max) (clearBit w max)+foldr1' _ (Set 0) = error (moduleName++".foldr1': empty set")+foldr1' f (Set w) = foldrBits folder (toEnum maxi) (clearBit w maxi)     where-      max = msb w+      maxi = msb w       folder i z = f (toEnum i) z  foldl :: (Ord a, Enum a) => (c -> a -> c) -> c -> Set a -> c foldl f z (Set w) = foldlBits folder z w-  where folder z i = f z (toEnum i)+  where folder h i = f h (toEnum i)  foldl' :: (Ord a, Enum a) => (c -> a -> c) -> c -> Set a -> c foldl' f z (Set w) = foldlBits' folder z w-  where folder z i = f z (toEnum i)+  where folder h i = f h (toEnum i)  foldl1 :: (Ord a, Enum a) => (a -> a -> a) -> Set a -> a-foldl1 f (Set 0) = error (moduleName++".foldl1: empty set")-foldl1 f (Set w) = foldlBits folder (toEnum min) (clearBit w min)+foldl1 _ (Set 0) = error (moduleName++".foldl1: empty set")+foldl1 f (Set w) = foldlBits folder (toEnum mininum) (clearBit w mininum)   where-    min = lsb w+    mininum = lsb w     folder z i = f z (toEnum i)  foldl1' :: (Ord a, Enum a) => (a -> a -> a) -> Set a -> a-foldl1' f (Set 0) = error (moduleName++".foldl1': empty set")-foldl1' f (Set w) = foldlBits' folder (toEnum min) (clearBit w min)+foldl1' _ (Set 0) = error (moduleName++".foldl1': empty set")+foldl1' f (Set w) = foldlBits' folder (toEnum mininum) (clearBit w mininum)   where-    min = lsb w+    mininum = lsb w     folder z i = f z (toEnum i)  {---------------------------------------------------------------------  Lists +  Lists --------------------------------------------------------------------} fromSeq :: (Eq a, Enum a, S.Sequence s) => s a -> Set a fromSeq xs = Set $ S.fold' f 0 xs@@ -573,7 +572,7 @@  -- given the preconditions, we can just ignore the combining function insertSeqWith :: (Eq a, Enum a, S.Sequence s) => (a -> a -> a) -> s a -> Set a -> Set a-insertSeqWith f = insertSeq+insertSeqWith _ = insertSeq  toSeq :: (Eq a, Enum a, S.Sequence s) => Set a -> s a toSeq (Set w) = foldrBits f S.empty w@@ -583,7 +582,7 @@ toOrdSeq = toSeq  fromSeqWith :: (Eq a, Enum a, S.Sequence s) => (a -> a -> a) -> s a -> Set a-fromSeqWith = fromSeqWithUsingInsertWith +fromSeqWith = fromSeqWithUsingInsertWith   {--------------------------------------------------------------------@@ -610,17 +609,17 @@ strict s@(Set w) = w `seq` s  strictWith :: (a -> b) -> Set a -> Set a-strictWith f s@(Set w) = w `seq` s+strictWith _ s@(Set w) = w `seq` s  {---------------------------------------------------------------------  Utility functions. +  Utility functions. --------------------------------------------------------------------}  foldrBits :: (Int -> a -> a) -> a -> Word -> a foldrBits f z w = foldrBits_aux f z 0 w  foldrBits_aux :: (Int -> a -> a) -> a -> Int -> Word -> a-foldrBits_aux f z i 0 = z+foldrBits_aux _ z _ 0 = z foldrBits_aux f z i w    | i `seq` w `seq` False = undefined    | otherwise =@@ -650,7 +649,7 @@ foldrBits' f z w = foldrBits_aux' f z 0 w  foldrBits_aux' :: (Int -> a -> a) -> a -> Int -> Word -> a-foldrBits_aux' f z i 0 = z+foldrBits_aux' _ z _ 0 = z foldrBits_aux' f z i w    | i `seq` w `seq` False = undefined    | otherwise =@@ -680,7 +679,7 @@ foldlBits f z w = foldlBits_aux f z 0 w  foldlBits_aux :: (a -> Int -> a) -> a -> Int -> Word -> a-foldlBits_aux f z i 0 = z+foldlBits_aux _ z _ 0 = z foldlBits_aux f z i w    | i `seq` w `seq` False = undefined    | otherwise =@@ -703,13 +702,13 @@      0x0F -> a $ f (f (f (f z i) (i+1)) (i+2)) (i+3)      _ -> error "bug in foldlBits_aux" - where a z = foldlBits_aux f z (i+4) (Bits.shiftR w 4)+ where a b = foldlBits_aux f b (i + 4) (Bits.shiftR w 4)  foldlBits' :: (a -> Int -> a) -> a -> Word -> a foldlBits' f z w = foldlBits_aux' (\x i -> x `seq` f x i) z 0 w  foldlBits_aux' :: (a -> Int -> a) -> a -> Int -> Word -> a-foldlBits_aux' f z i 0 = z+foldlBits_aux' _ z _ 0 = z foldlBits_aux' f z i w    | i `seq` w `seq` False = undefined    | otherwise =@@ -732,22 +731,22 @@      0x0F -> a $! f (f (f (f z i) (i+1)) (i+2)) (i+3)      _ -> error "bug in foldlBits_aux" - where a z = foldlBits_aux' f z (i+4) (Bits.shiftR w 4)+ where a b = foldlBits_aux' f b (i + 4) (Bits.shiftR w 4)  instance (Eq a, Enum a) => C.CollX (Set a) a where   {singleton = singleton; fromSeq = fromSeq; insert = insert;-   insertSeq = insertSeq; unionSeq = unionSeq; +   insertSeq = insertSeq; unionSeq = unionSeq;    delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;    null = null; size = size; member = member; count = count;    strict = strict;-   structuralInvariant = structuralInvariant; instanceName c = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance (Ord a, Enum a) => C.OrdCollX (Set a) a where-  {deleteMin = deleteMin; deleteMax = deleteMax; -   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; -   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; -   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; -   filterGE = filterGE; partitionLT_GE = partitionLT_GE; +  {deleteMin = deleteMin; deleteMax = deleteMax;+   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax;+   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend;+   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT;+   filterGE = filterGE; partitionLT_GE = partitionLT_GE;    partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}  instance (Eq a, Enum a) => C.SetX (Set a) a where@@ -756,20 +755,20 @@    properSubset = properSubset; subset = subset}  instance (Eq a, Enum a) => C.Coll (Set a) a where-  {toSeq = toSeq; lookup = lookup; lookupM = lookupM; -   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; +  {toSeq = toSeq; lookup = lookup; lookupM = lookupM;+   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; strictWith = strictWith}  instance (Ord a, Enum a) => C.OrdColl (Set a) a where-  {minView = minView; minElem = minElem; maxView = maxView; -   maxElem = maxElem; foldr = foldr; foldr' = foldr'; +  {minView = minView; minElem = minElem; maxView = maxView;+   maxElem = maxElem; foldr = foldr; foldr' = foldr';    foldl = foldl; foldl' = foldl'; foldr1 = foldr1; foldr1' = foldr1';    foldl1 = foldl1; foldl1' = foldl1'; toOrdSeq = toOrdSeq;    unsafeMapMonotonic = unsafeMapMonotonic}  instance (Eq a, Enum a) => C.Set (Set a) a where-  {fromSeqWith = fromSeqWith; insertWith = insertWith; +  {fromSeqWith = fromSeqWith; insertWith = insertWith;    insertSeqWith = insertSeqWith; unionl = unionl; unionr = unionr;    unionWith = unionWith; unionSeqWith = unionSeqWith;    intersectionWith = intersectionWith}
src/Data/Edison/Coll/LazyPairingHeap.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Coll.LazyPairingHeap---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -41,25 +41,25 @@ ) where  import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter)-import Data.Edison.Prelude import qualified Data.Edison.Coll as C ( CollX(..), OrdCollX(..),-				   Coll(..), OrdColl(..), toOrdList )+                                   Coll(..), OrdColl(..), toOrdList ) import qualified Data.Edison.Seq as S import Data.Edison.Coll.Defaults-import Data.List(sort)+import Data.List (sort) import Data.Monoid import Control.Monad import Test.QuickCheck +moduleName :: String moduleName = "Data.Edison.Coll.LazyPairingHeap"  -data Heap a = E +data Heap a = E             | H1 a (Heap a)             | H2 a !(Heap a) (Heap a)  --- Invariants: +-- Invariants: --   * left child of H2 not empty structuralInvariant :: Heap a -> Bool structuralInvariant E = True@@ -69,10 +69,11 @@  -- second arg is not empty -- not used!-link E h = h-link (H1 x b) a = H2 x a b-link (H2 x a b) a' = H1 x (union (union a a') b)+-- link E h = h+-- link (H1 x b) a = H2 x a b+-- link (H2 x a b) a' = H1 x (union (union a a') b) +makeH2 :: a -> Heap a -> Heap a -> Heap a makeH2 x E xs = H1 x xs makeH2 x h xs = H2 x h xs @@ -93,14 +94,14 @@  union :: Ord a => Heap a -> Heap a -> Heap a union E h = h-union hx@(H1 x xs) E = hx+union hx@(H1 _ _) E = hx union hx@(H1 x xs) hy@(H1 y ys)   | x <= y    = H2 x hy xs   | otherwise = H2 y hx ys union hx@(H1 x xs) hy@(H2 y a ys)   | x <= y    = H2 x hy xs   | otherwise = H1 y (union (union hx a) ys)-union hx@(H2 x a xs) E = hx+union hx@(H2 _ _ _) E = hx union hx@(H2 x a xs) hy@(H1 y ys)   | x <= y    = H1 x (union (union hy a) xs)   | otherwise = H2 y hx ys@@ -115,7 +116,7 @@         del (H1 x xs) =           case compare x y of             LT -> case del xs of-                    Just xs -> Just (H1 x xs)+                    Just ys -> Just (H1 x ys)                     Nothing -> Nothing             EQ -> Just xs             GT -> Nothing@@ -130,7 +131,7 @@             GT -> Nothing  deleteAll :: Ord a => a -> Heap a -> Heap a-deleteAll y E = E+deleteAll _ E = E deleteAll y h@(H1 x xs) =   case compare x y of     LT -> H1 x (deleteAll y xs)@@ -147,7 +148,7 @@   where delList [] h = h         delList (y:ys) h = del y ys h -        del y ys E = E+        del _ _ E = E         del y ys h@(H1 x xs) =           case compare x y of             LT -> H1 x (del y ys xs)@@ -172,11 +173,11 @@  size :: Heap a -> Int size E = 0-size (H1 x xs) = 1 + size xs-size (H2 x h xs) = 1 + size h + size xs+size (H1 _ xs) = 1 + size xs+size (H2 _ h xs) = 1 + size h + size xs  member :: Ord a => a -> Heap a -> Bool-member x E = False+member _ E = False member x (H1 y ys) =   case compare x y of     LT -> False@@ -189,7 +190,7 @@     GT -> member x h || member x ys  count :: Ord a => a -> Heap a -> Int-count x E = 0+count _ E = 0 count x (H1 y ys) =   case compare x y of     LT -> 0@@ -203,8 +204,8 @@  deleteMin :: Ord a => Heap a -> Heap a deleteMin E = E-deleteMin (H1 x xs) = xs-deleteMin (H2 x h xs) = union h xs+deleteMin (H1 _ xs) = xs+deleteMin (H2 _ h xs) = union h xs  unsafeInsertMin :: Ord a => a -> Heap a -> Heap a unsafeInsertMin = H1@@ -221,7 +222,7 @@ unsafeAppend (H2 x a xs) h = H1 x (union (unsafeAppend a h) xs)  filterLT :: Ord a => a -> Heap a -> Heap a-filterLT y E = E+filterLT _ E = E filterLT y (H1 x xs)   | x < y = H1 x (filterLT y xs)   | otherwise = E@@ -230,7 +231,7 @@   | otherwise = E  filterLE :: Ord a => a -> Heap a -> Heap a-filterLE y E = E+filterLE _ E = E filterLE y (H1 x xs)   | x <= y = H1 x (filterLE y xs)   | otherwise = E@@ -241,25 +242,25 @@ filterGT :: Ord a => a -> Heap a -> Heap a filterGT y h = fgt h E   where fgt E rest = rest-        fgt h@(H1 x xs) rest-          | x > y = union h rest+        fgt i@(H1 x xs) rest+          | x > y = union i rest           | otherwise = fgt xs rest-        fgt h@(H2 x a xs) rest-          | x > y = union h rest+        fgt i@(H2 x a xs) rest+          | x > y = union i rest           | otherwise = fgt a (fgt xs rest)  filterGE :: Ord a => a -> Heap a -> Heap a filterGE y h = fge h E   where fge E rest = rest-        fge h@(H1 x xs) rest-          | x >= y = union h rest+        fge i@(H1 x xs) rest+          | x >= y = union i rest           | otherwise = fge xs rest-        fge h@(H2 x a xs) rest-          | x >= y = union h rest+        fge i@(H2 x a xs) rest+          | x >= y = union i rest           | otherwise = fge a (fge xs rest)  partitionLT_GE :: Ord a => a -> Heap a -> (Heap a, Heap a)-partitionLT_GE y E = (E,E)+partitionLT_GE _ E = (E,E) partitionLT_GE y h@(H1 x xs)   | x < y = let (xs',xs'') = partitionLT_GE y xs             in (H1 x xs',xs'')@@ -271,7 +272,7 @@   | otherwise = (E, h)  partitionLE_GT :: Ord a => a -> Heap a -> (Heap a, Heap a)-partitionLE_GT y E = (E,E)+partitionLE_GT _ E = (E,E) partitionLE_GT y h@(H1 x xs)   | x <= y = let (xs',xs'') = partitionLE_GT y xs              in (H1 x xs',xs'')@@ -283,7 +284,7 @@   | otherwise = (E, h)  partitionLT_GT :: Ord a => a -> Heap a -> (Heap a, Heap a)-partitionLT_GT y E = (E,E)+partitionLT_GT _ E = (E,E) partitionLT_GT y h@(H1 x xs) =   case compare x y of     LT -> let (xs',xs'') = partitionLT_GT y xs@@ -302,39 +303,39 @@ toSeq h = tol h S.empty   where tol E rest = rest         tol (H1 x xs) rest = S.lcons x (tol xs rest)-        tol (H2 x h xs) rest = S.lcons x (tol h (tol xs rest))+        tol (H2 x i xs) rest = S.lcons x $ tol i $ tol xs rest  fold :: (a -> b -> b) -> b -> Heap a -> b-fold f c E = c+fold _ c E = c fold f c (H1 x xs) = f x (fold f c xs) fold f c (H2 x h xs) = f x (fold f (fold f c xs) h)  fold' :: (a -> b -> b) -> b -> Heap a -> b-fold' f c E = c+fold' _ c E = c fold' f c (H1 x xs)   = c `seq` f x $! (fold' f c xs) fold' f c (H2 x h xs) = c `seq` f x $! (fold' f (fold' f c xs) h)   fold1 :: (a -> a -> a) -> Heap a -> a-fold1 f E = error "LazyPairingHeap.fold1: empty heap"+fold1 _ E = error "LazyPairingHeap.fold1: empty heap" fold1 f (H1 x xs) = fold f x xs fold1 f (H2 x h xs) = fold f (fold f x xs) h  fold1' :: (a -> a -> a) -> Heap a -> a-fold1' f E = error "LazyPairingHeap.fold1': empty heap"+fold1' _ E = error "LazyPairingHeap.fold1': empty heap" fold1' f (H1 x xs)   = fold' f x xs fold1' f (H2 x h xs) = fold' f (fold' f x xs) h   filter :: Ord a => (a -> Bool) -> Heap a -> Heap a-filter p E = E+filter _ E = E filter p (H1 x xs) = if p x then H1 x (filter p xs) else filter p xs filter p (H2 x h xs) =   if p x then makeH2 x (filter p h) (filter p xs)          else union (filter p h) (filter p xs)  partition :: Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a)-partition p E = (E, E)+partition _ E = (E, E) partition p (H1 x xs) = if p x then (H1 x xs',xs'') else (xs',H1 x xs'')     where (xs',xs'') = partition p xs partition p (H2 x h xs) =@@ -351,10 +352,10 @@             LT -> look xs rest             EQ -> S.lcons x (look xs rest)             GT -> rest-        look (H2 x h xs) rest =+        look (H2 x i xs) rest =           case compare x y of-            LT -> look h (look xs rest)-            EQ -> S.lcons x (look h (look xs rest))+            LT -> look i $ look xs rest+            EQ -> S.lcons x $ look i $ look xs rest             GT -> rest  minView :: (Ord a, Monad m) => Heap a -> m (a, Heap a)@@ -364,8 +365,8 @@  minElem :: Heap a -> a minElem E = error "LazyPairingHeap.minElem: empty heap"-minElem (H1 x xs) = x-minElem (H2 x h xs) = x+minElem (H1 x _) = x+minElem (H2 x _ _) = x  maxView :: (Ord a, Monad m) => Heap a -> m (a, Heap a) maxView E = fail "LazyPairingHeap.maxView: empty heap"@@ -373,12 +374,13 @@   where (xs', y) = maxView' xs  -- not exported+maxView' :: (Ord a) => Heap a -> (Heap a, a) maxView' (H1 x E) = (E, x) maxView' (H1 x xs) = (H1 x xs', y)   where (xs', y) = maxView' xs maxView' (H2 x a E) = (H1 x a', y)   where (a', y) = maxView' a-maxView' (H2 x a xs) = +maxView' (H2 x a xs) =     if y > z then (makeH2 x a' xs, y) else (H2 x a xs', z)   where (a', y) = maxView' a         (xs', z) = maxView' xs@@ -387,66 +389,66 @@ maxElem :: Ord a => Heap a -> a maxElem E = error "LazyPairingHeap.maxElem: empty heap" maxElem (H1 x E) = x-maxElem (H1 x xs) = maxElem xs-maxElem (H2 x h E) = maxElem h-maxElem (H2 x h xs) = max (maxElem h) (maxElem xs)+maxElem (H1 _ xs) = maxElem xs+maxElem (H2 _ h E) = maxElem h+maxElem (H2 _ h xs) = max (maxElem h) (maxElem xs)  foldr :: Ord a => (a -> b -> b) -> b -> Heap a -> b-foldr f c E = c+foldr _ c E = c foldr f c (H1 x xs) = f x (foldr f c xs) foldr f c (H2 x h xs) = f x (foldr f c (union h xs))  foldr' :: Ord a => (a -> b -> b) -> b -> Heap a -> b-foldr' f c E = c+foldr' _ c E = c foldr' f c (H1 x xs)   = c `seq` f x $! (foldr' f c xs) foldr' f c (H2 x h xs) = c `seq` f x $! (foldr' f c (union h xs))  foldl :: Ord a => (b -> a -> b) -> b -> Heap a -> b-foldl f c E = c+foldl _ c E = c foldl f c (H1 x xs) = foldl f (f c x) xs foldl f c (H2 x h xs) = foldl f (f c x) (union h xs)  foldl' :: Ord a => (b -> a -> b) -> b -> Heap a -> b-foldl' f c E = c+foldl' _ c E = c foldl' f c (H1 x xs)   = c `seq` foldl' f (f c x) xs foldl' f c (H2 x h xs) = c `seq` foldl' f (f c x) (union h xs)  foldr1 :: Ord a => (a -> a -> a) -> Heap a -> a-foldr1 f E = error "LazyPairingHeap.foldr1: empty heap"-foldr1 f (H1 x E) = x+foldr1 _ E = error "LazyPairingHeap.foldr1: empty heap"+foldr1 _ (H1 x E) = x foldr1 f (H1 x xs) = f x (foldr1 f xs) foldr1 f (H2 x h xs) = f x (foldr1 f (union h xs))  foldr1' :: Ord a => (a -> a -> a) -> Heap a -> a-foldr1' f E = error "LazyPairingHeap.foldr1': empty heap"-foldr1' f (H1 x E)    = x+foldr1' _ E = error "LazyPairingHeap.foldr1': empty heap"+foldr1' _ (H1 x E)    = x foldr1' f (H1 x xs)   = f x $! (foldr1' f xs) foldr1' f (H2 x h xs) = f x $! (foldr1' f (union h xs))  foldl1 :: Ord a => (a -> a -> a) -> Heap a -> a-foldl1 f E = error "LazyPairingHeap.foldl1: empty heap"+foldl1 _ E = error "LazyPairingHeap.foldl1: empty heap" foldl1 f (H1 x xs) = foldl f x xs foldl1 f (H2 x h xs) = foldl f x (union h xs)  foldl1' :: Ord a => (a -> a -> a) -> Heap a -> a-foldl1' f E = error "LazyPairingHeap.foldl1': empty heap"+foldl1' _ E = error "LazyPairingHeap.foldl1': empty heap" foldl1' f (H1 x xs)   = foldl' f x xs foldl1' f (H2 x h xs) = foldl' f x (union h xs)  unsafeMapMonotonic :: (Ord a,Ord b) => (a -> b) -> Heap a -> Heap b unsafeMapMonotonic = mapm-  where mapm f E = E+  where mapm _ E = E         mapm f (H1 x xs) = H1 (f x) (mapm f xs)         mapm f (H2 x h xs) = H2 (f x) (mapm f h) (mapm f xs)   strict :: Heap a -> Heap a strict h@E = h-strict h@(H1 x xs) = strict xs `seq` h-strict h@(H2 x h' xs) = strict h' `seq` strict xs `seq` h+strict h@(H1 _ xs) = strict xs `seq` h+strict h@(H2 _ h' xs) = strict h' `seq` strict xs `seq` h  strictWith :: (a -> b) -> Heap a -> Heap a-strictWith f h@E = h+strictWith _ h@E = h strictWith f h@(H1 x xs) = f x `seq` strictWith f xs `seq` h strictWith f h@(H2 x h' xs) = f x `seq` strictWith f h' `seq` strictWith f xs `seq` h @@ -484,29 +486,29 @@  instance Ord a => C.CollX (Heap a) a where   {singleton = singleton; fromSeq = fromSeq; insert = insert;-   insertSeq = insertSeq; unionSeq = unionSeq; +   insertSeq = insertSeq; unionSeq = unionSeq;    delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;    null = null; size = size; member = member; count = count;    strict = strict;-   structuralInvariant = structuralInvariant; instanceName c = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Ord a => C.OrdCollX (Heap a) a where-  {deleteMin = deleteMin; deleteMax = deleteMax; -   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; -   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; -   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; -   filterGE = filterGE; partitionLT_GE = partitionLT_GE; +  {deleteMin = deleteMin; deleteMax = deleteMax;+   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax;+   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend;+   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT;+   filterGE = filterGE; partitionLT_GE = partitionLT_GE;    partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}  instance Ord a => C.Coll (Heap a) a where-  {toSeq = toSeq; lookup = lookup; lookupM = lookupM; -   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; +  {toSeq = toSeq; lookup = lookup; lookupM = lookupM;+   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; strictWith = strictWith}  instance Ord a => C.OrdColl (Heap a) a where-  {minView = minView; minElem = minElem; maxView = maxView; -   maxElem = maxElem; foldr = foldr; foldr' = foldr'; +  {minView = minView; minElem = minElem; maxView = maxView;+   maxElem = maxElem; foldr = foldr; foldr' = foldr';    foldl = foldl; foldl' = foldl'; foldr1 = foldr1;    foldr1' = foldr1'; foldl1 = foldl1; foldl1' = foldl1';    toOrdSeq = toOrdSeq; unsafeMapMonotonic = unsafeMapMonotonic}@@ -539,14 +541,14 @@                   mb = minElem b            sift1 x E = H1 x E-          sift1 x a +          sift1 x a               | x <= ma   = H1 x a               | otherwise = H1 ma (siftInto x a)             where ma = minElem a            siftInto x (H1 _ a) = sift1 x a           siftInto x (H2 _ a b) = sift x a b-          siftInto x E = error "LazyPairingHeap.arbitrary: bug!"+          siftInto _ E = error "LazyPairingHeap.arbitrary: bug!"    coarbitrary E = variant 0   coarbitrary (H1 x a) = variant 1 . coarbitrary x . coarbitrary a
src/Data/Edison/Coll/LeftistHeap.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Coll.LeftistHeap---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -40,8 +40,7 @@ ) where  import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter)-import Data.Edison.Prelude-import qualified Data.Edison.Coll as C ( CollX(..), OrdCollX(..), Coll(..), OrdColl(..), +import qualified Data.Edison.Coll as C ( CollX(..), OrdCollX(..), Coll(..), OrdColl(..),                                    unionList, toOrdList ) import qualified Data.Edison.Seq as S import Data.Edison.Coll.Defaults@@ -49,6 +48,7 @@ import Control.Monad import Test.QuickCheck +moduleName :: String moduleName = "Data.Edison.Coll.LeftistHeap"  data Heap a = E | L !Int !a !(Heap a) !(Heap a)@@ -61,20 +61,21 @@  structuralInvariant :: Ord a => Heap a -> Bool structuralInvariant E = True-structuralInvariant t@(L i x l r) =+structuralInvariant t@(L i x _ _) =     i == rank t && isMin x t && checkLeftist t - where rank E = 0-       rank (L _ _ _ r) = (rank r) + 1+ where rank :: Heap a -> Int+       rank E = 0+       rank (L _ _ _ s) = (rank s) + 1 -       isMin x E = True-       isMin x (L _ y l r) = x <= y && (isMin y l) && (isMin y r)+       isMin _ E = True+       isMin z (L _ y l r) = z <= y && (isMin y l) && (isMin y r)         checkLeftist E = True-       checkLeftist t@(L i _ l r) =+       checkLeftist (L _ _ l r) =           rank l >= rank r && checkLeftist l && checkLeftist r -+node :: a -> Heap a -> Heap a -> Heap a node x a E = L 1 x a E node x E b = L 1 x b E node x a@(L m _ _ _) b@(L n _ _ _)@@ -97,17 +98,17 @@  insert :: Ord a => a -> Heap a -> Heap a insert x E = L 1 x E E-insert x h@(L m y a b)+insert x h@(L _ y a b)   | x <= y    = L 1 x h E   | otherwise = node y a (insert x b)  union :: Ord a => Heap a -> Heap a -> Heap a union E h = h union h@(L _ x a b) h' = union' h x a b h'-  where union' h x a b E = h-        union' hx x a b hy@(L _ y c d)-          | x <= y    = node x a (union' hy y c d b)-          | otherwise = node y c (union' hx x a b d)+  where union' i _ _ _ E = i+        union' hx z q e hy@(L _ y c d)+          | z <= y    = node z q (union' hy y c d e)+          | otherwise = node y c (union' hx z q e d)  {- union E h = h@@ -139,7 +140,7 @@     LT -> h     EQ -> union (deleteAll x a) (deleteAll x b)     GT -> node y (deleteAll x a) (deleteAll x b)-deleteAll x E = E+deleteAll _ E = E  null :: Ord a => Heap a -> Bool null E = True@@ -151,7 +152,7 @@         sz (L _ _ a b) i = sz a (sz b (i + 1))  member :: Ord a => a -> Heap a -> Bool-member x E = False+member _ E = False member x (L _ y a b) =   case compare x y of     LT -> False@@ -159,7 +160,7 @@     GT -> member x b || member x a  count :: Ord a => a -> Heap a -> Int-count x E = 0+count _ E = 0 count x (L _ y a b) =   case compare x y of     LT -> 0@@ -172,14 +173,14 @@         tol (L _ x a b) rest = S.lcons x (tol b (tol a rest))  lookupM :: (Ord a, Monad m) => a -> Heap a -> m a-lookupM x E = fail "LeftistHeap.lookupM: XXX"+lookupM _ E = fail "LeftistHeap.lookupM: XXX" lookupM x (L _ y a b) =   case compare x y of     LT -> fail "LeftistHeap.lookupM: XXX"     EQ -> return y     GT -> case lookupM x b `mplus` lookupM x a of                 Nothing -> fail "LeftistHeap.lookupM: XXX"-                Just x  -> return x+                Just q -> return q  lookupAll :: (Ord a,S.Sequence seq) => a -> Heap a -> seq a lookupAll x h = look h S.empty@@ -191,30 +192,30 @@             GT -> look b (look a ys)  fold :: Ord a => (a -> b -> b) -> b -> Heap a -> b-fold f e E = e+fold _ e E = e fold f e (L _ x a b) = f x (fold f (fold f e a) b)  fold' :: Ord a => (a -> b -> b) -> b -> Heap a -> b-fold' f e E = e+fold' _ e E = e fold' f e (L _ x a b) = e `seq` f x $! (fold' f (fold' f e a) b)  fold1 :: Ord a => (a -> a -> a) -> Heap a -> a-fold1 f E = error "LeftistHeap.fold1: empty collection"+fold1 _ E = error "LeftistHeap.fold1: empty collection" fold1 f (L _ x a b) = fold f (fold f x a) b  fold1' :: Ord a => (a -> a -> a) -> Heap a -> a-fold1' f E = error "LeftistHeap.fold1': empty collection"+fold1' _ E = error "LeftistHeap.fold1': empty collection" fold1' f (L _ x a b) = fold' f (fold' f x a) b   filter :: Ord a => (a -> Bool) -> Heap a -> Heap a-filter p E = E+filter _ E = E filter p (L _ x a b)     | p x = node x (filter p a) (filter p b)     | otherwise = union (filter p a) (filter p b)  partition :: Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a)-partition p E = (E, E)+partition _ E = (E, E) partition p (L _ x a b)     | p x = (node x a' b', union a'' b'')     | otherwise = (union a' b', node x a'' b'')@@ -224,12 +225,12 @@  deleteMin :: Ord a => Heap a -> Heap a deleteMin E = E-deleteMin (L _ x a b) = union a b+deleteMin (L _ _ a b) = union a b  deleteMax :: Ord a => Heap a -> Heap a deleteMax h = case maxView h of                 Nothing     -> E-                Just (x,h') -> h'+                Just (_,h') -> h'  unsafeInsertMin :: Ord a => a -> Heap a -> Heap a unsafeInsertMin x h = L 1 x h E@@ -240,11 +241,11 @@  filterLT :: Ord a => a -> Heap a -> Heap a filterLT y (L _ x a b) | x < y = node x (filterLT y a) (filterLT y b)-filterLT y _ = E+filterLT _ _ = E  filterLE :: Ord a => a -> Heap a -> Heap a filterLE y (L _ x a b) | x <= y = node x (filterLE y a) (filterLE y b)-filterLE y _ = E+filterLE _ _ = E  filterGT :: Ord a => a -> Heap a -> Heap a filterGT y h = C.unionList (collect h [])@@ -287,13 +288,13 @@   where (h', hs) = collect h []          collect E hs = (E, hs)-        collect h@(L _ x a b) hs = +        collect h@(L _ x a b) is =           case compare x y of-            GT -> (E, h:hs)-            EQ -> let (a', hs') = collect a hs+            GT -> (E, h:is)+            EQ -> let (a', hs') = collect a is                       (b', hs'') = collect b hs'                   in (union a' b', hs'')-            LT -> let (a', hs') = collect a hs+            LT -> let (a', hs') = collect a is                       (b', hs'') = collect b hs'                   in (node x a' b', hs'') @@ -303,7 +304,7 @@  minElem :: Ord a => Heap a -> a minElem E = error "LeftistHeap.minElem: empty collection"-minElem (L _ x a b) = x+minElem (L _ x _ _) = x  maxView :: (Ord a, Monad m) => Heap a -> m (a, Heap a) maxView E = fail "LeftistHeap.maxView: empty collection"@@ -321,54 +322,54 @@ maxElem :: Ord a => Heap a -> a maxElem E = error "LeftistHeap.maxElem: empty collection" maxElem (L _ x E _) = x-maxElem (L _ x a b) = findMax b (findLeaf a)+maxElem (L _ _ a b) = findMax b (findLeaf a)   where findMax E m = m         findMax (L _ x E _) m           | m >= x = m           | otherwise = x-        findMax (L _ x a b) m = findMax a (findMax b m)+        findMax (L _ _ d c) m = findMax d (findMax c m)          findLeaf E = error "LeftistHeap.maxElem: bug"         findLeaf (L _ x E _) = x-        findLeaf (L _ x a b) = findMax b (findLeaf a)+        findLeaf (L _ _ y c) = findMax c (findLeaf y)  foldr :: Ord a => (a -> b -> b) -> b -> Heap a -> b-foldr f e E = e+foldr _ e E = e foldr f e (L _ x a b) = f x (foldr f e (union a b))  foldr' :: Ord a => (a -> b -> b) -> b -> Heap a -> b-foldr' f e E = e+foldr' _ e E = e foldr' f e (L _ x a b) = e `seq` f x $! (foldr' f e (union a b))  foldl :: Ord a => (b -> a -> b) -> b -> Heap a -> b-foldl f e E = e+foldl _ e E = e foldl f e (L _ x a b) = foldl f (f e x) (union a b)  foldl' :: Ord a => (b -> a -> b) -> b -> Heap a -> b-foldl' f e E = e+foldl' _ e E = e foldl' f e (L _ x a b) = e `seq` foldl' f (f e x) (union a b)  foldr1 :: Ord a => (a -> a -> a) -> Heap a -> a-foldr1 f E = error "LeftistHeap.foldr1: empty collection"-foldr1 f (L _ x E _) = x+foldr1 _ E = error "LeftistHeap.foldr1: empty collection"+foldr1 _ (L _ x E _) = x foldr1 f (L _ x a b) = f x (foldr1 f (union a b))  foldr1' :: Ord a => (a -> a -> a) -> Heap a -> a-foldr1' f E = error "LeftistHeap.foldr1': empty collection"-foldr1' f (L _ x E _) = x+foldr1' _ E = error "LeftistHeap.foldr1': empty collection"+foldr1' _ (L _ x E _) = x foldr1' f (L _ x a b) = f x $! (foldr1' f (union a b))  foldl1 :: Ord a => (a -> a -> a) -> Heap a -> a-foldl1 f E = error "LeftistHeap.foldl1: empty collection"+foldl1 _ E = error "LeftistHeap.foldl1: empty collection" foldl1 f (L _ x a b) = foldl f x (union a b)  foldl1' :: Ord a => (a -> a -> a) -> Heap a -> a-foldl1' f E = error "LeftistHeap.foldl1: empty collection"+foldl1' _ E = error "LeftistHeap.foldl1: empty collection" foldl1' f (L _ x a b) = foldl' f x (union a b)  {- ???? -} unsafeMapMonotonic :: Ord a => (a -> a) -> Heap a -> Heap a-unsafeMapMonotonic f E = E+unsafeMapMonotonic _ E = E unsafeMapMonotonic f (L i x a b) =   L i (f x) (unsafeMapMonotonic f a) (unsafeMapMonotonic f b) @@ -378,8 +379,8 @@ strict h = h  strictWith :: (a -> b) -> Heap a -> Heap a-strictWith f h@E = h-strictWith f h@(L i x l r) = f x `seq` strictWith f l `seq` strictWith f r `seq` h+strictWith _ h@E = h+strictWith f h@(L _ x l r) = f x `seq` strictWith f l `seq` strictWith f r `seq` h  -- the remaining functions all use default definitions @@ -415,30 +416,30 @@  instance Ord a => C.CollX (Heap a) a where   {singleton = singleton; fromSeq = fromSeq; insert = insert;-   insertSeq = insertSeq; unionSeq = unionSeq; +   insertSeq = insertSeq; unionSeq = unionSeq;    delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;    null = null; size = size; member = member; count = count;    strict = strict;-   structuralInvariant = structuralInvariant; instanceName c = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Ord a => C.OrdCollX (Heap a) a where-  {deleteMin = deleteMin; deleteMax = deleteMax; -   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; -   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; -   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; -   filterGE = filterGE; partitionLT_GE = partitionLT_GE; +  {deleteMin = deleteMin; deleteMax = deleteMax;+   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax;+   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend;+   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT;+   filterGE = filterGE; partitionLT_GE = partitionLT_GE;    partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}  instance Ord a => C.Coll (Heap a) a where-  {toSeq = toSeq; lookup = lookup; lookupM = lookupM; -   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; +  {toSeq = toSeq; lookup = lookup; lookupM = lookupM;+   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; strictWith = strictWith}  instance Ord a => C.OrdColl (Heap a) a where-  {minView = minView; minElem = minElem; maxView = maxView; +  {minView = minView; minElem = minElem; maxView = maxView;    maxElem = maxElem; foldr = foldr; foldr' = foldr';-   foldl = foldl; foldl' = foldl'; foldr1 = foldr1; +   foldl = foldl; foldl' = foldl'; foldr1 = foldr1;    foldr1' = foldr1'; foldl1 = foldl1; foldl1' = foldl1';    toOrdSeq = toOrdSeq; unsafeMapMonotonic = unsafeMapMonotonic} @@ -467,7 +468,7 @@             | a == E || x <= minElem a = t           sift (L r x (L r' y a b) E) =                 L r y (sift (L r' x a b)) E-          sift t@(L r x a b)+          sift t@(L _ x a b)             | x <= minElem a && x <= minElem b = t           sift (L r x (L r' y a b) c)             | y <= minElem c =@@ -477,7 +478,7 @@           sift _ = error "LeftistHeap.arbitrary: bug!"    coarbitrary E = variant 0-  coarbitrary (L _ x a b) = +  coarbitrary (L _ x a b) =       variant 1 . coarbitrary x . coarbitrary a . coarbitrary b  instance (Ord a) => Monoid (Heap a) where
src/Data/Edison/Coll/MinHeap.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Coll.MinHeap---   Copyright   :  Copyright (c) 1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -39,7 +39,6 @@ ) where  import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter)-import Data.Edison.Prelude import qualified Data.Edison.Coll as C import qualified Data.Edison.Seq as S import Data.Edison.Coll.Defaults@@ -50,11 +49,9 @@  data Min h a = E | M a h  deriving (Eq) +moduleName :: String moduleName = "Data.Edison.Coll.MinHeap" -instanceName E = "MinHeap(empty)"-instanceName (M x h) = "MinHeap(" ++ C.instanceName h ++ ")"- structuralInvariant :: (Ord a,C.OrdColl h a) => Min h a -> Bool structuralInvariant E = True structuralInvariant (M x h) = if C.null h then True else x <= C.minElem h@@ -115,7 +112,7 @@ foldr1' :: (C.OrdColl h a,Ord a) => (a -> a -> a) -> Min h a -> a foldl1' :: (C.OrdColl h a,Ord a) => (a -> a -> a) -> Min h a -> a toOrdSeq :: (C.OrdColl h a,Ord a,S.Sequence s) => Min h a -> s a-unsafeMapMonotonic :: (C.OrdColl h a,Ord a) => +unsafeMapMonotonic :: (C.OrdColl h a,Ord a) =>       (a -> a) -> Min h a -> Min h a  fromColl :: C.OrdColl h a => h -> Min h a@@ -124,10 +121,12 @@ toColl :: C.OrdColl h a => Min h a -> h toColl = toPrim +fromPrim :: (C.OrdColl c a) => c -> Min c a fromPrim xs = case C.minView xs of                 Nothing -> E                 Just (x, xs') -> M x xs' +toPrim :: (C.OrdCollX c a) => Min c a -> c toPrim E = C.empty toPrim (M x xs) = C.unsafeInsertMin x xs @@ -142,7 +141,7 @@   | otherwise = M y (C.insert x xs)  insertSeq xs E = fromSeq xs-insertSeq xs (M y ys) = +insertSeq xs (M y ys) =     case C.minView xs_ys of       Nothing -> M y C.empty       Just (x, rest)@@ -158,13 +157,13 @@  unionSeq = unionSeqUsingReduce -delete x E = E+delete _ E = E delete x m@(M y ys)   | x > y     = M y (C.delete x ys)   | x == y    = fromPrim ys   | otherwise = m -deleteAll x E = E+deleteAll _ E = E deleteAll x m@(M y ys)   | x > y     = M y (C.deleteAll x ys)   | x == y    = fromPrim (C.deleteAll x ys)@@ -173,18 +172,18 @@ deleteSeq = deleteSeqUsingDelete  null E = True-null (M x xs) = False+null (M _ _) = False  size E = 0-size (M x xs) = 1 + C.size xs+size (M _ xs) = 1 + C.size xs  -member x E = False+member _ E = False member x (M y ys)   | x > y     = C.member x ys   | otherwise = (x == y) -count x E = 0+count _ E = 0 count x (M y ys)   | x > y     = C.count x ys   | x == y    = 1 + C.count x ys@@ -213,31 +212,31 @@   | x == y = y lookupWithDefault d _ _ = d -fold f e E = e+fold _ e E = e fold f e (M x xs) = f x (C.fold f e xs) -fold' f e E = e+fold' _ e E = e fold' f e (M x xs) = f x $! (C.fold' f e xs) -fold1 f E = error "MinHeap.fold1: empty heap"+fold1 _ E = error "MinHeap.fold1: empty heap" fold1 f (M x xs) = C.fold f x xs -fold1' f E = error "MinHeap.fold1': empty heap"+fold1' _ E = error "MinHeap.fold1': empty heap" fold1' f (M x xs) = C.fold' f x xs -filter p E = E+filter _ E = E filter p (M x xs)   | p x       = M x (C.filter p xs)   | otherwise = fromPrim (C.filter p xs) -partition p E = (E, E)+partition _ E = (E, E) partition p (M x xs)     | p x       = (M x ys, fromPrim zs)     | otherwise = (fromPrim ys, M x zs)   where (ys,zs) = C.partition p xs  deleteMin E = E-deleteMin (M x xs) = fromPrim xs+deleteMin (M _ xs) = fromPrim xs  deleteMax E = E deleteMax (M x xs)@@ -264,33 +263,33 @@ filterLE _ _ = E  filterGT x (M y ys) | y <= x = fromPrim (C.filterGT x ys)-filterGT x h = h+filterGT _ h = h  filterGE x (M y ys) | y < x  = fromPrim (C.filterGE x ys)-filterGE x h = h+filterGE _ h = h  partitionLT_GE x (M y ys)   | y < x = (M y lows, fromPrim highs)   where (lows,highs) = C.partitionLT_GE x ys-partitionLT_GE x h = (E, h)+partitionLT_GE _ h = (E, h) -partitionLE_GT x (M y ys) +partitionLE_GT x (M y ys)   | y <= x = (M y lows, fromPrim highs)   where (lows,highs) = C.partitionLE_GT x ys-partitionLE_GT x h = (E, h)+partitionLE_GT _ h = (E, h)  partitionLT_GT x (M y ys)   | y < x  = let (lows,highs) = C.partitionLT_GT x ys              in (M y lows, fromPrim highs)   | y == x = (E, fromPrim (C.filterGT x ys))-partitionLT_GT x h = (E, h)+partitionLT_GT _ h = (E, h)   minView E = fail "MinHeap.minView: empty heap" minView (M x xs) = return (x, fromPrim xs)  minElem E = error "MinHeap.minElem: empty heap"-minElem (M x xs) = x+minElem (M x _) = x  maxView E = fail "MinHeap.maxView: empty heap" maxView (M x xs) = case C.maxView xs of@@ -302,32 +301,32 @@   | C.null xs   = x   | otherwise = C.maxElem xs -foldr f e E = e+foldr _ e E = e foldr f e (M x xs) = f x (C.foldr f e xs) -foldr' f e E = e+foldr' _ e E = e foldr' f e (M x xs) = f x $! (C.foldr' f e xs) -foldl f e E = e+foldl _ e E = e foldl f e (M x xs) = C.foldl f (f e x) xs -foldl' f e E = e+foldl' _ e E = e foldl' f e (M x xs) = e `seq` C.foldl' f (f e x) xs -foldr1 f E = error "MinHeap.foldr1: empty heap"+foldr1 _ E = error "MinHeap.foldr1: empty heap" foldr1 f (M x xs)   | C.null xs   = x   | otherwise = f x (C.foldr1 f xs) -foldr1' f E = error "MinHeap.foldr1': empty heap"+foldr1' _ E = error "MinHeap.foldr1': empty heap" foldr1' f (M x xs)   | C.null xs = x   | otherwise = f x $! (C.foldr1' f xs) -foldl1 f E = error "MinHeap.foldl1: empty heap"+foldl1 _ E = error "MinHeap.foldl1: empty heap" foldl1 f (M x xs) = C.foldl f x xs -foldl1' f E = error "MinHeap.foldl1': empty heap"+foldl1' _ E = error "MinHeap.foldl1': empty heap" foldl1' f (M x xs) = C.foldl' f x xs  toOrdSeq E = S.empty@@ -336,9 +335,9 @@ unsafeMapMonotonic = unsafeMapMonotonicUsingFoldr  strict h@E = h-strict h@(M x xs) = C.strict xs `seq` h+strict h@(M _ xs) = C.strict xs `seq` h -strictWith f h@E = h+strictWith _ h@E = h strictWith f h@(M x xs) = f x `seq` C.strictWith f xs `seq` h  @@ -346,29 +345,29 @@  instance (C.OrdColl h a, Ord a) => C.CollX (Min h a) a where   {singleton = singleton; fromSeq = fromSeq; insert = insert;-   insertSeq = insertSeq; unionSeq = unionSeq; +   insertSeq = insertSeq; unionSeq = unionSeq;    delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;    null = null; size = size; member = member; count = count;    strict = strict;-   structuralInvariant = structuralInvariant; instanceName c = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance (C.OrdColl h a, Ord a) => C.OrdCollX (Min h a) a where-  {deleteMin = deleteMin; deleteMax = deleteMax; -   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; -   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; -   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; -   filterGE = filterGE; partitionLT_GE = partitionLT_GE; +  {deleteMin = deleteMin; deleteMax = deleteMax;+   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax;+   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend;+   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT;+   filterGE = filterGE; partitionLT_GE = partitionLT_GE;    partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}  instance (C.OrdColl h a, Ord a) => C.Coll (Min h a) a where-  {toSeq = toSeq; lookup = lookup; lookupM = lookupM; -   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; +  {toSeq = toSeq; lookup = lookup; lookupM = lookupM;+   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; strictWith = strictWith}  instance (C.OrdColl h a, Ord a) => C.OrdColl (Min h a) a where-  {minView = minView; minElem = minElem; maxView = maxView; -   maxElem = maxElem; foldr = foldr; foldr' = foldr'; +  {minView = minView; minElem = minElem; maxView = maxView;+   maxElem = maxElem; foldr = foldr; foldr' = foldr';    foldl = foldl; foldl' = foldl'; foldr1 = foldr1;  foldr1' = foldr1';    foldl1 = foldl1; foldl1' = foldl1'; toOrdSeq = toOrdSeq;    unsafeMapMonotonic = unsafeMapMonotonic}@@ -381,8 +380,8 @@      | otherwise = concat ["(",moduleName,".fromColl ",showsPrec 10 (toColl xs) (')':rest)]  instance (C.OrdColl h a, Read h) => Read (Min h a) where-   readsPrec i xs = maybeParens p xs-       where p xs = tokenMatch (moduleName++".fromColl") xs+   readsPrec _ xs = maybeParens p xs+       where p ys = tokenMatch (moduleName++".fromColl") ys                       >>= readsPrec 10                       >>= \(coll,rest) -> return (fromColl coll,rest)
src/Data/Edison/Coll/SkewHeap.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Coll.SkewHeap---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -41,7 +41,6 @@ ) where  import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter)-import Data.Edison.Prelude import qualified Data.Edison.Coll as C import qualified Data.Edison.Seq as S import Data.Edison.Coll.Defaults@@ -49,6 +48,7 @@ import Control.Monad import Test.QuickCheck +moduleName :: String moduleName = "Data.Edison.Coll.SkewHeap"  data Heap a = E | T a (Heap a) (Heap a)@@ -57,8 +57,8 @@ --  * Heap order structuralInvariant :: Ord a => Heap a -> Bool structuralInvariant E = True-structuralInvariant t@(T x l r) = isMin x t-  where isMin x E = True+structuralInvariant t@(T x _ _) = isMin x t+  where isMin _ E = True         isMin x (T y l r) = x <= y && isMin y l && isMin y r  @@ -82,7 +82,7 @@ union :: Ord a => Heap a -> Heap a -> Heap a union E h = h union h@(T x a b) h' = union' h x a b h'-  where union' h x a b E = h+  where union' h _ _ _ E = h         union' hx x a b hy@(T y c d)           | x <= y    = T x (union' hy y c d b) a           | otherwise = T y (union' hx x a b d) c@@ -108,7 +108,7 @@     LT -> h     EQ -> union (deleteAll x a) (deleteAll x b)     GT -> T y (deleteAll x a) (deleteAll x b)-deleteAll x E = E+deleteAll _ E = E  null :: Ord a => Heap a -> Bool null E = True@@ -120,7 +120,7 @@         sz (T _ a b) i = sz a (sz b (i + 1))  member :: Ord a => a -> Heap a -> Bool-member x E = False+member _ E = False member x (T y a b) =   case compare x y of     LT -> False@@ -128,7 +128,7 @@     GT -> member x b || member x a  count :: Ord a => a -> Heap a -> Int-count x E = 0+count _ E = 0 count x (T y a b) =   case compare x y of     LT -> 0@@ -141,7 +141,7 @@         tol (T x a b) rest = S.lcons x (tol b (tol a rest))  lookupM :: (Ord a, Monad m) => a -> Heap a -> m a-lookupM x E = fail "SkewHeap.lookupM: XXX"+lookupM _ E = fail "SkewHeap.lookupM: XXX" lookupM x (T y a b) =   case compare x y of     LT -> fail "SkewHeap.lookupM: XXX"@@ -160,29 +160,29 @@             GT -> look b (look a ys)  fold :: Ord a => (a -> b -> b) -> b -> Heap a -> b-fold f e E = e+fold _ e E = e fold f e (T x a b) = f x (fold f (fold f e a) b)  fold' :: Ord a => (a -> b -> b) -> b -> Heap a -> b-fold' f e E = e+fold' _ e E = e fold' f e (T x a b) = e `seq` f x $! (fold' f (fold' f e a) b)  fold1 :: Ord a => (a -> a -> a) -> Heap a -> a-fold1 f E = error "SkewHeap.fold1: empty collection"+fold1 _ E = error "SkewHeap.fold1: empty collection" fold1 f (T x a b) = fold f (fold f x a) b  fold1' :: Ord a => (a -> a -> a) -> Heap a -> a-fold1' f E = error "SkewHeap.fold1': empty collection"+fold1' _ E = error "SkewHeap.fold1': empty collection" fold1' f (T x a b) = fold' f (fold' f x a) b  filter :: Ord a => (a -> Bool) -> Heap a -> Heap a-filter p E = E+filter _ E = E filter p (T x a b)     | p x = T x (filter p a) (filter p b)     | otherwise = union (filter p a) (filter p b)  partition :: Ord a => (a -> Bool) -> Heap a -> (Heap a, Heap a)-partition p E = (E, E)+partition _ E = (E, E) partition p (T x a b)     | p x = (T x a' b', union a'' b'')     | otherwise = (union a' b', T x a'' b'')@@ -192,12 +192,12 @@  deleteMin :: Ord a => Heap a -> Heap a deleteMin E = E-deleteMin (T x a b) = union a b+deleteMin (T _ a b) = union a b  deleteMax :: Ord a => Heap a -> Heap a deleteMax h = case maxView h of                 Nothing     -> E-                Just (x,h') -> h'+                Just (_,h') -> h'  unsafeInsertMin :: Ord a => a -> Heap a -> Heap a unsafeInsertMin x h = T x h E@@ -208,11 +208,11 @@  filterLT :: Ord a => a -> Heap a -> Heap a filterLT y (T x a b) | x < y = T x (filterLT y a) (filterLT y b)-filterLT y _ = E+filterLT _ _ = E  filterLE :: Ord a => a -> Heap a -> Heap a filterLE y (T x a b) | x <= y = T x (filterLE y a) (filterLE y b)-filterLE y _ = E+filterLE _ _ = E  filterGT :: Ord a => a -> Heap a -> Heap a filterGT y h = C.unionList (collect h [])@@ -255,7 +255,7 @@   where (h', hs) = collect h []          collect E hs = (E, hs)-        collect h@(T x a b) hs = +        collect h@(T x a b) hs =           case compare x y of             GT -> (E, h:hs)             EQ -> let (a', hs') = collect a hs@@ -271,7 +271,7 @@  minElem :: Ord a => Heap a -> a minElem E = error "SkewHeap.minElem: empty collection"-minElem (T x a b) = x+minElem (T x _ _) = x  maxView :: (Ord a, Monad m) => Heap a -> m (a, Heap a) maxView E = fail "SkewHeap.maxView: empty heap"@@ -291,70 +291,70 @@ maxElem :: Ord a => Heap a -> a maxElem E = error "SkewHeap.maxElem: empty collection" maxElem (T x E E) = x-maxElem (T x a E) = maxElem a-maxElem (T x E a) = maxElem a-maxElem (T x a b) = findMax b (findLeaf a)+maxElem (T _ a E) = maxElem a+maxElem (T _ E a) = maxElem a+maxElem (T _ a b) = findMax b (findLeaf a)   where findMax E m = m         findMax (T x E E) m           | m >= x = m           | otherwise = x-        findMax (T x a E) m = findMax a m-        findMax (T x E a) m = findMax a m-        findMax (T x a b) m = findMax a (findMax b m)+        findMax (T _ a E) m = findMax a m+        findMax (T _ E a) m = findMax a m+        findMax (T _ a b) m = findMax a (findMax b m)          findLeaf E = error "SkewHeap.maxElem: bug"         findLeaf (T x E E) = x-        findLeaf (T x a E) = findLeaf a-        findLeaf (T x E a) = findLeaf a-        findLeaf (T x a b) = findMax b (findLeaf a)+        findLeaf (T _ a E) = findLeaf a+        findLeaf (T _ E a) = findLeaf a+        findLeaf (T _ a b) = findMax b (findLeaf a)  foldr :: Ord a => (a -> b -> b) -> b -> Heap a -> b-foldr f e E = e+foldr _ e E = e foldr f e (T x a b) = f x (foldr f e (union a b))  foldr' :: Ord a => (a -> b -> b) -> b -> Heap a -> b-foldr' f e E = e+foldr' _ e E = e foldr' f e (T x a b) = e `seq` f x $! (foldr' f e (union a b))  foldl :: Ord a => (b -> a -> b) -> b -> Heap a -> b-foldl f e E = e+foldl _ e E = e foldl f e (T x a b) = foldl f (f e x) (union a b)  foldl' :: Ord a => (b -> a -> b) -> b -> Heap a -> b-foldl' f e E = e+foldl' _ e E = e foldl' f e (T x a b) = e `seq` foldl' f (f e x) (union a b)  foldr1 :: Ord a => (a -> a -> a) -> Heap a -> a-foldr1 f E = error "SkewHeap.foldr1: empty collection"-foldr1 f (T x E E) = x+foldr1 _ E = error "SkewHeap.foldr1: empty collection"+foldr1 _ (T x E E) = x foldr1 f (T x a b) = f x (foldr1 f (union a b))  foldr1' :: Ord a => (a -> a -> a) -> Heap a -> a-foldr1' f E = error "SkewHeap.foldr1': empty collection"-foldr1' f (T x E E) = x+foldr1' _ E = error "SkewHeap.foldr1': empty collection"+foldr1' _ (T x E E) = x foldr1' f (T x a b) = f x $! (foldr1' f (union a b))  foldl1 :: Ord a => (a -> a -> a) -> Heap a -> a-foldl1 f E = error "SkewHeap.foldl1: empty collection"+foldl1 _ E = error "SkewHeap.foldl1: empty collection" foldl1 f (T x a b) = foldl f x (union a b)  foldl1' :: Ord a => (a -> a -> a) -> Heap a -> a-foldl1' f E = error "SkewHeap.foldl1': empty collection"+foldl1' _ E = error "SkewHeap.foldl1': empty collection" foldl1' f (T x a b) = foldl' f x (union a b)  {- ???? -} unsafeMapMonotonic :: Ord a => (a -> a) -> Heap a -> Heap a-unsafeMapMonotonic f E = E+unsafeMapMonotonic _ E = E unsafeMapMonotonic f (T x a b) =   T (f x) (unsafeMapMonotonic f a) (unsafeMapMonotonic f b)   strict :: Heap a -> Heap a strict h@E = h-strict h@(T x l r) = strict l `seq` strict r `seq` h+strict h@(T _ l r) = strict l `seq` strict r `seq` h  strictWith :: (a -> b) -> Heap a -> Heap a-strictWith f h@E = h+strictWith _ h@E = h strictWith f h@(T x l r) = f x `seq` strictWith f l `seq` strictWith f r `seq` h  -- the remaining functions all use default definitions@@ -390,28 +390,28 @@  instance Ord a => C.CollX (Heap a) a where   {singleton = singleton; fromSeq = fromSeq; insert = insert;-   insertSeq = insertSeq; unionSeq = unionSeq; +   insertSeq = insertSeq; unionSeq = unionSeq;    delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;    null = null; size = size; member = member; count = count;    strict = strict;-   structuralInvariant = structuralInvariant; instanceName c = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Ord a => C.OrdCollX (Heap a) a where-  {deleteMin = deleteMin; deleteMax = deleteMax; -   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; -   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; -   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; -   filterGE = filterGE; partitionLT_GE = partitionLT_GE; +  {deleteMin = deleteMin; deleteMax = deleteMax;+   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax;+   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend;+   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT;+   filterGE = filterGE; partitionLT_GE = partitionLT_GE;    partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}  instance Ord a => C.Coll (Heap a) a where-  {toSeq = toSeq; lookup = lookup; lookupM = lookupM; -   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; +  {toSeq = toSeq; lookup = lookup; lookupM = lookupM;+   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; strictWith = strictWith}  instance Ord a => C.OrdColl (Heap a) a where-  {minView = minView; minElem = minElem; maxView = maxView; +  {minView = minView; minElem = minElem; maxView = maxView;    maxElem = maxElem; foldr = foldr; foldr' = foldr';    foldl = foldl; foldl' = foldl'; foldr1 = foldr1; foldr1' = foldr1';    foldl1  = foldl1; foldl1' = fold1'; toOrdSeq = toOrdSeq;@@ -435,9 +435,9 @@                        (4, liftM3 sift arbitrary (arbTree (n `div` 2))                                                  (arbTree (n `div` 4)))] -          sift x s@(T y a b) E+          sift x (T y a b) E             | y < x = T y (sift x a b) E-          sift x E s@(T y a b)+          sift x E (T y a b)             | y < x = T y E (sift x a b)           sift x s@(T y a b) t@(T z c d)             | y < x && y <= z = T y (sift x a b) t@@ -445,7 +445,7 @@           sift x a b = T x a b    coarbitrary E = variant 0-  coarbitrary (T x a b) = +  coarbitrary (T x a b) =       variant 1 . coarbitrary x . coarbitrary a . coarbitrary b  instance (Ord a) => Monoid (Heap a) where
src/Data/Edison/Coll/SplayHeap.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Coll.SplayHeap---   Copyright   :  Copyright (c) 1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -44,7 +44,6 @@ ) where  import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter)-import Data.Edison.Prelude import qualified Data.Edison.Coll as C import qualified Data.Edison.Seq as S import Data.Edison.Coll.Defaults@@ -52,6 +51,7 @@ import Control.Monad import Test.QuickCheck +moduleName :: String moduleName = "Data.Edison.Coll.SplayHeap"  data Heap a = E | T (Heap a) a (Heap a)@@ -62,7 +62,7 @@ structuralInvariant :: Ord a => Heap a -> Bool structuralInvariant t = bounded Nothing Nothing t    where bounded _ _ E = True-         bounded lo hi (T l x r)  = cmp_l lo x +         bounded lo hi (T l x r)  = cmp_l lo x                                  && cmp_r x hi                                  && bounded lo (Just x) l                                  && bounded (Just x) hi r@@ -155,17 +155,17 @@   where (a,b) = partitionLT_GT x xs  null E = True-null (T a x b) = False+null (T _ _ _) = False  size = sz 0   where sz n E = n-        sz n (T a x b) = sz (sz (1+n) a) b-  -member x E = False+        sz n (T a _ b) = sz (sz (1+n) a) b++member _ E = False member x (T a y b) = if x < y then member x a else x==y || member x b  count = cnt 0-  where cnt n x E = n+  where cnt n _ E = n         cnt n x (T a y b)           | x < y = cnt n x a           | x > y = cnt n x b@@ -175,49 +175,49 @@   where tos E rest = rest         tos (T a x b) rest = S.lcons x (tos a (tos b rest)) -lookup x E = error "SplayHeap.lookup: empty heap"+lookup _ E = error "SplayHeap.lookup: empty heap" lookup x (T a y b)   | x < y     = lookup x a   | x > y     = lookup x b   | otherwise = y -lookupM x E = fail "SplayHeap.lookup: empty heap"+lookupM _ E = fail "SplayHeap.lookup: empty heap" lookupM x (T a y b)   | x < y     = lookupM x a   | x > y     = lookupM x b   | otherwise = return y -lookupWithDefault d x E = d+lookupWithDefault d _ E = d lookupWithDefault d x (T a y b)   | x < y     = lookupWithDefault d x a   | x > y     = lookupWithDefault d x b   | otherwise = y  lookupAll x xs = look xs x S.empty-  where look E x rest = rest+  where look E _ rest = rest         look (T a y b) x rest           | x < y     = look a x rest           | x > y     = look b x rest           | otherwise = look a x (S.lcons y (look b x rest)) -fold f e E = e+fold _ e E = e fold f e (T a x b) = f x (fold f (fold f e b) a) -fold' f e E = e+fold' _ e E = e fold' f e (T a x b) = e `seq` f x $! (fold' f (fold' f e b) a) -fold1 f E = error "SplayHeap.fold1: empty heap"+fold1 _ E = error "SplayHeap.fold1: empty heap" fold1 f (T a x b) = fold f (fold f x b) a -fold1' f E = error "SplayHeap.fold1': empty heap"+fold1' _ E = error "SplayHeap.fold1': empty heap" fold1' f (T a x b) = fold' f (fold' f x b) a -filter p E = E-filter p (T a x b) +filter _ E = E+filter p (T a x b)   | p x       = T (filter p a) x (filter p b)   | otherwise = unsafeAppend (filter p a) (filter p b) -partition p E = (E, E)+partition _ E = (E, E) partition p (T a x b)     | p x       = (T a0 x b0, unsafeAppend a1 b1)     | otherwise = (unsafeAppend a0 b0, T a1 x b1)@@ -226,14 +226,14 @@  deleteMin E = E deleteMin (T a x b) = del a x b-  where del E x b = b-        del (T E x b) y c = T b y c+  where del E _ b = b+        del (T E _ b) y c = T b y c         del (T (T a x b) y c) z d = T (del a x b) y (T c z d)  deleteMax E = E deleteMax (T a x b) = del a x b-  where del a x E = a-        del a x (T b y E) = T a x b+  where del a _ E = a+        del a x (T b _ E) = T a x b         del a x (T b y (T c z d)) = T (T a x b) y (del c z d)  unsafeInsertMin x xs = T E x xs@@ -243,25 +243,25 @@                        Nothing      -> b                        Just (x, a') -> T a' x b -filterLT k E = E-filterLT k t@(T a x b) = +filterLT _ E = E+filterLT k t@(T a x b) =   if x >= k then filterLT k a   else case b of          E -> t          T ba y bb ->-           if y >= k then T a x (filterLT k ba) +           if y >= k then T a x (filterLT k ba)                      else T (T a x ba) y (filterLT k bb) -filterLE k E = E-filterLE k t@(T a x b) = +filterLE _ E = E+filterLE k t@(T a x b) =   if x > k then filterLE k a   else case b of          E -> t          T ba y bb ->-           if y > k then T a x (filterLE k ba) +           if y > k then T a x (filterLE k ba)                     else T (T a x ba) y (filterLE k bb) -filterGT k E = E+filterGT _ E = E filterGT k t@(T a x b) =   if x <= k then filterGT k b   else case a of@@ -270,7 +270,7 @@            if y <= k then T (filterGT k ab) x b                      else T (filterGT k aa) y (T ab x b) -filterGE k E = E+filterGE _ E = E filterGE k t@(T a x b) =   if x < k then filterGE k b   else case a of@@ -279,7 +279,7 @@            if y < k then T (filterGE k ab) x b                     else T (filterGE k aa) y (T ab x b) -partitionLT_GE k E = (E,E)+partitionLT_GE _ E = (E,E) partitionLT_GE k t@(T a x b) =   if x >= k then     case a of@@ -302,7 +302,7 @@           let (small,big) = partitionLT_GE k bb           in (T (T a x ba) y small, big) -partitionLE_GT k E = (E,E)+partitionLE_GT _ E = (E,E) partitionLE_GT k t@(T a x b) =   if x > k then     case a of@@ -327,7 +327,7 @@   -- could specialize calls to filterLT/filterGT-partitionLT_GT k E = (E,E)+partitionLT_GT _ E = (E,E) partitionLT_GT k t@(T a x b) =   if x > k then     case a of@@ -362,9 +362,9 @@           where (w,ab) = minv a x b  minElem E = error "SplayHeap.minElem: empty heap"-minElem (T a x b) = minel a x+minElem (T a x _) = minel a x   where minel E x = x-        minel (T a x b) _ = minel a x+        minel (T a x _) _ = minel a x   maxView E = fail "SplayHeap.maxView: empty heap"@@ -376,54 +376,54 @@           where (cd,w) = maxv c z d  maxElem E = error "SplayHeap.minElem: empty heap"-maxElem (T a x b) = maxel x b+maxElem (T _ x b) = maxel x b   where maxel x E = x-        maxel _ (T a x b) = maxel x b+        maxel _ (T _ x b) = maxel x b -foldr f e E = e+foldr _ e E = e foldr f e (T a x b) = foldr f (f x (foldr f e b)) a -foldr' f e E = e+foldr' _ e E = e foldr' f e (T a x b) = foldr' f (f x $! (foldr' f e b)) a -foldl f e E = e+foldl _ e E = e foldl f e (T a x b) = foldl f (f (foldl f e a) x) b -foldl' f e E = e+foldl' _ e E = e foldl' f e (T a x b) = e `seq` foldl' f ((f $! (foldl' f e a)) x) b -foldr1 f E = error "SplayHeap.foldr1: empty heap"+foldr1 _ E = error "SplayHeap.foldr1: empty heap" foldr1 f (T a x b) = foldr f (myfold f x b) a-  where myfold f x E = x+  where myfold _ x E = x         myfold f x (T a y b) = f x (foldr f (myfold f y b) a) -foldr1' f E = error "SplayHeap.foldr1': empty heap"+foldr1' _ E = error "SplayHeap.foldr1': empty heap" foldr1' f (T a x b) = foldr' f (myfold f x b) a-  where myfold f x E = x+  where myfold _ x E = x         myfold f x (T a y b) = f x $! (foldr' f (myfold f y b) a) -foldl1 f E = error "SplayHeap.foldl1: empty heap"+foldl1 _ E = error "SplayHeap.foldl1: empty heap" foldl1 f (T a x b) = foldl f (myfold f a x) b-  where myfold f E x = x+  where myfold _ E x = x         myfold f (T a x b) y = f (foldl f (myfold f a x) b) y -foldl1' f E = error "SplayHeap.foldl1': empty heap"+foldl1' _ E = error "SplayHeap.foldl1': empty heap" foldl1' f (T a x b) = foldl' f (myfold f a x) b-  where myfold f E x = x+  where myfold _ E x = x         myfold f (T a x b) y = (f $! (foldl f (myfold f a x) b)) y  toOrdSeq xs = tos xs S.empty   where tos E rest = rest         tos (T a x b) rest = tos a (S.lcons x (tos b rest)) -unsafeMapMonotonic f E = E+unsafeMapMonotonic _ E = E unsafeMapMonotonic f (T a x b) =   T (unsafeMapMonotonic f a) (f x) (unsafeMapMonotonic f b)  strict h@E = h-strict h@(T l x r) = strict l `seq` strict r `seq` h+strict h@(T l _ r) = strict l `seq` strict r `seq` h -strictWith f h@E = h+strictWith _ h@E = h strictWith f h@(T l x r) = f x `seq` strictWith f l `seq` strictWith f r `seq` h  -- the remaining functions all use defaults@@ -438,30 +438,30 @@  instance Ord a => C.CollX (Heap a) a where   {singleton = singleton; fromSeq = fromSeq; insert = insert;-   insertSeq = insertSeq; unionSeq = unionSeq; +   insertSeq = insertSeq; unionSeq = unionSeq;    delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;    null = null; size = size; member = member; count = count;    strict = strict;-   structuralInvariant = structuralInvariant; instanceName c = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Ord a => C.OrdCollX (Heap a) a where-  {deleteMin = deleteMin; deleteMax = deleteMax; -   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; -   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; -   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; -   filterGE = filterGE; partitionLT_GE = partitionLT_GE; +  {deleteMin = deleteMin; deleteMax = deleteMax;+   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax;+   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend;+   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT;+   filterGE = filterGE; partitionLT_GE = partitionLT_GE;    partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}  instance Ord a => C.Coll (Heap a) a where-  {toSeq = toSeq; lookup = lookup; lookupM = lookupM; -   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; +  {toSeq = toSeq; lookup = lookup; lookupM = lookupM;+   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    strictWith = strictWith;    filter = filter; partition = partition}  instance Ord a => C.OrdColl (Heap a) a where-  {minView = minView; minElem = minElem; maxView = maxView; -   maxElem = maxElem; foldr = foldr; foldr' = foldr'; foldl = foldl; +  {minView = minView; minElem = minElem; maxView = maxView;+   maxElem = maxElem; foldr = foldr; foldr' = foldr'; foldl = foldl;    foldl' = foldl'; foldr1 = foldr1; foldr1' = foldr1';    foldl1 = foldl1; foldl1' = foldl1'; toOrdSeq = toOrdSeq;    unsafeMapMonotonic = unsafeMapMonotonic}@@ -481,7 +481,7 @@                  return (C.fromList xs)    coarbitrary E = variant 0-  coarbitrary (T a x b) = +  coarbitrary (T a x b) =     variant 1 . coarbitrary a . coarbitrary x . coarbitrary b  instance (Ord a) => Monoid (Heap a) where
src/Data/Edison/Coll/StandardSet.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Coll---   Copyright   :  Copyright (c) 2006 Robert Dockins+--   Copyright   :  Copyright (c) 2006, 2008 Robert Dockins --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -45,7 +45,6 @@ import qualified Prelude import qualified Data.List -import Data.Edison.Prelude import qualified Data.Edison.Coll as C import qualified Data.Edison.Seq as S import qualified Data.Edison.Seq.ListSeq as L@@ -142,7 +141,7 @@ insert             = DS.insert insertSeq          = insertSeqUsingUnion union              = DS.union-unionSeq seq       = DS.unions (S.toList seq)+unionSeq se        = DS.unions $ S.toList se delete             = DS.delete deleteAll          = DS.delete -- by set property deleteSeq          = deleteSeqUsingDelete@@ -179,7 +178,7 @@ partitionLE_GT x   = DS.partition (<=x) partitionLT_GT     = DS.split -minView set        = if DS.null set +minView set        = if DS.null set                         then fail (moduleName ++ ".minView: failed")                         else return (DS.deleteFindMin set) minElem            = DS.findMin@@ -207,7 +206,7 @@ subset             = DS.isSubsetOf  fromSeqWith        = fromSeqWithUsingInsertWith-insertWith f x set = case lookupM x set of +insertWith f x set = case lookupM x set of                         Nothing -> DS.insert x set                         Just x' -> DS.insert (f x x') set insertSeqWith      = insertSeqWithUsingInsertWith@@ -222,28 +221,28 @@  instance Ord a => C.CollX (Set a) a where   {singleton = singleton; fromSeq = fromSeq; insert = insert;-   insertSeq = insertSeq; unionSeq = unionSeq; +   insertSeq = insertSeq; unionSeq = unionSeq;    delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;    null = null; size = size; member = member; count = count;    strict = strict;-   structuralInvariant = structuralInvariant; instanceName c = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Ord a => C.OrdCollX (Set a) a where-  {deleteMin = deleteMin; deleteMax = deleteMax; -   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; -   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; -   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; -   filterGE = filterGE; partitionLT_GE = partitionLT_GE; +  {deleteMin = deleteMin; deleteMax = deleteMax;+   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax;+   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend;+   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT;+   filterGE = filterGE; partitionLT_GE = partitionLT_GE;    partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}  instance Ord a => C.Coll (Set a) a where-  {toSeq = toSeq; lookup = lookup; lookupM = lookupM; -   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; +  {toSeq = toSeq; lookup = lookup; lookupM = lookupM;+   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; strictWith = strictWith}  instance Ord a => C.OrdColl (Set a) a where-  {minView = minView; minElem = minElem; maxView = maxView; +  {minView = minView; minElem = minElem; maxView = maxView;    maxElem = maxElem; foldr = foldr; foldr' = foldr'; foldl = foldl;    foldl' = foldl'; foldr1 = foldr1; foldr1' = foldr1';    foldl1 = foldl1; foldl1' = foldl1'; toOrdSeq = toOrdSeq;@@ -255,7 +254,7 @@    properSubset = properSubset; subset = subset}  instance Ord a => C.Set (Set a) a where-  {fromSeqWith = fromSeqWith; insertWith = insertWith; +  {fromSeqWith = fromSeqWith; insertWith = insertWith;    insertSeqWith = insertSeqWith; unionl = unionl; unionr = unionr;    unionWith = unionWith; unionSeqWith = unionSeqWith;    intersectionWith = intersectionWith}
src/Data/Edison/Coll/UnbalancedSet.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Coll.UnbalancedSet---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -43,10 +43,8 @@  import Prelude hiding (null,foldr,foldl,foldr1,foldl1,lookup,filter) import qualified Prelude-import Data.Edison.Prelude import qualified Data.Edison.Coll as C import qualified Data.Edison.Seq as S-import qualified Data.Edison.Seq.ListSeq as L import Data.Edison.Coll.Defaults import Data.Monoid import Test.QuickCheck@@ -135,7 +133,7 @@ structuralInvariant :: Ord a => Set a -> Bool structuralInvariant t = bounded Nothing Nothing t    where bounded _ _ E = True-         bounded lo hi (T l x r)  = cmp_l lo x +         bounded lo hi (T l x r)  = cmp_l lo x                                  && cmp_r x hi                                  && bounded lo (Just x) l                                  && bounded (Just x) hi r@@ -159,7 +157,7 @@             EQ -> T a (c x y) b             GT -> T a y (ins b) -delete x E = E+delete _ E = E delete x (T a y b) =   case compare x y of     LT -> T (delete x a) y b@@ -171,86 +169,86 @@  size t = sz t 0   where sz E i = i-        sz (T a x b) i = sz a (sz b (i+1))+        sz (T a _ b) i = sz a (sz b (i+1)) -member x E = False+member _ E = False member x (T a y b) =   case compare x y of     LT -> member x a     EQ -> True     GT -> member x b -lookupM x E = fail "UnbalancedSet.lookupM: XXX"+lookupM _ E = fail "UnbalancedSet.lookupM: XXX" lookupM x (T a y b) =   case compare x y of     LT -> lookupM x a     EQ -> return y     GT -> lookupM x b -fold f e E = e+fold _ e E = e fold f e (T a x b) = f x (fold f (fold f e a) b) -fold' f e E = e+fold' _ e E = e fold' f e (T a x b) = e `seq` f x $! (fold' f (fold' f e a) b) -fold1 f E = error "UnbalancedSet.fold1: empty collection"+fold1 _ E = error "UnbalancedSet.fold1: empty collection" fold1 f (T a x b) = fold f (fold f x a) b -fold1' f E = error "UnbalancedSet.fold1': empty collection"+fold1' _ E = error "UnbalancedSet.fold1': empty collection" fold1' f (T a x b) = fold' f (fold' f x a) b  deleteMin E = E-deleteMin (T E x b) = b+deleteMin (T E _ b) = b deleteMin (T a x b) = T (deleteMin a) x b  deleteMax E = E-deleteMax (T a x E) = a+deleteMax (T a _ E) = a deleteMax (T a x b) = T a x (deleteMax b)  unsafeInsertMin x t = T E x t unsafeInsertMax x t = T t x E  unsafeFromOrdSeq xs = fst (ins xs (S.size xs))-  where ins xs 0 = (E,xs)-        ins xs n = let m = n `div` 2-                       (a,xs') = ins xs m-                       Just (x,xs'') = S.lview xs'-                       (b,xs''') = ins xs'' (n - m - 1)-                   in (T a x b,xs''')+  where ins ys 0 = (E,ys)+        ins ys n = let m = n `div` 2+                       (a,ys') = ins ys m+                       Just (y,ys'') = S.lview ys'+                       (b,ys''') = ins ys'' (n - m - 1)+                   in (T a y b,ys''')  unsafeAppend a b = case minView b of                      Nothing -> a                      Just (x,b') -> T a x b' -filterLT y E = E+filterLT _ E = E filterLT y (T a x b) =   case compare x y of     LT -> T a x (filterLT y b)     EQ -> a     GT -> filterLT y a -filterLE y E = E+filterLE _ E = E filterLE y (T a x b) =   case compare x y of     LT -> T a x (filterLE y b)     EQ -> T a x E     GT -> filterLE y a -filterGT y E = E+filterGT _ E = E filterGT y (T a x b) =   case compare x y of     LT -> filterGT y b     EQ -> b     GT -> T (filterGT y a) x b -filterGE y E = E+filterGE _ E = E filterGE y (T a x b) =   case compare x y of     LT -> filterGE y b     EQ -> T E x b     GT -> T (filterGE y a) x b -partitionLT_GE y E = (E,E)+partitionLT_GE _ E = (E,E) partitionLT_GE y (T a x b) =   case compare x y of     LT -> (T a x b0,b1)@@ -259,7 +257,7 @@     GT -> (a0,T a1 x b)           where (a0,a1) = partitionLT_GE y a -partitionLE_GT y E = (E,E)+partitionLE_GT _ E = (E,E) partitionLE_GT y (T a x b) =   case compare x y of     LT -> (T a x b0,b1)@@ -268,7 +266,7 @@     GT -> (a0,T a1 x b)           where (a0,a1) = partitionLE_GT y a -partitionLT_GT y E = (E,E)+partitionLT_GT _ E = (E,E) partitionLT_GT y (T a x b) =   case compare x y of     LT -> (T a x b0,b1)@@ -283,8 +281,8 @@   where Just (y,a') = minView a  minElem E = error "UnbalancedSet.minElem: empty collection"-minElem (T E x b) = x-minElem (T a x b) = minElem a+minElem (T E x _) = x+minElem (T a _ _) = minElem a  maxView E = fail "UnbalancedSet.maxView: empty collection" maxView (T a x E) = return (x, a)@@ -292,45 +290,45 @@   where Just (y, b') = maxView b  maxElem E = error "UnbalancedSet.maxElem: empty collection"-maxElem (T a x E) = x-maxElem (T a x b) = maxElem b+maxElem (T _ x E) = x+maxElem (T _ _ b) = maxElem b -foldr f e E = e+foldr _ e E = e foldr f e (T a x b) = foldr f (f x (foldr f e b)) a -foldr' f e E = e+foldr' _ e E = e foldr' f e (T a x b) = e `seq` foldr' f (f x $! (foldr' f e b)) a -foldl f e E = e+foldl _ e E = e foldl f e (T a x b) = foldl f (f (foldl f e a) x) b -foldl' f e E = e+foldl' _ e E = e foldl' f e (T a x b) = e `seq` foldl' f ((f $! (foldl' f e a)) x) b -foldr1 f E = error "UnbalancedSet.foldr1: empty collection"+foldr1 _ E = error "UnbalancedSet.foldr1: empty collection" foldr1 f (T a x E) = foldr f x a foldr1 f (T a x b) = foldr f (f x (foldr1 f b)) a -foldr1' f E = error "UnbalancedSet.foldr1': empty collection"+foldr1' _ E = error "UnbalancedSet.foldr1': empty collection" foldr1' f (T a x E) = foldr' f x a foldr1' f (T a x b) = foldr' f (f x $! (foldr1' f b)) a -foldl1 f E = error "UnbalancedSet.foldl1: empty collection"+foldl1 _ E = error "UnbalancedSet.foldl1: empty collection" foldl1 f (T E x b) = foldl f x b foldl1 f (T a x b) = foldl f (f (foldl1 f a) x) b -foldl1' f E = error "UnbalancedSet.foldl1': empty collection"+foldl1' _ E = error "UnbalancedSet.foldl1': empty collection" foldl1' f (T E x b) = foldl' f x b foldl1' f (T a x b) = foldl' f ((f $! (foldl1' f a)) x) b -unsafeMapMonotonic f E = E-unsafeMapMonotonic f (T a x b) = +unsafeMapMonotonic _ E = E+unsafeMapMonotonic f (T a x b) =     T (unsafeMapMonotonic f a) (f x) (unsafeMapMonotonic f b)  strict s@E = s-strict s@(T l x r) = strict l `seq` strict r `seq` s+strict s@(T l _ r) = strict l `seq` strict r `seq` s -strictWith f s@E = s+strictWith _ s@E = s strictWith f s@(T l x r) = f x `seq` strictWith f l `seq` strictWith f r `seq` s  -- the remaining functions all use default definitions@@ -369,29 +367,29 @@  instance Ord a => C.CollX (Set a) a where   {singleton = singleton; fromSeq = fromSeq; insert = insert;-   insertSeq = insertSeq; unionSeq = unionSeq; +   insertSeq = insertSeq; unionSeq = unionSeq;    delete = delete; deleteAll = deleteAll; deleteSeq = deleteSeq;    null = null; size = size; member = member; count = count;    strict = strict;-   structuralInvariant = structuralInvariant; instanceName c = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Ord a => C.OrdCollX (Set a) a where-  {deleteMin = deleteMin; deleteMax = deleteMax; -   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax; -   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend; -   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT; -   filterGE = filterGE; partitionLT_GE = partitionLT_GE; +  {deleteMin = deleteMin; deleteMax = deleteMax;+   unsafeInsertMin = unsafeInsertMin; unsafeInsertMax = unsafeInsertMax;+   unsafeFromOrdSeq = unsafeFromOrdSeq; unsafeAppend = unsafeAppend;+   filterLT = filterLT; filterLE = filterLE; filterGT = filterGT;+   filterGE = filterGE; partitionLT_GE = partitionLT_GE;    partitionLE_GT = partitionLE_GT; partitionLT_GT = partitionLT_GT}  instance Ord a => C.Coll (Set a) a where-  {toSeq = toSeq; lookup = lookup; lookupM = lookupM; -   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault; +  {toSeq = toSeq; lookup = lookup; lookupM = lookupM;+   lookupAll = lookupAll; lookupWithDefault = lookupWithDefault;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    filter = filter; partition = partition; strictWith = strictWith}  instance Ord a => C.OrdColl (Set a) a where-  {minView = minView; minElem = minElem; maxView = maxView; -   maxElem = maxElem; foldr = foldr; foldr' = foldr'; +  {minView = minView; minElem = minElem; maxView = maxView;+   maxElem = maxElem; foldr = foldr; foldr' = foldr';    foldl = foldl; foldl' = foldl'; foldr1 = foldr1; foldr1' = foldr1';    foldl1 = foldl1; foldl1' = foldl1'; toOrdSeq = toOrdSeq;    unsafeMapMonotonic = unsafeMapMonotonic}@@ -402,7 +400,7 @@    properSubset = properSubset; subset = subset}  instance Ord a => C.Set (Set a) a where-  {fromSeqWith = fromSeqWith; insertWith = insertWith; +  {fromSeqWith = fromSeqWith; insertWith = insertWith;    insertSeqWith = insertSeqWith; unionl = unionl; unionr = unionr;    unionWith = unionWith; unionSeqWith = unionSeqWith;    intersectionWith = intersectionWith}@@ -427,7 +425,7 @@                  return (Prelude.foldr insert empty xs)    coarbitrary E = variant 0-  coarbitrary (T a x b) = +  coarbitrary (T a x b) =     variant 1 . coarbitrary a . coarbitrary x . coarbitrary b  instance (Ord a) => Monoid (Set a) where
src/Data/Edison/Concrete/FingerTree.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Edison.Concrete.FingerTree@@ -27,7 +28,7 @@  {------------------------------------------------------------------ -Copyright 2004, The University Court of the University of Glasgow. +Copyright 2004, 2008, The University Court of the University of Glasgow. All rights reserved.  Redistribution and use in source and binary forms, with or without@@ -35,14 +36,14 @@  - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.- + - 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.- + - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without-specific prior written permission. +specific prior written permission.  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,@@ -91,13 +92,13 @@         deriving Show  foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b-foldDigit mapp f (One a) = f a+foldDigit _ f (One a) = f a foldDigit mapp f (Two a b) = f a `mapp` f b foldDigit mapp f (Three a b c) = f a `mapp` f b `mapp` f c foldDigit mapp f (Four a b c d) = f a `mapp` f b `mapp` f c `mapp` f d  reduceDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b-reduceDigit mapp f (One a) = f a+reduceDigit _ f (One a) = f a reduceDigit mapp f (Two a b) = f a `mapp` f b reduceDigit mapp f (Three a b c) = f a `mapp` f b `mapp` f c reduceDigit mapp f (Four a b c d) = (f a `mapp` f b) `mapp` (f c `mapp` f d)@@ -172,7 +173,7 @@         measure (Deep v _ _ _)  =  v  sizeFT :: (a -> Int) -> FingerTree v a -> Int-sizeFT f Empty            = 0+sizeFT _ Empty            = 0 sizeFT f (Single x)       = f x sizeFT f (Deep _ d1 m d2) = sizeDigit f d1 + sizeFT (sizeNode f) m + sizeDigit f d2 @@ -180,8 +181,8 @@ size = sizeFT (const 1)  foldFT :: b -> (b -> b -> b) -> (a -> b) -> FingerTree v a -> b-foldFT mz mapp _ Empty      = mz-foldFT mz mapp f (Single x) = f x+foldFT mz _ _ Empty      = mz+foldFT _ _ f (Single x) = f x foldFT mz mapp f (Deep _ pr m sf) =              foldDigit  mapp f pr `mapp` foldFT mz mapp (foldNode mapp f) m `mapp` foldDigit mapp f sf @@ -194,7 +195,7 @@ toList ft = ftToList ft []  reduce1_aux :: (b -> b -> b) -> (a -> b) -> Digit a -> FingerTree v (Node v a) -> Digit a -> b-reduce1_aux mapp f pr Empty sf = +reduce1_aux mapp f pr Empty sf =      (reduceDigit mapp f pr) `mapp`      (reduceDigit mapp f sf) @@ -204,20 +205,20 @@      (reduceDigit mapp f sf)  reduce1_aux mapp f pr (Deep _ pr' m sf') sf =-     (reduceDigit mapp f pr) `mapp` +     (reduceDigit mapp f pr) `mapp`      (reduce1_aux mapp         (foldNode mapp f)             pr' m sf')       `mapp`      (reduceDigit mapp f sf)  reduce1 :: (a -> a -> a) -> FingerTree v a -> a-reduce1 mapp Empty             = error "FingerTree.reduce1: empty tree"-reduce1 mapp (Single x)        = x+reduce1 _ Empty             = error "FingerTree.reduce1: empty tree"+reduce1 _ (Single x)        = x reduce1 mapp (Deep _ pr m sf)  = reduce1_aux mapp id pr m sf -reduce1' :: (a -> a -> a) -> FingerTree v a -> a -reduce1' mapp Empty            = error "FingerTree.reduce1': empty tree"-reduce1' mapp (Single x)       = x+reduce1' :: (a -> a -> a) -> FingerTree v a -> a+reduce1' _ Empty            = error "FingerTree.reduce1': empty tree"+reduce1' _ (Single x)       = x reduce1' mapp (Deep _ pr m sf) = reduce1_aux mapp' id pr m sf   where mapp' x y = x `seq` y `seq` mapp x y @@ -685,7 +686,7 @@  splitDigit :: (Measured v a) => (v -> Bool) -> v -> Digit a ->                 Split (Maybe (Digit a)) a-splitDigit p i (One a) = i `seq` Split Nothing a Nothing+splitDigit _ i (One a) = i `seq` Split Nothing a Nothing splitDigit p i (Two a b)   | p va        = Split Nothing a (Just (One b))   | otherwise   = Split (Just (One a)) b Nothing@@ -729,7 +730,7 @@   instance (Arbitrary a) => Arbitrary (Digit a) where-  arbitrary = oneof +  arbitrary = oneof               [ arbitrary       >>= \x         -> return (One x)               , two arbitrary   >>= \(x,y)     -> return (Two x y)               , three arbitrary >>= \(x,y,z)   -> return (Three x y z)@@ -760,7 +761,7 @@   arbitrary = oneof                [ return Empty                , arbitrary >>= return . Single-               , do +               , do                    pf <- arbitrary                    m  <- arbitrary                    sf <- arbitrary
src/Data/Edison/Seq/BankersQueue.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.BankersQueue---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -49,12 +49,10 @@                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null) -import Data.Edison.Prelude-import qualified Data.Edison.Seq as S ( Sequence(..) ) +import qualified Data.Edison.Seq as S ( Sequence(..) ) import Data.Edison.Seq.Defaults import qualified Data.Edison.Seq.ListSeq as L import Data.Monoid-import Control.Monad import Control.Monad.Identity import Test.QuickCheck @@ -164,16 +162,16 @@ lview (Q i (x:xs) ys j) = return (x, makeQ (i-1) xs ys j)  lhead (Q _ [] _ _) = error "BankersQueue.lhead: empty sequence"-lhead (Q _ (x:xs) _ _) = x+lhead (Q _ (x:_) _ _) = x  lheadM (Q _ [] _ _) = fail "BankersQueue.lheadM: empty sequence"-lheadM (Q _ (x:xs) _ _) = return x+lheadM (Q _ (x:_) _ _) = return x -ltail (Q i (x:xs) ys j) = makeQ (i-1) xs ys j-ltail q = error "BankersQueue.ltail: empty sequence"+ltail (Q i (_:xs) ys j) = makeQ (i-1) xs ys j+ltail _ = error "BankersQueue.ltail: empty sequence" -ltailM (Q i (x:xs) ys j) = return (makeQ (i-1) xs ys j)-ltailM q = fail "BankersQueue.ltail: empty sequence"+ltailM (Q i (_:xs) ys j) = return (makeQ (i-1) xs ys j)+ltailM _ = fail "BankersQueue.ltail: empty sequence"  rview (Q i xs (y:ys) j) = return (y, Q i xs ys (j-1)) rview (Q i xs [] _) =@@ -181,24 +179,24 @@     Nothing      -> fail "BankersQueue.rview: empty sequence"     Just (x,xs') -> return (x, Q (i-1) xs' [] 0) -rhead (Q i xs (y:ys) j) = y+rhead (Q _ _ (y:_) _) = y rhead (Q _ [] [] _) = error "BankersQueue.rhead: empty sequence"-rhead (Q i xs [] _) = L.rhead xs+rhead (Q _ xs [] _) = L.rhead xs -rheadM (Q i xs (y:ys) j) = return y+rheadM (Q _ _ (y:_) _) = return y rheadM (Q _ [] [] _) = fail "BankersQueue.rheadM: empty sequence"-rheadM (Q i xs [] _) = return (L.rhead xs)+rheadM (Q _ xs [] _) = return (L.rhead xs) -rtail (Q i xs (y:ys) j) = Q i xs ys (j-1)-rtail q@(Q _ [] [] _) = error "BankersQueue.rtail: empty sequence"+rtail (Q i xs (_:ys) j) = Q i xs ys (j-1)+rtail (Q _ [] [] _) = error "BankersQueue.rtail: empty sequence" rtail (Q i xs [] _) = Q (i-1) (L.rtail xs) [] 0 -rtailM (Q i xs (y:ys) j) = return (Q i xs ys (j-1))-rtailM q@(Q _ [] [] _) = fail "BankersQueue.rtailM: empty sequence"+rtailM (Q i xs (_:ys) j) = return (Q i xs ys (j-1))+rtailM (Q _ [] [] _) = fail "BankersQueue.rtailM: empty sequence" rtailM (Q i xs [] _) = return (Q (i-1) (L.rtail xs) [] 0)  null (Q i _ _ _) = (i == 0)-size (Q i xs ys j) = i + j+size (Q i _ _ j) = i + j reverse (Q i xs ys j) = makeQ j ys xs i  reverseOnto (Q i1 xs1 ys1 j1) (Q i2 xs2 ys2 j2) =@@ -206,53 +204,57 @@  fromList xs = Q (length xs) xs [] 0 -toList (Q i xs ys j)+toList (Q _ xs ys j)   | j == 0 = xs   | otherwise = xs ++ L.reverse ys  map f (Q i xs ys j) = Q i (L.map f xs) (L.map f ys) j  -- local fn on lists-revfoldr f e [] = e+revfoldr :: (t -> t1 -> t1) -> t1 -> [t] -> t1+revfoldr _ e [] = e revfoldr f e (x:xs) = revfoldr f (f x e) xs -revfoldr' f e [] = e+revfoldr' :: (t -> a -> a) -> a -> [t] -> a+revfoldr' _ e [] = e revfoldr' f e (x:xs) = e `seq` revfoldr' f (f x e) xs  -- local fn on lists-revfoldl f e [] = e+revfoldl :: (t -> t1 -> t) -> t -> [t1] -> t+revfoldl _ e [] = e revfoldl f e (x:xs) = f (revfoldl f e xs) x -revfoldl' f e [] = e+revfoldl' :: (b -> t -> b) -> b -> [t] -> b+revfoldl' _ e [] = e revfoldl' f e (x:xs) = (\z -> f z x) $! (revfoldl f e xs) -fold  f e (Q i xs ys j) = L.foldr f (L.foldr f e ys) xs-fold' f e (Q i xs ys j) = (L.foldl' (flip f) $! (L.foldl' (flip f) e ys)) xs+fold  f e (Q _ xs ys _) = L.foldr f (L.foldr f e ys) xs+fold' f e (Q _ xs ys _) = (L.foldl' (flip f) $! (L.foldl' (flip f) e ys)) xs fold1  = fold1UsingFold fold1' = fold1'UsingFold' -foldr  f e (Q i xs ys j) = L.foldr  f (revfoldr  f e ys) xs-foldr' f e (Q i xs ys j) = L.foldr' f (revfoldr' f e ys) xs-foldl  f e (Q i xs ys j) = revfoldl  f (L.foldl  f e xs) ys-foldl' f e (Q i xs ys j) = revfoldl' f (L.foldl' f e xs) ys+foldr  f e (Q _ xs ys _) = L.foldr  f (revfoldr  f e ys) xs+foldr' f e (Q _ xs ys _) = L.foldr' f (revfoldr' f e ys) xs+foldl  f e (Q _ xs ys _) = revfoldl  f (L.foldl  f e xs) ys+foldl' f e (Q _ xs ys _) = revfoldl' f (L.foldl' f e xs) ys -foldr1 f (Q i xs (y:ys) j) = L.foldr f (revfoldr f y ys) xs+foldr1 f (Q _ xs (y:ys) _) = L.foldr f (revfoldr f y ys) xs foldr1 f (Q i xs [] _)   | i == 0 = error "BankersQueue.foldr1: empty sequence"   | otherwise = L.foldr1 f xs -foldr1' f (Q i xs (y:ys) j) = L.foldr' f (revfoldr' f y ys) xs+foldr1' f (Q _ xs (y:ys) _) = L.foldr' f (revfoldr' f y ys) xs foldr1' f (Q i xs [] _)   | i == 0 = error "BankersQueue.foldr1': empty sequence"   | otherwise = L.foldr1' f xs -foldl1 f (Q i (x:xs) ys j) = revfoldl f (L.foldl f x xs) ys-foldl1 f _ = error "BankersQueue.foldl1: empty sequence"+foldl1 f (Q _ (x:xs) ys _) = revfoldl f (L.foldl f x xs) ys+foldl1 _ _ = error "BankersQueue.foldl1: empty sequence" -foldl1' f (Q i (x:xs) ys j) = revfoldl' f (L.foldl' f x xs) ys-foldl1' f _ = error "BankersQueue.foldl1': empty sequence"+foldl1' f (Q _ (x:xs) ys _) = revfoldl' f (L.foldl' f x xs) ys+foldl1' _ _ = error "BankersQueue.foldl1': empty sequence" -copy n x +copy n x   | n < 0     = empty   | otherwise = Q n (L.copy n x) [] 0 @@ -282,7 +284,7 @@                 in if k' < 0 then q                    else Q i xs (L.adjust f k' ys) j -{- +{- could do   mapWithIndex   :: (Int -> a -> b) -> s a -> s b   foldrWithIndex :: (Int -> a -> b -> b) -> b -> s a -> b@@ -305,7 +307,7 @@   else let len' = len - i in     if len' >= j then empty     else Q (j - len') (L.reverse (L.take (j - len') ys)) [] 0-  -- could write more efficient version of reverse (take ...) +  -- could write more efficient version of reverse (take ...)  splitAt idx q@(Q i xs ys j) =   if idx <= i then@@ -317,11 +319,11 @@     else let (ys', ys'') = L.splitAt (j - idx') ys          in (Q i xs ys'' idx', Q (j - idx') (L.reverse ys') [] 0)       -- could do splitAt followed by reverse more efficiently...-   -strict l@(Q i xs ys j) = L.strict xs `seq` L.strict ys `seq` l-strictWith f l@(Q i xs ys j) = L.strictWith f xs `seq` L.strictWith f ys `seq` l +strict l@(Q _ xs ys _) = L.strict xs `seq` L.strict ys `seq` l+strictWith f l@(Q _ xs ys _) = L.strictWith f xs `seq` L.strictWith f ys `seq` l+ -- the remaining functions all use defaults  concat = concatUsingFoldr@@ -360,10 +362,10 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';-   foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl'; +   foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';    foldr1 = foldr1; foldr1' = foldr1'; foldl1 = foldl1; foldl1' = foldl1';    reducer = reducer; reducer' = reducer';    reducel = reducel; reducel' = reducel'; reduce1 = reduce1; reduce1' = reduce1';@@ -378,7 +380,7 @@    zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip;    unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName s = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Functor Seq where   fmap = map@@ -412,7 +414,7 @@                    j = L.size ys                in if i >= j then Q i xs ys j else Q j ys xs i) -  coarbitrary (Q i xs ys j) = coarbitrary xs . coarbitrary ys+  coarbitrary (Q _ xs ys _) = coarbitrary xs . coarbitrary ys  instance Monoid (Seq a) where   mempty  = empty
src/Data/Edison/Seq/BinaryRandList.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.BinaryRandList---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -57,8 +57,7 @@ import Control.Monad.Identity import Data.Maybe -import Data.Edison.Prelude-import qualified Data.Edison.Seq as S ( Sequence(..) ) +import qualified Data.Edison.Seq as S ( Sequence(..) ) import Data.Edison.Seq.Defaults import Data.Monoid import Control.Monad@@ -149,8 +148,10 @@ -- not exported, rewrite as bit ops? --even n = (n `mod` 2) == 0 --odd n  = (n `mod` 2) <> 0+half :: (Integral a) => a -> a half n = n `div` 2 +mkEven :: Seq (a, a) -> Seq a mkEven E = E mkEven ps = Even ps @@ -169,7 +170,7 @@     Odd x pxs -> Odd x (append pxs pys) append xs ys@(Odd _ _) = foldr lcons ys xs -copy n x +copy n x     | n <= 0 = E     | otherwise = cp n x   where cp :: Int -> a -> Seq a@@ -186,33 +187,33 @@  lhead E = error "BinaryRandList.lhead: empty sequence" lhead (Even ps) = fst (lhead ps)-lhead (Odd x ps) = x+lhead (Odd x _) = x  lheadM E = fail "BinaryRandList.lheadM: empty sequence" lheadM (Even ps) = return (fst (lhead ps))-lheadM (Odd x ps) = return (x)+lheadM (Odd x _) = return (x)  ltail E = error "BinaryRandList.ltail: empty sequence" ltail (Even ps) = case lview ps of-                    Just ((x,y), ps') -> Odd y ps'+                    Just ((_,y), ps') -> Odd y ps'                     Nothing -> error "BinaryRandList.ltail: bug!"-ltail (Odd x ps) = mkEven ps+ltail (Odd _ ps) = mkEven ps  ltailM E = fail "BinaryRandList.ltailM: empty sequence" ltailM (Even ps) = case lview ps of-                      Just ((x,y), ps') -> return (Odd y ps')+                      Just ((_,y), ps') -> return (Odd y ps')                       Nothing -> error "BinaryRandList.ltailM: bug!"-ltailM (Odd x ps) = return (mkEven ps)+ltailM (Odd _ ps) = return (mkEven ps)  rhead E = error "BinaryRandList.rhead: empty sequence" rhead (Even ps) = snd (rhead ps) rhead (Odd x E) = x-rhead (Odd x ps) = snd (rhead ps)+rhead (Odd _ ps) = snd (rhead ps)  rheadM E = fail "BinaryRandList.rheadM: empty sequence" rheadM (Even ps) = return (snd (rhead ps)) rheadM (Odd x E) = return x-rheadM (Odd x ps) = return (snd (rhead ps))+rheadM (Odd _ ps) = return (snd (rhead ps))   null E = True@@ -220,49 +221,49 @@  size E = 0 size (Even ps) = 2 * size ps-size (Odd x ps) = 1 + 2 * size ps+size (Odd _ ps) = 1 + 2 * size ps -map f E = E+map _ E = E map f (Even ps)  = Even (map (\(x,y) -> (f x,f y)) ps)-map f (Odd x ps) = Odd (f x) (map (\(x,y) -> (f x,f y)) ps)+map f (Odd x ps) = Odd (f x) (map (\(y,z) -> (f y,f z)) ps)  fold   = foldr fold'  = foldr' fold1  = fold1UsingFold fold1' = fold1'UsingFold' -foldr f e E = e+foldr _ e E = e foldr f e (Even ps)  = foldr (\(x,y) e -> f x (f y e)) e ps foldr f e (Odd x ps) = f x (foldr (\(x,y) e -> f x (f y e)) e ps) -foldr' f e E = e+foldr' _ e E = e foldr' f e (Even ps)  = foldr' (\(x,y) e -> f x $! f y $! e) e ps foldr' f e (Odd x ps) = f x $! (foldr' (\(x,y) e -> f x $! f y $! e) e ps) -foldl f e E = e+foldl _ e E = e foldl f e (Even ps)  = foldl (\e (x,y) -> f (f e x) y) e ps foldl f e (Odd x ps) = foldl (\e (x,y) -> f (f e x) y) (f e x) ps -foldl' f e E = e+foldl' _ e E = e foldl' f e (Even ps)  = foldl' (\e (x,y) -> f (f e x) y) e ps foldl' f e (Odd x ps) = e `seq` foldl' (\e (x,y) -> e `seq` (\z -> f z y) $! (f e x)) (f e x) ps -reduce1 f E = error "BinaryRandList.reduce1: empty seq"+reduce1 _ E = error "BinaryRandList.reduce1: empty seq" reduce1 f (Even ps)  = reduce1 f (map (uncurry f) ps)-reduce1 f (Odd x E)  = x+reduce1 _ (Odd x E)  = x reduce1 f (Odd x ps) = f x (reduce1 f (map (uncurry f) ps)) -reduce1' f E = error "BinaryRandList.reduce1': empty seq"+reduce1' _ E = error "BinaryRandList.reduce1': empty seq" reduce1' f (Even ps)  = reduce1' f (map (uncurry f) ps)-reduce1' f (Odd x E)  = x+reduce1' _ (Odd x E)  = x reduce1' f (Odd x ps) = (f $! x) $! (reduce1' f (map (uncurry f) ps))   inBounds i xs = (i >= 0) && inb xs i   where inb :: Seq a -> Int -> Bool-        inb E i = False+        inb E _ = False         inb (Even ps) i = inb ps (half i)-        inb (Odd x ps) i = (i == 0) || inb ps (half (i-1))+        inb (Odd _ ps) i = (i == 0) || inb ps (half (i-1))  lookup i xs = runIdentity (lookupM i xs) @@ -270,7 +271,7 @@     | i < 0     = fail "BinaryRandList.lookup: bad subscript"     | otherwise = lookFun nothing xs i return     where-    	nothing = fail "BinaryRandList.lookup: not found"+        nothing = fail "BinaryRandList.lookup: not found"  lookupWithDefault d i xs     | i < 0 = d@@ -278,7 +279,7 @@  -- not exported lookFun :: b -> Seq a -> Int -> (a -> b) -> b-lookFun d E i f = d+lookFun d E _ _ = d lookFun d (Even ps) i f   | even i = lookFun d ps (half i) (f . fst)   | otherwise = lookFun d ps (half i) (f . snd)@@ -291,7 +292,7 @@     | i < 0 = xs     | otherwise = adj f i xs   where adj :: (a -> a) -> Int -> Seq a -> Seq a-        adj f i E = E+        adj _ _ E = E         adj f i (Even ps)           | even i = Even (adj (mapFst f) (half i) ps)           | otherwise = Even (adj (mapSnd f) (half i) ps)@@ -301,13 +302,15 @@           | otherwise = Odd x (adj (mapSnd f) (half (i-1)) ps)  -- not exported+mapFst :: (t -> t2) -> (t, t1) -> (t2, t1) mapFst f (x,y) = (f x,y)+mapSnd :: (t1 -> t2) -> (t, t1) -> (t, t2) mapSnd f (x,y) = (x,f y)  take n xs = if n <= 0 then E else tak n xs   where tak :: Int -> Seq a -> Seq a-        tak 0 xs = E-        tak i E = E+        tak 0 _ = E+        tak _ E = E         tak i (Even ps)           | even i = Even (tak (half i) ps)         tak i (Odd x ps)@@ -318,7 +321,7 @@ drop n xs = if n <= 0 then xs else drp n xs   where drp :: Int -> Seq a -> Seq a         drp 0 xs = xs-        drp i E = E+        drp _ E = E         drp i (Even ps)           | even i = mkEven (drp (half i) ps)           | otherwise = fromMaybe empty (ltailM (mkEven (drp (half i) ps)))@@ -329,11 +332,11 @@  strict l@E = l strict l@(Even l') = strict l' `seq` l-strict l@(Odd x l') = strict l' `seq` l+strict l@(Odd _ l') = strict l' `seq` l -strictWith f l@E = l+strictWith _ l@E = l strictWith f l@(Even l')  = strictWith (\ (x,y) -> f x `seq` f y) l' `seq` l-strictWith f l@(Odd x l') = f x `seq` strictWith (\ (x,y) -> f x `seq` f y) `seq` l+strictWith f l@(Odd x _') = f x `seq` strictWith (\ (x,y) -> f x `seq` f y) `seq` l   -- structural invariants are enforced by the type system@@ -392,7 +395,7 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';@@ -410,7 +413,7 @@    zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip;    unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName s = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Functor Seq where   fmap = map@@ -435,7 +438,7 @@   readsPrec = readsPrecUsingFromList  instance Arbitrary a => Arbitrary (Seq a) where-  arbitrary = do xs <- arbitrary +  arbitrary = do xs <- arbitrary                  return (fromList xs)    coarbitrary E = variant 0
src/Data/Edison/Seq/BraunSeq.hs view
@@ -1,13 +1,13 @@ -- | --   Module      :  Data.Edison.Seq.BraunSeq---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm --   Stability   :  stable --   Portability :  GHC, Hugs (MPTC and FD) -----   One-sided Braun sequences.  All running times are as listed in +--   One-sided Braun sequences.  All running times are as listed in --   "Data.Edison.Seq" except the following: -- --   * lview, lcons, ltail*   @O( log n )@@@ -41,7 +41,7 @@ --   * Rob Hoogerwoord. \"A Logarithmic Implementation of Flexible Arrays\". --     /Mathematics of Program Construction/ (MPC'92), pages 191-207. -----   * Chris Okasaki. \"Three algorithms on Braun Trees\".  +--   * Chris Okasaki. \"Three algorithms on Braun Trees\". --     /Journal of Function Programming/ 7(6):661-666. Novemebr 1997.  module Data.Edison.Seq.BraunSeq (@@ -71,13 +71,11 @@                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null) -import Control.Monad import Control.Monad.Identity import Data.Maybe import Data.Monoid import Test.QuickCheck -import Data.Edison.Prelude import qualified Data.Edison.Seq as S ( Sequence(..) ) import Data.Edison.Seq.Defaults import qualified Data.Edison.Seq.ListSeq as L@@ -183,8 +181,8 @@  append xs E = xs append xs ys = app (size xs) xs ys-  where app 0 xs ys = ys-        app n xs E = xs+  where app 0 _ ys = ys+        app _ xs E = xs         app n (B x a b) (B y c d)             | odd n     = B x (app m a (lcons y d)) (app m b c)             | otherwise = B x (app m a c) (app (m-1) b (lcons y d))@@ -196,23 +194,25 @@ lview (B x a b) = return (x, combine a b)  -- not exported+combine :: Seq a -> Seq a -> Seq a combine E _ = E combine (B x a b) c = B x c (combine a b)  lhead E = error "BraunSeq.lhead: empty sequence"-lhead (B x a b) = x+lhead (B x _ _) = x  lheadM E = fail "BraunSeq.lheadM: empty sequence"-lheadM (B x a b) = return x+lheadM (B x _ _) = return x  ltail E = error "BraunSeq.ltail: empty sequence"-ltail (B x a b) = combine a b+ltail (B _ a b) = combine a b  ltailM E = fail "BraunSeq.ltailM: empty sequence"-ltailM (B x a b) = return (combine a b)+ltailM (B _ a b) = return (combine a b)  -- not exported -- precondition: i >= 0+delAt :: Int -> Seq a -> Seq a delAt 0 _ = E delAt i (B x a b)   | odd i     = B x (delAt (half i) a) b@@ -239,12 +239,12 @@ null _ = False  size E = 0-size (B x a b) = 1 + n + n + diff n a+size (B _ a b) = 1 + n + n + diff n a   where n = size b          diff 0 E = 0-        diff 0 (B x a b) = 1-        diff i (B x a b)+        diff 0 (B _ _ _) = 1+        diff i (B _ a b)           | odd i     = diff (half i) a           | otherwise = diff (half i - 1) b         diff _ _ = error "BraunSeq.size: bug. Impossible case in diff!"@@ -261,7 +261,7 @@       where m = half n     rev00 _ _ = error "BraunSeq.reverse: bug!" -    rev11 n x E = (x,E)+    rev11 _ x E = (x,E)     rev11 n x (B y a b)       | odd n     = let (x',a') = rev11 m x a                         (y',b') = rev11 m y b      in (y', B x' b' a')@@ -269,7 +269,7 @@                         (y',b') = rev11 (m-1) y b  in (x', B y' a' b')       where m = half n -    rev01 n E = error "BraunSeq.reverse: bug!"+    rev01 _ E = error "BraunSeq.reverse: bug!"     rev01 n (B x a b)       | n == 1    = (x, E)       | odd n     = let (y',a') = rev01 m a@@ -278,7 +278,7 @@                         (x',b') = rev11 (m-1) x b  in (y', B x' a' b')       where m = half n -    rev10 n x E = B x E E+    rev10 _ x E = B x E E     rev10 n x (B y a b)       | odd n     = let a'      = rev10 m x a                         (y',b') = rev11 m y b      in B y' a' b'@@ -287,7 +287,7 @@       where m = half n  fromList = L.lhead . L.foldr build [E] . rows 1-  where rows k [] = []+  where rows _ [] = []         rows k xs = (k, ys) : rows (k+k) zs           where (ys,zs) = L.splitAt k xs @@ -307,24 +307,24 @@                 (ts1,ts2) = children ts                  children [] = ([],[])-                children (B x E _ : ts) = ([],[])-                children (B x a E : ts) = (a : leftChildren ts, [])-                children (B x a b : ts) = (a : ts1, b : ts2)+                children (B _ E _ : _) = ([],[])+                children (B _ a E : ts) = (a : leftChildren ts, [])+                children (B _ a b : ts) = (a : ts1, b : ts2)                   where (ts1, ts2) = children ts                 children _ = error "BraunSeq.toList: bug!"                  leftChildren [] = []-                leftChildren (B x E _ : ts) = []-                leftChildren (B x a b : ts) = a : leftChildren ts+                leftChildren (B _ E _ : _) = []+                leftChildren (B _ a _ : ts) = a : leftChildren ts                 leftChildren _ = error "BraunSeq.toList: bug!" -                root (B x a b) = x+                root (B x _ _) = x                 root _ = error "BraunSeq.toList: bug!" -                left (B x a b) = a-                left _ = error "BraunSeq.toList: bug!"+                (B _ a _) = a+--                (left _) = error "BraunSeq.toList: bug!" -map f E = E+map _ E = E map f (B x a b) = B (f x) (map f a) (map f b)  copy n x = if n <= 0 then empty else fst (copy2 n)@@ -335,8 +335,8 @@           where (a, b) = copy2 (half (n-1))  inBounds i xs = (i >= 0) && inb xs i-  where inb E i = False-        inb (B x a b) i+  where inb E _ = False+        inb (B _ a b) i           | odd i     = inb a (half i)           | i == 0    = True           | otherwise = inb b (half i - 1)@@ -346,7 +346,7 @@ lookupM i xs   | i < 0     = fail "BraunSeq.lookupM: bad subscript"   | otherwise = look xs i-  where look E i = nothing+  where look E _ = nothing         look (B x a b) i           | odd i     = look a (half i)           | i == 0    = return x@@ -355,33 +355,33 @@  lookupWithDefault d i xs = if i < 0 then d                            else look xs i-  where look E i = d+  where look E _ = d         look (B x a b) i           | odd i     = look a (half i)           | i == 0    = x           | otherwise = look b (half i - 1)  update i y xs = if i < 0 then xs else upd i xs-  where upd i E = E+  where upd _ E = E         upd i (B x a b)           | odd i     = B x (upd (half i) a) b           | i == 0    = B y a b           | otherwise = B x a (upd (half i - 1) b)  adjust f i xs = if i < 0 then xs else adj i xs-  where adj i E = E+  where adj _ E = E         adj i (B x a b)           | odd i     = B x (adj (half i) a) b           | i == 0    = B (f x) a b           | otherwise = B x a (adj (half i - 1) b)  mapWithIndex f xs = mwi 0 1 xs-  where mwi i d E = E+  where mwi _ _ E = E         mwi i d (B x a b) = B (f i x) (mwi (i+d) dd a) (mwi (i+dd) dd b)           where dd = d+d  take n xs = if n <= 0 then E else ta n xs-  where ta n E = E+  where ta _ E = E         ta n (B x a b)             | odd n     = B x (ta m a) (ta m b)             | n == 0    = E@@ -389,8 +389,8 @@           where m = half n  drop n xs = if n <= 0 then xs else dr n xs-  where dr n E = E-        dr n t@(B x a b)+  where dr _ E = E+        dr n t@(B _ a b)             | odd n     = combine (dr m a) (dr m b)             | n == 0    = t             | otherwise = combine (dr (m-1) b) (dr m a)@@ -403,11 +403,11 @@ zip3 _ _ _ = E  zipWith f (B x a b) (B y c d) = B (f x y) (zipWith f a c) (zipWith f b d)-zipWith f _ _ = E+zipWith _ _ _ = E -zipWith3 fn (B x a b) (B y c d) (B z e f) = +zipWith3 fn (B x a b) (B y c d) (B z e f) =     B (fn x y z) (zipWith3 fn a c e) (zipWith3 fn b d f)-zipWith3 fn _ _ _ = E+zipWith3 _ _ _ _ = E  unzip E = (E, E) unzip (B (x,y) a b) = (B x a1 b1, B y a2 b2)@@ -419,31 +419,33 @@   where (a1,a2,a3) = unzip3 a         (b1,b2,b3) = unzip3 b -unzipWith f g E = (E, E)+unzipWith _ _ E = (E, E) unzipWith f g (B x a b) = (B (f x) a1 b1, B (g x) a2 b2)   where (a1,a2) = unzipWith f g a         (b1,b2) = unzipWith f g b -unzipWith3 f g h E = (E, E, E)+unzipWith3 _ _ _ E = (E, E, E) unzipWith3 f g h (B x a b) = (B (f x) a1 b1, B (g x) a2 b2, B (h x) a3 b3)   where (a1,a2,a3) = unzipWith3 f g h a         (b1,b2,b3) = unzipWith3 f g h b   strict s@E = s-strict s@(B x l r) = strict l `seq` strict r `seq` s+strict s@(B _ l r) = strict l `seq` strict r `seq` s -strictWith f s@E = s+strictWith _ s@E = s strictWith f s@(B x l r) = f x `seq` strictWith f l `seq` strictWith f r `seq` s  -- invariants: --   * Left subtree is exactily the same size as the right --     subtree, or one element larger +-- structuralInvariant :: Seq a -> Bool structuralInvariant E         = True structuralInvariant (B _ l r) = isJust (check l r) -  where check E           E           = Just 1+  where check :: Seq a -> Seq a -> Maybe Int+        check E           E           = Just 1         check (B _ E E)   E           = Just 2         check (B _ l1 l2) (B _ r1 r2) = do            x <- check l1 l2@@ -497,10 +499,10 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';-   foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl'; +   foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';    foldr1 = foldr1; foldr1' = foldr1'; foldl1 = foldl1; foldl1' = foldl1';    reducer = reducer; reducer' = reducer'; reducel = reducel;    reducel' = reducel'; reduce1 = reduce1; reduce1' = reduce1';@@ -515,7 +517,7 @@    zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip;    unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName s = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Functor Seq where   fmap = map
src/Data/Edison/Seq/Defaults.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.Defaults---   Copyright   :  Copyright (c) 1998 Chris Okasaki+--   Copyright   :  Copyright (c) 1998, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -20,7 +20,6 @@ import Control.Monad.Identity import Data.Char (isSpace) -import Data.Edison.Prelude import Data.Edison.Seq import qualified Data.Edison.Seq.ListSeq as L @@ -41,7 +40,7 @@   rtailUsingLview :: (Sequence s) => s a -> s a-rtailUsingLview xs = +rtailUsingLview xs =     case lview xs of       Nothing      -> error $ instanceName xs ++ ".rtail: empty sequence"       Just (x, xs) -> rt x xs@@ -51,7 +50,7 @@             Just (y, ys) -> lcons x (rt y ys)  rtailMUsingLview :: (Monad m,Sequence s) => s a -> m (s a)-rtailMUsingLview xs = +rtailMUsingLview xs =     case lview xs of       Nothing      -> fail $ instanceName xs ++ ".rtailM: empty sequence"       Just (x, xs) -> return (rt x xs)@@ -126,7 +125,7 @@       Just (x, xs) -> fold' f x xs  foldr1UsingLview :: Sequence s => (a -> a -> a) -> s a -> a-foldr1UsingLview f xs = +foldr1UsingLview f xs =     case lview xs of       Nothing      -> error $ instanceName xs ++ ".foldr1: empty sequence"       Just (x, xs) -> fr1 x xs@@ -140,13 +139,13 @@      case lview xs of         Nothing     -> error $ instanceName xs ++ ".foldr1': empty sequence"         Just (x,xs) -> fr1 x xs-  where fr1 x xs = +  where fr1 x xs =           case lview xs of              Nothing     -> x              Just (y,ys) -> f x $! (fr1 y ys)  foldl1UsingFoldl :: Sequence s => (a -> a -> a) -> s a -> a-foldl1UsingFoldl f xs = +foldl1UsingFoldl f xs =     case lview xs of       Nothing     -> error $ instanceName xs ++ ".foldl1: empty sequence"       Just (x,xs) -> foldl f x xs@@ -188,13 +187,13 @@   inBoundsUsingDrop :: Sequence s => Int -> s a -> Bool-inBoundsUsingDrop i s = +inBoundsUsingDrop i s =   i >= 0 && not (null (drop i s))  inBoundsUsingLookupM :: Sequence s => Int -> s a -> Bool inBoundsUsingLookupM i s =   case lookupM i s of-    Just x  -> True+    Just _  -> True     Nothing -> False  inBoundsUsingSize :: Sequence s => Int -> s a -> Bool@@ -225,7 +224,7 @@ lookupMUsingDrop i s   -- XXX better error message!   | i < 0 || null s' = fail $ instanceName s-  			++ ".lookupMUsingDrop: empty sequence"+                        ++ ".lookupMUsingDrop: empty sequence"   | otherwise        = return (lhead s')   where s' = drop i s @@ -274,7 +273,7 @@  {- insertAtUsingLists :: Sequence s => Int -> a -> s a -> s a-insertAtUsingLists i x xs = +insertAtUsingLists i x xs =   fromList (L.insertAt i x (toList xs))  insertAtUsingSplitAt :: Sequence s => Int -> a -> s a -> s a@@ -294,19 +293,19 @@ mapWithIndexUsingLists :: Sequence s => (Int -> a -> b) -> s a -> s b mapWithIndexUsingLists f xs = fromList (L.mapWithIndex f (toList xs)) -foldrWithIndexUsingLists :: +foldrWithIndexUsingLists ::   Sequence s => (Int -> a -> b -> b) -> b -> s a -> b foldrWithIndexUsingLists f e xs = L.foldrWithIndex f e (toList xs) -foldrWithIndex'UsingLists :: +foldrWithIndex'UsingLists ::   Sequence s => (Int -> a -> b -> b) -> b -> s a -> b foldrWithIndex'UsingLists f e xs = L.foldrWithIndex' f e (toList xs) -foldlWithIndexUsingLists :: +foldlWithIndexUsingLists ::   Sequence s => (b -> Int -> a -> b) -> b -> s a -> b foldlWithIndexUsingLists f e xs = L.foldlWithIndex f e (toList xs) -foldlWithIndex'UsingLists :: +foldlWithIndex'UsingLists ::   Sequence s => (b -> Int -> a -> b) -> b -> s a -> b foldlWithIndex'UsingLists f e xs = L.foldlWithIndex' f e (toList xs) @@ -391,7 +390,7 @@         Nothing -> empty         Just (y,ys') -> lcons (f x y) (zipWithUsingLview f xs' ys') -zipWith3UsingLview :: +zipWith3UsingLview ::   Sequence s => (a -> b -> c -> d) -> s a -> s b -> s c -> s d zipWith3UsingLview f xs ys zs =   case lview xs of@@ -408,14 +407,14 @@ zipUsingLists xs ys = fromList (L.zip (toList xs) (toList ys))  zip3UsingLists :: Sequence s => s a -> s b -> s c -> s (a,b,c)-zip3UsingLists xs ys zs = +zip3UsingLists xs ys zs =   fromList (L.zip3 (toList xs) (toList ys) (toList zs))  zipWithUsingLists :: Sequence s => (a -> b -> c) -> s a -> s b -> s c zipWithUsingLists f xs ys =   fromList (L.zipWith f (toList xs) (toList ys)) -zipWith3UsingLists :: +zipWith3UsingLists ::   Sequence s => (a -> b -> c -> d) -> s a -> s b -> s c -> s d zipWith3UsingLists f xs ys zs =   fromList (L.zipWith3 f (toList xs) (toList ys) (toList zs))@@ -426,7 +425,7 @@     (xs, ys) -> (fromList xs, fromList ys)  unzipUsingFoldr :: Sequence s => s (a,b) -> (s a, s b)-unzipUsingFoldr = foldr pcons (empty,empty) +unzipUsingFoldr = foldr pcons (empty,empty)   where pcons (x,y) (xs,ys) = (lcons x xs, lcons y ys)  unzip3UsingLists :: Sequence s => s (a,b,c) -> (s a, s b, s c)@@ -438,26 +437,26 @@ unzip3UsingFoldr = foldr tcons (empty,empty,empty)   where tcons (x,y,z) (xs,ys,zs) = (lcons x xs, lcons y ys, lcons z zs) -unzipWithUsingLists :: +unzipWithUsingLists ::   Sequence s => (a -> b) -> (a -> c) -> s a -> (s b, s c) unzipWithUsingLists f g xys =   case L.unzipWith f g (toList xys) of     (xs, ys) -> (fromList xs, fromList ys) -unzipWithUsingFoldr :: +unzipWithUsingFoldr ::   Sequence s => (a -> b) -> (a -> c) -> s a -> (s b, s c)-unzipWithUsingFoldr f g = foldr pcons (empty,empty) +unzipWithUsingFoldr f g = foldr pcons (empty,empty)   where pcons e (xs,ys) = (lcons (f e) xs, lcons (g e) ys) -unzipWith3UsingLists :: +unzipWith3UsingLists ::   Sequence s => (a -> b) -> (a -> c) -> (a -> d) -> s a -> (s b, s c, s d) unzipWith3UsingLists f g h xyzs =   case L.unzipWith3 f g h (toList xyzs) of     (xs, ys, zs) -> (fromList xs, fromList ys, fromList zs) -unzipWith3UsingFoldr :: +unzipWith3UsingFoldr ::   Sequence s => (a -> b) -> (a -> c) -> (a -> d) -> s a -> (s b, s c, s d)-unzipWith3UsingFoldr f g h = foldr tcons (empty,empty,empty) +unzipWith3UsingFoldr f g h = foldr tcons (empty,empty,empty)   where tcons e (xs,ys,zs) = (lcons (f e) xs, lcons (g e) ys, lcons (h e) zs)  showsPrecUsingToList :: (Show a,Sequence s) => Int -> s a -> ShowS@@ -466,7 +465,7 @@    | otherwise = concat ["(",instanceName xs,".fromList "] ++ showsPrec 10 (toList xs) (')':rest)  readsPrecUsingFromList :: (Read a,Sequence s) => Int -> ReadS (s a)-readsPrecUsingFromList i xs =+readsPrecUsingFromList _ xs =    let result = maybeParens p xs        p xs = tokenMatch ((instanceName x)++".fromList") xs                 >>= readsPrec 10@@ -485,7 +484,7 @@      (Nothing, _      ) -> LT      (_      , Nothing) -> GT      (Just (x,xs), Just (y,ys)) ->-	case compare x y of+        case compare x y of            EQ -> defaultCompare xs ys            c -> c
src/Data/Edison/Seq/FingerSeq.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.FingerSeq---   Copyright   :  Copyright (c) 2006 Robert Dockins+--   Copyright   :  Copyright (c) 2006, 2008 Robert Dockins --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -36,10 +36,9 @@                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null) -import Data.Edison.Prelude+import Data.Edison.Prelude (measure, Measured()) import qualified Data.Edison.Seq as S import Data.Edison.Seq.Defaults-import Control.Monad import Control.Monad.Identity import Data.Monoid import Test.QuickCheck@@ -56,6 +55,8 @@   newtype SizeM = SizeM Int deriving (Eq,Ord,Num,Enum,Show)++unSizeM :: SizeM -> Int unSizeM (SizeM x) = x  instance Monoid SizeM where@@ -64,12 +65,16 @@   newtype Elem a = Elem a++unElem :: Elem t -> t unElem (Elem x) = x  instance Measured SizeM (Elem a) where    measure _ = 1  newtype Seq a = Seq (FT.FingerTree SizeM (Elem a))++unSeq :: Seq t -> FT.FingerTree SizeM (Elem t) unSeq (Seq ft) = ft  @@ -151,6 +156,7 @@  #ifdef __GLASGOW_HASKELL__ +mapElem, mapUnElem :: t -> b mapElem   = unsafeCoerce# mapUnElem = unsafeCoerce# @@ -231,28 +237,28 @@  lookupM i (Seq xs)     | inBounds i (Seq xs) =-	case FT.splitTree (> (SizeM i)) (SizeM 0) xs of+        case FT.splitTree (> (SizeM i)) (SizeM 0) xs of            FT.Split _ (Elem x) _ -> return x      | otherwise = fail "FingerSeq.lookupM: index out of bounds"  lookupWithDefault d i (Seq xs)     | inBounds i (Seq xs) =-	case FT.splitTree (> (SizeM i)) (SizeM 0) xs of+        case FT.splitTree (> (SizeM i)) (SizeM 0) xs of            FT.Split _ (Elem x) _ -> x      | otherwise = d  update i x (Seq xs)     | inBounds i (Seq xs) =-	case FT.splitTree (> (SizeM i)) (SizeM 0) xs of+        case FT.splitTree (> (SizeM i)) (SizeM 0) xs of            FT.Split l _ r -> Seq $ FT.append l $ FT.lcons (Elem x) $ r      | otherwise = Seq xs  adjust f i (Seq xs)     | inBounds i (Seq xs) =-	case FT.splitTree (> (SizeM i)) (SizeM 0) xs of+        case FT.splitTree (> (SizeM i)) (SizeM 0) xs of            FT.Split l x r -> Seq $ FT.append l $ FT.lcons (Elem (f (unElem x))) $ r      | otherwise = Seq xs@@ -319,7 +325,7 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';@@ -337,7 +343,7 @@    zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip;    unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName s = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Functor Seq where   fmap = map
src/Data/Edison/Seq/JoinList.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.JoinList---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -52,7 +52,6 @@                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null) -import Data.Edison.Prelude import qualified Data.Edison.Seq as S ( Sequence(..) ) import Data.Edison.Seq.Defaults import Control.Monad@@ -163,30 +162,30 @@ lview E = fail "JoinList.lview: empty sequence" lview (L x) = return (x, E) lview (A xs ys) = lvw xs ys-  where lvw E zs = error "JoinList.lvw: bug"+  where lvw E _ = error "JoinList.lvw: bug"         lvw (L x) zs = return (x, zs)         lvw (A xs ys) zs = lvw xs (A ys zs)  lhead E = error "JoinList.lhead: empty sequence" lhead (L x) = x-lhead (A xs ys) = lhead xs+lhead (A xs _) = lhead xs  lheadM E = fail "JoinList.lheadM: empty sequence" lheadM (L x) = return x-lheadM (A xs ys) = lheadM xs+lheadM (A xs _) = lheadM xs  ltail E = error "JoinList.ltail: empty sequence"-ltail (L x) = E+ltail (L _) = E ltail (A xs ys) = ltl xs ys-  where ltl E zs = error "JoinList.ltl: bug"-        ltl (L x) zs = zs+  where ltl E _ = error "JoinList.ltl: bug"+        ltl (L _) zs = zs         ltl (A xs ys) zs = ltl xs (A ys zs)  ltailM E = fail "JoinList.ltailM: empty sequence"-ltailM (L x) = return E+ltailM (L _) = return E ltailM (A xs ys) = return (ltl xs ys)-  where ltl E zs = error "JoinList.ltl: bug"-        ltl (L x) zs = zs+  where ltl E _ = error "JoinList.ltl: bug"+        ltl (L _) zs = zs         ltl (A xs ys) zs = ltl xs (A ys zs)  @@ -200,38 +199,38 @@   where rvw xs (A ys (A zs s)) = rvw (A xs (A ys zs)) s         rvw xs (A ys (L x)) = return (x, A xs ys)         rvw xs (L x) = return (x, xs)-        rvw xs _ = error "JoinList.rvw: bug"- +        rvw _ _ = error "JoinList.rvw: bug"+ rhead E = error "JoinList.rhead: empty sequence" rhead (L x) = x-rhead (A xs ys) = rhead ys+rhead (A _ ys) = rhead ys  rheadM E = fail "JoinList.rheadM: empty sequence" rheadM (L x) = return x-rheadM (A xs ys) = rheadM ys+rheadM (A _ ys) = rheadM ys  rtail E = error "JoinList.rtail: empty sequence"-rtail (L x) = E+rtail (L _) = E rtail (A xs ys) = rtl xs ys   where rtl xs (A ys (A zs s)) = A (A xs ys) (rtl zs s)         rtl xs (A ys (L _)) = A xs ys-        rtl xs (L x) = xs-        rtl xs _ = error "JoinList.rtl: bug"+        rtl xs (L _) = xs+        rtl _ _ = error "JoinList.rtl: bug"  rtailM E = fail "JoinList.rtailM: empty sequence"-rtailM (L x) = return E+rtailM (L _) = return E rtailM (A xs ys) = return (rtl xs ys)   where rtl xs (A ys (A zs s)) = A (A xs ys) (rtl zs s)         rtl xs (A ys (L _)) = A xs ys-        rtl xs (L x) = xs-        rtl xs _ = error "JoinList.rtl: bug"+        rtl xs (L _) = xs+        rtl _ _ = error "JoinList.rtl: bug"  null E = True null _ = False  size xs = sz xs (0::Int)   where sz E n = n-        sz (L x) n = n + (1::Int)+        sz (L _) n = n + (1::Int)         sz (A xs ys) n = sz xs (sz ys n)  reverse (A xs ys) = A (reverse ys) (reverse xs)@@ -242,7 +241,7 @@         tol (L x) rest = x:rest         tol (A xs ys) rest = tol xs (tol ys rest) -map f E = E+map _ E = E map f (L x) = L (f x) map f (A xs ys) = A (map f xs) (map f ys) @@ -251,39 +250,38 @@ fold1  = fold1UsingFold fold1' = fold1'UsingFold' -foldr f e E = e+foldr _ e E = e foldr f e (L x) = f x e foldr f e (A xs ys) = foldr f (foldr f e ys) xs--foldr' f e E = e+foldr' _ e E = e foldr' f e (L x) = f x $! e foldr' f e (A xs ys) = (foldr' f $! (foldr' f e ys)) xs -foldl f e E = e+foldl _ e E = e foldl f e (L x) = f e x foldl f e (A xs ys) = foldl f (foldl f e xs) ys -foldl' f e E = e+foldl' _ e E = e foldl' f e (L x) = e `seq` f e x foldl' f e (A xs ys) = e `seq` foldl' f (foldl' f e xs) ys -foldr1 f E = error "JoinList.foldr1: empty sequence"-foldr1 f (L x) = x+foldr1 _ E = error "JoinList.foldr1: empty sequence"+foldr1 _ (L x) = x foldr1 f (A xs ys) = foldr f (foldr1 f ys) xs -foldr1' f E = error "JoinLis.foldr1': empty sequence"-foldr1' f (L x) = x+foldr1' _ E = error "JoinLis.foldr1': empty sequence"+foldr1' _ (L x) = x foldr1' f (A xs ys) = foldr' f (foldr1' f ys) xs -foldl1 f E = error "JoinList.foldl1: empty sequence"-foldl1 f (L x) = x+foldl1 _ E = error "JoinList.foldl1: empty sequence"+foldl1 _ (L x) = x foldl1 f (A xs ys) = foldl f (foldl1 f xs) ys -foldl1' f E = error "JoinList.foldl1': empty sequence"-foldl1' f (L x) = x+foldl1' _ E = error "JoinList.foldl1': empty sequence"+foldl1' _ (L x) = x foldl1' f (A xs ys) = foldl' f (foldl1' f xs) ys -copy n x +copy n x     | n <= 0 = E     | otherwise = cpy n x   where cpy n x  -- n > 0@@ -295,12 +293,12 @@   strict s@E = s-strict s@(L x) = s+strict s@(L _) = s strict s@(A l r) = strict l `seq` strict r `seq` s -strictWith f s@E = s+strictWith _ s@E = s strictWith f s@(L x) = f x `seq` s-strictWith f s@(A l r) = strictWith f l `seq` strictWith f l `seq` s+strictWith f s@(A l _) = strictWith f l `seq` strictWith f l `seq` s  -- invariants: --   * 'E' is never a child of 'A'@@ -342,7 +340,7 @@ drop = dropUsingLtail splitAt = splitAtUsingLview subseq = subseqDefault-        + filter = filterUsingLview partition = partitionUsingFoldr takeWhile = takeWhileUsingLview@@ -366,7 +364,7 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';@@ -384,7 +382,7 @@    zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip;    unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName s = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Functor Seq where   fmap = map
src/Data/Edison/Seq/MyersStack.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.MyersStack---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -48,10 +48,8 @@                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null) -import Data.Edison.Prelude import qualified Data.Edison.Seq as S ( Sequence(..) ) import Data.Edison.Seq.Defaults-import Control.Monad import Control.Monad.Identity import Data.Monoid import Test.QuickCheck@@ -140,6 +138,7 @@   -- what about strictness flags on tail and jump-tail?  -- auxiliary function+jump :: Seq t -> Seq t jump (C _ _ _ (C _ _ _ xs')) = xs' jump _ = error "MyersStack.jump: bug!" @@ -154,40 +153,40 @@ lview (C _ x xs _) = return (x, xs)  lhead E = error "MyersStack.lhead: empty sequence"-lhead (C _ x xs _) = x+lhead (C _ x _ _) = x  lheadM E = fail "MyersStack.lheadM: empty sequence"-lheadM (C _ x xs _) = return x+lheadM (C _ x _ _) = return x  ltail E = error "MyersStack.ltail: empty sequence"-ltail (C _ x xs _) = xs+ltail (C _ _ xs _) = xs  ltailM E = fail "MyersStack.ltailM: empty sequence"-ltailM (C _ x xs _) = return xs+ltailM (C _ _ xs _) = return xs  rview E = fail "MyersStack.rview: empty sequence" rview xs = return (rhead xs, rtail xs)  rhead E = error "MyersStack.rhead: empty sequence" rhead (C _ x xs xs') = rh x xs xs'-  where rh x xs (C _ y ys ys') = rh y ys ys'-        rh x (C _ y ys ys') E = rh y ys ys'+  where rh _ _ (C _ y ys ys') = rh y ys ys'+        rh _ (C _ y ys ys') E = rh y ys ys'         rh x E E = x  rheadM E = fail "MyersStack.rheadM: empty sequence" rheadM (C _ x xs xs') = return (rh x xs xs')-  where rh x xs (C _ y ys ys') = rh y ys ys'-        rh x (C _ y ys ys') E = rh y ys ys'+  where rh _ _ (C _ y ys ys') = rh y ys ys'+        rh _ (C _ y ys ys') E = rh y ys ys'         rh x E E = x  rtail E = error "MyersStack.rtail: empty sequence" rtail (C _ x xs _) = rt x xs-  where rt y E = E+  where rt _ E = E         rt y (C _ x xs _) = lcons y (rt x xs)  rtailM E = fail "MyersStack.rtailM: empty sequence" rtailM (C _ x xs _) = return (rt x xs)-  where rt y E = E+  where rt _ E = E         rt y (C _ x xs _) = lcons y (rt x xs)  null E = True@@ -195,13 +194,13 @@  size xs = go xs   where go E = (0::Int)-        go (C j x xs xs') = j + size xs'+        go (C j _ _ xs') = j + size xs'  reverseOnto E ys = ys reverseOnto (C _ x xs _) ys = reverseOnto xs (lcons x ys) -map f E = E-map f (C j x xs xs')+map _ E = E+map f (C j x xs _')     | j == 1    = C j (f x) ys ys     | otherwise = C j (f x) ys (jump ys)   where ys = map f xs@@ -211,53 +210,53 @@ fold1  = fold1UsingFold fold1' = fold1'UsingFold' -foldr f e E = e+foldr _ e E = e foldr f e (C _ x xs _) = f x (foldr f e xs) -foldr' f e E = e+foldr' _ e E = e foldr' f e (C _ x xs _) = f x $! (foldr' f e xs) -foldl f e E = e+foldl _ e E = e foldl f e (C _ x xs _) = foldl f (f e x) xs -foldl' f e E = e+foldl' _ e E = e foldl' f e (C _ x xs _) = e `seq` foldl' f (f e x) xs -foldr1 f E = error "MyersStack.foldr1: empty sequence"+foldr1 _ E = error "MyersStack.foldr1: empty sequence" foldr1 f (C _ x xs _) = fr x xs   where fr y E = y         fr y (C _ x xs _) = f y (fr x xs) -foldr1' f E = error "MyersStack.foldr1': empty sequence"+foldr1' _ E = error "MyersStack.foldr1': empty sequence" foldr1' f (C _ x xs _) = fr x xs   where fr y E = y         fr y (C _ x xs _) = f y $! (fr x xs) -foldl1 f E = error "MyersStack.foldl1: empty sequence"+foldl1 _ E = error "MyersStack.foldl1: empty sequence" foldl1 f (C _ x xs _) = foldl f x xs -foldl1' f E = error "MyersStack.foldl1': empty sequence"+foldl1' _ E = error "MyersStack.foldl1': empty sequence" foldl1' f (C _ x xs _ ) = foldl' f x xs  inBounds i xs = inb xs i-  where inb E i = False-        inb (C j x xs xs') i+  where inb E _ = False+        inb (C j _ _ xs') i           | i < j     = (i >= 0)           | otherwise = inb xs' (i - j)  lookup i xs = runIdentity (lookupM i xs)  lookupM i xs = look xs i-  where look E i = fail "MyersStack.lookup: bad subscript"+  where look E _ = fail "MyersStack.lookup: bad subscript"         look (C j x xs xs') i           | i >= j   = look xs' (i - j)           | i > 0    = look xs  (i - 1)           | i == 0   = return x           | otherwise = nothing-	nothing = fail "MyersStack.lookup: not found"+        nothing = fail "MyersStack.lookup: not found"  lookupWithDefault d i xs = look xs i-  where look E i = d+  where look E _ = d         look (C j x xs xs') i           | i >= j   = look xs' (i - j)           | i > 0    = look xs  (i - 1)@@ -265,15 +264,15 @@           | otherwise = d  update i y xs = upd i xs-  where upd i E = E-        upd 0 (C j x xs xs') = C j y xs xs'+  where upd _ E = E+        upd 0 (C j _ xs xs') = C j y xs xs'         upd i (C j x xs _)             | j == 1    = C j x ys ys             | otherwise = C j x ys (jump ys)           where ys = upd (i - 1) xs  adjust f i xs = adj i xs-  where adj i E = E+  where adj _ E = E         adj 0 (C j x xs xs') = C j (f x) xs xs'         adj i (C j x xs _)             | j == 1    = C j x ys ys@@ -282,30 +281,30 @@  drop n xs = drp n xs   where drp n xs | n <= 0 = xs-        drp n E = E-        drp n (C j x xs xs')+        drp _ E = E+        drp n (C j _ xs xs')           | n < j     = drp (n - 1) xs           | otherwise = drp (n - j) xs'  unzip E = (E, E)-unzip (C j (x,y) ps ps')+unzip (C j (x,y) ps _')     | j == 1    = (C j x xs xs, C j y ys ys)     | otherwise = (C j x xs (jump xs), C j y ys (jump ys))   where (xs,ys) = unzip ps  unzip3 E = (E, E, E)-unzip3 (C j (x,y,z) ts ts')+unzip3 (C j (x,y,z) ts _')     | j == 1    = (C j x xs xs, C j y ys ys, C j z zs zs)     | otherwise = (C j x xs (jump xs), C j y ys (jump ys), C j z zs (jump zs))   where (xs,ys,zs) = unzip3 ts -unzipWith f g E = (E, E)+unzipWith _ _ E = (E, E) unzipWith f g (C j x xs _)     | j == 1    = (C j (f x) as as, C j (g x) bs bs)     | otherwise = (C j (f x) as (jump as), C j (g x) bs (jump bs))   where (as,bs) = unzipWith f g xs -unzipWith3 f g h E = (E, E, E)+unzipWith3 _ _ _ E = (E, E, E) unzipWith3 f g h (C j x xs _)     | j == 1    = (C j (f x) as as, C j (g x) bs bs, C j (h x) cs cs)     | otherwise = (C j (f x) as (jump as), C j (g x) bs (jump bs),@@ -313,10 +312,10 @@   where (as,bs,cs) = unzipWith3 f g h xs  strict s@E = s-strict s@(C i x xs _) = strict xs `seq` s+strict s@(C _ _ xs _) = strict xs `seq` s -strictWith f s@E = s-strictWith f s@(C i x xs _) = f x `seq` strictWith f xs `seq` s+strictWith _ s@E = s+strictWith f s@(C _ x xs _) = f x `seq` strictWith f xs `seq` s  -- the remaining functions all use defaults @@ -366,7 +365,7 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';@@ -384,7 +383,7 @@    zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip;    unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName s = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Functor Seq where   fmap = map
src/Data/Edison/Seq/RandList.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.RandList---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -53,10 +53,8 @@                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null) -import Data.Edison.Prelude import qualified Data.Edison.Seq as S( Sequence(..) ) import Data.Edison.Seq.Defaults-import Control.Monad import Control.Monad.Identity import Data.Monoid import Test.QuickCheck@@ -148,7 +146,7 @@ empty = E singleton x = C 1 (L x) E -lcons x xs@(C i s (C j t xs'))+lcons x (C i s (C j t xs'))     | i == j = C (1 + i + j) (T x s t) xs' lcons x xs = C 1 (L x) xs @@ -162,7 +160,7 @@           | i > 0  = takeTrees i (half j) (child t) xs           | otherwise = xs -        child (T x s t) = t+        child (T _ _ t) = t         child _ = error "RandList.copy: bug!"  lview E = fail "RandList.lview: empty sequence"@@ -171,34 +169,34 @@   where j = half i  lhead E = error "RandList.lhead: empty sequence"-lhead (C _ (L x) xs) = x-lhead (C _ (T x s t) xs) = x+lhead (C _ (L x) _) = x+lhead (C _ (T x _ _) _) = x  lheadM E = fail "RandList.lheadM: empty sequence"-lheadM (C _ (L x) xs) = return x-lheadM (C _ (T x s t) xs) = return x+lheadM (C _ (L x) _) = return x+lheadM (C _ (T x _ _) _) = return x  ltail E = error "RandList.ltail: empty sequence"-ltail (C _ (L x) xs) = xs-ltail (C i (T x s t) xs) = C j s (C j t xs)+ltail (C _ (L _) xs) = xs+ltail (C i (T _ s t) xs) = C j s (C j t xs)   where j = half i  ltailM E = fail "RandList.ltailM: empty sequence"-ltailM (C _ (L x) xs) = return xs-ltailM (C i (T x s t) xs) = return (C j s (C j t xs))+ltailM (C _ (L _) xs) = return xs+ltailM (C i (T _ s t) xs) = return (C j s (C j t xs))   where j = half i  rhead E = error "RandList.rhead: empty sequence" rhead (C _ t E) = treeLast t   where treeLast (L x) = x-        treeLast (T x s t) = treeLast t-rhead (C _ t xs) = rhead xs+        treeLast (T _ _ t) = treeLast t+rhead (C _ _ xs) = rhead xs  rheadM E = fail "RandList.rhead: empty sequence" rheadM (C _ t E) = return(treeLast t)   where treeLast (L x) = x-        treeLast (T x s t) = treeLast t-rheadM (C _ t xs) = rheadM xs+        treeLast (T _ _ t) = treeLast t+rheadM (C _ _ xs) = rheadM xs   null E = True@@ -206,14 +204,14 @@  size xs = sz xs   where sz E = (0::Int)-        sz (C j t xs) = j + sz xs+        sz (C j _ xs) = j + sz xs  reverseOnto E ys = ys reverseOnto (C _ t xs) ys = reverseOnto xs (revTree t ys)   where revTree (L x) ys = lcons x ys         revTree (T x s t) ys = revTree t (revTree s (lcons x ys)) -map f E = E+map _ E = E map f (C j t xs) = C j (mapTree f t) (map f xs)   where mapTree f (L x) = L (f x)         mapTree f (T x s t) = T (f x) (mapTree f s) (mapTree f t)@@ -223,22 +221,22 @@ fold1  = fold1UsingFold fold1' = fold1'UsingFold' -foldr f e E = e+foldr _ e E = e foldr f e (C _ t xs) = foldTree t (foldr f e xs)   where foldTree (L x) e = f x e         foldTree (T x s t) e = f x (foldTree s (foldTree t e)) -foldr' f e E = e+foldr' _ e E = e foldr' f e (C _ t xs) = foldTree t $! (foldr' f e xs)   where foldTree (L x) e = f x $! e         foldTree (T x s t) e = f x $! (foldTree s $! (foldTree t $! e)) -foldl f e E = e+foldl _ e E = e foldl f e (C _ t xs) = foldl f (foldTree e t) xs   where foldTree e (L x) = f e x         foldTree e (T x s t) = foldTree (foldTree (f e x) s) t -foldl' f e E = e+foldl' _ e E = e foldl' f e (C _ t xs) = (foldl f $! (foldTree e t)) xs   where foldTree e (L x) = e `seq` f e x         foldTree e (T x s t) = e `seq` (foldTree $! (foldTree (f e x) s)) t@@ -247,7 +245,7 @@                  Nothing      -> error "RandList.reduce1: empty seq"                  Just (x, xs) -> red1 x xs   where red1 x E = x-        red1 x (C j t xs) = red1 (redTree x t) xs+        red1 x (C _ t xs) = red1 (redTree x t) xs          redTree x (L y) = f x y         redTree x (T y s t) = redTree (redTree (f x y) s) t@@ -256,22 +254,22 @@                   Nothing      -> error "RandList.reduce1': empty seq"                   Just (x, xs) -> red1 x xs   where red1 x E = x-        red1 x (C j t xs) = (red1 $! (redTree x t)) xs+        red1 x (C _ t xs) = (red1 $! (redTree x t)) xs          redTree x (L y) = x `seq` y `seq` f x y         redTree x (T y s t) = x `seq` y `seq` (redTree $! (redTree (f x y) s)) t   inBounds i xs = inb xs i-  where inb E i = False-        inb (C j t xs) i+  where inb E _ = False+        inb (C j _ xs) i           | i < j     = (i >= 0)           | otherwise = inb xs (i - j)  lookup i xs = runIdentity (lookupM i xs)  lookupM i xs = look xs i-  where look E i = fail "RandList.lookup bad subscript"+  where look E _ = fail "RandList.lookup bad subscript"         look (C j t xs) i             | i < j     = lookTree j t i             | otherwise = look xs (i - j)@@ -284,10 +282,10 @@             | i /= 0 = lookTree k s (i - 1)             | otherwise = return x           where k = half j-	nothing = fail "RandList.lookup: not found"+        nothing = fail "RandList.lookup: not found"  lookupWithDefault d i xs = look xs i-  where look E i = d+  where look E _ = d         look (C j t xs) i             | i < j     = lookTree j t i             | otherwise = look xs (i - j)@@ -302,12 +300,12 @@           where k = half j  update i y xs = upd i xs-  where upd i E = E+  where upd _ E = E         upd i (C j t xs)             | i < j     = C j (updTree i j t) xs             | otherwise = C j t (upd (i - j) xs) -        updTree i j t@(L x)+        updTree i _ t@(L _)             | i == 0    = L y             | otherwise = t         updTree i j (T x s t)@@ -317,12 +315,12 @@           where k = half j  adjust f i xs = adj i xs-  where adj i E = E+  where adj _ E = E         adj i (C j t xs)             | i < j     = C j (adjTree i j t) xs             | otherwise = C j t (adj (i - j) xs) -        adjTree i j t@(L x)+        adjTree i _ t@(L x)             | i == 0    = L (f x)             | otherwise = t         adjTree i j (T x s t)@@ -332,27 +330,29 @@           where k = half j  drop n xs = if n < 0 then xs else drp n xs-  where drp i E = E+  where drp _ E = E         drp i (C j t xs)             | i < j     = drpTree i j t xs             | otherwise = drp (i - j) xs          drpTree 0 j t xs = C j t xs-        drpTree i j (L x) xs = error "RandList.drop: bug.  Impossible case!"-        drpTree i j (T x s t) xs+        drpTree _ _ (L _) _ = error "RandList.drop: bug.  Impossible case!"+        drpTree i j (T _ s t) xs             | i > k     = drpTree (i - 1 - k) k t xs             | otherwise = drpTree (i - 1) k s (C k t xs)           where k = half j  strict s@E = s-strict s@(C j t xs) = strictTree t `seq` strict xs `seq` s+strict s@(C _ t xs) = strictTree t `seq` strict xs `seq` s -strictTree t@(L x) = t-strictTree t@(T x l r) = strictTree l `seq` strictTree r `seq` t+strictTree :: Tree t -> Tree t+strictTree t@(L _) = t+strictTree t@(T _ l r) = strictTree l `seq` strictTree r `seq` t -strictWith f s@E = s-strictWith f s@(C j t xs) = strictWithTree f t `seq` strictWith f xs `seq` s+strictWith _ s@E = s+strictWith f s@(C _ t xs) = strictWithTree f t `seq` strictWith f xs `seq` s +strictWithTree :: (t -> a) -> Tree t -> Tree t strictWithTree f t@(L x) = f x `seq` t strictWithTree f t@(T x l r) = f x `seq` strictWithTree f l `seq` strictWithTree f r `seq` t @@ -403,24 +403,24 @@ unzipWith = unzipWithUsingLists unzipWith3 = unzipWith3UsingLists --- invariants: +-- invariants: --   * list of complete binary trees in non-decreasing --     order by size --   * first argument to 'C' is the number --     of nodes in the tree-+structuralInvariant :: Seq t -> Bool structuralInvariant E = True structuralInvariant (C x t s) = x > 0 && checkTree x t && checkSeq x s     where checkTree 1 (L _) = True-         checkTree w (T _ l r) = -             let w' = (w - 1) `div` 2 +         checkTree w (T _ l r) =+             let w' = (w - 1) `div` 2              in w' > 0 && checkTree w' l && checkTree w' r          checkTree _ _ = False -         checkSeq x E = True-         checkSeq x (C y t s) = -	     x <= y && checkTree y t && checkSeq y s+         checkSeq _ E = True+         checkSeq x (C y t s) =+             x <= y && checkTree y t && checkSeq y s   -- instances@@ -430,7 +430,7 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';@@ -448,7 +448,7 @@    zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip;    unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName s = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Functor Seq where   fmap = map
src/Data/Edison/Seq/RevSeq.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.RevSeq---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -56,7 +56,6 @@                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null) -import Data.Edison.Prelude import qualified Data.Edison.Seq as S import qualified Data.Edison.Seq.ListSeq as L import Data.Edison.Seq.Defaults -- only used by concatMap@@ -149,14 +148,14 @@   moduleName = "Data.Edison.Seq.RevSeq"-instanceName (N m s) = "RevSeq(" ++ S.instanceName s ++ ")"+instanceName (N _ s) = "RevSeq(" ++ S.instanceName s ++ ")"  data Rev s a = N !Int (s a)   -- The Int is the size minus one.  The "minus one" makes indexing   -- calculations easier.  fromSeq xs = N (S.size xs - 1) xs-toSeq (N m xs) = xs+toSeq (N _ xs) = xs  empty = N (-1) S.empty singleton x = N 0 (S.singleton x)@@ -168,65 +167,65 @@                    Nothing     -> fail "RevSeq.lview: empty sequence"                    Just (x,xs) -> return (x, N (m-1) xs) -lhead (N m xs) = S.rhead xs+lhead (N _ xs) = S.rhead xs -lheadM (N m xs) = S.rheadM xs+lheadM (N _ xs) = S.rheadM xs -ltail (N (-1) xs) = error "RevSeq.ltail: empty sequence"+ltail (N (-1) _) = error "RevSeq.ltail: empty sequence" ltail (N m xs) = N (m-1) (S.rtail xs) -ltailM (N (-1) xs) = fail "RevSeq.ltailM: empty sequence"+ltailM (N (-1) _) = fail "RevSeq.ltailM: empty sequence" ltailM (N m xs) = return (N (m-1) (S.rtail xs))  rview (N m xs) = case S.lview xs of                    Nothing     -> fail "RevSeq.rview: empty sequence"                    Just (x,xs) -> return (x, N (m-1) xs)- -rhead (N m xs) = S.lhead xs -rheadM (N m xs) = S.lheadM xs+rhead (N _ xs) = S.lhead xs -rtail (N (-1) xs) = error "RevSeq.rtail: empty sequence"+rheadM (N _ xs) = S.lheadM xs++rtail (N (-1) _) = error "RevSeq.rtail: empty sequence" rtail (N m xs) = N (m-1) (S.ltail xs) -rtailM (N (-1) xs) = fail "RevSeq.rtailM: empty sequence"+rtailM (N (-1) _) = fail "RevSeq.rtailM: empty sequence" rtailM (N m xs) = return (N (m-1) (S.ltail xs)) -null (N m xs) = m == -1-size (N m xs) = m+1-concat (N m xss) = fromSeq (S.concat (S.map toSeq xss))+null (N m _) = m == -1+size (N m _) = m+1+concat (N _ xss) = fromSeq (S.concat (S.map toSeq xss)) reverse (N m xs) = N m (S.reverse xs) reverseOnto (N m xs) (N n ys) = N (m+n+1) (S.append ys (S.reverse xs)) fromList = fromSeq . S.fromList . L.reverse-toList (N m xs) = S.foldl (flip (:)) [] xs+toList (N _ xs) = S.foldl (flip (:)) [] xs map f (N m xs) = N m (S.map f xs)  concatMap = concatMapUsingFoldr -- only function that uses a default -fold f e (N m xs) = S.fold f e xs-fold' f e (N m xs) = S.fold' f e xs-fold1 f (N m xs) = S.fold1 f xs-fold1' f (N m xs) = S.fold1' f xs-foldr f e (N m xs) = S.foldl (flip f) e xs-foldr' f e (N m xs) = S.foldl' (flip f) e xs-foldl f e (N m xs) = S.foldr (flip f) e xs-foldl' f e (N m xs) = S.foldr' (flip f) e xs-foldr1 f (N m xs) = S.foldl1 (flip f) xs-foldr1' f (N m xs) = S.foldl1' (flip f) xs-foldl1 f (N m xs) = S.foldr1 (flip f) xs-foldl1' f (N m xs) = S.foldr1' (flip f) xs-reducer f e (N m xs) = S.reducel (flip f) e xs-reducer' f e (N m xs) = S.reducel' (flip f) e xs-reducel f e (N m xs) = S.reducer (flip f) e xs-reducel' f e (N m xs) = S.reducer' (flip f) e xs-reduce1 f (N m xs) = S.reduce1 (flip f) xs-reduce1' f (N m xs) = S.reduce1' (flip f) xs+fold f e (N _ xs) = S.fold f e xs+fold' f e (N _ xs) = S.fold' f e xs+fold1 f (N _ xs) = S.fold1 f xs+fold1' f (N _ xs) = S.fold1' f xs+foldr f e (N _ xs) = S.foldl (flip f) e xs+foldr' f e (N _ xs) = S.foldl' (flip f) e xs+foldl f e (N _ xs) = S.foldr (flip f) e xs+foldl' f e (N _ xs) = S.foldr' (flip f) e xs+foldr1 f (N _ xs) = S.foldl1 (flip f) xs+foldr1' f (N _ xs) = S.foldl1' (flip f) xs+foldl1 f (N _ xs) = S.foldr1 (flip f) xs+foldl1' f (N _ xs) = S.foldr1' (flip f) xs+reducer f e (N _ xs) = S.reducel (flip f) e xs+reducer' f e (N _ xs) = S.reducel' (flip f) e xs+reducel f e (N _ xs) = S.reducer (flip f) e xs+reducel' f e (N _ xs) = S.reducer' (flip f) e xs+reduce1 f (N _ xs) = S.reduce1 (flip f) xs+reduce1' f (N _ xs) = S.reduce1' (flip f) xs -copy n x +copy n x     | n <= 0 = empty     | otherwise = N (n-1) (S.copy n x) -inBounds i (N m xs) = (i >= 0) && (i <= m)+inBounds i (N m _) = (i >= 0) && (i <= m) lookup i (N m xs) = S.lookup (m-i) xs lookupM i (N m xs) = S.lookupM (m-i) xs lookupWithDefault d i (N m xs) = S.lookupWithDefault d (m-i) xs@@ -311,8 +310,8 @@ unzipWith3 f g h (N m xyzs) = (N m xs, N m ys, N m zs)   where (xs,ys,zs) = S.unzipWith3 f g h xyzs -strict s@(N i s') = S.strict s' `seq` s-strictWith f s@(N i s') = S.strictWith f s' `seq` s+strict s@(N _ s') = S.strict s' `seq` s+strictWith f s@(N _ s') = S.strictWith f s' `seq` s  structuralInvariant (N i s) = i == ((S.size s) - 1) @@ -323,7 +322,7 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';@@ -366,7 +365,7 @@      | otherwise = L.concat ["(",moduleName,".fromSeq ",showsPrec 10 (toSeq xs) (')':rest)]  instance (S.Sequence s, Read (s a)) => Read (Rev s a) where-  readsPrec i xs = maybeParens p xs+  readsPrec _ xs = maybeParens p xs       where p xs = tokenMatch (moduleName++".fromSeq") xs                      >>= readsPrec 10                      >>= \(l,rest) -> return (fromSeq l,rest)
src/Data/Edison/Seq/SimpleQueue.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.SimpleQueue---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -51,7 +51,6 @@                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null) -import Data.Edison.Prelude import qualified Data.Edison.Seq as S ( Sequence(..) ) import Data.Edison.Seq.Defaults import qualified Data.Edison.Seq.ListSeq as L@@ -143,6 +142,7 @@   -- invariant: front empty only if rear also empty  -- not exported+makeQ :: [a] -> [a] -> Seq a makeQ [] ys = Q (L.reverse ys) [] makeQ xs ys = Q xs ys @@ -161,18 +161,18 @@ lview (Q (x:xs) ys) = return (x, Q xs ys)  lhead (Q [] _) = error "SimpleQueue.lhead: empty sequence"-lhead (Q (x:xs) _) = x+lhead (Q (x:_) _) = x  lheadM (Q [] _) = fail "SimpleQueue.lheadM: empty sequence"-lheadM (Q (x:xs) _) = return x+lheadM (Q (x:_) _) = return x -ltail (Q [x] ys) = Q (L.reverse ys) []-ltail (Q (x:xs) ys) = Q xs ys-ltail q@(Q [] _) = error "SimpleQueue.ltail: empty sequence"+ltail (Q [_] ys) = Q (L.reverse ys) []+ltail (Q (_:xs) ys) = Q xs ys+ltail (Q [] _) = error "SimpleQueue.ltail: empty sequence" -ltailM (Q [x] ys) = return (Q (L.reverse ys) [])-ltailM (Q (x:xs) ys) = return (Q xs ys)-ltailM q@(Q [] _) = fail "SimpleQueue.ltailM: empty sequence"+ltailM (Q [_] ys) = return (Q (L.reverse ys) [])+ltailM (Q (_:xs) ys) = return (Q xs ys)+ltailM (Q [] _) = fail "SimpleQueue.ltailM: empty sequence"  rview (Q xs (y:ys)) = return (y, Q xs ys) rview (Q xs []) =@@ -180,20 +180,20 @@     Nothing      -> fail "SimpleQueue.rview: empty sequence"     Just (x,xs') -> return (x, Q xs' []) -rhead (Q xs (y:ys)) = y+rhead (Q _ (y:_)) = y rhead (Q [] []) = error "SimpleQueue.rhead: empty sequence" rhead (Q xs []) = L.rhead xs -rheadM (Q xs (y:ys)) = return y+rheadM (Q _ (y:_)) = return y rheadM (Q [] []) = fail "SimpleQueue.rheadM: empty sequence" rheadM (Q xs []) = return (L.rhead xs) -rtail (Q xs (y:ys)) = Q xs ys-rtail q@(Q [] []) = error "SimpleQueue.rtail: empty sequence"+rtail (Q xs (_:ys)) = Q xs ys+rtail (Q [] []) = error "SimpleQueue.rtail: empty sequence" rtail (Q xs []) = Q (L.rtail xs) [] -rtailM (Q xs (y:ys)) = return (Q xs ys)-rtailM q@(Q [] []) = fail "SimpleQueue.rtailM: empty sequence"+rtailM (Q xs (_:ys)) = return (Q xs ys)+rtailM (Q [] []) = fail "SimpleQueue.rtailM: empty sequence" rtailM (Q xs []) = return (Q (L.rtail xs) [])  null (Q [] _) = True@@ -215,17 +215,21 @@ map f (Q xs ys) = Q (L.map f xs) (L.map f ys)  -- local fn on lists-revfoldr f e [] = e+revfoldr :: (t -> t1 -> t1) -> t1 -> [t] -> t1+revfoldr _ e [] = e revfoldr f e (x:xs) = revfoldr f (f x e) xs -revfoldr' f e [] = e+revfoldr' :: (t -> a -> a) -> a -> [t] -> a+revfoldr' _ e [] = e revfoldr' f e (x:xs) = e `seq` revfoldr' f (f x e) xs  -- local fn on lists-revfoldl f e [] = e+revfoldl :: (t -> t1 -> t) -> t -> [t1] -> t+revfoldl _ e [] = e revfoldl f e (x:xs) = f (revfoldl f e xs) x -revfoldl' f e [] = e+revfoldl' :: (a -> t -> a) -> a -> [t] -> a+revfoldl' _ e [] = e revfoldl' f e (x:xs) = e `seq` f (revfoldl' f e xs) x  fold   f e (Q xs ys) = L.foldr f (L.foldr f e ys) xs@@ -240,18 +244,18 @@ foldl' f e (Q xs ys) = revfoldl' f (L.foldl' f e xs) ys  foldr1  f (Q xs (y:ys)) = L.foldr f (revfoldr f y ys) xs-foldr1  f (Q [] []) = error "SimpleQueue.foldr1: empty sequence"+foldr1  _ (Q [] []) = error "SimpleQueue.foldr1: empty sequence" foldr1  f (Q xs []) = L.foldr1 f xs  foldr1' f (Q xs (y:ys)) = L.foldr' f (revfoldr' f y ys) xs-foldr1' f (Q [] []) = error "SimpleQueye.foldr1': empty sequence"+foldr1' _ (Q [] []) = error "SimpleQueye.foldr1': empty sequence" foldr1' f (Q xs []) = L.foldr1' f xs  foldl1  f (Q (x:xs) ys) = revfoldl f (L.foldl f x xs) ys-foldl1  f (Q [] _) = error "SimpleQueue.foldl1: empty sequence"+foldl1  _ (Q [] _) = error "SimpleQueue.foldl1: empty sequence"  foldl1' f (Q (x:xs) ys) = revfoldl' f (L.foldl' f x xs) ys-foldl1' f (Q [] _) = error "SimpleQueue.foldl1': empty sequence"+foldl1' _ (Q [] _) = error "SimpleQueue.foldl1': empty sequence"  filter p (Q xs ys) = makeQ (L.filter p xs) (L.filter p ys) @@ -302,7 +306,7 @@ unzipWith = unzipWithUsingLists unzipWith3 = unzipWith3UsingLists --- invariant: +-- invariant: --   * front empty only if rear also empty  structuralInvariant (Q x y) = not (L.null x) || L.null y@@ -314,7 +318,7 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';@@ -332,7 +336,7 @@    zip3 = zip3; zipWith = zipWith; zipWith3 = zipWith3; unzip = unzip;    unzip3 = unzip3; unzipWith = unzipWith; unzipWith3 = unzipWith3;    strict = strict; strictWith = strictWith;-   structuralInvariant = structuralInvariant; instanceName s = moduleName}+   structuralInvariant = structuralInvariant; instanceName _ = moduleName}  instance Functor Seq where   fmap = map
src/Data/Edison/Seq/SizedSeq.hs view
@@ -1,6 +1,6 @@ -- | --   Module      :  Data.Edison.Seq.SizedSeq---   Copyright   :  Copyright (c) 1998-1999 Chris Okasaki+--   Copyright   :  Copyright (c) 1998-1999, 2008 Chris Okasaki --   License     :  MIT; see COPYRIGHT file for terms and conditions -- --   Maintainer  :  robdockins AT fastmail DOT fm@@ -46,7 +46,6 @@                        filter,takeWhile,dropWhile,lookup,take,drop,splitAt,                        zip,zip3,zipWith,zipWith3,unzip,unzip3,null) -import Data.Edison.Prelude import qualified Data.Edison.Seq as S import qualified Data.Edison.Seq.ListSeq as L import Data.Edison.Seq.Defaults -- only used by concatMap@@ -140,12 +139,12 @@   moduleName = "Data.Edison.Seq.SizedSeq"-instanceName (N n s) = "SizedSeq(" ++ S.instanceName s ++ ")"+instanceName (N _ s) = "SizedSeq(" ++ S.instanceName s ++ ")"  data Sized s a = N !Int (s a)  fromSeq xs = N (S.size xs) xs-toSeq (N n xs) = xs+toSeq (N _ xs) = xs  empty = N 0 S.empty singleton x = N 1 (S.singleton x)@@ -157,75 +156,75 @@                    Nothing     -> fail "SizedSeq.lview: empty sequence"                    Just (x,xs) -> return (x, N (n-1) xs) -lhead (N n xs) = S.lhead xs+lhead (N _ xs) = S.lhead xs -lheadM (N n xs) = S.lheadM xs+lheadM (N _ xs) = S.lheadM xs -ltail (N 0 xs) = error "SizedSeq.ltail: empty sequence"+ltail (N 0 _) = error "SizedSeq.ltail: empty sequence" ltail (N n xs) = N (n-1) (S.ltail xs) -ltailM (N 0 xs) = fail "SizedSeq.ltailM: empty sequence"+ltailM (N 0 _) = fail "SizedSeq.ltailM: empty sequence" ltailM (N n xs) = return (N (n-1) (S.ltail xs))  rview (N n xs) = case S.rview xs of                    Nothing     -> fail "SizedSeq.rview: empty sequence"                    Just (x,xs) -> return (x, N (n-1) xs)- -rhead (N n xs) = S.rhead xs -rheadM (N n xs) = S.rheadM xs+rhead (N _ xs) = S.rhead xs -rtail (N 0 xs) = error "SizedSeq.rtail: empty sequence"+rheadM (N _ xs) = S.rheadM xs++rtail (N 0 _) = error "SizedSeq.rtail: empty sequence" rtail (N n xs) = N (n-1) (S.rtail xs) -rtailM (N 0 xs) = fail "SizedSeq.rtailM: empty sequence"+rtailM (N 0 _) = fail "SizedSeq.rtailM: empty sequence" rtailM (N n xs) = return (N (n-1) (S.rtail xs)) -null (N n xs) = n == 0-size (N n xs) = n-concat (N n xss) = fromSeq (S.concat (S.map toSeq xss))+null (N n _) = n == 0+size (N n _) = n+concat (N _ xss) = fromSeq (S.concat (S.map toSeq xss)) reverse (N n xs) = N n (S.reverse xs) reverseOnto (N m xs) (N n ys) = N (m+n) (S.reverseOnto xs ys) fromList = fromSeq . S.fromList-toList (N n xs) = S.toList xs+toList (N _ xs) = S.toList xs map f (N n xs) = N n (S.map f xs)  concatMap = concatMapUsingFoldr -- only function that uses a default -fold  f e (N n xs) = S.fold f e xs-fold' f e (N n xs) = S.fold' f e xs-fold1 f  (N n xs) = S.fold1 f xs-fold1' f (N n xs) = S.fold1' f xs-foldr  f e (N n xs) = S.foldr f e xs-foldr' f e (N n xs) = S.foldr' f e xs-foldl  f e (N n xs) = S.foldl f e xs-foldl' f e (N n xs) = S.foldl' f e xs-foldr1  f (N n xs) = S.foldr1 f xs-foldr1' f (N n xs) = S.foldr1' f xs-foldl1  f (N n xs) = S.foldl1 f xs-foldl1' f (N n xs) = S.foldl1' f xs-reducer  f e (N n xs) = S.reducer f e xs-reducer' f e (N n xs) = S.reducer' f e xs-reducel  f e (N n xs) = S.reducel f e xs-reducel' f e (N n xs) = S.reducel' f e xs-reduce1  f (N n xs) = S.reduce1 f xs-reduce1' f (N n xs) = S.reduce1' f xs+fold  f e (N _ xs) = S.fold f e xs+fold' f e (N _ xs) = S.fold' f e xs+fold1 f  (N _ xs) = S.fold1 f xs+fold1' f (N _ xs) = S.fold1' f xs+foldr  f e (N _ xs) = S.foldr f e xs+foldr' f e (N _ xs) = S.foldr' f e xs+foldl  f e (N _ xs) = S.foldl f e xs+foldl' f e (N _ xs) = S.foldl' f e xs+foldr1  f (N _ xs) = S.foldr1 f xs+foldr1' f (N _ xs) = S.foldr1' f xs+foldl1  f (N _ xs) = S.foldl1 f xs+foldl1' f (N _ xs) = S.foldl1' f xs+reducer  f e (N _ xs) = S.reducer f e xs+reducer' f e (N _ xs) = S.reducer' f e xs+reducel  f e (N _ xs) = S.reducel f e xs+reducel' f e (N _ xs) = S.reducel' f e xs+reduce1  f (N _ xs) = S.reduce1 f xs+reduce1' f (N _ xs) = S.reduce1' f xs -copy n x +copy n x     | n <= 0 = empty     | otherwise = N n (S.copy n x) -inBounds i (N n xs) = (i >= 0) && (i < n)-lookup i (N n xs) = S.lookup i xs-lookupM i (N n xs) = S.lookupM i xs-lookupWithDefault d i (N n xs) = S.lookupWithDefault d i xs+inBounds i (N n _) = (i >= 0) && (i < n)+lookup i (N _ xs) = S.lookup i xs+lookupM i (N _ xs) = S.lookupM i xs+lookupWithDefault d i (N _ xs) = S.lookupWithDefault d i xs update i x (N n xs) = N n (S.update i x xs) adjust f i (N n xs) = N n (S.adjust f i xs) mapWithIndex f (N n xs) = N n (S.mapWithIndex f xs)-foldrWithIndex  f e (N n xs) = S.foldrWithIndex f e xs-foldrWithIndex' f e (N n xs) = S.foldrWithIndex' f e xs-foldlWithIndex  f e (N n xs) = S.foldlWithIndex f e xs-foldlWithIndex' f e (N n xs) = S.foldlWithIndex' f e xs+foldrWithIndex  f e (N _ xs) = S.foldrWithIndex f e xs+foldrWithIndex' f e (N _ xs) = S.foldrWithIndex' f e xs+foldlWithIndex  f e (N _ xs) = S.foldlWithIndex f e xs+foldlWithIndex' f e (N _ xs) = S.foldlWithIndex' f e xs  take i original@(N n xs)   | i <= 0 = empty@@ -280,8 +279,8 @@ unzipWith3 f g h (N n xyzs) = (N n xs, N n ys, N n zs)   where (xs,ys,zs) = S.unzipWith3 f g h xyzs -strict s@(N i s') = S.strict s' `seq` s-strictWith f s@(N i s') = S.strictWith f s' `seq` s+strict s@(N _ s') = S.strict s' `seq` s+strictWith f s@(N _ s') = S.strictWith f s' `seq` s  structuralInvariant (N i s) = i == S.size s @@ -292,7 +291,7 @@    lview = lview; lhead = lhead; ltail = ltail;    lheadM = lheadM; ltailM = ltailM; rheadM = rheadM; rtailM = rtailM;    rview = rview; rhead = rhead; rtail = rtail; null = null;-   size = size; concat = concat; reverse = reverse; +   size = size; concat = concat; reverse = reverse;    reverseOnto = reverseOnto; fromList = fromList; toList = toList;    fold = fold; fold' = fold'; fold1 = fold1; fold1' = fold1';    foldr = foldr; foldr' = foldr'; foldl = foldl; foldl' = foldl';@@ -339,7 +338,7 @@     | otherwise = L.concat ["(",moduleName,".fromSeq ",showsPrec 10 (toSeq xs) (')':rest)]  instance (S.Sequence s, Read (s a)) => Read (Sized s a) where-  readsPrec i xs = maybeParens p xs+  readsPrec _ xs = maybeParens p xs       where p xs = tokenMatch (moduleName++".fromSeq") xs                      >>= readsPrec 10                      >>= \(l,rest) -> return (fromSeq l, rest)