ghc-lib-parser 9.2.3.20220709 → 9.2.4.20220729

raw patch · 19 files changed

+133/−68 lines, 19 files

Files

• compiler/GHC/Core/FVs.hs +8/−1
• compiler/GHC/Core/Opt/Arity.hs +10/−21
• compiler/GHC/Core/Utils.hs +2/−1
• compiler/GHC/Data/IOEnv.hs +1/−1
• compiler/GHC/Driver/Errors.hs +6/−2
• compiler/GHC/Driver/Session.hs +9/−4
• compiler/GHC/Parser/Errors.hs +3/−0
• compiler/GHC/Parser/Errors/Ppr.hs +3/−0
• compiler/GHC/Parser/PostProcess.hs +11/−4
• compiler/GHC/Platform.hs +5/−0
• compiler/GHC/Tc/Types/Origin.hs +25/−2
• compiler/GHC/Tc/Utils/TcType.hs +36/−20
• compiler/GHC/Types/Demand.hs +4/−4
• compiler/GHC/Unit/Module/Graph.hs +2/−2
• ghc-lib-parser.cabal +1/−1
• ghc-lib/stage0/compiler/build/primop-out-of-line.hs-incl +1/−0
• ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs +4/−4
• libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs +1/−0
• libraries/ghci/GHCi/Message.hs +1/−1

@@ -625,7 +625,14 @@ dVarTypeTyCoVars var = fvDVarSet $ varTypeTyCoFVs var  varTypeTyCoFVs :: Var -> FV-varTypeTyCoFVs var = tyCoFVsOfType (varType var)+-- Find the free variables of a binder.+-- In the case of ids, don't forget the multiplicity field!+varTypeTyCoFVs var+  = tyCoFVsOfType (varType var) `unionFV` mult_fvs+  where+    mult_fvs = case varMultMaybe var of+                 Just mult -> tyCoFVsOfType mult+                 Nothing   -> emptyFV  idFreeVars :: Id -> VarSet idFreeVars id = ASSERT( isId id) fvVarSet $ idFVs id

