[Git][ghc/ghc][wip/romes/9557] 6 commits: Include diagnostic reason in -fdiagnostics-as-json
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Tue Nov 19 13:42:37 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/9557 at Glasgow Haskell Compiler / GHC
Commits:
831aab22 by sheaf at 2024-11-18T21:22:36-05:00
Include diagnostic reason in -fdiagnostics-as-json
This commit ensures that the -fdiagnostics-as-json output includes the
diagnostic reason. This allows the full error message produced by GHC
to be re-constructed from the JSON output.
Fixes #25403
- - - - -
3e5bfdd3 by Ben Gamari at 2024-11-18T21:23:12-05:00
rts: Introduce printIPE
This is a convenience utility for use in GDB.
- - - - -
909b9295 by Rodrigo Mesquita at 2024-11-19T13:42:19+00:00
Improve performance of deriving Show
Significantly improves performance of deriving Show instances by
avoiding using the very polymorphic `.` operator in favour of inlining
its definition. We were generating tons of applications of it, each
which had 3 type arguments!
Improves on #9557
-------------------------
Metric Decrease:
InstanceMatching
T12707
T3294
------------------------
- - - - -
89d624c4 by Rodrigo Mesquita at 2024-11-19T13:42:23+00:00
Deriving Ord: compare and <= only
Since the implementation of CLC proposal #24, the default
implementations of Ord's `<`, `>`, and `>=` are given in terms of `<=`.
This means we no longer need to generate implementations for these
methods when stock deriving `Ord`. Rather, just derive the
implementation of `compare` and `<=`, and rely on the default
implementations for the others.
- - - - -
80ef15e3 by Rodrigo Mesquita at 2024-11-19T13:42:23+00:00
Don't eta expand cons when deriving Data
This eta expansion was introduced with the initial commit for Linear
types.
I believe this isn't needed any longer. My guess is it is an artifact
from the initial linear types implementation: data constructors are
linear, but they shouldn't need to be eta expanded to be used as higher
order functions. I suppose in the early days this wasn't true.
For instance, this works now:
data T x = T x
f = \(x :: forall y. y -> T y) -> x True
f T -- ok!
T is linear, but can be passed where an unrestricted higher order
function is expected. I recall there being some magic around to make
this work for data constructors...
Since this works, there's no need to eta_expand the data constructors in
the derived Data instances.
- - - - -
df5e4f90 by Rodrigo Mesquita at 2024-11-19T13:42:23+00:00
deriving Traversable: Eta reduce more constructor
We were generating unnecessarily eta-expanded lambdas in derived
Traversable instances (via mkSimpleConMatch2).
We can generate smaller code by eta-reducing all trailing arguments
which do mention the last type variable
- - - - -
19 changed files:
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Tc/Deriv/Functor.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Unit/Module/Warnings.hs
- + docs/users_guide/diagnostics-as-json-schema-1_1.json
- docs/users_guide/using.rst
- rts/IPE.c
- rts/include/rts/IPE.h
- testsuite/tests/deriving/should_compile/T14682.stderr
- testsuite/tests/deriving/should_compile/T20496.stderr
- testsuite/tests/deriving/should_run/T9576.stderr
- testsuite/tests/driver/all.T
- testsuite/tests/driver/json.stderr
- testsuite/tests/driver/json_warn.hs
- testsuite/tests/driver/json_warn.stderr
- testsuite/tests/typecheck/should_fail/T15883c.stderr
- testsuite/tests/typecheck/should_fail/T15883d.stderr
- testsuite/tests/typecheck/should_fail/T15883e.stderr
Changes:
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -56,7 +56,7 @@ module GHC.Hs.Utils(
nlHsTyApp, nlHsTyApps, nlHsVar, nlHsDataCon,
nlHsLit, nlHsApp, nlHsApps, nlHsSyntaxApps,
nlHsIntLit, nlHsVarApps,
- nlHsDo, nlHsOpApp, nlHsPar, nlHsIf, nlHsCase, nlList,
+ nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,
mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,
mkLocatedList, nlAscribe,
@@ -598,11 +598,15 @@ nlHsDo ctxt stmts = noLocA (mkHsDo ctxt (noLocA stmts))
nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
nlHsOpApp e1 op e2 = noLocA (mkHsOpApp e1 op e2)
+nlHsLam :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs
nlHsPar :: IsPass p => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
-> LHsExpr GhcPs
nlList :: [LHsExpr GhcPs] -> LHsExpr GhcPs
+nlHsLam match = noLocA $ HsLam noAnn LamSingle
+ $ mkMatchGroup (Generated OtherExpansion SkipPmc) (noLocA [match])
+
nlHsPar e = noLocA (gHsPar e)
-- nlHsIf should generate if-expressions which are NOT subject to
=====================================
compiler/GHC/Tc/Deriv/Functor.hs
=====================================
@@ -689,9 +689,18 @@ mkSimpleConMatch2 ctxt fold extra_pats con insides = do
con_expr
| null asWithTyVar = nlHsApps con_name asWithoutTyVar
| otherwise =
- let bs = filterByList argTysTyVarInfo bs_RDRs
- vars = filterByLists argTysTyVarInfo bs_Vars as_Vars
- in mkHsLam (noLocA (map nlVarPat bs)) (nlHsApps con_name vars)
+ let -- All trailing b-args can be eta-reduced:
+ -- (\b1 b2 b3 -> A b1 a2 b2 b3) ==> (\b1 -> A b1 a2)
+ -- This improves the number of allocations needed to compile
+ -- the generated code (it is not relevant for correctness)
+ -- We do this by counting the n of args to keep
+ keep_n = length $ dropWhileEndLE (== True) argTysTyVarInfo
+ bs = filterByList (take keep_n argTysTyVarInfo) bs_RDRs
+ vars = take keep_n $
+ filterByLists argTysTyVarInfo bs_Vars as_Vars
+ in if keep_n == 0
+ then nlHsVar con_name
+ else mkHsLam (noLocA (map nlVarPat bs)) (nlHsApps con_name vars)
rhs <- fold con_expr exps
return $ mkMatch ctxt (noLocA (extra_pats ++ [pat])) rhs emptyLocalBinds
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -339,7 +339,7 @@ Several special cases:
See function unliftedOrdOp
Note [Game plan for deriving Ord]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's a bad idea to define only 'compare', and build the other binary
comparisons on top of it; see #2130, #4019. Reason: we don't
want to laboriously make a three-way comparison, only to extract a
@@ -350,16 +350,22 @@ binary result, something like this:
True -> False
False -> True
-This being said, we can get away with generating full code only for
-'compare' and '<' thus saving us generation of other three operators.
-Other operators can be cheaply expressed through '<':
-a <= b = not $ b < a
-a > b = b < a
-a >= b = not $ a < b
-
So for sufficiently small types (few constructors, or all nullary)
we generate all methods; for large ones we just use 'compare'.
+This being said, we can get away with generating full code only for
+'compare' and '<=' thus saving us generation of other three operators.
+Other operators can be cheaply expressed through '<=' -- indeed, that's what
+the default implementations of >, <, and >= do.
+
+Historically, derived instances defined '<' and the remaining operators as
+cheap expressions in function of it:
+ a <= b = not $ b < a
+ a > b = b < a
+ a >= b = not $ a < b
+but since the CLC proposal #24 (see 8f174e06185143674d6cbfee75c30e68805d85b8),
+it suffices to derive '<=' and rely on the
+default implementation for the others.
-}
data OrdOp = OrdCompare | OrdLT | OrdLE | OrdGE | OrdGT
@@ -417,19 +423,10 @@ gen_Ord_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
other_ops
| (last_tag - first_tag) <= 2 -- 1-3 constructors
|| null non_nullary_cons -- Or it's an enumeration
- = [mkOrdOp OrdLT, lE, gT, gE]
+ = [mkOrdOp OrdLE]
| otherwise
= []
- negate_expr = nlHsApp (nlHsVar not_RDR)
- pats = noLocA [a_Pat, b_Pat]
- lE = mkSimpleGeneratedFunBind loc le_RDR pats $
- negate_expr (nlHsApp (nlHsApp (nlHsVar lt_RDR) b_Expr) a_Expr)
- gT = mkSimpleGeneratedFunBind loc gt_RDR pats $
- nlHsApp (nlHsApp (nlHsVar lt_RDR) b_Expr) a_Expr
- gE = mkSimpleGeneratedFunBind loc ge_RDR pats $
- negate_expr (nlHsApp (nlHsApp (nlHsVar lt_RDR) a_Expr) b_Expr)
-
get_tag con = dataConTag con - fIRST_TAG
-- We want *zero-based* tags, because that's what
-- con2Tag returns (generated by untag_Expr)!
@@ -1407,7 +1404,7 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
gfoldl_eqn con
= ([nlVarPat k_RDR, z_Pat, nlConVarPat con_name as_needed],
- foldl' mk_k_app (z_Expr `nlHsApp` (eta_expand_data_con con)) as_needed)
+ foldl' mk_k_app (z_Expr `nlHsApp` (nlHsVar (getRdrName con))) as_needed)
where
con_name :: RdrName
con_name = getRdrName con
@@ -1427,18 +1424,9 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
gunfold_alt dc = mkHsCaseAlt (mk_unfold_pat dc) (mk_unfold_rhs dc)
mk_unfold_rhs dc = foldr nlHsApp
- (z_Expr `nlHsApp` (eta_expand_data_con dc))
+ (z_Expr `nlHsApp` (nlHsVar (getRdrName dc)))
(replicate (dataConSourceArity dc) (nlHsVar k_RDR))
- eta_expand_data_con dc =
- mkHsLam (noLocA eta_expand_pats)
- (foldl nlHsApp (nlHsVar (getRdrName dc)) eta_expand_hsvars)
- where
- eta_expand_pats = map nlVarPat eta_expand_vars
- eta_expand_hsvars = map nlHsVar eta_expand_vars
- eta_expand_vars = take (dataConSourceArity dc) as_RDRs
-
-
mk_unfold_pat dc -- Last one is a wild-pat, to avoid
-- redundant test, and annoying warning
| tag-fIRST_TAG == n_cons-1 = nlWildPat -- Last constructor
@@ -2528,21 +2516,21 @@ showParen_Expr
showParen_Expr e1 e2 = nlHsApp (nlHsApp (nlHsVar showParen_RDR) e1) e2
nested_compose_Expr :: [LHsExpr GhcPs] -> LHsExpr GhcPs
-
-nested_compose_Expr [] = panic "nested_compose_expr" -- Arg is always non-empty
-nested_compose_Expr [e] = parenify e
-nested_compose_Expr (e:es)
- = nlHsApp (nlHsApp (nlHsVar compose_RDR) (parenify e)) (nested_compose_Expr es)
+nested_compose_Expr =
+ nlHsLam . mkSimpleMatch (LamAlt LamSingle) (noLocA [z_Pat]) . go
+ where
+ -- Previously we used (`.`), but inlining its definition improves compiler
+ -- performance significantly since we no longer need to typecheck lots of
+ -- (.) applications (each which needed three type applications, all @String)
+ go [] = panic "nested_compose_expr" -- Arg is always non-empty
+ go [e] = nlHsApp e z_Expr
+ go (e:es) = nlHsApp e (go es)
-- impossible_Expr is used in case RHSs that should never happen.
-- We generate these to keep the desugarer from complaining that they *might* happen!
error_Expr :: FastString -> LHsExpr GhcPs
error_Expr string = nlHsApp (nlHsVar error_RDR) (nlHsLit (mkHsStringFS string))
-parenify :: LHsExpr GhcPs -> LHsExpr GhcPs
-parenify e@(L _ (HsVar _ _)) = e
-parenify e = mkHsPar e
-
-- genOpApp wraps brackets round the operator application, so that the
-- renamer won't subsequently try to re-associate it.
genOpApp :: LHsExpr GhcPs -> RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs
@@ -2570,10 +2558,9 @@ as_RDRs = [ mkVarUnqual (mkFastString ("a"++show i)) | i <- [(1::Int) ..
bs_RDRs = [ mkVarUnqual (mkFastString ("b"++show i)) | i <- [(1::Int) .. ] ]
cs_RDRs = [ mkVarUnqual (mkFastString ("c"++show i)) | i <- [(1::Int) .. ] ]
-a_Expr, b_Expr, c_Expr, z_Expr, ltTag_Expr, eqTag_Expr, gtTag_Expr, false_Expr,
+a_Expr, c_Expr, z_Expr, ltTag_Expr, eqTag_Expr, gtTag_Expr, false_Expr,
true_Expr, pure_Expr, unsafeCodeCoerce_Expr :: LHsExpr GhcPs
a_Expr = nlHsVar a_RDR
-b_Expr = nlHsVar b_RDR
c_Expr = nlHsVar c_RDR
z_Expr = nlHsVar z_RDR
ltTag_Expr = nlHsVar ltTag_RDR
=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -100,19 +100,23 @@ import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Hint
import GHC.Data.FastString (unpackFS)
import GHC.Data.StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)
+
+import GHC.Types.Hint.Ppr () -- Outputable instance
+import GHC.Unit.Module.Warnings (WarningCategory(..))
+
import GHC.Utils.Json
import GHC.Utils.Panic
-import GHC.Unit.Module.Warnings (WarningCategory)
+
+import GHC.Version (cProjectVersion)
import Data.Bifunctor
import Data.Foldable ( fold, toList )
import Data.List.NonEmpty ( NonEmpty (..) )
import qualified Data.List.NonEmpty as NE
import Data.List ( intercalate )
+import Data.Maybe ( maybeToList )
import Data.Typeable ( Typeable )
import Numeric.Natural ( Natural )
import Text.Printf ( printf )
-import GHC.Version (cProjectVersion)
-import GHC.Types.Hint.Ppr () -- Outputtable instance
{- Note [Messages]
~~~~~~~~~~~~~~~~~~
@@ -393,10 +397,8 @@ newtype ResolvedDiagnosticReason
pattern WarningWithFlag :: WarningFlag -> DiagnosticReason
pattern WarningWithFlag w = WarningWithFlags (w :| [])
-{-
-Note [Warnings controlled by multiple flags]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
+{- Note [Warnings controlled by multiple flags]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Diagnostics that started life as flag-controlled warnings have a
'diagnosticReason' of 'WarningWithFlags', giving the flags that control the
warning. Usually there is only one flag, but in a few cases multiple flags
@@ -563,11 +565,11 @@ instance ToJson DiagnosticCode where
{- Note [Diagnostic Message JSON Schema]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The below instance of ToJson must conform to the JSON schema
-specified in docs/users_guide/diagnostics-as-json-schema-1_0.json.
+specified in docs/users_guide/diagnostics-as-json-schema-1_1.json.
When the schema is altered, please bump the version.
If the content is altered in a backwards compatible way,
update the minor version (e.g. 1.3 ~> 1.4).
-If the content is breaking, update the major version (e.g. 1.3 ~> 2.3).
+If the content is breaking, update the major version (e.g. 1.3 ~> 2.0).
When updating the schema, replace the above file and name it appropriately with
the version appended, and change the documentation of the -fdiagnostics-as-json
flag to reflect the new schema.
@@ -576,25 +578,41 @@ https://json-schema.org
-}
schemaVersion :: String
-schemaVersion = "1.0"
+schemaVersion = "1.1"
-- See Note [Diagnostic Message JSON Schema] before editing!
instance Diagnostic e => ToJson (MsgEnvelope e) where
- json m = JSObject [
+ json m = JSObject $ [
("version", JSString schemaVersion),
("ghcVersion", JSString $ "ghc-" ++ cProjectVersion),
("span", json $ errMsgSpan m),
("severity", json $ errMsgSeverity m),
("code", maybe JSNull json (diagnosticCode diag)),
("message", JSArray $ map renderToJSString diagMsg),
- ("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) )
- ]
- where diag = errMsgDiagnostic m
- opts = defaultDiagnosticOpts @e
- style = mkErrStyle (errMsgContext m)
- ctx = defaultSDocContext {sdocStyle = style }
- diagMsg = filter (not . isEmpty ctx) (unDecorated (diagnosticMessage (opts) diag))
- renderToJSString :: SDoc -> JsonDoc
- renderToJSString = JSString . (renderWithContext ctx)
+ ("hints", JSArray $ map (renderToJSString . ppr) (diagnosticHints diag) ) ]
+ ++ [ ("reason", reasonJson)
+ | reasonJson <- maybeToList $ usefulReasonJson_maybe (errMsgReason m) ]
+ where
+ diag = errMsgDiagnostic m
+ opts = defaultDiagnosticOpts @e
+ style = mkErrStyle (errMsgContext m)
+ ctx = defaultSDocContext {sdocStyle = style }
+ diagMsg = filter (not . isEmpty ctx) (unDecorated (diagnosticMessage (opts) diag))
+ renderToJSString :: SDoc -> JsonDoc
+ renderToJSString = JSString . (renderWithContext ctx)
+
+ usefulReasonJson_maybe :: ResolvedDiagnosticReason -> Maybe JsonDoc
+ usefulReasonJson_maybe (ResolvedDiagnosticReason rea) =
+ case rea of
+ WarningWithoutFlag -> Nothing
+ ErrorWithoutFlag -> Nothing
+ WarningWithFlags flags ->
+ Just $ JSObject
+ [ ("flags", JSArray $ map (JSString . NE.head . warnFlagNames) (NE.toList flags))
+ ]
+ WarningWithCategory (WarningCategory cat) ->
+ Just $ JSObject
+ [ ("category", JSString $ unpackFS cat)
+ ]
instance Show (MsgEnvelope DiagnosticMessage) where
show = showMsgEnvelope
=====================================
compiler/GHC/Unit/Module/Warnings.hs
=====================================
@@ -1,6 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -130,7 +131,8 @@ fromWarningCategory wc = InWarningCategory noAnn NoSourceText (noLocA wc)
-- See Note [Warning categories]
newtype WarningCategory = WarningCategory FastString
- deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData)
+ deriving stock Data
+ deriving newtype (Binary, Eq, Outputable, Show, Uniquable, NFData)
mkWarningCategory :: FastString -> WarningCategory
mkWarningCategory = WarningCategory
=====================================
docs/users_guide/diagnostics-as-json-schema-1_1.json
=====================================
@@ -0,0 +1,134 @@
+{
+ "$schema": "https://json-schema.org/draft/2020-12/schema",
+ "title": "JSON Diagnostic Schema",
+ "description": "A Schema for specifying GHC diagnostics output as JSON",
+ "type": "object",
+ "properties": {
+ "version": {
+ "description": "The current JSON schema version this object conforms to",
+ "type": "string"
+ },
+ "ghcVersion": {
+ "description": "The GHC version",
+ "type": "string"
+ },
+ "span": {
+ "$ref": "#/$defs/span"
+ },
+ "severity": {
+ "description": "The diagnostic severity",
+ "type": "string",
+ "enum": [
+ "Warning",
+ "Error"
+ ]
+ },
+ "code": {
+ "description": "The diagnostic code (if it exists)",
+ "type": [
+ "integer",
+ "null"
+ ]
+ },
+ "message": {
+ "description": "The string output of the diagnostic message by GHC",
+ "type": "array",
+ "items": {
+ "type": "string"
+ }
+ },
+ "hints": {
+ "description": "The suggested fixes",
+ "type": "array",
+ "items": {
+ "type": "string"
+ }
+ },
+ "reason" : {
+ "description": "The GHC flag that was responsible for the emission of the diagnostic message",
+ "oneOf": [
+ {
+ "type": "object",
+ "description": "The diagnostic message was controlled by one or more GHC flags",
+ "properties": {
+ "flags": {
+ "type": "array",
+ "items": {
+ "description": "The name of a GHC flag controlling the diagnostic message",
+ "type": "string"
+ },
+ "minItems": 1
+ }
+ },
+ "required": ["flags"]
+ },
+ {
+ "type": "object",
+ "description": "The diagnostic message was controlled by a GHC diagnostic message category",
+ "properties": {
+ "category": {
+ "description": "The name of the GHC diagnostic message category controlling the diagnostic message",
+ "type": "string"
+ }
+ },
+ "required": ["category"]
+ }
+ ]
+ }
+ },
+ "required": [
+ "version",
+ "ghcVersion",
+ "span",
+ "severity",
+ "code",
+ "message",
+ "hints"
+ ],
+ "additionalProperties": false,
+ "$defs": {
+ "span": {
+ "description": "The span of the diagnostic",
+ "type": "object",
+ "properties": {
+ "file": {
+ "description": "The file in which the diagnostic occurs",
+ "type": "string"
+ },
+ "start": {
+ "description": "The start location of the diagnostic",
+ "$ref": "#/$defs/location"
+ },
+ "end": {
+ "description": "The end location of the diagnostic",
+ "$ref": "#/$defs/location"
+ }
+ },
+ "required": [
+ "file",
+ "start",
+ "end"
+ ],
+ "additionalProperties": false
+ },
+ "location": {
+ "description": "A location in a text file",
+ "type": "object",
+ "properties": {
+ "line": {
+ "description": "The line number",
+ "type": "integer"
+ },
+ "column": {
+ "description": "The column number",
+ "type": "integer"
+ }
+ },
+ "required": [
+ "line",
+ "column"
+ ],
+ "additionalProperties": false
+ }
+ }
+}
=====================================
docs/users_guide/using.rst
=====================================
@@ -1424,7 +1424,7 @@ messages and in GHCi:
a new line.
The structure of the output is described by a `JSON Schema <https://json-schema.org/>`_.
- The schema can be downloaded :download:`here <diagnostics-as-json-schema-1_0.json>`.
+ The schema can be downloaded :download:`here <diagnostics-as-json-schema-1_1.json>`.
.. ghc-flag:: -fdiagnostics-color=⟨always|auto|never⟩
:shortdesc: Use colors in error messages
=====================================
rts/IPE.c
=====================================
@@ -277,3 +277,20 @@ void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode *node) {
}
}
+
+#if defined(DEBUG)
+void printIPE(const StgInfoTable *info) {
+ InfoProvEnt ipe;
+ if (lookupIPE(info, &ipe)) {
+ debugBelch("%p:\n", info);
+ debugBelch(" name: %s\n", ipe.prov.table_name);
+ debugBelch(" desc: %" PRIu32 "\n", ipe.prov.closure_desc);
+ debugBelch(" type: %s\n", ipe.prov.ty_desc);
+ debugBelch(" label: %s\n", ipe.prov.label);
+ debugBelch(" module: %s:%s\n", ipe.prov.unit_id, ipe.prov.module);
+ debugBelch(" src loc: %s:%s\n", ipe.prov.src_file, ipe.prov.src_span);
+ } else {
+ debugBelch("%p: no IPE entry\n", info);
+ }
+}
+#endif
=====================================
rts/include/rts/IPE.h
=====================================
@@ -97,3 +97,7 @@ void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf);
// Returns true on success, initializes `out`.
bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out);
+
+#if defined(DEBUG)
+void printIPE(const StgInfoTable *info);
+#endif
=====================================
testsuite/tests/deriving/should_compile/T14682.stderr
=====================================
@@ -5,12 +5,13 @@ Derived class instances:
GHC.Internal.Show.showsPrec a (T14682.Foo b1 b2)
= GHC.Internal.Show.showParen
(a GHC.Classes.>= 11)
- ((GHC.Internal.Base..)
- (GHC.Internal.Show.showString "Foo ")
- ((GHC.Internal.Base..)
- (GHC.Internal.Show.showsPrec 11 b1)
- ((GHC.Internal.Base..)
- GHC.Internal.Show.showSpace (GHC.Internal.Show.showsPrec 11 b2))))
+ (\ z
+ -> GHC.Internal.Show.showString
+ "Foo "
+ (GHC.Internal.Show.showsPrec
+ 11 b1
+ (GHC.Internal.Show.showSpace
+ (GHC.Internal.Show.showsPrec 11 b2 z))))
instance GHC.Internal.TH.Lift.Lift T14682.Foo where
GHC.Internal.TH.Lift.lift (T14682.Foo a1 a2)
@@ -25,9 +26,8 @@ Derived class instances:
instance GHC.Internal.Data.Data.Data T14682.Foo where
GHC.Internal.Data.Data.gfoldl k z (T14682.Foo a1 a2)
- = ((z (\ a1 a2 -> T14682.Foo a1 a2) `k` a1) `k` a2)
- GHC.Internal.Data.Data.gunfold k z _
- = k (k (z (\ a1 a2 -> T14682.Foo a1 a2)))
+ = ((z T14682.Foo `k` a1) `k` a2)
+ GHC.Internal.Data.Data.gunfold k z _ = k (k (z T14682.Foo))
GHC.Internal.Data.Data.toConstr (T14682.Foo _ _) = $cFoo
GHC.Internal.Data.Data.dataTypeOf _ = $tFoo
@@ -46,18 +46,15 @@ Derived class instances:
GHC.Types.LT -> GHC.Types.LT
GHC.Types.EQ -> (a2 `GHC.Classes.compare` b2)
GHC.Types.GT -> GHC.Types.GT
- (GHC.Classes.<) a b
+ (GHC.Classes.<=) a b
= case a of
T14682.Foo a1 a2
-> case b of
T14682.Foo b1 b2
-> case (GHC.Classes.compare a1 b1) of
GHC.Types.LT -> GHC.Types.True
- GHC.Types.EQ -> (a2 GHC.Classes.< b2)
+ GHC.Types.EQ -> (a2 GHC.Classes.<= b2)
GHC.Types.GT -> GHC.Types.False
- (GHC.Classes.<=) a b = GHC.Classes.not ((GHC.Classes.<) b a)
- (GHC.Classes.>) a b = (GHC.Classes.<) b a
- (GHC.Classes.>=) a b = GHC.Classes.not ((GHC.Classes.<) a b)
instance GHC.Internal.Ix.Ix T14682.Foo where
GHC.Internal.Ix.range (T14682.Foo a1 a2, T14682.Foo b1 b2)
@@ -177,6 +174,24 @@ GHC.Classes.Eq [T14682.Foo]
+==================== Filling in method body ====================
+GHC.Classes.Ord [T14682.Foo]
+ (GHC.Classes.<) = GHC.Classes.$dm< @T14682.Foo
+
+
+
+==================== Filling in method body ====================
+GHC.Classes.Ord [T14682.Foo]
+ (GHC.Classes.>) = GHC.Classes.$dm> @T14682.Foo
+
+
+
+==================== Filling in method body ====================
+GHC.Classes.Ord [T14682.Foo]
+ (GHC.Classes.>=) = GHC.Classes.$dm>= @T14682.Foo
+
+
+
==================== Filling in method body ====================
GHC.Classes.Ord [T14682.Foo]
GHC.Classes.max = GHC.Classes.$dmmax @T14682.Foo
=====================================
testsuite/tests/deriving/should_compile/T20496.stderr
=====================================
@@ -32,5 +32,5 @@ rnd
null (MkT _) = False
instance Traversable T where
- traverse f (MkT a1) = fmap (\ b1 -> MkT b1) (f a1)
+ traverse f (MkT a1) = fmap MkT (f a1)
=====================================
testsuite/tests/deriving/should_run/T9576.stderr
=====================================
@@ -2,18 +2,16 @@ T9576: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.TypeE
T9576.hs:6:31: error: [GHC-39999]
• No instance for ‘Show Foo’ arising from a use of ‘showsPrec’
- • In the second argument of ‘(.)’, namely ‘(showsPrec 11 b1)’
+ • In the second argument of ‘showString’, namely
+ ‘(showsPrec 11 b1 z)’
+ In the expression: showString "MkBar " (showsPrec 11 b1 z)
In the second argument of ‘showParen’, namely
- ‘((.) (showString "MkBar ") (showsPrec 11 b1))’
- In the expression:
- showParen (a >= 11) ((.) (showString "MkBar ") (showsPrec 11 b1))
+ ‘(\ z -> showString "MkBar " (showsPrec 11 b1 z))’
When typechecking the code for ‘showsPrec’
in a derived instance for ‘Show Bar’:
To see the code I am typechecking, use -ddump-deriv
(deferred type error)
HasCallStack backtrace:
- collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
- toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:84:32 in ghc-internal:GHC.Internal.Exception
throw, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:435:30 in ghc-internal:GHC.Internal.Control.Exception.Base
=====================================
testsuite/tests/driver/all.T
=====================================
@@ -276,7 +276,7 @@ test('T12955', normal, makefile_test, [])
test('T12971', [when(opsys('mingw32'), fragile(17945)), ignore_stdout], makefile_test, [])
test('json_dump', normal, compile_fail, ['-ddump-json'])
test('json', normalise_version('ghc'), compile_fail, ['-fdiagnostics-as-json'])
-test('json_warn', normalise_version('ghc'), compile, ['-fdiagnostics-as-json -Wunused-matches'])
+test('json_warn', normalise_version('ghc'), compile, ['-fdiagnostics-as-json -Wunused-matches -Wx-partial'])
test('json2', normalise_version('ghc-internal', 'base','ghc-prim'), compile, ['-ddump-types -ddump-json -Wno-unsupported-llvm-version'])
test('T16167', [normalise_version('ghc'),req_interp,exit_code(1)], run_command,
['{compiler} -x hs -e ":set prog T16167.hs" -ddump-json T16167.hs'])
=====================================
testsuite/tests/driver/json.stderr
=====================================
@@ -1 +1 @@
-{"version":"1.0","ghcVersion":"ghc-9.11.20240329","span":{"file":"json.hs","start":{"line":9,"column":11},"end":{"line":9,"column":21}},"severity":"Error","code":48010,"message":["Empty list of alternatives in case expression"],"hints":["Perhaps you intended to use the `EmptyCase' extension"]}
+{"version":"1.1","ghcVersion":"ghc-9.13.20241113","span":{"file":"json.hs","start":{"line":9,"column":11},"end":{"line":9,"column":21}},"severity":"Error","code":48010,"message":["Empty list of alternatives in case expression"],"hints":["Perhaps you intended to use the `EmptyCase' extension"]}
=====================================
testsuite/tests/driver/json_warn.hs
=====================================
@@ -2,3 +2,6 @@ module Foo where
f :: Int -> Int
f x = 5
+
+g :: [a] -> a
+g = head
=====================================
testsuite/tests/driver/json_warn.stderr
=====================================
@@ -1 +1,2 @@
-{"version":"1.0","ghcVersion":"ghc-9.9.20230817","span":{"file":"json_warn.hs","start":{"line":4,"column":3},"end":{"line":4,"column":4}},"severity":"Warning","code":40910,"message":["Defined but not used: `x'"],"hints":[]}
+{"version":"1.1","ghcVersion":"ghc-9.13.20241113","span":{"file":"json_warn.hs","start":{"line":4,"column":3},"end":{"line":4,"column":4}},"severity":"Warning","code":40910,"message":["Defined but not used: `x'"],"hints":[],"reason":{"flags":["unused-matches"]}}
+{"version":"1.1","ghcVersion":"ghc-9.13.20241113","span":{"file":"json_warn.hs","start":{"line":7,"column":5},"end":{"line":7,"column":9}},"severity":"Warning","code":63394,"message":["In the use of `head'\n(imported from Prelude, but defined in GHC.Internal.List):\n\"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\".\""],"hints":[],"reason":{"category":"x-partial"}}
=====================================
testsuite/tests/typecheck/should_fail/T15883c.stderr
=====================================
@@ -1,4 +1,3 @@
-
T15883c.hs:14:1: error: [GHC-39999]
• No instance for ‘Eq (Foo LiftedRep)’
arising from the superclasses of an instance declaration
@@ -22,7 +21,7 @@ T15883c.hs:14:1: error: [GHC-39999]
To see the code I am typechecking, use -ddump-deriv
T15883c.hs:14:1: error: [GHC-39999]
- • Ambiguous type variable ‘a1’ arising from a use of ‘<’
+ • Ambiguous type variable ‘a1’ arising from a use of ‘<=’
prevents the constraint ‘(Ord a1)’ from being solved.
Probable fix: use a type annotation to specify what ‘a1’ should be.
Potentially matching instances:
@@ -31,9 +30,10 @@ T15883c.hs:14:1: error: [GHC-39999]
...plus 24 others
...plus two instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
- • In the expression: a1 < b1
- In a case alternative: MkFoo b1 -> (a1 < b1)
- In the expression: case b of MkFoo b1 -> (a1 < b1)
- When typechecking the code for ‘<’
+ • In the expression: a1 <= b1
+ In a case alternative: MkFoo b1 -> (a1 <= b1)
+ In the expression: case b of MkFoo b1 -> (a1 <= b1)
+ When typechecking the code for ‘<=’
in a derived instance for ‘Ord (Foo LiftedRep)’:
To see the code I am typechecking, use -ddump-deriv
+
=====================================
testsuite/tests/typecheck/should_fail/T15883d.stderr
=====================================
@@ -1,4 +1,3 @@
-
T15883d.hs:14:1: error: [GHC-39999]
• Ambiguous type variable ‘a0’ arising from a use of ‘showsPrec’
prevents the constraint ‘(Show a0)’ from being solved.
@@ -9,11 +8,12 @@ T15883d.hs:14:1: error: [GHC-39999]
...plus 29 others
...plus 10 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
- • In the second argument of ‘(.)’, namely ‘(showsPrec 11 b1)’
+ • In the second argument of ‘showString’, namely
+ ‘(showsPrec 11 b1 z)’
+ In the expression: showString "MkFoo " (showsPrec 11 b1 z)
In the second argument of ‘showParen’, namely
- ‘((.) (showString "MkFoo ") (showsPrec 11 b1))’
- In the expression:
- showParen (a >= 11) ((.) (showString "MkFoo ") (showsPrec 11 b1))
+ ‘(\ z -> showString "MkFoo " (showsPrec 11 b1 z))’
When typechecking the code for ‘showsPrec’
in a derived instance for ‘Show (Foo LiftedRep)’:
To see the code I am typechecking, use -ddump-deriv
+
=====================================
testsuite/tests/typecheck/should_fail/T15883e.stderr
=====================================
@@ -1,71 +1,26 @@
-
-T15883e.hs:16:1: error: [GHC-39999]
- • Ambiguous type variable ‘d0’ arising from a use of ‘k’
- prevents the constraint ‘(Data d0)’ from being solved.
- Probable fix: use a type annotation to specify what ‘d0’ should be.
- Potentially matching instances:
- instance (Data a, Data b) => Data (Either a b)
- -- Defined in ‘GHC.Internal.Data.Data’
- instance Data a => Data (Down a)
- -- Defined in ‘GHC.Internal.Data.Data’
- ...plus 20 others
- ...plus 47 instances involving out-of-scope types
- (use -fprint-potential-instances to see them all)
- • In the expression: z (\ a1 -> MkFoo a1) `k` a1
- In an equation for ‘GHC.Internal.Data.Data.gfoldl’:
- GHC.Internal.Data.Data.gfoldl k z (MkFoo a1)
- = (z (\ a1 -> MkFoo a1) `k` a1)
- When typechecking the code for ‘GHC.Internal.Data.Data.gfoldl’
- in a derived instance for ‘Data (Foo LiftedRep)’:
- To see the code I am typechecking, use -ddump-deriv
- In the instance declaration for ‘Data (Foo LiftedRep)’
-
-T15883e.hs:16:1: error: [GHC-46956]
- • Couldn't match expected type ‘a’ with actual type ‘d0’
- because type variable ‘a’ would escape its scope
- This (rigid, skolem) type variable is bound by
- a type expected by the context:
- forall a. a
- at T15883e.hs:16:1-52
- • In the first argument of ‘MkFoo’, namely ‘a1’
- In the expression: MkFoo a1
- In the first argument of ‘z’, namely ‘(\ a1 -> MkFoo a1)’
+T15883e.hs:16:1: error: [GHC-91028]
+ • Couldn't match type ‘d0’ with ‘forall a. a’
+ Expected: d0 -> Foo LiftedRep
+ Actual: (forall a. a) -> Foo LiftedRep
+ Cannot instantiate unification variable ‘d0’
+ with a type involving polytypes: forall a. a
+ • In the first argument of ‘z’, namely ‘MkFoo’
+ In the first argument of ‘k’, namely ‘z MkFoo’
+ In the expression: z MkFoo `k` a1
When typechecking the code for ‘GHC.Internal.Data.Data.gfoldl’
in a derived instance for ‘Data (Foo LiftedRep)’:
To see the code I am typechecking, use -ddump-deriv
- • Relevant bindings include a1 :: d0 (bound at T15883e.hs:16:1)
-T15883e.hs:16:1: error: [GHC-39999]
- • Ambiguous type variable ‘b0’ arising from a use of ‘k’
- prevents the constraint ‘(Data b0)’ from being solved.
- Probable fix: use a type annotation to specify what ‘b0’ should be.
- Potentially matching instances:
- instance (Data a, Data b) => Data (Either a b)
- -- Defined in ‘GHC.Internal.Data.Data’
- instance Data a => Data (Down a)
- -- Defined in ‘GHC.Internal.Data.Data’
- ...plus 20 others
- ...plus 47 instances involving out-of-scope types
- (use -fprint-potential-instances to see them all)
- • In the expression: k (z (\ a1 -> MkFoo a1))
- In an equation for ‘GHC.Internal.Data.Data.gunfold’:
- GHC.Internal.Data.Data.gunfold k z _ = k (z (\ a1 -> MkFoo a1))
+T15883e.hs:16:1: error: [GHC-91028]
+ • Couldn't match type ‘b0’ with ‘forall a. a’
+ Expected: b0 -> Foo LiftedRep
+ Actual: (forall a. a) -> Foo LiftedRep
+ Cannot instantiate unification variable ‘b0’
+ with a type involving polytypes: forall a. a
+ • In the first argument of ‘z’, namely ‘MkFoo’
+ In the first argument of ‘k’, namely ‘(z MkFoo)’
+ In the expression: k (z MkFoo)
When typechecking the code for ‘GHC.Internal.Data.Data.gunfold’
in a derived instance for ‘Data (Foo LiftedRep)’:
To see the code I am typechecking, use -ddump-deriv
- In the instance declaration for ‘Data (Foo LiftedRep)’
-T15883e.hs:16:1: error: [GHC-46956]
- • Couldn't match expected type ‘a’ with actual type ‘b0’
- because type variable ‘a’ would escape its scope
- This (rigid, skolem) type variable is bound by
- a type expected by the context:
- forall a. a
- at T15883e.hs:16:1-52
- • In the first argument of ‘MkFoo’, namely ‘a1’
- In the expression: MkFoo a1
- In the first argument of ‘z’, namely ‘(\ a1 -> MkFoo a1)’
- When typechecking the code for ‘GHC.Internal.Data.Data.gunfold’
- in a derived instance for ‘Data (Foo LiftedRep)’:
- To see the code I am typechecking, use -ddump-deriv
- • Relevant bindings include a1 :: b0 (bound at T15883e.hs:16:1)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/907f32ff9e8a0e8b9f4d1118f39a17b0a0fd9a1b...df5e4f90e9c024c9d390b5e53aac87b2e6170eba
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/907f32ff9e8a0e8b9f4d1118f39a17b0a0fd9a1b...df5e4f90e9c024c9d390b5e53aac87b2e6170eba
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/20241119/996cef71/attachment-0001.html>
More information about the ghc-commits
mailing list