summaryrefslogtreecommitdiff
path: root/compiler/coreSyn
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/coreSyn')
-rw-r--r--compiler/coreSyn/CoreArity.hs3
-rw-r--r--compiler/coreSyn/CoreSubst.hs11
-rw-r--r--compiler/coreSyn/CoreSyn.hs9
-rw-r--r--compiler/coreSyn/CoreUtils.hs4
-rw-r--r--compiler/coreSyn/TrieMap.hs5
5 files changed, 18 insertions, 14 deletions
diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs
index 59c261bfeb..ed46c89fb4 100644
--- a/compiler/coreSyn/CoreArity.hs
+++ b/compiler/coreSyn/CoreArity.hs
@@ -34,6 +34,7 @@ import Outputable
import FastString
import Pair
import Util ( debugIsOn )
+import Data.Foldable ( foldl' )
{-
************************************************************************
@@ -884,7 +885,7 @@ etaExpand n orig_expr
-- See Note [Eta expansion and source notes]
(expr', args) = collectArgs expr
(ticks, expr'') = stripTicksTop tickishFloatable expr'
- sexpr = foldl App expr'' args
+ sexpr = foldl' App expr'' args
retick expr = foldr mkTick expr ticks
-- Wrapper Unwrapper
diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs
index 1f60e7cd1f..8bc9cb6197 100644
--- a/compiler/coreSyn/CoreSubst.hs
+++ b/compiler/coreSyn/CoreSubst.hs
@@ -7,6 +7,7 @@ Utility functions on @Core@ syntax
-}
{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
module CoreSubst (
-- * Main data types
Subst(..), -- Implementation exported for supercompiler's Renaming.hs only
@@ -898,9 +899,9 @@ simpleOptPgm dflags this_mod binds rules vects
where
occ_anald_binds = occurAnalysePgm this_mod (\_ -> False) {- No rules active -}
rules vects emptyVarEnv binds
- (subst', binds') = foldl do_one (emptySubst, []) occ_anald_binds
+ (subst', binds') = foldl' do_one (emptySubst, []) occ_anald_binds
- do_one (subst, binds') bind
+ do_one (!subst, !binds') bind
= case simple_opt_bind subst bind of
(subst', Nothing) -> (subst', binds')
(subst', Just bind') -> (subst', bind':binds')
@@ -1006,7 +1007,7 @@ simple_app subst (Tick t e) as
| t `tickishScopesLike` SoftScope
= mkTick t $ simple_app subst e as
simple_app subst e as
- = foldl App (simple_opt_expr subst e) as
+ = foldl' App (simple_opt_expr subst e) as
----------------------
simple_opt_bind,simple_opt_bind' :: Subst -> CoreBind -> (Subst, Maybe CoreBind)
@@ -1018,8 +1019,8 @@ simple_opt_bind' subst (Rec prs)
where
res_bind = Just (Rec (reverse rev_prs'))
(subst', bndrs') = subst_opt_bndrs subst (map fst prs)
- (subst'', rev_prs') = foldl do_pr (subst', []) (prs `zip` bndrs')
- do_pr (subst, prs) ((b,r), b')
+ (subst'', rev_prs') = foldl' do_pr (subst', []) (prs `zip` bndrs')
+ do_pr (!subst, !prs) ((b,r), b')
= case maybe_substitute subst b r2 of
Just subst' -> (subst', prs)
Nothing -> (subst, (b2,r2):prs)
diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index 432f242586..c777f627e6 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -108,6 +108,7 @@ import SrcLoc ( RealSrcSpan, containsSpan )
import Binary
import Data.Data hiding (TyCon)
+import Data.Foldable ( foldl' )
import Data.Int
import Data.Word
@@ -1457,12 +1458,12 @@ mkVarApps :: Expr b -> [Var] -> Expr b
-- use 'MkCore.mkCoreConApps' if possible
mkConApp :: DataCon -> [Arg b] -> Expr b
-mkApps f args = foldl App f args
-mkCoApps f args = foldl (\ e a -> App e (Coercion a)) f args
-mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
+mkApps f args = foldl' App f args
+mkCoApps f args = foldl' (\ e a -> App e (Coercion a)) f args
+mkVarApps f vars = foldl' (\ e a -> App e (varToCoreExpr a)) f vars
mkConApp con args = mkApps (Var (dataConWorkId con)) args
-mkTyApps f args = foldl (\ e a -> App e (typeOrCoercion a)) f args
+mkTyApps f args = foldl' (\ e a -> App e (typeOrCoercion a)) f args
where
typeOrCoercion ty
| Just co <- isCoercionTy_maybe ty = Coercion co
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 887c313f71..cc1d4c7e0f 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -964,8 +964,8 @@ exprIsWorkFree e = go 0 e
go _ (Type {}) = True
go _ (Coercion {}) = True
go n (Cast e _) = go n e
- go n (Case scrut _ _ alts) = foldl (&&) (exprIsWorkFree scrut)
- [ go n rhs | (_,_,rhs) <- alts ]
+ go n (Case scrut _ _ alts) = exprIsWorkFree scrut
+ && and [ go n rhs | (_,_,rhs) <- alts ]
-- See Note [Case expressions are work-free]
go _ (Let {}) = False
go n (Var v) = isCheapApp v n
diff --git a/compiler/coreSyn/TrieMap.hs b/compiler/coreSyn/TrieMap.hs
index fbff260055..afee992e4c 100644
--- a/compiler/coreSyn/TrieMap.hs
+++ b/compiler/coreSyn/TrieMap.hs
@@ -29,6 +29,7 @@ import UniqDFM
import Unique( Unique )
import FastString(FastString)
+import Data.Foldable ( foldl' )
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import VarEnv
@@ -792,7 +793,7 @@ data TypeMapX a
-- to nested AppTys. Why the last one? See Note [Equality on AppTys] in Type
trieMapView :: Type -> Maybe Type
trieMapView ty | Just ty' <- coreViewOneStarKind ty = Just ty'
-trieMapView (TyConApp tc tys@(_:_)) = Just $ foldl AppTy (TyConApp tc []) tys
+trieMapView (TyConApp tc tys@(_:_)) = Just $ foldl' AppTy (TyConApp tc []) tys
trieMapView (ForAllTy (Anon arg) res)
= Just ((TyConApp funTyCon [] `AppTy` arg) `AppTy` res)
trieMapView _ = Nothing
@@ -1008,7 +1009,7 @@ extendCME (CME { cme_next = bv, cme_env = env }) v
= CME { cme_next = bv+1, cme_env = extendVarEnv env v bv }
extendCMEs :: CmEnv -> [Var] -> CmEnv
-extendCMEs env vs = foldl extendCME env vs
+extendCMEs env vs = foldl' extendCME env vs
lookupCME :: CmEnv -> Var -> Maybe BoundVar
lookupCME (CME { cme_env = env }) v = lookupVarEnv env v
View Lorry Controller Status