@@ -776,12 +776,12 @@ andArityType (AT (os1:oss1) div1) (AT (os2:oss2) div2)   | AT oss' div' <- andArityType (AT oss1 div1) (AT oss2 div2)   = AT ((os1 `bestOneShot` os2) : oss') div' -- See Note [Combining case branches]-andArityType (AT []         div1) at2+andArityType at1@(AT []         div1) at2   | isDeadEndDiv div1 = at2                  -- Note [ABot branches: max arity wins]-  | otherwise         = takeWhileOneShot at2 -- See Note [Combining case branches]-andArityType at1                  (AT []         div2)+  | otherwise         = at1                  -- See Note [Combining case branches]+andArityType at1                  at2@(AT []         div2)   | isDeadEndDiv div2 = at1                  -- Note [ABot branches: max arity wins]-  | otherwise         = takeWhileOneShot at1 -- See Note [Combining case branches]+  | otherwise         = at2                  -- See Note [Combining case branches]  {- Note [ABot branches: max arity wins] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -794,24 +794,13 @@  Note [Combining case branches] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider-  go = \x. let z = go e0-               go2 = \x. case x of-                           True  -> z-                           False -> \s(one-shot). e1-           in go2 x-We *really* want to respect the one-shot annotation provided by the-user and eta-expand go and go2.-When combining the branches of the case we have-     T `andAT` \1.T-and we want to get \1.T.-But if the inner lambda wasn't one-shot (\?.T) we don't want to do this.-(We need a usage analysis to justify that.) -So we combine the best of the two branches, on the (slightly dodgy)-basis that if we know one branch is one-shot, then they all must be.-Surprisingly, this means that the one-shot arity type is effectively the top-element of the lattice.+Unless we can conclude that **all** branches are safe to eta-expand then we+must pessimisticaly conclude that we can't eta-expand. See #21694 for where this+went wrong.+We can do better in the long run, but for the 9.4/9.2 branches we choose to simply+ignore oneshot annotations for the time being.+  Note [Arity trimming] ~~~~~~~~~~~~~~~~~~~~~

@@ -84,6 +84,7 @@ import GHC.Types.Name import GHC.Types.Literal import GHC.Types.Tickish+import GHC.Types.Demand ( isDeadEndAppSig ) import GHC.Core.DataCon import GHC.Builtin.PrimOps import GHC.Types.Id@@ -1116,7 +1117,7 @@   | otherwise   = go 0 e   where-    go n (Var v)                 = isDeadEndId v &&  n >= idArity v+    go n (Var v)                 = isDeadEndAppSig (idStrictness v) n     go n (App e a) | isTypeArg a = go n e                    | otherwise   = go (n+1) e     go n (Tick _ e)              = go n e

@@ -60,7 +60,7 @@   newtype IOEnv env a = IOEnv' (env -> IO a)-  deriving (MonadThrow, MonadCatch, MonadMask) via (ReaderT env IO)+  deriving (MonadThrow, MonadCatch, MonadMask, MonadFix) via (ReaderT env IO)  -- See Note [The one-shot state monad trick] in GHC.Utils.Monad instance Functor (IOEnv env) where

@@ -46,10 +46,14 @@ handleFlagWarnings logger dflags warns = do   let warns' = filter (shouldPrintWarning dflags . CmdLine.warnReason)  warns +      toWarnReason CmdLine.ReasonDeprecatedFlag = Reason Opt_WarnDeprecatedFlags+      toWarnReason CmdLine.ReasonUnrecognisedFlag = Reason Opt_WarnUnrecognisedWarningFlags+      toWarnReason CmdLine.NoReason = NoReason+       -- It would be nicer if warns :: [Located SDoc], but that       -- has circular import problems.-      bag = listToBag [ mkPlainWarnMsg loc (text warn)-                      | CmdLine.Warn _ (L loc warn) <- warns' ]+      bag = listToBag [ makeIntoWarning (toWarnReason reason) (mkPlainWarnMsg loc (text warn))+                      | CmdLine.Warn reason (L loc warn) <- warns' ]    printOrThrowWarnings logger dflags bag 

@@ -1373,12 +1373,14 @@        LangExt.DatatypeContexts,        LangExt.TraditionalRecordSyntax,        LangExt.FieldSelectors,-       LangExt.NondecreasingIndentation+       LangExt.NondecreasingIndentation,            -- strictly speaking non-standard, but we always had this            -- on implicitly before the option was added in 7.1, and            -- turning it off breaks code, so we're keeping it on for            -- backwards compatibility.  Cabal uses -XHaskell98 by            -- default unless you specify another language.+       LangExt.DeepSubsumption+       -- Non-standard but enabled for backwards compatability (see GHC proposal #511)       ]  languageExtensions (Just Haskell2010)@@ -1394,7 +1396,8 @@        LangExt.PatternGuards,        LangExt.DoAndIfThenElse,        LangExt.FieldSelectors,-       LangExt.RelaxedPolyRec]+       LangExt.RelaxedPolyRec,+       LangExt.DeepSubsumption ]  languageExtensions (Just GHC2021)     = [LangExt.ImplicitPrelude,@@ -2450,7 +2453,7 @@   , make_ord_flag defGhcFlag "ddump-asm-expanded"         (setDumpFlag Opt_D_dump_asm_expanded)   , make_ord_flag defGhcFlag "ddump-llvm"-        (NoArg $ setObjBackend LLVM >> setDumpFlag' Opt_D_dump_llvm)+        (NoArg $ setDumpFlag' Opt_D_dump_llvm)   , make_ord_flag defGhcFlag "ddump-c-backend"         (NoArg $ setDumpFlag' Opt_D_dump_c_backend)   , make_ord_flag defGhcFlag "ddump-deriv"@@ -3612,6 +3615,7 @@   flagSpec "MagicHash"                        LangExt.MagicHash,   flagSpec "MonadComprehensions"              LangExt.MonadComprehensions,   flagSpec "MonoLocalBinds"                   LangExt.MonoLocalBinds,+  flagSpec "DeepSubsumption"                  LangExt.DeepSubsumption,   flagSpec "MonomorphismRestriction"          LangExt.MonomorphismRestriction,   flagSpec "MultiParamTypeClasses"            LangExt.MultiParamTypeClasses,   flagSpec "MultiWayIf"                       LangExt.MultiWayIf,@@ -4012,7 +4016,8 @@         Opt_WarnSpaceAfterBang,         Opt_WarnNonCanonicalMonadInstances,         Opt_WarnNonCanonicalMonoidInstances,-        Opt_WarnOperatorWhitespaceExtConflict+        Opt_WarnOperatorWhitespaceExtConflict,+        Opt_WarnUnicodeBidirectionalFormatCharacters       ]  -- | Things you get with -W

