[Git][ghc/ghc][wip/t22695] Only store Name in FunRhs rather than Id with knot-tied fields
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Tue Jan 3 16:28:24 UTC 2023
Matthew Pickering pushed to branch wip/t22695 at Glasgow Haskell Compiler / GHC
Commits:
a5037f2f by Matthew Pickering at 2023-01-03T16:27:37+00:00
Only store Name in FunRhs rather than Id with knot-tied fields
The Note [fixM for rhs_ty in tcMonoBinds] explains that certain fields of the Id created
here are knot-tied and can't be referenced inside the scope of the fixM.
The modification to `FunRhs` ensures that we
can't accidentally force the knot-tied fields of the `Id`. The `Name` is
just used for error messages and printing.
The result is that when `-dppr-debug` was enabled the compiler would
hang because the debug printing of the Id would try and print fields
which were not populated yet.
Fixes #22695
- - - - -
11 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- + testsuite/tests/ghci/scripts/T22695.script
- + testsuite/tests/ghci/scripts/T22695.stderr
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -2002,7 +2002,7 @@ matchSeparator ThPatSplice = panic "unused"
matchSeparator ThPatQuote = panic "unused"
matchSeparator PatSyn = panic "unused"
-pprMatchContext :: (Outputable (IdP p), UnXRec p)
+pprMatchContext :: (Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p))
=> HsMatchContext p -> SDoc
pprMatchContext ctxt
| want_an ctxt = text "an" <+> pprMatchContextNoun ctxt
@@ -2013,10 +2013,10 @@ pprMatchContext ctxt
want_an (ArrowMatchCtxt KappaExpr) = True
want_an _ = False
-pprMatchContextNoun :: forall p. (Outputable (IdP p), UnXRec p)
+pprMatchContextNoun :: forall p. (Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p))
=> HsMatchContext p -> SDoc
pprMatchContextNoun (FunRhs {mc_fun=fun}) = text "equation for"
- <+> quotes (ppr (unXRec @p fun))
+ <+> quotes (ppr (unXRec @(NoGhcTc p) fun))
pprMatchContextNoun CaseAlt = text "case alternative"
pprMatchContextNoun (LamCaseAlt lc_variant) = lamCaseKeyword lc_variant
<+> text "alternative"
@@ -2032,10 +2032,10 @@ pprMatchContextNoun (StmtCtxt ctxt) = text "pattern binding in"
$$ pprAStmtContext ctxt
pprMatchContextNoun PatSyn = text "pattern synonym declaration"
-pprMatchContextNouns :: forall p. (Outputable (IdP p), UnXRec p)
+pprMatchContextNouns :: forall p. (Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p))
=> HsMatchContext p -> SDoc
pprMatchContextNouns (FunRhs {mc_fun=fun}) = text "equations for"
- <+> quotes (ppr (unXRec @p fun))
+ <+> quotes (ppr (unXRec @(NoGhcTc p) fun))
pprMatchContextNouns PatBindGuards = text "pattern binding guards"
pprMatchContextNouns (ArrowMatchCtxt c) = pprArrowMatchContextNouns c
pprMatchContextNouns (StmtCtxt ctxt) = text "pattern bindings in"
@@ -2056,7 +2056,7 @@ pprArrowMatchContextNouns (ArrowLamCaseAlt lc_variant) = lamCaseKeyword lc_varia
pprArrowMatchContextNouns ctxt = pprArrowMatchContextNoun ctxt <> char 's'
-----------------
-pprAStmtContext, pprStmtContext :: (Outputable (IdP p), UnXRec p)
+pprAStmtContext, pprStmtContext :: (Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p))
=> HsStmtContext p -> SDoc
pprAStmtContext (HsDoStmt flavour) = pprAHsDoFlavour flavour
pprAStmtContext ctxt = text "a" <+> pprStmtContext ctxt
=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -98,6 +98,13 @@ constraint of IsPass is *recursive*: it asserts that IsPass (NoGhcTcPass p) hold
For this to make sense, we need -XUndecidableSuperClasses and the other constraint,
saying that NoGhcTcPass is idempotent.
+There are also situations (such as in HsMatchContext) where we start by storing a
+RdrName in the parser, then a Name in the renamer but don't store an Id in the typechecker.
+The reason here is that the Id we would use in the typechecker is in the middle of being
+constructed by knot-tying (see Note [fixM for rhs_ty in tcMonoBinds]). All the fields
+apart from the `Name` can't be inspected whilst in the loop, so it's safer to just store the
+Name (see #22695 for where this went wrong).
+
-}
-- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -863,7 +863,7 @@ mkSimpleGeneratedFunBind loc fun pats expr
emptyLocalBinds]
-- | Make a prefix, non-strict function 'HsMatchContext'
-mkPrefixFunRhs :: LIdP p -> HsMatchContext p
+mkPrefixFunRhs :: LIdP (NoGhcTc p) -> HsMatchContext p
mkPrefixFunRhs n = FunRhs { mc_fun = n
, mc_fixity = Prefix
, mc_strictness = NoSrcStrict }
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -957,7 +957,7 @@ instance HiePass p => ToHie (HsMatchContext (GhcPass p)) where
name' :: LocatedN Name
name' = case hiePass @p of
HieRn -> name
- HieTc -> fmap varName name
+ HieTc -> name
toHie (StmtCtxt a) = toHie a
toHie _ = pure []
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -127,12 +127,7 @@ tcMatchesFun fun_id matches exp_ty
herald = ExpectedFunTyMatches (NameThing fun_name) matches
ctxt = GenSigCtxt -- Was: FunSigCtxt fun_name True
-- But that's wrong for f :: Int -> forall a. blah
- what = FunRhs { mc_fun = fun_id, mc_fixity = Prefix, mc_strictness = strictness }
- -- Careful: this fun_id could be an unfilled
- -- thunk from fixM in tcMonoBinds, so we're
- -- not allowed to look at it, except for
- -- idName.
- -- See Note [fixM for rhs_ty in tcMonoBinds]
+ what = FunRhs { mc_fun = idName <$> fun_id, mc_fixity = Prefix, mc_strictness = strictness }
match_ctxt = MC { mc_what = what, mc_body = tcBody }
strictness
| [L _ match] <- unLoc $ mg_alts matches
=====================================
compiler/GHC/Tc/TyCl/PatSyn.hs
=====================================
@@ -838,7 +838,7 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn
args body]
, mg_ext = MatchGroupTc (map unrestricted [pat_ty, cont_ty, fail_ty]) res_ty Generated
}
- match = mkMatch (mkPrefixFunRhs (L loc patsyn_id)) []
+ match = mkMatch (mkPrefixFunRhs (L loc (idName patsyn_id))) []
(mkHsLams (rr_tv:res_tv:univ_tvs)
req_dicts body')
(EmptyLocalBinds noExtField)
=====================================
compiler/Language/Haskell/Syntax/Expr.hs
=====================================
@@ -1533,7 +1533,14 @@ data HsMatchContext p
= FunRhs
-- ^ A pattern matching on an argument of a
-- function binding
- { mc_fun :: LIdP p -- ^ function binder of @f@
+ { mc_fun :: LIdP (NoGhcTc p) -- ^ function binder of @f@
+ -- See Note [NoGhcTc], this usage of 'NoGhcTc' is
+ -- because the 'Id' which would be put here
+ -- in 'tcMatchesFun' contains unfilled thunks
+ -- (see Note [fixM for rhs_ty in tcMonoBinds])
+ -- As it is only printed
+ -- in error messages and traces, it's safer to just
+ -- store the Name.
, mc_fixity :: LexicalFixity -- ^ fixing of @f@
, mc_strictness :: SrcStrictness -- ^ was @f@ banged?
-- See Note [FunBind vs PatBind]
=====================================
testsuite/tests/ghci/scripts/T22695.script
=====================================
@@ -0,0 +1 @@
+test x | Just <- x = x
=====================================
testsuite/tests/ghci/scripts/T22695.stderr
=====================================
@@ -0,0 +1,8 @@
+
+<interactive>:1:10: error:
+ • The constructor ‘Just’ should have 1 argument, but has been given none
+ • In the pattern: Just
+ In a stmt of a pattern guard for
+ an equation for ‘test’:
+ Just <- x
+ In an equation for ‘test’: test x | Just <- x = x
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -370,3 +370,4 @@ test('T21110', [extra_files(['T21110A.hs'])], ghci_script,
test('T17830', [filter_stdout_lines(r'======.*')], ghci_script, ['T17830.script'])
test('T21294a', normal, ghci_script, ['T21294a.script'])
test('T21507', normal, ghci_script, ['T21507.script'])
+test('T22695', normal, ghci_script, ['T22695.script'])
=====================================
testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
=====================================
@@ -1560,7 +1560,7 @@
(FunRhs
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpTypecheckedAst.hs:19:1-4 })
- {Var: main})
+ {Name: main})
(Prefix)
(NoSrcStrict))
[]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5037f2f62d06fa21d7f8a733e833947124efd16
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5037f2f62d06fa21d7f8a733e833947124efd16
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/20230103/1a318a12/attachment-0001.html>
More information about the ghc-commits
mailing list