From 541aedcd9023445b8e914d595ae8dcf2e799d618 Mon Sep 17 00:00:00 2001
From: Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io>
Date: Wed, 14 Dec 2022 01:25:29 +0100
Subject: [PATCH] Misc cleanup
- Remove unused uniques and hs-boot declarations
- Fix types of seq and unsafeCoerce#
- Remove FastString/String roundtrip in JS
- Use TTG to enforce totality
- Remove enumeration in Heap/Inspect; the 'otherwise' clause
serves the primitive types well.
---
compiler/GHC/Builtin/Names.hs | 16 -------------
compiler/GHC/Builtin/Types.hs | 2 +-
compiler/GHC/Builtin/Types/Literals.hs | 12 +++++-----
compiler/GHC/Builtin/primops.txt.pp | 4 ++--
compiler/GHC/Core/Coercion.hs-boot | 2 --
compiler/GHC/Core/Ppr.hs | 6 ++---
compiler/GHC/Core/Type.hs | 4 ++--
compiler/GHC/Core/Utils.hs | 3 +--
compiler/GHC/HsToCore/Arrows.hs | 2 +-
compiler/GHC/HsToCore/Binds.hs | 2 +-
compiler/GHC/HsToCore/Foreign/JavaScript.hs | 26 ++++++++++-----------
compiler/GHC/HsToCore/ListComp.hs | 4 ++--
compiler/GHC/HsToCore/Pmc/Desugar.hs | 4 ++--
compiler/GHC/Rename/Bind.hs | 2 +-
compiler/GHC/Rename/Expr.hs | 5 ++--
compiler/GHC/Rename/Pat.hs | 2 +-
compiler/GHC/Runtime/Heap/Inspect.hs | 16 -------------
compiler/GHC/Stg/BcPrep.hs | 4 ++--
compiler/GHC/StgToByteCode.hs | 5 ++--
compiler/GHC/StgToCmm/Layout.hs | 2 +-
compiler/GHC/StgToJS/Deps.hs | 2 +-
compiler/GHC/Tc/Gen/Splice.hs | 2 +-
compiler/GHC/Tc/Utils/Zonk.hs | 8 +++++--
compiler/Language/Haskell/Syntax/Decls.hs | 3 ++-
docs/users_guide/exts/poly_kinds.rst | 5 ++--
docs/users_guide/exts/unicode_syntax.rst | 2 ++
libraries/base/GHC/ST.hs | 2 +-
testsuite/tests/linters/notes.stdout | 2 --
28 files changed, 59 insertions(+), 90 deletions(-)
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 0b2ace3dfb51..691f500a77d7 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -2498,19 +2498,6 @@ typeCharTypeRepKey = mkPreludeMiscIdUnique 509
typeRepIdKey = mkPreludeMiscIdUnique 510
mkTrFunKey = mkPreludeMiscIdUnique 511
--- Representations for primitive types
-trTYPEKey
- , trTYPE'PtrRepLiftedKey
- , trRuntimeRepKey
- , tr'PtrRepLiftedKey
- , trLiftedRepKey
- :: Unique
-trTYPEKey = mkPreludeMiscIdUnique 512
-trTYPE'PtrRepLiftedKey = mkPreludeMiscIdUnique 513
-trRuntimeRepKey = mkPreludeMiscIdUnique 514
-tr'PtrRepLiftedKey = mkPreludeMiscIdUnique 515
-trLiftedRepKey = mkPreludeMiscIdUnique 516
-
-- KindReps for common cases
starKindRepKey, starArrStarKindRepKey, starArrStarArrStarKindRepKey, constraintKindRepKey :: Unique
starKindRepKey = mkPreludeMiscIdUnique 520
@@ -2523,9 +2510,6 @@ toDynIdKey :: Unique
toDynIdKey = mkPreludeMiscIdUnique 530
-bitIntegerIdKey :: Unique
-bitIntegerIdKey = mkPreludeMiscIdUnique 550
-
heqSCSelIdKey, eqSCSelIdKey, coercibleSCSelIdKey :: Unique
eqSCSelIdKey = mkPreludeMiscIdUnique 551
heqSCSelIdKey = mkPreludeMiscIdUnique 552
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index babd94f961f1..44d22f367636 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -903,7 +903,7 @@ mkConstraintTupleStr 1 = "Solo%" -- See Note [One-tuples]
mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)"
commas :: Arity -> String
-commas ar = take (ar-1) (repeat ',')
+commas ar = replicate (ar-1) ','
cTupleTyCon :: Arity -> TyCon
cTupleTyCon i
diff --git a/compiler/GHC/Builtin/Types/Literals.hs b/compiler/GHC/Builtin/Types/Literals.hs
index 02ffbd31dd10..5609fab10ab7 100644
--- a/compiler/GHC/Builtin/Types/Literals.hs
+++ b/compiler/GHC/Builtin/Types/Literals.hs
@@ -479,8 +479,7 @@ axConsSymbolDef =
axUnconsSymbolDef =
mkUnAxiom "UnconsSymbolDef" typeUnconsSymbolTyCon isStrLitTy $
- \str -> Just $
- mkPromotedMaybeTy charSymbolPairKind (fmap reifyCharSymbolPairTy (unconsFS str))
+ \str -> Just $ computeUncons str
axCharToNatDef =
mkUnAxiom "CharToNatDef" typeCharToNatTyCon isCharLitTy $
@@ -784,14 +783,15 @@ matchFamConsSymbol [s,t]
mbY = isStrLitTy t
matchFamConsSymbol _ = Nothing
-reifyCharSymbolPairTy :: (Char, FastString) -> Type
-reifyCharSymbolPairTy (c, s) = charSymbolPair (mkCharLitTy c) (mkStrLitTy s)
+computeUncons :: FastString -> Type
+computeUncons str = mkPromotedMaybeTy charSymbolPairKind (fmap reifyCharSymbolPairTy (unconsFS str))
+ where reifyCharSymbolPairTy :: (Char, FastString) -> Type
+ reifyCharSymbolPairTy (c, s) = charSymbolPair (mkCharLitTy c) (mkStrLitTy s)
matchFamUnconsSymbol :: [Type] -> Maybe (CoAxiomRule, [Type], Type)
matchFamUnconsSymbol [s]
| Just x <- mbX =
- Just (axUnconsSymbolDef, [s]
- , mkPromotedMaybeTy charSymbolPairKind (fmap reifyCharSymbolPairTy (unconsFS x)))
+ Just (axUnconsSymbolDef, [s], computeUncons x)
where
mbX = isStrLitTy s
matchFamUnconsSymbol _ = Nothing
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index 617abe5f9e6c..d51f3616f2cf 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -3743,7 +3743,7 @@ pseudoop "proxy#"
representation. }
pseudoop "seq"
- a -> b -> b
+ a -> p -> p
{ The value of @'seq' a b@ is bottom if @a@ is bottom, and
otherwise equal to @b@. In other words, it evaluates the first
argument @a@ to weak head normal form (WHNF). 'seq' is usually
@@ -3761,7 +3761,7 @@ pseudoop "seq"
-- change this, do update 'ghcPrimIface' in 'GHC.Iface.Load'.
pseudoop "unsafeCoerce#"
- a -> b
+ o -> p
{ The function 'unsafeCoerce#' allows you to side-step the typechecker entirely. That
is, it allows you to coerce any type into any other type. If you use this function,
you had better get it right, otherwise segmentation faults await. It is generally
diff --git a/compiler/GHC/Core/Coercion.hs-boot b/compiler/GHC/Core/Coercion.hs-boot
index 5d5193306e7b..0d56cf628cf8 100644
--- a/compiler/GHC/Core/Coercion.hs-boot
+++ b/compiler/GHC/Core/Coercion.hs-boot
@@ -45,8 +45,6 @@ coVarRole :: CoVar -> Role
mkCoercionType :: Role -> Type -> Type -> Type
-data LiftingContext
-liftCoSubst :: HasDebugCallStack => Role -> LiftingContext -> Type -> Coercion
seqCo :: Coercion -> ()
coercionKind :: Coercion -> Pair Type
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index 17559cf4a9ee..d5d21e294dba 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -159,9 +159,9 @@ ppr_binding ann (val_bdr, expr)
-- So refer to printing j = e
= pp_normal_bind
where
- (bndrs, body) = collectBinders expr
- lhs_bndrs = take join_arity bndrs
- rhs = mkLams (drop join_arity bndrs) body
+ (bndrs, body) = collectBinders expr
+ (lhs_bndrs, rest) = splitAt join_arity bndrs
+ rhs = mkLams rest body
pprParendExpr expr = ppr_expr parens expr
pprCoreExpr expr = ppr_expr noParens expr
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 1ef00b097779..e16ff2faa607 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -781,7 +781,7 @@ isBoxedRuntimeRep_maybe rep
-- | Check whether a type of kind 'RuntimeRep' is lifted, unlifted, or unknown.
--
--- `isLiftedRuntimeRep rr` returns:
+-- `runtimeRepLevity_maybe rr` returns:
--
-- * `Just Lifted` if `rr` is `LiftedRep :: RuntimeRep`
-- * `Just Unlifted` if `rr` is definitely unlifted, e.g. `IntRep`
@@ -1028,7 +1028,7 @@ invariant: use it.
Note [Decomposing fat arrow c=>t]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Can we unify (a b) with (Eq a => ty)? If we do so, we end up with
-a partial application like ((=>) Eq a) which doesn't make sense in
+a partial application like ((=>) (Eq a)) which doesn't make sense in
source Haskell. In contrast, we *can* unify (a b) with (t1 -> t2).
Here's an example (#9858) of how you might do it:
i :: (Typeable a, Typeable b) => Proxy (a b) -> TypeRep
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index c88ddb3d5517..32be6488b887 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -141,8 +141,7 @@ exprType (Lam binder expr) = mkLamType binder (exprType expr)
exprType e@(App _ _)
= case collectArgs e of
(fun, args) -> applyTypeToArgs (pprCoreExpr e) (exprType fun) args
-
-exprType other = pprPanic "exprType" (pprCoreExpr other)
+exprType (Type ty) = pprPanic "exprType" (ppr ty)
coreAltType :: CoreAlt -> Type
-- ^ Returns the type of the alternatives right hand side
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 4794f1107599..3a6b964aa8f5 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -647,7 +647,7 @@ dsCmd ids local_vars stack_ty res_ty (XCmd (HsWrap wrap cmd)) env_ids = do
core_wrap <- dsHsWrapper wrap
return (core_wrap core_cmd, env_ids')
-dsCmd _ _ _ _ c _ = pprPanic "dsCmd" (ppr c)
+dsCmd _ _ _ _ c@(HsCmdLam {}) _ = pprPanic "dsCmd" (ppr c)
-- D; ys |-a c : stk --> t (ys <= xs)
-- ---------------------
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 21cab8439d81..4d594e833f1d 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -307,7 +307,7 @@ dsAbsBinds dflags tyvars dicts exports
; let mk_bind (ABE { abe_wrap = wrap
, abe_poly = global
, abe_mono = local, abe_prags = spec_prags })
- -- See Note [AbsBinds wrappers] in "GHC.Hs.Binds"
+ -- See Note [ABExport wrapper] in "GHC.Hs.Binds"
= do { tup_id <- newSysLocalDs ManyTy tup_ty
; core_wrap <- dsHsWrapper wrap
; let rhs = core_wrap $ mkLams tyvars $ mkLams dicts $
diff --git a/compiler/GHC/HsToCore/Foreign/JavaScript.hs b/compiler/GHC/HsToCore/Foreign/JavaScript.hs
index 820ab8027593..130de83ebf5b 100644
--- a/compiler/GHC/HsToCore/Foreign/JavaScript.hs
+++ b/compiler/GHC/HsToCore/Foreign/JavaScript.hs
@@ -177,14 +177,14 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv
text "h$foreignExport" <>
parens (
ftext c_nm <> comma <>
- strlit (unitIdString (moduleUnitId m)) <> comma <>
- strlit (moduleNameString (moduleName m)) <> comma <>
- strlit (unpackFS c_nm) <> comma <>
- strlit type_string
+ strlit (unitIdFS (moduleUnitId m)) <> comma <>
+ strlit (moduleNameFS (moduleName m)) <> comma <>
+ strlit c_nm <> comma <>
+ strlit (mkFastString type_string)
) <> semi
_ -> empty
- strlit xs = docToSDoc (pprStringLit (mkFastString xs))
+ strlit xs = docToSDoc (pprStringLit xs)
-- the target which will form the root of what we ask rts_evalIO to run
the_cfun
@@ -382,16 +382,16 @@ dsJsCall fn_id co (CCall (CCallSpec target cconv safety)) _mDeclHeader = do
mkHObj :: Type -> SDoc
-mkHObj t = text "h$rts_mk" <> text (showFFIType t)
+mkHObj t = text "h$rts_mk" <> showFFIType t
unpackHObj :: Type -> SDoc
-unpackHObj t = text "h$rts_get" <> text (showFFIType t)
+unpackHObj t = text "h$rts_get" <> showFFIType t
showStgType :: Type -> SDoc
-showStgType t = text "Hs" <> text (showFFIType t)
+showStgType t = text "Hs" <> showFFIType t
-showFFIType :: Type -> String
-showFFIType t = getOccString (getName (typeTyCon t))
+showFFIType :: Type -> SDoc
+showFFIType t = ftext (occNameFS (getOccName (typeTyCon t)))
typeTyCon :: Type -> TyCon
typeTyCon ty
@@ -639,7 +639,7 @@ jsResultWrapper result_ty
| Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey = do
-- result_id <- newSysLocalDs boolTy
ccall_uniq <- newUnique
- let forceBool e = mkJsCall ccall_uniq "$r = !(!$1)" [e] boolTy
+ let forceBool e = mkJsCall ccall_uniq (fsLit "$r = !(!$1)") [e] boolTy
return
(Just intPrimTy, \e -> forceBool e)
@@ -674,10 +674,10 @@ jsResultWrapper result_ty
maybe_tc_app = splitTyConApp_maybe result_ty
-- low-level primitive JavaScript call:
-mkJsCall :: Unique -> String -> [CoreExpr] -> Type -> CoreExpr
+mkJsCall :: Unique -> FastString -> [CoreExpr] -> Type -> CoreExpr
mkJsCall u tgt args t = mkFCall u ccall args t
where
ccall = CCall $ CCallSpec
- (StaticTarget NoSourceText (mkFastString tgt) (Just primUnit) True)
+ (StaticTarget NoSourceText tgt (Just primUnit) True)
JavaScriptCallConv
PlayRisky
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index b9f7c664ce75..ca89c468ed1a 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -584,8 +584,8 @@ dsMcStmt (ParStmt bind_ty blocks mzip_op bind_op) stmts_rest
= do { exp <- dsInnerMonadComp stmts bndrs return_op
; return (exp, mkBigCoreVarTupTy bndrs) }
-dsMcStmt stmt _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt)
-
+dsMcStmt stmt@(ApplicativeStmt {}) _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt)
+dsMcStmt stmt@(RecStmt {}) _ = pprPanic "dsMcStmt: unexpected stmt" (ppr stmt)
matchTuple :: [Id] -> CoreExpr -> DsM CoreExpr
-- (matchTuple [a,b,c] body)
diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs
index 9b02e50c293f..8ebe472d5fac 100644
--- a/compiler/GHC/HsToCore/Pmc/Desugar.hs
+++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs
@@ -48,7 +48,7 @@ import GHC.Data.Maybe
import qualified GHC.LanguageExtensions as LangExt
import GHC.Utils.Monad (concatMapM)
import GHC.Types.SourceText (FractionalLit(..))
-import Control.Monad (zipWithM)
+import Control.Monad (zipWithM, replicateM)
import Data.List (elemIndex)
import Data.List.NonEmpty ( NonEmpty(..) )
import qualified Data.List.NonEmpty as NE
@@ -92,7 +92,7 @@ mkPmLitGrds x (PmLit _ (PmLitString s)) = do
-- 'GHC.HsToCore.Pmc.Solver.addRefutableAltCon', but it's so much simpler
-- here. See Note [Representation of Strings in TmState] in
-- GHC.HsToCore.Pmc.Solver
- vars <- traverse mkPmId (take (lengthFS s) (repeat charTy))
+ vars <- replicateM (lengthFS s) (mkPmId charTy)
let mk_char_lit y c = mkPmLitGrds y (PmLit charTy (PmLitChar c))
char_grdss <- zipWithM mk_char_lit vars (unpackFS s)
mkListGrds x (zip vars char_grdss)
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 349fc770b633..fa5c7b85329a 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -529,7 +529,7 @@ rnBind sig_fn (PatSynBind x bind)
= do { (bind', name, fvs) <- rnPatSynBind sig_fn bind
; return (PatSynBind x bind', name, fvs) }
-rnBind _ b = pprPanic "rnBind" (ppr b)
+rnBind _ b@(VarBind {}) = pprPanic "rnBind" (ppr b)
-- See Note [Pattern bindings that bind no variables]
isOkNoBindPattern :: LPat GhcRn -> Bool
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 4ee8870318c5..95931ca4a153 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -501,6 +501,8 @@ rnExpr (RecordUpd { rupd_expr = expr, rupd_flds = rbinds })
, plusFVs [fv_getField, fv_setField, fv_e, fv_us] )
}
+rnExpr (HsRecSel x _) = dataConCantHappen x
+
rnExpr (ExprWithTySig _ expr pty)
= do { (pty', fvTy) <- rnHsSigWcType ExprWithTySigCtx pty
; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $
@@ -588,9 +590,6 @@ rnExpr (HsProc x pat body)
{ (body',fvBody) <- rnCmdTop body
; return (HsProc x pat' body', fvBody) }
-rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
- -- HsWrap
-
{-
************************************************************************
* *
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index c73b1edcadfd..9c4f3dd9fbbc 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -773,7 +773,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
mb_con = case ctxt of
HsRecFieldCon con -> Just con
HsRecFieldPat con -> Just con
- _ {- update -} -> Nothing
+ HsRecFieldUpd -> Nothing
rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (LocatedA arg)
-> RnM (LHsRecField GhcRn (LocatedA arg))
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index ec13338d0cc0..04743d6ba8f9 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -478,22 +478,6 @@ repPrim t = rep where
| t == int64PrimTyCon = text $ show (build x :: Int64)
| t == word64PrimTyCon = text $ show (build x :: Word64)
| t == addrPrimTyCon = text $ show (nullPtr `plusPtr` build x)
- | t == stablePtrPrimTyCon = text "<stablePtr>"
- | t == stableNamePrimTyCon = text "<stableName>"
- | t == statePrimTyCon = text "<statethread>"
- | t == proxyPrimTyCon = text "<proxy>"
- | t == realWorldTyCon = text "<realworld>"
- | t == threadIdPrimTyCon = text "<ThreadId>"
- | t == weakPrimTyCon = text "<Weak>"
- | t == arrayPrimTyCon = text "<array>"
- | t == smallArrayPrimTyCon = text "<smallArray>"
- | t == byteArrayPrimTyCon = text "<bytearray>"
- | t == mutableArrayPrimTyCon = text "<mutableArray>"
- | t == smallMutableArrayPrimTyCon = text "<smallMutableArray>"
- | t == mutableByteArrayPrimTyCon = text "<mutableByteArray>"
- | t == mutVarPrimTyCon = text "<mutVar>"
- | t == mVarPrimTyCon = text "<mVar>"
- | t == tVarPrimTyCon = text "<tVar>"
| otherwise = char '<' <> ppr t <> char '>'
where build ww = unsafePerformIO $ withArray ww (peek . castPtr)
-- This ^^^ relies on the representation of Haskell heap values being
diff --git a/compiler/GHC/Stg/BcPrep.hs b/compiler/GHC/Stg/BcPrep.hs
index e9a3c88e34ce..b99a0ab8c1ea 100644
--- a/compiler/GHC/Stg/BcPrep.hs
+++ b/compiler/GHC/Stg/BcPrep.hs
@@ -128,7 +128,7 @@ bcPrep us bnds = evalState (mapM bcPrepTopLvl bnds) (BcPrepM_State us)
isNNLJoinPoint :: Id -> Bool
isNNLJoinPoint x = isJoinId x && mightBeUnliftedType (idType x)
--- Update an Id's type to take a Void# argument.
+-- Update an Id's type to take a (# #) argument.
-- Precondition: the Id is a not-necessarily-lifted join point.
-- See Note [Not-necessarily-lifted join points]
protectNNLJoinPointId :: Id -> Id
@@ -200,7 +200,7 @@ Here is an example. Suppose we have
Our plan is to behave is if the code was
f = \(r :: RuntimeRep) (a :: TYPE r) (x :: T).
- let j :: (Void# -> a)
+ let j :: ((# #) -> a)
j = \ _ -> error @r @a "bloop"
in case x of
A -> j void#
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs
index 989121207d40..7cf5f477b779 100644
--- a/compiler/GHC/StgToByteCode.hs
+++ b/compiler/GHC/StgToByteCode.hs
@@ -271,7 +271,7 @@ argBits :: Platform -> [ArgRep] -> [Bool]
argBits _ [] = []
argBits platform (rep : args)
| isFollowableArg rep = False : argBits platform args
- | otherwise = take (argRepSizeW platform rep) (repeat True) ++ argBits platform args
+ | otherwise = replicate (argRepSizeW platform rep) True ++ argBits platform args
non_void :: [ArgRep] -> [ArgRep]
non_void = filter nv
@@ -1818,8 +1818,7 @@ mkMultiBranch maybe_ncons raw_ways = do
mkTree vals range_lo range_hi
= let n = length vals `div` 2
- vals_lo = take n vals
- vals_hi = drop n vals
+ (vals_lo, vals_hi) = splitAt n vals
v_mid = fst (head vals_hi)
in do
label_geq <- getLabelBc
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 5b05e846d5e6..d465e4280033 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -554,7 +554,7 @@ mkArgDescr platform args
argBits :: Platform -> [ArgRep] -> [Bool] -- True for non-ptr, False for ptr
argBits _ [] = []
argBits platform (P : args) = False : argBits platform args
-argBits platform (arg : args) = take (argRepSizeW platform arg) (repeat True)
+argBits platform (arg : args) = replicate (argRepSizeW platform arg) True
++ argBits platform args
----------------------
diff --git a/compiler/GHC/StgToJS/Deps.hs b/compiler/GHC/StgToJS/Deps.hs
index 229daf51a40d..bd7d2c75bd26 100644
--- a/compiler/GHC/StgToJS/Deps.hs
+++ b/compiler/GHC/StgToJS/Deps.hs
@@ -153,7 +153,7 @@ genDependencyData mod units = do
lookupOtherFun od@(OtherSymb m idTxt) =
case M.lookup od unitOtherExports of
Just n -> return (Right n)
- Nothing | m == mod -> panic ("genDependencyData.lookupOtherFun: unknown local other id: " ++ unpackFS idTxt)
+ Nothing | m == mod -> pprPanic "genDependencyData.lookupOtherFun: unknown local other id:" (ftext idTxt)
Nothing -> Left <$> (maybe (lookupExternalFun Nothing od) return =<<
gets (M.lookup od . ddcOther))
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 6ba304be1690..239a55ee6e6f 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -962,7 +962,7 @@ typedSpliceCtxtDoc n splice
spliceResultDoc :: LHsExpr GhcTc -> SDoc
spliceResultDoc expr
= sep [ text "In the result of the splice:"
- , nest 2 (char '$' <> ppr expr)
+ , nest 2 (text "$$" <> ppr expr)
, text "To see what the splice expanded to, use -ddump-splices"]
stubNestedSplice :: HsExpr GhcTc
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 84e086515497..8c95d6f29758 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -785,7 +785,7 @@ zonkExpr env (HsUntypedBracket hsb_tc body)
zonkExpr env (HsTypedSplice s _) = runTopSplice s >>= zonkExpr env
-zonkExpr _ e@(HsUntypedSplice _ _) = pprPanic "zonkExpr: HsUntypedSplice" (ppr e)
+zonkExpr _ (HsUntypedSplice x _) = dataConCantHappen x
zonkExpr _ (OpApp x _ _ _) = dataConCantHappen x
@@ -899,7 +899,11 @@ zonkExpr env (XExpr (ConLikeTc con tvs tys))
-- The tvs come straight from the data-con, and so are strictly redundant
-- See Wrinkles of Note [Typechecking data constructors] in GHC.Tc.Gen.Head
-zonkExpr _ expr = pprPanic "zonkExpr" (ppr expr)
+zonkExpr _ (RecordUpd x _ _) = dataConCantHappen x
+zonkExpr _ (HsGetField x _ _) = dataConCantHappen x
+zonkExpr _ (HsProjection x _) = dataConCantHappen x
+zonkExpr _ e@(XExpr (HsTick {})) = pprPanic "zonkExpr" (ppr e)
+zonkExpr _ e@(XExpr (HsBinTick {})) = pprPanic "zonkExpr" (ppr e)
-------------------------------------------------------------------------
{-
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index 21a03c9c226d..50ab1fd6bef1 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -580,7 +580,8 @@ declaration before checking all of the others, supporting polymorphic recursion.
See https://gitlab.haskell.org/ghc/ghc/wikis/ghc-kinds/kind-inference#proposed-new-strategy
and #9200 for lots of discussion of how we got here.
-The detection of CUSKs is enabled by the -XCUSKs extension, switched on by default.
+The detection of CUSKs is enabled by the -XCUSKs extension, switched off by default
+in GHC2021 and on in Haskell98/2010.
Under -XNoCUSKs, all declarations are treated as if they have no CUSK.
See https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0036-kind-signatures.rst
diff --git a/docs/users_guide/exts/poly_kinds.rst b/docs/users_guide/exts/poly_kinds.rst
index f72b20b79044..76a925ffd99a 100644
--- a/docs/users_guide/exts/poly_kinds.rst
+++ b/docs/users_guide/exts/poly_kinds.rst
@@ -372,8 +372,9 @@ According to the rules above ``X`` has a CUSK. Yet, the kind of ``k`` is undeter
It is thus quantified over, giving ``X`` the kind ``forall k1 (k :: k1). Proxy k -> Type``.
The detection of CUSKs is enabled by the :extension:`CUSKs` flag, which is
-switched on by default. This extension is scheduled for deprecation to be
-replaced with :extension:`StandaloneKindSignatures`.
+switched off by default in GHC2021 and on in Haskell98 and Haskell2010.
+This extension is scheduled for deprecation to be replaced
+with :extension:`StandaloneKindSignatures`.
.. index::
single: standalone kind signature
diff --git a/docs/users_guide/exts/unicode_syntax.rst b/docs/users_guide/exts/unicode_syntax.rst
index aa1d8e88b482..cda9223ccc3c 100644
--- a/docs/users_guide/exts/unicode_syntax.rst
+++ b/docs/users_guide/exts/unicode_syntax.rst
@@ -47,5 +47,7 @@ sequences. The following alternatives are provided:
+--------------+---------------+-------------+-----------------------------------------+
| ``|]`` | ⟧ | 0x27E7 | MATHEMATICAL RIGHT WHITE SQUARE BRACKET |
+--------------+---------------+-------------+-----------------------------------------+
+| ``%1->`` | ⊸ | 0x22B8 | MULTIMAP |
++--------------+---------------+-------------+-----------------------------------------+
diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs
index 27749e83bbda..4f17f5618bef 100644
--- a/libraries/base/GHC/ST.hs
+++ b/libraries/base/GHC/ST.hs
@@ -131,4 +131,4 @@ instance Show (ST s a) where
-- computation is inaccessible to the rest of the program.
runST :: (forall s. ST s a) -> a
runST (ST st_rep) = case runRW# st_rep of (# _, a #) -> a
--- See Note [Definition of runRW#] in GHC.Magic
+-- See Note [runRW magic] in GHC.CoreToStg.Prep
diff --git a/testsuite/tests/linters/notes.stdout b/testsuite/tests/linters/notes.stdout
index b50da6b3a22f..edf75f2d7751 100644
--- a/testsuite/tests/linters/notes.stdout
+++ b/testsuite/tests/linters/notes.stdout
@@ -13,7 +13,6 @@ ref compiler/GHC/Hs/Expr.hs:1704:87: Note [Lifecycle of a splice]
ref compiler/GHC/Hs/Expr.hs:1740:7: Note [Pending Splices]
ref compiler/GHC/Hs/Extension.hs:144:5: Note [Strict argument type constraints]
ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice]
-ref compiler/GHC/HsToCore/Binds.hs:312:33: Note [AbsBinds wrappers]
ref compiler/GHC/HsToCore/Pmc/Solver.hs:854:20: Note [COMPLETE sets on data families]
ref compiler/GHC/HsToCore/Quote.hs:1460:7: Note [How brackets and nested splices are handled]
ref compiler/GHC/Rename/Pat.hs:888:29: Note [Disambiguating record fields]
@@ -51,7 +50,6 @@ ref compiler/Language/Haskell/Syntax/Pat.hs:336:12: Note [Disambiguating
ref configure.ac:212:10: Note [Linking ghc-bin against threaded stage0 RTS]
ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders]
ref hadrian/src/Expression.hs:130:30: Note [Linking ghc-bin against threaded stage0 RTS]
-ref libraries/base/GHC/ST.hs:134:7: Note [Definition of runRW#]
ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "]
ref linters/lint-notes/Notes.hs:69:22: Note [...]
ref testsuite/config/ghc:243:10: Note [WayFlags]
--
GitLab