[Git][ghc/ghc][wip/az/T25453-strictness] EPA: Add strictness annotations to data structures
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sat Nov 9 11:06:37 UTC 2024
Alan Zimmerman pushed to branch wip/az/T25453-strictness at Glasgow Haskell Compiler / GHC
Commits:
0c92dccb by Alan Zimmerman at 2024-11-09T11:01:10+00:00
EPA: Add strictness annotations to data structures
As pointed out in #25453, a lot of time/allocations come about from
the Semigroup instance for AddEpAnn.
To mitigate some of this, add strictness marks to most data structures
for annotations. Any left out are accidental.
- - - - -
6 changed files:
- compiler/GHC/Hs.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Parser/Annotation.hs
Changes:
=====================================
compiler/GHC/Hs.hs
=====================================
@@ -88,11 +88,11 @@ deriving instance Data (HsModule GhcPs)
data AnnsModule
= AnnsModule {
- am_sig :: EpToken "signature",
- am_mod :: EpToken "module",
- am_where :: EpToken "where",
+ am_sig :: !(EpToken "signature"),
+ am_mod :: !(EpToken "module"),
+ am_where :: !(EpToken "where"),
am_decls :: [TrailingAnn], -- ^ Semis before the start of top decls
- am_cs :: [LEpaComment], -- ^ Comments before start of top decl,
+ am_cs :: [LEpaComment], -- ^ Comments before start of top decl,
-- used in exact printing only
am_eof :: Maybe (RealSrcSpan, RealSrcSpan) -- ^ End of file and end of prior token
} deriving (Data, Eq)
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -154,11 +154,11 @@ type instance XXMultAnn (GhcPass _) = DataConCantHappen
data AnnPSB
= AnnPSB {
- ap_pattern :: EpToken "pattern",
- ap_openc :: Maybe (EpToken "{"),
- ap_closec :: Maybe (EpToken "}"),
- ap_larrow :: Maybe (EpUniToken "<-" "←"),
- ap_equal :: Maybe (EpToken "=")
+ ap_pattern :: !(EpToken "pattern"),
+ ap_openc :: !(Maybe (EpToken "{")),
+ ap_closec :: !(Maybe (EpToken "}")),
+ ap_larrow :: !(Maybe (EpUniToken "<-" "←")),
+ ap_equal :: !(Maybe (EpToken "="))
} deriving Data
instance NoAnn AnnPSB where
@@ -736,10 +736,10 @@ type instance XXFixitySig (GhcPass p) = DataConCantHappen
data AnnSpecSig
= AnnSpecSig {
- ass_open :: EpaLocation,
- ass_close :: EpToken "#-}",
- ass_dcolon :: TokDcolon,
- ass_act :: ActivationAnn
+ ass_open :: !EpaLocation,
+ ass_close :: !(EpToken "#-}"),
+ ass_dcolon :: !TokDcolon,
+ ass_act :: !ActivationAnn
} deriving Data
instance NoAnn AnnSpecSig where
@@ -747,10 +747,10 @@ instance NoAnn AnnSpecSig where
data ActivationAnn
= ActivationAnn {
- aa_openc :: EpToken "[",
- aa_closec :: EpToken "]",
- aa_tilde :: Maybe (EpToken "~"),
- aa_val :: Maybe EpaLocation
+ aa_openc :: !(EpToken "["),
+ aa_closec :: !(EpToken "]"),
+ aa_tilde :: !(Maybe (EpToken "~")),
+ aa_val :: !(Maybe EpaLocation)
} deriving (Data, Eq)
instance NoAnn ActivationAnn where
@@ -807,9 +807,9 @@ newtype IdSig = IdSig { unIdSig :: Id }
data AnnSig
= AnnSig {
- asDcolon :: EpUniToken "::" "∷",
- asPattern :: Maybe (EpToken "pattern"),
- asDefault :: Maybe (EpToken "default")
+ asDcolon :: !(EpUniToken "::" "∷"),
+ asPattern :: !(Maybe (EpToken "pattern")),
+ asDefault :: !(Maybe (EpToken "default"))
} deriving Data
instance NoAnn AnnSig where
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -392,15 +392,15 @@ data AnnDataDefn
= AnnDataDefn {
andd_openp :: [EpToken "("],
andd_closep :: [EpToken ")"],
- andd_type :: EpToken "type",
- andd_newtype :: EpToken "newtype",
- andd_data :: EpToken "data",
- andd_instance :: EpToken "instance",
- andd_dcolon :: TokDcolon,
- andd_where :: EpToken "where",
- andd_openc :: EpToken "{",
- andd_closec :: EpToken "}",
- andd_equal :: EpToken "="
+ andd_type :: !(EpToken "type"),
+ andd_newtype :: !(EpToken "newtype"),
+ andd_data :: !(EpToken "data"),
+ andd_instance :: !(EpToken "instance"),
+ andd_dcolon :: !TokDcolon,
+ andd_where :: !(EpToken "where"),
+ andd_openc :: !(EpToken "{"),
+ andd_closec :: !(EpToken "}"),
+ andd_equal :: !(EpToken "=")
} deriving Data
instance NoAnn AnnDataDefn where
@@ -408,13 +408,13 @@ instance NoAnn AnnDataDefn where
data AnnClassDecl
= AnnClassDecl {
- acd_class :: EpToken "class",
+ acd_class :: !(EpToken "class"),
acd_openp :: [EpToken "("],
acd_closep :: [EpToken ")"],
- acd_vbar :: EpToken "|",
- acd_where :: EpToken "where",
- acd_openc :: EpToken "{",
- acd_closec :: EpToken "}",
+ acd_vbar :: !(EpToken "|"),
+ acd_where :: !(EpToken "where"),
+ acd_openc :: !(EpToken "{"),
+ acd_closec :: !(EpToken "}"),
acd_semis :: [EpToken ";"]
} deriving Data
@@ -425,8 +425,8 @@ data AnnSynDecl
= AnnSynDecl {
asd_opens :: [EpToken "("],
asd_closes :: [EpToken ")"],
- asd_type :: EpToken "type",
- asd_equal :: EpToken "="
+ asd_type :: !(EpToken "type"),
+ asd_equal :: !(EpToken "=")
} deriving Data
instance NoAnn AnnSynDecl where
@@ -624,16 +624,16 @@ data AnnFamilyDecl
= AnnFamilyDecl {
afd_openp :: [EpToken "("],
afd_closep :: [EpToken ")"],
- afd_type :: EpToken "type",
- afd_data :: EpToken "data",
- afd_family :: EpToken "family",
- afd_dcolon :: TokDcolon,
- afd_equal :: EpToken "=",
- afd_vbar :: EpToken "|",
- afd_where :: EpToken "where",
- afd_openc :: EpToken "{",
- afd_dotdot :: EpToken "..",
- afd_closec :: EpToken "}"
+ afd_type :: !(EpToken "type"),
+ afd_data :: !(EpToken "data"),
+ afd_family :: !(EpToken "family"),
+ afd_dcolon :: !TokDcolon,
+ afd_equal :: !(EpToken "="),
+ afd_vbar :: !(EpToken "|"),
+ afd_where :: !(EpToken "where"),
+ afd_openc :: !(EpToken "{"),
+ afd_dotdot :: !(EpToken ".."),
+ afd_closec :: !(EpToken "}")
} deriving Data
instance NoAnn AnnFamilyDecl where
@@ -774,9 +774,9 @@ type instance XXConDeclGADTDetails (GhcPass _) = DataConCantHappen
data AnnConDeclH98
= AnnConDeclH98 {
- acdh_forall :: TokForall,
- acdh_dot :: EpToken ".",
- acdh_darrow :: TokDarrow
+ acdh_forall :: !TokForall,
+ acdh_dot :: !(EpToken "."),
+ acdh_darrow :: !TokDarrow
} deriving Data
instance NoAnn AnnConDeclH98 where
@@ -786,7 +786,7 @@ data AnnConDeclGADT
= AnnConDeclGADT {
acdg_openp :: [EpToken "("],
acdg_closep :: [EpToken ")"],
- acdg_dcolon :: TokDcolon
+ acdg_dcolon :: !TokDcolon
} deriving Data
instance NoAnn AnnConDeclGADT where
@@ -950,11 +950,11 @@ type instance XXInstDecl (GhcPass _) = DataConCantHappen
data AnnClsInstDecl
= AnnClsInstDecl {
- acid_instance :: EpToken "instance",
- acid_where :: EpToken "where",
- acid_openc :: EpToken "{",
+ acid_instance :: !(EpToken "instance"),
+ acid_where :: !(EpToken "where"),
+ acid_openc :: !(EpToken "{"),
acid_semis :: [EpToken ";"],
- acid_closec :: EpToken "}"
+ acid_closec :: !(EpToken "}")
} deriving Data
instance NoAnn AnnClsInstDecl where
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -418,10 +418,10 @@ arrowToHsExpr = expandHsArrow (HsVar noExtField)
data AnnExplicitSum
= AnnExplicitSum {
- aesOpen :: EpaLocation,
+ aesOpen :: !EpaLocation,
aesBarsBefore :: [EpToken "|"],
aesBarsAfter :: [EpToken "|"],
- aesClose :: EpaLocation
+ aesClose :: !EpaLocation
} deriving Data
instance NoAnn AnnExplicitSum where
@@ -429,7 +429,7 @@ instance NoAnn AnnExplicitSum where
data AnnFieldLabel
= AnnFieldLabel {
- afDot :: Maybe (EpToken ".")
+ afDot :: !(Maybe (EpToken "."))
} deriving Data
instance NoAnn AnnFieldLabel where
@@ -437,8 +437,8 @@ instance NoAnn AnnFieldLabel where
data AnnProjection
= AnnProjection {
- apOpen :: EpToken "(",
- apClose :: EpToken ")"
+ apOpen :: !(EpToken "("),
+ apClose :: !(EpToken ")")
} deriving Data
instance NoAnn AnnProjection where
@@ -446,10 +446,10 @@ instance NoAnn AnnProjection where
data AnnArithSeq
= AnnArithSeq {
- aas_open :: EpToken "[",
- aas_comma :: Maybe (EpToken ","),
- aas_dotdot :: EpToken "..",
- aas_close :: EpToken "]"
+ aas_open :: !(EpToken "["),
+ aas_comma :: !(Maybe (EpToken ")")),
+ aas_dotdot :: !(EpToken ".."),
+ aas_close :: !(EpToken "]")
} deriving Data
instance NoAnn AnnArithSeq where
@@ -457,11 +457,11 @@ instance NoAnn AnnArithSeq where
data AnnsIf
= AnnsIf {
- aiIf :: EpToken "if",
- aiThen :: EpToken "then",
- aiElse :: EpToken "else",
- aiThenSemi :: Maybe (EpToken ";"),
- aiElseSemi :: Maybe (EpToken ";")
+ aiIf :: !(EpToken "if"),
+ aiThen :: !(EpToken "then"),
+ aiElse :: !(EpToken "else"),
+ aiThenSemi :: !(Maybe (EpToken ";")),
+ aiElseSemi :: !(Maybe (EpToken ";"))
} deriving Data
instance NoAnn AnnsIf where
@@ -469,7 +469,7 @@ instance NoAnn AnnsIf where
data AnnFunRhs
= AnnFunRhs {
- afr_strict :: EpToken "!",
+ afr_strict :: !(EpToken "!"),
afr_opens :: [EpToken "("],
afr_closes :: [EpToken ")"]
} deriving Data
@@ -1791,10 +1791,10 @@ type instance XXStmtLR (GhcPass x) GhcTc b = ApplicativeStmt (GhcPass x)
data AnnTransStmt
= AnnTransStmt {
- ats_then :: EpToken "then",
- ats_group :: Maybe (EpToken "group"),
- ats_by :: Maybe (EpToken "by"),
- ats_using :: Maybe (EpToken "using")
+ ats_then :: !(EpToken "then"),
+ ats_group :: !(Maybe (EpToken "group")),
+ ats_by :: !(Maybe (EpToken "by")),
+ ats_using :: !(Maybe (EpToken "using"))
} deriving Data
instance NoAnn AnnTransStmt where
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -372,8 +372,8 @@ data AnnTyVarBndr
= AnnTyVarBndr {
atv_opens :: [EpaLocation], -- all "(" or all "{"
atv_closes :: [EpaLocation], -- all ")" or all "}"
- atv_tv :: EpToken "'",
- atv_dcolon :: TokDcolon
+ atv_tv :: !(EpToken "'"),
+ atv_dcolon :: !TokDcolon
} deriving Data
instance NoAnn AnnTyVarBndr where
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -302,8 +302,8 @@ deriving instance Data EpLayout
data EpaComment =
EpaComment
- { ac_tok :: EpaCommentTok
- , ac_prior_tok :: RealSrcSpan
+ { ac_tok :: !EpaCommentTok
+ , ac_prior_tok :: !RealSrcSpan
-- ^ The location of the prior token, used in exact printing. The
-- 'EpaComment' appears as an 'LEpaComment' containing its
-- location. The difference between the end of the prior token
@@ -314,10 +314,10 @@ data EpaComment =
data EpaCommentTok =
-- Documentation annotations
- EpaDocComment HsDocString -- ^ a docstring that can be pretty printed using pprHsDocString
- | EpaDocOptions String -- ^ doc options (prune, ignore-exports, etc)
- | EpaLineComment String -- ^ comment starting by "--"
- | EpaBlockComment String -- ^ comment in {- -}
+ EpaDocComment !HsDocString -- ^ a docstring that can be pretty printed using pprHsDocString
+ | EpaDocOptions String -- ^ doc options (prune, ignore-exports, etc)
+ | EpaLineComment String -- ^ comment starting by "--"
+ | EpaBlockComment String -- ^ comment in {- -}
deriving (Eq, Data, Show)
-- Note: these are based on the Token versions, but the Token type is
-- defined in GHC.Parser.Lexer and bringing it in here would create a loop
@@ -420,10 +420,10 @@ noSpanAnchor = EpaDelta noSrcSpan (SameLine 0) noAnn
-- following it. The 'EpaCommentsBalanced' constructor is used to do
-- this. The GHC parser will only insert the 'EpaComments' form.
data EpAnnComments = EpaComments
- { priorComments :: ![LEpaComment] }
+ { priorComments :: [LEpaComment] }
| EpaCommentsBalanced
- { priorComments :: ![LEpaComment]
- , followingComments :: ![LEpaComment] }
+ { priorComments :: [LEpaComment]
+ , followingComments :: [LEpaComment] }
deriving (Data, Eq)
type LEpaComment = GenLocated NoCommentsLocation EpaComment
@@ -504,10 +504,10 @@ meaning we can have type LocatedN RdrName
-- | Captures the location of punctuation occurring between items,
-- normally in a list. It is captured as a trailing annotation.
data TrailingAnn
- = AddSemiAnn (EpToken ";") -- ^ Trailing ';'
- | AddCommaAnn (EpToken ",") -- ^ Trailing ','
- | AddVbarAnn (EpToken "|") -- ^ Trailing '|'
- | AddDarrowAnn TokDarrow -- ^ Trailing '=>' / '⇒'
+ = AddSemiAnn !(EpToken ";") -- ^ Trailing ';'
+ | AddCommaAnn !(EpToken ",") -- ^ Trailing ','
+ | AddVbarAnn !(EpToken "|") -- ^ Trailing '|'
+ | AddDarrowAnn !TokDarrow -- ^ Trailing '=>' / '⇒'
deriving (Data, Eq)
ta_location :: TrailingAnn -> EpaLocation
@@ -544,16 +544,16 @@ data AnnList a
al_brackets :: !AnnListBrackets,
al_semis :: [EpToken ";"], -- decls
al_rest :: !a,
- al_trailing :: ![TrailingAnn] -- ^ items appearing after the
- -- list, such as '=>' for a
- -- context
+ al_trailing :: [TrailingAnn] -- ^ items appearing after the
+ -- list, such as '=>' for a
+ -- context
} deriving (Data,Eq)
data AnnListBrackets
- = ListParens (EpToken "(") (EpToken ")")
- | ListBraces (EpToken "{") (EpToken "}")
- | ListSquare (EpToken "[") (EpToken "]")
- | ListBanana (EpUniToken "(|" "⦇") (EpUniToken "|)" "⦈")
+ = ListParens !(EpToken "(") !(EpToken ")")
+ | ListBraces !(EpToken "{") !(EpToken "}")
+ | ListSquare !(EpToken "[") !(EpToken "]")
+ | ListBanana !(EpUniToken "(|" "⦇") !(EpUniToken "|)" "⦈")
| ListNone
deriving (Data,Eq)
@@ -564,9 +564,9 @@ data AnnListBrackets
-- | exact print annotation for an item having surrounding "brackets", such as
-- tuples or lists
data AnnParen
- = AnnParens (EpToken "(") (EpToken ")") -- ^ '(', ')'
- | AnnParensHash (EpToken "(#") (EpToken "#)") -- ^ '(#', '#)'
- | AnnParensSquare (EpToken "[") (EpToken "]") -- ^ '[', ']'
+ = AnnParens !(EpToken "(") !(EpToken ")") -- ^ '(', ')'
+ | AnnParensHash !(EpToken "(#") !(EpToken "#)") -- ^ '(#', '#)'
+ | AnnParensSquare !(EpToken "[") !(EpToken "]") -- ^ '[', ']'
deriving Data
-- ---------------------------------------------------------------------
@@ -574,7 +574,7 @@ data AnnParen
-- | Exact print annotation for the 'Context' data type.
data AnnContext
= AnnContext {
- ac_darrow :: Maybe TokDarrow,
+ ac_darrow :: !(Maybe TokDarrow),
-- ^ location of the '=>', if present.
ac_open :: [EpToken "("], -- ^ zero or more opening parentheses.
ac_close :: [EpToken ")"] -- ^ zero or more closing parentheses.
@@ -591,39 +591,39 @@ data AnnContext
data NameAnn
-- | Used for a name with an adornment, so '`foo`', '(bar)'
= NameAnn {
- nann_adornment :: NameAdornment,
- nann_name :: EpaLocation,
+ nann_adornment :: !NameAdornment,
+ nann_name :: !EpaLocation,
nann_trailing :: [TrailingAnn]
}
-- | Used for @(,,,)@, or @(#,,,#)@
| NameAnnCommas {
- nann_adornment :: NameAdornment,
+ nann_adornment :: !NameAdornment,
nann_commas :: [EpToken ","],
nann_trailing :: [TrailingAnn]
}
-- | Used for @(# | | #)@
| NameAnnBars {
- nann_parensh :: (EpToken "(#", EpToken "#)"),
+ nann_parensh :: !(EpToken "(#", EpToken "#)"),
nann_bars :: [EpToken "|"],
nann_trailing :: [TrailingAnn]
}
-- | Used for @()@, @(##)@, @[]@
| NameAnnOnly {
- nann_adornment :: NameAdornment,
+ nann_adornment :: !NameAdornment,
nann_trailing :: [TrailingAnn]
}
-- | Used for @->@, as an identifier
| NameAnnRArrow {
- nann_mopen :: Maybe (EpToken "("),
- nann_arrow :: TokRarrow,
- nann_mclose :: Maybe (EpToken ")"),
+ nann_mopen :: !(Maybe (EpToken "(")),
+ nann_arrow :: !TokRarrow,
+ nann_mclose :: !(Maybe (EpToken ")")),
nann_trailing :: [TrailingAnn]
}
-- | Used for an item with a leading @'@. The annotation for
-- unquoted item is stored in 'nann_quoted'.
| NameAnnQuote {
- nann_quote :: EpToken "'",
- nann_quoted :: SrcSpanAnnN,
+ nann_quote :: !(EpToken "'"),
+ nann_quoted :: !SrcSpanAnnN,
nann_trailing :: [TrailingAnn]
}
-- | Used when adding a 'TrailingAnn' to an existing 'LocatedN'
@@ -637,10 +637,10 @@ data NameAnn
-- such as parens or backquotes. This data type identifies what
-- particular pair are being used.
data NameAdornment
- = NameParens (EpToken "(") (EpToken ")")
- | NameParensHash (EpToken "(#") (EpToken "#)")
- | NameBackquotes (EpToken "`") (EpToken "`")
- | NameSquare (EpToken "[") (EpToken "]")
+ = NameParens !(EpToken "(") !(EpToken ")")
+ | NameParensHash !(EpToken "(#") !(EpToken "#)")
+ | NameBackquotes !(EpToken "`") !(EpToken "`")
+ | NameSquare !(EpToken "[") !(EpToken "]")
| NameNoAdornment
deriving (Eq, Data)
@@ -651,13 +651,13 @@ data NameAdornment
-- annotations in pragmas.
data AnnPragma
= AnnPragma {
- apr_open :: EpaLocation,
- apr_close :: EpToken "#-}",
- apr_squares :: (EpToken "[", EpToken "]"),
- apr_loc1 :: EpaLocation,
- apr_loc2 :: EpaLocation,
- apr_type :: EpToken "type",
- apr_module :: EpToken "module"
+ apr_open :: !EpaLocation,
+ apr_close :: !(EpToken "#-}"),
+ apr_squares :: !(EpToken "[", EpToken "]"),
+ apr_loc1 :: !EpaLocation,
+ apr_loc2 :: !EpaLocation,
+ apr_type :: !(EpToken "type"),
+ apr_module :: !(EpToken "module")
} deriving (Data,Eq)
-- ---------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c92dccba009571f421c0b771613f3e369547e0c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0c92dccba009571f421c0b771613f3e369547e0c
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/20241109/2b606fb9/attachment-0001.html>
More information about the ghc-commits
mailing list