Commit c3fde723 authored by Ryan Scott's avatar Ryan Scott Committed by Marge Bot

Handle local fixity declarations in DsMeta properly

`DsMeta.rep_sig` used to skip over `FixSig` entirely, which had the
effect of causing local fixity declarations to be dropped when quoted
in Template Haskell. But there is no good reason for this state of
affairs, as the code in `DsMeta.repFixD` (which handles top-level
fixity declarations) handles local fixity declarations just fine.
This patch factors out the necessary parts of `repFixD` so that they
can be used in `rep_sig` as well.

There was one minor complication: the fixity signatures for class
methods in each `HsGroup` were stored both in `FixSig`s _and_ the
list of `LFixitySig`s for top-level fixity signatures, so I needed
to take action to prevent fixity signatures for class methods being
converted to `Dec`s twice. I tweaked `RnSource.add` to avoid putting
these fixity signatures in two places and added
`Note [Top-level fixity signatures in an HsGroup]` in `GHC.Hs.Decls`
to explain the new design.

Fixes #17608. Bumps the Haddock submodule.
parent 86966d48
......@@ -84,7 +84,8 @@ module GHC.Hs.Decls (
resultVariableName,
-- * Grouping
HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls
HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups, hsGroupInstDecls,
hsGroupTopLevelFixitySigs,
) where
......@@ -167,18 +168,49 @@ type instance XDocD (GhcPass _) = NoExtField
type instance XRoleAnnotD (GhcPass _) = NoExtField
type instance XXHsDecl (GhcPass _) = NoExtCon
-- NB: all top-level fixity decls are contained EITHER
-- EITHER SigDs
-- OR in the ClassDecls in TyClDs
--
-- The former covers
-- a) data constructors
-- b) class methods (but they can be also done in the
-- signatures of class decls)
-- c) imported functions (that have an IfacSig)
-- d) top level decls
--
-- The latter is for class methods only
{-
Note [Top-level fixity signatures in an HsGroup]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
An `HsGroup p` stores every top-level fixity declarations in one of two places:
1. hs_fixds :: [LFixitySig p]
This stores fixity signatures for top-level declarations (e.g., functions,
data constructors, classes, type families, etc.) as well as fixity
signatures for class methods written outside of the class, as in this
example:
infixl 4 `m1`
class C1 a where
m1 :: a -> a -> a
2. hs_tyclds :: [TyClGroup p]
Each type class can be found in a TyClDecl inside a TyClGroup, and that
TyClDecl stores the fixity signatures for its methods written inside of the
class, as in this example:
class C2 a where
infixl 4 `m2`
m2 :: a -> a -> a
The story for fixity signatures for class methods is made slightly complicated
by the fact that they can appear both inside and outside of the class itself,
and both forms of fixity signatures are considered top-level. This matters
in `GHC.Rename.Source.rnSrcDecls`, which must create a fixity environment out
of all top-level fixity signatures before doing anything else. Therefore,
`rnSrcDecls` must be aware of both (1) and (2) above. The
`hsGroupTopLevelFixitySigs` function is responsible for collecting this
information from an `HsGroup`.
One might wonder why we even bother separating top-level fixity signatures
into two places at all. That is, why not just take the fixity signatures
from `hs_tyclds` and put them into `hs_fixds` so that they are all in one
location? This ends up causing problems for `DsMeta.repTopDs`, which translates
each fixity signature in `hs_fixds` and `hs_tyclds` into a Template Haskell
`Dec`. If there are any duplicate signatures between the two fields, this will
result in an error (#17608).
-}
-- | Haskell Group
--
......@@ -199,8 +231,10 @@ data HsGroup p
hs_derivds :: [LDerivDecl p],
hs_fixds :: [LFixitySig p],
-- Snaffled out of both top-level fixity signatures,
-- and those in class declarations
-- A list of fixity signatures defined for top-level
-- declarations and class methods (defined outside of the class
-- itself).
-- See Note [Top-level fixity signatures in an HsGroup]
hs_defds :: [LDefaultDecl p],
hs_fords :: [LForeignDecl p],
......@@ -232,6 +266,19 @@ emptyGroup = HsGroup { hs_ext = noExtField,
hs_splcds = [],
hs_docs = [] }
-- | The fixity signatures for each top-level declaration and class method
-- in an 'HsGroup'.
-- See Note [Top-level fixity signatures in an HsGroup]
hsGroupTopLevelFixitySigs :: HsGroup (GhcPass p) -> [LFixitySig (GhcPass p)]
hsGroupTopLevelFixitySigs (HsGroup{ hs_fixds = fixds, hs_tyclds = tyclds }) =
fixds ++ cls_fixds
where
cls_fixds = [ L loc sig
| L _ ClassDecl{tcdSigs = sigs} <- tyClGroupTyClDecls tyclds
, L loc (FixSig _ sig) <- sigs
]
hsGroupTopLevelFixitySigs (XHsGroup nec) = noExtCon nec
appendGroups :: HsGroup (GhcPass p) -> HsGroup (GhcPass p)
-> HsGroup (GhcPass p)
appendGroups
......
......@@ -104,10 +104,10 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls,
hs_ruleds = rule_decls,
hs_docs = docs })
= do {
-- (A) Process the fixity declarations, creating a mapping from
-- FastStrings to FixItems.
-- Also checks for duplicates.
local_fix_env <- makeMiniFixityEnv fix_decls ;
-- (A) Process the top-level fixity declarations, creating a mapping from
-- FastStrings to FixItems. Also checks for duplicates.
-- See Note [Top-level fixity signatures in an HsGroup] in GHC.Hs.Decls
local_fix_env <- makeMiniFixityEnv $ hsGroupTopLevelFixitySigs group ;
-- (B) Bring top level binders (and their fixities) into scope,
-- *except* for the value bindings, which get done in step (D)
......@@ -2301,13 +2301,8 @@ add gp loc (SpliceD _ splice@(SpliceDecl _ _ flag)) ds
-- relevant to the larger base of users.
-- See #12146 for discussion.
-- Class declarations: pull out the fixity signatures to the top
add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD _ d) ds
| isClassDecl d
= let fsigs = [ L l f
| L l (FixSig _ f) <- tcdSigs d ] in
addl (gp { hs_tyclds = add_tycld (L l d) ts, hs_fixds = fsigs ++ fs}) ds
| otherwise
-- Class declarations: added to the TyClGroup
add gp@(HsGroup {hs_tyclds = ts}) l (TyClD _ d) ds
= addl (gp { hs_tyclds = add_tycld (L l d) ts }) ds
-- Signatures: fixity sigs go a different place than all others
......
......@@ -285,7 +285,7 @@ repTopDs group@(HsGroup { hs_valds = valds
; kisig_ds <- mapM repKiSigD (concatMap group_kisigs tyclds)
; inst_ds <- mapM repInstD instds
; deriv_ds <- mapM repStandaloneDerivD derivds
; fix_ds <- mapM repFixD fixds
; fix_ds <- mapM repLFixD fixds
; _ <- mapM no_default_decl defds
; for_ds <- mapM repForD fords
; _ <- mapM no_warn (concatMap (wd_warnings . unLoc)
......@@ -796,8 +796,11 @@ repSafety PlayRisky = rep2_nw unsafeName []
repSafety PlayInterruptible = rep2_nw interruptibleName []
repSafety PlaySafe = rep2_nw safeName []
repFixD :: LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
repFixD (L loc (FixitySig _ names (Fixity _ prec dir)))
repLFixD :: LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
repLFixD (L loc fix_sig) = rep_fix_d loc fix_sig
rep_fix_d :: SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
rep_fix_d loc (FixitySig _ names (Fixity _ prec dir))
= do { MkC prec' <- coreIntLit prec
; let rep_fn = case dir of
InfixL -> infixLDName
......@@ -808,7 +811,7 @@ repFixD (L loc (FixitySig _ names (Fixity _ prec dir)))
; dec <- rep2 rep_fn [prec', name']
; return (loc,dec) }
; mapM do_one names }
repFixD (L _ (XFixitySig nec)) = noExtCon nec
rep_fix_d _ (XFixitySig nec) = noExtCon nec
repRuleD :: LRuleDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec))
repRuleD (L loc (HsRule { rd_name = n
......@@ -1003,7 +1006,7 @@ rep_sig (L loc (ClassOpSig _ is_deflt nms ty))
| is_deflt = mapM (rep_ty_sig defaultSigDName loc ty) nms
| otherwise = mapM (rep_ty_sig sigDName loc ty) nms
rep_sig d@(L _ (IdSig {})) = pprPanic "rep_sig IdSig" (ppr d)
rep_sig (L _ (FixSig {})) = return [] -- fixity sigs at top level
rep_sig (L loc (FixSig _ fix_sig)) = rep_fix_d loc fix_sig
rep_sig (L loc (InlineSig _ nm ispec))= rep_inline nm ispec loc
rep_sig (L loc (SpecSig _ nm tys ispec))
= concatMapM (\t -> rep_specialise nm t ispec loc) tys
......
......@@ -42,6 +42,10 @@ Template Haskell
forms have now been generalised in terms of a minimal interface necessary for the
implementation rather than the overapproximation of the ``Q`` monad.
- Template Haskell quotes now handle fixity declarations in ``let`` and
``where`` bindings properly. Previously, such fixity declarations would
be dropped when quoted due to a Template Haskell bug.
``ghc-prim`` library
~~~~~~~~~~~~~~~~~~~~
......@@ -56,6 +60,20 @@ Template Haskell
=> ([Word8] -> a) -> ModGuts
-> CoreM (ModuleEnv [a], NameEnv [a])
- The meaning of the ``hs_fixds`` field of ``HsGroup`` has changed slightly.
It now only contains fixity signatures defined for top-level declarations
and class methods defined *outside* of the class itself. Previously,
``hs_fixds`` would also contain fixity signatures for class methods defined
*inside* the class, such as the fixity signature for ``m`` in the following
example: ::
class C a where
infixl 4 `m`
m :: a -> a -> a
If you wish to attain the previous behavior of ``hs_fixds``, use the new
``hsGroupTopLevelFixitySigs`` function, which collects all top-level fixity
signatures, including those for class methods defined inside classes.
``base`` library
~~~~~~~~~~~~~~~~
......
{-# LANGUAGE TemplateHaskell #-}
module T17608 where
$([d| infixl 4 `f`
f :: Bool
f = let infixl 4 `h`
h :: () -> Bool -> Bool
h _ _ = True in
h () (g () ())
where
infixl 4 `g`
g :: () -> () -> Bool
g _ _ = True
infixl 4 `n`
class C a where
infixl 4 `m`
m :: a -> a -> a
n :: a -> a -> a
|])
T17608.hs:(4,2)-(20,7): Splicing declarations
[d| infixl 4 `n`
infixl 4 `f`
f :: Bool
f = let
infixl 4 `h`
h :: () -> Bool -> Bool
h _ _ = True
in h () (g () ())
where
infixl 4 `g`
g :: () -> () -> Bool
g _ _ = True
class C a where
infixl 4 `m`
m :: a -> a -> a
n :: a -> a -> a |]
======>
infixl 4 `f`
f :: Bool
f = let
infixl 4 `h`
h :: () -> Bool -> Bool
h _ _ = True
in (h ()) ((g ()) ())
where
infixl 4 `g`
g :: () -> () -> Bool
g _ _ = True
infixl 4 `n`
class C a where
infixl 4 `m`
m :: a -> a -> a
n :: a -> a -> a
......@@ -495,5 +495,6 @@ test('T17379a', normal, compile_fail, [''])
test('T17379b', normal, compile_fail, [''])
test('T17461', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T17511', normal, compile, [''])
test('T17608', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('TH_PprStar', normal, compile, ['-v0 -dsuppress-uniques'])
test('TH_StringLift', normal, compile, [''])
Subproject commit c67c24fc90e8217c3d2139e99e92889e1df180f8
Subproject commit e2c0a757f5aae215d89e464a7e45f9777c27c8f0
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment