Bodigrim pushed to branch wip/warning-for-last-and-init at Glasgow Haskell Compiler / GHC

Commits:

3 changed files:

Changes:

  • compiler/GHC/Core/Utils.hs
    ... ... @@ -7,6 +7,9 @@ Utility functions on @Core@ syntax
    7 7 
     -}
    8 8
    9 9 
     -- | Commonly useful utilities for manipulating the Core language
    10 
    +
    11 
    +{-# OPTIONS_GHC -Wno-x-partial #-}
    12 
    +
    10 13 
     module GHC.Core.Utils (
    11 14 
             -- * Constructing expressions
    12 15 
             mkCast, mkCastMCo, mkPiMCo,
    ... ... @@ -112,7 +115,8 @@ import GHC.Utils.Misc
    112 115
    113 116 
     import Data.ByteString     ( ByteString )
    114 117 
     import Data.Function       ( on )
    115 
    -import Data.List           ( sort, sortBy, partition, zipWith4, mapAccumL, unsnoc )
    118 
    +import Data.List           ( sort, sortBy, partition, zipWith4, mapAccumL )
    119 
    +import qualified Data.List as Partial ( init, last )
    116 120 
     import Data.Ord            ( comparing )
    117 121 
     import Control.Monad       ( guard )
    118 122 
     import qualified Data.Set as Set
    ... ... @@ -1870,10 +1874,10 @@ app_ok fun_ok primop_ok fun args
    1870 1874
    1871 1875 
           PrimOpId op _
    1872 1876 
             | primOpIsDiv op
    1873 
    -        , Just (initArgs, Lit divisor) <- unsnoc args
    1877 
    +        , Lit divisor <- Partial.last args
    1874 1878 
                 -- there can be 2 args (most div primops) or 3 args
    1875 1879 
                 -- (WordQuotRem2Op), hence the use of last/init
    1876 
    -        -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) initArgs
    1880 
    +        -> not (isZeroLit divisor) && all (expr_ok fun_ok primop_ok) (Partial.init args)
    1877 1881 
                   -- Special case for dividing operations that fail
    1878 1882 
                   -- In general they are NOT ok-for-speculation
    1879 1883 
                   -- (which primop_ok will catch), but they ARE OK

  • libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs
    1 1 
     -- Vendored from filepath v1.4.2.2
    2 2
    3 3 
     {-# LANGUAGE PatternGuards #-}
    4 
    +{-# OPTIONS_GHC -Wno-x-partial #-}
    4 5
    5 6 
     -- This template expects CPP definitions for:
    6 7 
     --     MODULE_NAME = Posix | Windows
    ... ... @@ -104,7 +105,7 @@ module System.FilePath.Posix
    104 105
    105 106 
     import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
    106 107 
     import Data.Maybe(isJust)
    107 
    -import Data.List(stripPrefix, isSuffixOf, uncons, unsnoc)
    108 
    +import Data.List(stripPrefix, isSuffixOf)
    108 109
    109 110 
     import System.Environment(getEnv)
    110 111
    ... ... @@ -203,20 +204,14 @@ isExtSeparator = (== extSeparator)
    203 204 
     splitSearchPath :: String -> [FilePath]
    204 205 
     splitSearchPath = f
    205 206 
         where
    206 
    -    f xs = let (pre, post) = break isSearchPathSeparator xs
    207 
    -           in case uncons post of
    208 
    -             Nothing     -> g pre
    209 
    -             Just (_, t) -> g pre ++ f t
    210 
    -
    211 
    -    g x = case uncons x of
    212 
    -      Nothing -> ["." | isPosix]
    213 
    -      Just (h, t)
    214 
    -        | h == '"'
    215 
    -        , Just{} <- uncons t -- >= 2
    216 
    -        , isWindows
    217 
    -        , Just (i, l) <- unsnoc t
    218 
    -        , l == '"' -> [i]
    219 
    -        | otherwise -> [x]
    207 
    +    f xs = case break isSearchPathSeparator xs of
    208 
    +           (pre, []    ) -> g pre
    209 
    +           (pre, _:post) -> g pre ++ f post
    210 
    +
    211 
    +    g "" = ["." | isPosix]
    212 
    +    g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]
    213 
    +    g x = [x]
    214 
    +
    220 215
    221 216 
     -- | Get a list of 'FilePath's in the $PATH variable.
    222 217 
     getSearchPath :: IO [FilePath]
    ... ... @@ -239,17 +234,12 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH")
    239 234 
     -- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
    240 235 
     -- > splitExtension "file/path.txt/" == ("file/path.txt/","")
    241 236 
     splitExtension :: FilePath -> (String, String)
    242 
    -splitExtension x = case unsnoc nameDot of
    243 
    -  -- Imagine x = "no-dots", then nameDot = ""
    244 
    -  Nothing -> (x, mempty)
    245 
    -  Just (initNameDot, _)
    246 
    -    -- Imagine x = "\\shared.with.dots\no-dots"
    247 
    -    | isWindows && null (dropDrive nameDot) -> (x, mempty)
    248 
    -    -- Imagine x = "dir.with.dots/no-dots"
    249 
    -    | any isPathSeparator ext -> (x, mempty)
    250 
    -    | otherwise -> (initNameDot, extSeparator : ext)
    251 
    -  where
    252 
    -    (nameDot, ext) = breakEnd isExtSeparator x
    237 
    +splitExtension x = case nameDot of
    238 
    +                       "" -> (x,"")
    239 
    +                       _ -> (dir ++ init nameDot, extSeparator : ext)
    240 
    +    where
    241 
    +        (dir,file) = splitFileName_ x
    242 
    +        (nameDot,ext) = breakEnd isExtSeparator file
    253 243
    254 244 
     -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
    255 245 
     --
    ... ... @@ -605,13 +595,9 @@ replaceBaseName pth nam = combineAlways a (nam <.> ext)
    605 595 
     -- > hasTrailingPathSeparator "test" == False
    606 596 
     -- > hasTrailingPathSeparator "test/" == True
    607 597 
     hasTrailingPathSeparator :: FilePath -> Bool
    608 
    -hasTrailingPathSeparator = isJust . getTrailingPathSeparator
    598 
    +hasTrailingPathSeparator "" = False
    599 
    +hasTrailingPathSeparator x = isPathSeparator (last x)
    609 600
    610 
    -getTrailingPathSeparator :: FilePath -> Maybe Char
    611 
    -getTrailingPathSeparator x = case unsnoc x of
    612 
    -  Just (_, lastX)
    613 
    -    | isPathSeparator lastX -> Just lastX
    614 
    -  _ -> Nothing
    615 601
    616 602 
     hasLeadingPathSeparator :: FilePath -> Bool
    617 603 
     hasLeadingPathSeparator "" = False
    ... ... @@ -634,12 +620,12 @@ addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pat
    634 620 
     -- > Windows:  dropTrailingPathSeparator "\\" == "\\"
    635 621 
     -- > Posix:    not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
    636 622 
     dropTrailingPathSeparator :: FilePath -> FilePath
    637 
    -dropTrailingPathSeparator x = case getTrailingPathSeparator x of
    638 
    -  Just lastX
    639 
    -    | not (isDrive x)
    640 
    -    -> let x' = dropWhileEnd isPathSeparator x
    641 
    -        in if null x' then [lastX] else x'
    642 
    -  _ -> x
    623 
    +dropTrailingPathSeparator x =
    624 
    +    if hasTrailingPathSeparator x && not (isDrive x)
    625 
    +    then let x' = dropWhileEnd isPathSeparator x
    626 
    +         in if null x' then [last x] else x'
    627 
    +    else x
    628 
    +
    643 629
    644 630 
     -- | Get the directory name, move up one level.
    645 631 
     --
    ... ... @@ -878,37 +864,28 @@ makeRelative root path
    878 864 
     -- > Posix:   normalise "bob/fred/." == "bob/fred/"
    879 865 
     -- > Posix:   normalise "//home" == "/home"
    880 866 
     normalise :: FilePath -> FilePath
    881 
    -normalise filepath =
    882 
    -  result <>
    883 
    -  (if addPathSeparator
    884 
    -       then [pathSeparator]
    885 
    -       else mempty)
    886 
    -  where
    887 
    -    (drv,pth) = splitDrive filepath
    888 
    -
    889 
    -    result = joinDrive' (normaliseDrive drv) (f pth)
    867 
    +normalise path = result ++ [pathSeparator | addPathSeparator]
    868 
    +    where
    869 
    +        (drv,pth) = splitDrive path
    870 
    +        result = joinDrive' (normaliseDrive drv) (f pth)
    890 871
    891 
    -    joinDrive' d p
    892 
    -      = if null d && null p
    893 
    -           then "."
    894 
    -           else joinDrive d p
    872 
    +        joinDrive' "" "" = "."
    873 
    +        joinDrive' d p = joinDrive d p
    895 874
    896 
    -    addPathSeparator = isDirPath pth
    897 
    -      && not (hasTrailingPathSeparator result)
    898 
    -      && not (isRelativeDrive drv)
    875 
    +        addPathSeparator = isDirPath pth
    876 
    +            && not (hasTrailingPathSeparator result)
    877 
    +            && not (isRelativeDrive drv)
    899 878
    900 
    -    isDirPath xs = hasTrailingPathSeparator xs || case unsnoc xs of
    901 
    -      Nothing -> False
    902 
    -      Just (initXs, lastXs) -> lastXs == '.' && hasTrailingPathSeparator initXs
    879 
    +        isDirPath xs = hasTrailingPathSeparator xs
    880 
    +            || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)
    903 881
    904 
    -    f = joinPath . dropDots . propSep . splitDirectories
    882 
    +        f = joinPath . dropDots . propSep . splitDirectories
    905 883
    906 
    -    propSep (x:xs)
    907 
    -      | all isPathSeparator x = [pathSeparator] : xs
    908 
    -      | otherwise             = x : xs
    909 
    -    propSep [] = []
    884 
    +        propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs
    885 
    +                       | otherwise = x : xs
    886 
    +        propSep [] = []
    910 887
    911 
    -    dropDots = filter ("." /=)
    888 
    +        dropDots = filter ("." /=)
    912 889
    913 890 
     normaliseDrive :: FilePath -> FilePath
    914 891 
     normaliseDrive "" = ""

  • libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs
    1 1 
     -- Vendored from filepath v1.4.2.2
    2 2
    3 3 
     {-# LANGUAGE PatternGuards #-}
    4 
    +{-# OPTIONS_GHC -Wno-x-partial #-}
    4 5
    5 6 
     -- This template expects CPP definitions for:
    6 7 
     --     MODULE_NAME = Posix | Windows
    ... ... @@ -104,7 +105,7 @@ module System.FilePath.Windows
    104 105
    105 106 
     import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
    106 107 
     import Data.Maybe(isJust)
    107 
    -import Data.List(stripPrefix, isSuffixOf, uncons, unsnoc)
    108 
    +import Data.List(stripPrefix, isSuffixOf)
    108 109
    109 110 
     import System.Environment(getEnv)
    110 111
    ... ... @@ -203,20 +204,14 @@ isExtSeparator = (== extSeparator)
    203 204 
     splitSearchPath :: String -> [FilePath]
    204 205 
     splitSearchPath = f
    205 206 
         where
    206 
    -    f xs = let (pre, post) = break isSearchPathSeparator xs
    207 
    -           in case uncons post of
    208 
    -             Nothing     -> g pre
    209 
    -             Just (_, t) -> g pre ++ f t
    210 
    -
    211 
    -    g x = case uncons x of
    212 
    -      Nothing -> ["." | isPosix]
    213 
    -      Just (h, t)
    214 
    -        | h == '"'
    215 
    -        , Just{} <- uncons t -- >= 2
    216 
    -        , isWindows
    217 
    -        , Just (i, l) <- unsnoc t
    218 
    -        , l == '"' -> [i]
    219 
    -        | otherwise -> [x]
    207 
    +    f xs = case break isSearchPathSeparator xs of
    208 
    +           (pre, []    ) -> g pre
    209 
    +           (pre, _:post) -> g pre ++ f post
    210 
    +
    211 
    +    g "" = ["." | isPosix]
    212 
    +    g ('\"':x@(_:_)) | isWindows && last x == '\"' = [init x]
    213 
    +    g x = [x]
    214 
    +
    220 215
    221 216 
     -- | Get a list of 'FilePath's in the $PATH variable.
    222 217 
     getSearchPath :: IO [FilePath]
    ... ... @@ -239,17 +234,12 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH")
    239 234 
     -- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
    240 235 
     -- > splitExtension "file/path.txt/" == ("file/path.txt/","")
    241 236 
     splitExtension :: FilePath -> (String, String)
    242 
    -splitExtension x = case unsnoc nameDot of
    243 
    -  -- Imagine x = "no-dots", then nameDot = ""
    244 
    -  Nothing -> (x, mempty)
    245 
    -  Just (initNameDot, _)
    246 
    -    -- Imagine x = "\\shared.with.dots\no-dots"
    247 
    -    | isWindows && null (dropDrive nameDot) -> (x, mempty)
    248 
    -    -- Imagine x = "dir.with.dots/no-dots"
    249 
    -    | any isPathSeparator ext -> (x, mempty)
    250 
    -    | otherwise -> (initNameDot, extSeparator : ext)
    251 
    -  where
    252 
    -    (nameDot, ext) = breakEnd isExtSeparator x
    237 
    +splitExtension x = case nameDot of
    238 
    +                       "" -> (x,"")
    239 
    +                       _ -> (dir ++ init nameDot, extSeparator : ext)
    240 
    +    where
    241 
    +        (dir,file) = splitFileName_ x
    242 
    +        (nameDot,ext) = breakEnd isExtSeparator file
    253 243
    254 244 
     -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
    255 245 
     --
    ... ... @@ -605,13 +595,9 @@ replaceBaseName pth nam = combineAlways a (nam <.> ext)
    605 595 
     -- > hasTrailingPathSeparator "test" == False
    606 596 
     -- > hasTrailingPathSeparator "test/" == True
    607 597 
     hasTrailingPathSeparator :: FilePath -> Bool
    608 
    -hasTrailingPathSeparator = isJust . getTrailingPathSeparator
    598 
    +hasTrailingPathSeparator "" = False
    599 
    +hasTrailingPathSeparator x = isPathSeparator (last x)
    609 600
    610 
    -getTrailingPathSeparator :: FilePath -> Maybe Char
    611 
    -getTrailingPathSeparator x = case unsnoc x of
    612 
    -  Just (_, lastX)
    613 
    -    | isPathSeparator lastX -> Just lastX
    614 
    -  _ -> Nothing
    615 601
    616 602 
     hasLeadingPathSeparator :: FilePath -> Bool
    617 603 
     hasLeadingPathSeparator "" = False
    ... ... @@ -634,12 +620,12 @@ addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pat
    634 620 
     -- > Windows:  dropTrailingPathSeparator "\\" == "\\"
    635 621 
     -- > Posix:    not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
    636 622 
     dropTrailingPathSeparator :: FilePath -> FilePath
    637 
    -dropTrailingPathSeparator x = case getTrailingPathSeparator x of
    638 
    -  Just lastX
    639 
    -    | not (isDrive x)
    640 
    -    -> let x' = dropWhileEnd isPathSeparator x
    641 
    -        in if null x' then [lastX] else x'
    642 
    -  _ -> x
    623 
    +dropTrailingPathSeparator x =
    624 
    +    if hasTrailingPathSeparator x && not (isDrive x)
    625 
    +    then let x' = dropWhileEnd isPathSeparator x
    626 
    +         in if null x' then [last x] else x'
    627 
    +    else x
    628 
    +
    643 629
    644 630 
     -- | Get the directory name, move up one level.
    645 631 
     --
    ... ... @@ -878,37 +864,28 @@ makeRelative root path
    878 864 
     -- > Posix:   normalise "bob/fred/." == "bob/fred/"
    879 865 
     -- > Posix:   normalise "//home" == "/home"
    880 866 
     normalise :: FilePath -> FilePath
    881 
    -normalise filepath =
    882 
    -  result <>
    883 
    -  (if addPathSeparator
    884 
    -       then [pathSeparator]
    885 
    -       else mempty)
    886 
    -  where
    887 
    -    (drv,pth) = splitDrive filepath
    888 
    -
    889 
    -    result = joinDrive' (normaliseDrive drv) (f pth)
    867 
    +normalise path = result ++ [pathSeparator | addPathSeparator]
    868 
    +    where
    869 
    +        (drv,pth) = splitDrive path
    870 
    +        result = joinDrive' (normaliseDrive drv) (f pth)
    890 871
    891 
    -    joinDrive' d p
    892 
    -      = if null d && null p
    893 
    -           then "."
    894 
    -           else joinDrive d p
    872 
    +        joinDrive' "" "" = "."
    873 
    +        joinDrive' d p = joinDrive d p
    895 874
    896 
    -    addPathSeparator = isDirPath pth
    897 
    -      && not (hasTrailingPathSeparator result)
    898 
    -      && not (isRelativeDrive drv)
    875 
    +        addPathSeparator = isDirPath pth
    876 
    +            && not (hasTrailingPathSeparator result)
    877 
    +            && not (isRelativeDrive drv)
    899 878
    900 
    -    isDirPath xs = hasTrailingPathSeparator xs || case unsnoc xs of
    901 
    -      Nothing -> False
    902 
    -      Just (initXs, lastXs) -> lastXs == '.' && hasTrailingPathSeparator initXs
    879 
    +        isDirPath xs = hasTrailingPathSeparator xs
    880 
    +            || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)
    903 881
    904 
    -    f = joinPath . dropDots . propSep . splitDirectories
    882 
    +        f = joinPath . dropDots . propSep . splitDirectories
    905 883
    906 
    -    propSep (x:xs)
    907 
    -      | all isPathSeparator x = [pathSeparator] : xs
    908 
    -      | otherwise             = x : xs
    909 
    -    propSep [] = []
    884 
    +        propSep (x:xs) | all isPathSeparator x = [pathSeparator] : xs
    885 
    +                       | otherwise = x : xs
    886 
    +        propSep [] = []
    910 887
    911 
    -    dropDots = filter ("." /=)
    888 
    +        dropDots = filter ("." /=)
    912 889
    913 890 
     normaliseDrive :: FilePath -> FilePath
    914 891 
     normaliseDrive "" = ""

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help