diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2021-12-21 13:00:28 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-12-22 00:13:38 -0500 |
| commit | 09b6cb45505c2c32ddaffcdb930fb3f7873b2cfc (patch) | |
| tree | e5ece936a8853bef1c8b9551b4eb8f2a4af0bac4 /compiler/GHC/Parser.y | |
| parent | d7cc8f1915c9617b6d4256fd1e483c24b4b1e851 (diff) | |
| download | haskell-09b6cb45505c2c32ddaffcdb930fb3f7873b2cfc.tar.gz | |
Fix panic trying to -ddump-parsed-ast for implicit fixity
A declaration such as
infixr ++++
is supplied with an implicit fixity of 9 in the parser, but uses
an invalid SrcSpan to capture this. Use of this span triggers a panic.
Fix the problem by not recording an exact print annotation for the
non-existent fixity source.
Closes #20846
Diffstat (limited to 'compiler/GHC/Parser.y')
| -rw-r--r-- | compiler/GHC/Parser.y | 22 |
1 files changed, 15 insertions, 7 deletions
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index d768ef2d04..b7c2655f36 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -1158,10 +1158,10 @@ impspec :: { Located (Bool, LocatedL [LIE GhcPs]) } ----------------------------------------------------------------------------- -- Fixity Declarations -prec :: { Located (SourceText,Int) } - : {- empty -} { noLoc (NoSourceText,9) } +prec :: { Maybe (Located (SourceText,Int)) } + : {- empty -} { Nothing } | INTEGER - { sL1 $1 (getINTEGERs $1,fromInteger (il_value (getINTEGER $1))) } + { Just (sL1 $1 (getINTEGERs $1,fromInteger (il_value (getINTEGER $1)))) } infix :: { Located FixityDirection } : 'infix' { sL1 $1 InfixN } @@ -2552,10 +2552,18 @@ sigdecl :: { LHsDecl GhcPs } ; acsA (\cs -> sLL (reLocN $1) (reLoc $>) $ SigD noExtField (sig cs) ) }} | infix prec ops - {% checkPrecP $2 $3 >> - acsA (\cs -> sLL $1 $> $ SigD noExtField - (FixSig (EpAnn (glR $1) [mj AnnInfix $1,mj AnnVal $2] cs) (FixitySig noExtField (fromOL $ unLoc $3) - (Fixity (fst $ unLoc $2) (snd $ unLoc $2) (unLoc $1))))) } + {% do { mbPrecAnn <- traverse (\l2 -> do { checkPrecP l2 $3 + ; pure (mj AnnVal l2) }) + $2 + ; let (fixText, fixPrec) = case $2 of + -- If an explicit precedence isn't supplied, + -- it defaults to maxPrecedence + Nothing -> (NoSourceText, maxPrecedence) + Just l2 -> (fst $ unLoc l2, snd $ unLoc l2) + ; acsA (\cs -> sLL $1 $> $ SigD noExtField + (FixSig (EpAnn (glR $1) (mj AnnInfix $1 : maybeToList mbPrecAnn) cs) (FixitySig noExtField (fromOL $ unLoc $3) + (Fixity fixText fixPrec (unLoc $1))))) + }} | pattern_synonym_sig { sL1 $1 . SigD noExtField . unLoc $ $1 } |