Commit 737f3682 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

`M-x delete-trailing-whitespace` & `M-x untabify`...

...some files more or less recently touched by me

[ci skip]
parent a8a969ae
......@@ -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"
......
......@@ -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}
......@@ -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
......
......@@ -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)
]
......
......@@ -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]
......
......@@ -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}
......@@ -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
......
......@@ -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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -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
}
-}
......@@ -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
......@@ -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#)
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment