diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 6e805fe19b3e1539c91af9f5775d147c0c14c0c0..bf35ef46ec13472c48568c3c180f5d5b7a86372f 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -42,7 +42,7 @@ just attach noSrcSpan to everything.
module GHC.Hs.Utils(
-- * Terms
- mkHsPar, mkHsApp, mkHsAppWith, mkHsApps, mkHsAppsWith,
+ mkHsPar, mkHsApp, mkHsAppWith, mkHsApps, mkHsAppsWith, mkHsSyntaxApps,
mkHsAppType, mkHsAppTypes, mkHsCaseAlt,
mkSimpleMatch, unguardedGRHSs, unguardedRHS,
mkMatchGroup, mkLamCaseMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf,
@@ -282,6 +282,17 @@ mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc
mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars
<.> mkWpEvLams dicts) expr
+mkHsSyntaxApps :: SrcSpanAnnA -> SyntaxExprTc -> [LHsExpr GhcTc]
+ -> LHsExpr GhcTc
+mkHsSyntaxApps ann (SyntaxExprTc { syn_expr = fun
+ , syn_arg_wraps = arg_wraps
+ , syn_res_wrap = res_wrap }) args
+ = mkLHsWrap res_wrap (foldl' mkHsApp (L ann fun) (zipWithEqual "mkHsSyntaxApps"
+ mkLHsWrap arg_wraps args))
+mkHsSyntaxApps _ NoSyntaxExprTc args = pprPanic "mkHsSyntaxApps" (ppr args)
+ -- this function should never be called in scenarios where there is no
+ -- syntax expr
+
-- |A simple case alternative with a single pattern, no binds, no guards;
-- pre-typechecking
mkHsCaseAlt :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
@@ -516,14 +527,7 @@ nlHsApp f x = noLocA (HsApp noComments f (mkLHsPar x))
nlHsSyntaxApps :: SyntaxExprTc -> [LHsExpr GhcTc]
-> LHsExpr GhcTc
-nlHsSyntaxApps (SyntaxExprTc { syn_expr = fun
- , syn_arg_wraps = arg_wraps
- , syn_res_wrap = res_wrap }) args
- = mkLHsWrap res_wrap (foldl' nlHsApp (noLocA fun) (zipWithEqual "nlHsSyntaxApps"
- mkLHsWrap arg_wraps args))
-nlHsSyntaxApps NoSyntaxExprTc args = pprPanic "nlHsSyntaxApps" (ppr args)
- -- this function should never be called in scenarios where there is no
- -- syntax expr
+nlHsSyntaxApps = mkHsSyntaxApps noSrcSpanA
nlHsApps :: IsSrcSpanAnn p a
=> IdP (GhcPass p) -> [LHsExpr (GhcPass p)] -> LHsExpr (GhcPass p)
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 3558277b20ededd66ff2b2c981faaa843a316545..6d4d39117bb38564248c7c3a7747f9e514f94d4c 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -12,6 +12,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-orphans #-} -- For the HasLoc instances
@@ -1010,10 +1011,14 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
]
LitPat _ _ ->
[]
- NPat _ _ _ _ ->
- []
- NPlusKPat _ n _ _ _ _ ->
+ NPat _ (L loc lit) _ eq ->
+ [ toHie $ L (l2l loc :: SrcSpanAnnA) lit
+ , toHieSyntax (L ospan eq)
+ ]
+ NPlusKPat _ n (L loc lit) _ ord _ ->
[ toHie $ C (PatternBind scope pscope rsp) n
+ , toHie $ L (l2l loc :: SrcSpanAnnA) lit
+ , toHieSyntax (L ospan ord)
]
SigPat _ pat sig ->
[ toHie $ PS rsp scope pscope pat
@@ -1055,6 +1060,23 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
L spn $ HsFieldBind x lbl (PS rsp scope fscope pat) pun
scoped_fds = listScopes pscope fds
+toHieSyntax :: forall p. HiePass p => LocatedA (SyntaxExpr (GhcPass p)) -> HieM [HieAST Type]
+toHieSyntax s = local (const GeneratedInfo) $ case hiePass @p of
+ HieRn -> toHie s
+ HieTc -> toHie s
+
+instance ToHie (LocatedA SyntaxExprRn) where
+ toHie (L mspan (SyntaxExprRn expr)) = toHie (L mspan expr)
+ toHie (L _ NoSyntaxExprRn) = pure []
+
+instance ToHie (LocatedA SyntaxExprTc) where
+ toHie (L mspan (SyntaxExprTc expr w1 w2)) = concatM
+ [ toHie (L mspan expr)
+ , concatMapM (toHie . L mspan) w1
+ , toHie (L mspan w2)
+ ]
+ toHie (L _ NoSyntaxExprTc) = pure []
+
instance ToHie (TScoped (HsPatSigType GhcRn)) where
toHie (TS sc (HsPS (HsPSRn wcs tvs) body@(L span _))) = concatM $
[ bindingsOnly $ map (C $ TyVarBind (mkScopeA span) sc) (wcs++tvs)
@@ -1088,6 +1110,50 @@ instance ( ToHie (LocatedA (body (GhcPass p)))
, toHie body
]
+{-
+Note [Source locations for implicit function calls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+While calls to e.g. 'fromString' with -XOverloadedStrings do not actually
+appear in the source code, giving their HsWrapper the location of the
+overloaded bit of syntax that triggered them is useful for assigning
+their type class evidence uses to the right location in the HIE AST.
+Without this, we only get type class instance information under the
+expected top-level node if the type had to be inferred. (#23540)
+
+We currently handle the following constructors with this in mind,
+all largely in the renamer as their locations are normally inherited by
+the typechecker:
+
+ * HsOverLit, where we assign the SrcSpan of the overloaded literal
+ to ol_from_fun.
+ * HsDo, where we give the SrcSpan of the entire do block to each
+ ApplicativeStmt.
+ * HsExpanded ExplicitList{}, where we give the SrcSpan of the original
+ list expression to the 'fromListN' call.
+
+In order for the implicit function calls to not be confused for actual
+occurrences of functions in the source code, most of this extra information
+is put under 'GeneratedInfo'.
+-}
+
+whenPostTc :: forall p t m. (HiePass p, Applicative t, Monoid m) => ((p ~ 'Typechecked) => t m) -> t m
+whenPostTc a = case hiePass @p of
+ HieTc -> a
+ HieRn -> pure mempty
+
+-- | Helper function for a common pattern where we are only interested in
+-- implicit evidence information: runs only post-typecheck and marks the
+-- current 'NodeOrigin' as generated.
+whenPostTcGen :: forall p. HiePass p => ((p ~ 'Typechecked) => HieM [HieAST Type]) -> HieM [HieAST Type]
+whenPostTcGen a = local (const GeneratedInfo) $ whenPostTc @p a
+
+instance HiePass p => ToHie (LocatedA (HsOverLit (GhcPass p))) where
+ toHie (L span (OverLit x _)) = whenPostTcGen @p $ concatM $ case x of
+ OverLitTc _ witness _ ->
+ [ toHie (L span witness)
+ ]
+ -- See Note [Source locations for implicit function calls]
+
instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
toHie e@(L mspan oexpr) = concatM $ getTypeNode e : case oexpr of
HsVar _ (L _ var) ->
@@ -1100,7 +1166,9 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
]
HsOverLabel {} -> []
HsIPVar _ _ -> []
- HsOverLit _ _ -> []
+ HsOverLit _ o ->
+ [ toHie (L mspan o)
+ ]
HsLit _ _ -> []
HsLam _ mg ->
[ toHie mg
@@ -1186,8 +1254,9 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
[ toHie expr
, toHie $ TS (ResolvedScopes [mkLScopeA expr]) sig
]
- ArithSeq _ _ info ->
+ ArithSeq enum _ info ->
[ toHie info
+ , whenPostTcGen @p $ toHie (L mspan enum)
]
HsPragE _ _ expr ->
[ toHie expr
@@ -1261,15 +1330,22 @@ instance ( ToHie (LocatedA (body (GhcPass p)))
LastStmt _ body _ _ ->
[ toHie body
]
- BindStmt _ pat body ->
+ BindStmt monad pat body ->
[ toHie $ PS (getRealSpan $ getLocA body) scope NoScope pat
, toHie body
+ , whenPostTcGen @p $
+ toHieSyntax $ L span (xbstc_bindOp monad)
]
ApplicativeStmt _ stmts _ ->
[ concatMapM (toHie . RS scope . snd) stmts
+ , let applicative_or_functor = map fst stmts
+ in whenPostTcGen @p $
+ concatMapM (toHieSyntax . L span) applicative_or_functor
]
- BodyStmt _ body _ _ ->
+ BodyStmt _ body monad alternative ->
[ toHie body
+ , whenPostTc @p $
+ concatMapM (toHieSyntax . L span) [monad, alternative]
]
LetStmt _ binds ->
[ toHie $ RS scope binds
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index e51a515c511cab0b2a3ea1d6f456b10e1a3dbb34..758da90e8628e4df52c82eda7149180957840814 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -46,7 +46,7 @@ import GHC.Rename.Utils ( bindLocalNamesFV, checkDupNames
, warnUnusedLocalBinds, typeAppErr
, checkUnusedRecordWildcard
, wrapGenSpan, genHsIntegralLit, genHsTyLit
- , genHsVar, genLHsVar, genHsApp, genHsApps
+ , genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps'
, genAppType, isIrrefutableHsPatRn )
import GHC.Rename.Unbound ( reportUnboundName )
import GHC.Rename.Splice ( rnTypedBracket, rnUntypedBracket, rnTypedSplice, rnUntypedSpliceExpr, checkThLocalName )
@@ -450,10 +450,11 @@ rnExpr (ExplicitList _ exps)
then return (ExplicitList noExtField exps', fvs)
else
do { (from_list_n_name, fvs') <- lookupSyntaxName fromListNName
+ ; loc <- getSrcSpanM -- See Note [Source locations for implicit function calls]
; let rn_list = ExplicitList noExtField exps'
lit_n = mkIntegralLit (length exps)
hs_lit = genHsIntegralLit lit_n
- exp_list = genHsApps from_list_n_name [hs_lit, wrapGenSpan rn_list]
+ exp_list = genHsApps' (L (noAnnSrcSpan loc) from_list_n_name) [hs_lit, wrapGenSpan rn_list]
; return ( mkExpandedExpr rn_list exp_list
, fvs `plusFV` fvs') } }
@@ -2415,7 +2416,11 @@ mkApplicativeStmt ctxt args need_join body_stmts
; return (Just join_op, fvs) }
else
return (Nothing, emptyNameSet)
- ; let applicative_stmt = noLocA $ ApplicativeStmt noExtField
+ -- We cannot really say where the ApplicativeStmt is located with more accuracy
+ -- than the span of the do-block, but it is better than nothing for IDE info
+ -- See Note [Source locations for implicit function calls]
+ ; loc <- getSrcSpanM
+ ; let applicative_stmt = L (noAnnSrcSpan loc) $ ApplicativeStmt noExtField
(zip (fmap_op : repeat ap_op) args)
mb_join
; return ( applicative_stmt : body_stmts
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 331cfdd99789a84137560428424f431725f427d2..d9519c18a99f5ed76e1e068ca83783b2d463d872 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -1111,9 +1111,10 @@ rnOverLit origLit
}
; let std_name = hsOverLitName val
; (from_thing_name, fvs1) <- lookupSyntaxName std_name
+ ; loc <- getSrcSpanM -- See Note [Source locations for implicit function calls] in GHC.Iface.Ext.Ast
; let rebindable = from_thing_name /= std_name
lit' = lit { ol_ext = OverLitRn { ol_rebindable = rebindable
- , ol_from_fun = noLocA from_thing_name } }
+ , ol_from_fun = L (noAnnSrcSpan loc) from_thing_name } }
; if isNegativeZeroOverLit lit'
then do { (negate_name, fvs2) <- lookupSyntaxExpr negateName
; return ((lit' { ol_val = negateOverLitVal val }, Just negate_name)
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index e947fd3156f40aad58f07c5fe55aee0573a4ba14..d8cda861d63faf5b38dba88d29e6cd723b73f0fa 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -21,7 +21,7 @@ module GHC.Rename.Utils (
DeprecationWarnings(..), warnIfDeprecated,
checkUnusedRecordWildcard,
badQualBndrErr, typeAppErr, badFieldConErr,
- wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genLHsApp,
+ wrapGenSpan, genHsVar, genLHsVar, genHsApp, genHsApps, genHsApps', genLHsApp,
genAppType,
genLHsLit, genHsIntegralLit, genHsTyLit, genSimpleConPat,
genVarPat, genWildPat,
@@ -722,6 +722,11 @@ wrapGenSpan x = L (noAnnSrcSpan generatedSrcSpan) x
genHsApps :: Name -> [LHsExpr GhcRn] -> HsExpr GhcRn
genHsApps fun args = foldl genHsApp (genHsVar fun) args
+-- | Keeps the span given to the 'Name' for the application head only
+genHsApps' :: LocatedN Name -> [LHsExpr GhcRn] -> HsExpr GhcRn
+genHsApps' (L _ fun) [] = genHsVar fun
+genHsApps' (L loc fun) (arg:args) = foldl genHsApp (unLoc $ mkHsApp (L (l2l loc) $ genHsVar fun) arg) args
+
genHsApp :: HsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
genHsApp fun arg = HsApp noAnn (wrapGenSpan fun) arg
diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs
index e12160e547fdf3938d1be0904949c28f1a136246..5fd815d48d1913d825e5809c838bf63454b54908 100644
--- a/compiler/GHC/Tc/Gen/App.hs
+++ b/compiler/GHC/Tc/Gen/App.hs
@@ -528,7 +528,7 @@ tcInstFun do_ql inst_final (tc_fun, fun_ctxt) fun_sigma rn_args
; go emptyVarSet [] [] fun_sigma rn_args }
where
fun_orig = exprCtOrigin (case fun_ctxt of
- VAExpansion e _ -> e
+ VAExpansion e _ _ -> e
VACall e _ _ -> e)
-- These are the type variables which must be instantiated to concrete
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 038c842d579ed9485312a7426d4aa9f5f0affa67..f771a0b84db524e3ebfece7e1da3c7409bfe1fee 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -204,6 +204,10 @@ data AppCtxt
(HsExpr GhcRn) -- Inside an expansion of this expression
SrcSpan -- The SrcSpan of the expression
-- noSrcSpan if outermost; see Note [AppCtxt]
+ SrcSpan -- The SrcSpan of the application as specified
+ -- inside the expansion.
+ -- Used for accurately reconstructing the
+ -- original SrcSpans in 'rebuildHsApps'.
| VACall
(HsExpr GhcRn) Int -- In the third argument of function f
@@ -238,7 +242,7 @@ a second time.
-}
appCtxtLoc :: AppCtxt -> SrcSpan
-appCtxtLoc (VAExpansion _ l) = l
+appCtxtLoc (VAExpansion _ l _) = l
appCtxtLoc (VACall _ _ l) = l
insideExpansion :: AppCtxt -> Bool
@@ -246,7 +250,7 @@ insideExpansion (VAExpansion {}) = True
insideExpansion (VACall {}) = False
instance Outputable AppCtxt where
- ppr (VAExpansion e _) = text "VAExpansion" <+> ppr e
+ ppr (VAExpansion e _ _) = text "VAExpansion" <+> ppr e
ppr (VACall f n _) = text "VACall" <+> int n <+> ppr f
type family XPass p where
@@ -310,7 +314,7 @@ splitHsApps e = go e (top_ctxt 0 e) []
-- See Note [Looking through HsExpanded]
go (XExpr (HsExpanded orig fun)) ctxt args
- = go fun (VAExpansion orig (appCtxtLoc ctxt))
+ = go fun (VAExpansion orig (appCtxtLoc ctxt) (appCtxtLoc ctxt))
(EWrap (EExpand orig) : args)
-- See Note [Looking through Template Haskell splices in splitHsApps]
@@ -339,11 +343,11 @@ splitHsApps e = go e (top_ctxt 0 e) []
set :: SrcAnn ann -> AppCtxt -> AppCtxt
set l (VACall f n _) = VACall f n (locA l)
- set _ ctxt@(VAExpansion {}) = ctxt
+ set l (VAExpansion orig ol _) = VAExpansion orig ol (locA l)
dec :: SrcAnn ann -> AppCtxt -> AppCtxt
dec l (VACall f n _) = VACall f (n-1) (locA l)
- dec _ ctxt@(VAExpansion {}) = ctxt
+ dec l (VAExpansion orig ol _) = VAExpansion orig ol (locA l)
-- | Rebuild an application: takes a type-checked application head
-- expression together with arguments in the form of typechecked 'HsExprArg's
@@ -390,7 +394,9 @@ rebuild_hs_apps fun ctxt (arg : args)
EWrap (EHsWrap wrap)
-> rebuild_hs_apps (mkHsWrap wrap fun) ctxt args
where
- lfun = L (noAnnSrcSpan $ appCtxtLoc ctxt) fun
+ lfun = L (noAnnSrcSpan $ appCtxtLoc' ctxt) fun
+ appCtxtLoc' (VAExpansion _ _ l) = l
+ appCtxtLoc' v = appCtxtLoc v
{- Note [Representation-polymorphic Ids with no binding]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -775,6 +781,19 @@ labels (#19154) won't work.
It's easy to achieve this: `splitHsApps` unwraps `HsExpanded`.
+In order to be able to more accurately reconstruct the original `SrcSpan`s
+from the renamer in `rebuildHsApps`, we also have to track the `SrcSpan`
+of the current application in `VAExpansion` when unwrapping `HsExpanded`
+in `splitHsApps`, just as we track it in a non-expanded expression.
+
+Previously, `rebuildHsApps` substituted the location of the original
+expression as given by `splitHsApps` for this. As a result, the application
+head in expanded expressions, e.g. the call to `fromListN`, would either
+have `noSrcSpan` set as its location post-typecheck, or get the location
+of the original expression, depending on whether the `XExpr` given to
+`splitHsApps` is in the outermost layer. The span it got in the renamer
+would always be discarded, causing #23120.
+
Note [Looking through Template Haskell splices in splitHsApps]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When typechecking an application, we must look through untyped TH splices in
@@ -869,7 +888,7 @@ addHeadCtxt fun_ctxt thing_inside
| otherwise
= setSrcSpan fun_loc $
case fun_ctxt of
- VAExpansion orig _ -> addExprCtxt orig thing_inside
+ VAExpansion orig _ _ -> addExprCtxt orig thing_inside
VACall {} -> thing_inside
where
fun_loc = appCtxtLoc fun_ctxt
@@ -1064,6 +1083,7 @@ tcInferOverLit lit@(OverLit { ol_val = val
(1, []) from_ty
; co <- unifyType mb_thing (hsLitType hs_lit) (scaledThing sarg_ty)
+ -- See Note [Source locations for implicit function calls] in GHC.Iface.Ext.Ast
; let lit_expr = L (l2l loc) $ mkHsWrapCo co $
HsLit noAnn hs_lit
from_expr = mkHsWrap (wrap2 <.> wrap1) $
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 23af3cf3cb6b3aea420ba60bb483f85010a0b824..66c1df732e3e3e453976d19454f90e4986a82d18 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -691,14 +691,14 @@ newNonTrivialOverloadedLit :: HsOverLit GhcRn
-> ExpRhoType
-> TcM (HsOverLit GhcTc)
newNonTrivialOverloadedLit
- lit@(OverLit { ol_val = val, ol_ext = OverLitRn rebindable (L _ meth_name) })
+ lit@(OverLit { ol_val = val, ol_ext = OverLitRn rebindable (L loc meth_name) })
res_ty
= do { hs_lit <- mkOverLit val
; let lit_ty = hsLitType hs_lit
; (_, fi') <- tcSyntaxOp orig (mkRnSyntaxExpr meth_name)
[synKnownType lit_ty] res_ty $
\_ _ -> return ()
- ; let L _ witness = nlHsSyntaxApps fi' [nlHsLit hs_lit]
+ ; let L _ witness = mkHsSyntaxApps (l2l loc) fi' [nlHsLit hs_lit]
; res_ty <- readExpType res_ty
; return (lit { ol_ext = OverLitTc { ol_rebindable = rebindable
, ol_witness = witness
diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index 505a1da68fd1838aaad92823a50383d0a77d7851..568afd288be47d00a4c17565693c5b062b317595 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -381,9 +381,14 @@ processAllTypeCheckedModule tcm
-- | Variant of @syb@'s @everything@ (which summarises all nodes
-- in top-down, left-to-right order) with a stop-condition on 'NameSet's
+ -- and 'OverLitTc'
everythingAllSpans :: (r -> r -> r) -> r -> GenericQ r -> GenericQ r
everythingAllSpans k z f x
| (False `mkQ` (const True :: NameSet -> Bool)) x = z
+ -- Exception for OverLitTc: we have SrcSpans in the ol_witness field,
+ -- but it's there only for HIE file info (see Note [Source locations for implicit function calls]).
+ -- T16804 fails without this.
+ | (False `mkQ` (const True :: OverLitTc -> Bool)) x = z
| otherwise = foldl k (f x) (gmapQ (everythingAllSpans k z f) x)
cmpSpan (_,a,_) (_,b,_)