Use dropWhileEndLE p instead of reverse . dropWhile p . reverse

Summary: Using `dropWhileEndLE` tends to be faster and easier to read
than the `reverse . dropWhile p . reverse` idiom. This also cleans up
some other, nearby, messes. Fix #9616 (incorrect number formatting
potentially leading to incorrect numbers in output).

Test Plan: Run validate

Reviewers: thomie, rwbarton, nomeata, austin

Reviewed By: nomeata, austin

Subscribers: simonmar, ezyang, carter, thomie

Projects: #ghc

Differential Revision: https://phabricator.haskell.org/D259

GHC Trac Issues: #9623, #9616

Conflicts:
	compiler/basicTypes/OccName.lhs

5 files changed, 41 insertions, 9 deletions

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index 1f1fda8ae3..0010ad37dc 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -833,7 +833,7 @@ tidyOccName env occ@(OccName occ_sp fs)
         Nothing -> (addToUFM env fs 1, occ)
   where
     base :: String  -- Drop trailing digits (see Note [TidyOccEnv])
-    base = reverse (dropWhile isDigit (reverse (unpackFS fs)))
+    base = dropWhileEndLE isDigit (unpackFS fs)
 
     find n
       = case lookupUFM env new_fs of
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 7292b4a4b3..aa5f6f9c95 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -23,6 +23,8 @@ module Util (
         mapAndUnzip, mapAndUnzip3, mapAccumL2,
         nOfThem, filterOut, partitionWith, splitEithers,
 
+        dropWhileEndLE,
+
         foldl1', foldl2, count, all2,
 
         lengthExceeds, lengthIs, lengthAtLeast,
@@ -593,6 +595,18 @@ dropTail n xs
     go _      _      = []  -- Stop when ys runs out
                            -- It'll always run out before xs does
 
+-- dropWhile from the end of a list. This is similar to Data.List.dropWhileEnd,
+-- but is lazy in the elements and strict in the spine. For reasonably short lists,
+-- such as path names and typical lines of text, dropWhileEndLE is generally
+-- faster than dropWhileEnd. Its advantage is magnified when the predicate is
+-- expensive--using dropWhileEndLE isSpace to strip the space off a line of text
+-- is generally much faster than using dropWhileEnd isSpace for that purpose.
+-- Specification: dropWhileEndLE p = reverse . dropWhile p . reverse
+-- Pay attention to the short-circuit (&&)! The order of its arguments is the only
+-- difference between dropWhileEnd and dropWhileEndLE.
+dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
+dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) []
+
 snocView :: [a] -> Maybe ([a],a)
         -- Split off the last element
 snocView [] = Nothing
@@ -651,7 +665,7 @@ cmpList cmp (a:as) (b:bs)
 
 \begin{code}
 removeSpaces :: String -> String
-removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+removeSpaces = dropWhileEndLE isSpace . dropWhile isSpace
 \end{code}
 
 %************************************************************************
diff --git a/libraries/base/GHC/Windows.hs b/libraries/base/GHC/Windows.hs
index 0a57fc3368..83f83df949 100644
--- a/libraries/base/GHC/Windows.hs
+++ b/libraries/base/GHC/Windows.hs
@@ -69,6 +69,7 @@ import GHC.Base
 import GHC.IO
 import GHC.Num
 import System.IO.Error
+import Util
 
 import qualified Numeric
 
@@ -120,7 +121,7 @@ errCodeToIOError fn_name err_code = do
     -- XXX we should really do this directly.
     let errno = c_maperrno_func err_code
 
-    let msg' = reverse $ dropWhile isSpace $ reverse msg -- drop trailing \n
+    let msg' = dropWhileEndLE isSpace msg -- drop trailing \n
         ioerror = errnoToIOError fn_name errno Nothing Nothing
                     `ioeSetErrorString` msg'
     return ioerror
diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs
index 8fd9e4226c..c294b6a94e 100644
--- a/utils/hpc/HpcMarkup.hs
+++ b/utils/hpc/HpcMarkup.hs
@@ -140,6 +140,16 @@ charEncodingTag =
     "<meta http-equiv=\"Content-Type\" " ++
           "content=\"text/html; " ++ "charset=" ++ show localeEncoding ++ "\">"
 
+-- Add characters to the left of a string until it is at least as
+-- large as requested.
+padLeft :: Int -> Char -> String -> String
+padLeft n c str = go n str
+  where
+    -- If the string is already long enough, stop traversing it.
+    go 0 _       = str
+    go k []      = replicate k c ++ str
+    go k (_:xs)  = go (k-1) xs
+
 genHtmlFromMod
   :: String
   -> Flags
@@ -210,8 +220,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
   content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath
 
   let content' = markup tabStop info content
-  let show' = reverse . take 5 . (++ "       ") . reverse . show
-  let addLine n xs = "<span class=\"lineno\">" ++ show' n ++ " </span>" ++ xs
+  let addLine n xs = "<span class=\"lineno\">" ++ padLeft 5 ' ' (show n) ++ " </span>" ++ xs
   let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines
   let fileName = modName0 ++ ".hs.html"
   putStrLn $ "Writing: " ++ fileName
@@ -363,10 +372,14 @@ openTick (TopLevelDecl True 1)
 openTick (TopLevelDecl True n0)
          = "<span class=\"funcount\">-- entered " ++ showBigNum n0 ++ " times</span>" ++ openTopDecl
   where showBigNum n | n <= 9999 = show n
-                     | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000)
+                     | otherwise = case n `quotRem` 1000 of
+                                     (q, r) -> showBigNum' q ++ "," ++ showWith r
         showBigNum' n | n <= 999 = show n
-                      | otherwise = showBigNum' (n `div` 1000) ++ "," ++ showWith (n `mod` 1000)
-        showWith n = take 3 $ reverse $ ("000" ++) $ reverse $ show n
+                      | otherwise = case n `quotRem` 1000 of
+                                      (q, r) -> showBigNum' q ++ "," ++ showWith r
+        showWith n = padLeft 3 '0' $ show n
+
+
 
 closeTick :: String
 closeTick = "</span>"
@@ -462,7 +475,7 @@ instance Monoid ModuleSummary where
 
 writeFileUsing :: String -> String -> IO ()
 writeFileUsing filename text = do
-  let dest_dir = reverse . dropWhile (\ x -> x /= '/') . reverse $ filename
+  let dest_dir = dropWhileEndLE (\ x -> x /= '/') $ filename
 
 -- We need to check for the dest_dir each time, because we use sub-dirs for
 -- packages, and a single .tix file might contain information about
diff --git a/utils/hpc/HpcUtils.hs b/utils/hpc/HpcUtils.hs
index 5655f837f3..73d9cd3a87 100644
--- a/utils/hpc/HpcUtils.hs
+++ b/utils/hpc/HpcUtils.hs
@@ -3,6 +3,10 @@ module HpcUtils where
 import Trace.Hpc.Util
 import qualified Data.Map as Map
 
+dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
+-- Spec: dropWhileEndLE p = reverse . dropWhileEnd . reverse
+dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) []
+
 -- turns \n into ' '
 -- | grab's the text behind a HpcPos; 
 grabHpcPos :: Map.Map Int String -> HpcPos -> String