@@ -367,6 +367,9 @@    | PsErrLinearFunction       -- ^ Linear function found but LinearTypes not enabled +   | PsErrInvalidCApiImport+      -- ^ Invalid CApi import+    | PsErrMultiWayIf       -- ^ Multi-way if-expression found but MultiWayIf not enabled 

@@ -584,6 +584,9 @@    PsErrLinearFunction       -> text "Enable LinearTypes to allow linear functions" +   PsErrInvalidCApiImport {}+      -> text "Wrapper stubs can't be used with CApiFFI."+    PsErrMultiWayIf       -> text "Multi-way if-expressions need MultiWayIf turned on" 

@@ -2500,9 +2500,13 @@          -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs) mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) =     case unLoc cconv of-      CCallConv          -> mkCImport-      CApiConv           -> mkCImport-      StdCallConv        -> mkCImport+      CCallConv          -> returnSpec =<< mkCImport+      CApiConv           -> do+        imp <- mkCImport+        if isCWrapperImport imp+          then addFatalError $ PsError PsErrInvalidCApiImport [] loc+          else returnSpec imp+      StdCallConv        -> returnSpec =<< mkCImport       PrimCallConv       -> mkOtherImport       JavaScriptCallConv -> mkOtherImport   where@@ -2514,7 +2518,10 @@       let e = unpackFS entity       case parseCImport cconv safety (mkExtName (unLoc v)) e (L loc esrc) of         Nothing         -> addFatalError $ PsError PsErrMalformedEntityString [] loc-        Just importSpec -> returnSpec importSpec+        Just importSpec -> return importSpec++    isCWrapperImport (CImport _ _ _ CWrapper _) = True+    isCWrapperImport _ = False      -- currently, all the other import conventions only support a symbol name in     -- the entity string. If it is missing, we use the function name instead.

@@ -218,6 +218,11 @@   ArchPPC_64 _ -> True   ArchS390X    -> True   ArchRISCV64  -> True+  ArchAArch64+      -- Apple's AArch64 ABI requires that the caller sign-extend+      -- small integer arguments. See+      -- https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms+    | OSDarwin <- platformOS platform -> True   _            -> False  

@@ -461,7 +461,7 @@         -- We only need a CtOrigin on the first, because the location         -- is pinned on the entire error message -  | ExprHoleOrigin OccName   -- from an expression hole+  | ExprHoleOrigin (Maybe OccName)   -- from an expression hole   | TypeHoleOrigin OccName   -- from a type hole (partial type signature)   | PatCheckOrigin      -- normalisation of a type during pattern-match checking   | ListOrigin          -- An overloaded list@@ -481,6 +481,13 @@       CtOrigin   -- origin of the original constraint       -- See Detail (7) of Note [Type equality cycles] in GHC.Tc.Solver.Canonical +  | InstanceSigOrigin   -- from the sub-type check of an InstanceSig+      Name   -- the method name+      Type   -- the instance-sig type+      Type   -- the instantiated type of the method+  | AmbiguityCheckOrigin UserTypeCtxt+  | GhcBug20076+ -- | The number of superclass selections needed to get this Given. -- If @d :: C ty@   has @ScDepth=2@, then the evidence @d@ will look -- like @sc_sel (sc_sel dg)@, where @dg@ is a Given.@@ -660,6 +667,18 @@ pprCtOrigin (CycleBreakerOrigin orig)   = pprCtOrigin orig +pprCtOrigin (InstanceSigOrigin method_name sig_type orig_method_type)+  = vcat [ ctoHerald <+> text "the check that an instance signature is more general"+         , text "than the type of the method (instantiated for this instance)"+         , hang (text "instance signature:")+              2 (ppr method_name <+> dcolon <+> ppr sig_type)+         , hang (text "instantiated method type:")+              2 (ppr orig_method_type) ]++pprCtOrigin (AmbiguityCheckOrigin ctxt)+  = ctoHerald <+> text "a type ambiguity check for" $$+    pprUserTypeCtxt ctxt+ pprCtOrigin simple_origin   = ctoHerald <+> pprCtO simple_origin @@ -693,7 +712,8 @@ pprCtO MCompOrigin           = text "a statement in a monad comprehension" pprCtO ProcOrigin            = text "a proc expression" pprCtO AnnOrigin             = text "an annotation"-pprCtO (ExprHoleOrigin occ)  = text "a use of" <+> quotes (ppr occ)+pprCtO (ExprHoleOrigin Nothing)  = text "an expression hole"+pprCtO (ExprHoleOrigin (Just occ))  = text "a use of" <+> quotes (ppr occ) pprCtO (TypeHoleOrigin occ)  = text "a use of wildcard" <+> quotes (ppr occ) pprCtO PatCheckOrigin        = text "a pattern-match completeness check" pprCtO ListOrigin            = text "an overloaded list"@@ -701,4 +721,7 @@ pprCtO NonLinearPatternOrigin = text "a non-linear pattern" pprCtO (UsageEnvironmentOf x) = hsep [text "multiplicity of", quotes (ppr x)] pprCtO BracketOrigin         = text "a quotation bracket"+pprCtO (InstanceSigOrigin {})  = text "a type signature in an instance"+pprCtO (AmbiguityCheckOrigin {}) = text "a type ambiguity check"+pprCtO GhcBug20076           = text "GHC Bug #20076" pprCtO _                     = panic "pprCtOrigin"

