[Git][ghc/ghc][wip/T24251a] 11 commits: Remove duplicate code normalising slashes
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Thu Mar 14 15:43:41 UTC 2024
Simon Peyton Jones pushed to branch wip/T24251a at Glasgow Haskell Compiler / GHC
Commits:
b85a4631 by Brandon Chinn at 2024-03-12T19:25:56-04:00
Remove duplicate code normalising slashes
- - - - -
c91946f9 by Brandon Chinn at 2024-03-12T19:25:56-04:00
Simplify regexes with raw strings
- - - - -
1a5f53c6 by Brandon Chinn at 2024-03-12T19:25:57-04:00
Don't normalize backslashes in characters
- - - - -
7ea971d3 by Andrei Borzenkov at 2024-03-12T19:26:32-04:00
Fix compiler crash caused by implicit RHS quantification in type synonyms (#24470)
- - - - -
39f3ac3e by Cheng Shao at 2024-03-12T19:27:11-04:00
Revert "compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms"
This reverts commit 615eb855416ce536e02ed935ecc5a6f25519ae16. It was
originally intended to fix #24449, but it was merely sweeping the bug
under the rug. 3836a110577b5c9343915fd96c1b2c64217e0082 has properly
fixed the fragile test, and we no longer need the C version of genSym.
Furthermore, the C implementation causes trouble when compiling with
clang that targets i386 due to alignment warning and libatomic linking
issue, so it makes sense to revert it.
- - - - -
e6bfb85c by Cheng Shao at 2024-03-12T19:27:11-04:00
compiler: fix out-of-bound memory access of genSym on 32-bit
This commit fixes an unnoticed out-of-bound memory access of genSym on
32-bit. ghc_unique_inc is 32-bit sized/aligned on 32-bit platforms,
but we mistakenly treat it as a Word64 pointer in genSym, and
therefore will accidentally load 2 garbage higher bytes, or with a
small but non-zero chance, overwrite something else in the data
section depends on how the linker places the data segments. This
regression was introduced in !11802 and fixed here.
- - - - -
77171cd1 by Ben Orchard at 2024-03-14T09:00:40-04:00
Note mutability of array and address access primops
Without an understanding of immutable vs. mutable memory, the index
primop family have a potentially non-intuitive type signature:
indexOffAddr :: Addr# -> Int# -> a
readOffAddr :: Addr# -> Int# -> State# d -> (# State# d, a #)
indexOffAddr# might seem like a free generality improvement, which it
certainly is not!
This change adds a brief note on mutability expectations for most
index/read/write access primops.
- - - - -
7da7f8f6 by Alan Zimmerman at 2024-03-14T09:01:15-04:00
EPA: Fix regression discarding comments in contexts
Closes #24533
- - - - -
25a754c5 by Simon Peyton Jones at 2024-03-14T15:43:15+00:00
Rename tryCaseMerge
- - - - -
8b8a269c by Simon Peyton Jones at 2024-03-14T15:43:16+00:00
Try a more clever discard-eval
Addresses programs like this
f xs = xs `seq`
(let t = reverse $ reverse $ reverse $ reverse $ reverse $ reverse xs in
case xs of
[] -> (t,True)
(_:_) -> (t,False))
Also including the case where t is a join point.
Relates to #24251. See GHC Log 13 March
- - - - -
9975ad57 by Simon Peyton Jones at 2024-03-14T15:43:16+00:00
Wibbles
- - - - -
27 changed files:
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Unique/Supply.hs
- compiler/cbits/genSym.c
- testsuite/driver/testlib.py
- testsuite/tests/parser/should_fail/T21843a.stderr
- testsuite/tests/parser/should_fail/T21843b.stderr
- testsuite/tests/parser/should_fail/T21843c.stderr
- testsuite/tests/parser/should_fail/T21843d.stderr
- testsuite/tests/parser/should_fail/T21843e.stderr
- testsuite/tests/parser/should_fail/T21843f.stderr
- testsuite/tests/printer/Makefile
- + testsuite/tests/printer/Test24533.hs
- + testsuite/tests/printer/Test24533.stdout
- testsuite/tests/printer/all.T
- + testsuite/tests/typecheck/should_compile/T24470b.hs
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/typecheck/should_fail/T24470a.hs
- + testsuite/tests/typecheck/should_fail/T24470a.stderr
- testsuite/tests/typecheck/should_fail/all.T
- utils/genprimopcode/AccessOps.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -17,7 +17,7 @@ module GHC.Core.Opt.Simplify.Env (
seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames,
seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline,
seRuleOpts, seRules, seUnfoldingOpts,
- mkSimplEnv, extendIdSubst,
+ mkSimplEnv, extendIdSubst, extendCvIdSubst,
extendTvSubst, extendCvSubst,
zapSubstEnv, setSubstEnv, bumpCaseDepth,
getInScope, setInScopeFromE, setInScopeFromF,
@@ -550,6 +550,10 @@ extendCvSubst env@(SimplEnv {seCvSubst = csubst}) var co
= assert (isCoVar var) $
env {seCvSubst = extendVarEnv csubst var co}
+extendCvIdSubst :: SimplEnv -> Id -> OutExpr -> SimplEnv
+extendCvIdSubst env bndr (Coercion co) = extendCvSubst env bndr co
+extendCvIdSubst env bndr rhs = extendIdSubst env bndr (DoneEx rhs NotJoinPoint)
+
---------------------
getInScope :: SimplEnv -> InScopeSet
getInScope env = seInScope env
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -412,9 +412,7 @@ simplAuxBind env bndr new_rhs
-- have no NOLINE pragmas, nor RULEs
| exprIsTrivial new_rhs -- Short-cut for let x = y in ...
= return ( emptyFloats env
- , case new_rhs of
- Coercion co -> extendCvSubst env bndr co
- _ -> extendIdSubst env bndr (DoneEx new_rhs NotJoinPoint) )
+ , extendCvIdSubst env bndr new_rhs ) -- bndr can be a CoVar
| otherwise
= do { -- ANF-ise the RHS
@@ -3053,12 +3051,20 @@ rebuildCase env scrut case_bndr alts cont
-- 2. Eliminate the case if scrutinee is evaluated
--------------------------------------------------
-rebuildCase env scrut case_bndr alts@[Alt _ bndrs rhs] cont
+rebuildCase env scrut case_bndr alts@[Alt con bndrs rhs] cont
-- See if we can get rid of the case altogether
-- See Note [Case elimination]
-- mkCase made sure that if all the alternatives are equal,
-- then there is now only one (DEFAULT) rhs
+ | DEFAULT <- con
+ , exprIsTrivial scrut
+ , isEvaldSoon case_bndr rhs
+ = assert( null bndrs ) $
+ do { tick (CaseElim case_bndr)
+ ; simplExprF (extendCvIdSubst env case_bndr scrut) rhs cont }
+ -- case_bndr can be a CoVar
+
-- 2a. Dropping the case altogether, if
-- a) it binds nothing (so it's really just a 'seq')
-- b) evaluating the scrutinee has no side effects
@@ -3106,6 +3112,24 @@ rebuildCase env scrut case_bndr alts cont
= reallyRebuildCase env scrut case_bndr alts cont
+isEvaldSoon :: InId -> InExpr -> Bool
+-- (isEvaldSoon b e) is True is evaluated soon by e
+isEvaldSoon bndr expr
+ = go expr
+ where
+ go (Var v) = v==bndr
+ go (Case scrut cb _ alts)
+ | Var v <- scrut, v==bndr = True
+ | otherwise = all go_alt alts && cb /= bndr && all ok_alt alts
+ -- ok_alt only runs if things look good
+ go (Let _ e) = go e
+ go (Tick _ e) = go e
+ go (Cast e _) = go e
+ go _ = False
+
+ go_alt (Alt _ _ rhs) = go rhs
+ ok_alt (Alt _ cbs _) = not (bndr `elem` cbs)
+
doCaseToLet :: OutExpr -- Scrutinee
-> InId -- Case binder
-> Bool
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -2395,7 +2395,7 @@ Wrinkles
This story is not fully robust; it will be defeated by a let-binding,
whih we don't want to duplicate. But accounting for single-alternative
case-on-variable is easy to do, and seems useful in common cases so
- `tryMergeCase` does it.
+ `tryCaseMerge` does it.
Note [Eliminate Identity Case]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2578,7 +2578,7 @@ mkCase, mkCase1, mkCase2, mkCase3
mkCase mode scrut outer_bndr alts_ty alts
| sm_case_merge mode
- , Just alts' <- tryMergeCase outer_bndr alts
+ , Just alts' <- tryCaseMerge outer_bndr alts
= do { tick (CaseMerge outer_bndr)
; mkCase1 mode scrut outer_bndr alts_ty alts' }
-- Warning: don't call mkCase recursively!
@@ -2589,9 +2589,9 @@ mkCase mode scrut outer_bndr alts_ty alts
| otherwise
= mkCase1 mode scrut outer_bndr alts_ty alts
-tryMergeCase :: OutId -> [OutAlt] -> Maybe [OutAlt]
+tryCaseMerge :: OutId -> [OutAlt] -> Maybe [OutAlt]
-- See Note [Merge Nested Cases]
-tryMergeCase outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
+tryCaseMerge outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
= case go 5 (\e -> e) emptyVarSet deflt_rhs of
Nothing -> Nothing
Just inner_alts -> Just (mergeAlts outer_alts inner_alts)
@@ -2630,7 +2630,7 @@ tryMergeCase outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
go n wrap free_bndrs (Case (Var inner_scrut) inner_bndr ty inner_alts)
| [Alt con bndrs rhs] <- inner_alts -- Wrinkle (MC1)
, let wrap_case rhs' = Case (Var inner_scrut) inner_bndr ty $
- tryMergeCase inner_bndr alts `orElse` alts
+ tryCaseMerge inner_bndr alts `orElse` alts
where
alts = [Alt con bndrs rhs']
= assert (not (outer_bndr `elem` (inner_bndr : bndrs))) $
@@ -2638,7 +2638,7 @@ tryMergeCase outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
go _ _ _ _ = Nothing
-tryMergeCase _ _ = Nothing
+tryCaseMerge _ _ = Nothing
--------------------------------------------------
-- 2. Eliminate Identity Case
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1135,8 +1135,8 @@ checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
-- (((Eq a))) --> [Eq a]
-- @
checkContext :: LHsType GhcPs -> P (LHsContext GhcPs)
-checkContext orig_t@(L (EpAnn l _ _) _orig_t) =
- check ([],[],emptyComments) orig_t
+checkContext orig_t@(L (EpAnn l _ cs) _orig_t) =
+ check ([],[],cs) orig_t
where
check :: ([EpaLocation],[EpaLocation],EpAnnComments)
-> LHsType GhcPs -> P (LHsContext GhcPs)
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1922,6 +1922,18 @@ instance Diagnostic TcRnMessage where
, text "in a fixity signature"
]
+ TcRnOutOfArityTyVar ts_name tv_name -> mkDecorated
+ [ vcat [ text "The arity of" <+> quotes (ppr ts_name) <+> text "is insufficiently high to accommodate"
+ , text "an implicit binding for the" <+> quotes (ppr tv_name) <+> text "type variable." ]
+ , suggestion ]
+ where
+ suggestion =
+ text "Use" <+> quotes at_bndr <+> text "on the LHS" <+>
+ text "or" <+> quotes forall_bndr <+> text "on the RHS" <+>
+ text "to bring it into scope."
+ at_bndr = char '@' <> ppr tv_name
+ forall_bndr = text "forall" <+> ppr tv_name <> text "."
+
diagnosticReason :: TcRnMessage -> DiagnosticReason
diagnosticReason = \case
TcRnUnknownMessage m
@@ -2556,6 +2568,8 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnNamespacedFixitySigWithoutFlag{}
-> ErrorWithoutFlag
+ TcRnOutOfArityTyVar{}
+ -> ErrorWithoutFlag
diagnosticHints = \case
TcRnUnknownMessage m
@@ -3224,6 +3238,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnNamespacedFixitySigWithoutFlag{}
-> [suggestExtension LangExt.ExplicitNamespaces]
+ TcRnOutOfArityTyVar{}
+ -> noHints
diagnosticCode = constructorCode
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -2272,6 +2272,8 @@ data TcRnMessage where
where the implicitly-bound type type variables can't be matched up unambiguously
with the ones from the signature. See Note [Disconnected type variables] in
GHC.Tc.Gen.HsType.
+
+ Test cases: T24083
-}
TcRnDisconnectedTyVar :: !Name -> TcRnMessage
@@ -4267,6 +4269,24 @@ data TcRnMessage where
-}
TcRnDefaultedExceptionContext :: CtLoc -> TcRnMessage
+ {-| TcRnOutOfArityTyVar is an error raised when the arity of a type synonym
+ (as determined by the SAKS and the LHS) is insufficiently high to
+ accommodate an implicit binding for a free variable that occurs in the
+ outermost kind signature on the RHS of the said type synonym.
+
+ Example:
+
+ type SynBad :: forall k. k -> Type
+ type SynBad = Proxy :: j -> Type
+
+ Test cases:
+ T24770a
+ -}
+ TcRnOutOfArityTyVar
+ :: Name -- ^ Type synonym's name
+ -> Name -- ^ Type variable's name
+ -> TcRnMessage
+
deriving Generic
----
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -2617,7 +2617,7 @@ kcCheckDeclHeader_sig sig_kind name flav
; implicit_tvs <- liftZonkM $ zonkTcTyVarsToTcTyVars implicit_tvs
; let implicit_prs = implicit_nms `zip` implicit_tvs
; checkForDuplicateScopedTyVars implicit_prs
- ; checkForDisconnectedScopedTyVars flav all_tcbs implicit_prs
+ ; checkForDisconnectedScopedTyVars name flav all_tcbs implicit_prs
-- Swizzle the Names so that the TyCon uses the user-declared implicit names
-- E.g type T :: k -> Type
@@ -2978,25 +2978,32 @@ expectedKindInCtxt _ = OpenKind
* *
********************************************************************* -}
-checkForDisconnectedScopedTyVars :: TyConFlavour TyCon -> [TcTyConBinder]
+checkForDisconnectedScopedTyVars :: Name -> TyConFlavour TyCon -> [TcTyConBinder]
-> [(Name,TcTyVar)] -> TcM ()
-- See Note [Disconnected type variables]
+-- For the type synonym case see Note [Out of arity type variables]
-- `scoped_prs` is the mapping gotten by unifying
-- - the standalone kind signature for T, with
-- - the header of the type/class declaration for T
-checkForDisconnectedScopedTyVars flav sig_tcbs scoped_prs
- = when (needsEtaExpansion flav) $
+checkForDisconnectedScopedTyVars name flav all_tcbs scoped_prs
-- needsEtaExpansion: see wrinkle (DTV1) in Note [Disconnected type variables]
- mapM_ report_disconnected (filterOut ok scoped_prs)
+ | needsEtaExpansion flav = mapM_ report_disconnected (filterOut ok scoped_prs)
+ | flav == TypeSynonymFlavour = mapM_ report_out_of_arity (filterOut ok scoped_prs)
+ | otherwise = pure ()
where
- sig_tvs = mkVarSet (binderVars sig_tcbs)
- ok (_, tc_tv) = tc_tv `elemVarSet` sig_tvs
+ all_tvs = mkVarSet (binderVars all_tcbs)
+ ok (_, tc_tv) = tc_tv `elemVarSet` all_tvs
report_disconnected :: (Name,TcTyVar) -> TcM ()
report_disconnected (nm, _)
= setSrcSpan (getSrcSpan nm) $
addErrTc $ TcRnDisconnectedTyVar nm
+ report_out_of_arity :: (Name,TcTyVar) -> TcM ()
+ report_out_of_arity (tv_nm, _)
+ = setSrcSpan (getSrcSpan tv_nm) $
+ addErrTc $ TcRnOutOfArityTyVar name tv_nm
+
checkForDuplicateScopedTyVars :: [(Name,TcTyVar)] -> TcM ()
-- Check for duplicates
-- E.g. data SameKind (a::k) (b::k)
@@ -3083,6 +3090,63 @@ explicitly, rather than binding it implicitly via unification.
The scoped-tyvar stuff is needed precisely for data/class/newtype declarations,
where needsEtaExpansion is True.
+
+Note [Out of arity type variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+(Relevant ticket: #24470)
+Type synonyms have a special scoping rule that allows implicit quantification in
+the outermost kind signature:
+
+ type P_e :: k -> Type
+ type P_e @k = Proxy :: k -> Type -- explicit binding
+
+ type P_i = Proxy :: k -> Type -- implicit binding (relies on the special rule)
+
+This is a deprecated feature (warning flag: -Wimplicit-rhs-quantification) but
+we have to support it for a couple more releases. It is explained in more detail
+in Note [Implicit quantification in type synonyms] in GHC.Rename.HsType.
+
+Type synonyms `P_e` and `P_i` are equivalent. Both of them have kind
+`forall k. k -> Type` and arity 1. (Recall that the arity of a type synonym is
+the number of arguments it requires at use sites; the arity matter because
+unsaturated application of type families and type synonyms is not allowed).
+
+We start to see problems when implicit RHS quantification (as in `P_i`) is
+combined with a standalone king signature (like the one that `P_e` has).
+That is:
+
+ type P_i_sig :: k -> Type
+ type P_i_sig = Proxy :: k -> Type
+
+Per GHC Proposal #425, the arity of `P_i_sig` is determined /by the LHS only/,
+which has no binders. So the arity of `P_i_sig` is 0.
+At the same time, the legacy implicit quantification rule dictates that `k` is
+brought into scope, as if there was a binder `@k` on the LHS.
+
+We end up with a `k` that is in scope on the RHS but cannot be bound implicitly
+on the LHS without affecting the arity. This led to #24470 (a compiler crash)
+
+ GHC internal error: ‘k’ is not in scope during type checking,
+ but it passed the renamer
+
+This problem occurs only if the arity of the type synonym is insufficiently
+high to accommodate an implicit binding. It can be worked around by adding an
+unused binder on the LHS:
+
+ type P_w :: k -> Type
+ type P_w @_w = Proxy :: k -> Type
+
+The variable `_w` is unused. The only effect of the `@_w` binder is that the
+arity of `P_w` is changed from 0 to 1. However, bumping the arity is exactly
+what's needed to make the implicit binding of `k` possible.
+
+All this is a rather unfortunate bit of accidental complexity that will go away
+when GHC drops support for implicit RHS quantification. In the meantime, we
+ought to produce a proper error message instead of a compiler panic, and we do
+that with a check in checkForDisconnectedScopedTyVars:
+
+ | flav == TypeSynonymFlavour = mapM_ report_out_of_arity (filterOut ok scoped_prs)
+
-}
{- *********************************************************************
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -606,6 +606,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnInvisPatWithNoForAll" = 14964
GhcDiagnosticCode "TcRnIllegalInvisibleTypePattern" = 78249
GhcDiagnosticCode "TcRnNamespacedFixitySigWithoutFlag" = 78534
+ GhcDiagnosticCode "TcRnOutOfArityTyVar" = 84925
-- TcRnTypeApplicationsDisabled
GhcDiagnosticCode "TypeApplication" = 23482
=====================================
compiler/GHC/Types/Unique/Supply.hs
=====================================
@@ -7,7 +7,6 @@
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
module GHC.Types.Unique.Supply (
-- * Main data type
@@ -49,16 +48,16 @@ import Foreign.Storable
#define NO_FETCH_ADD
#endif
-#if defined(javascript_HOST_ARCH)
-import GHC.Exts ( atomicCasWord64Addr#, eqWord64# )
-#elif !defined(NO_FETCH_ADD)
-import GHC.Exts( fetchAddWordAddr#, word64ToWord#, wordToWord64# )
+#if defined(NO_FETCH_ADD)
+import GHC.Exts ( atomicCasWord64Addr#, eqWord64#, readWord64OffAddr# )
+#else
+import GHC.Exts( fetchAddWordAddr#, word64ToWord# )
#endif
import GHC.Exts ( Addr#, State#, Word64#, RealWorld )
-
+import GHC.Int ( Int(..) )
import GHC.Word( Word64(..) )
-import GHC.Exts( plusWord64#, readWord64OffAddr# )
+import GHC.Exts( plusWord64#, int2Word#, wordToWord64# )
{-
************************************************************************
@@ -233,8 +232,9 @@ mkSplitUniqSupply c
(# s4, MkSplitUniqSupply (tag .|. u) x y #)
}}}}
-#if defined(javascript_HOST_ARCH)
--- CAS-based pure Haskell implementation
+#if defined(NO_FETCH_ADD)
+-- GHC currently does not provide this operation on 32-bit platforms,
+-- hence the CAS-based implementation.
fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
-> (# State# RealWorld, Word64# #)
fetchAddWord64Addr# = go
@@ -246,35 +246,7 @@ fetchAddWord64Addr# = go
(# s2, res #)
| 1# <- res `eqWord64#` n0 -> (# s2, n0 #)
| otherwise -> go ptr inc s2
-
-#elif defined(NO_FETCH_ADD)
-
--- atomic_inc64 is defined in compiler/cbits/genSym.c. This is of
--- course not ideal, but we need to live with it for now given the
--- current situation:
--- 1. There's no Haskell primop fetchAddWord64Addr# on 32-bit
--- platforms yet
--- 2. The Cmm %fetch_add64 primop syntax is only present in ghc 9.8
--- but we currently bootstrap from older ghc in our CI
--- 3. The Cmm MO_AtomicRMW operation with 64-bit width is well
--- supported on 32-bit platforms already, but the plumbing from
--- either Haskell or Cmm doesn't work yet because of 1 or 2
--- 4. There's hs_atomic_add64 in ghc-prim cbits that we ought to use,
--- but it's only available on 32-bit starting from ghc 9.8
--- 5. The pure Haskell implementation causes mysterious i386
--- regression in unrelated ghc work that can only be fixed by the C
--- version here
-
-foreign import ccall unsafe "atomic_inc64" atomic_inc64 :: Addr# -> Word64# -> IO Word64
-
-fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
- -> (# State# RealWorld, Word64# #)
-fetchAddWord64Addr# addr inc s0 =
- case unIO (atomic_inc64 addr inc) s0 of
- (# s1, W64# res #) -> (# s1, res #)
-
#else
-
fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
-> (# State# RealWorld, Word64# #)
fetchAddWord64Addr# addr inc s0 =
@@ -286,9 +258,9 @@ genSym :: IO Word64
genSym = do
let !mask = (1 `unsafeShiftL` uNIQUE_BITS) - 1
let !(Ptr counter) = ghc_unique_counter64
- let !(Ptr inc_ptr) = ghc_unique_inc
- u <- IO $ \s0 -> case readWord64OffAddr# inc_ptr 0# s0 of
- (# s1, inc #) -> case fetchAddWord64Addr# counter inc s1 of
+ I# inc# <- peek ghc_unique_inc
+ let !inc = wordToWord64# (int2Word# inc#)
+ u <- IO $ \s1 -> case fetchAddWord64Addr# counter inc s1 of
(# s2, val #) ->
let !u = W64# (val `plusWord64#` inc) .&. mask
in (# s2, u #)
=====================================
compiler/cbits/genSym.c
=====================================
@@ -15,11 +15,3 @@ HsWord64 ghc_unique_counter64 = 0;
#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
HsInt ghc_unique_inc = 1;
#endif
-
-// Only used on 32-bit non-JS platforms
-#if WORD_SIZE_IN_BITS != 64
-StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 incr)
-{
- return __atomic_fetch_add(p, incr, __ATOMIC_SEQ_CST);
-}
-#endif
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1119,8 +1119,8 @@ def normalise_win32_io_errors(name, opts):
def normalise_version_( *pkgs ):
def normalise_version__( str ):
# (name)(-version)(-hash)(-components)
- return re.sub('(' + '|'.join(map(re.escape,pkgs)) + ')-[0-9.]+(-[0-9a-zA-Z\+]+)?(-[0-9a-zA-Z]+)?',
- '\\1-<VERSION>-<HASH>', str)
+ return re.sub('(' + '|'.join(map(re.escape,pkgs)) + r')-[0-9.]+(-[0-9a-zA-Z+]+)?(-[0-9a-zA-Z]+)?',
+ r'\1-<VERSION>-<HASH>', str)
return normalise_version__
def normalise_version( *pkgs ):
@@ -1491,7 +1491,7 @@ async def do_test(name: TestName,
if opts.expect not in ['pass', 'fail', 'missing-lib']:
framework_fail(name, way, 'bad expected ' + opts.expect)
- directory = re.sub('^\\.[/\\\\]', '', str(opts.testdir))
+ directory = re.sub(r'^\.[/\\]', '', str(opts.testdir))
if way in opts.fragile_ways:
if_verbose(1, '*** fragile test %s resulted in %s' % (full_name, 'pass' if result.passed else 'fail'))
@@ -1538,7 +1538,7 @@ def override_options(pre_cmd):
def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str) -> None:
opts = getTestOpts()
- directory = re.sub('^\\.[/\\\\]', '', str(opts.testdir))
+ directory = re.sub(r'^\.[/\\]', '', str(opts.testdir))
full_name = '%s(%s)' % (name, way)
if_verbose(1, '*** framework failure for %s %s ' % (full_name, reason))
name2 = name if name is not None else TestName('none')
@@ -1549,7 +1549,7 @@ def framework_fail(name: Optional[TestName], way: Optional[WayName], reason: str
def framework_warn(name: TestName, way: WayName, reason: str) -> None:
opts = getTestOpts()
- directory = re.sub('^\\.[/\\\\]', '', str(opts.testdir))
+ directory = re.sub(r'^\.[/\\]', '', str(opts.testdir))
full_name = name + '(' + way + ')'
if_verbose(1, '*** framework warning for %s %s ' % (full_name, reason))
t.framework_warnings.append(TestResult(directory, name, reason, way))
@@ -2598,8 +2598,9 @@ def normalise_errmsg(s: str) -> str:
s = normalise_callstacks(s)
s = normalise_type_reps(s)
- # normalise slashes, minimise Windows/Unix filename differences
- s = re.sub('\\\\', '/', s)
+ # normalise slashes to minimise Windows/Unix filename differences,
+ # but don't normalize backslashes in chars
+ s = re.sub(r"(?!')\\", '/', s)
# Normalize the name of the GHC executable. Specifically,
# this catches the cases that:
@@ -2614,14 +2615,11 @@ def normalise_errmsg(s: str) -> str:
# the colon is there because it appears in error messages; this
# hacky solution is used in place of more sophisticated filename
# mangling
- s = re.sub('([^\\s])\\.exe', '\\1', s)
+ s = re.sub(r'([^\s])\.exe', r'\1', s)
# Same thing for .wasm modules generated by the Wasm backend
- s = re.sub('([^\\s])\\.wasm', '\\1', s)
+ s = re.sub(r'([^\s])\.wasm', r'\1', s)
# Same thing for .jsexe directories generated by the JS backend
- s = re.sub('([^\\s])\\.jsexe', '\\1', s)
-
- # normalise slashes, minimise Windows/Unix filename differences
- s = re.sub('\\\\', '/', s)
+ s = re.sub(r'([^\s])\.jsexe', r'\1', s)
# hpc executable is given ghc suffix
s = re.sub('hpc-ghc', 'hpc', s)
@@ -2631,8 +2629,8 @@ def normalise_errmsg(s: str) -> str:
s = re.sub('ghc-stage[123]', 'ghc', s)
# Remove platform prefix (e.g. javascript-unknown-ghcjs) for cross-compiled tools
# (ghc, ghc-pkg, unlit, etc.)
- s = re.sub('\\w+(-\\w+)*-ghc', 'ghc', s)
- s = re.sub('\\w+(-\\w+)*-unlit', 'unlit', s)
+ s = re.sub(r'\w+(-\w+)*-ghc', 'ghc', s)
+ s = re.sub(r'\w+(-\w+)*-unlit', 'unlit', s)
# On windows error messages can mention versioned executables
s = re.sub('ghc-[0-9.]+', 'ghc', s)
@@ -2735,8 +2733,8 @@ def normalise_prof (s: str) -> str:
return s
def normalise_slashes_( s: str ) -> str:
- s = re.sub('\\\\', '/', s)
- s = re.sub('//', '/', s)
+ s = re.sub(r'\\', '/', s)
+ s = re.sub(r'//', '/', s)
return s
def normalise_exe_( s: str ) -> str:
@@ -2754,9 +2752,9 @@ def normalise_output( s: str ) -> str:
# and .wasm extension (for the Wasm backend)
# and .jsexe extension (for the JS backend)
# This can occur in error messages generated by the program.
- s = re.sub('([^\\s])\\.exe', '\\1', s)
- s = re.sub('([^\\s])\\.wasm', '\\1', s)
- s = re.sub('([^\\s])\\.jsexe', '\\1', s)
+ s = re.sub(r'([^\s])\.exe', r'\1', s)
+ s = re.sub(r'([^\s])\.wasm', r'\1', s)
+ s = re.sub(r'([^\s])\.jsexe', r'\1', s)
s = normalise_callstacks(s)
s = normalise_type_reps(s)
# ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is
@@ -2776,7 +2774,7 @@ def normalise_output( s: str ) -> str:
s = re.sub('.*warning: argument unused during compilation:.*\n', '', s)
# strip the cross prefix if any
- s = re.sub('\\w+(-\\w+)*-ghc', 'ghc', s)
+ s = re.sub(r'\w+(-\w+)*-ghc', 'ghc', s)
return s
=====================================
testsuite/tests/parser/should_fail/T21843a.stderr
=====================================
@@ -1,4 +1,4 @@
T21843a.hs:3:13: [GHC-31623]
- Unicode character '“' ('/8220') looks like '"' (Quotation Mark), but it is not
+ Unicode character '“' ('\8220') looks like '"' (Quotation Mark), but it is not
=====================================
testsuite/tests/parser/should_fail/T21843b.stderr
=====================================
@@ -1,3 +1,3 @@
T21843b.hs:3:11: [GHC-31623]
- Unicode character '‘' ('/8216') looks like ''' (Single Quote), but it is not
+ Unicode character '‘' ('\8216') looks like ''' (Single Quote), but it is not
=====================================
testsuite/tests/parser/should_fail/T21843c.stderr
=====================================
@@ -1,6 +1,6 @@
T21843c.hs:3:19: [GHC-31623]
- Unicode character '”' ('/8221') looks like '"' (Quotation Mark), but it is not
+ Unicode character '”' ('\8221') looks like '"' (Quotation Mark), but it is not
T21843c.hs:3:20: [GHC-21231]
- lexical error in string/character literal at character '/n'
+ lexical error in string/character literal at character '\n'
=====================================
testsuite/tests/parser/should_fail/T21843d.stderr
=====================================
@@ -1,3 +1,3 @@
T21843d.hs:3:13: [GHC-31623]
- Unicode character '’' ('/8217') looks like ''' (Single Quote), but it is not
+ Unicode character '’' ('\8217') looks like ''' (Single Quote), but it is not
=====================================
testsuite/tests/parser/should_fail/T21843e.stderr
=====================================
@@ -1,3 +1,3 @@
T21843e.hs:3:15: [GHC-31623]
- Unicode character '”' ('/8221') looks like '"' (Quotation Mark), but it is not
+ Unicode character '”' ('\8221') looks like '"' (Quotation Mark), but it is not
=====================================
testsuite/tests/parser/should_fail/T21843f.stderr
=====================================
@@ -1,3 +1,3 @@
T21843f.hs:3:13: [GHC-31623]
- Unicode character '‘' ('/8216') looks like ''' (Single Quote), but it is not
+ Unicode character '‘' ('\8216') looks like ''' (Single Quote), but it is not
=====================================
testsuite/tests/printer/Makefile
=====================================
@@ -816,3 +816,8 @@ Test23885:
AnnotationNoListTuplePuns:
$(CHECK_PPR) $(LIBDIR) AnnotationNoListTuplePuns.hs
$(CHECK_EXACT) $(LIBDIR) AnnotationNoListTuplePuns.hs
+
+.PHONY: Test24533
+Test24533:
+ $(CHECK_PPR) $(LIBDIR) Test24533.hs
+ $(CHECK_EXACT) $(LIBDIR) Test24533.hs
=====================================
testsuite/tests/printer/Test24533.hs
=====================================
@@ -0,0 +1,8 @@
+{-# OPTIONS -ddump-parsed-ast #-}
+module Test24533 where
+
+instance
+ ( Read a, -- Weird
+ Read b
+ ) =>
+ Read (a, b)
=====================================
testsuite/tests/printer/Test24533.stdout
=====================================
@@ -0,0 +1,548 @@
+
+==================== Parser AST ====================
+
+(L
+ { Test24533.hs:1:1 }
+ (HsModule
+ (XModulePs
+ (EpAnn
+ (EpaSpan { Test24533.hs:1:1 })
+ (AnnsModule
+ [(AddEpAnn AnnModule (EpaSpan { Test24533.hs:2:1-6 }))
+ ,(AddEpAnn AnnWhere (EpaSpan { Test24533.hs:2:18-22 }))]
+ []
+ (Just
+ ((,)
+ { Test24533.hs:9:1 }
+ { Test24533.hs:8:13 })))
+ (EpaCommentsBalanced
+ [(L
+ (EpaSpan
+ { Test24533.hs:1:1-33 })
+ (EpaComment
+ (EpaBlockComment
+ "{-# OPTIONS -ddump-parsed-ast #-}")
+ { Test24533.hs:1:1 }))]
+ []))
+ (EpVirtualBraces
+ (1))
+ (Nothing)
+ (Nothing))
+ (Just
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:2:8-16 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ {ModuleName: Test24533}))
+ (Nothing)
+ []
+ [(L
+ (EpAnn
+ (EpaSpan { Test24533.hs:(4,1)-(8,13) })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (InstD
+ (NoExtField)
+ (ClsInstD
+ (NoExtField)
+ (ClsInstDecl
+ ((,,)
+ (Nothing)
+ [(AddEpAnn AnnInstance (EpaSpan { Test24533.hs:4:1-8 }))]
+ (NoAnnSortKey))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:(5,3)-(8,13) })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsSig
+ (NoExtField)
+ (HsOuterImplicit
+ (NoExtField))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:(5,3)-(8,13) })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsQualTy
+ (NoExtField)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:(5,3)-(7,3) })
+ (AnnContext
+ (Just
+ ((,)
+ (NormalSyntax)
+ (EpaSpan { Test24533.hs:7:5-6 })))
+ [(EpaSpan { Test24533.hs:5:3 })]
+ [(EpaSpan { Test24533.hs:7:3 })])
+ (EpaComments
+ [(L
+ (EpaSpan
+ { Test24533.hs:5:13-20 })
+ (EpaComment
+ (EpaLineComment
+ "-- Weird")
+ { Test24533.hs:5:11 }))]))
+ [(L
+ (EpAnn
+ (EpaSpan { Test24533.hs:5:5-10 })
+ (AnnListItem
+ [(AddCommaAnn
+ (EpaSpan { Test24533.hs:5:11 }))])
+ (EpaComments
+ []))
+ (HsAppTy
+ (NoExtField)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:5:5-8 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:5:5-8 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: Read}))))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:5:10 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:5:10 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: a}))))))
+ ,(L
+ (EpAnn
+ (EpaSpan { Test24533.hs:6:5-10 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsAppTy
+ (NoExtField)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:6:5-8 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:6:5-8 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: Read}))))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:6:10 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:6:10 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: b}))))))])
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:8:3-13 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsAppTy
+ (NoExtField)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:8:3-6 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:8:3-6 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: Read}))))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:8:8-13 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTupleTy
+ (AnnParen
+ AnnParens
+ (EpaSpan { Test24533.hs:8:8 })
+ (EpaSpan { Test24533.hs:8:13 }))
+ (HsBoxedOrConstraintTuple)
+ [(L
+ (EpAnn
+ (EpaSpan { Test24533.hs:8:9 })
+ (AnnListItem
+ [(AddCommaAnn
+ (EpaSpan { Test24533.hs:8:10 }))])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:8:9 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: a}))))
+ ,(L
+ (EpAnn
+ (EpaSpan { Test24533.hs:8:12 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.hs:8:12 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: b}))))]))))))))
+ {Bag(LocatedA (HsBind GhcPs)):
+ []}
+ []
+ []
+ []
+ (Nothing)))))]))
+
+
+
+==================== Parser AST ====================
+
+(L
+ { Test24533.ppr.hs:1:1 }
+ (HsModule
+ (XModulePs
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:1:1 })
+ (AnnsModule
+ [(AddEpAnn AnnModule (EpaSpan { Test24533.ppr.hs:2:1-6 }))
+ ,(AddEpAnn AnnWhere (EpaSpan { Test24533.ppr.hs:2:18-22 }))]
+ []
+ (Just
+ ((,)
+ { Test24533.ppr.hs:3:41 }
+ { Test24533.ppr.hs:3:40 })))
+ (EpaCommentsBalanced
+ [(L
+ (EpaSpan
+ { Test24533.ppr.hs:1:1-33 })
+ (EpaComment
+ (EpaBlockComment
+ "{-# OPTIONS -ddump-parsed-ast #-}")
+ { Test24533.ppr.hs:1:1 }))]
+ []))
+ (EpVirtualBraces
+ (1))
+ (Nothing)
+ (Nothing))
+ (Just
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:2:8-16 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ {ModuleName: Test24533}))
+ (Nothing)
+ []
+ [(L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:1-40 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (InstD
+ (NoExtField)
+ (ClsInstD
+ (NoExtField)
+ (ClsInstDecl
+ ((,,)
+ (Nothing)
+ [(AddEpAnn AnnInstance (EpaSpan { Test24533.ppr.hs:3:1-8 }))]
+ (NoAnnSortKey))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:10-40 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsSig
+ (NoExtField)
+ (HsOuterImplicit
+ (NoExtField))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:10-40 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsQualTy
+ (NoExtField)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:10-25 })
+ (AnnContext
+ (Just
+ ((,)
+ (NormalSyntax)
+ (EpaSpan { Test24533.ppr.hs:3:27-28 })))
+ [(EpaSpan { Test24533.ppr.hs:3:10 })]
+ [(EpaSpan { Test24533.ppr.hs:3:25 })])
+ (EpaComments
+ []))
+ [(L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:11-16 })
+ (AnnListItem
+ [(AddCommaAnn
+ (EpaSpan { Test24533.ppr.hs:3:17 }))])
+ (EpaComments
+ []))
+ (HsAppTy
+ (NoExtField)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:11-14 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:11-14 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: Read}))))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:16 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:16 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: a}))))))
+ ,(L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:19-24 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsAppTy
+ (NoExtField)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:19-22 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:19-22 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: Read}))))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:24 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:24 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: b}))))))])
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:30-40 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsAppTy
+ (NoExtField)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:30-33 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:30-33 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: Read}))))
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:35-40 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTupleTy
+ (AnnParen
+ AnnParens
+ (EpaSpan { Test24533.ppr.hs:3:35 })
+ (EpaSpan { Test24533.ppr.hs:3:40 }))
+ (HsBoxedOrConstraintTuple)
+ [(L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:36 })
+ (AnnListItem
+ [(AddCommaAnn
+ (EpaSpan { Test24533.ppr.hs:3:37 }))])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:36 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: a}))))
+ ,(L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:39 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { Test24533.ppr.hs:3:39 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: b}))))]))))))))
+ {Bag(LocatedA (HsBind GhcPs)):
+ []}
+ []
+ []
+ []
+ (Nothing)))))]))
\ No newline at end of file
=====================================
testsuite/tests/printer/all.T
=====================================
@@ -196,3 +196,4 @@ test('Test23887', [ignore_stderr, req_ppr_deps], makefile_test, ['Test23887'])
test('Test23885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test23885'])
test('ListTuplePuns', extra_files(['ListTuplePuns.hs']), ghci_script, ['ListTuplePuns.script'])
test('AnnotationNoListTuplePuns', [ignore_stderr, req_ppr_deps], makefile_test, ['AnnotationNoListTuplePuns'])
+test('Test24533', [ignore_stderr, req_ppr_deps], makefile_test, ['Test24533'])
=====================================
testsuite/tests/typecheck/should_compile/T24470b.hs
=====================================
@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-implicit-rhs-quantification #-}
+{-# LANGUAGE TypeAbstractions #-}
+
+module T24470b where
+
+import Data.Kind
+import Data.Data
+
+type SynOK :: forall k. k -> Type
+type SynOK @t = Proxy :: j -> Type
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -912,3 +912,4 @@ test('T21206', normal, compile, [''])
test('T17594a', req_th, compile, [''])
test('T17594f', normal, compile, [''])
test('WarnDefaultedExceptionContext', normal, compile, ['-Wdefaulted-exception-context'])
+test('T24470b', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_fail/T24470a.hs
=====================================
@@ -0,0 +1,7 @@
+module T24470a where
+
+import Data.Data
+import Data.Kind
+
+type SynBad :: forall k. k -> Type
+type SynBad = Proxy :: j -> Type
=====================================
testsuite/tests/typecheck/should_fail/T24470a.stderr
=====================================
@@ -0,0 +1,6 @@
+
+T24470a.hs:7:24: error: [GHC-84925]
+ • The arity of ‘SynBad’ is insufficiently high to accommodate
+ an implicit binding for the ‘j’ type variable.
+ • Use ‘@j’ on the LHS or ‘forall j.’ on the RHS to bring it into scope.
+ • In the type synonym declaration for ‘SynBad’
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -722,3 +722,5 @@ test('DoExpansion3', normal, compile, ['-fdefer-type-errors'])
test('T17594c', normal, compile_fail, [''])
test('T17594d', normal, compile_fail, [''])
test('T17594g', normal, compile_fail, [''])
+
+test('T24470a', normal, compile_fail, [''])
=====================================
utils/genprimopcode/AccessOps.hs
=====================================
@@ -82,7 +82,7 @@ mkIndexByteArrayOp e = PrimOpSpec
$ TyF (strToTy "Int#")
(elt_rep_ty e)
, cat = GenPrimOp
- , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "."
+ , desc = "Read " ++ elt_desc e ++ " from immutable array; offset in " ++ prettyOffset e ++ "."
, opts = [OptionEffect CanFail]
}
@@ -94,7 +94,7 @@ mkUnalignedIndexByteArrayOp e = PrimOpSpec
$ TyF (strToTy "Int#")
(elt_rep_ty e)
, cat = GenPrimOp
- , desc = "Read " ++ elt_desc e ++ "; offset in bytes."
+ , desc = "Read " ++ elt_desc e ++ " from immutable array; offset in bytes."
, opts = [OptionEffect CanFail]
}
@@ -106,7 +106,7 @@ mkReadByteArrayOp e = PrimOpSpec
$ TyF (strToTy "Int#")
$ readResTy e
, cat = GenPrimOp
- , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "."
+ , desc = "Read " ++ elt_desc e ++ " from mutable array; offset in " ++ prettyOffset e ++ "."
, opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail]
}
@@ -118,7 +118,7 @@ mkUnalignedReadByteArrayOp e = PrimOpSpec
$ TyF (strToTy "Int#")
$ readResTy e
, cat = GenPrimOp
- , desc = "Read " ++ elt_desc e ++ "; offset in bytes."
+ , desc = "Read " ++ elt_desc e ++ " from mutable array; offset in bytes."
, opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail]
}
@@ -130,7 +130,7 @@ mkWriteByteArrayOp e = PrimOpSpec
$ TyF (strToTy "Int#")
$ writeResTy e
, cat = GenPrimOp
- , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ "."
+ , desc = "Write " ++ elt_desc e ++ " to mutable array; offset in " ++ prettyOffset e ++ "."
, opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail]
}
@@ -142,7 +142,7 @@ mkUnalignedWriteByteArrayOp e = PrimOpSpec
$ TyF (strToTy "Int#")
$ writeResTy e
, cat = GenPrimOp
- , desc = "Write " ++ elt_desc e ++ "; offset in bytes."
+ , desc = "Write " ++ elt_desc e ++ " to mutable array; offset in bytes."
, opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail]
}
@@ -166,7 +166,7 @@ mkIndexOffAddrOp e = PrimOpSpec
$ TyF (strToTy "Int#")
(elt_rep_ty e)
, cat = GenPrimOp
- , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n"
+ , desc = "Read " ++ elt_desc e ++ " from immutable address; offset in " ++ prettyOffset e ++ ".\n\n"
++ getAlignWarn e
, opts = [OptionEffect CanFail]
}
@@ -179,7 +179,7 @@ mkUnalignedIndexOffAddrOp e = PrimOpSpec
$ TyF (strToTy "Int#")
(elt_rep_ty e)
, cat = GenPrimOp
- , desc = "Read " ++ elt_desc e ++ "; offset in bytes."
+ , desc = "Read " ++ elt_desc e ++ " from immutable address; offset in bytes."
, opts = [OptionEffect CanFail]
}
@@ -191,7 +191,7 @@ mkReadOffAddrOp e = PrimOpSpec
$ TyF (strToTy "Int#")
$ readResTy e
, cat = GenPrimOp
- , desc = "Read " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n"
+ , desc = "Read " ++ elt_desc e ++ " from mutable address; offset in " ++ prettyOffset e ++ ".\n\n"
++ getAlignWarn e
, opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail]
}
@@ -204,7 +204,7 @@ mkUnalignedReadOffAddrOp e = PrimOpSpec
$ TyF (strToTy "Int#")
$ readResTy e
, cat = GenPrimOp
- , desc = "Read " ++ elt_desc e ++ "; offset in bytes."
+ , desc = "Read " ++ elt_desc e ++ " from mutable address; offset in bytes."
, opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail]
}
@@ -216,7 +216,7 @@ mkWriteOffAddrOp e = PrimOpSpec
$ TyF (strToTy "Int#")
$ writeResTy e
, cat = GenPrimOp
- , desc = "Write " ++ elt_desc e ++ "; offset in " ++ prettyOffset e ++ ".\n\n"
+ , desc = "Write " ++ elt_desc e ++ " to mutable address; offset in " ++ prettyOffset e ++ ".\n\n"
++ getAlignWarn e
, opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail]
}
@@ -229,7 +229,7 @@ mkUnalignedWriteOffAddrOp e = PrimOpSpec
$ TyF (strToTy "Int#")
$ writeResTy e
, cat = GenPrimOp
- , desc = "Write " ++ elt_desc e ++ "; offset in bytes."
+ , desc = "Write " ++ elt_desc e ++ " to mutable address; offset in bytes."
, opts = [OptionEffect ReadWriteEffect, OptionCanFailWarnFlag YesWarnCanFail]
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca405979ea626e3e7bcb137f356320827ff18253...9975ad57752aacdf96eed7874c1a042bce3e05af
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca405979ea626e3e7bcb137f356320827ff18253...9975ad57752aacdf96eed7874c1a042bce3e05af
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/20240314/9eb55217/attachment-0001.html>
More information about the ghc-commits
mailing list