From c7cc711d5b215889eed7e821093fa50c005d62fe Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 13 Jan 2008 15:00:17 +0000 Subject: [PATCH] Fix warnings in utils/ListSetOps --- compiler/utils/ListSetOps.lhs | 174 +++++++++++++++++++---------------------- 1 file changed, 81 insertions(+), 93 deletions(-) diff --git a/compiler/utils/ListSetOps.lhs b/compiler/utils/ListSetOps.lhs index 2d972a9..f5e0eae 100644 --- a/compiler/utils/ListSetOps.lhs +++ b/compiler/utils/ListSetOps.lhs @@ -5,50 +5,41 @@ \section[ListSetOps]{Set-like operations on lists} \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 ListSetOps ( - unionLists, minusList, insertList, + unionLists, minusList, insertList, - -- Association lists - Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, - emptyAssoc, unitAssoc, mapAssoc, plusAssoc_C, extendAssoc_C, - mkLookupFun, findInList, assocElts, + -- Association lists + Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, + emptyAssoc, unitAssoc, mapAssoc, plusAssoc_C, extendAssoc_C, + mkLookupFun, findInList, assocElts, - -- Duplicate handling - hasNoDups, runs, removeDups, findDupsEq, - equivClasses, equivClassesByUniq + -- Duplicate handling + hasNoDups, runs, removeDups, findDupsEq, + equivClasses, equivClassesByUniq ) where -#include "HsVersions.h" - import Outputable -import Unique ( Unique ) -import UniqFM ( eltsUFM, emptyUFM, addToUFM_C ) -import Util ( isn'tIn, isIn, sortLe ) +import Unique +import UniqFM +import Util import Data.List \end{code} %************************************************************************ -%* * - Treating lists as sets - Assumes the lists contain no duplicates, but are unordered -%* * +%* * + Treating lists as sets + Assumes the lists contain no duplicates, but are unordered +%* * %************************************************************************ \begin{code} insertList :: Eq a => a -> [a] -> [a] -- Assumes the arg list contains no dups; guarantees the result has no dups insertList x xs | isIn "insert" x xs = xs - | otherwise = x : xs + | otherwise = x : xs unionLists :: (Eq a) => [a] -> [a] -> [a] -- Assumes that the arguments contain no duplicates @@ -61,39 +52,39 @@ minusList xs ys = [ x | x <- xs, isn'tIn "minusList" x ys] %************************************************************************ -%* * +%* * \subsection[Utils-assoc]{Association lists} -%* * +%* * %************************************************************************ Inefficient finite maps based on association lists and equality. \begin{code} -type Assoc a b = [(a,b)] -- A finite mapping based on equality and association lists - -emptyAssoc :: Assoc a b -unitAssoc :: a -> b -> Assoc a b -assocElts :: Assoc a b -> [(a,b)] -assoc :: (Eq a) => String -> Assoc a b -> a -> b -assocDefault :: (Eq a) => b -> Assoc a b -> a -> b -assocUsing :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b -assocMaybe :: (Eq a) => Assoc a b -> a -> Maybe b +-- A finite mapping based on equality and association lists +type Assoc a b = [(a,b)] + +emptyAssoc :: Assoc a b +unitAssoc :: a -> b -> Assoc a b +assocElts :: Assoc a b -> [(a,b)] +assoc :: (Eq a) => String -> Assoc a b -> a -> b +assocDefault :: (Eq a) => b -> Assoc a b -> a -> b +assocUsing :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b +assocMaybe :: (Eq a) => Assoc a b -> a -> Maybe b assocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b -mapAssoc :: (b -> c) -> Assoc a b -> Assoc a c -extendAssoc_C :: (Eq a) => (b -> b -> b) -> Assoc a b -> (a,b) -> Assoc a b -plusAssoc_C :: (Eq a) => (b -> b -> b) -> Assoc a b -> Assoc a b -> Assoc a b - -- combining fn takes (old->new->result) +mapAssoc :: (b -> c) -> Assoc a b -> Assoc a c +extendAssoc_C :: (Eq a) => (b -> b -> b) -> Assoc a b -> (a,b) -> Assoc a b +plusAssoc_C :: (Eq a) => (b -> b -> b) -> Assoc a b -> Assoc a b -> Assoc a b + -- combining fn takes (old->new->result) emptyAssoc = [] unitAssoc a b = [(a,b)] assocElts xs = xs +assocDefaultUsing _ deflt [] _ = deflt assocDefaultUsing eq deflt ((k,v) : rest) key | k `eq` key = v | otherwise = assocDefaultUsing eq deflt rest key -assocDefaultUsing eq deflt [] key = deflt - assoc crash_msg list key = assocDefaultUsing (==) (panic ("Failed in assoc: " ++ crash_msg)) list key assocDefault deflt list key = assocDefaultUsing (==) deflt list key assocUsing eq crash_msg list key = assocDefaultUsing eq (panic ("Failed in assoc: " ++ crash_msg)) list key @@ -101,21 +92,21 @@ assocUsing eq crash_msg list key = assocDefaultUsing eq (panic ("Failed in assoc assocMaybe alist key = lookup alist where - lookup [] = Nothing + lookup [] = Nothing lookup ((tv,ty):rest) = if key == tv then Just ty else lookup rest mapAssoc f alist = [(key, f val) | (key,val) <- alist] -plusAssoc_C combine [] new = new -- Shortcut for common case +plusAssoc_C _ [] new = new -- Shortcut for common case plusAssoc_C combine old new = foldl (extendAssoc_C combine) old new extendAssoc_C combine old_list (new_key, new_val) = go old_list where go [] = [(new_key, new_val)] - go ((old_key, old_val) : old_list) - | new_key == old_key = ((old_key, old_val `combine` new_val) : old_list) - | otherwise = (old_key, old_val) : go old_list + go ((old_key, old_val) : old_list) + | new_key == old_key = ((old_key, old_val `combine` new_val) : old_list) + | otherwise = (old_key, old_val) : go old_list \end{code} @@ -125,10 +116,10 @@ its argument in the association list @alist@, returning a Maybe type. on failure. \begin{code} -mkLookupFun :: (key -> key -> Bool) -- Equality predicate - -> [(key,val)] -- The assoc list - -> key -- The key - -> Maybe val -- The corresponding value +mkLookupFun :: (key -> key -> Bool) -- Equality predicate + -> [(key,val)] -- The assoc list + -> key -- The key + -> Maybe val -- The corresponding value mkLookupFun eq alist s = case [a | (s',a) <- alist, s' `eq` s] of @@ -136,16 +127,16 @@ mkLookupFun eq alist s (a:_) -> Just a findInList :: (a -> Bool) -> [a] -> Maybe a -findInList p [] = Nothing -findInList p (x:xs) | p x = Just x - | otherwise = findInList p xs +findInList _ [] = Nothing +findInList p (x:xs) | p x = Just x + | otherwise = findInList p xs \end{code} %************************************************************************ -%* * +%* * \subsection[Utils-dups]{Duplicate-handling} -%* * +%* * %************************************************************************ \begin{code} @@ -153,24 +144,22 @@ hasNoDups :: (Eq a) => [a] -> Bool hasNoDups xs = f [] xs where - f seen_so_far [] = True - f seen_so_far (x:xs) = if x `is_elem` seen_so_far then - False - else - f (x:seen_so_far) xs + f _ [] = True + f seen_so_far (x:xs) = if x `is_elem` seen_so_far + then False + else f (x:seen_so_far) xs is_elem = isIn "hasNoDups" \end{code} \begin{code} -equivClasses :: (a -> a -> Ordering) -- Comparison - -> [a] - -> [[a]] - -equivClasses cmp stuff@[] = [] -equivClasses cmp stuff@[item] = [stuff] -equivClasses cmp items - = runs eq (sortLe le items) +equivClasses :: (a -> a -> Ordering) -- Comparison + -> [a] + -> [[a]] + +equivClasses _ [] = [] +equivClasses _ stuff@[_] = [stuff] +equivClasses cmp items = runs eq (sortLe le items) where eq a b = case cmp a b of { EQ -> True; _ -> False } le a b = case cmp a b of { LT -> True; EQ -> True; GT -> False } @@ -184,48 +173,48 @@ identical elements of the input list. It is passed a predicate @p@ which tells when two elements are equal. \begin{code} -runs :: (a -> a -> Bool) -- Equality +runs :: (a -> a -> Bool) -- Equality -> [a] -> [[a]] -runs p [] = [] +runs _ [] = [] runs p (x:xs) = case (span (p x) xs) of - (first, rest) -> (x:first) : (runs p rest) + (first, rest) -> (x:first) : (runs p rest) \end{code} \begin{code} -removeDups :: (a -> a -> Ordering) -- Comparison function - -> [a] - -> ([a], -- List with no duplicates - [[a]]) -- List of duplicate groups. One representative from - -- each group appears in the first result - -removeDups cmp [] = ([], []) -removeDups cmp [x] = ([x],[]) +removeDups :: (a -> a -> Ordering) -- Comparison function + -> [a] + -> ([a], -- List with no duplicates + [[a]]) -- List of duplicate groups. One representative from + -- each group appears in the first result + +removeDups _ [] = ([], []) +removeDups _ [x] = ([x],[]) removeDups cmp xs = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') -> (xs', dups) } where - collect_dups dups_so_far [x] = (dups_so_far, x) - collect_dups dups_so_far dups@(x:xs) = (dups:dups_so_far, x) + collect_dups _ [] = panic "ListSetOps: removeDups" + collect_dups dups_so_far [x] = (dups_so_far, x) + collect_dups dups_so_far dups@(x:_) = (dups:dups_so_far, x) findDupsEq :: (a->a->Bool) -> [a] -> [[a]] -findDupsEq eq [] = [] +findDupsEq _ [] = [] findDupsEq eq (x:xs) | null eq_xs = findDupsEq eq xs - | otherwise = (x:eq_xs) : findDupsEq eq neq_xs - where - (eq_xs, neq_xs) = partition (eq x) xs + | otherwise = (x:eq_xs) : findDupsEq eq neq_xs + where (eq_xs, neq_xs) = partition (eq x) xs \end{code} \begin{code} equivClassesByUniq :: (a -> Unique) -> [a] -> [[a]] - -- NB: it's *very* important that if we have the input list [a,b,c], - -- where a,b,c all have the same unique, then we get back the list - -- [a,b,c] - -- not - -- [c,b,a] - -- Hence the use of foldr, plus the reversed-args tack_on below + -- NB: it's *very* important that if we have the input list [a,b,c], + -- where a,b,c all have the same unique, then we get back the list + -- [a,b,c] + -- not + -- [c,b,a] + -- Hence the use of foldr, plus the reversed-args tack_on below equivClassesByUniq get_uniq xs = eltsUFM (foldr add emptyUFM xs) where @@ -233,4 +222,3 @@ equivClassesByUniq get_uniq xs tack_on old new = new++old \end{code} - -- 1.7.10.4