[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: ci: bump ci-images for updated wasm image
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Jan 18 07:11:24 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
320454d3 by Cheng Shao at 2024-01-17T23:02:40+00:00
ci: bump ci-images for updated wasm image
- - - - -
2eca52b4 by Cheng Shao at 2024-01-17T23:06:44+00:00
base: treat all FDs as "nonblocking" on wasm
On posix platforms, when performing read/write on FDs, we check the
nonblocking flag first. For FDs without this flag (e.g. stdout), we
call fdReady() first, which in turn calls poll() to wait for I/O to be
available on that FD. This is problematic for wasm32-wasi: although
select()/poll() is supported via the poll_oneoff() wasi syscall, that
syscall is rather heavyweight and runtime behavior differs in
different wasi implementations. The issue is even worse when targeting
browsers, given there's no satisfactory way to implement async I/O as
a synchronous syscall, so existing JS polyfills for wasi often give up
and simply return ENOSYS.
Before we have a proper I/O manager that avoids poll_oneoff() for
async I/O on wasm, this patch improves the status quo a lot by merely
pretending all FDs are "nonblocking". Read/write on FDs will directly
invoke read()/write(), which are much more reliably handled in
existing wasi implementations, especially those in browsers.
Fixes #23275 and the following test cases: T7773 isEOF001 openFile009
T4808 cgrun025
Approved by CLC proposal #234:
https://github.com/haskell/core-libraries-committee/issues/234
- - - - -
a68b44ff by Andrew Lelechenko at 2024-01-18T02:11:04-05:00
base: clarify how to disable warnings about partiality of Data.List.{head,tail}
- - - - -
20bce39d by Simon Peyton Jones at 2024-01-18T02:11:05-05:00
Fix four bug in handling of (forall cv. body_ty)
These bugs are all described in #24335
It's not easy to provoke the bug, hence no test case.
- - - - -
14 changed files:
- .gitlab-ci.yml
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Utils.hs
- libraries/base/cbits/inputReady.c
- libraries/base/changelog.md
- libraries/base/src/Data/OldList.hs
- libraries/base/src/GHC/List.hs
- libraries/base/tests/IO/all.T
- libraries/base/tests/all.T
- testsuite/tests/codeGen/should_run/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
GIT_SSL_NO_VERIFY: "1"
# Commit of ghc/ci-images repository from which to pull Docker images
- DOCKER_REV: cf2ba8e205bd41ac36f39e1a12b4727f899ded75
+ DOCKER_REV: f8658053d14911d73b1e32f5b6d13fb7b1c8a5ee
# Sequential version number of all cached things.
# Bump to invalidate GitLab CI cache.
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -822,7 +822,27 @@ special behaviour. For example, this is /not/ fine:
join j = ...
in runRW# @r @ty (jump j)
+Note [Coercions in terms]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+The expression (Type ty) can occur only as the argument of an application,
+or the RHS of a non-recursive Let. But what about (Coercion co)?
+Currently it appears in ghc-prim:GHC.Types.coercible_sel, a WiredInId whose
+definition is:
+ coercible_sel :: Coercible a b => (a ~R# b)
+ coercible_sel d = case d of
+ MkCoercibleDict (co :: a ~# b) -> Coercion co
+
+So this function has a (Coercion co) in the alternative of a case.
+
+Richard says (!11908): it shouldn't appear outside of arguments, but we've been
+loose about this. coercible_sel is some thin ice. Really we should be unpacking
+Coercible using case, not a selector. I recall looking into this a few years
+back and coming to the conclusion that the fix was worse than the disease. Don't
+remember the details, but could probably recover it if we want to revisit.
+
+So Lint current accepts (Coercion co) in arbitrary places. There is no harm in
+that: it really is a value, albeit a zero-bit value.
************************************************************************
* *
@@ -996,6 +1016,7 @@ lintCoreExpr (Type ty)
= failWithL (text "Type found as expression" <+> ppr ty)
lintCoreExpr (Coercion co)
+ -- See Note [Coercions in terms]
= do { co' <- addLoc (InCo co) $
lintCoercion co
; return (coercionType co', zeroUE) }
@@ -1438,6 +1459,8 @@ lintCoreArgs :: (LintedType, UsageEnv) -> [CoreArg] -> LintM (LintedType, Usage
lintCoreArgs (fun_ty, fun_ue) args = foldM lintCoreArg (fun_ty, fun_ue) args
lintCoreArg :: (LintedType, UsageEnv) -> CoreArg -> LintM (LintedType, UsageEnv)
+
+-- Type argument
lintCoreArg (fun_ty, ue) (Type arg_ty)
= do { checkL (not (isCoercionTy arg_ty))
(text "Unnecessary coercion-to-type injection:"
@@ -1446,6 +1469,14 @@ lintCoreArg (fun_ty, ue) (Type arg_ty)
; res <- lintTyApp fun_ty arg_ty'
; return (res, ue) }
+-- Coercion argument
+lintCoreArg (fun_ty, ue) (Coercion co)
+ = do { co' <- addLoc (InCo co) $
+ lintCoercion co
+ ; res <- lintCoApp fun_ty co'
+ ; return (res, ue) }
+
+-- Other value argument
lintCoreArg (fun_ty, fun_ue) arg
= do { (arg_ty, arg_ue) <- markAllJoinsBad $ lintCoreExpr arg
-- See Note [Representation polymorphism invariants] in GHC.Core
@@ -1510,7 +1541,7 @@ checkCaseLinearity ue case_bndr var_w bndr = do
-----------------
lintTyApp :: LintedType -> LintedType -> LintM LintedType
lintTyApp fun_ty arg_ty
- | Just (tv,body_ty) <- splitForAllTyCoVar_maybe fun_ty
+ | Just (tv,body_ty) <- splitForAllTyVar_maybe fun_ty
= do { lintTyKind tv arg_ty
; in_scope <- getInScope
-- substTy needs the set of tyvars in scope to avoid generating
@@ -1521,12 +1552,35 @@ lintTyApp fun_ty arg_ty
| otherwise
= failWithL (mkTyAppMsg fun_ty arg_ty)
+-----------------
+lintCoApp :: LintedType -> LintedCoercion -> LintM LintedType
+lintCoApp fun_ty co
+ | Just (cv,body_ty) <- splitForAllCoVar_maybe fun_ty
+ , let co_ty = coercionType co
+ cv_ty = idType cv
+ , cv_ty `eqType` co_ty
+ = do { in_scope <- getInScope
+ ; let init_subst = mkEmptySubst in_scope
+ subst = extendCvSubst init_subst cv co
+ ; return (substTy subst body_ty) }
+
+ | Just (_, _, arg_ty', res_ty') <- splitFunTy_maybe fun_ty
+ , co_ty `eqType` arg_ty'
+ = return (res_ty')
+
+ | otherwise
+ = failWithL (mkCoAppMsg fun_ty co)
+
+ where
+ co_ty = coercionType co
+
-----------------
-- | @lintValApp arg fun_ty arg_ty@ lints an application of @fun arg@
-- where @fun :: fun_ty@ and @arg :: arg_ty@, returning the type of the
-- application.
-lintValApp :: CoreExpr -> LintedType -> LintedType -> UsageEnv -> UsageEnv -> LintM (LintedType, UsageEnv)
+lintValApp :: CoreExpr -> LintedType -> LintedType -> UsageEnv -> UsageEnv
+ -> LintM (LintedType, UsageEnv)
lintValApp arg fun_ty arg_ty fun_ue arg_ue
| Just (_, w, arg_ty', res_ty') <- splitFunTy_maybe fun_ty
= do { ensureEqTys arg_ty' arg_ty (mkAppMsg arg_ty' arg_ty arg)
@@ -3627,11 +3681,19 @@ mkLetErr bndr rhs
mkTyAppMsg :: Type -> Type -> SDoc
mkTyAppMsg ty arg_ty
= vcat [text "Illegal type application:",
- hang (text "Exp type:")
+ hang (text "Function type:")
4 (ppr ty <+> dcolon <+> ppr (typeKind ty)),
- hang (text "Arg type:")
+ hang (text "Type argument:")
4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]
+mkCoAppMsg :: Type -> Coercion -> SDoc
+mkCoAppMsg fun_ty co
+ = vcat [ text "Illegal coercion application:"
+ , hang (text "Function type:")
+ 4 (ppr fun_ty)
+ , hang (text "Coercion argument:")
+ 4 (ppr co <+> dcolon <+> ppr (coercionType co))]
+
emptyRec :: CoreExpr -> SDoc
emptyRec e = hang (text "Empty Rec binding:") 2 (ppr e)
=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -198,8 +198,10 @@ typeOneShots ty
= go initRecTc ty
where
go rec_nts ty
- | Just (_, ty') <- splitForAllTyCoVar_maybe ty
- = go rec_nts ty'
+ | Just (tcv, ty') <- splitForAllTyCoVar_maybe ty
+ = if isCoVar tcv
+ then idOneShotInfo tcv : go rec_nts ty'
+ else go rec_nts ty'
| Just (_,_,arg,res) <- splitFunTy_maybe ty
= typeOneShot arg : go rec_nts res
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -20,7 +20,7 @@ import GHC.Driver.Flags
import GHC.Core
import GHC.Core.Opt.Simplify.Monad
import GHC.Core.Opt.ConstantFold
-import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst )
+import GHC.Core.Type hiding ( substTy, substCo, substTyVar, extendTvSubst, extendCvSubst )
import GHC.Core.TyCo.Compare( eqType )
import GHC.Core.Opt.Simplify.Env
import GHC.Core.Opt.Simplify.Inline
@@ -1551,8 +1551,8 @@ completeBindX :: SimplEnv
-> SimplCont -- Consumed by this continuation
-> SimplM (SimplFloats, OutExpr)
completeBindX env from_what bndr rhs body cont
- | FromBeta arg_ty <- from_what
- , needsCaseBinding arg_ty rhs -- Enforcing the let-can-float-invariant
+ | FromBeta arg_levity <- from_what
+ , needsCaseBindingL arg_levity rhs -- Enforcing the let-can-float-invariant
= do { (env1, bndr1) <- simplNonRecBndr env bndr -- Lambda binders don't have rules
; (floats, expr') <- simplNonRecBody env1 from_what body cont
-- Do not float floats past the Case binder below
@@ -1753,26 +1753,47 @@ simpl_lam env bndr body (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = cont })
= do { tick (BetaReduction bndr)
; simplLam (extendTvSubst env bndr arg_ty) body cont }
+-- Coercion beta-reduction
+simpl_lam env bndr body (ApplyToVal { sc_arg = Coercion arg_co, sc_env = arg_se
+ , sc_cont = cont })
+ = assertPpr (isCoVar bndr) (ppr bndr) $
+ do { tick (BetaReduction bndr)
+ ; let arg_co' = substCo (arg_se `setInScopeFromE` env) arg_co
+ ; simplLam (extendCvSubst env bndr arg_co') body cont }
+
-- Value beta-reduction
+-- This works for /coercion/ lambdas too
simpl_lam env bndr body (ApplyToVal { sc_arg = arg, sc_env = arg_se
, sc_cont = cont, sc_dup = dup
, sc_hole_ty = fun_ty})
= do { tick (BetaReduction bndr)
- ; let arg_ty = funArgTy fun_ty
+ ; let from_what = FromBeta arg_levity
+ arg_levity
+ | isForAllTy fun_ty = assertPpr (isCoVar bndr) (ppr bndr) Unlifted
+ | otherwise = typeLevity (funArgTy fun_ty)
+ -- Example: (\(cv::a ~# b). blah) co
+ -- The type of (\cv.blah) can be (forall cv. ty); see GHC.Core.Utils.mkLamType
+
+ -- Using fun_ty: see Note [Dark corner with representation polymorphism]
+ -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg
+ -- When we come to `x=arg` we must choose lazy/strict correctly
+ -- It's wrong to err in either direction
+ -- But fun_ty is an OutType, so is fully substituted
+
; if | isSimplified dup -- Don't re-simplify if we've simplified it once
-- Including don't preInlineUnconditionally
-- See Note [Avoiding exponential behaviour]
- -> completeBindX env (FromBeta arg_ty) bndr arg body cont
+ -> completeBindX env from_what bndr arg body cont
| Just env' <- preInlineUnconditionally env NotTopLevel bndr arg arg_se
- , not (needsCaseBinding arg_ty arg)
+ , not (needsCaseBindingL arg_levity arg)
-- Ok to test arg::InExpr in needsCaseBinding because
-- exprOkForSpeculation is stable under simplification
-> do { tick (PreInlineUnconditionally bndr)
; simplLam env' body cont }
| otherwise
- -> simplNonRecE env (FromBeta arg_ty) bndr (arg, arg_se) body cont }
+ -> simplNonRecE env from_what bndr (arg, arg_se) body cont }
-- Discard a non-counting tick on a lambda. This may change the
-- cost attribution slightly (moving the allocation of the
@@ -1846,15 +1867,12 @@ simplNonRecE env from_what bndr (rhs, rhs_se) body cont
where
is_strict_bind = case from_what of
- FromBeta arg_ty | isUnliftedType arg_ty -> True
- -- If we are coming from a beta-reduction (FromBeta) we must
- -- establish the let-can-float invariant, so go via StrictBind
- -- If not, the invariant holds already, and it's optional.
- -- Using arg_ty: see Note [Dark corner with representation polymorphism]
- -- e.g (\r \(a::TYPE r) \(x::a). blah) @LiftedRep @Int arg
- -- When we come to `x=arg` we myst choose lazy/strict correctly
- -- It's wrong to err in either directly
+ FromBeta Unlifted -> True
+ -- If we are coming from a beta-reduction (FromBeta) we must
+ -- establish the let-can-float invariant, so go via StrictBind
+ -- If not, the invariant holds already, and it's optional.
+ -- (FromBeta Lifted) or FromLet: look at the demand info
_ -> seCaseCase env && isStrUsedDmd (idDemandInfo bndr)
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -214,7 +214,7 @@ data SimplCont
type StaticEnv = SimplEnv -- Just the static part is relevant
-data FromWhat = FromLet | FromBeta OutType
+data FromWhat = FromLet | FromBeta Levity
-- See Note [DupFlag invariants]
data DupFlag = NoDup -- Unsimplified, might be big
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -126,7 +126,7 @@ module GHC.Core.Type (
-- *** Levity and boxity
sORTKind_maybe, typeTypeOrConstraint,
- typeLevity_maybe, tyConIsTYPEorCONSTRAINT,
+ typeLevity, typeLevity_maybe, tyConIsTYPEorCONSTRAINT,
isLiftedTypeKind, isUnliftedTypeKind, pickyIsLiftedTypeKind,
isLiftedRuntimeRep, isUnliftedRuntimeRep, runtimeRepLevity_maybe,
isBoxedRuntimeRep,
@@ -1417,7 +1417,7 @@ funResultTy ty
| FunTy { ft_res = res } <- coreFullView ty = res
| otherwise = pprPanic "funResultTy" (ppr ty)
-funArgTy :: Type -> Type
+funArgTy :: HasDebugCallStack => Type -> Type
-- ^ Extract the function argument type and panic if that is not possible
funArgTy ty
| FunTy { ft_arg = arg } <- coreFullView ty = arg
@@ -1471,8 +1471,9 @@ piResultTys ty orig_args@(arg:args)
| FunTy { ft_res = res } <- ty
= piResultTys res args
- | ForAllTy (Bndr tv _) res <- ty
- = go (extendTCvSubst init_subst tv arg) res args
+ | ForAllTy (Bndr tcv _) res <- ty
+ = -- Both type and coercion variables
+ go (extendTCvSubst init_subst tcv arg) res args
| Just ty' <- coreView ty
= piResultTys ty' orig_args
@@ -2291,6 +2292,11 @@ buildSynTyCon name binders res_kind roles rhs
typeLevity_maybe :: HasDebugCallStack => Type -> Maybe Levity
typeLevity_maybe ty = runtimeRepLevity_maybe (getRuntimeRep ty)
+typeLevity :: HasDebugCallStack => Type -> Levity
+typeLevity ty = case typeLevity_maybe ty of
+ Just lev -> lev
+ Nothing -> pprPanic "typeLevity" (ppr ty)
+
-- | Is the given type definitely unlifted?
-- See "Type#type_classification" for what an unlifted type is.
--
@@ -2647,18 +2653,20 @@ typeKind (AppTy fun arg)
go fun args = piResultTys (typeKind fun) args
typeKind ty@(ForAllTy {})
- = case occCheckExpand tvs body_kind of
- -- We must make sure tv does not occur in kind
- -- As it is already out of scope!
+ = assertPpr (not (null tcvs)) (ppr ty) $
+ -- If tcvs is empty somehow we'll get an infinite loop!
+ case occCheckExpand tcvs body_kind of
+ -- We must make sure tvs do not occur in kind,
+ -- as they would be out of scope!
-- See Note [Phantom type variables in kinds]
Nothing -> pprPanic "typeKind"
- (ppr ty $$ ppr tvs $$ ppr body <+> dcolon <+> ppr body_kind)
+ (ppr ty $$ ppr tcvs $$ ppr body <+> dcolon <+> ppr body_kind)
- Just k' | all isTyVar tvs -> k' -- Rule (FORALL1)
- | otherwise -> lifted_kind_from_body -- Rule (FORALL2)
+ Just k' | all isTyVar tcvs -> k' -- Rule (FORALL1)
+ | otherwise -> lifted_kind_from_body -- Rule (FORALL2)
where
- (tvs, body) = splitForAllTyVars ty
- body_kind = typeKind body
+ (tcvs, body) = splitForAllTyCoVars ty -- Important: splits both TyVar and CoVar binders
+ body_kind = typeKind body
lifted_kind_from_body -- Implements (FORALL2)
= case sORTKind_maybe body_kind of
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -11,7 +11,7 @@ module GHC.Core.Utils (
-- * Constructing expressions
mkCast, mkCastMCo, mkPiMCo,
mkTick, mkTicks, mkTickNoHNF, tickHNFArgs,
- bindNonRec, needsCaseBinding,
+ bindNonRec, needsCaseBinding, needsCaseBindingL,
mkAltExpr, mkDefaultCase, mkSingleAltCase,
-- * Taking expressions apart
@@ -513,14 +513,21 @@ bindNonRec bndr rhs body
case_bind = mkDefaultCase rhs bndr body
let_bind = Let (NonRec bndr rhs) body
--- | Tests whether we have to use a @case@ rather than @let@ binding for this
--- expression as per the invariants of 'CoreExpr': see "GHC.Core#let_can_float_invariant"
-needsCaseBinding :: Type -> CoreExpr -> Bool
-needsCaseBinding ty rhs
- = mightBeUnliftedType ty && not (exprOkForSpeculation rhs)
- -- Make a case expression instead of a let
- -- These can arise either from the desugarer,
- -- or from beta reductions: (\x.e) (x +# y)
+-- | `needsCaseBinding` tests whether we have to use a @case@ rather than @let@
+-- binding for this expression as per the invariants of 'CoreExpr': see
+-- "GHC.Core#let_can_float_invariant"
+-- (needsCaseBinding ty rhs) requires that `ty` has a well-defined levity, else
+-- `typeLevity ty` will fail; but that should be the case because
+-- `needsCaseBinding` is only called once typechecking is complete
+needsCaseBinding :: HasDebugCallStack => Type -> CoreExpr -> Bool
+needsCaseBinding ty rhs = needsCaseBindingL (typeLevity ty) rhs
+
+needsCaseBindingL :: Levity -> CoreExpr -> Bool
+-- True <=> make a case expression instead of a let
+-- These can arise either from the desugarer,
+-- or from beta reductions: (\x.e) (x +# y)
+needsCaseBindingL Lifted _rhs = False
+needsCaseBindingL Unlifted rhs = not (exprOkForSpeculation rhs)
mkAltExpr :: AltCon -- ^ Case alternative constructor
-> [CoreBndr] -- ^ Things bound by the pattern match
=====================================
libraries/base/cbits/inputReady.c
=====================================
@@ -153,6 +153,9 @@ compute_WaitForSingleObject_timeout(bool infinite, Time remaining)
int
fdReady(int fd, bool write, int64_t msecs, bool isSock)
{
+#if defined(wasm32_HOST_ARCH)
+ return 1;
+#else
bool infinite = msecs < 0;
// if we need to track the time then record the end time in case we are
@@ -477,4 +480,5 @@ fdReady(int fd, bool write, int64_t msecs, bool isSock)
}
}
#endif
+#endif // wasm32_HOST_ARCH
}
=====================================
libraries/base/changelog.md
=====================================
@@ -35,6 +35,8 @@
* Add more instances for `Compose`: `Fractional`, `RealFrac`, `Floating`, `RealFloat` ([CLC proposal #226](https://github.com/haskell/core-libraries-committee/issues/226))
+ * Treat all FDs as "nonblocking" on wasm32 ([CLC proposal #234](https://github.com/haskell/core-libraries-committee/issues/234))
+
## 4.19.0.0 *October 2023*
* Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`.
Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it.
=====================================
libraries/base/src/Data/OldList.hs
=====================================
@@ -1369,6 +1369,10 @@ deleteFirstsBy eq = foldl (flip (deleteBy eq))
--
-- It's often preferable to use @Data.List.NonEmpty.@'Data.List.NonEmpty.group',
-- which provides type-level guarantees of non-emptiness of inner lists.
+-- A common idiom to squash repeating elements 'map' 'head' '.' 'group'
+-- is better served by
+-- 'map' @Data.List.NonEmpty.@'Data.List.NonEmpty.head' '.' @Data.List.NonEmpty.@'Data.List.NonEmpty.group'
+-- because it avoids partial functions.
--
-- ==== __Examples__
--
=====================================
libraries/base/src/GHC/List.hs
=====================================
@@ -69,6 +69,12 @@ infix 4 `elem`, `notElem`
-- | \(\mathcal{O}(1)\). Extract the first element of a list, which must be non-empty.
--
+-- To disable the warning about partiality put @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@
+-- at the top of the file. To disable it throughout a package put the same
+-- options into @ghc-options@ section of Cabal file. To disable it in GHCi
+-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ config file.
+-- See also the [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/warning-for-head-and-tail.md).
+--
-- ===== __Examples__
--
-- >>> head [1, 2, 3]
@@ -84,7 +90,7 @@ head (x:_) = x
head [] = badHead
{-# NOINLINE [1] head #-}
-{-# WARNING in "x-partial" head "This is a partial function, it throws an error on empty lists. Use pattern matching or Data.List.uncons instead. Consider refactoring to use Data.List.NonEmpty." #-}
+{-# WARNING in "x-partial" head "This is a partial function, it throws an error on empty lists. Use pattern matching, 'Data.List.uncons' or 'Data.Maybe.listToMaybe' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-}
badHead :: HasCallStack => a
badHead = errorEmptyList "head"
@@ -164,6 +170,12 @@ unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing
-- | \(\mathcal{O}(1)\). Extract the elements after the head of a list, which
-- must be non-empty.
--
+-- To disable the warning about partiality put @{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}@
+-- at the top of the file. To disable it throughout a package put the same
+-- options into @ghc-options@ section of Cabal file. To disable it in GHCi
+-- put @:set -Wno-x-partial -Wno-unrecognised-warning-flags@ into @~/.ghci@ config file.
+-- See also the [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/warning-for-head-and-tail.md).
+--
-- ==== __Examples__
--
-- >>> tail [1, 2, 3]
@@ -178,7 +190,7 @@ tail :: HasCallStack => [a] -> [a]
tail (_:xs) = xs
tail [] = errorEmptyList "tail"
-{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with drop 1, or use pattern matching or Data.List.uncons instead. Consider refactoring to use Data.List.NonEmpty." #-}
+{-# WARNING in "x-partial" tail "This is a partial function, it throws an error on empty lists. Replace it with 'drop' 1, or use pattern matching or 'Data.List.uncons' instead. Consider refactoring to use \"Data.List.NonEmpty\"." #-}
-- | \(\mathcal{O}(n)\). Extract the last element of a list, which must be
-- finite and non-empty.
=====================================
libraries/base/tests/IO/all.T
=====================================
@@ -63,7 +63,7 @@ test('hSetBuffering004', set_stdin('hSetBuffering004.hs'), compile_and_run, ['']
test('ioeGetErrorString001', normal, compile_and_run, ['-cpp'])
test('ioeGetFileName001', normal, compile_and_run, ['-cpp'])
test('ioeGetHandle001', normal, compile_and_run, ['-cpp'])
-test('isEOF001', [extra_run_opts('</dev/null'), when(arch('wasm32'), fragile(23275))], compile_and_run, [''])
+test('isEOF001', [extra_run_opts('</dev/null')], compile_and_run, [''])
test('misc001', [extra_run_opts('misc001.hs misc001.out')], compile_and_run,
[''])
@@ -76,7 +76,7 @@ test('openFile005', js_broken(22261), compile_and_run, [''])
test('openFile006', [], compile_and_run, [''])
test('openFile007', js_broken(22261), compile_and_run, [''])
test('openFile008', [cmd_prefix('ulimit -n 1024; ')], compile_and_run, [''])
-test('openFile009', [when(arch('wasm32'), fragile(23284))], compile_and_run, [''])
+test('openFile009', [], compile_and_run, [''])
test('putStr001', normal, compile_and_run, [''])
test('readFile001', js_broken(22261), compile_and_run, [''])
@@ -155,7 +155,6 @@ test('encodingerror001', normal, compile_and_run, [''])
# Requires use of the FD interface which is not supported under WINIO
test('T4808', [when(opsys('mingw32'), skip)
- , when(arch('wasm32'), fragile(23284))
,fragile_for(16909, concurrent_ways), exit_code(1)]
, compile_and_run, [''])
test('T4895', normal, compile_and_run, [''])
=====================================
libraries/base/tests/all.T
=====================================
@@ -175,9 +175,8 @@ test('T7457', normal, compile_and_run, [''])
test('T7773',
[when(opsys('mingw32'), skip),
js_broken(22261),
- expect_broken_for(23272, ['ghci-opt']), # unclear
- when(arch('wasm32'),
- fragile(23275))],
+ expect_broken_for(23272, ['ghci-opt']) # unclear
+ ],
compile_and_run,
[''])
# Andreas says that T7773 will not (and should not) work on Windows
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -29,7 +29,7 @@ test('cgrun021', extra_ways(['nursery_chunks']), compile_and_run, [''])
test('cgrun022', normal, compile_and_run, [''])
test('cgrun024', normal, compile_and_run, [''])
test('cgrun025',
- [ omit_ghci, extra_run_opts('cgrun025.hs < /dev/null'), exit_code(1), when(arch('wasm32'), fragile(23275))],
+ [ omit_ghci, extra_run_opts('cgrun025.hs < /dev/null'), exit_code(1) ],
compile_and_run, [''])
test('cgrun026', normal, compile_and_run, [''])
test('cgrun027', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aeb4de1934f072fb7437afdd1a0cefee70c27f5c...20bce39d16f438d4fbddb7f0298362520dde88ce
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aeb4de1934f072fb7437afdd1a0cefee70c27f5c...20bce39d16f438d4fbddb7f0298362520dde88ce
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240118/9412ef1f/attachment-0001.html>
More information about the ghc-commits
mailing list