[Git][ghc/ghc][wip/az/epa-hslet-tokens] 2 commits: Style: use bang patterns instead of seq in Parser.y

Vladislav Zavialov (@int-index) gitlab at gitlab.haskell.org
Fri Feb 2 21:52:00 UTC 2024



Vladislav Zavialov pushed to branch wip/az/epa-hslet-tokens at Glasgow Haskell Compiler / GHC


Commits:
33f877fb by Vladislav Zavialov at 2024-02-03T00:27:23+03:00
Style: use bang patterns instead of seq in Parser.y

- - - - -
2b5d9ca4 by Vladislav Zavialov at 2024-02-03T00:51:45+03:00
EPA: revert changes to mkHsVarPV

- - - - -


2 changed files:

- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs


Changes:

=====================================
compiler/GHC/Parser.y
=====================================
@@ -4107,26 +4107,28 @@ stringLiteralToHsDocWst  = lexStringLiteral parseIdentifier
 
 -- Utilities for combining source spans
 comb2 :: (HasLoc a, HasLoc b) => a -> b -> SrcSpan
-comb2 a b = a `seq` b `seq` combineHasLocs a b
+comb2 !a !b = combineHasLocs a b
 
 comb3 :: (HasLoc a, HasLoc b, HasLoc c) => a -> b -> c -> SrcSpan
-comb3 a b c = a `seq` b `seq` c `seq`
-    combineSrcSpans (getHasLoc a) (combineHasLocs b c)
+comb3 !a !b !c = combineSrcSpans (getHasLoc a) (combineHasLocs b c)
 
 comb4 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d) => a -> b -> c -> d -> SrcSpan
-comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
-    (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $
-                combineSrcSpans (getHasLoc c) (getHasLoc d))
+comb4 !a !b !c !d =
+    combineSrcSpans (getHasLoc a) $
+    combineSrcSpans (getHasLoc b) $
+    combineSrcSpans (getHasLoc c) (getHasLoc d)
 
 comb5 :: (HasLoc a, HasLoc b, HasLoc c, HasLoc d, HasLoc e) => a -> b -> c -> d -> e -> SrcSpan
-comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq`
-    (combineSrcSpans (getHasLoc a) $ combineSrcSpans (getHasLoc b) $
-       combineSrcSpans (getHasLoc c) $ combineSrcSpans (getHasLoc d) (getHasLoc e))
+comb5 !a !b !c !d !e =
+    combineSrcSpans (getHasLoc a) $
+    combineSrcSpans (getHasLoc b) $
+    combineSrcSpans (getHasLoc c) $
+    combineSrcSpans (getHasLoc d) (getHasLoc e)
 
 -- strict constructor version:
 {-# INLINE sL #-}
 sL :: l -> a -> GenLocated l a
-sL loc a = loc `seq` a `seq` L loc a
+sL !loc !a = L loc a
 
 -- See Note [Adding location info] for how these utility functions are used
 
@@ -4137,32 +4139,32 @@ sL0 = L noSrcSpan       -- #define L0   L noSrcSpan
 
 {-# INLINE sL1 #-}
 sL1 :: HasLoc a => a -> b -> Located b
-sL1 x = x `seq` sL (getHasLoc x)   -- #define sL1   sL (getLoc $1)
+sL1 !x = sL (getHasLoc x)   -- #define sL1   sL (getLoc $1)
 
 {-# INLINE sL1a #-}
 sL1a :: (HasLoc a, HasAnnotation t) =>  a -> b -> GenLocated t b
-sL1a x = x `seq` sL (noAnnSrcSpan $ getHasLoc x)   -- #define sL1   sL (getLoc $1)
+sL1a !x = sL (noAnnSrcSpan $ getHasLoc x)   -- #define sL1   sL (getLoc $1)
 
 {-# INLINE sL1n #-}
 sL1n :: HasLoc a => a -> b -> LocatedN b
-sL1n x = x `seq` L (noAnnSrcSpan $ getHasLoc x)   -- #define sL1   sL (getLoc $1)
+sL1n !x = L (noAnnSrcSpan $ getHasLoc x)   -- #define sL1   sL (getLoc $1)
 
 {-# INLINE sLL #-}
 sLL :: (HasLoc a, HasLoc b) => a -> b -> c -> Located c
-sLL x y = x `seq` y `seq` sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)
+sLL !x !y = sL (comb2 x y) -- #define LL   sL (comb2 $1 $>)
 
 {-# INLINE sLLa #-}
 sLLa :: (HasLoc a, HasLoc b, NoAnn t) => a -> b -> c -> LocatedAn t c
-sLLa x y = x `seq` y `seq` sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)
+sLLa !x !y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)
 
 {-# INLINE sLLl #-}
 sLLl :: (HasLoc a, HasLoc b) => a -> b -> c -> LocatedL c
-sLLl x y = x `seq` y `seq` sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)
+sLLl !x !y = sL (noAnnSrcSpan $ comb2 x y) -- #define LL   sL (comb2 $1 $>)
 
 {-# INLINE sLLAsl #-}
 sLLAsl :: (HasLoc a) => [a] -> Located b -> c -> Located c
 sLLAsl [] = sL1
-sLLAsl (x:_) = x `seq` sLL x
+sLLAsl (!x:_) = sLL x
 
 {- Note [Adding location info]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -4281,35 +4283,35 @@ in GHC.Parser.Annotation
 -- |Construct an AddEpAnn from the annotation keyword and the location
 -- of the keyword itself
 mj :: AnnKeywordId -> Located e -> AddEpAnn
-mj a l = a `seq` l `seq` AddEpAnn a (srcSpan2e $ gl l)
+mj !a !l = AddEpAnn a (srcSpan2e $ gl l)
 
 mjN :: AnnKeywordId -> LocatedN e -> AddEpAnn
-mjN a l = a `seq` l `seq` AddEpAnn a (srcSpan2e $ glA l)
+mjN !a !l = AddEpAnn a (srcSpan2e $ glA l)
 
 -- |Construct an AddEpAnn from the annotation keyword and the location
 -- of the keyword itself, provided the span is not zero width
 mz :: AnnKeywordId -> Located e -> [AddEpAnn]
-mz a l = a `seq` l `seq` if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (srcSpan2e $ gl l)]
+mz !a !l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (srcSpan2e $ gl l)]
 
 msemi :: Located e -> [TrailingAnn]
-msemi l = l `seq` if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (srcSpan2e $ gl l)]
+msemi !l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (srcSpan2e $ gl l)]
 
 msemiA :: Located e -> [AddEpAnn]
-msemiA l = l `seq` if isZeroWidthSpan (gl l) then [] else [AddEpAnn AnnSemi (srcSpan2e $ gl l)]
+msemiA !l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn AnnSemi (srcSpan2e $ gl l)]
 
 msemim :: Located e -> Maybe EpaLocation
-msemim l = l `seq` if isZeroWidthSpan (gl l) then Nothing else Just (srcSpan2e $ gl l)
+msemim !l = if isZeroWidthSpan (gl l) then Nothing else Just (srcSpan2e $ gl l)
 
 -- |Construct an AddEpAnn from the annotation keyword and the Located Token. If
 -- the token has a unicode equivalent and this has been used, provide the
 -- unicode variant of the annotation.
 mu :: AnnKeywordId -> Located Token -> AddEpAnn
-mu a lt@(L l t) = a `seq` lt `seq` AddEpAnn (toUnicodeAnn a lt) (srcSpan2e l)
+mu !a lt@(L l t) = AddEpAnn (toUnicodeAnn a lt) (srcSpan2e l)
 
 -- | If the 'Token' is using its unicode variant return the unicode variant of
 --   the annotation
 toUnicodeAnn :: AnnKeywordId -> Located Token -> AnnKeywordId
-toUnicodeAnn a t = a `seq` t `seq` if isUnicode t then unicodeAnn a else a
+toUnicodeAnn !a !t = if isUnicode t then unicodeAnn a else a
 
 toUnicode :: Located Token -> IsUnicodeSyntax
 toUnicode t = if isUnicode t then UnicodeSyntax else NormalSyntax
@@ -4323,19 +4325,19 @@ glA :: HasLoc a => a -> SrcSpan
 glA = getHasLoc
 
 glR :: HasLoc a => a -> Anchor
-glR la = la `seq` EpaSpan (getHasLoc la)
+glR !la = EpaSpan (getHasLoc la)
 
 glEE :: (HasLoc a, HasLoc b) => a -> b -> Anchor
-glEE x y = x `seq` y `seq` spanAsAnchor $ comb2 x y
+glEE !x !y = spanAsAnchor $ comb2 x y
 
 glRM :: Located a -> Maybe Anchor
-glRM (L l _) = l `seq` Just $ spanAsAnchor l
+glRM (L !l _) = Just $ spanAsAnchor l
 
 glAA :: HasLoc a => a -> EpaLocation
 glAA = srcSpan2e . getHasLoc
 
 n2l :: LocatedN a -> LocatedA a
-n2l (L la a) = la `seq` a `seq` L (l2l la) a
+n2l (L !la !a) = L (l2l la) a
 
 -- Called at the very end to pick up the EOF position, as well as any comments not allocated yet.
 acsFinal :: (EpAnnComments -> Maybe (RealSrcSpan, RealSrcSpan) -> Located a) -> P (Located a)
@@ -4350,13 +4352,13 @@ acsFinal a = do
   return (a (cs Semi.<> csf) ce)
 
 acs :: (HasLoc l, MonadP m) => l -> (l -> EpAnnComments -> GenLocated l a) -> m (GenLocated l a)
-acs l a = do
-  !cs <- getCommentsFor (l `seq` locA l)
+acs !l a = do
+  !cs <- getCommentsFor (locA l)
   return (a l cs)
 
 acsA :: (HasLoc l, HasAnnotation t, MonadP m) => l -> (l -> EpAnnComments -> Located a) -> m (GenLocated t a)
-acsA l a = do
-  !cs <- getCommentsFor (l `seq` locA l)
+acsA !l a = do
+  !cs <- getCommentsFor (locA l)
   return $ reLoc (a l cs)
 
 ams1 :: MonadP m => Located a -> b -> m (LocatedA b)
@@ -4370,8 +4372,8 @@ amsA' (L l a) = do
   return (L (EpAnn (spanAsAnchor l) noAnn cs) a)
 
 amsA :: MonadP m => LocatedA a -> [TrailingAnn] -> m (LocatedA a)
-amsA (L l a) bs = do
-  !cs <- getCommentsFor (l `seq` locA l)
+amsA (L !l a) bs = do
+  !cs <- getCommentsFor (locA l)
   return (L (addAnnsA l bs cs) a)
 
 amsAl :: MonadP m => LocatedA a -> SrcSpan -> [TrailingAnn] -> m (LocatedA a)
@@ -4386,24 +4388,24 @@ amsr (L l a) an = do
 
 -- |Synonyms for AddEpAnn versions of AnnOpen and AnnClose
 mo,mc :: Located Token -> AddEpAnn
-mo ll = ll `seq` mj AnnOpen ll
-mc ll = ll `seq` mj AnnClose ll
+mo !ll = mj AnnOpen ll
+mc !ll = mj AnnClose ll
 
 moc,mcc :: Located Token -> AddEpAnn
-moc ll = ll `seq` mj AnnOpenC ll
-mcc ll = ll `seq` mj AnnCloseC ll
+moc !ll = mj AnnOpenC ll
+mcc !ll = mj AnnCloseC ll
 
 mop,mcp :: Located Token -> AddEpAnn
-mop ll = ll `seq` mj AnnOpenP ll
-mcp ll = ll `seq` mj AnnCloseP ll
+mop !ll = mj AnnOpenP ll
+mcp !ll = mj AnnCloseP ll
 
 moh,mch :: Located Token -> AddEpAnn
-moh ll = ll `seq` mj AnnOpenPH ll
-mch ll = ll `seq` mj AnnClosePH ll
+moh !ll = mj AnnOpenPH ll
+mch !ll = mj AnnClosePH ll
 
 mos,mcs :: Located Token -> AddEpAnn
-mos ll = ll `seq` mj AnnOpenS ll
-mcs ll = ll `seq` mj AnnCloseS ll
+mos !ll = mj AnnOpenS ll
+mcs !ll = mj AnnCloseS ll
 
 -- | Parse a Haskell module with Haddock comments. This is done in two steps:
 --
@@ -4433,7 +4435,7 @@ commentsA loc cs = EpAnn (EpaSpan loc) noAnn cs
 
 spanWithComments :: (NoAnn ann, MonadP m) => SrcSpan -> m (EpAnn ann)
 spanWithComments l = do
-  cs <- getCommentsFor l
+  !cs <- getCommentsFor l
   return (commentsA l cs)
 
 -- | Instead of getting the *enclosed* comments, this includes the
@@ -4460,15 +4462,15 @@ listAsAnchorM (L l _:_) =
     _                -> Nothing
 
 epTok :: Located Token -> EpToken tok
-epTok (L l _) = l `seq` EpTok (EpaSpan l)
+epTok (L !l _) = EpTok (EpaSpan l)
 
 epUniTok :: Located Token -> EpUniToken tok utok
-epUniTok t@(L l _) = t `seq` l `seq` EpUniTok (EpaSpan l) u
+epUniTok t@(L !l _) = EpUniTok (EpaSpan l) u
   where
     u = if isUnicode t then UnicodeSyntax else NormalSyntax
 
 epExplicitBraces :: Located Token -> Located Token -> EpLayout
-epExplicitBraces t1 t2 = t1 `seq` t2 `seq` EpExplicitBraces (epTok t1) (epTok t2)
+epExplicitBraces !t1 !t2 = EpExplicitBraces (epTok t1) (epTok t2)
 
 -- -------------------------------------
 


=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1795,9 +1795,7 @@ instance DisambECP (HsExpr GhcPs) where
   mkHsParPV l lpar e rpar = do
     !cs <- getCommentsFor l
     return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsPar (lpar, rpar) e)
-  mkHsVarPV v@(L l@(EpAnn anc _ _) _) = do
-    !cs <- getCommentsFor (getHasLoc l)
-    return $ L (EpAnn anc noAnn cs) (HsVar noExtField v)
+  mkHsVarPV v@(L l _) = return $ L (l2l l) (HsVar noExtField v)
   mkHsLitPV (L l a) = do
     !cs <- getCommentsFor l
     return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsLit noExtField a)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f594889ce38e4deb5154e363838280a19667dc0...2b5d9ca452cdb854348ba20aa986251375e0cdd3

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f594889ce38e4deb5154e363838280a19667dc0...2b5d9ca452cdb854348ba20aa986251375e0cdd3
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/20240202/13a1081b/attachment-0001.html>


More information about the ghc-commits mailing list