[Git][ghc/ghc][master] Eliminate headFS, use unconsFS instead

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
6a2eec98 by Bodigrim at 2022-09-28T22:52:38-04:00
Eliminate headFS, use unconsFS instead

A small step towards #22185 to avoid partial functions + safe implementation
of `startsWithUnderscore`.

- - - - -


3 changed files:

- compiler/GHC/Data/FastString.hs
- compiler/GHC/Types/Name/Occurrence.hs
- compiler/GHC/Utils/Lexeme.hs


Changes:

=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -82,7 +82,6 @@ module GHC.Data.FastString
         lengthFS,
         nullFS,
         appendFS,
-        headFS,
         concatFS,
         consFS,
         nilFS,
@@ -609,11 +608,6 @@ appendFS fs1 fs2 = mkFastStringShortByteString
 concatFS :: [FastString] -> FastString
 concatFS = mkFastStringShortByteString . mconcat . map fs_sbs
 
-headFS :: FastString -> Char
-headFS fs
-  | SBS.null $ fs_sbs fs = panic "headFS: Empty FastString"
-headFS fs = head $ unpackFS fs
-
 consFS :: Char -> FastString -> FastString
 consFS c fs = mkFastString (c : unpackFS fs)
 


=====================================
compiler/GHC/Types/Name/Occurrence.hs
=====================================
@@ -519,7 +519,9 @@ parenSymOcc occ doc | isSymOcc occ = parens doc
 startsWithUnderscore :: OccName -> Bool
 -- ^ Haskell 98 encourages compilers to suppress warnings about unused
 -- names in a pattern if they start with @_@: this implements that test
-startsWithUnderscore occ = headFS (occNameFS occ) == '_'
+startsWithUnderscore occ = case unconsFS (occNameFS occ) of
+  Just ('_', _) -> True
+  _ -> False
 
 {-
 ************************************************************************


=====================================
compiler/GHC/Utils/Lexeme.hs
=====================================
@@ -67,19 +67,17 @@ isLexId  cs = isLexConId  cs || isLexVarId  cs
 isLexSym cs = isLexConSym cs || isLexVarSym cs
 
 -------------
-isLexConId cs                           -- Prefix type or data constructors
-  | nullFS cs          = False          --      e.g. "Foo", "[]", "(,)"
-  | cs == (fsLit "[]") = True
-  | otherwise          = startsConId (headFS cs)
-
-isLexVarId cs                           -- Ordinary prefix identifiers
-  | nullFS cs         = False           --      e.g. "x", "_x"
-  | otherwise         = startsVarId (headFS cs)
-
-isLexConSym cs                          -- Infix type or data constructors
-  | nullFS cs          = False          --      e.g. ":-:", ":", "->"
-  | cs == (fsLit "->") = True
-  | otherwise          = startsConSym (headFS cs)
+isLexConId cs = case unconsFS cs of     -- Prefix type or data constructors
+  Nothing     -> False                  --      e.g. "Foo", "[]", "(,)"
+  Just (c, _) -> cs == fsLit "[]" || startsConId c
+
+isLexVarId cs = case unconsFS cs of     -- Ordinary prefix identifiers
+  Nothing     -> False                  --      e.g. "x", "_x"
+  Just (c, _) -> startsVarId c
+
+isLexConSym cs = case unconsFS cs of    -- Infix type or data constructors
+  Nothing     -> False                  --      e.g. ":-:", ":", "->"
+  Just (c, _) -> cs == fsLit "->" || startsConSym c
 
 isLexVarSym fs                          -- Infix identifiers e.g. "+"
   | fs == (fsLit "~R#") = True



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a2eec98d9f5c3f5d735042f0d7bb65d0dbb3323

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6a2eec98d9f5c3f5d735042f0d7bb65d0dbb3323
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/20220928/ac364227/attachment-0001.html>