diff options
author | Herbert Valerio Riedel <hvr@gnu.org> | 2014-08-31 16:05:26 +0200 |
---|---|---|
committer | Herbert Valerio Riedel <hvr@gnu.org> | 2014-08-31 16:09:25 +0200 |
commit | 737f36823d03a6c9d92f56e3e2433a3961780e13 (patch) | |
tree | 251c4655db37e898ac10a31ac37735e0cb1bcd9a | |
parent | a8a969ae7a05e408b29961d0a2ea621a16d73d3e (diff) | |
download | haskell-737f36823d03a6c9d92f56e3e2433a3961780e13.tar.gz |
`M-x delete-trailing-whitespace` & `M-x untabify`...
...some files more or less recently touched by me
[ci skip]
-rw-r--r-- | compiler/cmm/PprC.hs | 2 | ||||
-rw-r--r-- | compiler/coreSyn/MkCore.lhs | 109 | ||||
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 14 | ||||
-rw-r--r-- | compiler/main/DynFlags.hs | 4 | ||||
-rw-r--r-- | compiler/nativeGen/X86/Instr.hs | 4 | ||||
-rw-r--r-- | compiler/prelude/PrelNames.lhs | 5 | ||||
-rw-r--r-- | ghc/InteractiveUI.hs | 11 | ||||
-rw-r--r-- | ghc/Main.hs | 2 | ||||
-rw-r--r-- | libraries/base/Data/Bits.hs | 7 | ||||
-rw-r--r-- | libraries/base/Data/Fixed.hs | 3 | ||||
-rw-r--r-- | libraries/base/GHC/Int.hs | 8 | ||||
-rw-r--r-- | libraries/base/Prelude.hs | 2 |
12 files changed, 83 insertions, 88 deletions
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 58042f761a..c25147cd82 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -606,7 +606,7 @@ pprMachOp_for_C mop = case mop of MO_SF_Conv _from to -> parens (machRep_F_CType to) MO_FS_Conv _from to -> parens (machRep_S_CType to) - + MO_S_MulMayOflo _ -> pprTrace "offending mop:" (ptext $ sLit "MO_S_MulMayOflo") (panic $ "PprC.pprMachOp_for_C: MO_S_MulMayOflo" diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs index 08c3eedc53..012306abd5 100644 --- a/compiler/coreSyn/MkCore.lhs +++ b/compiler/coreSyn/MkCore.lhs @@ -15,7 +15,7 @@ module MkCore ( mkCoreLams, mkWildCase, mkIfThenElse, mkWildValBinder, mkWildEvBinder, sortQuantVars, castBottomExpr, - + -- * Constructing boxed literals mkWordExpr, mkWordExprWord, mkIntExpr, mkIntExprInt, @@ -32,29 +32,29 @@ module MkCore ( -- * Constructing general big tuples -- $big_tuples mkChunkified, - + -- * Constructing small tuples - mkCoreVarTup, mkCoreVarTupTy, mkCoreTup, - + mkCoreVarTup, mkCoreVarTupTy, mkCoreTup, + -- * Constructing big tuples mkBigCoreVarTup, mkBigCoreVarTupTy, mkBigCoreTup, mkBigCoreTupTy, - + -- * Deconstructing small tuples mkSmallTupleSelector, mkSmallTupleCase, - + -- * Deconstructing big tuples mkTupleSelector, mkTupleCase, - + -- * Constructing list expressions - mkNilExpr, mkConsExpr, mkListExpr, + mkNilExpr, mkConsExpr, mkListExpr, mkFoldrExpr, mkBuildExpr, - -- * Error Ids - mkRuntimeErrorApp, mkImpossibleExpr, errorIds, - rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID, - nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, - pAT_ERROR_ID, eRROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID, + -- * Error Ids + mkRuntimeErrorApp, mkImpossibleExpr, errorIds, + rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID, + nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, + pAT_ERROR_ID, eRROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID, uNDEFINED_ID, undefinedName ) where @@ -71,14 +71,14 @@ import HscTypes import TysWiredIn import PrelNames -import TcType ( mkSigmaTy ) +import TcType ( mkSigmaTy ) import Type import Coercion import TysPrim import DataCon ( DataCon, dataConWorkId ) -import IdInfo ( vanillaIdInfo, setStrictnessInfo, +import IdInfo ( vanillaIdInfo, setStrictnessInfo, setArityInfo ) -import Demand +import Demand import Name hiding ( varName ) import Outputable import FastString @@ -107,7 +107,7 @@ infixl 4 `mkCoreApp`, `mkCoreApps` \begin{code} sortQuantVars :: [Var] -> [Var] --- Sort the variables (KindVars, TypeVars, and Ids) +-- Sort the variables (KindVars, TypeVars, and Ids) -- into order: Kind, then Type, then Id sortQuantVars = sortBy (comparing withCategory) where @@ -175,20 +175,20 @@ mk_val_app fun arg arg_ty _ -- See Note [CoreSyn let/app invariant] mk_val_app fun arg arg_ty res_ty = Case arg arg_id res_ty [(DEFAULT,[],App fun (Var arg_id))] where - arg_id = mkWildValBinder arg_ty - -- Lots of shadowing, but it doesn't matter, + arg_id = mkWildValBinder arg_ty + -- Lots of shadowing, but it doesn't matter, -- because 'fun ' should not have a free wild-id - -- - -- This is Dangerous. But this is the only place we play this - -- game, mk_val_app returns an expression that does not have - -- have a free wild-id. So the only thing that can go wrong - -- is if you take apart this case expression, and pass a - -- fragmet of it as the fun part of a 'mk_val_app'. + -- + -- This is Dangerous. But this is the only place we play this + -- game, mk_val_app returns an expression that does not have + -- have a free wild-id. So the only thing that can go wrong + -- is if you take apart this case expression, and pass a + -- fragmet of it as the fun part of a 'mk_val_app'. mkWildEvBinder :: PredType -> EvVar mkWildEvBinder pred = mkWildValBinder pred --- | Make a /wildcard binder/. This is typically used when you need a binder +-- | Make a /wildcard binder/. This is typically used when you need a binder -- that you expect to use only at a *binding* site. Do not use it at -- occurrence sites because it has a single, fixed unique, and it's very -- easy to get into difficulties with shadowing. That's why it is used so little. @@ -199,18 +199,18 @@ mkWildValBinder ty = mkLocalId wildCardName ty mkWildCase :: CoreExpr -> Type -> Type -> [CoreAlt] -> CoreExpr -- Make a case expression whose case binder is unused -- The alts should not have any occurrences of WildId -mkWildCase scrut scrut_ty res_ty alts +mkWildCase scrut scrut_ty res_ty alts = Case scrut (mkWildValBinder scrut_ty) res_ty alts mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr mkIfThenElse guard then_expr else_expr -- Not going to be refining, so okay to take the type of the "then" clause - = mkWildCase guard boolTy (exprType then_expr) - [ (DataAlt falseDataCon, [], else_expr), -- Increasing order of tag! - (DataAlt trueDataCon, [], then_expr) ] + = mkWildCase guard boolTy (exprType then_expr) + [ (DataAlt falseDataCon, [], else_expr), -- Increasing order of tag! + (DataAlt trueDataCon, [], then_expr) ] castBottomExpr :: CoreExpr -> Type -> CoreExpr --- (castBottomExpr e ty), assuming that 'e' diverges, +-- (castBottomExpr e ty), assuming that 'e' diverges, -- return an expression of type 'ty' -- See Note [Empty case alternatives] in CoreSyn castBottomExpr e res_ty @@ -348,7 +348,7 @@ mkChunkified :: ([a] -> a) -- ^ \"Small\" constructor function, of maximum -> a -- ^ Constructed thing made possible by recursive decomposition mkChunkified small_tuple as = mk_big_tuple (chunkify as) where - -- Each sub-list is short enough to fit in a tuple + -- Each sub-list is short enough to fit in a tuple mk_big_tuple [as] = small_tuple as mk_big_tuple as_s = mk_big_tuple (chunkify (map small_tuple as_s)) @@ -357,23 +357,23 @@ chunkify :: [a] -> [[a]] -- tuple arity. The sub-lists of the result all have length <= 'mAX_TUPLE_SIZE' -- But there may be more than 'mAX_TUPLE_SIZE' sub-lists chunkify xs - | n_xs <= mAX_TUPLE_SIZE = [xs] - | otherwise = split xs + | n_xs <= mAX_TUPLE_SIZE = [xs] + | otherwise = split xs where n_xs = length xs split [] = [] split xs = take mAX_TUPLE_SIZE xs : split (drop mAX_TUPLE_SIZE xs) - + \end{code} -Creating tuples and their types for Core expressions +Creating tuples and their types for Core expressions -@mkBigCoreVarTup@ builds a tuple; the inverse to @mkTupleSelector@. +@mkBigCoreVarTup@ builds a tuple; the inverse to @mkTupleSelector@. * If it has only one element, it is the identity function. -* If there are more elements than a big tuple can have, it nests - the tuples. +* If there are more elements than a big tuple can have, it nests + the tuples. \begin{code} @@ -457,14 +457,14 @@ mkTupleSelector :: [Id] -- ^ The 'Id's to pattern match the tuple agains -> CoreExpr -- ^ Selector expression -- mkTupleSelector [a,b,c,d] b v e --- = case e of v { +-- = case e of v { -- (p,q) -> case p of p { -- (a,b) -> b }} -- We use 'tpl' vars for the p,q, since shadowing does not matter. -- -- In fact, it's more convenient to generate it innermost first, getting -- --- case (case e of v +-- case (case e of v -- (p,q) -> p) of p -- (a,b) -> b mkTupleSelector vars the_var scrut_var scrut @@ -526,12 +526,12 @@ mkTupleCase uniqs vars body scrut_var scrut -- This is the case where don't need any nesting mk_tuple_case _ [vars] body = mkSmallTupleCase vars body scrut_var scrut - + -- This is the case where we must make nest tuples at least once mk_tuple_case us vars_s body = let (us', vars', body') = foldr one_tuple_case (us, [], body) vars_s in mk_tuple_case us' (chunkify vars') body' - + one_tuple_case chunk_vars (us, vs, body) = let (uniq, us') = takeUniqFromSupply us scrut_var = mkSysLocal (fsLit "ds") uniq @@ -589,7 +589,7 @@ mkFoldrExpr :: MonadThings m -> m CoreExpr mkFoldrExpr elt_ty result_ty c n list = do foldr_id <- lookupId foldrName - return (Var foldr_id `App` Type elt_ty + return (Var foldr_id `App` Type elt_ty `App` Type result_ty `App` c `App` n @@ -607,9 +607,9 @@ mkBuildExpr elt_ty mk_build_inside = do let n_ty = mkTyVarTy n_tyvar c_ty = mkFunTys [elt_ty, n_ty] n_ty [c, n] <- sequence [mkSysLocalM (fsLit "c") c_ty, mkSysLocalM (fsLit "n") n_ty] - + build_inside <- mk_build_inside (c, c_ty) (n, n_ty) - + build_id <- lookupId buildName return $ Var build_id `App` Type elt_ty `App` mkLams [n_tyvar, c, n] build_inside where @@ -626,14 +626,14 @@ mkBuildExpr elt_ty mk_build_inside = do %************************************************************************ \begin{code} -mkRuntimeErrorApp +mkRuntimeErrorApp :: Id -- Should be of type (forall a. Addr# -> a) -- where Addr# points to a UTF8 encoded string -> Type -- The type to instantiate 'a' -> String -- The string to print -> CoreExpr -mkRuntimeErrorApp err_id res_ty err_msg +mkRuntimeErrorApp err_id res_ty err_msg = mkApps (Var err_id) [Type res_ty, err_string] where err_string = Lit (mkMachString err_msg) @@ -666,7 +666,7 @@ templates, but we don't ever expect to generate code for it. \begin{code} errorIds :: [Id] -errorIds +errorIds = [ eRROR_ID, -- This one isn't used anywhere else in the compiler -- But we still need it in wiredInIds so that when GHC -- compiles a program that mentions 'error' we don't @@ -698,7 +698,7 @@ patErrorName = err_nm "patError" patErrorIdKey pAT_ERROR_ID noMethodBindingErrorName = err_nm "noMethodBindingError" noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID -nonExhaustiveGuardsErrorName = err_nm "nonExhaustiveGuardsError" +nonExhaustiveGuardsErrorName = err_nm "nonExhaustiveGuardsError" nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID err_nm :: String -> Unique -> Id -> Name @@ -746,11 +746,11 @@ undefinedTy = mkSigmaTy [openAlphaTyVar] [] openAlphaTy Note [Error and friends have an "open-tyvar" forall] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -'error' and 'undefined' have types +'error' and 'undefined' have types error :: forall (a::OpenKind). String -> a undefined :: forall (a::OpenKind). a Notice the 'OpenKind' (manifested as openAlphaTyVar in the code). This ensures that -"error" can be instantiated at +"error" can be instantiated at * unboxed as well as boxed types * polymorphic types This is OK because it never returns, so the return type is irrelevant. @@ -770,8 +770,8 @@ pc_bottoming_Id1 name ty = mkVanillaGlobalWithInfo name ty bottoming_info where bottoming_info = vanillaIdInfo `setStrictnessInfo` strict_sig - `setArityInfo` 1 - -- Make arity and strictness agree + `setArityInfo` 1 + -- Make arity and strictness agree -- Do *not* mark them as NoCafRefs, because they can indeed have -- CAF refs. For example, pAT_ERROR_ID calls GHC.Err.untangle, @@ -793,4 +793,3 @@ pc_bottoming_Id0 name ty bottoming_info = vanillaIdInfo `setStrictnessInfo` strict_sig strict_sig = mkClosedStrictSig [] botRes \end{code} - diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index c4c24461d5..a8869d10ed 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -282,7 +282,7 @@ genCall t@(PrimTarget op) [] args' -- than a direct constant (i.e. 'i32 8') as the alignment argument for the -- memcpy & co llvm intrinsic functions. So we handle this directly now. extractLit (CmmLit (CmmInt i _)) = mkIntLit i32 i - extractLit _other = trace ("WARNING: Non constant alignment value given" ++ + extractLit _other = trace ("WARNING: Non constant alignment value given" ++ " for memcpy! Please report to GHC developers") mkIntLit i32 0 @@ -986,10 +986,10 @@ genMachOp _ op [x] = case op of MO_Shl _ -> panicOp MO_U_Shr _ -> panicOp MO_S_Shr _ -> panicOp - + MO_V_Insert _ _ -> panicOp MO_V_Extract _ _ -> panicOp - + MO_V_Add _ _ -> panicOp MO_V_Sub _ _ -> panicOp MO_V_Mul _ _ -> panicOp @@ -999,7 +999,7 @@ genMachOp _ op [x] = case op of MO_VU_Quot _ _ -> panicOp MO_VU_Rem _ _ -> panicOp - + MO_VF_Insert _ _ -> panicOp MO_VF_Extract _ _ -> panicOp @@ -1038,7 +1038,7 @@ genMachOp _ op [x] = case op of w | w < toWidth -> sameConv' expand w | w > toWidth -> sameConv' reduce _w -> return x' - + panicOp = panic $ "LLVM.CodeGen.genMachOp: non unary op encountered" ++ "with one argument! (" ++ show op ++ ")" @@ -1116,7 +1116,7 @@ genMachOp_slow _ (MO_VF_Insert l w) [val, elt, idx] = do top1 ++ top2 ++ top3) where ty = LMVector l (widthToLlvmFloat w) - + -- Binary MachOp genMachOp_slow opt op [x, y] = case op of @@ -1175,7 +1175,7 @@ genMachOp_slow opt op [x, y] = case op of MO_VU_Quot l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_UDiv MO_VU_Rem l w -> genCastBinMach (LMVector l (widthToLlvmInt w)) LM_MO_URem - + MO_VF_Add l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FAdd MO_VF_Sub l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FSub MO_VF_Mul l w -> genCastBinMach (LMVector l (widthToLlvmFloat w)) LM_MO_FMul diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0d4347df4e..5d0e2a2b94 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -2905,7 +2905,7 @@ xFlags = [ deprecatedForExtension "MultiParamTypeClasses" ), ( "FunctionalDependencies", Opt_FunctionalDependencies, nop ), ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, setGenDeriving ), - ( "OverlappingInstances", Opt_OverlappingInstances, + ( "OverlappingInstances", Opt_OverlappingInstances, \ turn_on -> when turn_on $ deprecate "instead use per-instance pragmas OVERLAPPING/OVERLAPPABLE/OVERLAPS" ), ( "UndecidableInstances", Opt_UndecidableInstances, nop ), @@ -2996,7 +2996,7 @@ impliedFlags , (Opt_ImplicitParams, turnOn, Opt_FlexibleInstances) , (Opt_JavaScriptFFI, turnOn, Opt_InterruptibleFFI) - + , (Opt_DeriveTraversable, turnOn, Opt_DeriveFunctor) , (Opt_DeriveTraversable, turnOn, Opt_DeriveFoldable) ] diff --git a/compiler/nativeGen/X86/Instr.hs b/compiler/nativeGen/X86/Instr.hs index a43d42ec2a..7d382455d9 100644 --- a/compiler/nativeGen/X86/Instr.hs +++ b/compiler/nativeGen/X86/Instr.hs @@ -955,10 +955,10 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do alloc = mkStackAllocInstr platform delta dealloc = mkStackDeallocInstr platform delta - + new_blockmap :: BlockEnv BlockId new_blockmap = mapFromList (zip entries (map mkBlockId uniqs)) - + insert_stack_insns (BasicBlock id insns) | Just new_blockid <- mapLookup id new_blockmap = [ BasicBlock id [alloc, JXX ALWAYS new_blockid] diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index 5757ba1234..ed6fa3f791 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -81,7 +81,7 @@ This is accomplished through a combination of mechanisms: This is accomplished through a variety of mechanisms: - a) The parser recognises them specially and generates an + a) The parser recognises them specially and generates an Exact Name (hence not looked up in the orig-name cache) b) The known infinite families of names are specially @@ -137,7 +137,7 @@ import FastString \begin{code} allNameStrings :: [String] -- Infinite list of a,b,c...z, aa, ab, ac, ... etc -allNameStrings = [ c:cs | cs <- "" : allNameStrings, c <- ['a'..'z'] ] +allNameStrings = [ c:cs | cs <- "" : allNameStrings, c <- ['a'..'z'] ] \end{code} @@ -1898,4 +1898,3 @@ derivableClassKeys = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey, boundedClassKey, showClassKey, readClassKey ] \end{code} - diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 3d871d9d1d..070932cefc 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -35,7 +35,7 @@ import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..), TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc, handleSourceError ) import HsImpExp -import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC, +import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC, setInteractivePrintName ) import Module import Name @@ -384,7 +384,6 @@ interactiveUI config srcs maybe_exprs = do _ <- GHC.setProgramDynFlags $ progDynFlags { log_action = ghciLogAction lastErrLocationsRef } - liftIO $ when (isNothing maybe_exprs) $ do -- Only for GHCi (not runghc and ghc -e): @@ -427,7 +426,7 @@ interactiveUI config srcs maybe_exprs = do long_help = fullHelpText config, lastErrorLocations = lastErrLocationsRef } - + return () resetLastErrorLocations :: GHCi () @@ -696,7 +695,7 @@ installInteractivePrint Nothing _ = return () installInteractivePrint (Just ipFun) exprmode = do ok <- trySuccess $ do (name:_) <- GHC.parseName ipFun - modifySession (\he -> let new_ic = setInteractivePrintName (hsc_IC he) name + modifySession (\he -> let new_ic = setInteractivePrintName (hsc_IC he) name in he{hsc_IC = new_ic}) return Succeeded @@ -1838,7 +1837,7 @@ restoreContextOnFailure do_this = do checkAdd :: InteractiveImport -> GHCi () checkAdd ii = do - dflags <- getDynFlags + dflags <- getDynFlags let safe = safeLanguageOn dflags case ii of IIModule modname @@ -3136,7 +3135,7 @@ expandPathIO p = tilde <- getHomeDirectory -- will fail if HOME not defined return (tilde ++ '/':d) other -> - return other + return other sameFile :: FilePath -> FilePath -> IO Bool sameFile path1 path2 = do diff --git a/ghc/Main.hs b/ghc/Main.hs index 8746125450..e6ff043bf0 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -837,7 +837,7 @@ unknownFlagsErr fs = throwGhcException $ UsageError $ concatMap oneError fs "unrecognised flag: " ++ f ++ "\n" ++ (case fuzzyMatch f (nub allFlags) of [] -> "" - suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) + suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) {- Note [-Bsymbolic and hooks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs index a751176441..532f5d5617 100644 --- a/libraries/base/Data/Bits.hs +++ b/libraries/base/Data/Bits.hs @@ -445,7 +445,7 @@ instance Bits Int where (I# x#) `shiftR` (I# i#) = I# (x# `iShiftRA#` i#) (I# x#) `unsafeShiftR` (I# i#) = I# (x# `uncheckedIShiftRA#` i#) - {-# INLINE rotate #-} -- See Note [Constant folding for rotate] + {-# INLINE rotate #-} -- See Note [Constant folding for rotate] (I# x#) `rotate` (I# i#) = I# ((x# `uncheckedIShiftL#` i'#) `orI#` (x# `uncheckedIShiftRL#` (wsib -# i'#))) where @@ -520,8 +520,8 @@ instance Bits Integer where bitSize _ = error "Data.Bits.bitSize(Integer)" isSigned _ = True -{- Note [Constant folding for rotate] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [Constant folding for rotate] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The INLINE on the Int instance of rotate enables it to be constant folded. For example: sumU . mapU (`rotate` 3) . replicateU 10000000 $ (7 :: Int) @@ -544,4 +544,3 @@ own to enable constant folding; for example 'shift': 10000000 -> ww_sOb } -} - diff --git a/libraries/base/Data/Fixed.hs b/libraries/base/Data/Fixed.hs index cadbb61ac1..8e8ea60ebe 100644 --- a/libraries/base/Data/Fixed.hs +++ b/libraries/base/Data/Fixed.hs @@ -8,7 +8,7 @@ -- Module : Data.Fixed -- Copyright : (c) Ashley Yakeley 2005, 2006, 2009 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : Ashley Yakeley <ashley@semantic.org> -- Stability : experimental -- Portability : portable @@ -215,4 +215,3 @@ instance HasResolution E12 where resolution _ = 1000000000000 -- | resolution of 10^-12 = .000000000001 type Pico = Fixed E12 - diff --git a/libraries/base/GHC/Int.hs b/libraries/base/GHC/Int.hs index a9743ce1a0..b8e05e2c5b 100644 --- a/libraries/base/GHC/Int.hs +++ b/libraries/base/GHC/Int.hs @@ -704,12 +704,12 @@ instance Bits Int64 where iShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64# a `iShiftL64#` b | isTrue# (b >=# 64#) = intToInt64# 0# - | otherwise = a `uncheckedIShiftL64#` b + | otherwise = a `uncheckedIShiftL64#` b a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# 0#)) - then intToInt64# (-1#) - else intToInt64# 0# - | otherwise = a `uncheckedIShiftRA64#` b + then intToInt64# (-1#) + else intToInt64# 0# + | otherwise = a `uncheckedIShiftRA64#` b {-# RULES "fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#) diff --git a/libraries/base/Prelude.hs b/libraries/base/Prelude.hs index 3a3cc4dcc2..687dcc6854 100644 --- a/libraries/base/Prelude.hs +++ b/libraries/base/Prelude.hs @@ -6,7 +6,7 @@ -- Module : Prelude -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : stable -- Portability : portable |