diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2023-01-10 19:41:43 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-01-11 00:58:38 -0500 |
commit | 083f701553852c4460159cd6deb2515d3373714d (patch) | |
tree | e49af47f216ecb1f68142a40e97b47daad1b445d | |
parent | bc1257750f507218059ac6bad05d9c96a8b88d67 (diff) | |
download | haskell-083f701553852c4460159cd6deb2515d3373714d.tar.gz |
Misc cleanup
- 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.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Core/Make.hs | 17 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Type.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Utils.hs | 14 | ||||
-rw-r--r-- | compiler/GHC/Tc/Validity.hs | 3 | ||||
-rw-r--r-- | testsuite/driver/runtests.py | 2 | ||||
-rw-r--r-- | testsuite/tests/cabal/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/cmm/should_compile/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/codeGen/should_compile/all.T | 8 | ||||
-rw-r--r-- | testsuite/tests/simplStg/should_compile/all.T | 2 | ||||
-rw-r--r-- | testsuite/tests/stranal/sigs/all.T | 2 |
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']) |