Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
262c142b
Commit
262c142b
authored
Jul 02, 2007
by
Ian Lynagh
Browse files
Remove mapAccumL, mapAccumR, mapAccumB
mapAccumL and mapAccumR are in Data.List now. mapAccumB is unused.
parent
00c8fa01
Changes
17
Hide whitespace changes
Inline
Side-by-side
compiler/codeGen/CgClosure.lhs
View file @
262c142b
...
...
@@ -46,6 +46,8 @@ import BasicTypes
import Constants
import Outputable
import FastString
import Data.List
\end{code}
%********************************************************
...
...
compiler/codeGen/CgHeapery.lhs
View file @
262c142b
...
...
@@ -45,6 +45,8 @@ import Util
import Constants
import PackageConfig
import Outputable
import Data.List
\end{code}
...
...
compiler/codeGen/CgMonad.lhs
View file @
262c142b
...
...
@@ -79,6 +79,7 @@ import FastString
import Outputable
import Control.Monad
import Data.List
infixr 9 `thenC` -- Right-associative!
infixr 9 `thenFC`
...
...
compiler/coreSyn/CoreSubst.lhs
View file @
262c142b
...
...
@@ -45,6 +45,8 @@ import Outputable
import PprCore () -- Instances
import Util
import FastTypes
import Data.List
\end{code}
...
...
compiler/coreSyn/CoreTidy.lhs
View file @
262c142b
...
...
@@ -26,6 +26,8 @@ import OccName
import SrcLoc
import Maybes
import Util
import Data.List
\end{code}
...
...
compiler/deSugar/DsArrows.lhs
View file @
262c142b
...
...
@@ -42,6 +42,8 @@ import Util
import HsUtils
import VarSet
import SrcLoc
import Data.List
\end{code}
\begin{code}
...
...
compiler/iface/BinIface.hs
View file @
262c142b
...
...
@@ -34,6 +34,7 @@ import Config
import
FastMutInt
import
Outputable
import
Data.List
import
Data.Word
import
Data.Array
import
Data.IORef
...
...
compiler/simplCore/CSE.lhs
View file @
262c142b
...
...
@@ -21,8 +21,10 @@ import CoreLint ( showPass, endPass )
import Outputable
import StaticFlags ( opt_PprStyle_Debug )
import BasicTypes ( isAlwaysActive )
import Util (
mapAccumL,
lengthExceeds )
import Util ( lengthExceeds )
import UniqFM
import Data.List
\end{code}
...
...
compiler/simplCore/OccurAnal.lhs
View file @
262c142b
...
...
@@ -35,8 +35,10 @@ import Digraph ( stronglyConnCompR, SCC(..) )
import PrelNames ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey )
import Unique ( Unique )
import UniqFM ( keysUFM, intersectsUFM )
import Util ( mapAndUnzip
, mapAccumL
)
import Util ( mapAndUnzip )
import Outputable
import Data.List
\end{code}
...
...
compiler/simplCore/SimplEnv.lhs
View file @
262c142b
...
...
@@ -58,6 +58,8 @@ import BasicTypes
import DynFlags
import Util
import Outputable
import Data.List
\end{code}
%************************************************************************
...
...
compiler/specialise/Rules.lhs
View file @
262c142b
...
...
@@ -45,7 +45,7 @@ import Maybes
import OrdList
import Bag
import Util
import
List hiding( mapAccumL ) -- Also defined in Util
import
Data.List
\end{code}
...
...
compiler/stranal/DmdAnal.lhs
View file @
262c142b
...
...
@@ -43,11 +43,13 @@ import UniqFM ( plusUFM_C, addToUFM_Directly, lookupUFM_Directly,
import Type ( isUnLiftedType, coreEqType, splitTyConApp_maybe )
import Coercion ( coercionKind )
import CoreLint ( showPass, endPass )
import Util ( mapAndUnzip,
mapAccumL, mapAccumR,
lengthIs )
import Util ( mapAndUnzip, lengthIs )
import BasicTypes ( Arity, TopLevelFlag(..), isTopLevel, isNeverActive,
RecFlag(..), isRec )
import Maybes ( orElse, expectJust )
import Outputable
import Data.List
\end{code}
To think about
...
...
compiler/typecheck/Inst.lhs
View file @
262c142b
...
...
@@ -76,6 +76,8 @@ import DynFlags
import Maybes
import Util
import Outputable
import Data.List
\end{code}
...
...
compiler/typecheck/TcTyClsDecls.lhs
View file @
262c142b
...
...
@@ -44,7 +44,7 @@ import ListSetOps
import Digraph
import DynFlags
import Data.List
( partition, elemIndex )
import Data.List
import Control.Monad ( mplus )
\end{code}
...
...
compiler/types/Type.lhs
View file @
262c142b
...
...
@@ -122,6 +122,7 @@ import Util
import Outputable
import UniqSet
import Data.List
import Data.Maybe ( isJust )
\end{code}
...
...
compiler/utils/ListSetOps.lhs
View file @
262c142b
...
...
@@ -24,9 +24,9 @@ module ListSetOps (
import Outputable
import Unique ( Unique )
import UniqFM ( eltsUFM, emptyUFM, addToUFM_C )
import Util ( isn'tIn, isIn,
mapAccumR,
sortLe )
import Util ( isn'tIn, isIn, sortLe )
import Data.List
( partition )
import Data.List
\end{code}
...
...
compiler/utils/Util.lhs
View file @
262c142b
...
...
@@ -32,7 +32,6 @@ module Util (
transitiveClosure,
-- accumulating
mapAccumL, mapAccumR, mapAccumB,
foldl2, count, all2,
takeList, dropList, splitAtList, split,
...
...
@@ -488,62 +487,6 @@ transitiveClosure succ eq xs
%* *
%************************************************************************
@mapAccumL@ behaves like a combination
of @map@ and @foldl@;
it applies a function to each element of a list, passing an accumulating
parameter from left to right, and returning a final value of this
accumulator together with the new list.
\begin{code}
mapAccumL :: (acc -> x -> (acc, y)) -- Function of elt of input list
-- and accumulator, returning new
-- accumulator and elt of result list
-> acc -- Initial accumulator
-> [x] -- Input list
-> (acc, [y]) -- Final accumulator and result list
mapAccumL f b [] = (b, [])
mapAccumL f b (x:xs) = (b'', x':xs') where
(b', x') = f b x
(b'', xs') = mapAccumL f b' xs
\end{code}
@mapAccumR@ does the same, but working from right to left instead. Its type is
the same as @mapAccumL@, though.
\begin{code}
mapAccumR :: (acc -> x -> (acc, y)) -- Function of elt of input list
-- and accumulator, returning new
-- accumulator and elt of result list
-> acc -- Initial accumulator
-> [x] -- Input list
-> (acc, [y]) -- Final accumulator and result list
mapAccumR f b [] = (b, [])
mapAccumR f b (x:xs) = (b'', x':xs') where
(b'', x') = f b' x
(b', xs') = mapAccumR f b xs
\end{code}
Here is the bi-directional version, that works from both left and right.
\begin{code}
mapAccumB :: (accl -> accr -> x -> (accl, accr,y))
-- Function of elt of input list
-- and accumulator, returning new
-- accumulator and elt of result list
-> accl -- Initial accumulator from left
-> accr -- Initial accumulator from right
-> [x] -- Input list
-> (accl, accr, [y]) -- Final accumulators and result list
mapAccumB f a b [] = (a,b,[])
mapAccumB f a b (x:xs) = (a'',b'',y:ys)
where
(a',b'',y) = f a b' x
(a'',b',ys) = mapAccumB f a' b xs
\end{code}
A strict version of foldl.
\begin{code}
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment