[Git][ghc/ghc][master] Class layout info (#19623)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Oct 24 04:12:43 UTC 2022
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
11fe42d8 by Vladislav Zavialov at 2022-10-23T00:11:50+03:00
Class layout info (#19623)
Updates the haddock submodule.
- - - - -
28 changed files:
- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/Language/Haskell/Syntax.hs
- + compiler/Language/Haskell/Syntax/Concrete.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Pat.hs
- compiler/Language/Haskell/Syntax/Type.hs
- compiler/ghc.cabal.in
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/perf/compiler/hard_hole_fits.stderr
- utils/check-exact/ExactPrint.hs
- utils/check-ppr/Main.hs
- utils/haddock
Changes:
=====================================
compiler/GHC/Hs.hs
=====================================
@@ -68,7 +68,7 @@ import Data.Data hiding ( Fixity )
data XModulePs
= XModulePs {
hsmodAnn :: EpAnn AnnsModule,
- hsmodLayout :: LayoutInfo,
+ hsmodLayout :: LayoutInfo GhcPs,
-- ^ Layout info for the module.
-- For incomplete modules (e.g. the output of parseHeader), it is NoLayoutInfo.
hsmodDeprecMessage :: Maybe (LocatedP (WarningTxt GhcPs)),
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -353,7 +353,8 @@ data DataDeclRn = DataDeclRn
, tcdFVs :: NameSet }
deriving Data
-type instance XClassDecl GhcPs = (EpAnn [AddEpAnn], AnnSortKey, LayoutInfo) -- See Note [Class LayoutInfo]
+type instance XClassDecl GhcPs = (EpAnn [AddEpAnn], AnnSortKey)
+
-- TODO:AZ:tidy up AnnSortKey above
type instance XClassDecl GhcRn = NameSet -- FVs
type instance XClassDecl GhcTc = NameSet -- FVs
=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -11,6 +11,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableSuperClasses #-} -- for IsPass; see Note [NoGhcTc]
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
-- in module Language.Haskell.Syntax.Extension
@@ -27,6 +28,7 @@ import GHC.Prelude
import GHC.TypeLits (KnownSymbol, symbolVal)
import Data.Data hiding ( Fixity )
+import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import GHC.Types.Name
import GHC.Types.Name.Reader
@@ -258,3 +260,5 @@ instance KnownSymbol tok => Outputable (HsToken tok) where
instance (KnownSymbol tok, KnownSymbol utok) => Outputable (HsUniToken tok utok) where
ppr HsNormalTok = text (symbolVal (Proxy :: Proxy tok))
ppr HsUnicodeTok = text (symbolVal (Proxy :: Proxy utok))
+
+deriving instance Typeable p => Data (LayoutInfo (GhcPass p))
=====================================
compiler/GHC/Parser.y
=====================================
@@ -925,17 +925,17 @@ maybemodwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) }
body :: { (AnnList
,([LImportDecl GhcPs], [LHsDecl GhcPs])
- ,LayoutInfo) }
+ ,LayoutInfo GhcPs) }
: '{' top '}' { (AnnList Nothing (Just $ moc $1) (Just $ mcc $3) [] (fst $2)
- , snd $2, ExplicitBraces) }
+ , snd $2, explicitBraces $1 $3) }
| vocurly top close { (AnnList Nothing Nothing Nothing [] (fst $2)
, snd $2, VirtualBraces (getVOCURLY $1)) }
body2 :: { (AnnList
,([LImportDecl GhcPs], [LHsDecl GhcPs])
- ,LayoutInfo) }
+ ,LayoutInfo GhcPs) }
: '{' top '}' { (AnnList Nothing (Just $ moc $1) (Just $ mcc $3) [] (fst $2)
- , snd $2, ExplicitBraces) }
+ , snd $2, explicitBraces $1 $3) }
| missing_module_keyword top close { (AnnList Nothing Nothing Nothing [] [], snd $2, VirtualBraces leftmostColumn) }
@@ -1712,9 +1712,9 @@ decls_cls :: { Located ([AddEpAnn],OrdList (LHsDecl GhcPs)) } -- Reversed
decllist_cls
:: { Located ([AddEpAnn]
, OrdList (LHsDecl GhcPs)
- , LayoutInfo) } -- Reversed
+ , LayoutInfo GhcPs) } -- Reversed
: '{' decls_cls '}' { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2)
- ,snd $ unLoc $2, ExplicitBraces) }
+ ,snd $ unLoc $2, explicitBraces $1 $3) }
| vocurly decls_cls close { let { L l (anns, decls) = $2 }
in L l (anns, decls, VirtualBraces (getVOCURLY $1)) }
@@ -1722,7 +1722,7 @@ decllist_cls
--
where_cls :: { Located ([AddEpAnn]
,(OrdList (LHsDecl GhcPs)) -- Reversed
- ,LayoutInfo) }
+ ,LayoutInfo GhcPs) }
-- No implicit parameters
-- May have type declarations
: 'where' decllist_cls { sLL $1 $> (mj AnnWhere $1:(fstOf3 $ unLoc $2)
@@ -4409,6 +4409,9 @@ hsUniTok t@(L l _) =
L (mkTokenLocation l)
(if isUnicode t then HsUnicodeTok else HsNormalTok)
+explicitBraces :: Located Token -> Located Token -> LayoutInfo GhcPs
+explicitBraces t1 t2 = ExplicitBraces (hsTok t1) (hsTok t2)
+
-- -------------------------------------
addTrailingCommaFBind :: MonadP m => Fbind b -> SrcSpan -> m (Fbind b)
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -193,7 +193,7 @@ mkClassDecl :: SrcSpan
-> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)
-> Located (a,[LHsFunDep GhcPs])
-> OrdList (LHsDecl GhcPs)
- -> LayoutInfo
+ -> LayoutInfo GhcPs
-> [AddEpAnn]
-> P (LTyClDecl GhcPs)
@@ -204,7 +204,8 @@ mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layoutInfo annsIn
; tyvars <- checkTyVars (text "class") whereDots cls tparams
; cs <- getCommentsFor (locA loc) -- Get any remaining comments
; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn emptyComments) ann cs
- ; return (L loc (ClassDecl { tcdCExt = (anns', NoAnnSortKey, layoutInfo)
+ ; return (L loc (ClassDecl { tcdCExt = (anns', NoAnnSortKey)
+ , tcdLayout = layoutInfo
, tcdCtxt = mcxt
, tcdLName = cls, tcdTyVars = tyvars
, tcdFixity = fixity
=====================================
compiler/GHC/Parser/PostProcess/Haddock.hs
=====================================
@@ -340,7 +340,7 @@ In this case, we should produce four HsDecl items (pseudo-code):
The inputs to addHaddockInterleaveItems are:
- * layout_info :: LayoutInfo
+ * layout_info :: LayoutInfo GhcPs
In the example above, note that the indentation level inside the module is
2 spaces. It would be represented as layout_info = VirtualBraces 2.
@@ -372,7 +372,7 @@ The inputs to addHaddockInterleaveItems are:
addHaddockInterleaveItems
:: forall a.
HasHaddock a
- => LayoutInfo
+ => LayoutInfo GhcPs
-> (PsLocated HdkComment -> Maybe a) -- Get a documentation item
-> [a] -- Unprocessed (non-documentation) items
-> HdkA [a] -- Documentation items & processed non-documentation items
@@ -389,7 +389,7 @@ addHaddockInterleaveItems layout_info get_doc_item = go
with_layout_info :: HdkA a -> HdkA a
with_layout_info = case layout_info of
NoLayoutInfo -> id
- ExplicitBraces -> id
+ ExplicitBraces{} -> id
VirtualBraces n ->
let loc_range = mempty { loc_range_col = ColumnFrom (n+1) }
in hoistHdkA (inLocRange loc_range)
@@ -498,7 +498,7 @@ instance HasHaddock (HsDecl GhcPs) where
-- -- ^ Comment on the second method
--
addHaddock (TyClD _ decl)
- | ClassDecl { tcdCExt = (x, NoAnnSortKey, tcdLayout),
+ | ClassDecl { tcdCExt = (x, NoAnnSortKey), tcdLayout,
tcdCtxt, tcdLName, tcdTyVars, tcdFixity, tcdFDs,
tcdSigs, tcdMeths, tcdATs, tcdATDefs } <- decl
= do
@@ -509,7 +509,7 @@ instance HasHaddock (HsDecl GhcPs) where
flattenBindsAndSigs (tcdMeths, tcdSigs, tcdATs, tcdATDefs, [], [])
pure $
let (tcdMeths', tcdSigs', tcdATs', tcdATDefs', _, tcdDocs) = partitionBindsAndSigs where_cls'
- decl' = ClassDecl { tcdCExt = (x, NoAnnSortKey, tcdLayout)
+ decl' = ClassDecl { tcdCExt = (x, NoAnnSortKey), tcdLayout
, tcdCtxt, tcdLName, tcdTyVars, tcdFixity, tcdFDs
, tcdSigs = tcdSigs'
, tcdMeths = tcdMeths'
@@ -1309,10 +1309,10 @@ reportExtraDocs =
* *
********************************************************************* -}
-mkDocHsDecl :: LayoutInfo -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs)
+mkDocHsDecl :: LayoutInfo GhcPs -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs)
mkDocHsDecl layout_info a = fmap (DocD noExtField) <$> mkDocDecl layout_info a
-mkDocDecl :: LayoutInfo -> PsLocated HdkComment -> Maybe (LDocDecl GhcPs)
+mkDocDecl :: LayoutInfo GhcPs -> PsLocated HdkComment -> Maybe (LDocDecl GhcPs)
mkDocDecl layout_info (L l_comment hdk_comment)
| indent_mismatch = Nothing
| otherwise =
@@ -1346,7 +1346,7 @@ mkDocDecl layout_info (L l_comment hdk_comment)
-- -- ^ indent mismatch
indent_mismatch = case layout_info of
NoLayoutInfo -> False
- ExplicitBraces -> False
+ ExplicitBraces{} -> False
VirtualBraces n -> n /= srcSpanStartCol (psRealSpan l_comment)
mkDocIE :: PsLocated HdkComment -> Maybe (LIE GhcPs)
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -1839,7 +1839,8 @@ rnTyClDecl (DataDecl
, tcdDataDefn = defn'
, tcdDExt = rn_info }, fvs) } }
-rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
+rnTyClDecl (ClassDecl { tcdLayout = layout,
+ tcdCtxt = context, tcdLName = lcls,
tcdTyVars = tyvars, tcdFixity = fixity,
tcdFDs = fds, tcdSigs = sigs,
tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs,
@@ -1893,7 +1894,8 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
; let all_fvs = meth_fvs `plusFV` stuff_fvs `plusFV` fv_at_defs
; docs' <- traverse rnLDocDecl docs
- ; return (ClassDecl { tcdCtxt = context', tcdLName = lcls',
+ ; return (ClassDecl { tcdLayout = rnLayoutInfo layout,
+ tcdCtxt = context', tcdLName = lcls',
tcdTyVars = tyvars', tcdFixity = fixity,
tcdFDs = fds', tcdSigs = sigs',
tcdMeths = mbinds', tcdATs = ats', tcdATDefs = at_defs',
@@ -1902,6 +1904,11 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
where
cls_doc = ClassDeclCtx lcls
+rnLayoutInfo :: LayoutInfo GhcPs -> LayoutInfo GhcRn
+rnLayoutInfo (ExplicitBraces ob cb) = ExplicitBraces ob cb
+rnLayoutInfo (VirtualBraces n) = VirtualBraces n
+rnLayoutInfo NoLayoutInfo = NoLayoutInfo
+
-- Does the data type declaration include a CUSK?
data_decl_has_cusk :: LHsQTyVars (GhcPass p) -> NewOrData -> Bool -> Maybe (LHsKind (GhcPass p')) -> RnM Bool
data_decl_has_cusk tyvars new_or_data no_rhs_kvs kind_sig = do
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -328,7 +328,7 @@ cvtDec (ClassD ctxt cl tvs fds decs)
<+> text "are not allowed:")
$$ (Outputable.ppr adts'))
; returnJustLA $ TyClD noExtField $
- ClassDecl { tcdCExt = (noAnn, NoAnnSortKey, NoLayoutInfo)
+ ClassDecl { tcdCExt = (noAnn, NoAnnSortKey), tcdLayout = NoLayoutInfo
, tcdCtxt = mkHsContextMaybe cxt', tcdLName = tc', tcdTyVars = tvs'
, tcdFixity = Prefix
, tcdFDs = fds', tcdSigs = Hs.mkClassOpSigs sigs'
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -16,6 +16,7 @@ module GHC.Types.SrcLoc (
-- ** Constructing SrcLoc
mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,
+ leftmostColumn,
noSrcLoc, -- "I'm sorry, I haven't a clue"
generatedSrcLoc, -- Code generated within the compiler
@@ -104,11 +105,6 @@ module GHC.Types.SrcLoc (
mkSrcSpanPs,
combineRealSrcSpans,
psLocatedToLocated,
-
- -- * Layout information
- LayoutInfo(..),
- leftmostColumn
-
) where
import GHC.Prelude
@@ -241,6 +237,10 @@ mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col) Strict.Nothing
mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc x line col = SrcLoc (LexicalFastString x) line col
+-- | Indentation level is 1-indexed, so the leftmost column is 1.
+leftmostColumn :: Int
+leftmostColumn = 1
+
getBufPos :: SrcLoc -> Strict.Maybe BufPos
getBufPos (RealSrcLoc _ mbpos) = mbpos
getBufPos (UnhelpfulLoc _) = Strict.Nothing
@@ -886,33 +886,3 @@ psSpanEnd (PsSpan r b) = PsLoc (realSrcSpanEnd r) (bufSpanEnd b)
mkSrcSpanPs :: PsSpan -> SrcSpan
mkSrcSpanPs (PsSpan r b) = RealSrcSpan r (Strict.Just b)
-
--- | Layout information for declarations.
-data LayoutInfo =
-
- -- | Explicit braces written by the user.
- --
- -- @
- -- class C a where { foo :: a; bar :: a }
- -- @
- ExplicitBraces
- |
- -- | Virtual braces inserted by the layout algorithm.
- --
- -- @
- -- class C a where
- -- foo :: a
- -- bar :: a
- -- @
- VirtualBraces
- !Int -- ^ Layout column (indentation level, begins at 1)
- |
- -- | Empty or compiler-generated blocks do not have layout information
- -- associated with them.
- NoLayoutInfo
-
- deriving (Eq, Ord, Show, Data)
-
--- | Indentation level is 1-indexed, so the leftmost column is 1.
-leftmostColumn :: Int
-leftmostColumn = 1
=====================================
compiler/Language/Haskell/Syntax.hs
=====================================
@@ -25,6 +25,7 @@ module Language.Haskell.Syntax (
module Language.Haskell.Syntax.Module.Name,
module Language.Haskell.Syntax.Pat,
module Language.Haskell.Syntax.Type,
+ module Language.Haskell.Syntax.Concrete,
module Language.Haskell.Syntax.Extension,
ModuleName(..), HsModule(..)
) where
@@ -35,6 +36,7 @@ import Language.Haskell.Syntax.Expr
import Language.Haskell.Syntax.ImpExp
import Language.Haskell.Syntax.Module.Name
import Language.Haskell.Syntax.Lit
+import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Pat
import Language.Haskell.Syntax.Type
=====================================
compiler/Language/Haskell/Syntax/Concrete.hs
=====================================
@@ -0,0 +1,63 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | Bits of concrete syntax (tokens, layout).
+
+module Language.Haskell.Syntax.Concrete
+ ( LHsToken, LHsUniToken,
+ HsToken(HsTok),
+ HsUniToken(HsNormalTok, HsUnicodeTok),
+ LayoutInfo(ExplicitBraces, VirtualBraces, NoLayoutInfo)
+ ) where
+
+import GHC.Prelude
+import GHC.TypeLits (Symbol, KnownSymbol)
+import Data.Data
+import Language.Haskell.Syntax.Extension
+
+type LHsToken tok p = XRec p (HsToken tok)
+type LHsUniToken tok utok p = XRec p (HsUniToken tok utok)
+
+-- | A token stored in the syntax tree. For example, when parsing a
+-- let-expression, we store @HsToken "let"@ and @HsToken "in"@.
+-- The locations of those tokens can be used to faithfully reproduce
+-- (exactprint) the original program text.
+data HsToken (tok :: Symbol) = HsTok
+
+-- | With @UnicodeSyntax@, there might be multiple ways to write the same
+-- token. For example an arrow could be either @->@ or @→@. This choice must be
+-- recorded in order to exactprint such tokens, so instead of @HsToken "->"@ we
+-- introduce @HsUniToken "->" "→"@.
+--
+-- See also @IsUnicodeSyntax@ in @GHC.Parser.Annotation@; we do not use here to
+-- avoid a dependency.
+data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok
+
+deriving instance KnownSymbol tok => Data (HsToken tok)
+deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok)
+
+-- | Layout information for declarations.
+data LayoutInfo pass =
+
+ -- | Explicit braces written by the user.
+ --
+ -- @
+ -- class C a where { foo :: a; bar :: a }
+ -- @
+ ExplicitBraces !(LHsToken "{" pass) !(LHsToken "}" pass)
+ |
+ -- | Virtual braces inserted by the layout algorithm.
+ --
+ -- @
+ -- class C a where
+ -- foo :: a
+ -- bar :: a
+ -- @
+ VirtualBraces
+ !Int -- ^ Layout column (indentation level, begins at 1)
+ |
+ -- | Empty or compiler-generated blocks do not have layout information
+ -- associated with them.
+ NoLayoutInfo
=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -97,8 +97,9 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
-- Because Expr imports Decls via HsBracket
import Language.Haskell.Syntax.Binds
-import Language.Haskell.Syntax.Type
+import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
+import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Basic (Role)
import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName, Activation)
@@ -457,6 +458,8 @@ data TyClDecl pass
-- 'GHC.Parser.Annotation.AnnRarrow'
-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation
| ClassDecl { tcdCExt :: XClassDecl pass, -- ^ Post renamer, FVs
+ tcdLayout :: !(LayoutInfo pass), -- ^ Explicit or virtual braces
+ -- See Note [Class LayoutInfo]
tcdCtxt :: Maybe (LHsContext pass), -- ^ Context...
tcdLName :: LIdP pass, -- ^ Name of the class
tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables
=====================================
compiler/Language/Haskell/Syntax/Expr.hs
=====================================
@@ -26,6 +26,7 @@ import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Decls
import Language.Haskell.Syntax.Pat
import Language.Haskell.Syntax.Lit
+import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Binds
=====================================
compiler/Language/Haskell/Syntax/Extension.hs
=====================================
@@ -5,7 +5,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDeriving #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
@@ -22,8 +21,6 @@ module Language.Haskell.Syntax.Extension where
-- This module captures the type families to precisely identify the extension
-- points for GHC.Hs syntax
-import GHC.TypeLits (Symbol, KnownSymbol)
-
#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
import Data.Type.Equality (type (~))
#endif
@@ -731,27 +728,3 @@ type family NoGhcTc (p :: Type)
-- =====================================================================
-- End of Type family definitions
-- =====================================================================
-
-
-
--- =====================================================================
--- Token information
-
-type LHsToken tok p = XRec p (HsToken tok)
-
-data HsToken (tok :: Symbol) = HsTok
-
-deriving instance KnownSymbol tok => Data (HsToken tok)
-
-type LHsUniToken tok utok p = XRec p (HsUniToken tok utok)
-
--- With UnicodeSyntax, there might be multiple ways to write the same token.
--- For example an arrow could be either "->" or "→". This choice must be
--- recorded in order to exactprint such tokens,
--- so instead of HsToken "->" we introduce HsUniToken "->" "→".
---
--- See also IsUnicodeSyntax in GHC.Parser.Annotation; we do not use here to
--- avoid a dependency.
-data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok
-
-deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok)
=====================================
compiler/Language/Haskell/Syntax/Pat.hs
=====================================
@@ -36,6 +36,7 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr (SyntaxExpr, LHsExpr, HsUntyp
-- friends:
import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Lit
+import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
=====================================
compiler/Language/Haskell/Syntax/Type.hs
=====================================
@@ -57,6 +57,7 @@ module Language.Haskell.Syntax.Type (
import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsUntypedSplice )
+import Language.Haskell.Syntax.Concrete
import Language.Haskell.Syntax.Extension
import GHC.Types.Name.Reader ( RdrName )
=====================================
compiler/ghc.cabal.in
=====================================
@@ -810,6 +810,7 @@ Library
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
+ Language.Haskell.Syntax.Concrete
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -295,6 +295,7 @@ GHC.Utils.Trace
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
+Language.Haskell.Syntax.Concrete
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -302,6 +302,7 @@ GHC.Utils.Trace
Language.Haskell.Syntax
Language.Haskell.Syntax.Basic
Language.Haskell.Syntax.Binds
+Language.Haskell.Syntax.Concrete
Language.Haskell.Syntax.Decls
Language.Haskell.Syntax.Expr
Language.Haskell.Syntax.Extension
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -49,7 +49,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:(5,1)-(6,16) }
@@ -58,9 +58,9 @@
,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:5:12-16 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (VirtualBraces
- (3)))
+ (NoAnnSortKey))
+ (VirtualBraces
+ (3))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:5:7-8 })
@@ -186,7 +186,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:(9,1)-(10,16) }
@@ -195,9 +195,9 @@
,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:9:12-16 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (VirtualBraces
- (3)))
+ (NoAnnSortKey))
+ (VirtualBraces
+ (3))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:9:7-8 })
@@ -321,7 +321,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:(13,1)-(14,16) }
@@ -330,9 +330,9 @@
,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:13:12-16 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (VirtualBraces
- (3)))
+ (NoAnnSortKey))
+ (VirtualBraces
+ (3))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:13:7-8 })
@@ -459,7 +459,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:(17,1)-(20,16) }
@@ -468,9 +468,9 @@
,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:17:12-16 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (VirtualBraces
- (3)))
+ (NoAnnSortKey))
+ (VirtualBraces
+ (3))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:17:7-8 })
@@ -648,7 +648,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:22:1-30 }
@@ -659,8 +659,16 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:22:30 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (ExplicitBraces))
+ (NoAnnSortKey))
+ (ExplicitBraces
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:22:18 }))
+ (HsTok))
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:22:30 }))
+ (HsTok)))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:22:7-8 })
@@ -917,7 +925,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:28:1-30 }
@@ -928,8 +936,16 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:28:30 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (ExplicitBraces))
+ (NoAnnSortKey))
+ (ExplicitBraces
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:28:18 }))
+ (HsTok))
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:28:30 }))
+ (HsTok)))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:28:7-8 })
@@ -1186,7 +1202,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:34:1-30 }
@@ -1197,8 +1213,16 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:34:30 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (ExplicitBraces))
+ (NoAnnSortKey))
+ (ExplicitBraces
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:34:18 }))
+ (HsTok))
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:34:30 }))
+ (HsTok)))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:34:7-8 })
@@ -1455,7 +1479,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:40:1-30 }
@@ -1466,8 +1490,16 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:40:30 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (ExplicitBraces))
+ (NoAnnSortKey))
+ (ExplicitBraces
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:40:18 }))
+ (HsTok))
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:40:30 }))
+ (HsTok)))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:40:7-8 })
@@ -1724,7 +1756,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:46:1-30 }
@@ -1735,8 +1767,16 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:46:30 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (ExplicitBraces))
+ (NoAnnSortKey))
+ (ExplicitBraces
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:46:18 }))
+ (HsTok))
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:46:30 }))
+ (HsTok)))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:46:7-8 })
@@ -1993,7 +2033,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544.hs:52:1-32 }
@@ -2004,8 +2044,16 @@
,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:52:32 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (ExplicitBraces))
+ (NoAnnSortKey))
+ (ExplicitBraces
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:52:19 }))
+ (HsTok))
+ (L
+ (TokenLoc
+ (EpaSpan { T17544.hs:52:32 }))
+ (HsTok)))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544.hs:52:7-9 })
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -269,7 +269,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T17544_kw.hs:(21,1)-(24,18) }
@@ -278,9 +278,9 @@
,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:23:3-7 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (VirtualBraces
- (5)))
+ (NoAnnSortKey))
+ (VirtualBraces
+ (5))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:21:7-9 })
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -1050,6 +1050,8 @@
(ClassDecl
{NameSet:
[]}
+ (VirtualBraces
+ (3))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:27:7 })
=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -1048,7 +1048,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ DumpSemis.hs:(28,1)-(29,23) }
@@ -1057,9 +1057,9 @@
,(AddEpAnn AnnWhere (EpaSpan { DumpSemis.hs:28:40-44 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (VirtualBraces
- (3)))
+ (NoAnnSortKey))
+ (VirtualBraces
+ (3))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:28:7-19 })
@@ -2112,3 +2112,5 @@
(NoExtField)))))]))))))]
(EmptyLocalBinds
(NoExtField)))))])))))]))
+
+
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -227,7 +227,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T20452.hs:8:1-85 }
@@ -238,8 +238,16 @@
,(AddEpAnn AnnCloseC (EpaSpan { T20452.hs:8:85 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (ExplicitBraces))
+ (NoAnnSortKey))
+ (ExplicitBraces
+ (L
+ (TokenLoc
+ (EpaSpan { T20452.hs:8:84 }))
+ (HsTok))
+ (L
+ (TokenLoc
+ (EpaSpan { T20452.hs:8:85 }))
+ (HsTok)))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T20452.hs:8:7-12 })
@@ -413,7 +421,7 @@
(TyClD
(NoExtField)
(ClassDecl
- ((,,)
+ ((,)
(EpAnn
(Anchor
{ T20452.hs:9:1-85 }
@@ -424,8 +432,16 @@
,(AddEpAnn AnnCloseC (EpaSpan { T20452.hs:9:85 }))]
(EpaComments
[]))
- (NoAnnSortKey)
- (ExplicitBraces))
+ (NoAnnSortKey))
+ (ExplicitBraces
+ (L
+ (TokenLoc
+ (EpaSpan { T20452.hs:9:84 }))
+ (HsTok))
+ (L
+ (TokenLoc
+ (EpaSpan { T20452.hs:9:85 }))
+ (HsTok)))
(Nothing)
(L
(SrcSpanAnn (EpAnnNotUsed) { T20452.hs:9:7-12 })
=====================================
testsuite/tests/perf/compiler/hard_hole_fits.stderr
=====================================
@@ -180,7 +180,7 @@ hard_hole_fits.hs:23:38: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
hwcb :: Language.Haskell.Syntax.Type.LHsWcType
(Language.Haskell.Syntax.Extension.NoGhcTc GhcPs)
(bound at hard_hole_fits.hs:23:30)
- at :: Language.Haskell.Syntax.Extension.LHsToken "@" GhcPs
+ at :: Language.Haskell.Syntax.Concrete.LHsToken "@" GhcPs
(bound at hard_hole_fits.hs:23:27)
gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:23:24)
xate :: Language.Haskell.Syntax.Extension.XAppTypeE GhcPs
@@ -239,10 +239,10 @@ hard_hole_fits.hs:26:30: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Int
• In an equation for ‘testMe’: testMe (HsPar xp gl ab ac) = _
• Relevant bindings include
- ac :: Language.Haskell.Syntax.Extension.LHsToken ")" GhcPs
+ ac :: Language.Haskell.Syntax.Concrete.LHsToken ")" GhcPs
(bound at hard_hole_fits.hs:26:24)
ab :: LHsExpr GhcPs (bound at hard_hole_fits.hs:26:21)
- gl :: Language.Haskell.Syntax.Extension.LHsToken "(" GhcPs
+ gl :: Language.Haskell.Syntax.Concrete.LHsToken "(" GhcPs
(bound at hard_hole_fits.hs:26:18)
xp :: Language.Haskell.Syntax.Extension.XPar GhcPs
(bound at hard_hole_fits.hs:26:15)
@@ -407,11 +407,11 @@ hard_hole_fits.hs:34:39: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)]
testMe (HsLet xl tkLet gl tkIn gl') = _
• Relevant bindings include
gl' :: LHsExpr GhcPs (bound at hard_hole_fits.hs:34:32)
- tkIn :: Language.Haskell.Syntax.Extension.LHsToken "in" GhcPs
+ tkIn :: Language.Haskell.Syntax.Concrete.LHsToken "in" GhcPs
(bound at hard_hole_fits.hs:34:27)
gl :: Language.Haskell.Syntax.Binds.HsLocalBinds GhcPs
(bound at hard_hole_fits.hs:34:24)
- tkLet :: Language.Haskell.Syntax.Extension.LHsToken "let" GhcPs
+ tkLet :: Language.Haskell.Syntax.Concrete.LHsToken "let" GhcPs
(bound at hard_hole_fits.hs:34:18)
xl :: Language.Haskell.Syntax.Extension.XLet GhcPs
(bound at hard_hole_fits.hs:34:15)
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -3417,17 +3417,17 @@ exactTransStmt an by using GroupForm = do
-- ---------------------------------------------------------------------
instance ExactPrint (TyClDecl GhcPs) where
- getAnnotationEntry (FamDecl { }) = NoEntryVal
- getAnnotationEntry (SynDecl { tcdSExt = an }) = fromAnn an
- getAnnotationEntry (DataDecl { tcdDExt = an }) = fromAnn an
- getAnnotationEntry (ClassDecl { tcdCExt = (an, _, _) }) = fromAnn an
+ getAnnotationEntry (FamDecl { }) = NoEntryVal
+ getAnnotationEntry (SynDecl { tcdSExt = an }) = fromAnn an
+ getAnnotationEntry (DataDecl { tcdDExt = an }) = fromAnn an
+ getAnnotationEntry (ClassDecl { tcdCExt = (an, _) }) = fromAnn an
setAnnotationAnchor a at FamDecl{} _ _s = a
setAnnotationAnchor x at SynDecl{} anc cs = x { tcdSExt = setAnchorEpa (tcdSExt x) anc cs }
setAnnotationAnchor x at DataDecl{} anc cs = x { tcdDExt = setAnchorEpa (tcdDExt x) anc cs }
- setAnnotationAnchor x at ClassDecl{} anc cs = x { tcdCExt = (setAnchorEpa an anc cs, a, b) }
+ setAnnotationAnchor x at ClassDecl{} anc cs = x { tcdCExt = (setAnchorEpa an anc cs, a) }
where
- (an,a,b) = tcdCExt x
+ (an,a) = tcdCExt x
exact (FamDecl a decl) = do
decl' <- markAnnotated decl
@@ -3459,7 +3459,8 @@ instance ExactPrint (TyClDecl GhcPs) where
-- -----------------------------------
- exact (ClassDecl {tcdCExt = (an, sortKey, lo),
+ exact (ClassDecl {tcdCExt = (an, sortKey),
+ tcdLayout = lo,
tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
tcdFixity = fixity,
tcdFDs = fds,
@@ -3472,7 +3473,8 @@ instance ExactPrint (TyClDecl GhcPs) where
(an0, fds', lclas', tyvars',context') <- top_matter
an1 <- markEpAnnL an0 lidl AnnOpenC
an2 <- markEpAnnL an1 lidl AnnCloseC
- return (ClassDecl {tcdCExt = (an2, sortKey, lo),
+ return (ClassDecl {tcdCExt = (an2, sortKey),
+ tcdLayout = lo,
tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',
tcdFixity = fixity,
tcdFDs = fds',
@@ -3498,7 +3500,8 @@ instance ExactPrint (TyClDecl GhcPs) where
methods' = listToBag $ undynamic ds
ats' = undynamic ds
at_defs' = undynamic ds
- return (ClassDecl {tcdCExt = (an3, sortKey, lo),
+ return (ClassDecl {tcdCExt = (an3, sortKey),
+ tcdLayout = lo,
tcdCtxt = context', tcdLName = lclas', tcdTyVars = tyvars',
tcdFixity = fixity,
tcdFDs = fds',
=====================================
utils/check-ppr/Main.hs
=====================================
@@ -110,7 +110,7 @@ eraseLayoutInfo = everywhere go
where
go :: forall a. Typeable a => a -> a
go x =
- case eqT @a @LayoutInfo of
+ case eqT @a @(LayoutInfo GhcPs) of
Nothing -> x
Just Refl -> NoLayoutInfo
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 57b7493ba60bc4f4cf6b57b900b0c46fe8d86669
+Subproject commit 9bede9364033d6167212d86c800bf8e6cc4f579c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11fe42d89d37539bd90f31ca47547922b3fc84ae
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11fe42d89d37539bd90f31ca47547922b3fc84ae
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/20221024/c07d1106/attachment-0001.html>
More information about the ghc-commits
mailing list