From e4cdbb7b821b1ee6dfb0d7a5ef7275edab6a0520 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 13 Jan 2008 00:20:37 +0000 Subject: [PATCH] Fix warnings in utils/Bag.lhs --- compiler/utils/Bag.lhs | 154 ++++++++++++++++++++++++------------------------ 1 file changed, 76 insertions(+), 78 deletions(-) diff --git a/compiler/utils/Bag.lhs b/compiler/utils/Bag.lhs index 2e50e00..e53d23d 100644 --- a/compiler/utils/Bag.lhs +++ b/compiler/utils/Bag.lhs @@ -6,48 +6,41 @@ Bag: an unordered collection with duplicates \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module Bag ( - Bag, -- abstract type - - emptyBag, unitBag, unionBags, unionManyBags, - mapBag, - elemBag, - filterBag, partitionBag, concatBag, foldBag, foldrBag, foldlBag, - isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, - listToBag, bagToList, - mapBagM, mapAndUnzipBagM + Bag, -- abstract type + + emptyBag, unitBag, unionBags, unionManyBags, + mapBag, + elemBag, + filterBag, partitionBag, concatBag, foldBag, foldrBag, foldlBag, + isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, + listToBag, bagToList, + mapBagM, mapAndUnzipBagM ) where -#include "HsVersions.h" - import Outputable -import Util ( isSingleton ) +import Util ( isSingleton ) -import Data.List ( partition ) +import Data.List ( partition ) \end{code} \begin{code} data Bag a = EmptyBag - | UnitBag a - | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty - | ListBag [a] -- INVARIANT: the list is non-empty + | UnitBag a + | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty + | ListBag [a] -- INVARIANT: the list is non-empty +emptyBag :: Bag a emptyBag = EmptyBag + +unitBag :: a -> Bag a unitBag = UnitBag elemBag :: Eq a => a -> Bag a -> Bool - -elemBag x EmptyBag = False -elemBag x (UnitBag y) = x==y +elemBag _ EmptyBag = False +elemBag x (UnitBag y) = x == y elemBag x (TwoBags b1 b2) = x `elemBag` b1 || x `elemBag` b2 elemBag x (ListBag ys) = any (x ==) ys @@ -67,54 +60,54 @@ snocBag :: Bag a -> a -> Bag a consBag elt bag = (unitBag elt) `unionBags` bag snocBag bag elt = bag `unionBags` (unitBag elt) +isEmptyBag :: Bag a -> Bool isEmptyBag EmptyBag = True -isEmptyBag other = False -- NB invariants +isEmptyBag _ = False -- NB invariants isSingletonBag :: Bag a -> Bool -isSingletonBag EmptyBag = False -isSingletonBag (UnitBag x) = True -isSingletonBag (TwoBags b1 b2) = False -- Neither is empty -isSingletonBag (ListBag xs) = isSingleton xs +isSingletonBag EmptyBag = False +isSingletonBag (UnitBag _) = True +isSingletonBag (TwoBags _ _) = False -- Neither is empty +isSingletonBag (ListBag xs) = isSingleton xs filterBag :: (a -> Bool) -> Bag a -> Bag a -filterBag pred EmptyBag = EmptyBag +filterBag _ EmptyBag = EmptyBag filterBag pred b@(UnitBag val) = if pred val then b else EmptyBag filterBag pred (TwoBags b1 b2) = sat1 `unionBags` sat2 - where - sat1 = filterBag pred b1 - sat2 = filterBag pred b2 + where sat1 = filterBag pred b1 + sat2 = filterBag pred b2 filterBag pred (ListBag vs) = listToBag (filter pred vs) anyBag :: (a -> Bool) -> Bag a -> Bool -anyBag p EmptyBag = False +anyBag _ EmptyBag = False anyBag p (UnitBag v) = p v anyBag p (TwoBags b1 b2) = anyBag p b1 || anyBag p b2 anyBag p (ListBag xs) = any p xs concatBag :: Bag (Bag a) -> Bag a -concatBag EmptyBag = EmptyBag -concatBag (UnitBag b) = b -concatBag (TwoBags b1 b2) = concatBag b1 `unionBags` concatBag b2 -concatBag (ListBag bs) = unionManyBags bs +concatBag EmptyBag = EmptyBag +concatBag (UnitBag b) = b +concatBag (TwoBags b1 b2) = concatBag b1 `unionBags` concatBag b2 +concatBag (ListBag bs) = unionManyBags bs partitionBag :: (a -> Bool) -> Bag a -> (Bag a {- Satisfy predictate -}, - Bag a {- Don't -}) -partitionBag pred EmptyBag = (EmptyBag, EmptyBag) -partitionBag pred b@(UnitBag val) = if pred val then (b, EmptyBag) else (EmptyBag, b) -partitionBag pred (TwoBags b1 b2) = (sat1 `unionBags` sat2, fail1 `unionBags` fail2) - where - (sat1,fail1) = partitionBag pred b1 - (sat2,fail2) = partitionBag pred b2 -partitionBag pred (ListBag vs) = (listToBag sats, listToBag fails) - where - (sats,fails) = partition pred vs - - -foldBag :: (r -> r -> r) -- Replace TwoBags with this; should be associative - -> (a -> r) -- Replace UnitBag with this - -> r -- Replace EmptyBag with this - -> Bag a - -> r + Bag a {- Don't -}) +partitionBag _ EmptyBag = (EmptyBag, EmptyBag) +partitionBag pred b@(UnitBag val) + = if pred val then (b, EmptyBag) else (EmptyBag, b) +partitionBag pred (TwoBags b1 b2) + = (sat1 `unionBags` sat2, fail1 `unionBags` fail2) + where (sat1, fail1) = partitionBag pred b1 + (sat2, fail2) = partitionBag pred b2 +partitionBag pred (ListBag vs) = (listToBag sats, listToBag fails) + where (sats, fails) = partition pred vs + + +foldBag :: (r -> r -> r) -- Replace TwoBags with this; should be associative + -> (a -> r) -- Replace UnitBag with this + -> r -- Replace EmptyBag with this + -> Bag a + -> r {- Standard definition foldBag t u e EmptyBag = e @@ -124,51 +117,56 @@ foldBag t u e (ListBag xs) = foldr (t.u) e xs -} -- More tail-recursive definition, exploiting associativity of "t" -foldBag t u e EmptyBag = e +foldBag _ _ e EmptyBag = e foldBag t u e (UnitBag x) = u x `t` e foldBag t u e (TwoBags b1 b2) = foldBag t u (foldBag t u e b2) b1 foldBag t u e (ListBag xs) = foldr (t.u) e xs foldrBag :: (a -> r -> r) -> r - -> Bag a - -> r + -> Bag a + -> r -foldrBag k z EmptyBag = z +foldrBag _ z EmptyBag = z foldrBag k z (UnitBag x) = k x z foldrBag k z (TwoBags b1 b2) = foldrBag k (foldrBag k z b2) b1 foldrBag k z (ListBag xs) = foldr k z xs foldlBag :: (r -> a -> r) -> r - -> Bag a - -> r + -> Bag a + -> r -foldlBag k z EmptyBag = z +foldlBag _ z EmptyBag = z foldlBag k z (UnitBag x) = k z x foldlBag k z (TwoBags b1 b2) = foldlBag k (foldlBag k z b1) b2 foldlBag k z (ListBag xs) = foldl k z xs mapBag :: (a -> b) -> Bag a -> Bag b -mapBag f EmptyBag = EmptyBag +mapBag _ EmptyBag = EmptyBag mapBag f (UnitBag x) = UnitBag (f x) -mapBag f (TwoBags b1 b2) = TwoBags (mapBag f b1) (mapBag f b2) +mapBag f (TwoBags b1 b2) = TwoBags (mapBag f b1) (mapBag f b2) mapBag f (ListBag xs) = ListBag (map f xs) mapBagM :: Monad m => (a -> m b) -> Bag a -> m (Bag b) -mapBagM f EmptyBag = return EmptyBag -mapBagM f (UnitBag x) = do { r <- f x; return (UnitBag r) } -mapBagM f (TwoBags b1 b2) = do { r1 <- mapBagM f b1; r2 <- mapBagM f b2; return (TwoBags r1 r2) } -mapBagM f (ListBag xs) = do { rs <- mapM f xs; return (ListBag rs) } +mapBagM _ EmptyBag = return EmptyBag +mapBagM f (UnitBag x) = do r <- f x + return (UnitBag r) +mapBagM f (TwoBags b1 b2) = do r1 <- mapBagM f b1 + r2 <- mapBagM f b2 + return (TwoBags r1 r2) +mapBagM f (ListBag xs) = do rs <- mapM f xs + return (ListBag rs) mapAndUnzipBagM :: Monad m => (a -> m (b,c)) -> Bag a -> m (Bag b, Bag c) -mapAndUnzipBagM f EmptyBag = return (EmptyBag, EmptyBag) -mapAndUnzipBagM f (UnitBag x) = do { (r,s) <- f x; return (UnitBag r, UnitBag s) } -mapAndUnzipBagM f (TwoBags b1 b2) = do { (r1,s1) <- mapAndUnzipBagM f b1 - ; (r2,s2) <- mapAndUnzipBagM f b2 - ; return (TwoBags r1 r2, TwoBags s1 s2) } -mapAndUnzipBagM f (ListBag xs) = do { ts <- mapM f xs - ; let (rs,ss) = unzip ts - ; return (ListBag rs, ListBag ss) } +mapAndUnzipBagM _ EmptyBag = return (EmptyBag, EmptyBag) +mapAndUnzipBagM f (UnitBag x) = do (r,s) <- f x + return (UnitBag r, UnitBag s) +mapAndUnzipBagM f (TwoBags b1 b2) = do (r1,s1) <- mapAndUnzipBagM f b1 + (r2,s2) <- mapAndUnzipBagM f b2 + return (TwoBags r1 r2, TwoBags s1 s2) +mapAndUnzipBagM f (ListBag xs) = do ts <- mapM f xs + let (rs,ss) = unzip ts + return (ListBag rs, ListBag ss) listToBag :: [a] -> Bag a listToBag [] = EmptyBag -- 1.7.10.4