Commit fb848179 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

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

parent 805ee118
......@@ -11,7 +11,7 @@ Pattern-matching literal patterns
module MatchLit ( dsLit, dsOverLit, hsLitKey, hsOverLitKey
, tidyLitPat, tidyNPat
, matchLiterals, matchNPlusKPats, matchNPats
, warnAboutIdentities, warnAboutEmptyEnumerations
, warnAboutIdentities, warnAboutEmptyEnumerations
) where
#include "HsVersions.h"
......
......@@ -557,7 +557,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
; let { osuf = objectSuf dflags }
; lnks_needed <- mapM (get_linkable osuf) mods_needed
; return (lnks_needed, pkgs_needed) }
; return (lnks_needed, pkgs_needed) }
where
dflags = hsc_dflags hsc_env
this_pkg = thisPackage dflags
......
......@@ -81,19 +81,19 @@ deriving instance (DataId idL, DataId idR)
type HsValBinds id = HsValBindsLR id id
-- | Value bindings (not implicit parameters)
data HsValBindsLR idL idR
data HsValBindsLR idL idR
= -- | Before renaming RHS; idR is always RdrName
-- Not dependency analysed
-- Recursive by default
ValBindsIn
(LHsBindsLR idL idR) [LSig idR]
(LHsBindsLR idL idR) [LSig idR]
-- | After renaming RHS; idR can be Name or Id
-- Dependency analysed,
-- later bindings in the list may depend on earlier
-- ones.
| ValBindsOut
[(RecFlag, LHsBinds idL)]
| ValBindsOut
[(RecFlag, LHsBinds idL)]
[LSig Name]
deriving (Typeable)
deriving instance (DataId idL, DataId idR)
......@@ -161,8 +161,8 @@ data HsBindLR idL idR
-- | Dictionary binding and suchlike.
-- All VarBinds are introduced by the type checker
| VarBind {
var_id :: idL,
| VarBind {
var_id :: idL,
var_rhs :: LHsExpr idR, -- ^ Located only for consistency
var_inline :: Bool -- ^ True <=> inline this binding regardless
-- (used for implication constraints only)
......@@ -230,9 +230,9 @@ top-level binding
In Hindley-Milner, a recursive binding is typechecked with the *recursive* uses
being *monomorphic*. So after typechecking *and* desugaring we will get something
like this
M.reverse :: forall a. [a] -> [a]
= /\a. letrec
= /\a. letrec
reverse :: [a] -> [a] = \xs -> case xs of
[] -> []
(x:xs) -> reverse xs ++ [x]
......@@ -242,22 +242,22 @@ Notice that 'M.reverse' is polymorphic as expected, but there is a local
definition for plain 'reverse' which is *monomorphic*. The type variable
'a' scopes over the entire letrec.
That's after desugaring. What about after type checking but before desugaring?
That's after desugaring. What about after type checking but before desugaring?
That's where AbsBinds comes in. It looks like this:
AbsBinds { abs_tvs = [a]
, abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a],
, abe_mono = reverse :: a -> a}]
, abs_binds = { reverse :: [a] -> [a]
, abs_binds = { reverse :: [a] -> [a]
= \xs -> case xs of
[] -> []
(x:xs) -> reverse xs ++ [x] } }
Here,
* abs_tvs says what type variables are abstracted over the binding group,
* abs_tvs says what type variables are abstracted over the binding group,
just 'a' in this case.
* abs_binds is the *monomorphic* bindings of the group
* abs_exports describes how to get the polymorphic Id 'M.reverse' from the
* abs_exports describes how to get the polymorphic Id 'M.reverse' from the
monomorphic one 'reverse'
Notice that the *original* function (the polymorphic one you thought
......@@ -643,9 +643,9 @@ type LTcSpecPrag = Located TcSpecPrag
data TcSpecPrag
= SpecPrag
Id
HsWrapper
InlinePragma
Id
HsWrapper
InlinePragma
-- ^ The Id to be specialised, an wrapper that specialises the
-- polymorphic function, and inlining spec for the specialised function
deriving (Data, Typeable)
......
This diff is collapsed.
......@@ -650,7 +650,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
ifConArgTys = args, ifConFields = field_lbls,
ifConStricts = if_stricts})
= -- Universally-quantified tyvars are shared with
= -- Universally-quantified tyvars are shared with
-- parent TyCon, and are alrady in scope
bindIfaceTyVars ex_tvs $ \ ex_tyvars -> do
{ traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
......
......@@ -1424,7 +1424,7 @@ isDllName dflags _this_pkg this_mod name
Just i -> i
Nothing -> panic ("Can't find " ++ modStr ++ "in DLL split")
in findMod mod /= findMod this_mod
| otherwise = False -- no, it is not even an external name
-- -----------------------------------------------------------------------------
......
......@@ -432,11 +432,11 @@ patchCCallTarget packageKey callTarget =
\begin{code}
rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
rnSrcInstDecl (TyFamInstD { tfid_inst = tfi })
rnSrcInstDecl (TyFamInstD { tfid_inst = tfi })
= do { (tfi', fvs) <- rnTyFamInstDecl Nothing tfi
; return (TyFamInstD { tfid_inst = tfi' }, fvs) }
rnSrcInstDecl (DataFamInstD { dfid_inst = dfi })
rnSrcInstDecl (DataFamInstD { dfid_inst = dfi })
= do { (dfi', fvs) <- rnDataFamInstDecl Nothing dfi
; return (DataFamInstD { dfid_inst = dfi' }, fvs) }
......@@ -465,7 +465,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
-- Rename the associated types, and type signatures
-- Both need to have the instance type variables in scope
; traceRn (text "rnSrcInstDecl" <+> ppr inst_ty' $$ ppr inst_tyvars $$ ppr ktv_names)
; ((ats', adts', other_sigs'), more_fvs)
; ((ats', adts', other_sigs'), more_fvs)
<- extendTyVarEnvFVRn ktv_names $
do { (ats', at_fvs) <- rnATInstDecls rnTyFamInstDecl cls inst_tyvars ats
; (adts', adt_fvs) <- rnATInstDecls rnDataFamInstDecl cls inst_tyvars adts
......@@ -533,9 +533,9 @@ rnFamInstDecl doc mb_cls tycon pats payload rnPayload
; tv_names <- mapM (newTyVarNameRn mb_cls rdr_env loc) tv_rdr_names
-- All the free vars of the family patterns
-- with a sensible binding location
; ((pats', payload'), fvs)
<- bindLocalNamesFV kv_names $
bindLocalNamesFV tv_names $
; ((pats', payload'), fvs)
<- bindLocalNamesFV kv_names $
bindLocalNamesFV tv_names $
do { (pats', pat_fvs) <- rnLHsTypes doc pats
; (payload', rhs_fvs) <- rnPayload doc payload
......@@ -547,7 +547,7 @@ rnFamInstDecl doc mb_cls tycon pats payload rnPayload
; unless (null bad_tvs) (badAssocRhs bad_tvs)
; return ((pats', payload'), rhs_fvs `plusFV` pat_fvs) }
; let all_fvs = fvs `addOneFV` unLoc tycon'
; return (tycon',
......@@ -610,7 +610,7 @@ Renaming of the associated types in instances.
\begin{code}
-- Rename associated type family decl in class
rnATDecls :: Name -- Class
-> [LFamilyDecl RdrName]
-> [LFamilyDecl RdrName]
-> RnM ([LFamilyDecl Name], FreeVars)
rnATDecls cls at_decls
= rnList (rnFamDecl (Just cls)) at_decls
......@@ -620,7 +620,7 @@ rnATInstDecls :: (Maybe (Name, [Name]) -> -- The function that renames
RnM (decl Name, FreeVars)) -- or rnDataFamInstDecl
-> Name -- Class
-> LHsTyVarBndrs Name
-> [Located (decl RdrName)]
-> [Located (decl RdrName)]
-> RnM ([Located (decl Name)], FreeVars)
-- Used for data and type family defaults in a class decl
-- and the family instance declarations in an instance
......@@ -804,7 +804,7 @@ rnHsVectDecl (HsVect var rhs@(L _ (HsVar _)))
; return (HsVect var' rhs', fv_rhs `addOneFV` unLoc var')
}
rnHsVectDecl (HsVect _var _rhs)
= failWith $ vcat
= failWith $ vcat
[ ptext (sLit "IMPLEMENTATION RESTRICTION: right-hand side of a VECTORISE pragma")
, ptext (sLit "must be an identifier")
]
......@@ -930,12 +930,12 @@ rnTyClDecls extra_deps tycl_ds
)
([], role_annot_env)
raw_groups
; mapM_ orphanRoleAnnotErr (nameEnvElts orphan_roles)
; traceRn (text "rnTycl" <+> (ppr ds_w_fvs $$ ppr sccs))
; return (groups, all_fvs) }
rnTyClDecl :: TyClDecl RdrName
rnTyClDecl :: TyClDecl RdrName
-> RnM (TyClDecl Name, FreeVars)
rnTyClDecl (ForeignType {tcdLName = name, tcdExtName = ext_name})
= do { name' <- lookupLocatedTopBndrRn name
......@@ -974,8 +974,8 @@ rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdDataDefn = defn
; return (DataDecl { tcdLName = tycon', tcdTyVars = tyvars'
, tcdDataDefn = defn', tcdFVs = fvs }, fvs) }
rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = lcls,
tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
tcdMeths = mbinds, tcdATs = ats, tcdATDefs = at_defs,
tcdDocs = docs})
= do { lcls' <- lookupLocatedTopBndrRn lcls
......@@ -1078,7 +1078,7 @@ dupRoleAnnotErr list
where
sorted_list = sortBy cmp_annot list
(L loc first_decl : _) = sorted_list
pp_role_annot (L loc decl) = hang (ppr decl)
4 (text "-- written at" <+> ppr loc)
......@@ -1095,9 +1095,9 @@ orphanRoleAnnotErr (L loc decl)
rnDataDefn :: HsDocContext -> HsDataDefn RdrName -> RnM (HsDataDefn Name, FreeVars)
rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
, dd_ctxt = context, dd_cons = condecls
, dd_ctxt = context, dd_cons = condecls
, dd_kindSig = sig, dd_derivs = derivs })
= do { checkTc (h98_style || null (unLoc context))
= do { checkTc (h98_style || null (unLoc context))
(badGadtStupidTheta doc)
; (sig', sig_fvs) <- rnLHsMaybeKind doc sig
......@@ -1137,7 +1137,7 @@ badGadtStupidTheta _
ptext (sLit "(You can put a context on each contructor, though.)")]
rnFamDecl :: Maybe Name
-- Just cls => this FamilyDecl is nested
-- Just cls => this FamilyDecl is nested
-- inside an *class decl* for cls
-- used for associated types
-> FamilyDecl RdrName
......@@ -1153,7 +1153,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
; return (FamilyDecl { fdLName = tycon', fdTyVars = tyvars'
, fdInfo = info', fdKindSig = kind' }
, fv1 `plusFV` fv2) }
where
where
fmly_doc = TyFamilyCtx tycon
kvs = extractRdrKindSigVars kind
......@@ -1163,7 +1163,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
; return (ClosedTypeFamily eqns', fvs) }
rn_info OpenTypeFamily = return (OpenTypeFamily, emptyFVs)
rn_info DataFamily = return (DataFamily, emptyFVs)
\end{code}
Note [Stupid theta]
......@@ -1196,11 +1196,11 @@ depAnalTyClDecls ds_w_fvs
(L _ d, _) <- ds_w_fvs
case d of
ClassDecl { tcdLName = L _ cls_name
, tcdATs = ats }
, tcdATs = ats }
-> do L _ (FamilyDecl { fdLName = L _ fam_name }) <- ats
return (fam_name, cls_name)
DataDecl { tcdLName = L _ data_name
, tcdDataDefn = HsDataDefn { dd_cons = cons } }
, tcdDataDefn = HsDataDefn { dd_cons = cons } }
-> do L _ dc <- cons
return (unLoc (con_name dc), data_name)
_ -> []
......
......@@ -8,25 +8,25 @@
module TcEvidence (
-- HsWrapper
HsWrapper(..),
HsWrapper(..),
(<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams, mkWpLams, mkWpLet, mkWpCast,
idHsWrapper, isIdHsWrapper, pprHsWrapper,
-- Evidence bindings
TcEvBinds(..), EvBindsVar(..),
TcEvBinds(..), EvBindsVar(..),
EvBindMap(..), emptyEvBindMap, extendEvBinds, lookupEvBind, evBindMapBinds,
EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds,
EvTerm(..), mkEvCast, evVarsOfTerm,
EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds,
EvTerm(..), mkEvCast, evVarsOfTerm,
EvLit(..), evTermCoercion,
-- TcCoercion
TcCoercion(..), LeftOrRight(..), pickLR,
mkTcReflCo, mkTcNomReflCo,
mkTcReflCo, mkTcNomReflCo,
mkTcTyConAppCo, mkTcAppCo, mkTcAppCos, mkTcFunCo,
mkTcAxInstCo, mkTcUnbranchedAxInstCo, mkTcForAllCo, mkTcForAllCos,
mkTcAxInstCo, mkTcUnbranchedAxInstCo, mkTcForAllCo, mkTcForAllCos,
mkTcSymCo, mkTcTransCo, mkTcNthCo, mkTcLRCo, mkTcSubCo,
mkTcAxiomRuleCo,
tcCoercionKind, coVarsOfTcCo, isEqVar, mkTcCoVarCo,
tcCoercionKind, coVarsOfTcCo, isEqVar, mkTcCoVarCo,
isTcReflCo, getTcCoVar_maybe,
tcCoercionRole, eqVarRole
) where
......@@ -53,7 +53,7 @@ import Control.Applicative
#if __GLASGOW_HASKELL__ < 709
import Data.Traversable (traverse, sequenceA)
#endif
import qualified Data.Data as Data
import qualified Data.Data as Data
import Outputable
import FastString
import Data.IORef( IORef )
......@@ -97,11 +97,11 @@ differences
[Coercion axioms applied to coercions]).
\begin{code}
data TcCoercion
data TcCoercion
= TcRefl Role TcType
| TcTyConAppCo Role TyCon [TcCoercion]
| TcAppCo TcCoercion TcCoercion
| TcForAllCo TyVar TcCoercion
| TcForAllCo TyVar TcCoercion
| TcCoVarCo EqVar
| TcAxiomInstCo (CoAxiom Branched) Int [TcCoercion] -- Int specifies branch number
-- See [CoAxiom Index] in Coercion.lhs
......@@ -118,7 +118,7 @@ data TcCoercion
| TcLetCo TcEvBinds TcCoercion
deriving (Data.Data, Data.Typeable)
isEqVar :: Var -> Bool
isEqVar :: Var -> Bool
-- Is lifted coercion variable (only!)
isEqVar v = case tyConAppTyCon_maybe (varType v) of
Just tc -> tc `hasKey` eqTyConKey
......@@ -148,7 +148,7 @@ mkTcFunCo role co1 co2 = mkTcTyConAppCo role funTyCon [co1, co2]
mkTcTyConAppCo :: Role -> TyCon -> [TcCoercion] -> TcCoercion
mkTcTyConAppCo role tc cos -- No need to expand type synonyms
-- See Note [TcCoercions]
| Just tys <- traverse isTcReflCo_maybe cos
| Just tys <- traverse isTcReflCo_maybe cos
= TcRefl role (mkTyConApp tc tys) -- See Note [Refl invariant]
| otherwise = TcTyConAppCo role tc cos
......@@ -182,7 +182,7 @@ mkTcAxInstCo role ax index tys
| ASSERT2( not (role == Nominal && ax_role == Representational) , ppr (ax, tys) )
arity == n_tys = maybeTcSubCo2 role ax_role $ TcAxiomInstCo ax_br index rtys
| otherwise = ASSERT( arity < n_tys )
maybeTcSubCo2 role ax_role $
maybeTcSubCo2 role ax_role $
foldl TcAppCo (TcAxiomInstCo ax_br index (take arity rtys))
(drop arity rtys)
where
......@@ -248,8 +248,8 @@ mkTcCoVarCo ipv = TcCoVarCo ipv
\begin{code}
tcCoercionKind :: TcCoercion -> Pair Type
tcCoercionKind co = go co
where
tcCoercionKind co = go co
where
go (TcRefl _ ty) = Pair ty ty
go (TcLetCo _ co) = go co
go (TcCastCo _ co) = case getEqPredTys (pSnd (go co)) of
......@@ -333,12 +333,12 @@ coVarsOfTcCo tc_co
go (TcAxiomRuleCo _ _ cos) = mapUnionVarSet go cos
-- We expect only coercion bindings, so use evTermCoercion
-- We expect only coercion bindings, so use evTermCoercion
go_bind :: EvBind -> VarSet
go_bind (EvBind _ tm) = go (evTermCoercion tm)
get_bndrs :: Bag EvBind -> VarSet
get_bndrs = foldrBag (\ (EvBind b _) bs -> extendVarSet bs b) emptyVarSet
get_bndrs = foldrBag (\ (EvBind b _) bs -> extendVarSet bs b) emptyVarSet
\end{code}
Pretty printing
......@@ -365,7 +365,7 @@ ppr_co p (TcAppCo co1 co2) = maybeParen p TyConPrec $
ppr_co p (TcCastCo co1 co2) = maybeParen p FunPrec $
ppr_co FunPrec co1 <+> ptext (sLit "|>") <+> ppr_co FunPrec co2
ppr_co p co@(TcForAllCo {}) = ppr_forall_co p co
ppr_co _ (TcCoVarCo cv) = parenSymOcc (getOccName cv) (ppr cv)
ppr_co p (TcAxiomInstCo con ind cos)
......@@ -533,8 +533,8 @@ instance Data.Data TcEvBinds where
dataTypeOf _ = Data.mkNoRepType "TcEvBinds"
-----------------
newtype EvBindMap
= EvBindMap {
newtype EvBindMap
= EvBindMap {
ev_bind_varenv :: VarEnv EvBind
} -- Map from evidence variables to evidence terms
......@@ -542,14 +542,14 @@ emptyEvBindMap :: EvBindMap
emptyEvBindMap = EvBindMap { ev_bind_varenv = emptyVarEnv }
extendEvBinds :: EvBindMap -> EvVar -> EvTerm -> EvBindMap
extendEvBinds bs v t
extendEvBinds bs v t
= EvBindMap { ev_bind_varenv = extendVarEnv (ev_bind_varenv bs) v (EvBind v t) }
lookupEvBind :: EvBindMap -> EvVar -> Maybe EvBind
lookupEvBind bs = lookupVarEnv (ev_bind_varenv bs)
evBindMapBinds :: EvBindMap -> Bag EvBind
evBindMapBinds bs
evBindMapBinds bs
= foldVarEnv consBag emptyBag (ev_bind_varenv bs)
-----------------
......@@ -601,14 +601,14 @@ A "coercion evidence term" takes one of these forms
We do quite often need to get a TcCoercion from an EvTerm; see
'evTermCoercion'.
INVARIANT: The evidence for any constraint with type (t1~t2) is
INVARIANT: The evidence for any constraint with type (t1~t2) is
a coercion evidence term. Consider for example
[G] d :: F Int a
If we have
ax7 a :: F Int a ~ (a ~ Bool)
then we do NOT generate the constraint
[G] (d |> ax7 a) :: a ~ Bool
because that does not satisfy the invariant (d is not a coercion variable).
because that does not satisfy the invariant (d is not a coercion variable).
Instead we make a binding
g1 :: a~Bool = g |> ax7 a
and the constraint
......@@ -781,7 +781,7 @@ instance Outputable EvTerm where
ppr (EvSuperClass d n) = ptext (sLit "sc") <> parens (ppr (d,n))
ppr (EvDFunApp df tys ts) = ppr df <+> sep [ char '@' <> ppr tys, ppr ts ]
ppr (EvLit l) = ppr l
ppr (EvDelayedError ty msg) = ptext (sLit "error")
ppr (EvDelayedError ty msg) = ptext (sLit "error")
<+> sep [ char '@' <> ppr ty, ppr msg ]
instance Outputable EvLit where
......
......@@ -88,7 +88,7 @@ hsPatType (ListPat _ ty Nothing) = mkListTy ty
hsPatType (ListPat _ _ (Just (ty,_))) = ty
hsPatType (PArrPat _ ty) = mkPArrTy ty
hsPatType (TuplePat _ bx tys) = mkTupleTy (boxityNormalTupleSort bx) tys
hsPatType (ConPatOut { pat_con = L _ con, pat_arg_tys = tys })
hsPatType (ConPatOut { pat_con = L _ con, pat_arg_tys = tys })
= conLikeResTy con tys
hsPatType (SigPatOut _ ty) = ty
hsPatType (NPat lit _ _) = overLitType lit
......
......@@ -222,7 +222,7 @@ RTS_THUNK(stg_ap_5_upd);
RTS_THUNK(stg_ap_6_upd);
RTS_THUNK(stg_ap_7_upd);
/* standard application routines (see also utils/genapply,
/* standard application routines (see also utils/genapply,
* and compiler/codeGen/CgStackery.lhs).
*/
RTS_RET(stg_ap_v);
......
......@@ -3606,7 +3606,7 @@ allocateImageAndTrampolines (
barf("getNumberOfSymbols: error whilst reading `%s' header in `%S'",
member_name, arch_name);
fseek( f, -sizeof_COFF_header, SEEK_CUR );
/* We get back 8-byte aligned memory (is that guaranteed?), but
the offsets to the sections within the file are all 4 mod 8
(is that guaranteed?). We therefore need to offset the image
......
......@@ -318,7 +318,7 @@ stg_casArrayzh ( gcptr arr, W_ ind, gcptr old, gcptr new )
p = arr + SIZEOF_StgMutArrPtrs + WDS(ind);
(h) = ccall cas(p, old, new);
if (h != old) {
// Failure, return what was there instead of 'old':
return (1,h);
......@@ -791,7 +791,7 @@ stg_decodeDoublezu2Intzh ( D_ arg )
mp_tmp2 = tmp + WDS(2);
mp_result1 = tmp + WDS(1);
mp_result2 = tmp;
/* Perform the operation */
ccall __decodeDouble_2Int(mp_tmp1 "ptr", mp_tmp2 "ptr",
mp_result1 "ptr", mp_result2 "ptr",
......
......@@ -52,13 +52,13 @@ StgDouble
__word_encodeDouble (W_ j, I_ e)
{
StgDouble r;
r = (StgDouble)j;
/* Now raise to the exponent */
if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
r = ldexp(r, e);
return r;
}
......@@ -67,17 +67,17 @@ StgDouble
__int_encodeDouble (I_ j, I_ e)
{
StgDouble r;
r = (StgDouble)__abs(j);
/* Now raise to the exponent */
if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
r = ldexp(r, e);
/* sign is encoded in the size */
if (j < 0)
r = -r;
return r;
}
......@@ -86,17 +86,17 @@ StgFloat
__int_encodeFloat (I_ j, I_ e)
{
StgFloat r;
r = (StgFloat)__abs(j);
/* Now raise to the exponent */
if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
r = ldexp(r, e);
/* sign is encoded in the size */
if (j < 0)
r = -r;
return r;
}
......@@ -105,13 +105,13 @@ StgFloat
__word_encodeFloat (W_ j, I_ e)
{
StgFloat r;
r = (StgFloat)j;
/* Now raise to the exponent */
if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
r = ldexp(r, e);
return r;
}
......
......@@ -23,7 +23,7 @@ ll = mdo n0 <- newNode n3 0 n1
data Direction = Forward | Backward deriving Eq
traverse :: Direction -> Node s a -> ST s [a]
traverse dir (N (v, b, i, f)) =
traverse dir (N (v, b, i, f)) =
do visited <- readSTRef v
if visited
then return []
......@@ -44,14 +44,14 @@ l2dll' p (x:xs) = mdo c <- newNode p x f
return (c, l)
insertAfter :: Node s a -> a -> ST s (Node s a)
insertAfter cur@(N (v, prev, val, next)) i
insertAfter cur@(N (v, prev, val, next)) i
= do vis <- newSTRef False
let newCell = N (vis, cur, i, next)
return (N (v, prev, val, newCell))
return (N (v, prev, val, newCell))
test = runST (do l <- l2dll [1 .. 10]
l' <- insertAfter l 12
l'' <- insertAfter l' 13
traverse Forward l'')
test = runST (do l <- l2dll [1 .. 10]
l' <- insertAfter l 12
l'' <- insertAfter l' 13
traverse Forward l'')
main = print test
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