From 7b59db21fd85515f47d0cbc8712538559b25633e Mon Sep 17 00:00:00 2001 From: Herbert Valerio Riedel Date: Sat, 25 Oct 2014 16:11:21 +0200 Subject: `M-x delete-trailing-whitespace` & `M-x untabify` This removes all remaining tabs from `base`'s source code --- libraries/base/GHC/Arr.lhs | 16 +++++----- libraries/base/GHC/Exception.lhs | 8 ++--- libraries/base/GHC/Float.lhs | 6 ++-- libraries/base/GHC/IO/Buffer.hs | 22 +++++++------- libraries/base/GHC/IO/Encoding/Iconv.hs | 30 +++++++++---------- libraries/base/GHC/Num.lhs | 2 +- libraries/base/GHC/Real.lhs | 4 +-- libraries/base/GHC/TopHandler.lhs | 26 ++++++++--------- libraries/base/System/Mem/StableName.hs | 28 +++++++++--------- libraries/base/System/Mem/Weak.hs | 52 ++++++++++++++++----------------- libraries/base/Text/Show/Functions.hs | 6 ++-- 11 files changed, 100 insertions(+), 100 deletions(-) diff --git a/libraries/base/GHC/Arr.lhs b/libraries/base/GHC/Arr.lhs index 14bc917cca..2b30091b52 100644 --- a/libraries/base/GHC/Arr.lhs +++ b/libraries/base/GHC/Arr.lhs @@ -100,9 +100,9 @@ class (Ord a) => Ix a where -- Must specify one of index, unsafeIndex - -- 'index' is typically over-ridden in instances, with essentially - -- the same code, but using indexError instead of hopelessIndexError - -- Reason: we have 'Show' at the instances + -- 'index' is typically over-ridden in instances, with essentially + -- the same code, but using indexError instead of hopelessIndexError + -- Reason: we have 'Show' at the instances {-# INLINE index #-} -- See Note [Inlining index] index b i | inRange b i = unsafeIndex b i | otherwise = hopelessIndexError @@ -529,7 +529,7 @@ safeRangeSize (l,u) = let r = rangeSize (l, u) else r -- Don't inline this error message everywhere!! -negRange :: Int -- Uninformative, but Ix does not provide Show +negRange :: Int -- Uninformative, but Ix does not provide Show negRange = error "Negative range size" {-# INLINE[1] safeIndex #-} @@ -537,7 +537,7 @@ negRange = error "Negative range size" -- Inline *after* (!) so the rules can fire -- Make sure it is strict in n safeIndex :: Ix i => (i, i) -> Int -> i -> Int -safeIndex (l,u) n@(I# _) i +safeIndex (l,u) n@(I# _) i | (0 <= i') && (i' < n) = i' | otherwise = badSafeIndex i' n where @@ -633,9 +633,9 @@ adjust :: (e -> a -> e) -> MutableArray# s e -> (Int, a) -> STRep s b -> STRep s -- See NB on 'fill' adjust f marr# (I# i#, new) next = \s1# -> case readArray# marr# i# s1# of - (# s2#, old #) -> - case writeArray# marr# i# (f old new) s2# of - s3# -> next s3# + (# s2#, old #) -> + case writeArray# marr# i# (f old new) s2# of + s3# -> next s3# -- | Constructs an array identical to the first argument except that it has -- been updated by the associations in the right argument. diff --git a/libraries/base/GHC/Exception.lhs b/libraries/base/GHC/Exception.lhs index 540df31da1..e5bb0f9aaa 100644 --- a/libraries/base/GHC/Exception.lhs +++ b/libraries/base/GHC/Exception.lhs @@ -12,13 +12,13 @@ -- Module : GHC.Exception -- Copyright : (c) The University of Glasgow, 1998-2002 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC extensions) -- -- Exceptions and exception-handling functions. --- +-- ----------------------------------------------------------------------------- module GHC.Exception @@ -194,8 +194,8 @@ data ArithException deriving (Eq, Ord, Typeable) divZeroException, overflowException, ratioZeroDenomException :: SomeException -divZeroException = toException DivideByZero -overflowException = toException Overflow +divZeroException = toException DivideByZero +overflowException = toException Overflow ratioZeroDenomException = toException RatioZeroDenominator instance Exception ArithException diff --git a/libraries/base/GHC/Float.lhs b/libraries/base/GHC/Float.lhs index fcb9c169f3..dc2c1de087 100644 --- a/libraries/base/GHC/Float.lhs +++ b/libraries/base/GHC/Float.lhs @@ -742,7 +742,7 @@ floatToDigits base x = k1 = (lx * 8651) `quot` 28738 in if lx >= 0 then k1 + 1 else k1 else - -- f :: Integer, log :: Float -> Float, + -- f :: Integer, log :: Float -> Float, -- ceiling :: Float -> Int ceiling ((log (fromInteger (f+1) :: Float) + fromIntegral e * log (fromInteger b)) / @@ -1133,8 +1133,8 @@ word2Float (W# w) = F# (word2Float# w) "realToFrac/Float->Double" realToFrac = float2Double "realToFrac/Double->Float" realToFrac = double2Float "realToFrac/Double->Double" realToFrac = id :: Double -> Double -"realToFrac/Int->Double" realToFrac = int2Double -- See Note [realToFrac int-to-float] -"realToFrac/Int->Float" realToFrac = int2Float -- ..ditto +"realToFrac/Int->Double" realToFrac = int2Double -- See Note [realToFrac int-to-float] +"realToFrac/Int->Float" realToFrac = int2Float -- ..ditto #-} \end{code} diff --git a/libraries/base/GHC/IO/Buffer.hs b/libraries/base/GHC/IO/Buffer.hs index e0695552c8..77f1d99f46 100644 --- a/libraries/base/GHC/IO/Buffer.hs +++ b/libraries/base/GHC/IO/Buffer.hs @@ -7,7 +7,7 @@ -- Module : GHC.IO.Buffer -- Copyright : (c) The University of Glasgow 2008 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) @@ -179,11 +179,11 @@ charSize = 4 -- of the file. data Buffer e = Buffer { - bufRaw :: !(RawBuffer e), + bufRaw :: !(RawBuffer e), bufState :: BufferState, - bufSize :: !Int, -- in elements, not bytes - bufL :: !Int, -- offset of first item in the buffer - bufR :: !Int -- offset of last item + 1 + bufSize :: !Int, -- in elements, not bytes + bufL :: !Int, -- offset of first item in the buffer + bufR :: !Int -- offset of last item + 1 } #ifdef CHARBUF_UTF16 @@ -237,7 +237,7 @@ bufferAdd :: Int -> Buffer e -> Buffer e bufferAdd i buf@Buffer{ bufR=w } = buf{ bufR=w+i } emptyBuffer :: RawBuffer e -> Int -> BufferState -> Buffer e -emptyBuffer raw sz state = +emptyBuffer raw sz state = Buffer{ bufRaw=raw, bufState=state, bufR=0, bufL=0, bufSize=sz } newByteBuffer :: Int -> BufferState -> IO (Buffer Word8) @@ -270,7 +270,7 @@ summaryBuffer buf = "buf" ++ show (bufSize buf) ++ "(" ++ show (bufL buf) ++ "-" -- * r <= w -- * if r == w, and the buffer is for reading, then r == 0 && w == 0 -- * a write buffer is never full. If an operation --- fills up the buffer, it will always flush it before +-- fills up the buffer, it will always flush it before -- returning. -- * a read buffer may be full as a result of hLookAhead. In normal -- operation, a read buffer always has at least one character of space. @@ -278,10 +278,10 @@ summaryBuffer buf = "buf" ++ show (bufSize buf) ++ "(" ++ show (bufL buf) ++ "-" checkBuffer :: Buffer a -> IO () checkBuffer buf@Buffer{ bufState = state, bufL=r, bufR=w, bufSize=size } = do check buf ( - size > 0 - && r <= w - && w <= size - && ( r /= w || state == WriteBuffer || (r == 0 && w == 0) ) + size > 0 + && r <= w + && w <= size + && ( r /= w || state == WriteBuffer || (r == 0 && w == 0) ) && ( state /= WriteBuffer || w < size ) -- write buffer is never full ) diff --git a/libraries/base/GHC/IO/Encoding/Iconv.hs b/libraries/base/GHC/IO/Encoding/Iconv.hs index 2ae6146317..892f84498e 100644 --- a/libraries/base/GHC/IO/Encoding/Iconv.hs +++ b/libraries/base/GHC/IO/Encoding/Iconv.hs @@ -10,7 +10,7 @@ -- Module : GHC.IO.Encoding.Iconv -- Copyright : (c) The University of Glasgow, 2008-2009 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : libraries@haskell.org -- Stability : internal -- Portability : non-portable @@ -78,7 +78,7 @@ foreign import ccall unsafe "hs_iconv_close" foreign import ccall unsafe "hs_iconv" hs_iconv :: IConv -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize - -> IO CSize + -> IO CSize foreign import ccall unsafe "localeEncoding" c_localeEncoding :: IO CString @@ -101,10 +101,10 @@ iconvEncoding = mkIconvEncoding ErrorOnCodingFailure mkIconvEncoding :: CodingFailureMode -> String -> IO TextEncoding mkIconvEncoding cfm charset = do - return (TextEncoding { + return (TextEncoding { textEncodingName = charset, - mkTextDecoder = newIConv raw_charset (haskellChar ++ suffix) (recoverDecode cfm) iconvDecode, - mkTextEncoder = newIConv haskellChar charset (recoverEncode cfm) iconvEncode}) + mkTextDecoder = newIConv raw_charset (haskellChar ++ suffix) (recoverDecode cfm) iconvDecode, + mkTextEncoder = newIConv haskellChar charset (recoverEncode cfm) iconvEncode}) where -- An annoying feature of GNU iconv is that the //PREFIXES only take -- effect when they appear on the tocode parameter to iconv_open: @@ -135,7 +135,7 @@ iconvDecode iconv_t ibuf obuf = iconvRecode iconv_t ibuf 0 obuf char_shift iconvEncode :: IConv -> EncodeBuffer iconvEncode iconv_t ibuf obuf = iconvRecode iconv_t ibuf char_shift obuf 0 -iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int +iconvRecode :: IConv -> Buffer a -> Int -> Buffer b -> Int -> IO (CodingProgress, Buffer a, Buffer b) iconvRecode iconv_t input@Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } iscale @@ -153,20 +153,20 @@ iconvRecode iconv_t res <- hs_iconv iconv_t p_inbuf p_inleft p_outbuf p_outleft new_inleft <- peek p_inleft new_outleft <- peek p_outleft - let - new_inleft' = fromIntegral new_inleft `shiftR` iscale - new_outleft' = fromIntegral new_outleft `shiftR` oscale - new_input + let + new_inleft' = fromIntegral new_inleft `shiftR` iscale + new_outleft' = fromIntegral new_outleft `shiftR` oscale + new_input | new_inleft == 0 = input { bufL = 0, bufR = 0 } - | otherwise = input { bufL = iw - new_inleft' } - new_output = output{ bufR = os - new_outleft' } + | otherwise = input { bufL = iw - new_inleft' } + new_output = output{ bufR = os - new_outleft' } iconv_trace ("iconv res=" ++ show res) iconv_trace ("iconvRecode after, input=" ++ show (summaryBuffer new_input)) iconv_trace ("iconvRecode after, output=" ++ show (summaryBuffer new_output)) if (res /= -1) - then do -- all input translated - return (InputUnderflow, new_input, new_output) - else do + then do -- all input translated + return (InputUnderflow, new_input, new_output) + else do errno <- getErrno case errno of e | e == e2BIG -> return (OutputUnderflow, new_input, new_output) diff --git a/libraries/base/GHC/Num.lhs b/libraries/base/GHC/Num.lhs index 5cdf782a41..4e0bef2972 100644 --- a/libraries/base/GHC/Num.lhs +++ b/libraries/base/GHC/Num.lhs @@ -93,7 +93,7 @@ instance Num Int where | n `eqInt` 0 = 0 | otherwise = 1 - {-# INLINE fromInteger #-} -- Just to be sure! + {-# INLINE fromInteger #-} -- Just to be sure! fromInteger i = I# (integerToInt i) \end{code} diff --git a/libraries/base/GHC/Real.lhs b/libraries/base/GHC/Real.lhs index 481125aa93..9b5c5d8463 100644 --- a/libraries/base/GHC/Real.lhs +++ b/libraries/base/GHC/Real.lhs @@ -241,10 +241,10 @@ These 'numeric' enumerations come straight from the Report \begin{code} numericEnumFrom :: (Fractional a) => a -> [a] -numericEnumFrom n = n `seq` (n : numericEnumFrom (n + 1)) +numericEnumFrom n = n `seq` (n : numericEnumFrom (n + 1)) numericEnumFromThen :: (Fractional a) => a -> a -> [a] -numericEnumFromThen n m = n `seq` m `seq` (n : numericEnumFromThen m (m+m-n)) +numericEnumFromThen n m = n `seq` m `seq` (n : numericEnumFromThen m (m+m-n)) numericEnumFromTo :: (Ord a, Fractional a) => a -> a -> [a] numericEnumFromTo n m = takeWhile (<= m + 1/2) (numericEnumFrom n) diff --git a/libraries/base/GHC/TopHandler.lhs b/libraries/base/GHC/TopHandler.lhs index cdca26205c..52ac6c8eb8 100644 --- a/libraries/base/GHC/TopHandler.lhs +++ b/libraries/base/GHC/TopHandler.lhs @@ -12,7 +12,7 @@ -- Module : GHC.TopHandler -- Copyright : (c) The University of Glasgow, 2001-2002 -- License : see libraries/base/LICENSE --- +-- -- Maintainer : cvs-ghc@haskell.org -- Stability : internal -- Portability : non-portable (GHC Extensions) @@ -55,12 +55,12 @@ import Data.Dynamic (toDyn) -- called in the program). It catches otherwise uncaught exceptions, -- and also flushes stdout\/stderr before exiting. runMainIO :: IO a -> IO a -runMainIO main = - do +runMainIO main = + do main_thread_id <- myThreadId weak_tid <- mkWeakThreadId main_thread_id install_interrupt_handler $ do - m <- deRefWeak weak_tid + m <- deRefWeak weak_tid case m of Nothing -> return () Just tid -> throwTo tid (toException UserInterrupt) @@ -72,7 +72,7 @@ install_interrupt_handler :: IO () -> IO () #ifdef mingw32_HOST_OS install_interrupt_handler handler = do _ <- GHC.ConsoleHandler.installHandler $ - Catch $ \event -> + Catch $ \event -> case event of ControlC -> handler Break -> handler @@ -93,10 +93,10 @@ install_interrupt_handler handler = do foreign import ccall unsafe stg_sig_install - :: CInt -- sig no. - -> CInt -- action code (STG_SIG_HAN etc.) - -> Ptr () -- (in, out) blocked - -> IO CInt -- (ret) old action code + :: CInt -- sig no. + -> CInt -- action code (STG_SIG_HAN etc.) + -> Ptr () -- (in, out) blocked + -> IO CInt -- (ret) old action code #endif -- | 'runIO' is wrapped around every @foreign export@ and @foreign @@ -112,7 +112,7 @@ runIO main = catch main topHandler -- we don't shut down the system cleanly, we just exit. This is -- useful in some cases, because the safe exit version will give other -- threads a chance to clean up first, which might shut down the --- system in a different way. For example, try +-- system in a different way. For example, try -- -- main = forkIO (runIO (exitWith (ExitFailure 1))) >> threadDelay 10000 -- @@ -135,7 +135,7 @@ topHandler :: SomeException -> IO a topHandler err = catch (real_handler safeExit err) topHandler topHandlerFastExit :: SomeException -> IO a -topHandlerFastExit err = +topHandlerFastExit err = catchException (real_handler fastExit err) topHandlerFastExit -- Make sure we handle errors while reporting the error! @@ -165,7 +165,7 @@ real_handler exit se = do | Errno ioe == ePIPE, hdl == stdout -> exit 0 _ -> do reportError se exit 1 - + -- try to flush stdout/stderr, but don't worry if we fail -- (these handles might have errors, and we don't want to go into @@ -204,7 +204,7 @@ foreign import ccall "shutdownHaskellAndSignal" #endif exitInterrupted :: IO a -exitInterrupted = +exitInterrupted = #ifdef mingw32_HOST_OS safeExit 252 #else diff --git a/libraries/base/System/Mem/StableName.hs b/libraries/base/System/Mem/StableName.hs index f2baaf3e83..9da42e516e 100644 --- a/libraries/base/System/Mem/StableName.hs +++ b/libraries/base/System/Mem/StableName.hs @@ -11,14 +11,14 @@ -- Module : System.Mem.StableName -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable -- -- Stable names are a way of performing fast (O(1)), not-quite-exact -- comparison between objects. --- +-- -- Stable names solve the following problem: suppose you want to build -- a hash table with Haskell objects as keys, but you want to use -- pointer equality for comparison; maybe because the keys are large @@ -41,8 +41,8 @@ module System.Mem.StableName ( import Data.Typeable import GHC.IO ( IO(..) ) -import GHC.Base ( Int(..), StableName#, makeStableName# - , eqStableName#, stableNameToInt# ) +import GHC.Base ( Int(..), StableName#, makeStableName# + , eqStableName#, stableNameToInt# ) ----------------------------------------------------------------------------- -- Stable Names @@ -53,7 +53,7 @@ import GHC.Base ( Int(..), StableName#, makeStableName# Stable names have the following property: * If @sn1 :: StableName@ and @sn2 :: StableName@ and @sn1 == sn2@ - then @sn1@ and @sn2@ were created by calls to @makeStableName@ on + then @sn1@ and @sn2@ were created by calls to @makeStableName@ on the same object. The reverse is not necessarily true: if two stable names are not @@ -82,7 +82,7 @@ data StableName a = StableName (StableName# a) -- the first argument is not evaluated by 'makeStableName'. makeStableName :: a -> IO (StableName a) #if defined(__PARALLEL_HASKELL__) -makeStableName a = +makeStableName a = error "makeStableName not implemented in parallel Haskell" #else makeStableName a = IO $ \ s -> @@ -95,21 +95,21 @@ makeStableName a = IO $ \ s -> -- of 'hashStableName' makes a good hash key). hashStableName :: StableName a -> Int #if defined(__PARALLEL_HASKELL__) -hashStableName (StableName sn) = +hashStableName (StableName sn) = error "hashStableName not implemented in parallel Haskell" #else hashStableName (StableName sn) = I# (stableNameToInt# sn) #endif -instance Eq (StableName a) where +instance Eq (StableName a) where #if defined(__PARALLEL_HASKELL__) - (StableName sn1) == (StableName sn2) = + (StableName sn1) == (StableName sn2) = error "eqStableName not implemented in parallel Haskell" #else - (StableName sn1) == (StableName sn2) = + (StableName sn1) == (StableName sn2) = case eqStableName# sn1 sn2 of - 0# -> False - _ -> True + 0# -> False + _ -> True #endif -- | Equality on 'StableName' that does not require that the types of @@ -119,8 +119,8 @@ instance Eq (StableName a) where eqStableName :: StableName a -> StableName b -> Bool eqStableName (StableName sn1) (StableName sn2) = case eqStableName# sn1 sn2 of - 0# -> False - _ -> True + 0# -> False + _ -> True -- Requested by Emil Axelsson on glasgow-haskell-users, who wants to -- use it for implementing observable sharing. diff --git a/libraries/base/System/Mem/Weak.hs b/libraries/base/System/Mem/Weak.hs index fc69019e65..b9580b5588 100644 --- a/libraries/base/System/Mem/Weak.hs +++ b/libraries/base/System/Mem/Weak.hs @@ -5,7 +5,7 @@ -- Module : System.Mem.Weak -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable @@ -16,9 +16,9 @@ -- object. A weak pointer can be de-referenced to find out -- whether the object it refers to is still alive or not, and if so -- to return the object itself. --- +-- -- Weak pointers are particularly useful for caches and memo tables. --- To build a memo table, you build a data structure +-- To build a memo table, you build a data structure -- mapping from the function argument (the key) to its result (the -- value). When you apply the function to a new argument you first -- check whether the key\/value pair is already in the memo table. @@ -26,47 +26,47 @@ -- key and value alive. So the table should contain a weak pointer -- to the key, not an ordinary pointer. The pointer to the value must -- not be weak, because the only reference to the value might indeed be --- from the memo table. --- +-- from the memo table. +-- -- So it looks as if the memo table will keep all its values -- alive for ever. One way to solve this is to purge the table -- occasionally, by deleting entries whose keys have died. --- +-- -- The weak pointers in this library -- support another approach, called /finalization/. -- When the key referred to by a weak pointer dies, the storage manager -- arranges to run a programmer-specified finalizer. In the case of memo -- tables, for example, the finalizer could remove the key\/value pair --- from the memo table. --- +-- from the memo table. +-- -- Another difficulty with the memo table is that the value of a -- key\/value pair might itself contain a pointer to the key. -- So the memo table keeps the value alive, which keeps the key alive, -- even though there may be no other references to the key so both should --- die. The weak pointers in this library provide a slight +-- die. The weak pointers in this library provide a slight -- generalisation of the basic weak-pointer idea, in which each -- weak pointer actually contains both a key and a value. -- ----------------------------------------------------------------------------- module System.Mem.Weak ( - -- * The @Weak@ type - Weak, -- abstract - - -- * The general interface - mkWeak, - deRefWeak, - finalize, - - -- * Specialised versions - mkWeakPtr, - addFinalizer, - mkWeakPair, - -- replaceFinaliser - - -- * A precise semantics - - -- $precise + -- * The @Weak@ type + Weak, -- abstract + + -- * The general interface + mkWeak, + deRefWeak, + finalize, + + -- * Specialised versions + mkWeakPtr, + addFinalizer, + mkWeakPair, + -- replaceFinaliser + + -- * A precise semantics + + -- $precise ) where import GHC.Weak diff --git a/libraries/base/Text/Show/Functions.hs b/libraries/base/Text/Show/Functions.hs index 7d3f110a32..690b203ea3 100644 --- a/libraries/base/Text/Show/Functions.hs +++ b/libraries/base/Text/Show/Functions.hs @@ -7,7 +7,7 @@ -- Module : Text.Show.Functions -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable @@ -15,12 +15,12 @@ -- Optional instance of 'Text.Show.Show' for functions: -- -- > instance Show (a -> b) where --- > showsPrec _ _ = showString \"\\" +-- > showsPrec _ _ = showString \"\\" -- ----------------------------------------------------------------------------- module Text.Show.Functions () where instance Show (a -> b) where - showsPrec _ _ = showString "" + showsPrec _ _ = showString "" -- cgit v1.2.1