summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2023-01-10 19:41:43 +0100
committerKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2023-01-10 19:44:11 +0100
commit627a288b216defe0d66efc060b79db4fbd8c47e5 (patch)
tree43c06b59c290874263ba31b7f3099bb3407bcf38
parent146a145835f5c2e82da4dd0bcb90702460505a01 (diff)
downloadhaskell-wip/misc-cleanup4.tar.gz
Misc cleanupwip/misc-cleanup4
- Remove unused mkWildEvBinder - Use typeTypeOrConstraint - more symmetric and asserts that that the type is Type or Constraint - Fix escape sequences in Python; they raise a deprecation warning with -Wdefault
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs3
-rw-r--r--compiler/GHC/Core/Make.hs17
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap.hs4
-rw-r--r--compiler/GHC/Core/Type.hs2
-rw-r--r--compiler/GHC/HsToCore/Utils.hs14
-rw-r--r--compiler/GHC/Tc/Validity.hs3
-rw-r--r--testsuite/driver/runtests.py2
-rw-r--r--testsuite/tests/cabal/all.T2
-rw-r--r--testsuite/tests/cmm/should_compile/all.T2
-rw-r--r--testsuite/tests/codeGen/should_compile/all.T8
-rw-r--r--testsuite/tests/simplStg/should_compile/all.T2
-rw-r--r--testsuite/tests/stranal/sigs/all.T2
12 files changed, 24 insertions, 37 deletions
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
index f15f9ff4ba..5cf7565495 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
@@ -199,8 +199,7 @@ joinToTargets_again
(return ())
-}
delta <- getDeltaR
- fixUpInstrs_ <- mapM (handleComponent delta instr) sccs
- let fixUpInstrs = concat fixUpInstrs_
+ fixUpInstrs <- concatMapM (handleComponent delta instr) sccs
-- make a new basic block containing the fixup code.
-- A the end of the current block we will jump to the fixup one,
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index 2d567786ea..abd28baa47 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -6,7 +6,7 @@ module GHC.Core.Make (
mkCoreLet, mkCoreLets,
mkCoreApp, mkCoreApps, mkCoreConApps,
mkCoreLams, mkWildCase, mkIfThenElse,
- mkWildValBinder, mkWildEvBinder,
+ mkWildValBinder,
mkSingleAltCase,
sortQuantVars, castBottomExpr,
@@ -54,7 +54,7 @@ import GHC.Prelude
import GHC.Platform
import GHC.Types.Id
-import GHC.Types.Var ( EvVar, setTyVarUnique, visArgConstraintLike )
+import GHC.Types.Var ( setTyVarUnique, visArgConstraintLike )
import GHC.Types.TyThing
import GHC.Types.Id.Info
import GHC.Types.Cpr
@@ -173,9 +173,6 @@ mkCoreAppTyped d (fun, fun_ty) arg
* *
********************************************************************* -}
-mkWildEvBinder :: PredType -> EvVar
-mkWildEvBinder pred = mkWildValBinder ManyTy pred
-
-- | Make a /wildcard binder/. This is typically used when you need a binder
-- that you expect to use only at a *binding* site. Do not use it at
-- occurrence sites because it has a single, fixed unique, and it's very
@@ -1082,8 +1079,9 @@ mkImpossibleExpr :: Type -> String -> CoreExpr
mkImpossibleExpr res_ty str
= mkRuntimeErrorApp err_id res_ty str
where -- See Note [Type vs Constraint for error ids]
- err_id | isConstraintLikeKind (typeKind res_ty) = iMPOSSIBLE_CONSTRAINT_ERROR_ID
- | otherwise = iMPOSSIBLE_ERROR_ID
+ err_id = case typeTypeOrConstraint res_ty of
+ TypeLike -> iMPOSSIBLE_ERROR_ID
+ ConstraintLike -> iMPOSSIBLE_CONSTRAINT_ERROR_ID
{- Note [Type vs Constraint for error ids]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1207,8 +1205,9 @@ mkAbsentErrorApp :: Type -- The type to instantiate 'a'
mkAbsentErrorApp res_ty err_msg
= mkApps (Var err_id) [ Type res_ty, err_string ]
where
- err_id | isConstraintLikeKind (typeKind res_ty) = aBSENT_CONSTRAINT_ERROR_ID
- | otherwise = aBSENT_ERROR_ID
+ err_id = case typeTypeOrConstraint res_ty of
+ TypeLike -> aBSENT_ERROR_ID
+ ConstraintLike -> aBSENT_CONSTRAINT_ERROR_ID
err_string = Lit (mkLitString err_msg)
absentErrorName, absentConstraintErrorName :: Name
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 1ed95703af..29f1e3973f 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -68,9 +68,7 @@ info for exported values).
wwTopBinds :: WwOpts -> UniqSupply -> CoreProgram -> CoreProgram
wwTopBinds ww_opts us top_binds
- = initUs_ us $ do
- top_binds' <- mapM (wwBind ww_opts) top_binds
- return (concat top_binds')
+ = initUs_ us $ concatMapM (wwBind ww_opts) top_binds
{-
************************************************************************
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index e16ff2faa6..c35c534dea 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -770,7 +770,7 @@ isBoxedRuntimeRep rep = isJust (isBoxedRuntimeRep_maybe rep)
-- expands to `Boxed lev` and returns `Nothing` otherwise.
--
-- Types with this runtime rep are represented by pointers on the GC'd heap.
-isBoxedRuntimeRep_maybe :: RuntimeRepType -> Maybe Type
+isBoxedRuntimeRep_maybe :: RuntimeRepType -> Maybe LevityType
isBoxedRuntimeRep_maybe rep
| Just (rr_tc, args) <- splitRuntimeRep_maybe rep
, rr_tc `hasKey` boxedRepDataConKey
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index f919a422c5..a64c8b74bc 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -81,7 +81,6 @@ import GHC.Types.Tickish
import GHC.Utils.Misc
import GHC.Driver.Session
import GHC.Driver.Ppr
-import GHC.Data.FastString
import qualified GHC.LanguageExtensions as LangExt
import GHC.Tc.Types.Evidence
@@ -995,19 +994,10 @@ mkOptTickBox = flip (foldr Tick)
mkBinaryTickBox :: Int -> Int -> CoreExpr -> DsM CoreExpr
mkBinaryTickBox ixT ixF e = do
- uq <- newUnique
this_mod <- getModule
- let bndr1 = mkSysLocal (fsLit "t1") uq OneTy boolTy
- -- It's always sufficient to pattern-match on a boolean with
- -- multiplicity 'One'.
- let
+ let trueBox = Tick (HpcTick this_mod ixT) (Var trueDataConId)
falseBox = Tick (HpcTick this_mod ixF) (Var falseDataConId)
- trueBox = Tick (HpcTick this_mod ixT) (Var trueDataConId)
- --
- return $ Case e bndr1 boolTy
- [ Alt (DataAlt falseDataCon) [] falseBox
- , Alt (DataAlt trueDataCon) [] trueBox
- ]
+ return $ mkIfThenElse e trueBox falseBox
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index 949eb90d53..ff1c616974 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -774,7 +774,8 @@ check_type (ve@ValidityEnv{ ve_tidy_env = env, ve_ctxt = ctxt
where
(arg_rank, res_rank) = funArgResRank rank
-check_type _ ty = pprPanic "check_type" (ppr ty)
+check_type _ ty@(ForAllTy {}) = pprPanic "check_type" (ppr ty)
+check_type _ ty@(CoercionTy {}) = pprPanic "check_type" (ppr ty)
----------------------------------------
check_syn_tc_app :: ValidityEnv
diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py
index 8a0524248b..e254ff13aa 100644
--- a/testsuite/driver/runtests.py
+++ b/testsuite/driver/runtests.py
@@ -224,7 +224,7 @@ else:
h.close()
if v != '':
# If it does then use the first utf8 locale that is available
- h = os.popen('locale -a | grep -i "utf8\|utf-8" 2>/dev/null', 'r')
+ h = os.popen(r'locale -a | grep -i "utf8\|utf-8" 2>/dev/null', 'r')
v = h.readline().strip()
h.close()
if v != '':
diff --git a/testsuite/tests/cabal/all.T b/testsuite/tests/cabal/all.T
index 3f07527584..caa3286f79 100644
--- a/testsuite/tests/cabal/all.T
+++ b/testsuite/tests/cabal/all.T
@@ -1,5 +1,5 @@
def normaliseDynlibNames(str):
- return re.sub('-ghc[0-9.]+\.', '-ghc<VERSION>.', str)
+ return re.sub(r'-ghc[0-9.]+\.', '-ghc<VERSION>.', str)
def ignore_warnings(str):
return re.sub(r'Warning:.*\n', '', str)
diff --git a/testsuite/tests/cmm/should_compile/all.T b/testsuite/tests/cmm/should_compile/all.T
index ce38d8d9a1..721b2c1dee 100644
--- a/testsuite/tests/cmm/should_compile/all.T
+++ b/testsuite/tests/cmm/should_compile/all.T
@@ -3,7 +3,7 @@ setTestOpts(
])
test('selfloop', [cmm_src], compile, ['-no-hs-main'])
-test('cmm_sink_sp', [ only_ways(['optasm']), grep_errmsg('(\[Sp.*\]).*(=).*(\[.*R1.*\]).*;',[1,2,3]), cmm_src], compile, ['-no-hs-main -ddump-cmm -dsuppress-uniques -O'])
+test('cmm_sink_sp', [ only_ways(['optasm']), grep_errmsg(r'(\[Sp.*\]).*(=).*(\[.*R1.*\]).*;',[1,2,3]), cmm_src], compile, ['-no-hs-main -ddump-cmm -dsuppress-uniques -O'])
test('T16930', normal, makefile_test, ['T16930'])
test('T17442', normal, compile, [''])
diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T
index 4c636eb57d..fb469a292b 100644
--- a/testsuite/tests/codeGen/should_compile/all.T
+++ b/testsuite/tests/codeGen/should_compile/all.T
@@ -75,9 +75,9 @@ test('T14373',
[ js_skip # JS backend doesn't produce Cmm
],
multimod_compile_filter, ['T14373', '-fasm -O2 -c -ddump-cmm-from-stg',
- 'grep -e "const T14373\.._closure+.;"'])
+ r'grep -e "const T14373\.._closure+.;"'])
-switch_skeleton_only = 'grep -e "switch \[" -e "case " -e "default: " | sed -e "s|\] .*|\]|g" -e "s|goto .*|goto |g"'
+switch_skeleton_only = r'grep -e "switch \[" -e "case " -e "default: " | sed -e "s|\] .*|\]|g" -e "s|goto .*|goto |g"'
test('T14373a',
[ js_skip # JS backend doesn't produce Cmm
@@ -95,8 +95,8 @@ test('T14373c',
multimod_compile_filter, ['T14373c', '-fasm -O2 -c -ddump-cmm-from-stg',
switch_skeleton_only])
-switch_skeleton_and_entries_only = ('grep -e "switch \[" -e "case " -e "default: " -e "Default_entry(" -e "R1 = .*_closure+2;"'
- '| sed -e "s|\] .*|\]|g" -e "s|goto .*|goto |g" -e "s|R1 = .*_closure+2;.*|R1 = XYZ_closure+2;|g" -e "s|//.*|//|g"')
+switch_skeleton_and_entries_only = (r'grep -e "switch \[" -e "case " -e "default: " -e "Default_entry(" -e "R1 = .*_closure+2;"'
+ '| sed -e "s|\] .*|\]|g" -e "s|goto .*|goto |g" -e "s|R1 = .*_closure+2;.*|R1 = XYZ_closure+2;|g" -e "s|//.*|//|g"')
test('T14373d',
[ js_skip # JS backend doesn't produce Cmm
diff --git a/testsuite/tests/simplStg/should_compile/all.T b/testsuite/tests/simplStg/should_compile/all.T
index 4ad68258fa..d8bb1dfa5b 100644
--- a/testsuite/tests/simplStg/should_compile/all.T
+++ b/testsuite/tests/simplStg/should_compile/all.T
@@ -11,6 +11,6 @@ setTestOpts(f)
test('T13588', [ grep_errmsg('case') ] , compile, ['-dverbose-stg2stg -fno-worker-wrapper'])
test('T19717', normal, compile, ['-ddump-stg-final -dsuppress-uniques -dno-typeable-binds'])
-test('inferTags002', [ only_ways(['optasm']), grep_errmsg('(call stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O'])
+test('inferTags002', [ only_ways(['optasm']), grep_errmsg(r'(call stg\_ap\_0)', [1])], compile, ['-ddump-cmm -dsuppress-uniques -dno-typeable-binds -O'])
test('T22212', normal, compile, ['-O'])
diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T
index 24969391b7..3392f931c1 100644
--- a/testsuite/tests/stranal/sigs/all.T
+++ b/testsuite/tests/stranal/sigs/all.T
@@ -23,7 +23,7 @@ test('T13380c', expect_broken('!3014'), compile, [''])
test('T13380f', normal, compile, [''])
test('T18086', normal, compile, ['-package ghc'])
test('T18957', normal, compile, [''])
-test('T16197b', [grep_errmsg('\$wf')], compile, ['-ddump-simpl -dsuppress-uniques -dsuppress-all'])
+test('T16197b', [grep_errmsg(r'\$wf')], compile, ['-ddump-simpl -dsuppress-uniques -dsuppress-all'])
test('T19407', normal, compile, [''])
test('T19871', normal, compile, [''])
test('T16859', normal, compile, ['-package ghc'])