diff options
Diffstat (limited to 'compiler/utils')
| -rw-r--r-- | compiler/utils/Outputable.lhs | 39 | ||||
| -rw-r--r-- | compiler/utils/Util.lhs | 61 |
2 files changed, 44 insertions, 56 deletions
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs index 5263081c9a..248f549aa3 100644 --- a/compiler/utils/Outputable.lhs +++ b/compiler/utils/Outputable.lhs @@ -22,7 +22,7 @@ module Outputable ( empty, nest, char, text, ftext, ptext, - int, integer, float, double, rational, + int, intWithCommas, integer, float, double, rational, parens, cparen, brackets, braces, quotes, quote, doubleQuotes, angleBrackets, semi, comma, colon, dcolon, space, equals, dot, arrow, darrow, lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore, @@ -48,7 +48,7 @@ module Outputable ( renderWithStyle, pprInfixVar, pprPrefixVar, - pprHsChar, pprHsString, pprHsInfix, pprHsVar, + pprHsChar, pprHsString, pprFastFilePath, -- * Controlling the style in which output is printed @@ -743,6 +743,11 @@ data BindingSite = LambdaBind | CaseBind | LetBind class Outputable a => OutputableBndr a where pprBndr :: BindingSite -> a -> SDoc pprBndr _b x = ppr x + + pprPrefixOcc, pprInfixOcc :: a -> SDoc + -- Print an occurrence of the name, suitable either in the + -- prefix position of an application, thus (f a b) or ((+) x) + -- or infix position, thus (a `f` b) or (x + y) \end{code} %************************************************************************ @@ -777,27 +782,6 @@ pprInfixVar is_operator pp_v | otherwise = char '`' <> pp_v <> char '`' --------------------- --- pprHsVar and pprHsInfix use the gruesome isOperator, which --- in turn uses (showSDoc (ppr v)), rather than isSymOcc (getOccName v). --- Reason: it means that pprHsVar doesn't need a NamedThing context, --- which none of the HsSyn printing functions do -pprHsVar, pprHsInfix :: Outputable name => name -> SDoc -pprHsVar v = pprPrefixVar (isOperator pp_v) pp_v - where pp_v = ppr v -pprHsInfix v = pprInfixVar (isOperator pp_v) pp_v - where pp_v = ppr v - -isOperator :: SDoc -> Bool -isOperator ppr_v - = case showSDocUnqual ppr_v of - ('(':_) -> False -- (), (,) etc - ('[':_) -> False -- [] - ('$':c:_) -> not (isAlpha c) -- Don't treat $d as an operator - (':':c:_) -> not (isAlpha c) -- Don't treat :T as an operator - ('_':_) -> False -- Not an operator - (c:_) -> not (isAlpha c) -- Starts with non-alpha - _ -> False - pprFastFilePath :: FastString -> SDoc pprFastFilePath path = text $ normalise $ unpackFS path \end{code} @@ -846,6 +830,15 @@ quotedListWithOr xs = quotedList xs %************************************************************************ \begin{code} +intWithCommas :: Integral a => a -> SDoc +-- Prints a big integer with commas, eg 345,821 +intWithCommas n + | n < 0 = char '-' <> intWithCommas (-n) + | q == 0 = int (fromIntegral r) + | otherwise = intWithCommas q <> comma <> int (fromIntegral r) + where + (q,r) = n `quotRem` 1000 + -- | Converts an integer to a verbal index: -- -- > speakNth 1 = text "first" diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 0720eae113..93800b0399 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -1,17 +1,11 @@ % % (c) The University of Glasgow 2006 -% (c) The University of Glasgow 1992-2002 % \begin{code} -{-# OPTIONS -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details -- | Highly random utility functions +-- module Util ( -- * Flags dependent on the compiler build ghciSupported, debugIsOn, ncgDebugIsOn, @@ -21,13 +15,13 @@ module Util ( -- * General list processing zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal, zipLazy, stretchZipWith, - + unzipWith, - + mapFst, mapSnd, mapAndUnzip, mapAndUnzip3, nOfThem, filterOut, partitionWith, splitEithers, - + foldl1', foldl2, count, all2, lengthExceeds, lengthIs, lengthAtLeast, @@ -51,13 +45,13 @@ module Util ( nTimes, -- * Sorting - sortLe, sortWith, minWith, on, + sortLe, sortWith, minWith, on, -- * Comparisons isEqual, eqListBy, eqMaybeBy, thenCmp, cmpList, removeSpaces, - + -- * Edit distance fuzzyMatch, fuzzyLookup, @@ -219,9 +213,9 @@ nTimes n f = f . nTimes (n-1) f \end{code} \begin{code} -fstOf3 :: (a,b,c) -> a -sndOf3 :: (a,b,c) -> b -thirdOf3 :: (a,b,c) -> c +fstOf3 :: (a,b,c) -> a +sndOf3 :: (a,b,c) -> b +thirdOf3 :: (a,b,c) -> c fstOf3 (a,_,_) = a sndOf3 (_,b,_) = b thirdOf3 (_,_,c) = c @@ -760,7 +754,7 @@ restrictedDamerauLevenshteinDistanceWithLengths m n str1 str2 restrictedDamerauLevenshteinDistance' :: (Bits bv) => bv -> Int -> Int -> String -> String -> Int -restrictedDamerauLevenshteinDistance' _bv_dummy m n str1 str2 +restrictedDamerauLevenshteinDistance' _bv_dummy m n str1 str2 | [] <- str1 = n | otherwise = extractAnswer $ foldl' (restrictedDamerauLevenshteinDistanceWorker @@ -782,19 +776,19 @@ restrictedDamerauLevenshteinDistanceWorker str1_mvs top_bit_mask vector_mask (pm', d0', vp', vn', distance'') where pm' = IM.findWithDefault 0 (ord char2) str1_mvs - + d0' = ((((sizedComplement vector_mask d0) .&. pm') `shiftL` 1) .&. pm) .|. ((((pm' .&. vp) + vp) .&. vector_mask) `xor` vp) .|. pm' .|. vn -- No need to mask the shiftL because of the restricted range of pm hp' = vn .|. sizedComplement vector_mask (d0' .|. vp) hn' = d0' .&. vp - + hp'_shift = ((hp' `shiftL` 1) .|. 1) .&. vector_mask hn'_shift = (hn' `shiftL` 1) .&. vector_mask vp' = hn'_shift .|. sizedComplement vector_mask (d0' .|. hp'_shift) vn' = d0' .&. hp'_shift - + distance' = if hp' .&. top_bit_mask /= 0 then distance + 1 else distance distance'' = if hn' .&. top_bit_mask /= 0 then distance' - 1 else distance' @@ -843,16 +837,16 @@ fuzzyLookup user_entered possibilites poss_str user_entered , distance <= fuzzy_threshold ] where - -- Work out an approriate match threshold: - -- We report a candidate if its edit distance is <= the threshold, + -- Work out an approriate match threshold: + -- We report a candidate if its edit distance is <= the threshold, -- The threshhold is set to about a quarter of the # of characters the user entered - -- Length Threshold - -- 1 0 -- Don't suggest *any* candidates - -- 2 1 -- for single-char identifiers - -- 3 1 - -- 4 1 - -- 5 1 - -- 6 2 + -- Length Threshold + -- 1 0 -- Don't suggest *any* candidates + -- 2 1 -- for single-char identifiers + -- 3 1 + -- 4 1 + -- 5 1 + -- 6 2 -- fuzzy_threshold = truncate $ fromIntegral (length user_entered + 2) / (4 :: Rational) mAX_RESULTS = 3 @@ -1129,14 +1123,15 @@ abstractDataType n = mkDataType n [abstractConstr n] \begin{code} charToC :: Word8 -> String -charToC w = +charToC w = case chr (fromIntegral w) of - '\"' -> "\\\"" - '\'' -> "\\\'" - '\\' -> "\\\\" - c | c >= ' ' && c <= '~' -> [c] + '\"' -> "\\\"" + '\'' -> "\\\'" + '\\' -> "\\\\" + c | c >= ' ' && c <= '~' -> [c] | otherwise -> ['\\', chr (ord '0' + ord c `div` 64), chr (ord '0' + ord c `div` 8 `mod` 8), chr (ord '0' + ord c `mod` 8)] \end{code} + |