summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-12-14 01:25:29 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-01-05 10:48:34 -0500
commit541aedcd9023445b8e914d595ae8dcf2e799d618 (patch)
tree35bf6bee4a05753b486bb642de679963aa134614 /compiler
parent00dc51060881df81258ba3b3bdf447294618a4de (diff)
downloadhaskell-541aedcd9023445b8e914d595ae8dcf2e799d618.tar.gz
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.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Builtin/Names.hs16
-rw-r--r--compiler/GHC/Builtin/Types.hs2
-rw-r--r--compiler/GHC/Builtin/Types/Literals.hs12
-rw-r--r--compiler/GHC/Builtin/primops.txt.pp4
-rw-r--r--compiler/GHC/Core/Coercion.hs-boot2
-rw-r--r--compiler/GHC/Core/Ppr.hs6
-rw-r--r--compiler/GHC/Core/Type.hs4
-rw-r--r--compiler/GHC/Core/Utils.hs3
-rw-r--r--compiler/GHC/HsToCore/Arrows.hs2
-rw-r--r--compiler/GHC/HsToCore/Binds.hs2
-rw-r--r--compiler/GHC/HsToCore/Foreign/JavaScript.hs26
-rw-r--r--compiler/GHC/HsToCore/ListComp.hs4
-rw-r--r--compiler/GHC/HsToCore/Pmc/Desugar.hs4
-rw-r--r--compiler/GHC/Rename/Bind.hs2
-rw-r--r--compiler/GHC/Rename/Expr.hs5
-rw-r--r--compiler/GHC/Rename/Pat.hs2
-rw-r--r--compiler/GHC/Runtime/Heap/Inspect.hs16
-rw-r--r--compiler/GHC/Stg/BcPrep.hs4
-rw-r--r--compiler/GHC/StgToByteCode.hs5
-rw-r--r--compiler/GHC/StgToCmm/Layout.hs2
-rw-r--r--compiler/GHC/StgToJS/Deps.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Zonk.hs8
-rw-r--r--compiler/Language/Haskell/Syntax/Decls.hs3
24 files changed, 53 insertions, 85 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 0b2ace3dfb..691f500a77 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 babd94f961..44d22f3676 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 02ffbd31dd..5609fab10a 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 617abe5f9e..d51f3616f2 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 5d5193306e..0d56cf628c 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 17559cf4a9..d5d21e294d 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 1ef00b0977..e16ff2faa6 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 c88ddb3d55..32be6488b8 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 4794f11075..3a6b964aa8 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 21cab8439d..4d594e833f 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 820ab80275..130de83ebf 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 b9f7c664ce..ca89c468ed 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 9b02e50c29..8ebe472d5f 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 349fc770b6..fa5c7b8532 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 4ee8870318..95931ca4a1 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 c73b1edcad..9c4f3dd9fb 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 ec13338d0c..04743d6ba8 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 e9a3c88e34..b99a0ab8c1 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 989121207d..7cf5f477b7 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 5b05e846d5..d465e42800 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 229daf51a4..bd7d2c75bd 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 6ba304be16..239a55ee6e 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 84e0865154..8c95d6f297 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 21a03c9c22..50ab1fd6be 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