diff options
| author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2017-03-12 21:56:31 +0300 |
|---|---|---|
| committer | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2017-03-12 21:56:47 +0300 |
| commit | e5453a0e69911f135c192219189104bd0d2e3b5d (patch) | |
| tree | a457c8d70ed5a71ee715b4c56920878e99f39505 | |
| parent | 740ecda32116abe84b6d7d4786b3e2ad9c8ba2a4 (diff) | |
| download | haskell-e5453a0e69911f135c192219189104bd0d2e3b5d.tar.gz | |
Remove `runs` function which already exists in base
Reviewers: austin, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D3320
| -rw-r--r-- | compiler/deSugar/Match.hs | 4 | ||||
| -rw-r--r-- | compiler/deSugar/MatchCon.hs | 8 | ||||
| -rw-r--r-- | compiler/simplCore/CoreMonad.hs | 3 | ||||
| -rw-r--r-- | compiler/utils/ListSetOps.hs | 21 |
4 files changed, 9 insertions, 27 deletions
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs index 92f78bed33..692db8b036 100644 --- a/compiler/deSugar/Match.hs +++ b/compiler/deSugar/Match.hs @@ -39,7 +39,6 @@ import Coercion ( eqCoercion ) import TcType ( toTcTypeBag ) import TyCon( isNewTyCon ) import TysWiredIn -import ListSetOps import SrcLoc import Maybes import Util @@ -52,6 +51,7 @@ import UniqDFM import Control.Monad( when, unless ) import qualified Data.Map as Map +import Data.List (groupBy) {- ************************************************************************ @@ -887,7 +887,7 @@ groupEquations :: DynFlags -> [EquationInfo] -> [[(PatGroup, EquationInfo)]] -- (b) none of the gi are empty -- The ordering of equations is unchanged groupEquations dflags eqns - = runs same_gp [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns] + = groupBy same_gp [(patGroup dflags (firstPat eqn), eqn) | eqn <- eqns] where same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool (pg1,_) `same_gp` (pg2,_) = pg1 `sameGroup` pg2 diff --git a/compiler/deSugar/MatchCon.hs b/compiler/deSugar/MatchCon.hs index 4a7d1cd2b7..0e1aa802e9 100644 --- a/compiler/deSugar/MatchCon.hs +++ b/compiler/deSugar/MatchCon.hs @@ -22,7 +22,6 @@ import DsMonad import DsUtils import MkCore ( mkCoreLets ) import Util -import ListSetOps ( runs ) import Id import NameEnv import FieldLabel ( flSelector ) @@ -30,6 +29,7 @@ import SrcLoc import DynFlags import Outputable import Control.Monad(liftM) +import Data.List (groupBy) {- We are confronted with the first column of patterns in a set of @@ -153,8 +153,8 @@ matchOneConLike vars ty (eqn1 : eqns) -- All eqns for a single constructor -- Divide into sub-groups; see Note [Record patterns] ; let groups :: [[(ConArgPats, EquationInfo)]] - groups = runs compatible_pats [ (pat_args (firstPat eqn), eqn) - | eqn <- eqn1:eqns ] + groups = groupBy compatible_pats [ (pat_args (firstPat eqn), eqn) + | eqn <- eqn1:eqns ] ; match_results <- mapM (match_group arg_vars) groups @@ -245,7 +245,7 @@ Now consider: In the first we must test y first; in the second we must test x first. So we must divide even the equations for a single constructor T into sub-goups, based on whether they match the same field in the -same order. That's what the (runs compatible_pats) grouping. +same order. That's what the (groupBy compatible_pats) grouping. All non-record patterns are "compatible" in this sense, because the positional patterns (T a b) and (a `T` b) all match the arguments diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs index ac3e2c4fb9..209d0f8370 100644 --- a/compiler/simplCore/CoreMonad.hs +++ b/compiler/simplCore/CoreMonad.hs @@ -76,7 +76,6 @@ import UniqFM ( UniqFM, mapUFM, filterUFM ) import MonadUtils import NameCache import SrcLoc -import ListSetOps ( runs ) import Data.List import Data.Ord import Data.Dynamic @@ -348,7 +347,7 @@ pprTickCounts counts where groups :: [[(Tick,Int)]] -- Each group shares a comon tag -- toList returns common tags adjacent - groups = runs same_tag (Map.toList counts) + groups = groupBy same_tag (Map.toList counts) same_tag (tick1,_) (tick2,_) = tickToTag tick1 == tickToTag tick2 pprTickGroup :: [(Tick, Int)] -> SDoc diff --git a/compiler/utils/ListSetOps.hs b/compiler/utils/ListSetOps.hs index eaa79bd7fb..e5315ddfd4 100644 --- a/compiler/utils/ListSetOps.hs +++ b/compiler/utils/ListSetOps.hs @@ -14,7 +14,7 @@ module ListSetOps ( Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing, -- Duplicate handling - hasNoDups, runs, removeDups, findDupsEq, + hasNoDups, removeDups, findDupsEq, equivClasses, -- Indexing @@ -111,27 +111,10 @@ equivClasses :: (a -> a -> Ordering) -- Comparison equivClasses _ [] = [] equivClasses _ stuff@[_] = [stuff] -equivClasses cmp items = runs eq (sortBy cmp items) +equivClasses cmp items = groupBy eq (sortBy cmp items) where eq a b = case cmp a b of { EQ -> True; _ -> False } -{- -The first cases in @equivClasses@ above are just to cut to the point -more quickly... - -@runs@ groups a list into a list of lists, each sublist being a run of -identical elements of the input list. It is passed a predicate @p@ which -tells when two elements are equal. --} - -runs :: (a -> a -> Bool) -- Equality - -> [a] - -> [[a]] - -runs _ [] = [] -runs p (x:xs) = case (span (p x) xs) of - (first, rest) -> (x:first) : (runs p rest) - removeDups :: (a -> a -> Ordering) -- Comparison function -> [a] -> ([a], -- List with no duplicates |