@@ -1316,34 +1316,50 @@                         (tvs, rho) -> case tcSplitPhiTy rho of                                         (theta, tau) -> (tvs, theta, tau) --- | Split a sigma type into its parts, going underneath as many @ForAllTy@s--- as possible. For example, given this type synonym:------ @--- type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t--- @------ if you called @tcSplitSigmaTy@ on this type:------ @--- forall s t a b. Each s t a b => Traversal s t a b--- @------ then it would return @([s,t,a,b], [Each s t a b], Traversal s t a b)@. But--- if you instead called @tcSplitNestedSigmaTys@ on the type, it would return--- @([s,t,a,b,f], [Each s t a b, Applicative f], (a -> f b) -> s -> f t)@.+-- | Split a sigma type into its parts, going underneath as many arrows+-- and foralls as possible. See Note [tcSplitNestedSigmaTys] tcSplitNestedSigmaTys :: Type -> ([TyVar], ThetaType, Type)--- NB: This is basically a pure version of topInstantiate (from Inst) that--- doesn't compute an HsWrapper.+-- See Note [tcSplitNestedSigmaTys]+-- NB: This is basically a pure version of deeplyInstantiate (from Unify) that+--     doesn't compute an HsWrapper. tcSplitNestedSigmaTys ty     -- If there's a forall, split it apart and try splitting the rho type     -- underneath it.-  | (tvs1, theta1, rho1) <- tcSplitSigmaTy ty+  | (arg_tys, body_ty)   <- tcSplitFunTys ty+  , (tvs1, theta1, rho1) <- tcSplitSigmaTy body_ty   , not (null tvs1 && null theta1)   = let (tvs2, theta2, rho2) = tcSplitNestedSigmaTys rho1-    in (tvs1 ++ tvs2, theta1 ++ theta2, rho2)+    in (tvs1 ++ tvs2, theta1 ++ theta2, mkVisFunTys arg_tys rho2)+     -- If there's no forall, we're done.   | otherwise = ([], [], ty)++{- Note [tcSplitNestedSigmaTys]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+tcSplitNestedSigmaTys splits out all the /nested/ foralls and constraints,+including under function arrows.  E.g. given this type synonym:+  type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t++then+  tcSplitNestedSigmaTys (forall s t a b. C s t a b => Int -> Traversal s t a b)++will return+  ( [s,t,a,b,f]+  , [C s t a b, Applicative f]+  , Int -> (a -> f b) -> s -> f t)@.++This function is used in these places:+* Improving error messages in GHC.Tc.Gen.Head.addFunResCtxt+* Validity checking for default methods: GHC.Tc.TyCl.checkValidClass+* A couple of calls in the GHCi debugger: GHC.Runtime.Heap.Inspect++In other words, just in validity checking and error messages; hence+no wrappers or evidence generation.++Notice that tcSplitNestedSigmaTys even looks under function arrows;+doing so is the Right Thing even with simple subsumption, not just+with deep subsumption.+-}  ----------------------- tcTyConAppTyCon :: Type -> TyCon

@@ -60,7 +60,7 @@     -- * Demand signatures     StrictSig(..), mkStrictSigForArity, mkClosedStrictSig,     splitStrictSig, strictSigDmdEnv, hasDemandEnvSig,-    nopSig, botSig, isTopSig, isDeadEndSig, appIsDeadEnd,+    nopSig, botSig, isTopSig, isDeadEndSig, isDeadEndAppSig,     -- ** Handling arity adjustments     prependArgsStrictSig, etaConvertStrictSig, @@ -1468,15 +1468,15 @@ isDeadEndSig :: StrictSig -> Bool isDeadEndSig (StrictSig (DmdType _ _ res)) = isDeadEndDiv res --- | Returns true if an application to n args would diverge or throw an+-- | Returns true if an application to n value args would diverge or throw an -- exception. -- -- If a function having 'botDiv' is applied to a less number of arguments than -- its syntactic arity, we cannot say for sure that it is going to diverge. -- Hence this function conservatively returns False in that case. -- See Note [Dead ends].-appIsDeadEnd :: StrictSig -> Int -> Bool-appIsDeadEnd (StrictSig (DmdType _ ds res)) n+isDeadEndAppSig :: StrictSig -> Int -> Bool+isDeadEndAppSig (StrictSig (DmdType _ ds res)) n   = isDeadEndDiv res && not (lengthExceeds ds n)  prependArgsStrictSig :: Int -> StrictSig -> StrictSig

@@ -72,9 +72,9 @@ -- 'GHC.topSortModuleGraph' and 'GHC.Data.Graph.Directed.flattenSCC' to achieve this. data ModuleGraph = ModuleGraph   { mg_mss :: [ModuleGraphNode]-  , mg_non_boot :: ModuleEnv ModSummary+  , mg_non_boot :: !(ModuleEnv ModSummary)     -- a map of all non-boot ModSummaries keyed by Modules-  , mg_boot :: ModuleSet+  , mg_boot :: !ModuleSet     -- a set of boot Modules   , mg_needs_th_or_qq :: !Bool     -- does any of the modules in mg_mss require TemplateHaskell or

@@ -1,7 +1,7 @@ cabal-version: 2.0 build-type: Simple name: ghc-lib-parser-version: 9.2.3.20220709+version: 9.2.4.20220729 license: BSD3 license-file: LICENSE category: Development

@@ -92,6 +92,7 @@ primOpOutOfLine CompactSize = True primOpOutOfLine GetSparkOp = True primOpOutOfLine NumSparks = True+primOpOutOfLine KeepAliveOp = True primOpOutOfLine MkApUpd0_Op = True primOpOutOfLine NewBCOOp = True primOpOutOfLine UnpackClosureOp = True

@@ -3,19 +3,19 @@ import Prelude -- See Note [Why do we import Prelude here?]  cProjectGitCommitId   :: String-cProjectGitCommitId   = "a2f693f524830c2ab1e8a6e9d729839ac8b468c5"+cProjectGitCommitId   = "a54827e0b48af33fa9cfde6ad131c6751c2fe321"  cProjectVersion       :: String-cProjectVersion       = "9.2.3"+cProjectVersion       = "9.2.4"  cProjectVersionInt    :: String cProjectVersionInt    = "902"  cProjectPatchLevel    :: String-cProjectPatchLevel    = "3"+cProjectPatchLevel    = "4"  cProjectPatchLevel1   :: String-cProjectPatchLevel1   = "3"+cProjectPatchLevel1   = "4"  cProjectPatchLevel2   :: String cProjectPatchLevel2   = ""

@@ -30,6 +30,7 @@    | UndecidableSuperClasses    | MonomorphismRestriction    | MonoLocalBinds+   | DeepSubsumption    | RelaxedPolyRec           -- Deprecated    | ExtendedDefaultRules     -- Use GHC's extended rules for defaulting    | ForeignFunctionInterface

@@ -462,7 +462,7 @@ #define MIN_VERSION_ghc_heap(major1,major2,minor) (\   (major1) <  9 || \   (major1) == 9 && (major2) <  2 || \-  (major1) == 9 && (major2) == 2 && (minor) <= 3)+  (major1) == 9 && (major2) == 2 && (minor) <= 4) #endif /* MIN_VERSION_ghc_heap */ #if MIN_VERSION_ghc_heap(8,11,0) instance Binary Heap.StgTSOProfInfo