diff --git a/compiler/GHC/Core/LateCC/OverloadedCalls.hs b/compiler/GHC/Core/LateCC/OverloadedCalls.hs
index 4a804ff0ed40b1fdba2beeb25db663605bc5db0d..fb6a8a0fe8503c2d7d1ff181e08fb8a0f2b54274 100644
--- a/compiler/GHC/Core/LateCC/OverloadedCalls.hs
+++ b/compiler/GHC/Core/LateCC/OverloadedCalls.hs
@@ -107,7 +107,7 @@ overloadedCallsCC =
let
cc_name :: FastString
cc_name =
- fsLit $ maybe "<no name available>" getOccString (exprName app)
+ maybe (fsLit "<no name available>") getOccFS (exprName app)
cc_srcspan <-
fmap (Strict.fromMaybe (UnhelpfulSpan UnhelpfulNoLocationInfo)) $
diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
index a8827457de80461ff1ceef37729661cdb3613bb7..3e6ba5b23c0f2cdf17ce19e1e216facb0682dc38 100644
--- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
@@ -586,7 +586,7 @@ tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co)
-- a DFunUnfolding in mk_worker_unfolding
, not (exprIsTrivial rhs) -- Not x = y |> co; Wrinkle 1
, not (hasInlineUnfolding info) -- Not INLINE things: Wrinkle 4
- , isConcreteType (typeKind work_ty) -- Don't peel off a cast if doing so would
+ , typeHasFixedRuntimeRep work_ty -- Don't peel off a cast if doing so would
-- lose the underlying runtime representation.
-- See Note [Preserve RuntimeRep info in cast w/w]
, not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 1d597014270c3e95ec9b425352c4afbc9819c222..bba044a98a1fd668e0eb2bd3ac9e53335c422e09 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -617,7 +617,7 @@ extract_renamed_stuff mod_summary tc_result = do
-- Validate HIE files
when (gopt Opt_ValidateHie dflags) $ do
- hs_env <- Hsc $ \e w -> return (e, w)
+ hs_env <- getHscEnv
liftIO $ do
-- Validate Scopes
case validateScopes (hie_module hieFile) $ getAsts $ hie_asts hieFile of
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 8b01f64d6ecc5402c0d953016868faeed282aad7..cf7fdc47bccd865a68280e3abca8fd273b9be3ec 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -526,10 +526,9 @@ dsExpr (HsStatic (_, whole_ty) expr@(L loc _)) = do
, srcLocCol $ realSrcSpanStart r
)
_ -> (0, 0)
- srcLoc = mkCoreConApps (tupleDataCon Boxed 2)
- [ Type intTy , Type intTy
- , mkIntExprInt platform line, mkIntExprInt platform col
- ]
+ srcLoc = mkCoreTup [ mkIntExprInt platform line
+ , mkIntExprInt platform col
+ ]
putSrcSpanDsA loc $ return $
mkCoreApps (Var makeStaticId) [ Type ty, srcLoc, expr_ds ]
diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs
index ffa06975ada032c1a9859c6237f52d5950dc665f..b3e6a98d45b7e1cdcc3fc238645ca6f16f057095 100644
--- a/compiler/GHC/HsToCore/Foreign/Call.hs
+++ b/compiler/GHC/HsToCore/Foreign/Call.hs
@@ -172,8 +172,8 @@ unboxArg arg
-- data ByteArray ix = ByteArray ix ix ByteArray#
-- data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
| is_product_type &&
- data_con_arity == 3 &&
- isJust maybe_arg3_tycon &&
+ data_con_arity == 3,
+ Just arg3_tycon <- maybe_arg3_tycon,
(arg3_tycon == byteArrayPrimTyCon ||
arg3_tycon == mutableByteArrayPrimTyCon)
= do case_bndr <- newSysLocalDs ManyTy arg_ty
@@ -196,7 +196,6 @@ unboxArg arg
(_ : _ : data_con_arg_ty3 : _) = data_con_arg_tys
maybe_arg3_tycon = tyConAppTyCon_maybe data_con_arg_ty3
- Just arg3_tycon = maybe_arg3_tycon
boxResult :: Type
-> DsM (Type, CoreExpr -> CoreExpr)
diff --git a/compiler/GHC/HsToCore/Foreign/JavaScript.hs b/compiler/GHC/HsToCore/Foreign/JavaScript.hs
index 271a0d6f09c61ee1a15184a762bc44449030e669..790d95fd4e945d2df56701ce8a84c4187e947bd0 100644
--- a/compiler/GHC/HsToCore/Foreign/JavaScript.hs
+++ b/compiler/GHC/HsToCore/Foreign/JavaScript.hs
@@ -446,8 +446,8 @@ unboxJsArg arg
-- data ByteArray ix = ByteArray ix ix ByteArray#
-- data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
| is_product_type &&
- data_con_arity == 3 &&
- isJust maybe_arg3_tycon &&
+ data_con_arity == 3,
+ Just arg3_tycon <- maybe_arg3_tycon,
(arg3_tycon == byteArrayPrimTyCon ||
arg3_tycon == mutableByteArrayPrimTyCon)
= do case_bndr <- newSysLocalDs ManyTy arg_ty
@@ -469,7 +469,6 @@ unboxJsArg arg
(_ : _ : data_con_arg_ty3 : _) = data_con_arg_tys
maybe_arg3_tycon = tyConAppTyCon_maybe (scaledThing data_con_arg_ty3)
- Just arg3_tycon = maybe_arg3_tycon
-- Takes the result of the user-level ccall:
@@ -545,7 +544,7 @@ mk_alt return_result (Just prim_res_ty, wrap_result)
-- The ccall returns a non-() value
| isUnboxedTupleType prim_res_ty = do
let
- Just ls = fmap dropRuntimeRepArgs (tyConAppArgs_maybe prim_res_ty)
+ ls = dropRuntimeRepArgs (tyConAppArgs prim_res_ty)
arity = 1 + length ls
args_ids <- mapM (newSysLocalDs ManyTy) ls
state_id <- newSysLocalDs ManyTy realWorldStatePrimTy
@@ -612,15 +611,13 @@ jsResultWrapper result_ty
| isPrimitiveType result_ty
= return (Just result_ty, \e -> e)
-- Base case 1c: boxed tuples
- -- fixme: levity args?
- | Just (tc, args) <- splitTyConApp_maybe result_ty
+ | Just (tc, args) <- maybe_tc_app
, isBoxedTupleTyCon tc = do
- let args' = dropRuntimeRepArgs args
- innerTy = mkTupleTy Unboxed args'
+ let innerTy = mkTupleTy Unboxed args
(inner_res, w) <- jsResultWrapper innerTy
- matched <- mapM (newSysLocalDs ManyTy) args'
+ matched <- mapM (newSysLocalDs ManyTy) args
let inner e = mkWildCase (w e) (unrestricted innerTy) result_ty
- [ Alt (DataAlt (tupleDataCon Unboxed (length args')))
+ [ Alt (DataAlt (tupleDataCon Unboxed (length args)))
matched
(mkCoreTup (map Var matched))
-- mkCoreConApps (tupleDataCon Boxed (length args)) (map Type args ++ map Var matched)
diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index cc8c5d1a4c6b17e87018ef13ff023e4e0f658dfd..b30c90df0cf5f19374d1fcabff2c7b377ad82a73 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -759,13 +759,11 @@ mapTupleIdBinders
mapTupleIdBinders ids args0 rho0
= assert (not (any (null . stgArgRep) args0)) $
let
- ids_unarised :: [(Id, [PrimRep])]
- ids_unarised = map (\id -> (id, typePrimRep (idType id))) ids
-
- map_ids :: UnariseEnv -> [(Id, [PrimRep])] -> [StgArg] -> UnariseEnv
+ map_ids :: UnariseEnv -> [Id] -> [StgArg] -> UnariseEnv
map_ids rho [] _ = rho
- map_ids rho ((x, x_reps) : xs) args =
+ map_ids rho (x : xs) args =
let
+ x_reps = typePrimRep (idType x)
x_arity = length x_reps
(x_args, args') =
assert (args `lengthAtLeast` x_arity)
@@ -780,7 +778,7 @@ mapTupleIdBinders ids args0 rho0
in
map_ids rho' xs args'
in
- map_ids rho0 ids_unarised args0
+ map_ids rho0 ids args0
mapSumIdBinders
:: InId -- Binder (in the case alternative).
@@ -1094,7 +1092,7 @@ unariseConArg _ arg@(StgLitArg lit)
| Just as <- unariseLiteral_maybe lit
= as
| otherwise
- = assert (not (isZeroBitTy (literalType lit))) -- We have no non-rubbish void literals
+ = assert (isNvUnaryRep (typePrimRep (literalType lit))) -- We have no non-rubbish non-unary literals
[arg]
unariseConArgs :: UnariseEnv -> [InStgArg] -> [OutStgArg]
@@ -1110,10 +1108,10 @@ unariseConArgBinder = unariseArgBinder True
--------------------------------------------------------------------------------
-mkIds :: FastString -> [UnaryType] -> UniqSM [Id]
+mkIds :: FastString -> [NvUnaryType] -> UniqSM [Id]
mkIds fs tys = mkUnarisedIds fs tys
-mkId :: FastString -> UnaryType -> UniqSM Id
+mkId :: FastString -> NvUnaryType -> UniqSM Id
mkId s t = mkUnarisedId s t
isMultiValBndr :: Id -> Bool
diff --git a/compiler/GHC/Stg/Utils.hs b/compiler/GHC/Stg/Utils.hs
index 5800dc42ad703d268695861a0bdf5fabf341216e..aadbb0994747a970b1732132f46a9317d18ba2bf 100644
--- a/compiler/GHC/Stg/Utils.hs
+++ b/compiler/GHC/Stg/Utils.hs
@@ -30,10 +30,10 @@ import GHC.Utils.Panic
import GHC.Data.FastString
-mkUnarisedIds :: MonadUnique m => FastString -> [UnaryType] -> m [Id]
+mkUnarisedIds :: MonadUnique m => FastString -> [NvUnaryType] -> m [Id]
mkUnarisedIds fs tys = mapM (mkUnarisedId fs) tys
-mkUnarisedId :: MonadUnique m => FastString -> UnaryType -> m Id
+mkUnarisedId :: MonadUnique m => FastString -> NvUnaryType -> m Id
mkUnarisedId s t = mkSysLocalM s ManyTy t
-- Checks if id is a top level error application.
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs
index 364aee33f850efe6375ff37d76d4a117643e82e1..8e309de3724b06be8464931f36b6a35fd97a9f23 100644
--- a/compiler/GHC/StgToCmm/DataCon.hs
+++ b/compiler/GHC/StgToCmm/DataCon.hs
@@ -335,7 +335,7 @@ precomputedStaticConInfo_maybe cfg binder con [arg]
, platformOS platform /= OSMinGW32 || not (stgToCmmPIE cfg || stgToCmmPIC cfg)
, Just val <- getClosurePayload arg
, inRange val
- = let intlike_lbl = mkCmmClosureLabel rtsUnitId (fsLit label)
+ = let intlike_lbl = mkCmmClosureLabel rtsUnitId label
val_int = fromIntegral val :: Int
offsetW = (val_int - fromIntegral min_static_range) * (fixedHdrSizeW profile + 1)
-- INTLIKE/CHARLIKE closures consist of a header and one word payload
@@ -366,8 +366,8 @@ precomputedStaticConInfo_maybe cfg binder con [arg]
| charClosure = fromIntegral (pc_MAX_CHARLIKE constants)
| otherwise = panic "precomputedStaticConInfo_maybe: Unknown closure type"
label
- | intClosure = "stg_INTLIKE"
- | charClosure = "stg_CHARLIKE"
+ | intClosure = fsLit "stg_INTLIKE"
+ | charClosure = fsLit "stg_CHARLIKE"
| otherwise = panic "precomputedStaticConInfo_maybe: Unknown closure type"
precomputedStaticConInfo_maybe _ _ _ _ = Nothing
diff --git a/compiler/GHC/StgToJS/CodeGen.hs b/compiler/GHC/StgToJS/CodeGen.hs
index 030d89f4c65827a899a718ce720d27bafbabd905..e1f8245419dd620d2ccf5266abd068491eba9c69 100644
--- a/compiler/GHC/StgToJS/CodeGen.hs
+++ b/compiler/GHC/StgToJS/CodeGen.hs
@@ -297,13 +297,13 @@ genSetConInfo i d l {- srt -} = do
emitClosureInfo $ ClosureInfo ei
(CIRegs 0 [PtrV])
(mkFastString $ renderWithContext defaultSDocContext (ppr d))
- (fixedLayout $ map unaryTypeJSRep fields)
+ (fixedLayout fields)
(CICon $ dataConTag d)
sr
return (mkDataEntry ei)
where
-- dataConRepArgTys sometimes returns unboxed tuples. is that a bug?
- fields = concatMap (map primRepToType . typePrimRep . unwrapType . scaledThing)
+ fields = concatMap (typeJSRep . unwrapType . scaledThing)
(dataConRepArgTys d)
-- concatMap (map slotTyToType . repTypeSlots . repType) (dataConRepArgTys d)
diff --git a/compiler/GHC/StgToJS/Expr.hs b/compiler/GHC/StgToJS/Expr.hs
index 64b3bb8e8fc37737a5f599f2dc8353de0f06c205..7b6f20a2b8362f5f9fe3a0e710d1b5fc27ff7eaa 100644
--- a/compiler/GHC/StgToJS/Expr.hs
+++ b/compiler/GHC/StgToJS/Expr.hs
@@ -491,7 +491,7 @@ optimizeFree offset ids = do
-- this line goes wrong vvvvvvv
let -- ids' = concat $ map (\i -> map (i,) [1..varSize . unaryTypeJSRep . idType $ i]) ids
idSize :: Id -> Int
- idSize i = sum $ map varSize (typeJSRep . idType $ i)
+ idSize i = typeSize $ idType i
ids' = concatMap (\i -> map (i,) [1..idSize i]) ids
-- 1..varSize] . unaryTypeJSRep . idType $ i]) (typeJSRep ids)
l = length ids'
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index ceb3fd1a1bdda89cf2e8903379e27729d0bf0c19..2dce8c2985cb1d4f1d683aa235cde915c661a2df 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -2216,7 +2216,7 @@ tcAnonWildCardOcc is_extra (TcTyMode { mode_holes = Just (hole_lvl, hole_mode) }
= do { kv_details <- newTauTvDetailsAtLevel hole_lvl
; kv_name <- newMetaTyVarName (fsLit "k")
; wc_details <- newTauTvDetailsAtLevel hole_lvl
- ; wc_name <- newMetaTyVarName (fsLit wc_nm)
+ ; wc_name <- newMetaTyVarName wc_nm
; let kv = mkTcTyVar kv_name liftedTypeKind kv_details
wc_kind = mkTyVarTy kv
wc_tv = mkTcTyVar wc_name wc_kind wc_details
@@ -2235,10 +2235,10 @@ tcAnonWildCardOcc is_extra (TcTyMode { mode_holes = Just (hole_lvl, hole_mode) }
where
-- See Note [Wildcard names]
wc_nm = case hole_mode of
- HM_Sig -> "w"
- HM_FamPat -> "_"
- HM_VTA -> "w"
- HM_TyAppPat -> "_"
+ HM_Sig -> fsLit "w"
+ HM_FamPat -> fsLit "_"
+ HM_VTA -> fsLit "w"
+ HM_TyAppPat -> fsLit "_"
emit_holes = case hole_mode of
HM_Sig -> True
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index ce0db740e8c39340453fb561c2496462770f4977..448dfd431fa95d5abd3b594d1c23c0b54eedba5c 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -75,7 +75,6 @@ as ``-Wno-...`` for every individual warning in the group.
* :ghc-flag:`-Woperator-whitespace-ext-conflict`
* :ghc-flag:`-Wambiguous-fields`
* :ghc-flag:`-Wunicode-bidirectional-format-characters`
- * :ghc-flag:`-Wforall-identifier`
* :ghc-flag:`-Wgadt-mono-local-binds`
* :ghc-flag:`-Wtype-equality-requires-operators`
* :ghc-flag:`-Wtype-equality-out-of-scope`
diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst
index 0c9cb898d04f285d873b7f4e0ce50f4d4a4964b2..9a562ba904845dac8ed3778afff98ca9bad2cd5b 100644
--- a/docs/users_guide/using.rst
+++ b/docs/users_guide/using.rst
@@ -799,7 +799,7 @@ There are two kinds of participants in the GHC Jobserver protocol:
processes through the semaphore ⟨sem⟩ (specified as a string).
Error if the semaphore doesn't exist.
- Use of ``-jsem`` will override use of :ghc-flag:``-j[⟨n⟩]``,
+ Use of ``-jsem`` will override use of :ghc-flag:`-j[⟨n⟩]`,
and vice-versa.
.. _multi-home-units:
diff --git a/testsuite/tests/programs/andy_cherry/test.T b/testsuite/tests/programs/andy_cherry/test.T
index f85310014c48e3e0446bb2bbde4adbc37a6049ad..daef58506fadb2ac54ab0cf09c675898d5735bad 100644
--- a/testsuite/tests/programs/andy_cherry/test.T
+++ b/testsuite/tests/programs/andy_cherry/test.T
@@ -2,6 +2,5 @@
test('andy_cherry',
[extra_files(['DataTypes.hs', 'GenUtils.hs', 'Interp.hs', 'InterpUtils.hs', 'Main.hs', 'Parser.hs', 'PrintTEX.hs', 'mygames.pgn']),
when(fast(), skip),
- expect_broken_for(23272, ['ghci-opt']),
extra_run_opts('.')],
multimod_compile_and_run, ['Main', '-cpp'])