diff options
| -rw-r--r-- | compiler/deSugar/MatchLit.lhs | 2 | ||||
| -rw-r--r-- | compiler/ghci/Linker.lhs | 2 | ||||
| -rw-r--r-- | compiler/hsSyn/HsBinds.lhs | 30 | ||||
| -rw-r--r-- | compiler/hsSyn/HsDecls.lhs | 116 | ||||
| -rw-r--r-- | compiler/iface/TcIface.lhs | 2 | ||||
| -rw-r--r-- | compiler/main/Packages.lhs | 2 | ||||
| -rw-r--r-- | compiler/rename/RnSource.lhs | 44 | ||||
| -rw-r--r-- | compiler/typecheck/TcEvidence.lhs | 50 | ||||
| -rw-r--r-- | compiler/typecheck/TcHsSyn.lhs | 2 | ||||
| -rw-r--r-- | includes/stg/MiscClosures.h | 2 | ||||
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 144 | ||||
| -rw-r--r-- | rts/Linker.c | 2 | ||||
| -rw-r--r-- | rts/PrimOps.cmm | 4 | ||||
| -rw-r--r-- | rts/StgPrimFloat.c | 28 | ||||
| -rw-r--r-- | testsuite/tests/mdo/should_run/mdorun002.hs | 14 |
15 files changed, 222 insertions, 222 deletions
diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs index 5a247177a3..61db408066 100644 --- a/compiler/deSugar/MatchLit.lhs +++ b/compiler/deSugar/MatchLit.lhs @@ -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" diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index ecba45b0fa..f0dee88c79 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -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 diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index e6d0c0ecd5..bbf6bc2fd7 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -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) diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs index 52807ff274..6f7e41f6f7 100644 --- a/compiler/hsSyn/HsDecls.lhs +++ b/compiler/hsSyn/HsDecls.lhs @@ -57,14 +57,14 @@ module HsDecls ( noForeignImportCoercionYet, noForeignExportCoercionYet, CImportSpec(..), -- ** Data-constructor declarations - ConDecl(..), LConDecl, ResType(..), - HsConDeclDetails, hsConDeclArgTys, + ConDecl(..), LConDecl, ResType(..), + HsConDeclDetails, hsConDeclArgTys, -- ** Document comments DocDecl(..), LDocDecl, docDeclDoc, -- ** Deprecations WarnDecl(..), LWarnDecl, -- ** Annotations - AnnDecl(..), LAnnDecl, + AnnDecl(..), LAnnDecl, AnnProvenance(..), annProvenanceName_maybe, -- ** Role annotations RoleAnnotDecl(..), LRoleAnnotDecl, roleAnnotDeclName, @@ -93,7 +93,7 @@ import NameSet -- others: import InstEnv import Class -import Outputable +import Outputable import Util import SrcLoc import FastString @@ -187,7 +187,7 @@ emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn } emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut } -emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], +emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [], hs_fixds = [], hs_defds = [], hs_annds = [], hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [], @@ -196,46 +196,46 @@ emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_docs = [] } appendGroups :: HsGroup a -> HsGroup a -> HsGroup a -appendGroups - HsGroup { +appendGroups + HsGroup { hs_valds = val_groups1, hs_splcds = spliceds1, - hs_tyclds = tyclds1, + hs_tyclds = tyclds1, hs_instds = instds1, hs_derivds = derivds1, - hs_fixds = fixds1, + hs_fixds = fixds1, hs_defds = defds1, hs_annds = annds1, - hs_fords = fords1, + hs_fords = fords1, hs_warnds = warnds1, hs_ruleds = rulds1, hs_vects = vects1, hs_docs = docs1 } - HsGroup { + HsGroup { hs_valds = val_groups2, hs_splcds = spliceds2, - hs_tyclds = tyclds2, + hs_tyclds = tyclds2, hs_instds = instds2, hs_derivds = derivds2, - hs_fixds = fixds2, + hs_fixds = fixds2, hs_defds = defds2, hs_annds = annds2, - hs_fords = fords2, + hs_fords = fords2, hs_warnds = warnds2, hs_ruleds = rulds2, hs_vects = vects2, hs_docs = docs2 } - = - HsGroup { + = + HsGroup { hs_valds = val_groups1 `plusHsValBinds` val_groups2, - hs_splcds = spliceds1 ++ spliceds2, - hs_tyclds = tyclds1 ++ tyclds2, + hs_splcds = spliceds1 ++ spliceds2, + hs_tyclds = tyclds1 ++ tyclds2, hs_instds = instds1 ++ instds2, hs_derivds = derivds1 ++ derivds2, hs_fixds = fixds1 ++ fixds2, hs_annds = annds1 ++ annds2, hs_defds = defds1 ++ defds2, - hs_fords = fords1 ++ fords2, + hs_fords = fords1 ++ fords2, hs_warnds = warnds1 ++ warnds2, hs_ruleds = rulds1 ++ rulds2, hs_vects = vects1 ++ vects2, @@ -272,15 +272,15 @@ instance OutputableBndr name => Outputable (HsGroup name) where hs_defds = default_decls, hs_ruleds = rule_decls, hs_vects = vect_decls }) - = vcat_mb empty - [ppr_ds fix_decls, ppr_ds default_decls, + = vcat_mb empty + [ppr_ds fix_decls, ppr_ds default_decls, ppr_ds deprec_decls, ppr_ds ann_decls, ppr_ds rule_decls, ppr_ds vect_decls, - if isEmptyValBinds val_decls - then Nothing + if isEmptyValBinds val_decls + then Nothing else Just (ppr val_decls), - ppr_ds (tyClGroupConcat tycl_decls), + ppr_ds (tyClGroupConcat tycl_decls), ppr_ds inst_decls, ppr_ds deriv_decls, ppr_ds foreign_decls] @@ -327,7 +327,7 @@ and instance decls. It's a bit tricky, so pay attention! "Implicit" (or "system") binders ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Each data type decl defines + Each data type decl defines a worker name for each constructor to-T and from-T convertors Each class decl defines @@ -345,7 +345,7 @@ interface files, of course. Any such occurrence must haul in the relevant type or class decl. Plan of attack: - - Ensure they "point to" the parent data/class decl + - Ensure they "point to" the parent data/class decl when loading that decl from an interface file (See RnHiFiles.getSysBinders) @@ -377,7 +377,7 @@ In *source-code* class declarations: - The renamer renames it to a Name - - During typechecking, we generate a binding for each $dm for + - During typechecking, we generate a binding for each $dm for which there's a programmer-supplied default method: class Foo a where op1 :: <type> @@ -398,7 +398,7 @@ In *interface-file* class declarations: - The interface file has a separate definition for $dmop1, with unfolding etc. - The renamer renames it to a Name. - The renamer treats $dmop1 as a free variable of the declaration, so that - the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs) + the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs) This doesn't happen for source code class decls, because they *bind* the default method. Dictionary functions @@ -426,7 +426,7 @@ Source code: instance decl, whether it comes from a source-code instance decl, or whether the instance decl is derived from some other construct (e.g. 'deriving'). - - The occurrence name it chooses is derived from the instance decl (just for + - The occurrence name it chooses is derived from the instance decl (just for documentation really) --- e.g. dNumInt. Two dict funs may share a common occurrence name, but will have different uniques. E.g. instance Foo [Int] where ... @@ -436,7 +436,7 @@ Source code: - The CoreTidy phase externalises the name, and ensures the occurrence name is unique (this isn't special to dict funs). So we'd get dFooList and dFooList1. - - We can take this relaxed approach (changing the occurrence name later) + - We can take this relaxed approach (changing the occurrence name later) because dict fun Ids are not captured in a TyCon or Class (unlike default methods, say). Instead, they are kept separately in the InstEnv. This makes it easy to adjust them after compiling a module. (Once we've finished @@ -456,7 +456,7 @@ type LTyClDecl name = Located (TyClDecl name) -- | A type or class declaration. data TyClDecl name - = ForeignType { + = ForeignType { tcdLName :: Located name, tcdExtName :: Maybe FastString } @@ -478,7 +478,7 @@ data TyClDecl name -- Eg class T a where -- type F a :: * -- type F a = a -> a - -- Here the type decl for 'f' includes 'a' + -- Here the type decl for 'f' includes 'a' -- in its tcdTyVars , tcdDataDefn :: HsDataDefn name , tcdFVs :: PostRn name NameSet } @@ -614,7 +614,7 @@ tyClDeclTyVars d = tcdTyVars d \begin{code} countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int) -- class, synonym decls, data, newtype, family decls -countTyClDecls decls +countTyClDecls decls = (count isClassDecl decls, count isSynDecl decls, -- excluding... count isDataTy decls, -- ...family... @@ -623,7 +623,7 @@ countTyClDecls decls where isDataTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = DataType } } = True isDataTy _ = False - + isNewTy DataDecl{ tcdDataDefn = HsDataDefn { dd_ND = NewType } } = True isNewTy _ = False @@ -685,12 +685,12 @@ instance OutputableBndr name ppr (SynDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdRhs = rhs }) = hang (ptext (sLit "type") <+> pp_vanilla_decl_head ltycon tyvars [] <+> equals) - 4 (ppr rhs) + 4 (ppr rhs) ppr (DataDecl { tcdLName = ltycon, tcdTyVars = tyvars, tcdDataDefn = defn }) = pp_data_defn (pp_vanilla_decl_head ltycon tyvars) defn - ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, + ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, tcdMeths = methods, tcdATs = ats, tcdATDefs = at_defs}) @@ -703,7 +703,7 @@ instance OutputableBndr name map ppr_fam_deflt_eqn at_defs ++ pprLHsBindsForUser methods sigs) ] where - top_matter = ptext (sLit "class") + top_matter = ptext (sLit "class") <+> pp_vanilla_decl_head lclas tyvars (unLoc context) <+> pprFundeps (map unLoc fds) @@ -713,7 +713,7 @@ instance OutputableBndr name => Outputable (TyClGroup name) where ppr roles instance (OutputableBndr name) => Outputable (FamilyDecl name) where - ppr (FamilyDecl { fdInfo = info, fdLName = ltycon, + ppr (FamilyDecl { fdInfo = info, fdLName = ltycon, fdTyVars = tyvars, fdKindSig = mb_kind}) = vcat [ pprFlavour info <+> pp_vanilla_decl_head ltycon tyvars [] <+> pp_kind <+> pp_where , nest 2 $ pp_eqns ] @@ -785,7 +785,7 @@ data HsDataDefn name -- The payload of a data type defn dd_kindSig:: Maybe (LHsKind name), -- ^ Optional kind signature. -- - -- @(Just k)@ for a GADT-style @data@, + -- @(Just k)@ for a GADT-style @data@, -- or @data instance@ decl, with explicit kind sig -- -- Always @Nothing@ for H98-syntax decls @@ -848,7 +848,7 @@ data ConDecl name -- - ResTyGADT: *all* the constructor's quantified type variables -- -- If con_explicit is Implicit, then con_qvars is irrelevant - -- until after renaming. + -- until after renaming. , con_cxt :: LHsContext name -- ^ The context. This /does not/ include the \"stupid theta\" which @@ -895,9 +895,9 @@ instance Outputable ty => Outputable (ResType ty) where pp_data_defn :: OutputableBndr name => (HsContext name -> SDoc) -- Printing the header -> HsDataDefn name - -> SDoc + -> SDoc pp_data_defn pp_hdr (HsDataDefn { dd_ND = new_or_data, dd_ctxt = L _ context - , dd_kindSig = mb_sig + , dd_kindSig = mb_sig , dd_cons = condecls, dd_derivs = derivings }) | null condecls = ppr new_or_data <+> pp_hdr context <+> pp_sig @@ -942,14 +942,14 @@ pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs , con_cxt = cxt, con_details = PrefixCon arg_tys , con_res = ResTyGADT res_ty }) - = ppr con <+> dcolon <+> + = ppr con <+> dcolon <+> sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)] where mk_fun_ty a b = noLoc (HsFunTy a b) pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs , con_cxt = cxt, con_details = RecCon fields, con_res = ResTyGADT res_ty }) - = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt, + = sep [ppr con <+> dcolon <+> pprHsForAll expl tvs cxt, pprConDeclFields fields <+> arrow <+> ppr res_ty] pprConDecl decl@(ConDecl { con_details = InfixCon ty1 ty2, con_res = ResTyGADT {} }) @@ -1048,7 +1048,7 @@ deriving instance (DataId id) => Data (ClsInstDecl id) type LInstDecl name = Located (InstDecl name) data InstDecl name -- Both class and family instances - = ClsInstD + = ClsInstD { cid_inst :: ClsInstDecl name } | DataFamInstD -- data family instance { dfid_inst :: DataFamInstDecl name } @@ -1069,7 +1069,7 @@ tvs are fv(pat_tys), *including* ones that are already in scope instance C w (a,b) where type F (a,b) x = x->a The tcdTyVars of the F decl are {a,b,x}, even though the F decl - is nested inside the 'instance' decl. + is nested inside the 'instance' decl. However after the renamer, the uniques will match up: instance C w7 (a8,b9) where @@ -1106,7 +1106,7 @@ instance (OutputableBndr name) => Outputable (DataFamInstDecl name) where pprDataFamInstDecl :: OutputableBndr name => TopLevelFlag -> DataFamInstDecl name -> SDoc pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_tycon = tycon - , dfid_pats = pats + , dfid_pats = pats , dfid_defn = defn }) = pp_data_defn pp_hdr defn where @@ -1155,7 +1155,7 @@ instance (OutputableBndr name) => Outputable (InstDecl name) where -- Extract the declarations of associated data types from an instance instDeclDataFamInsts :: [LInstDecl name] -> [DataFamInstDecl name] -instDeclDataFamInsts inst_decls +instDeclDataFamInsts inst_decls = concatMap do_one inst_decls where do_one (L _ (ClsInstD { cid_inst = ClsInstDecl { cid_datafam_insts = fam_insts } })) @@ -1252,7 +1252,7 @@ noForeignExportCoercionYet :: PlaceHolder noForeignExportCoercionYet = PlaceHolder -- Specification Of an imported external entity in dependence on the calling --- convention +-- convention -- data ForeignImport = -- import of a C entity -- @@ -1264,7 +1264,7 @@ data ForeignImport = -- import of a C entity -- -- * the calling convention is irrelevant for code -- generation in the case of `CLabel', but is needed - -- for pretty printing + -- for pretty printing -- -- * `Safety' is irrelevant for `CLabel' and `CWrapper' -- @@ -1301,16 +1301,16 @@ instance OutputableBndr name => Outputable (ForeignDecl name) where instance Outputable ForeignImport where ppr (CImport cconv safety mHeader spec) = - ppr cconv <+> ppr safety <+> + ppr cconv <+> ppr safety <+> char '"' <> pprCEntity spec <> char '"' where pp_hdr = case mHeader of Nothing -> empty Just (Header header) -> ftext header - pprCEntity (CLabel lbl) = + pprCEntity (CLabel lbl) = ptext (sLit "static") <+> pp_hdr <+> char '&' <> ppr lbl - pprCEntity (CFunction (StaticTarget lbl _ isFun)) = + pprCEntity (CFunction (StaticTarget lbl _ isFun)) = ptext (sLit "static") <+> pp_hdr <+> (if isFun then empty else ptext (sLit "value")) @@ -1320,7 +1320,7 @@ instance Outputable ForeignImport where pprCEntity (CWrapper) = ptext (sLit "wrapper") instance Outputable ForeignExport where - ppr (CExport (CExportStatic lbl cconv)) = + ppr (CExport (CExportStatic lbl cconv)) = ppr cconv <+> char '"' <> ppr lbl <> char '"' \end{code} @@ -1358,7 +1358,7 @@ collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs] instance OutputableBndr name => Outputable (RuleDecl name) where ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs) = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act, - nest 4 (pp_forall <+> pprExpr (unLoc lhs)), + nest 4 (pp_forall <+> pprExpr (unLoc lhs)), nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ] where pp_forall | null ns = empty @@ -1384,7 +1384,7 @@ A vectorisation pragma, one of {-# VECTORISE type T = ty #-} {-# VECTORISE SCALAR type T #-} - + \begin{code} type LVectDecl name = Located (VectDecl name) @@ -1431,7 +1431,7 @@ lvectInstDecl _ = False instance OutputableBndr name => Outputable (VectDecl name) where ppr (HsVect v rhs) = sep [text "{-# VECTORISE" <+> ppr v, - nest 4 $ + nest 4 $ pprExpr (unLoc rhs) <+> text "#-}" ] ppr (HsNoVect v) = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ] @@ -1477,7 +1477,7 @@ data DocDecl | DocCommentNamed String HsDocString | DocGroup Int HsDocString deriving (Data, Typeable) - + -- Okay, I need to reconstruct the document comments, but for now: instance Outputable DocDecl where ppr _ = text "<document comment>" diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 293e8c9c4c..bb5186931d 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -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) diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index f0d4d4f1fc..a308a990d1 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -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 -- ----------------------------------------------------------------------------- diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index 6aa666642f..ef93cfb616 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -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) _ -> [] diff --git a/compiler/typecheck/TcEvidence.lhs b/compiler/typecheck/TcEvidence.lhs index 468f9c3956..3b2a3d6727 100644 --- a/compiler/typecheck/TcEvidence.lhs +++ b/compiler/typecheck/TcEvidence.lhs @@ -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 diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs index b19bfbbdc1..f65efc0da2 100644 --- a/compiler/typecheck/TcHsSyn.lhs +++ b/compiler/typecheck/TcHsSyn.lhs @@ -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 diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h index 0d323e2db2..6fd7181426 100644 --- a/includes/stg/MiscClosures.h +++ b/includes/stg/MiscClosures.h @@ -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); diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 268838e195..87f18630dc 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -23,30 +23,30 @@ import qualified Data.Data as Data import Control.Applicative( Applicative(..) ) #endif import Data.IORef -import System.IO.Unsafe ( unsafePerformIO ) +import System.IO.Unsafe ( unsafePerformIO ) import Control.Monad (liftM) -import System.IO ( hPutStrLn, stderr ) +import System.IO ( hPutStrLn, stderr ) import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Word ( Word8 ) ----------------------------------------------------- -- --- The Quasi class +-- The Quasi class -- ----------------------------------------------------- class (Monad m, Applicative m) => Quasi m where qNewName :: String -> m Name - -- ^ Fresh names + -- ^ Fresh names - -- Error reporting and recovery - qReport :: Bool -> String -> m () -- ^ Report an error (True) or warning (False) - -- ...but carry on; use 'fail' to stop + -- Error reporting and recovery + qReport :: Bool -> String -> m () -- ^ Report an error (True) or warning (False) + -- ...but carry on; use 'fail' to stop qRecover :: m a -- ^ the error handler -> m a -- ^ action which may fail - -> m a -- ^ Recover from the monadic 'fail' + -> m a -- ^ Recover from the monadic 'fail' - -- Inspect the type-checker's environment + -- Inspect the type-checker's environment qLookupName :: Bool -> String -> m (Maybe Name) -- True <=> type namespace, False <=> value namespace qReify :: Name -> m Info @@ -75,7 +75,7 @@ class (Monad m, Applicative m) => Quasi m where qPutQ :: Typeable a => a -> m () ----------------------------------------------------- --- The IO instance of Quasi +-- The IO instance of Quasi -- -- This instance is used only when running a Q -- computation in the IO monad, usually just to @@ -99,8 +99,8 @@ instance Quasi IO where qReifyRoles _ = badIO "reifyRoles" qReifyAnnotations _ = badIO "reifyAnnotations" qReifyModule _ = badIO "reifyModule" - qLocation = badIO "currentLocation" - qRecover _ _ = badIO "recover" -- Maybe we could fix this? + qLocation = badIO "currentLocation" + qRecover _ _ = badIO "recover" -- Maybe we could fix this? qAddDependentFile _ = badIO "addDependentFile" qAddTopDecls _ = badIO "addTopDecls" qAddModFinalizer _ = badIO "addModFinalizer" @@ -110,8 +110,8 @@ instance Quasi IO where qRunIO m = m badIO :: String -> IO a -badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad") - ; fail "Template Haskell failure" } +badIO op = do { qReport True ("Can't do `" ++ op ++ "' in the IO monad") + ; fail "Template Haskell failure" } -- Global variable to generate unique symbols counter :: IORef Int @@ -121,7 +121,7 @@ counter = unsafePerformIO (newIORef 0) ----------------------------------------------------- -- --- The Q monad +-- The Q monad -- ----------------------------------------------------- @@ -156,7 +156,7 @@ instance Applicative Q where ----------------------------------------------------- -- --- The TExp type +-- The TExp type -- ----------------------------------------------------- @@ -402,17 +402,17 @@ putQ :: Typeable a => a -> Q () putQ x = Q (qPutQ x) instance Quasi Q where - qNewName = newName - qReport = report - qRecover = recover - qReify = reify + qNewName = newName + qReport = report + qRecover = recover + qReify = reify qReifyInstances = reifyInstances qReifyRoles = reifyRoles qReifyAnnotations = reifyAnnotations qReifyModule = reifyModule qLookupName = lookupName - qLocation = location - qRunIO = runIO + qLocation = location + qRunIO = runIO qAddDependentFile = addDependentFile qAddTopDecls = addTopDecls qAddModFinalizer = addModFinalizer @@ -436,7 +436,7 @@ sequenceQ = sequence ----------------------------------------------------- -- --- The Lift class +-- The Lift class -- ----------------------------------------------------- @@ -521,13 +521,13 @@ rightName = mkNameG DataName "base" "Data.Either" "Right" ----------------------------------------------------- --- Names and uniques +-- Names and uniques ----------------------------------------------------- -newtype ModName = ModName String -- Module name +newtype ModName = ModName String -- Module name deriving (Show,Eq,Ord,Typeable,Data) -newtype PkgName = PkgName String -- package name +newtype PkgName = PkgName String -- package name deriving (Show,Eq,Ord,Typeable,Data) -- | Obtained from 'reifyModule' and 'thisModule'. @@ -552,7 +552,7 @@ pkgString (PkgName m) = m ----------------------------------------------------- --- OccName +-- OccName ----------------------------------------------------- mkOccName :: String -> OccName @@ -563,7 +563,7 @@ occString (OccName occ) = occ ----------------------------------------------------- --- Names +-- Names ----------------------------------------------------- -- -- For "global" names ('NameG') we need a totally unique name, @@ -655,8 +655,8 @@ data NameFlavour | NameL Int# -- ^ Local name bound outside of the TH AST | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST: -- An original name (occurrences only, not binders) - -- Need the namespace too to be sure which - -- thing we are naming + -- Need the namespace too to be sure which + -- thing we are naming deriving ( Typeable ) -- | @@ -702,11 +702,11 @@ ty_NameFlavour = mkDataType "Language.Haskell.TH.Syntax.NameFlavour" [con_NameS, con_NameQ, con_NameU, con_NameL, con_NameG] -data NameSpace = VarName -- ^ Variables - | DataName -- ^ Data constructors - | TcClsName -- ^ Type constructors and classes; Haskell has them - -- in the same name space for now. - deriving( Eq, Ord, Data, Typeable ) +data NameSpace = VarName -- ^ Variables + | DataName -- ^ Data constructors + | TcClsName -- ^ Type constructors and classes; Haskell has them + -- in the same name space for now. + deriving( Eq, Ord, Data, Typeable ) type Uniq = Int @@ -760,16 +760,16 @@ mkName str = split [] (reverse str) where split occ [] = Name (mkOccName occ) NameS - split occ ('.':rev) | not (null occ) - , is_rev_mod_name rev - = Name (mkOccName occ) (NameQ (mkModName (reverse rev))) - -- The 'not (null occ)' guard ensures that - -- mkName "&." = Name "&." NameS - -- The 'is_rev_mod' guards ensure that - -- mkName ".&" = Name ".&" NameS - -- mkName "^.." = Name "^.." NameS -- Trac #8633 - -- mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits") - -- This rather bizarre case actually happened; (.&.) is in Data.Bits + split occ ('.':rev) | not (null occ) + , is_rev_mod_name rev + = Name (mkOccName occ) (NameQ (mkModName (reverse rev))) + -- The 'not (null occ)' guard ensures that + -- mkName "&." = Name "&." NameS + -- The 'is_rev_mod' guards ensure that + -- mkName ".&" = Name ".&" NameS + -- mkName "^.." = Name "^.." NameS -- Trac #8633 + -- mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits") + -- This rather bizarre case actually happened; (.&.) is in Data.Bits split occ (c:rev) = split (c:occ) rev -- Recognises a reversed module name xA.yB.C, @@ -810,13 +810,13 @@ instance Eq Name where instance Ord Name where (Name o1 f1) `compare` (Name o2 f2) = (f1 `compare` f2) `thenCmp` - (o1 `compare` o2) + (o1 `compare` o2) instance Eq NameFlavour where f1 == f2 = cmpEq (f1 `compare` f2) instance Ord NameFlavour where - -- NameS < NameQ < NameU < NameL < NameG + -- NameS < NameQ < NameU < NameL < NameG NameS `compare` NameS = EQ NameS `compare` _ = LT @@ -827,21 +827,21 @@ instance Ord NameFlavour where (NameU _) `compare` NameS = GT (NameU _) `compare` (NameQ _) = GT (NameU u1) `compare` (NameU u2) | isTrue# (u1 <# u2) = LT - | isTrue# (u1 ==# u2) = EQ - | otherwise = GT + | isTrue# (u1 ==# u2) = EQ + | otherwise = GT (NameU _) `compare` _ = LT (NameL _) `compare` NameS = GT (NameL _) `compare` (NameQ _) = GT (NameL _) `compare` (NameU _) = GT (NameL u1) `compare` (NameL u2) | isTrue# (u1 <# u2) = LT - | isTrue# (u1 ==# u2) = EQ - | otherwise = GT + | isTrue# (u1 ==# u2) = EQ + | otherwise = GT (NameL _) `compare` _ = LT (NameG ns1 p1 m1) `compare` (NameG ns2 p2 m2) = (ns1 `compare` ns2) `thenCmp` (p1 `compare` p2) `thenCmp` - (m1 `compare` m2) + (m1 `compare` m2) (NameG _ _ _) `compare` _ = GT data NameIs = Alone | Applied | Infix @@ -860,12 +860,12 @@ showName' ni nm | pnam -> "`" ++ nms ++ "`" | otherwise -> nms where - -- For now, we make the NameQ and NameG print the same, even though - -- NameQ is a qualified name (so what it means depends on what the - -- current scope is), and NameG is an original name (so its meaning - -- should be independent of what's in scope. - -- We may well want to distinguish them in the end. - -- Ditto NameU and NameL + -- For now, we make the NameQ and NameG print the same, even though + -- NameQ is a qualified name (so what it means depends on what the + -- current scope is), and NameG is an original name (so its meaning + -- should be independent of what's in scope. + -- We may well want to distinguish them in the end. + -- Ditto NameU and NameL nms = case nm of Name occ NameS -> occString occ Name occ (NameQ m) -> modString m ++ "." ++ occString occ @@ -932,22 +932,22 @@ mk_unboxed_tup_name n_commas space ----------------------------------------------------- --- Locations +-- Locations ----------------------------------------------------- data Loc = Loc { loc_filename :: String - , loc_package :: String - , loc_module :: String - , loc_start :: CharPos - , loc_end :: CharPos } + , loc_package :: String + , loc_module :: String + , loc_start :: CharPos + , loc_end :: CharPos } -type CharPos = (Int, Int) -- ^ Line and character position +type CharPos = (Int, Int) -- ^ Line and character position ----------------------------------------------------- -- --- The Info returned by reification +-- The Info returned by reification -- ----------------------------------------------------- @@ -1012,9 +1012,9 @@ data Info At present, this is always @'VarT' theName@, but future changes may permit refinement of this. -} - | TyVarI -- Scoped type variable - Name - Type -- What it is bound to + | TyVarI -- Scoped type variable + Name + Type -- What it is bound to deriving( Show, Data, Typeable ) -- | Obtained from 'reifyModule' in the 'Q' Monad. @@ -1123,7 +1123,7 @@ reassociate the tree as necessary. ----------------------------------------------------- -- --- The main syntax data types +-- The main syntax data types -- ----------------------------------------------------- @@ -1138,7 +1138,7 @@ data Lit = CharL Char | WordPrimL Integer | FloatPrimL Rational | DoublePrimL Rational - | StringPrimL [Word8] -- ^ A primitive C-style string, type Addr# + | StringPrimL [Word8] -- ^ A primitive C-style string, type Addr# deriving( Show, Eq, Data, Typeable ) -- We could add Int, Float, Double etc, as we do in HsLit, @@ -1426,7 +1426,7 @@ type constructor at the head. So, ----------------------------------------------- t1 -> t2 ArrowT `AppT` t2 `AppT` t2 [t] ListT `AppT` t - (t1,t2) TupleT 2 `AppT` t1 `AppT` t2 + (t1,t2) TupleT 2 `AppT` t1 `AppT` t2 '(t1,t2) PromotedTupleT 2 `AppT` t1 `AppT` t2 But if the original HsSyn used prefix application, we won't use @@ -1447,7 +1447,7 @@ constructors): -} ----------------------------------------------------- --- Internal helper functions +-- Internal helper functions ----------------------------------------------------- cmpEq :: Ordering -> Bool diff --git a/rts/Linker.c b/rts/Linker.c index 63cf981c58..5919d010f3 100644 --- a/rts/Linker.c +++ b/rts/Linker.c @@ -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 diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index cb4cd5e9fa..3e8612cea7 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -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", diff --git a/rts/StgPrimFloat.c b/rts/StgPrimFloat.c index 6e78546b3e..dad8ff8bc0 100644 --- a/rts/StgPrimFloat.c +++ b/rts/StgPrimFloat.c @@ -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; } diff --git a/testsuite/tests/mdo/should_run/mdorun002.hs b/testsuite/tests/mdo/should_run/mdorun002.hs index 0a09451324..ad40b5f03a 100644 --- a/testsuite/tests/mdo/should_run/mdorun002.hs +++ b/testsuite/tests/mdo/should_run/mdorun002.hs @@ -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 |