diff options
| author | Bodigrim <andrew.lelechenko@gmail.com> | 2022-09-14 22:02:18 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-09-28 22:52:38 -0400 |
| commit | 6a2eec98d9f5c3f5d735042f0d7bb65d0dbb3323 (patch) | |
| tree | 4dc1798d823d8383607284d9a7e49454616ccb3f /compiler | |
| parent | bc0020fa0871aff23d26b0116c1d4e43b8a3e9a9 (diff) | |
| download | haskell-6a2eec98d9f5c3f5d735042f0d7bb65d0dbb3323.tar.gz | |
Eliminate headFS, use unconsFS instead
A small step towards #22185 to avoid partial functions + safe implementation
of `startsWithUnderscore`.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Data/FastString.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Types/Name/Occurrence.hs | 4 | ||||
| -rw-r--r-- | compiler/GHC/Utils/Lexeme.hs | 24 |
3 files changed, 14 insertions, 20 deletions
diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs index 98ca34c249..483d40cca1 100644 --- a/compiler/GHC/Data/FastString.hs +++ b/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) diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs index f056e833dd..947982b53d 100644 --- a/compiler/GHC/Types/Name/Occurrence.hs +++ b/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 {- ************************************************************************ diff --git a/compiler/GHC/Utils/Lexeme.hs b/compiler/GHC/Utils/Lexeme.hs index 6df962a54b..f71bf1674a 100644 --- a/compiler/GHC/Utils/Lexeme.hs +++ b/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 |