Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
737f3682
Commit
737f3682
authored
Aug 31, 2014
by
Herbert Valerio Riedel
🕺
Browse files
`M-x delete-trailing-whitespace` & `M-x untabify`...
...some files more or less recently touched by me [ci skip]
parent
a8a969ae
Changes
12
Hide whitespace changes
Inline
Side-by-side
compiler/cmm/PprC.hs
View file @
737f3682
...
...
@@ -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"
...
...
compiler/coreSyn/MkCore.lhs
View file @
737f3682
...
...
@@ -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}
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
View file @
737f3682
...
...
@@ -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
...
...
compiler/main/DynFlags.hs
View file @
737f3682
...
...
@@ -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
)
]
...
...
compiler/nativeGen/X86/Instr.hs
View file @
737f3682
...
...
@@ -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
]
...
...
compiler/prelude/PrelNames.lhs
View file @
737f3682
...
...
@@ -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}
ghc/InteractiveUI.hs
View file @
737f3682
...
...
@@ -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
...
...
ghc/Main.hs
View file @
737f3682
...
...
@@ -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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
...
...
libraries/base/Data/Bits.hs
View file @
737f3682
...
...
@@ -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
}
-}
libraries/base/Data/Fixed.hs
View file @
737f3682
...
...
@@ -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
libraries/base/GHC/Int.hs
View file @
737f3682
...
...
@@ -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#)
...
...
libraries/base/Prelude.hs
View file @
737f3682
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment