[Git][ghc/ghc][master] HsToken in TypeArg (#19623)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Jan 6 04:02:17 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
9e077999 by Vladislav Zavialov at 2023-01-05T23:01:55-05:00
HsToken in TypeArg (#19623)
Updates the haddock submodule.
- - - - -
18 changed files:
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/ThToHs.hs
- compiler/Language/Haskell/Syntax/Type.hs
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- utils/check-exact/ExactPrint.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -510,10 +510,10 @@ deriving instance Data thing => Data (HsScaled GhcPs thing)
deriving instance Data thing => Data (HsScaled GhcRn thing)
deriving instance Data thing => Data (HsScaled GhcTc thing)
-deriving instance (Data a, Data b) => Data (HsArg a b)
--- deriving instance Data (HsArg (Located (HsType GhcPs)) (Located (HsKind GhcPs)))
--- deriving instance Data (HsArg (Located (HsType GhcRn)) (Located (HsKind GhcRn)))
--- deriving instance Data (HsArg (Located (HsType GhcTc)) (Located (HsKind GhcTc)))
+-- deriving instance (Data a, Data b) => Data (HsArg p a b)
+deriving instance (Data a, Data b) => Data (HsArg GhcPs a b)
+deriving instance (Data a, Data b) => Data (HsArg GhcRn a b)
+deriving instance (Data a, Data b) => Data (HsArg GhcTc a b)
-- deriving instance (DataIdLR p p) => Data (ConDeclField p)
deriving instance Data (ConDeclField GhcPs)
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -1,5 +1,6 @@
{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
@@ -94,6 +95,7 @@ import Language.Haskell.Syntax.Type
import {-# SOURCE #-} GHC.Hs.Expr ( pprUntypedSplice, HsUntypedSpliceResult(..) )
+import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import GHC.Core.DataCon( SrcStrictness(..), SrcUnpackedness(..), HsImplBang(..) )
import GHC.Hs.Extension
@@ -312,7 +314,7 @@ type instance XIParamTy (GhcPass _) = EpAnn [AddEpAnn]
type instance XStarTy (GhcPass _) = NoExtField
type instance XKindSig (GhcPass _) = EpAnn [AddEpAnn]
-type instance XAppKindTy (GhcPass _) = SrcSpan -- Where the `@` lives
+type instance XAppKindTy (GhcPass _) = NoExtField
type instance XSpliceTy GhcPs = NoExtField
type instance XSpliceTy GhcRn = HsUntypedSpliceResult (LHsType GhcRn)
@@ -489,10 +491,10 @@ mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
-> LHsType (GhcPass p)
mkHsAppTys = foldl' mkHsAppTy
-mkHsAppKindTy :: XAppKindTy (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+mkHsAppKindTy :: LHsType (GhcPass p) -> LHsToken "@" (GhcPass p) -> LHsType (GhcPass p)
-> LHsType (GhcPass p)
-mkHsAppKindTy ext ty k
- = addCLocAA ty k (HsAppKindTy ext ty k)
+mkHsAppKindTy ty at k
+ = addCLocAA ty k (HsAppKindTy noExtField ty at k)
{-
************************************************************************
@@ -541,7 +543,7 @@ hsTyGetAppHead_maybe = go
where
go (L _ (HsTyVar _ _ ln)) = Just ln
go (L _ (HsAppTy _ l _)) = go l
- go (L _ (HsAppKindTy _ t _)) = go t
+ go (L _ (HsAppKindTy _ t _ _)) = go t
go (L _ (HsOpTy _ _ _ ln _)) = Just ln
go (L _ (HsParTy _ t)) = go t
go (L _ (HsKindSig _ t _)) = go t
@@ -553,12 +555,12 @@ hsTyGetAppHead_maybe = go
lhsTypeArgSrcSpan :: LHsTypeArg (GhcPass pass) -> SrcSpan
lhsTypeArgSrcSpan arg = case arg of
HsValArg tm -> getLocA tm
- HsTypeArg at ty -> at `combineSrcSpans` getLocA ty
+ HsTypeArg at ty -> getTokenSrcSpan (getLoc at) `combineSrcSpans` getLocA ty
HsArgPar sp -> sp
--------------------------------
-numVisibleArgs :: [HsArg tm ty] -> Arity
+numVisibleArgs :: [HsArg p tm ty] -> Arity
numVisibleArgs = count is_vis
where is_vis (HsValArg _) = True
is_vis _ = False
@@ -576,7 +578,7 @@ numVisibleArgs = count is_vis
-- pprHsArgsApp (++) Infix [HsValArg Char, HsValArg Double, HsVarArg Ordering] = (Char ++ Double) Ordering
-- @
pprHsArgsApp :: (OutputableBndr id, Outputable tm, Outputable ty)
- => id -> LexicalFixity -> [HsArg tm ty] -> SDoc
+ => id -> LexicalFixity -> [HsArg p tm ty] -> SDoc
pprHsArgsApp thing fixity (argl:argr:args)
| Infix <- fixity
= let pp_op_app = hsep [ ppr_single_hs_arg argl
@@ -591,7 +593,7 @@ pprHsArgsApp thing _fixity args
-- | Pretty-print a prefix identifier to a list of 'HsArg's.
ppr_hs_args_prefix_app :: (Outputable tm, Outputable ty)
- => SDoc -> [HsArg tm ty] -> SDoc
+ => SDoc -> [HsArg p tm ty] -> SDoc
ppr_hs_args_prefix_app acc [] = acc
ppr_hs_args_prefix_app acc (arg:args) =
case arg of
@@ -601,7 +603,7 @@ ppr_hs_args_prefix_app acc (arg:args) =
-- | Pretty-print an 'HsArg' in isolation.
ppr_single_hs_arg :: (Outputable tm, Outputable ty)
- => HsArg tm ty -> SDoc
+ => HsArg p tm ty -> SDoc
ppr_single_hs_arg (HsValArg tm) = ppr tm
ppr_single_hs_arg (HsTypeArg _ ty) = char '@' <> ppr ty
-- GHC shouldn't be constructing ASTs such that this case is ever reached.
@@ -611,9 +613,9 @@ ppr_single_hs_arg (HsArgPar{}) = empty
-- | This instance is meant for debug-printing purposes. If you wish to
-- pretty-print an application of 'HsArg's, use 'pprHsArgsApp' instead.
-instance (Outputable tm, Outputable ty) => Outputable (HsArg tm ty) where
+instance (Outputable tm, Outputable ty) => Outputable (HsArg (GhcPass p) tm ty) where
ppr (HsValArg tm) = text "HsValArg" <+> ppr tm
- ppr (HsTypeArg sp ty) = text "HsTypeArg" <+> ppr sp <+> ppr ty
+ ppr (HsTypeArg at ty) = text "HsTypeArg" <+> ppr at <+> ppr ty
ppr (HsArgPar sp) = text "HsArgPar" <+> ppr sp
--------------------------------
@@ -1180,7 +1182,7 @@ ppr_mono_ty (HsStarTy _ isUni) = char (if isUni then '★' else '*')
ppr_mono_ty (HsAppTy _ fun_ty arg_ty)
= hsep [ppr_mono_lty fun_ty, ppr_mono_lty arg_ty]
-ppr_mono_ty (HsAppKindTy _ ty k)
+ppr_mono_ty (HsAppKindTy _ ty _ k)
= ppr_mono_lty ty <+> char '@' <> ppr_mono_lty k
ppr_mono_ty (HsOpTy _ prom ty1 (L _ op) ty2)
= sep [ ppr_mono_lty ty1
@@ -1295,7 +1297,7 @@ lhsTypeHasLeadingPromotionQuote ty
go (HsWildCardTy{}) = False
go (HsStarTy{}) = False
go (HsAppTy _ t _) = goL t
- go (HsAppKindTy _ t _) = goL t
+ go (HsAppKindTy _ t _ _) = goL t
go (HsParTy{}) = False
go (HsDocTy _ t _) = goL t
go (XHsType{}) = False
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -628,13 +628,13 @@ nlHsTyConApp prom fixity tycon tys
mk_app fun@(L _ (HsOpTy {})) arg = mk_app (noLocA $ HsParTy noAnn fun) arg
-- parenthesize things like `(A + B) C`
mk_app fun (HsValArg ty) = noLocA (HsAppTy noExtField fun (parenthesizeHsType appPrec ty))
- mk_app fun (HsTypeArg _ ki) = noLocA (HsAppKindTy noSrcSpan fun (parenthesizeHsType appPrec ki))
+ mk_app fun (HsTypeArg at ki) = noLocA (HsAppKindTy noExtField fun at (parenthesizeHsType appPrec ki))
mk_app fun (HsArgPar _) = noLocA (HsParTy noAnn fun)
nlHsAppKindTy ::
LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)
nlHsAppKindTy f k
- = noLocA (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k))
+ = noLocA (HsAppKindTy noExtField f noHsTok (parenthesizeHsType appPrec k))
{-
Tuples. All these functions are *pre-typechecker* because they lack
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -1389,7 +1389,7 @@ repTy (HsAppTy _ f a) = do
f1 <- repLTy f
a1 <- repLTy a
repTapp f1 a1
-repTy (HsAppKindTy _ ty ki) = do
+repTy (HsAppKindTy _ ty _ ki) = do
ty1 <- repLTy ty
ki1 <- repLTy ki
repTappKind ty1 ki1
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -570,7 +570,7 @@ instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where
HsOuterExplicit{hso_bndrs = tvs} ->
foldl1' combineSrcSpans [loc a, loc tvs, loc b, loc c]
-instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where
+instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg p tm ty) where
loc (HsValArg tm) = loc tm
loc (HsTypeArg _ ty) = loc ty
loc (HsArgPar sp) = sp
@@ -1773,7 +1773,7 @@ instance ToHie (LocatedA (HsType GhcRn)) where
[ toHie a
, toHie b
]
- HsAppKindTy _ ty ki ->
+ HsAppKindTy _ ty _ ki ->
[ toHie ty
, toHie ki
]
@@ -1831,7 +1831,7 @@ instance ToHie (LocatedA (HsType GhcRn)) where
HsStarTy _ _ -> []
XHsType _ -> []
-instance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where
+instance (ToHie tm, ToHie ty) => ToHie (HsArg p tm ty) where
toHie (HsValArg tm) = toHie tm
toHie (HsTypeArg _ ty) = toHie ty
toHie (HsArgPar sp) = locOnly sp
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2199,7 +2199,7 @@ ftype :: { forall b. DisambTD b => PV (LocatedA b) }
| ftype tyarg { $1 >>= \ $1 ->
mkHsAppTyPV $1 $2 }
| ftype PREFIX_AT atype { $1 >>= \ $1 ->
- mkHsAppKindTyPV $1 (getLoc $2) $3 }
+ mkHsAppKindTyPV $1 (hsTok $2) $3 }
tyarg :: { LHsType GhcPs }
: atype { $1 }
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -15,6 +15,7 @@ module GHC.Parser.Annotation (
AddEpAnn(..),
EpaLocation(..), epaLocationRealSrcSpan, epaLocationFromSrcAnn,
TokenLocation(..),
+ getTokenSrcSpan,
DeltaPos(..), deltaPos, getDeltaLine,
EpAnn(..), Anchor(..), AnchorOperation(..),
@@ -412,6 +413,11 @@ data EpaLocation = EpaSpan !RealSrcSpan !(Strict.Maybe BufSpan)
data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation
deriving (Data,Eq)
+getTokenSrcSpan :: TokenLocation -> SrcSpan
+getTokenSrcSpan NoTokenLoc = noSrcSpan
+getTokenSrcSpan (TokenLoc EpaDelta{}) = noSrcSpan
+getTokenSrcSpan (TokenLoc (EpaSpan rspan mbufpos)) = RealSrcSpan rspan mbufpos
+
instance Outputable a => Outputable (GenLocated TokenLocation a) where
ppr (L _ x) = ppr x
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1020,7 +1020,7 @@ checkTyClHdr is_cls ty
where
(o,c) = mkParensEpAnn (realSrcSpan l)
go _ (HsAppTy _ t1 t2) acc ops cps fix = goL t1 (HsValArg t2:acc) ops cps fix
- go _ (HsAppKindTy l ty ki) acc ops cps fix = goL ty (HsTypeArg l ki:acc) ops cps fix
+ go _ (HsAppKindTy _ ty at ki) acc ops cps fix = goL ty (HsTypeArg at ki:acc) ops cps fix
go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ops cps fix
= return (L (noAnnSrcSpan l) (nameRdrName tup_name)
, map HsValArg ts, fix, (reverse ops)++cps)
@@ -1957,7 +1957,7 @@ class DisambTD b where
-- | Disambiguate @f x@ (function application or prefix data constructor).
mkHsAppTyPV :: LocatedA b -> LHsType GhcPs -> PV (LocatedA b)
-- | Disambiguate @f \@t@ (visible kind application)
- mkHsAppKindTyPV :: LocatedA b -> SrcSpan -> LHsType GhcPs -> PV (LocatedA b)
+ mkHsAppKindTyPV :: LocatedA b -> LHsToken "@" GhcPs -> LHsType GhcPs -> PV (LocatedA b)
-- | Disambiguate @f \# x@ (infix operator)
mkHsOpTyPV :: PromotionFlag -> LHsType GhcPs -> LocatedN RdrName -> LHsType GhcPs -> PV (LocatedA b)
-- | Disambiguate @{-\# UNPACK \#-} t@ (unpack/nounpack pragma)
@@ -1966,7 +1966,7 @@ class DisambTD b where
instance DisambTD (HsType GhcPs) where
mkHsAppTyHeadPV = return
mkHsAppTyPV t1 t2 = return (mkHsAppTy t1 t2)
- mkHsAppKindTyPV t l_at ki = return (mkHsAppKindTy l_at t ki)
+ mkHsAppKindTyPV t at ki = return (mkHsAppKindTy t at ki)
mkHsOpTyPV prom t1 op t2 = return (mkLHsOpTy prom t1 op t2)
mkUnpackednessPV = addUnpackednessP
@@ -2002,8 +2002,8 @@ instance DisambTD DataConBuilder where
-- the grammar in Parser.y is written (see infixtype/ftype).
panic "mkHsAppTyPV: InfixDataConBuilder"
- mkHsAppKindTyPV lhs l_at ki =
- addFatalError $ mkPlainErrorMsgEnvelope l_at $
+ mkHsAppKindTyPV lhs at ki =
+ addFatalError $ mkPlainErrorMsgEnvelope (getTokenSrcSpan (getLoc at)) $
(PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki))
mkHsOpTyPV prom lhs tc rhs = do
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -693,12 +693,12 @@ rnHsTyKi env (HsAppTy _ ty1 ty2)
; (ty2', fvs2) <- rnLHsTyKi env ty2
; return (HsAppTy noExtField ty1' ty2', fvs1 `plusFV` fvs2) }
-rnHsTyKi env (HsAppKindTy l ty k)
+rnHsTyKi env (HsAppKindTy _ ty at k)
= do { kind_app <- xoptM LangExt.TypeApplications
; unless kind_app (addErr (typeAppErr "kind" k))
; (ty', fvs1) <- rnLHsTyKi env ty
; (k', fvs2) <- rnLHsTyKi (env {rtke_level = KindLevel }) k
- ; return (HsAppKindTy l ty' k', fvs1 `plusFV` fvs2) }
+ ; return (HsAppKindTy noExtField ty' at k', fvs1 `plusFV` fvs2) }
rnHsTyKi env t@(HsIParamTy x n ty)
= do { notInKinds env t
@@ -1929,7 +1929,7 @@ extract_lty (L _ ty) acc
flds
HsAppTy _ ty1 ty2 -> extract_lty ty1 $
extract_lty ty2 acc
- HsAppKindTy _ ty k -> extract_lty ty $
+ HsAppKindTy _ ty _ k -> extract_lty ty $
extract_lty k acc
HsListTy _ ty -> extract_lty ty acc
HsTupleTy _ _ tys -> extract_ltys tys acc
=====================================
compiler/GHC/Tc/Gen/HsType.hs
=====================================
@@ -1517,11 +1517,11 @@ splitHsAppTys hs_ty
is_app _ = False
go :: LHsType GhcRn
- -> [HsArg (LHsType GhcRn) (LHsKind GhcRn)]
+ -> [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)]
-> (LHsType GhcRn,
- [HsArg (LHsType GhcRn) (LHsKind GhcRn)]) -- AZ temp
+ [HsArg GhcRn (LHsType GhcRn) (LHsKind GhcRn)]) -- AZ temp
go (L _ (HsAppTy _ f a)) as = go f (HsValArg a : as)
- go (L _ (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as)
+ go (L _ (HsAppKindTy _ ty at k)) as = go ty (HsTypeArg at k : as)
go (L sp (HsParTy _ f)) as = go f (HsArgPar (locA sp) : as)
go (L _ (HsOpTy _ prom l op@(L sp _) r)) as
= ( L (na2la sp) (HsTyVar noAnn prom op)
@@ -1698,7 +1698,7 @@ tcInferTyApps_nosat mode orig_hs_ty fun orig_hs_args
substed_fun_ki = substTy subst fun_ki
hs_ty = appTypeToArg orig_hs_ty (take (n-1) orig_hs_args)
- n_initial_val_args :: [HsArg tm ty] -> Arity
+ n_initial_val_args :: [HsArg p tm ty] -> Arity
-- Count how many leading HsValArgs we have
n_initial_val_args (HsValArg {} : args) = 1 + n_initial_val_args args
n_initial_val_args (HsArgPar {} : args) = n_initial_val_args args
@@ -1890,10 +1890,10 @@ unsaturated arguments: see #11246. Hence doing this in tcInferApps.
appTypeToArg :: LHsType GhcRn -> [LHsTypeArg GhcRn] -> LHsType GhcRn
appTypeToArg f [] = f
-appTypeToArg f (HsValArg arg : args) = appTypeToArg (mkHsAppTy f arg) args
-appTypeToArg f (HsArgPar _ : args) = appTypeToArg f args
-appTypeToArg f (HsTypeArg l arg : args)
- = appTypeToArg (mkHsAppKindTy l f arg) args
+appTypeToArg f (HsValArg arg : args) = appTypeToArg (mkHsAppTy f arg) args
+appTypeToArg f (HsArgPar _ : args) = appTypeToArg f args
+appTypeToArg f (HsTypeArg at arg : args)
+ = appTypeToArg (mkHsAppKindTy f at arg) args
{- *********************************************************************
=====================================
compiler/GHC/Tc/Gen/Sig.hs
=====================================
@@ -299,7 +299,7 @@ no_anon_wc_ty lty = go lty
go (L _ ty) = case ty of
HsWildCardTy _ -> False
HsAppTy _ ty1 ty2 -> go ty1 && go ty2
- HsAppKindTy _ ty ki -> go ty && go ki
+ HsAppKindTy _ ty _ ki -> go ty && go ki
HsFunTy _ w ty1 ty2 -> go ty1 && go ty2 && go (arrowToHsType w)
HsListTy _ ty -> go ty
HsTupleTy _ _ tys -> gos tys
=====================================
compiler/GHC/Tc/TyCl.hs
=====================================
@@ -3045,7 +3045,7 @@ tcTyFamInstEqn fam_tc mb_clsinfo
(map (const Nominal) qtvs)
(locA loc)) }
-checkTyFamInstEqn :: TcTyCon -> Name -> [HsArg tm ty] -> TcM ()
+checkTyFamInstEqn :: TcTyCon -> Name -> [HsArg p tm ty] -> TcM ()
checkTyFamInstEqn tc_fam_tc eqn_tc_name hs_pats =
do { -- Ensure that each equation's type constructor is for the right
-- type family. E.g. barf on
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1795,8 +1795,9 @@ mk_apps head_ty type_args = do
case arg of
HsValArg ty -> do p_ty <- add_parens ty
mk_apps (HsAppTy noExtField phead_ty p_ty) args
- HsTypeArg l ki -> do p_ki <- add_parens ki
- mk_apps (HsAppKindTy l phead_ty p_ki) args
+ HsTypeArg at ki ->
+ do p_ki <- add_parens ki
+ mk_apps (HsAppKindTy noExtField phead_ty at p_ki) args
HsArgPar _ -> mk_apps (HsParTy noAnn phead_ty) args
go type_args
@@ -1841,7 +1842,7 @@ split_ty_app ty = go ty []
where
go (AppT f a) as' = do { a' <- cvtType a; go f (HsValArg a':as') }
go (AppKindT ty ki) as' = do { ki' <- cvtKind ki
- ; go ty (HsTypeArg noSrcSpan ki':as') }
+ ; go ty (HsTypeArg noHsTok ki' : as') }
go (ParensT t) as' = do { loc <- getL; go t (HsArgPar loc: as') }
go f as = return (f,as)
=====================================
compiler/Language/Haskell/Syntax/Type.hs
=====================================
@@ -756,6 +756,7 @@ data HsType pass
| HsAppKindTy (XAppKindTy pass) -- type level type app
(LHsType pass)
+ !(LHsToken "@" pass)
(LHsKind pass)
| HsFunTy (XFunTy pass)
@@ -1181,14 +1182,13 @@ if they correspond to a visible 'forall'.
-}
-- | Arguments in an expression/type after splitting
-data HsArg tm ty
+data HsArg p tm ty
= HsValArg tm -- Argument is an ordinary expression (f arg)
- | HsTypeArg SrcSpan ty -- Argument is a visible type application (f @ty)
- -- SrcSpan is location of the `@`
+ | HsTypeArg !(LHsToken "@" p) ty -- Argument is a visible type application (f @ty)
| HsArgPar SrcSpan -- See Note [HsArgPar]
-- type level equivalent
-type LHsTypeArg p = HsArg (LHsType p) (LHsKind p)
+type LHsTypeArg p = HsArg p (LHsType p) (LHsKind p)
{-
Note [HsArgPar]
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -656,7 +656,10 @@
(HsOuterImplicit
(NoExtField))
[(HsTypeArg
- { DumpParsedAst.hs:18:6 }
+ (L
+ (TokenLoc
+ (EpaSpan { DumpParsedAst.hs:18:6 }))
+ (HsTok))
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:18:7-11 })
(HsTyVar
@@ -716,7 +719,7 @@
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:18:19-26 })
(HsAppKindTy
- { DumpParsedAst.hs:18:21 }
+ (NoExtField)
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:18:19 })
(HsTyVar
@@ -732,6 +735,10 @@
(SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:18:19 })
(Unqual
{OccName: T}))))
+ (L
+ (TokenLoc
+ (EpaSpan { DumpParsedAst.hs:18:21 }))
+ (HsTok))
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:18:22-26 })
(HsTyVar
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -868,7 +868,10 @@
[{Name: a}
,{Name: f}])
[(HsTypeArg
- { DumpRenamedAst.hs:25:6 }
+ (L
+ (TokenLoc
+ (EpaSpan { DumpRenamedAst.hs:25:6 }))
+ (HsTok))
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:7-11 })
(HsTyVar
@@ -907,7 +910,7 @@
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:19-26 })
(HsAppKindTy
- { DumpRenamedAst.hs:25:21 }
+ (NoExtField)
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:19 })
(HsTyVar
@@ -916,6 +919,10 @@
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:19 })
{Name: DumpRenamedAst.T})))
+ (L
+ (TokenLoc
+ (EpaSpan { DumpRenamedAst.hs:25:21 }))
+ (HsTok))
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:25:22-26 })
(HsTyVar
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1998,12 +1998,12 @@ exactHsFamInstLHS an thing bndrs typats fixity mb_ctxt = do
-- ---------------------------------------------------------------------
instance (ExactPrint tm, ExactPrint ty, Outputable tm, Outputable ty)
- => ExactPrint (HsArg tm ty) where
+ => ExactPrint (HsArg GhcPs tm ty) where
getAnnotationEntry = const NoEntryVal
setAnnotationAnchor a _ _ = a
exact a@(HsValArg tm) = markAnnotated tm >> return a
- exact a@(HsTypeArg ss ty) = printStringAtSs ss "@" >> markAnnotated ty >> return a
+ exact a@(HsTypeArg at ty) = markToken at >> markAnnotated ty >> return a
exact x@(HsArgPar _sp) = withPpr x -- Does not appear in original source
-- ---------------------------------------------------------------------
@@ -3777,7 +3777,7 @@ instance ExactPrint (HsType GhcPs) where
getAnnotationEntry (HsQualTy _ _ _) = NoEntryVal
getAnnotationEntry (HsTyVar an _ _) = fromAnn an
getAnnotationEntry (HsAppTy _ _ _) = NoEntryVal
- getAnnotationEntry (HsAppKindTy _ _ _) = NoEntryVal
+ getAnnotationEntry (HsAppKindTy _ _ _ _) = NoEntryVal
getAnnotationEntry (HsFunTy an _ _ _) = fromAnn an
getAnnotationEntry (HsListTy an _) = fromAnn an
getAnnotationEntry (HsTupleTy an _ _) = fromAnn an
@@ -3801,7 +3801,7 @@ instance ExactPrint (HsType GhcPs) where
setAnnotationAnchor a@(HsQualTy _ _ _) _ _s = a
setAnnotationAnchor (HsTyVar an a b) anc cs = (HsTyVar (setAnchorEpa an anc cs) a b)
setAnnotationAnchor a@(HsAppTy _ _ _) _ _s = a
- setAnnotationAnchor a@(HsAppKindTy _ _ _) _ _s = a
+ setAnnotationAnchor a@(HsAppKindTy _ _ _ _) _ _s = a
setAnnotationAnchor (HsFunTy an a b c) anc cs = (HsFunTy (setAnchorEpa an anc cs) a b c)
setAnnotationAnchor (HsListTy an a) anc cs = (HsListTy (setAnchorEpa an anc cs) a)
setAnnotationAnchor (HsTupleTy an a b) anc cs = (HsTupleTy (setAnchorEpa an anc cs) a b)
@@ -3842,11 +3842,11 @@ instance ExactPrint (HsType GhcPs) where
t1' <- markAnnotated t1
t2' <- markAnnotated t2
return (HsAppTy an t1' t2')
- exact (HsAppKindTy ss ty ki) = do
+ exact (HsAppKindTy ss ty at ki) = do
ty' <- markAnnotated ty
- printStringAtSs ss "@"
+ at' <- markToken at
ki' <- markAnnotated ki
- return (HsAppKindTy ss ty' ki')
+ return (HsAppKindTy ss ty' at' ki')
exact (HsFunTy an mult ty1 ty2) = do
ty1' <- markAnnotated ty1
mult' <- markArrow mult
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 261a7c8ac5b5ff29e6e0380690cbb6ee9730f985
+Subproject commit 519a95998b09a2c9c7a42c3a0cf2ca0c4358bb49
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e077999eb3d09af6f31eb92233d4d757ece75f8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e077999eb3d09af6f31eb92233d4d757ece75f8
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/20230105/2a13c267/attachment-0001.html>
More information about the ghc-commits
mailing list