diff options
89 files changed, 233 insertions, 230 deletions
diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs index 2e9f09c0b5..0f7d74bbc6 100644 --- a/ghc/compiler/basicTypes/DataCon.lhs +++ b/ghc/compiler/basicTypes/DataCon.lhs @@ -279,7 +279,7 @@ data DataConIds -- may or may not have a wrapper, depending on whether -- the wrapper does anything. - -- *Neither* the worker *nor* the wrapper take the dcStupidTheta dicts as arguments + -- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments -- The wrapper takes dcOrigArgTys as its arguments -- The worker takes dcRepArgTys as its arguments diff --git a/ghc/compiler/basicTypes/Demand.lhs b/ghc/compiler/basicTypes/Demand.lhs index a038a23f6a..50bb0c6ffa 100644 --- a/ghc/compiler/basicTypes/Demand.lhs +++ b/ghc/compiler/basicTypes/Demand.lhs @@ -42,7 +42,7 @@ data Demand = WwLazy -- Argument is lazy as far as we know MaybeAbsent -- (does not imply worker's existence [etc]). -- If MaybeAbsent == True, then it is - -- *definitely* lazy. (NB: Absence implies + -- *definitely* lazy. (NB: Absence implies -- a worker...) | WwStrict -- Argument is strict but that's all we know diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs index fa3f24a4c4..3443a73472 100644 --- a/ghc/compiler/basicTypes/MkId.lhs +++ b/ghc/compiler/basicTypes/MkId.lhs @@ -225,7 +225,7 @@ mkDataConIds wrap_name wkr_name data_con -- If we pretend it is strict then when we see -- case x of y -> $wMkT y -- the simplifier thinks that y is "sure to be evaluated" (because - -- $wMkT is strict) and drops the case. No, $wMkT is not strict. + -- $wMkT is strict) and drops the case. No, $wMkT is not strict. -- -- When the simplifer sees a pattern -- case e of MkT x -> ... diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs index c4d71caa32..2dca6a001a 100644 --- a/ghc/compiler/basicTypes/RdrName.lhs +++ b/ghc/compiler/basicTypes/RdrName.lhs @@ -69,7 +69,7 @@ data RdrName | Qual Module OccName -- A qualified name written by the user in - -- *source* code. The module isn't necessarily + -- *source* code. The module isn't necessarily -- the module where the thing is defined; -- just the one from which it is imported diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs index 02eb902b66..adfafaf069 100644 --- a/ghc/compiler/cmm/PprC.hs +++ b/ghc/compiler/cmm/PprC.hs @@ -370,8 +370,8 @@ pprLit lit = case lit of CmmLabelOff clbl i -> mkW_ <> pprCLabel clbl <> char '+' <> int i CmmLabelDiffOff clbl1 clbl2 i -- WARNING: - -- * the lit must occur in the info table clbl2 - -- * clbl1 must be an SRT, a slow entry point or a large bitmap + -- * the lit must occur in the info table clbl2 + -- * clbl1 must be an SRT, a slow entry point or a large bitmap -- The Mangler is expected to convert any reference to an SRT, -- a slow entry point or a large bitmap -- from an info table to an offset. diff --git a/ghc/compiler/cmm/PprCmm.hs b/ghc/compiler/cmm/PprCmm.hs index 70234321bd..0f9a3d527b 100644 --- a/ghc/compiler/cmm/PprCmm.hs +++ b/ghc/compiler/cmm/PprCmm.hs @@ -134,7 +134,7 @@ pprStmt stmt = case stmt of -- ; CmmNop -> semi - -- // text + -- // text CmmComment s -> text "//" <+> ftext s -- reg = expr; diff --git a/ghc/compiler/codeGen/Bitmap.hs b/ghc/compiler/codeGen/Bitmap.hs index 36915e07d2..c0b490978c 100644 --- a/ghc/compiler/codeGen/Bitmap.hs +++ b/ghc/compiler/codeGen/Bitmap.hs @@ -66,9 +66,9 @@ intsToReverseBitmap size slots{- must be sorted -} | size >= wORD_SIZE_IN_BITS = complement 0 | otherwise = (1 `shiftL` size) - 1 -{-| +{- | Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h. -Some kinds of bitmap pack a size/bitmap into a single word if +Some kinds of bitmap pack a size\/bitmap into a single word if possible, or fall back to an external pointer when the bitmap is too large. This value represents the largest size of bitmap that can be packed into a single word. diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs index e6e1043a47..e4ca141c9e 100644 --- a/ghc/compiler/codeGen/CgBindery.lhs +++ b/ghc/compiler/codeGen/CgBindery.lhs @@ -165,7 +165,7 @@ idInfoToAmode info VirStkLoc sp_off -> do { sp_rel <- getSpRelOffset sp_off ; return (CmmLoad sp_rel mach_rep) } - VirStkLNE sp_off -> getSpRelOffset sp_off ; + VirStkLNE sp_off -> getSpRelOffset sp_off VoidLoc -> return $ pprPanic "idInfoToAmode: void" (ppr (cg_id info)) -- We return a 'bottom' amode, rather than panicing now diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs index fad78d8215..58a43f489c 100644 --- a/ghc/compiler/codeGen/CgCase.lhs +++ b/ghc/compiler/codeGen/CgCase.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgCase.lhs,v 1.73 2005/03/18 13:37:38 simonmar Exp $ +% $Id: CgCase.lhs,v 1.74 2005/03/31 10:16:34 simonmar Exp $ % %******************************************************** %* * @@ -171,7 +171,7 @@ cgCase (StgOpApp op@(StgFCallOp fcall _) args _) live_in_whole_case live_in_alts bndr srt alt_type alts | unsafe_foreign_call = ASSERT( isSingleton alts ) - do -- *must* be an unboxed tuple alt. + do -- *must* be an unboxed tuple alt. -- exactly like the cgInlinePrimOp case for unboxed tuple alts.. { res_tmps <- mapFCs bindNewToTemp non_void_res_ids ; let res_hints = map (typeHint.idType) non_void_res_ids @@ -471,7 +471,7 @@ are inlined alternatives. \begin{code} cgAlgAlts :: GCFlag -> Maybe VirtualSpOffset - -> AltType -- ** AlgAlt or PolyAlt only ** + -> AltType -- ** AlgAlt or PolyAlt only ** -> [StgAlt] -- The alternatives -> FCode ( [(ConTagZ, CgStmts)], -- The branches Maybe CgStmts ) -- The default case @@ -491,7 +491,7 @@ cgAlgAlts gc_flag cc_slot alt_type alts cgAlgAlt :: GCFlag -> Maybe VirtualSpOffset -- Turgid state - -> AltType -- ** AlgAlt or PolyAlt only ** + -> AltType -- ** AlgAlt or PolyAlt only ** -> StgAlt -> FCode (AltCon, CgStmts) diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs index 3c3d4e2494..401da80103 100644 --- a/ghc/compiler/codeGen/CgClosure.lhs +++ b/ghc/compiler/codeGen/CgClosure.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgClosure.lhs,v 1.67 2005/03/18 13:37:40 simonmar Exp $ +% $Id: CgClosure.lhs,v 1.68 2005/03/31 10:16:34 simonmar Exp $ % \section[CgClosure]{Code generation for closures} @@ -155,7 +155,7 @@ cgRhsClosure bndr cc bndr_info srt fvs upd_flag args body = do -- it in the closure. Instead, just bind it to Node on entry. -- NB we can be sure that Node will point to it, because we -- havn't told mkClosureLFInfo about this; so if the binder - -- *was* a free var of its RHS, mkClosureLFInfo thinks it *is* + -- _was_ a free var of its RHS, mkClosureLFInfo thinks it *is* -- stored in the closure itself, so it will make sure that -- Node points to it... let diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs index e154bed545..82276898bc 100644 --- a/ghc/compiler/codeGen/CgHeapery.lhs +++ b/ghc/compiler/codeGen/CgHeapery.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgHeapery.lhs,v 1.44 2005/03/18 13:37:42 simonmar Exp $ +% $Id: CgHeapery.lhs,v 1.45 2005/03/31 10:16:34 simonmar Exp $ % \section[CgHeapery]{Heap management functions} @@ -138,8 +138,8 @@ layOutConstr is_static dflags data_con args = (mkConInfo dflags is_static data_con tot_wds ptr_wds, things_w_offsets) where - (tot_wds, -- #ptr_wds + #nonptr_wds - ptr_wds, -- #ptr_wds + (tot_wds, -- #ptr_wds + #nonptr_wds + ptr_wds, -- #ptr_wds things_w_offsets) = mkVirtHeapOffsets args \end{code} @@ -150,7 +150,7 @@ list \begin{code} mkVirtHeapOffsets :: [(CgRep,a)] -- Things to make offsets for - -> (WordOff, -- *Total* number of words allocated + -> (WordOff, -- _Total_ number of words allocated WordOff, -- Number of words allocated for *pointers* [(a, VirtualHpOffset)]) -- Things with their offsets from start of diff --git a/ghc/compiler/codeGen/CgInfoTbls.hs b/ghc/compiler/codeGen/CgInfoTbls.hs index 940852d078..adfdb1a3de 100644 --- a/ghc/compiler/codeGen/CgInfoTbls.hs +++ b/ghc/compiler/codeGen/CgInfoTbls.hs @@ -191,9 +191,9 @@ mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry -- <srt slot> -- <forward vector table> -- --- * The vector table is only present for vectored returns +-- * The vector table is only present for vectored returns -- --- * The SRT slot is only there if either +-- * The SRT slot is only there if either -- (a) there is SRT info to record, OR -- (b) if the return is vectored -- The latter (b) is necessary so that the vector is in a @@ -346,7 +346,7 @@ emitDirectReturnInstr = do { info_amode <- getSequelAmode ; stmtC (CmmJump (entryCode info_amode) []) } -emitVectoredReturnInstr :: CmmExpr -- *Zero-indexed* constructor tag +emitVectoredReturnInstr :: CmmExpr -- _Zero-indexed_ constructor tag -> Code emitVectoredReturnInstr zero_indexed_tag = do { info_amode <- getSequelAmode diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs index 52f65510d0..db01ee837b 100644 --- a/ghc/compiler/codeGen/CgPrimOp.hs +++ b/ghc/compiler/codeGen/CgPrimOp.hs @@ -121,7 +121,7 @@ emitPrimOp [res] ForeignObjToAddrOp [fo] live emitPrimOp [] WriteForeignObjOp [fo,addr] live = stmtC (CmmStore (cmmOffsetW fo fixedHdrSize) addr) --- #define sizzeofByteArrayzh(r,a) \ +-- #define sizzeofByteArrayzh(r,a) \ -- r = (((StgArrWords *)(a))->words * sizeof(W_)) emitPrimOp [res] SizeofByteArrayOp [arg] live = stmtC $ @@ -130,25 +130,25 @@ emitPrimOp [res] SizeofByteArrayOp [arg] live CmmLit (mkIntCLit wORD_SIZE) ]) --- #define sizzeofMutableByteArrayzh(r,a) \ +-- #define sizzeofMutableByteArrayzh(r,a) \ -- r = (((StgArrWords *)(a))->words * sizeof(W_)) emitPrimOp [res] SizeofMutableByteArrayOp [arg] live = emitPrimOp [res] SizeofByteArrayOp [arg] live --- #define touchzh(o) /* nothing */ +-- #define touchzh(o) /* nothing */ emitPrimOp [] TouchOp [arg] live = nopC --- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a) +-- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a) emitPrimOp [res] ByteArrayContents_Char [arg] live = stmtC (CmmAssign res (cmmOffsetB arg arrWordsHdrSize)) --- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn) +-- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn) emitPrimOp [res] StableNameToIntOp [arg] live = stmtC (CmmAssign res (cmmLoadIndexW arg fixedHdrSize)) --- #define eqStableNamezh(r,sn1,sn2) \ +-- #define eqStableNamezh(r,sn1,sn2) \ -- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn)) emitPrimOp [res] EqStableNameOp [arg1,arg2] live = stmtC (CmmAssign res (CmmMachOp mo_wordEq [ @@ -160,11 +160,11 @@ emitPrimOp [res] EqStableNameOp [arg1,arg2] live emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live = stmtC (CmmAssign res (CmmMachOp mo_wordEq [arg1,arg2])) --- #define addrToHValuezh(r,a) r=(P_)a +-- #define addrToHValuezh(r,a) r=(P_)a emitPrimOp [res] AddrToHValueOp [arg] live = stmtC (CmmAssign res arg) --- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info)) +-- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info)) emitPrimOp [res] DataToTagOp [arg] live = stmtC (CmmAssign res (getConstrTag arg)) @@ -173,7 +173,7 @@ emitPrimOp [res] DataToTagOp [arg] live objects, even if they are in old space. When they become immutable, they can be removed from this scavenge list. -} --- #define unsafeFreezzeArrayzh(r,a) +-- #define unsafeFreezzeArrayzh(r,a) -- { -- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info); -- r = a; @@ -182,7 +182,7 @@ emitPrimOp [res] UnsafeFreezeArrayOp [arg] live = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)), CmmAssign res arg ] --- #define unsafeFreezzeByteArrayzh(r,a) r=(a) +-- #define unsafeFreezzeByteArrayzh(r,a) r=(a) emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live = stmtC (CmmAssign res arg) diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs index 0b77823560..9932613b14 100644 --- a/ghc/compiler/codeGen/CgTailCall.lhs +++ b/ghc/compiler/codeGen/CgTailCall.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgTailCall.lhs,v 1.41 2004/11/26 16:20:12 simonmar Exp $ +% $Id: CgTailCall.lhs,v 1.42 2005/03/31 10:16:34 simonmar Exp $ % %******************************************************** %* * @@ -97,7 +97,7 @@ performTailCall :: CgIdInfo -- The function -> [(CgRep,CmmExpr)] -- Args -> CmmStmts -- Pending simultaneous assignments - -- *** GUARANTEED to contain only stack assignments. + -- *** GUARANTEED to contain only stack assignments. -> Code performTailCall fun_info arg_amodes pending_assts @@ -372,7 +372,7 @@ tailCallPrimOp op args -- ----------------------------------------------------------------------------- -- Return Addresses --- | We always push the return address just before performing a tail call +-- We always push the return address just before performing a tail call -- or return. The reason we leave it until then is because the stack -- slot that the return address is to go into might contain something -- useful. diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index 11dafdd363..0c8e314fcc 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -135,7 +135,7 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods startupHaskell() must supply the name of the init function for the "top" module in the program, and we don't want to require that this name has the version and way info appended to it. - -------------------------------------------------------------------------- */ + -------------------------------------------------------------------------- */ We initialise the module tree by keeping a work-stack, * pointed to by Sp diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs index 1ffbcda56d..da446b6c54 100644 --- a/ghc/compiler/codeGen/SMRep.lhs +++ b/ghc/compiler/codeGen/SMRep.lhs @@ -251,8 +251,8 @@ data SMRep = GenericRep -- GC routines consult sizes in info tbl Bool -- True <=> This is a static closure. Affects how -- we garbage-collect it - !Int -- # ptr words - !Int -- # non-ptr words + !Int -- # ptr words + !Int -- # non-ptr words ClosureType -- closure type | BlackHoleRep diff --git a/ghc/compiler/coreSyn/CoreFVs.lhs b/ghc/compiler/coreSyn/CoreFVs.lhs index f54b268234..d0045bf2fb 100644 --- a/ghc/compiler/coreSyn/CoreFVs.lhs +++ b/ghc/compiler/coreSyn/CoreFVs.lhs @@ -284,8 +284,8 @@ idFreeTyVars :: Id -> TyVarSet -- Only local Ids conjured up locally, can have free type variables. -- (During type checking top-level Ids can have free tyvars) idFreeTyVars id = tyVarsOfType (idType id) --- | isLocalId id = tyVarsOfType (idType id) --- | otherwise = emptyVarSet +-- | isLocalId id = tyVarsOfType (idType id) +-- | otherwise = emptyVarSet idRuleVars ::Id -> VarSet idRuleVars id = ASSERT( isId id) rulesRhsFreeVars (idSpecialisation id) diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs index fbf4927dfd..4b0a59bd63 100644 --- a/ghc/compiler/coreSyn/CoreLint.lhs +++ b/ghc/compiler/coreSyn/CoreLint.lhs @@ -104,9 +104,9 @@ Outstanding issues: -- -- Things are *not* OK if: -- - -- * Unsaturated type app before specialisation has been done; + -- * Unsaturated type app before specialisation has been done; -- - -- * Oversaturated type app after specialisation (eta reduction + -- * Oversaturated type app after specialisation (eta reduction -- may well be happening...); \begin{code} diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs index 0cb191875d..931a1a858b 100644 --- a/ghc/compiler/coreSyn/CoreUnfold.lhs +++ b/ghc/compiler/coreSyn/CoreUnfold.lhs @@ -240,7 +240,7 @@ sizeExpr bOMB_OUT_SIZE top_args expr -- into h; if we inline f first, while it looks small, then g's -- wrapper will get inlined later anyway. To avoid this nasty -- ordering difference, we make (case a of (x,y) -> ...), - -- *where a is one of the arguments* look free. + -- *where a is one of the arguments* look free. other -> -} @@ -561,7 +561,7 @@ callSiteInline dflags active_inline inline_call occ id arg_infos interesting_con | otherwise = case guidance of - UnfoldNever -> False ; + UnfoldNever -> False UnfoldIfGoodArgs n_vals_wanted arg_discounts size res_discount | enough_args && size <= (n_vals_wanted + 1) @@ -622,8 +622,8 @@ computeDiscount :: Int -> [Int] -> Int -> [Bool] -> Bool -> Int computeDiscount n_vals_wanted arg_discounts res_discount arg_infos result_used -- We multiple the raw discounts (args_discount and result_discount) -- ty opt_UnfoldingKeenessFactor because the former have to do with - -- *size* whereas the discounts imply that there's some extra - -- *efficiency* to be gained (e.g. beta reductions, case reductions) + -- *size* whereas the discounts imply that there's some extra + -- *efficiency* to be gained (e.g. beta reductions, case reductions) -- by inlining. -- we also discount 1 for each argument passed, because these will diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs index f7383191d9..24a6eb1c35 100644 --- a/ghc/compiler/coreSyn/CoreUtils.lhs +++ b/ghc/compiler/coreSyn/CoreUtils.lhs @@ -91,7 +91,7 @@ exprType (Var var) = idType var exprType (Lit lit) = literalType lit exprType (Let _ body) = exprType body exprType (Case _ _ ty alts) = ty -exprType (Note (Coerce ty _) e) = ty -- **! should take usage from e +exprType (Note (Coerce ty _) e) = ty -- **! should take usage from e exprType (Note other_note e) = exprType e exprType (Lam binder expr) = mkPiType binder (exprType expr) exprType e@(App _ _) diff --git a/ghc/compiler/deSugar/Check.lhs b/ghc/compiler/deSugar/Check.lhs index 1e4a186845..60502d7518 100644 --- a/ghc/compiler/deSugar/Check.lhs +++ b/ghc/compiler/deSugar/Check.lhs @@ -550,7 +550,7 @@ make_con (ConPatOut (L _ id) _ _ _ (PrefixCon pats) _) (ps, constraints) -- reconstruct parallel array pattern -- --- * don't check for the type only; we need to make sure that we are really +-- * don't check for the type only; we need to make sure that we are really -- dealing with one of the fake constructors and not with the real -- representation diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs index 71df1b1963..43450bc3cf 100644 --- a/ghc/compiler/deSugar/DsExpr.lhs +++ b/ghc/compiler/deSugar/DsExpr.lhs @@ -317,7 +317,7 @@ dsExpr (ExplicitList ty xs) -- we create a list from the array elements and convert them into a list using -- `PrelPArr.toP' -- --- * the main disadvantage to this scheme is that `toP' traverses the list +-- * the main disadvantage to this scheme is that `toP' traverses the list -- twice: once to determine the length and a second time to put to elements -- into the array; this inefficiency could be avoided by exposing some of -- the innards of `PrelPArr' to the compiler (ie, have a `PrelPArrBase') so diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs index 150b90e8b4..a97e79a294 100644 --- a/ghc/compiler/deSugar/DsMeta.hs +++ b/ghc/compiler/deSugar/DsMeta.hs @@ -300,7 +300,7 @@ repC (L loc (ConDecl con tvs (L cloc ctxt) details)) repC (L loc con_decl) = do { dsWarn (loc, hang ds_msg 4 (ppr con_decl)) ; return (panic "DsMeta:repC") } - where + -- gaw 2004 FIX! Need a case for GadtDecl repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ)) @@ -881,7 +881,7 @@ lookupBinder n -- Look up a name that is either locally bound or a global name -- --- * If it is a global name, generate the "original name" representation (ie, +-- * If it is a global name, generate the "original name" representation (ie, -- the <module>:<name> form) for the associated entity -- lookupLOcc :: Located Name -> DsM (Core TH.Name) diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs index 671697b259..11aa01b8c8 100644 --- a/ghc/compiler/deSugar/DsUtils.lhs +++ b/ghc/compiler/deSugar/DsUtils.lhs @@ -325,13 +325,13 @@ mkCoAlgCaseMatchResult var ty match_alts -- Stuff for parallel arrays -- - -- * the following is to desugar cases over fake constructors for + -- * the following is to desugar cases over fake constructors for -- parallel arrays, which are introduced by `tidy1' in the `PArrPat' -- case -- -- Concerning `isPArrFakeAlts': -- - -- * it is *not* sufficient to just check the type of the type + -- * it is *not* sufficient to just check the type of the type -- constructor, as we have to be careful not to confuse the real -- representation of parallel arrays with the fake constructors; -- moreover, a list of alternatives must not mix fake and real diff --git a/ghc/compiler/deSugar/MatchLit.lhs b/ghc/compiler/deSugar/MatchLit.lhs index 5ca0569d64..51c7c98931 100644 --- a/ghc/compiler/deSugar/MatchLit.lhs +++ b/ghc/compiler/deSugar/MatchLit.lhs @@ -88,8 +88,8 @@ tidyLitPat :: HsLit -> LPat Id -> LPat Id -- Result has only the following HsLits: -- HsIntPrim, HsCharPrim, HsFloatPrim -- HsDoublePrim, HsStringPrim ? --- * HsInteger, HsRat, HsInt can't show up in LitPats, --- * HsString has been turned into an NPat in tcPat +-- * HsInteger, HsRat, HsInt can't show up in LitPats, +-- * HsString has been turned into an NPat in tcPat -- and we get rid of HsChar right here tidyLitPat (HsChar c) pat = mkCharLitPat c tidyLitPat lit pat = pat diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs index 99e9e11f85..a4dd7ceac9 100644 --- a/ghc/compiler/ghci/ByteCodeGen.lhs +++ b/ghc/compiler/ghci/ByteCodeGen.lhs @@ -886,7 +886,7 @@ generateCCall d0 s p ccall_spec@(CCallSpec target cconv safety) fn args_r_to_l let -- Get the arg reps, zapping the leading Addr# in the dynamic case - a_reps -- | trace (showSDoc (ppr a_reps_pushed_RAW)) False = error "???" + a_reps -- | trace (showSDoc (ppr a_reps_pushed_RAW)) False = error "???" | is_static = a_reps_pushed_RAW | otherwise = if null a_reps_pushed_RAW then panic "ByteCodeGen.generateCCall: dyn with no args" @@ -1121,7 +1121,7 @@ foreign import ccall unsafe "memcpy" -- of making a multiway branch using a switch tree. -- What a load of hassle! -mkMultiBranch :: Maybe Int -- # datacons in tycon, if alg alt +mkMultiBranch :: Maybe Int -- # datacons in tycon, if alg alt -- a hint; generates better code -- Nothing is always safe -> [(Discr, BCInstrList)] diff --git a/ghc/compiler/ghci/ByteCodeItbls.lhs b/ghc/compiler/ghci/ByteCodeItbls.lhs index c44e562bc0..c4259036a4 100644 --- a/ghc/compiler/ghci/ByteCodeItbls.lhs +++ b/ghc/compiler/ghci/ByteCodeItbls.lhs @@ -223,6 +223,7 @@ vecret_entry 5 = stg_interp_constr6_entry vecret_entry 6 = stg_interp_constr7_entry vecret_entry 7 = stg_interp_constr8_entry +#ifndef __HADDOCK__ -- entry point for direct returns for created constr itbls foreign label "stg_interp_constr_entry" stg_interp_constr_entry :: Ptr () -- and the 8 vectored ones @@ -234,7 +235,7 @@ foreign label "stg_interp_constr5_entry" stg_interp_constr5_entry :: Ptr () foreign label "stg_interp_constr6_entry" stg_interp_constr6_entry :: Ptr () foreign label "stg_interp_constr7_entry" stg_interp_constr7_entry :: Ptr () foreign label "stg_interp_constr8_entry" stg_interp_constr8_entry :: Ptr () - +#endif diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs index 5a0da8f5bd..47302c5050 100644 --- a/ghc/compiler/hsSyn/HsBinds.lhs +++ b/ghc/compiler/hsSyn/HsBinds.lhs @@ -48,7 +48,7 @@ instance OutputableBndr id => Outputable (HsBindGroup id) where = vcat [ppr_isrec, vcat (map ppr sigs), vcat (map ppr (bagToList binds)) - -- *not* pprLHsBinds because we don't want braces; 'let' and + -- *not* pprLHsBinds because we don't want braces; 'let' and -- 'where' include a list of HsBindGroups and we don't want -- several groups of bindings each with braces around. ] diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs index 981c70a3ca..07377827c6 100644 --- a/ghc/compiler/hsSyn/HsDecls.lhs +++ b/ghc/compiler/hsSyn/HsDecls.lhs @@ -586,7 +586,7 @@ instance (OutputableBndr name) -- foreign declarations are distinguished as to whether they define or use a -- Haskell name -- --- * the Boolean value indicates whether the pre-standard deprecated syntax +-- * the Boolean value indicates whether the pre-standard deprecated syntax -- has been used -- type LForeignDecl name = Located (ForeignDecl name) @@ -600,17 +600,17 @@ data ForeignDecl name -- data ForeignImport = -- import of a C entity -- - -- * the two strings specifying a header file or library + -- * the two strings specifying a header file or library -- may be empty, which indicates the absence of a -- header or object specification (both are not used -- in the case of `CWrapper' and when `CFunction' -- has a dynamic target) -- - -- * the calling convention is irrelevant for code + -- * the calling convention is irrelevant for code -- generation in the case of `CLabel', but is needed -- for pretty printing -- - -- * `Safety' is irrelevant for `CLabel' and `CWrapper' + -- * `Safety' is irrelevant for `CLabel' and `CWrapper' -- CImport CCallConv -- ccall or stdcall Safety -- safe or unsafe diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs index b3173cb5c1..56018699eb 100644 --- a/ghc/compiler/hsSyn/HsExpr.lhs +++ b/ghc/compiler/hsSyn/HsExpr.lhs @@ -229,15 +229,15 @@ This gets filled in by the renamer. \begin{code} type ReboundNames id = [(Name, HsExpr id)] --- * Before the renamer, this list is empty +-- * Before the renamer, this list is empty -- --- * After the renamer, it takes the form [(std_name, HsVar actual_name)] +-- * After the renamer, it takes the form [(std_name, HsVar actual_name)] -- For example, for the 'return' op of a monad -- normal case: (GHC.Base.return, HsVar GHC.Base.return) -- with rebindable syntax: (GHC.Base.return, return_22) -- where return_22 is whatever "return" is in scope -- --- * After the type checker, it takes the form [(std_name, <expression>)] +-- * After the type checker, it takes the form [(std_name, <expression>)] -- where <expression> is the evidence for the method \end{code} @@ -814,7 +814,7 @@ pprComp brack stmts %************************************************************************ \begin{code} -data HsSplice id = HsSplice -- $z or $(f 4) +data HsSplice id = HsSplice -- $z or $(f 4) id -- The id is just a unique name to (LHsExpr id) -- identify this splice point diff --git a/ghc/compiler/hsSyn/HsPat.lhs b/ghc/compiler/hsSyn/HsPat.lhs index 912dc4c90d..b8fac5e6e5 100644 --- a/ghc/compiler/hsSyn/HsPat.lhs +++ b/ghc/compiler/hsSyn/HsPat.lhs @@ -86,7 +86,7 @@ data Pat id -- The literal is retained so that the desugarer can readily identify -- equations with identical literal-patterns -- Always HsInteger, HsRat or HsString. - -- *Unlike* NPatIn, for negative literals, the + -- *Unlike* NPatIn, for negative literals, the -- literal is acutally negative! Type -- Type of pattern, t (HsExpr id) -- Of type t -> Bool; detects match diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs index 257b940c8e..d92ca9e4d6 100644 --- a/ghc/compiler/hsSyn/HsTypes.lhs +++ b/ghc/compiler/hsSyn/HsTypes.lhs @@ -208,7 +208,7 @@ type LHsTyVarBndr name = Located (HsTyVarBndr name) data HsTyVarBndr name = UserTyVar name | KindedTyVar name Kind - -- *** NOTA BENE *** A "monotype" in a pragma can have + -- *** NOTA BENE *** A "monotype" in a pragma can have -- for-alls in it, (mostly to do with dictionaries). These -- must be explicitly Kinded. diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs index ab11421f17..20142bf647 100644 --- a/ghc/compiler/iface/LoadIface.lhs +++ b/ghc/compiler/iface/LoadIface.lhs @@ -363,7 +363,7 @@ bumpDeclStats name ----------------- ifaceDeclSubBndrs :: IfaceDecl -> [OccName] --- *Excludes* the 'main' name, but *includes* the implicitly-bound names +-- *Excludes* the 'main' name, but *includes* the implicitly-bound names -- Deeply revolting, because it has to predict what gets bound, -- especially the question of whether there's a wrapper for a datacon diff --git a/ghc/compiler/ilxGen/IlxGen.lhs b/ghc/compiler/ilxGen/IlxGen.lhs index 66d9b0246c..19e9f76ecf 100644 --- a/ghc/compiler/ilxGen/IlxGen.lhs +++ b/ghc/compiler/ilxGen/IlxGen.lhs @@ -1914,7 +1914,7 @@ ilxPrimOpTable op FloatSinhOp -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Sinh(float64) conv.r4") FloatCoshOp -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Cosh(float64) conv.r4") FloatTanhOp -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Tanh(float64) conv.r4") - FloatPowerOp -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Pow(float64, float64) conv.r4") -- ** op, make use of implicit cast to r8... + FloatPowerOp -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Pow(float64, float64) conv.r4") -- ** op, make use of implicit cast to r8... DoubleExpOp -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Exp(float64)") DoubleLogOp -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Log(float64)") diff --git a/ghc/compiler/javaGen/Java.lhs b/ghc/compiler/javaGen/Java.lhs index ec2c5061d3..368be03fc1 100644 --- a/ghc/compiler/javaGen/Java.lhs +++ b/ghc/compiler/javaGen/Java.lhs @@ -112,8 +112,8 @@ data Name = Name String Type -- to store an access to this thing. -- So variables might be Int or Object. - -- ** method calls store the returned - -- ** type, not a complete arg x result type. + -- ** method calls store the returned + -- ** type, not a complete arg x result type. -- -- Thinking: -- ... foo1.foo2(...).foo3 ... diff --git a/ghc/compiler/javaGen/JavaGen.lhs b/ghc/compiler/javaGen/JavaGen.lhs index ff0dd9163d..a3925b18e8 100644 --- a/ghc/compiler/javaGen/JavaGen.lhs +++ b/ghc/compiler/javaGen/JavaGen.lhs @@ -891,7 +891,7 @@ newtype LifterM a = LifterM { unLifterM :: TypeName -> -- this class name Int -> -- uniq supply - ( a -- * + ( a -- * , Frees -- frees , [Decl] -- lifted classes , Int -- The uniqs diff --git a/ghc/compiler/main/DriverPhases.hs b/ghc/compiler/main/DriverPhases.hs index 693c4e17c9..1b2972c145 100644 --- a/ghc/compiler/main/DriverPhases.hs +++ b/ghc/compiler/main/DriverPhases.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPhases.hs,v 1.35 2005/03/18 13:39:05 simonmar Exp $ +-- $Id: DriverPhases.hs,v 1.36 2005/03/31 10:16:38 simonmar Exp $ -- -- GHC Driver -- diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 75c266117b..42797ac15a 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -174,7 +174,6 @@ compile hsc_env mod_summary maybe_old_linkable old_iface = do | otherwise -- Normal Haskell source files -> do - let maybe_stub_o <- compileStub dflags' stub_c_exists let stub_unlinked = case maybe_stub_o of Nothing -> [] diff --git a/ghc/compiler/main/DynFlags.hs b/ghc/compiler/main/DynFlags.hs index fc48857def..f02c27d55c 100644 --- a/ghc/compiler/main/DynFlags.hs +++ b/ghc/compiler/main/DynFlags.hs @@ -239,7 +239,7 @@ data DynFlags = DynFlags { pgm_l :: (String,[Option]), pgm_dll :: (String,[Option]), - -- ** Package flags + -- ** Package flags extraPkgConfs :: [FilePath], -- The -package-conf flags given on the command line, in the order -- they appeared. @@ -247,7 +247,7 @@ data DynFlags = DynFlags { packageFlags :: [PackageFlag], -- The -package and -hide-package flags from the command-line - -- ** Package state + -- ** Package state pkgState :: PackageState, -- hsc dynamic flags diff --git a/ghc/compiler/main/ErrUtils.lhs b/ghc/compiler/main/ErrUtils.lhs index 434b7d77d6..9e43b3fba3 100644 --- a/ghc/compiler/main/ErrUtils.lhs +++ b/ghc/compiler/main/ErrUtils.lhs @@ -18,7 +18,7 @@ module ErrUtils ( dumpIfSet, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or, mkDumpDoc, showPass, - -- * Messages during compilation + -- * Messages during compilation setMsgHandler, putMsg, compilationProgressMsg, diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs index 18ba708081..df6c21a2d5 100644 --- a/ghc/compiler/main/GHC.hs +++ b/ghc/compiler/main/GHC.hs @@ -28,7 +28,7 @@ module GHC ( addTarget, guessTarget, - -- * Loading/compiling the program + -- * Loading\/compiling the program depanal, load, SuccessFlag(..), -- also does depanal workingDirectoryChanged, @@ -210,7 +210,7 @@ GLOBAL_VAR(v_initDynFlags, error "initDynFlags", DynFlags) -- | Starts a new session. A session consists of a set of loaded -- modules, a set of options (DynFlags), and an interactive context. --- ToDo: GhcMode should say "keep typechecked code" and/or "keep renamed +-- ToDo: GhcMode should say "keep typechecked code" and\/or "keep renamed -- code". newSession :: GhcMode -> IO Session newSession mode = do @@ -256,7 +256,7 @@ setMsgHandler = ErrUtils.setMsgHandler -- | Sets the targets for this session. Each target may be a module name -- or a filename. The targets correspond to the set of root modules for --- the program/library. Unloading the current program is achieved by +-- the program\/library. Unloading the current program is achieved by -- setting the current set of targets to be empty, followed by load. setTargets :: Session -> [Target] -> IO () setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets }) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index e1ee2615a3..0cf54726a5 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -10,9 +10,9 @@ module HscMain ( hscMain, newHscEnv, hscCmmFile, hscBufferCheck, hscFileCheck, #ifdef GHCI - , hscStmt, hscTcExpr, hscKcType - , hscGetInfo, GetInfoResult - , compileExpr + hscStmt, hscTcExpr, hscKcType, + hscGetInfo, GetInfoResult, + compileExpr, #endif ) where @@ -171,7 +171,7 @@ hscMain hsc_env msg_act mod_summary source_unchanged have_object maybe_old_iface = do { (recomp_reqd, maybe_checked_iface) <- - _scc_ "checkOldIface" + {-# SCC "checkOldIface" #-} checkOldIface hsc_env mod_summary source_unchanged maybe_old_iface; @@ -201,7 +201,7 @@ hscNoRecomp hsc_env msg_act mod_summary = do { compilationProgressMsg (hsc_dflags hsc_env) $ ("Skipping " ++ showModMsg have_object mod_summary) - ; new_details <- _scc_ "tcRnIface" + ; new_details <- {-# SCC "tcRnIface" #-} typecheckIface hsc_env old_iface ; ; dumpIfaceStats hsc_env @@ -233,7 +233,7 @@ hscCoreFrontEnd hsc_env msg_act mod_summary = do { ------------------- -- RENAME and TYPECHECK ------------------- - ; (tc_msgs, maybe_tc_result) <- _scc_ "TypeCheck" + ; (tc_msgs, maybe_tc_result) <- {-# SCC "TypeCheck" #-} tcRnExtCore hsc_env rdr_module ; msg_act tc_msgs ; case maybe_tc_result of @@ -270,7 +270,7 @@ hscFileFrontEnd hsc_env msg_act mod_summary = do { -- RENAME and TYPECHECK ------------------- (tc_msgs, maybe_tc_result) - <- _scc_ "Typecheck-Rename" + <- {-# SCC "Typecheck-Rename" #-} tcRnModule hsc_env (ms_hsc_src mod_summary) rdr_module ; msg_act tc_msgs @@ -281,7 +281,7 @@ hscFileFrontEnd hsc_env msg_act mod_summary = do { ------------------- -- DESUGAR ------------------- - ; (warns, maybe_ds_result) <- _scc_ "DeSugar" + ; (warns, maybe_ds_result) <- {-# SCC "DeSugar" #-} deSugar hsc_env tc_result ; msg_act (warns, emptyBag) ; case maybe_ds_result of @@ -296,7 +296,7 @@ hscBootBackEnd :: HscEnv -> ModSummary -> Maybe ModIface -> Maybe ModGuts -> IO hscBootBackEnd hsc_env mod_summary maybe_checked_iface Nothing = return HscFail hscBootBackEnd hsc_env mod_summary maybe_checked_iface (Just ds_result) - = do { final_iface <- _scc_ "MkFinalIface" + = do { final_iface <- {-# SCC "MkFinalIface" #-} mkIface hsc_env (ms_location mod_summary) maybe_checked_iface ds_result @@ -327,7 +327,7 @@ hscBackEnd hsc_env mod_summary maybe_checked_iface (Just ds_result) ------------------- -- FLATTENING ------------------- - ; flat_result <- _scc_ "Flattening" + ; flat_result <- {-# SCC "Flattening" #-} flatten hsc_env ds_result @@ -357,13 +357,13 @@ hscBackEnd hsc_env mod_summary maybe_checked_iface (Just ds_result) ------------------- -- SIMPLIFY ------------------- - ; simpl_result <- _scc_ "Core2Core" + ; simpl_result <- {-# SCC "Core2Core" #-} core2core hsc_env flat_result ------------------- -- TIDY ------------------- - ; tidy_result <- _scc_ "CoreTidy" + ; tidy_result <- {-# SCC "CoreTidy" #-} tidyCorePgm hsc_env simpl_result -- Emit external core @@ -379,7 +379,7 @@ hscBackEnd hsc_env mod_summary maybe_checked_iface (Just ds_result) -- This has to happen *after* code gen so that the back-end -- info has been set. Not yet clear if it matters waiting -- until after code output - ; new_iface <- _scc_ "MkFinalIface" + ; new_iface <- {-# SCC "MkFinalIface" #-} mkIface hsc_env (ms_location mod_summary) maybe_checked_iface tidy_result @@ -444,7 +444,7 @@ hscBufferCheck hsc_env buffer msg_act = do hscBufferTypecheck hsc_env rdr_module msg_act hscBufferTypecheck hsc_env rdr_module msg_act = do - (tc_msgs, maybe_tc_result) <- _scc_ "Typecheck-Rename" + (tc_msgs, maybe_tc_result) <- {-# SCC "Typecheck-Rename" #-} tcRnModule hsc_env HsSrcFile rdr_module msg_act tc_msgs case maybe_tc_result of @@ -466,7 +466,7 @@ hscCodeGen dflags ------------------- -- PREPARE FOR CODE GENERATION -- Do saturation and convert to A-normal form - prepd_binds <- _scc_ "CorePrep" + prepd_binds <- {-# SCC "CorePrep" #-} corePrepPgm dflags core_binds type_env; case hscTarget dflags of @@ -489,11 +489,11 @@ hscCodeGen dflags other -> do ----------------- Convert to STG ------------------ - (stg_binds, cost_centre_info) <- _scc_ "CoreToStg" + (stg_binds, cost_centre_info) <- {-# SCC "CoreToStg" #-} myCoreToStg dflags this_mod prepd_binds ------------------ Code generation ------------------ - abstractC <- _scc_ "CodeGen" + abstractC <- {-# SCC "CodeGen" #-} codeGen dflags this_mod type_env foreign_stubs dir_imps cost_centre_info stg_binds @@ -519,9 +519,9 @@ hscCmmFile dflags filename = do myParseModule dflags src_filename maybe_src_buf - = do -------------------------- Parser ---------------- - showPass dflags "Parser" - _scc_ "Parser" do + = -------------------------- Parser ---------------- + showPass dflags "Parser" >> + {-# SCC "Parser" #-} do -- sometimes we already have the buffer in memory, perhaps -- because we needed to parse the imports out of it, or get the @@ -550,10 +550,10 @@ myParseModule dflags src_filename maybe_src_buf myCoreToStg dflags this_mod prepd_binds = do - stg_binds <- _scc_ "Core2Stg" + stg_binds <- {-# SCC "Core2Stg" #-} coreToStg dflags prepd_binds - (stg_binds2, cost_centre_info) <- _scc_ "Core2Stg" + (stg_binds2, cost_centre_info) <- {-# SCC "Core2Stg" #-} stg2stg dflags this_mod stg_binds return (stg_binds2, cost_centre_info) @@ -671,8 +671,8 @@ hscParseThing :: Outputable thing -- Nothing => Parse error (message already printed) -- Just x => success hscParseThing parser dflags str - = do showPass dflags "Parser" - _scc_ "Parser" do + = showPass dflags "Parser" >> + {-# SCC "Parser" #-} do buf <- stringToStringBuffer str diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index c170f52885..6a43db5e0c 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -191,8 +191,8 @@ hscEPS hsc_env = readIORef (hsc_EPS hsc_env) data Target = Target TargetId (Maybe (StringBuffer,ClockTime)) data TargetId - = TargetModule Module -- | A module name: search for the file - | TargetFile FilePath -- | A filename: parse it to find the module name. + = TargetModule Module -- ^ A module name: search for the file + | TargetFile FilePath -- ^ A filename: parse it to find the module name. pprTarget :: Target -> SDoc diff --git a/ghc/compiler/main/Packages.lhs b/ghc/compiler/main/Packages.lhs index 0df3d184a6..45b083513b 100644 --- a/ghc/compiler/main/Packages.lhs +++ b/ghc/compiler/main/Packages.lhs @@ -368,7 +368,6 @@ mkPackageState dflags pkg_db = do -- when (not (null overlaps)) $ overlappingError pkg overlaps -- - let return (addListToUFM modmap [(m, (pkg, m `elem` exposed_mods)) | m <- all_mods]) diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs index b18cd8a3bc..d919bcf541 100644 --- a/ghc/compiler/main/SysTools.lhs +++ b/ghc/compiler/main/SysTools.lhs @@ -656,8 +656,8 @@ slash s1 s2 = s1 ++ ('/' : s2) ----------------------------------------------------------------------------- -- Define getBaseDir :: IO (Maybe String) -#if defined(mingw32_HOST_OS) getBaseDir :: IO (Maybe String) +#if defined(mingw32_HOST_OS) -- Assuming we are running ghc, accessed by path $()/bin/ghc.exe, -- return the path $(stuff). Note that we drop the "bin/" directory too. getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32. @@ -673,7 +673,7 @@ getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32. foreign import stdcall unsafe "GetModuleFileNameA" getModuleFileName :: Ptr () -> CString -> Int -> IO Int32 #else -getBaseDir :: IO (Maybe String) = do return Nothing +getBaseDir = return Nothing #endif #ifdef mingw32_HOST_OS diff --git a/ghc/compiler/nativeGen/MachCodeGen.hs b/ghc/compiler/nativeGen/MachCodeGen.hs index 9e7787c73e..35e010556d 100644 --- a/ghc/compiler/nativeGen/MachCodeGen.hs +++ b/ghc/compiler/nativeGen/MachCodeGen.hs @@ -1553,7 +1553,7 @@ extendSExpr rep x = CmmMachOp (MO_S_Conv rep I32) [x] extendUExpr I32 x = x extendUExpr rep x = CmmMachOp (MO_U_Conv rep I32) [x] --- ###FIXME: exact code duplication from x86 case +-- ###FIXME: exact code duplication from x86 case -- The dual to getAnyReg: compute an expression into a register, but -- we don't mind which one it is. getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock) @@ -2085,7 +2085,7 @@ condFltCode cond x y #endif /* sparc_TARGET_ARCH */ #if powerpc_TARGET_ARCH --- ###FIXME: I16 and I8! +-- ###FIXME: I16 and I8! condIntCode cond x (CmmLit (CmmInt y rep)) | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y = do diff --git a/ghc/compiler/nativeGen/MachInstrs.hs b/ghc/compiler/nativeGen/MachInstrs.hs index 28e2578dc0..1b662e3c61 100644 --- a/ghc/compiler/nativeGen/MachInstrs.hs +++ b/ghc/compiler/nativeGen/MachInstrs.hs @@ -452,8 +452,8 @@ bit or 64 bit precision. | PUSH MachRep Operand | POP MachRep Operand -- both unused (SDM): - -- | PUSHA - -- | POPA + -- | PUSHA + -- | POPA -- Jumping around. | JMP Operand @@ -495,15 +495,15 @@ ffree_before_nonlocal_transfers insn is_G_instr :: Instr -> Bool is_G_instr instr = case instr of - GMOV _ _ -> True; GLD _ _ _ -> True; GST _ _ _ -> True; - GLDZ _ -> True; GLD1 _ -> True; - GFTOI _ _ -> True; GDTOI _ _ -> True; - GITOF _ _ -> True; GITOD _ _ -> True; + GMOV _ _ -> True; GLD _ _ _ -> True; GST _ _ _ -> True + GLDZ _ -> True; GLD1 _ -> True + GFTOI _ _ -> True; GDTOI _ _ -> True + GITOF _ _ -> True; GITOD _ _ -> True GADD _ _ _ _ -> True; GDIV _ _ _ _ -> True GSUB _ _ _ _ -> True; GMUL _ _ _ _ -> True GCMP _ _ _ -> True; GABS _ _ _ -> True GNEG _ _ _ -> True; GSQRT _ _ _ -> True - GSIN _ _ _ -> True; GCOS _ _ _ -> True; GTAN _ _ _ -> True; + GSIN _ _ _ -> True; GCOS _ _ _ -> True; GTAN _ _ _ -> True GFREE -> panic "is_G_instr: GFREE (!)" other -> False diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs index ec28f70075..a3946a7fe0 100644 --- a/ghc/compiler/nativeGen/MachRegs.lhs +++ b/ghc/compiler/nativeGen/MachRegs.lhs @@ -1156,7 +1156,7 @@ callerSaves CurrentNursery = True callerSaves _ = False --- | Returns 'Nothing' if this global register is not stored +-- | Returns 'Nothing' if this global register is not stored -- in a real machine register, otherwise returns @'Just' reg@, where -- reg is the machine register it is stored in. diff --git a/ghc/compiler/nativeGen/PositionIndependentCode.hs b/ghc/compiler/nativeGen/PositionIndependentCode.hs index a874270b19..acf37856dc 100644 --- a/ghc/compiler/nativeGen/PositionIndependentCode.hs +++ b/ghc/compiler/nativeGen/PositionIndependentCode.hs @@ -170,8 +170,8 @@ howToAccessLabel _ lbl | labelDynamic lbl = AccessViaSymbolPtr -- Mach-O (Darwin, Mac OS X) -- -- Indirect access is required in the following cases: --- * things imported from a dynamic library --- * things from a different module, if we're generating PIC code +-- * things imported from a dynamic library +-- * things from a different module, if we're generating PIC code -- It is always possible to access something indirectly, -- even when it's not necessary. diff --git a/ghc/compiler/ndpFlatten/FlattenInfo.hs b/ghc/compiler/ndpFlatten/FlattenInfo.hs index 306797166c..f759242455 100644 --- a/ghc/compiler/ndpFlatten/FlattenInfo.hs +++ b/ghc/compiler/ndpFlatten/FlattenInfo.hs @@ -31,7 +31,7 @@ import PrelNames (fstName, andName, orName, lengthPName, replicatePName, -- this is a list of names that need to be available if flattening is -- performed (EXPORTED) -- --- * needs to be kept in sync with the names used in Core generation in +-- * needs to be kept in sync with the names used in Core generation in -- `FlattenMonad' and `NDPCoreUtils' -- namesNeededForFlattening :: FreeVars diff --git a/ghc/compiler/ndpFlatten/FlattenMonad.hs b/ghc/compiler/ndpFlatten/FlattenMonad.hs index 9f89563f6a..43e804ccee 100644 --- a/ghc/compiler/ndpFlatten/FlattenMonad.hs +++ b/ghc/compiler/ndpFlatten/FlattenMonad.hs @@ -199,18 +199,18 @@ mkBind lexeme e = -- extend the parallel context by the given set of variables (EXPORTED) -- --- * if there is no parallel context at the moment, the first element of the +-- * if there is no parallel context at the moment, the first element of the -- variable list will be used to determine the new parallel context -- --- * the second argument is executed in the current context extended with the +-- * the second argument is executed in the current context extended with the -- given variables -- --- * the variables must already have been lifted by transforming their type, +-- * the variables must already have been lifted by transforming their type, -- but they *must* have retained their original name (or, at least, their -- unique); this is needed so that they match the original variable in -- variable environments -- --- * any trace of the given set of variables has to be removed from the state +-- * any trace of the given set of variables has to be removed from the state -- at the end of this operation -- extendContext :: [Var] -> Flatten a -> Flatten a @@ -232,12 +232,12 @@ extendContext vs m = Flatten $ \state -> -- execute the second argument in a restricted context (EXPORTED) -- --- * all variables in the current parallel context are packed according to +-- * all variables in the current parallel context are packed according to -- the permutation vector associated with the variable passed as the first -- argument (ie, all elements of vectorised context variables that are -- invalid in the restricted context are dropped) -- --- * the returned list of core binders contains the operations that perform +-- * the returned list of core binders contains the operations that perform -- the restriction on all variables in the parallel context that *do* occur -- during the execution of the second argument (ie, `liftVar' is executed at -- least once on any such variable) @@ -286,14 +286,14 @@ packContext perm m = Flatten $ \state -> -- lift a single variable in the current context (EXPORTED) -- --- * if the variable does not occur in the context, it's value is vectorised to +-- * if the variable does not occur in the context, it's value is vectorised to -- match the size of the current context -- --- * otherwise, the variable is replaced by whatever the context environment +-- * otherwise, the variable is replaced by whatever the context environment -- maps it to (this may either be simply the lifted version of the original -- variable or a packed variant of that variable) -- --- * the monad keeps track of all lifted variables that occur in the parallel +-- * the monad keeps track of all lifted variables that occur in the parallel -- context, so that `packContext' can determine the correct set of core -- bindings -- @@ -311,7 +311,7 @@ liftVar var = Flatten $ \s -> -- lift a constant expression in the current context (EXPORTED) -- --- * the value of the constant expression is vectorised to match the current +-- * the value of the constant expression is vectorised to match the current -- parallel context -- liftConst :: CoreExpr -> Flatten CoreExpr @@ -326,7 +326,7 @@ liftConst e = Flatten $ \s -> -- pick those variables of the given set that occur (if albeit in lifted form) -- in the current parallel context (EXPORTED) -- --- * the variables returned are from the given set and *not* the corresponding +-- * the variables returned are from the given set and *not* the corresponding -- context variables -- intersectWithContext :: VarSet -> Flatten [Var] @@ -382,10 +382,10 @@ mk'neq ty a1 a2 = return (mkApps (Var neqName) [a1, a2]) where tc = tyConAppTyCon ty -- - neqName {- | name == charPrimTyConName = neqCharName -} + neqName {- | name == charPrimTyConName = neqCharName -} | tc == intPrimTyCon = primOpId IntNeOp - {- | name == floatPrimTyConName = neqFloatName -} - {- | name == doublePrimTyConName = neqDoubleName -} + {- | name == floatPrimTyConName = neqFloatName -} + {- | name == doublePrimTyConName = neqDoubleName -} | otherwise = pprPanic "FlattenMonad.mk'neq: " (ppr ty) @@ -443,7 +443,7 @@ mkFunApp name args = -- get the `Id' of a known `Name' -- --- * this can be the `Name' of any function that's visible on the toplevel of +-- * this can be the `Name' of any function that's visible on the toplevel of -- the current compilation unit -- lookupName :: Name -> Flatten Id diff --git a/ghc/compiler/ndpFlatten/Flattening.hs b/ghc/compiler/ndpFlatten/Flattening.hs index 3fc1d5565e..276b6a96d1 100644 --- a/ghc/compiler/ndpFlatten/Flattening.hs +++ b/ghc/compiler/ndpFlatten/Flattening.hs @@ -755,7 +755,7 @@ mkIndexOfExprDft idType b lits = -- create a back-permute binder -- --- * `mkDftBackpermute ty indexArrayVar srcArrayVar dftArrayVar' creates a +-- * `mkDftBackpermute ty indexArrayVar srcArrayVar dftArrayVar' creates a -- Core binding of the form -- -- x = bpermuteDftP indexArrayVar srcArrayVar dftArrayVar diff --git a/ghc/compiler/ndpFlatten/NDPCoreUtils.hs b/ghc/compiler/ndpFlatten/NDPCoreUtils.hs index 85b0110be0..6e6b94f175 100644 --- a/ghc/compiler/ndpFlatten/NDPCoreUtils.hs +++ b/ghc/compiler/ndpFlatten/NDPCoreUtils.hs @@ -84,7 +84,7 @@ funTyArgs = splitFunTy -- for a type of the form `[:t:]', yield `t' (EXPORTED) -- --- * if the type has any other form, a fatal error occurs +-- * if the type has any other form, a fatal error occurs -- parrElemTy :: Type -> Type parrElemTy ty = @@ -100,7 +100,7 @@ parrElemTy ty = -- make a tuple construction expression from a list of argument types and -- argument values (EXPORTED) -- --- * the two lists need to be of the same length +-- * the two lists need to be of the same length -- mkTuple :: [Type] -> [CoreExpr] -> CoreExpr mkTuple [] [] = Var unitDataConId diff --git a/ghc/compiler/parser/Ctype.lhs b/ghc/compiler/parser/Ctype.lhs index d97d5e0c21..dfdb94a0c0 100644 --- a/ghc/compiler/parser/Ctype.lhs +++ b/ghc/compiler/parser/Ctype.lhs @@ -93,7 +93,7 @@ charType c = case c of '\10' -> cSpace -- \n (not allowed in strings, so !cAny) '\11' -> cAny + cSpace -- \v '\12' -> cAny + cSpace -- \f - '\13' -> cAny + cSpace -- ^M + '\13' -> cAny + cSpace -- ^M '\14' -> 0 -- \016 '\15' -> 0 -- \017 '\16' -> 0 -- \020 @@ -115,19 +115,19 @@ charType c = case c of '\32' -> cAny + cSpace -- '\33' -> cAny + cSymbol -- ! '\34' -> cAny -- " - '\35' -> cAny + cSymbol -- # - '\36' -> cAny + cSymbol -- $ + '\35' -> cAny + cSymbol -- # + '\36' -> cAny + cSymbol -- $ '\37' -> cAny + cSymbol -- % '\38' -> cAny + cSymbol -- & '\39' -> cAny + cIdent -- ' '\40' -> cAny -- ( '\41' -> cAny -- ) - '\42' -> cAny + cSymbol -- * + '\42' -> cAny + cSymbol -- * '\43' -> cAny + cSymbol -- + '\44' -> cAny -- , '\45' -> cAny + cSymbol -- - '\46' -> cAny + cSymbol -- . - '\47' -> cAny + cSymbol -- / + '\47' -> cAny + cSymbol -- / '\48' -> cAny + cIdent + cDigit -- 0 '\49' -> cAny + cIdent + cDigit -- 1 '\50' -> cAny + cIdent + cDigit -- 2 @@ -174,7 +174,7 @@ charType c = case c of '\91' -> cAny -- [ '\92' -> cAny + cSymbol -- backslash '\93' -> cAny -- ] - '\94' -> cAny + cSymbol -- ^ + '\94' -> cAny + cSymbol -- ^ '\95' -> cAny + cIdent + cLower -- _ '\96' -> cAny -- ` '\97' -> cAny + cIdent + cLower -- a @@ -204,7 +204,7 @@ charType c = case c of '\121' -> cAny + cIdent + cLower -- y '\122' -> cAny + cIdent + cLower -- z '\123' -> cAny -- { - '\124' -> cAny + cSymbol -- | + '\124' -> cAny + cSymbol -- | '\125' -> cAny -- } '\126' -> cAny + cSymbol -- ~ '\127' -> 0 -- \177 diff --git a/ghc/compiler/parser/Lexer.x b/ghc/compiler/parser/Lexer.x index 89d288abfe..c7ffc592e0 100644 --- a/ghc/compiler/parser/Lexer.x +++ b/ghc/compiler/parser/Lexer.x @@ -425,25 +425,25 @@ data Token | ITprimdouble Rational -- MetaHaskell extension tokens - | ITopenExpQuote -- [| or [e| - | ITopenPatQuote -- [p| - | ITopenDecQuote -- [d| - | ITopenTypQuote -- [t| - | ITcloseQuote -- |] - | ITidEscape FastString -- $x - | ITparenEscape -- $( - | ITvarQuote -- ' - | ITtyQuote -- '' + | ITopenExpQuote -- [| or [e| + | ITopenPatQuote -- [p| + | ITopenDecQuote -- [d| + | ITopenTypQuote -- [t| + | ITcloseQuote -- |] + | ITidEscape FastString -- $x + | ITparenEscape -- $( + | ITvarQuote -- ' + | ITtyQuote -- '' -- Arrow notation extension | ITproc | ITrec - | IToparenbar -- (| - | ITcparenbar -- |) - | ITlarrowtail -- -< - | ITrarrowtail -- >- - | ITLarrowtail -- -<< - | ITRarrowtail -- >>- + | IToparenbar -- (| + | ITcparenbar -- |) + | ITlarrowtail -- -< + | ITrarrowtail -- >- + | ITLarrowtail -- -<< + | ITRarrowtail -- >>- | ITunknown String -- Used when the lexer can't make sense of it | ITeof -- end of file token diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs index 5a258a19e9..5146e4ab7d 100644 --- a/ghc/compiler/parser/RdrHsSyn.lhs +++ b/ghc/compiler/parser/RdrHsSyn.lhs @@ -20,30 +20,30 @@ module RdrHsSyn ( findSplice, mkGroup, -- Stuff to do with Foreign declarations - , CallConv(..) - , mkImport -- CallConv -> Safety + CallConv(..), + mkImport, -- CallConv -> Safety -- -> (FastString, RdrName, RdrNameHsType) -- -> P RdrNameHsDecl - , mkExport -- CallConv + mkExport, -- CallConv -- -> (FastString, RdrName, RdrNameHsType) -- -> P RdrNameHsDecl - , mkExtName -- RdrName -> CLabelString + mkExtName, -- RdrName -> CLabelString -- Bunch of functions in the parser monad for -- checking and constructing values - , checkPrecP -- Int -> P Int - , checkContext -- HsType -> P HsContext - , checkPred -- HsType -> P HsPred - , checkTyClHdr - , checkSynHdr - , checkInstType -- HsType -> P HsType - , checkPattern -- HsExp -> P HsPat - , checkPatterns -- SrcLoc -> [HsExp] -> P [HsPat] - , checkDo -- [Stmt] -> P [Stmt] - , checkMDo -- [Stmt] -> P [Stmt] - , checkValDef -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl - , checkValSig -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl - , parseError -- String -> Pa + checkPrecP, -- Int -> P Int + checkContext, -- HsType -> P HsContext + checkPred, -- HsType -> P HsPred + checkTyClHdr, + checkSynHdr, + checkInstType, -- HsType -> P HsType + checkPattern, -- HsExp -> P HsPat + checkPatterns, -- SrcLoc -> [HsExp] -> P [HsPat] + checkDo, -- [Stmt] -> P [Stmt] + checkMDo, -- [Stmt] -> P [Stmt] + checkValDef, -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl + checkValSig, -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl + parseError, -- String -> Pa ) where #include "HsVersions.h" @@ -187,7 +187,7 @@ analyser. \begin{code} --- | Groups together bindings for a single function +-- | Groups together bindings for a single function cvTopDecls :: OrdList (LHsDecl RdrName) -> [LHsDecl RdrName] cvTopDecls decls = go (fromOL decls) where diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 36b9520eef..5ed26fc2f5 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -101,6 +101,7 @@ wired-in Ids. \begin{code} ghcPrimExports :: [RdrAvailInfo] +ghcPrimExports = map (Avail . nameOccName . idName) ghcPrimIds ++ map (Avail . primOpOcc) allThePrimOps ++ [ AvailTC occ [occ] | diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index 69d924f5eb..0b85276b36 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -946,7 +946,7 @@ arrAIdKey = mkPreludeMiscIdUnique 119 composeAIdKey = mkPreludeMiscIdUnique 120 -- >>> firstAIdKey = mkPreludeMiscIdUnique 121 appAIdKey = mkPreludeMiscIdUnique 122 -choiceAIdKey = mkPreludeMiscIdUnique 123 -- ||| +choiceAIdKey = mkPreludeMiscIdUnique 123 -- ||| loopAIdKey = mkPreludeMiscIdUnique 124 ---------------- Template Haskell ------------------- diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs index 7f78ecd449..9dc312d290 100644 --- a/ghc/compiler/prelude/TysWiredIn.lhs +++ b/ghc/compiler/prelude/TysWiredIn.lhs @@ -485,7 +485,7 @@ mkPArrTy ty = mkTyConApp parrTyCon [ty] -- represents the type constructor of parallel arrays -- --- * this must match the definition in `PrelPArr' +-- * this must match the definition in `PrelPArr' -- -- NB: Although the constructor is given here, it will not be accessible in -- user code as it is not in the environment of any compiled module except @@ -511,7 +511,7 @@ isPArrTyCon tc = tyConName tc == parrTyConName -- fake array constructors -- --- * these constructors are never really used to represent array values; +-- * these constructors are never really used to represent array values; -- however, they are very convenient during desugaring (and, in particular, -- in the pattern matching compiler) to treat array pattern just like -- yet another constructor pattern diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index a5808844f3..fadf87a6d5 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -253,7 +253,7 @@ lookupGlobalOccRn rdr_name Nothing -> -- We allow qualified names on the command line to refer to - -- *any* name exported by any module in scope, just as if + -- *any* name exported by any module in scope, just as if -- there was an "import qualified M" declaration for every -- module. getModule `thenM` \ mod -> diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs index 2b43899235..8a8cc321e7 100644 --- a/ghc/compiler/rename/RnNames.lhs +++ b/ghc/compiler/rename/RnNames.lhs @@ -355,7 +355,7 @@ getLocalDeclBinders mod (HsGroup {hs_valds = val_decls, mappM new_tc tycl_decls `thenM` \ tc_avails -> -- In a hs-boot file, the value binders come from the - -- *signatures*, and there should be no foreign binders + -- *signatures*, and there should be no foreign binders tcIsHsBoot `thenM` \ is_hs_boot -> let val_bndrs | is_hs_boot = sig_hs_bndrs | otherwise = for_hs_bndrs ++ val_hs_bndrs @@ -468,7 +468,7 @@ filterImports iface imp_spec (Just (want_hiding, import_items)) all_names get_item item@(IEThingAbs n) | want_hiding -- hiding( C ) -- Here the 'C' can be a data constructor - -- *or* a type/class, or even both + -- *or* a type/class, or even both = case concat [check_item item, check_item (IEVar data_n)] of [] -> bale_out item names -> succeed_with True names diff --git a/ghc/compiler/simplCore/SATMonad.lhs b/ghc/compiler/simplCore/SATMonad.lhs index 0df2551e3f..9786f448af 100644 --- a/ghc/compiler/simplCore/SATMonad.lhs +++ b/ghc/compiler/simplCore/SATMonad.lhs @@ -205,7 +205,7 @@ saTransform binder rhs nonrec_rhs = origLams local_body -- HACK! The following is a fake SysLocal binder with - -- *the same* unique as binder. + -- *the same* unique as binder. -- the reason for this is the following: -- this binder *will* get inlined but if it happen to be -- a top level binder it is never removed as dead code, diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs index 36b47d8dd8..f43f24104d 100644 --- a/ghc/compiler/simplStg/SimplStg.lhs +++ b/ghc/compiler/simplStg/SimplStg.lhs @@ -69,7 +69,7 @@ stg2stg dflags module_name binds end_pass us2 "StgStats" ccs binds StgDoMassageForProfiling -> - _scc_ "ProfMassage" + {-# SCC "ProfMassage" #-} let (collected_CCs, binds3) = stgMassageForProfiling dflags module_name us1 binds diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs index c5d5d73d37..f276caeb5e 100644 --- a/ghc/compiler/specialise/Specialise.lhs +++ b/ghc/compiler/specialise/Specialise.lhs @@ -1007,7 +1007,7 @@ mkCallUDs subst f args || not (all isClassPred theta) -- Only specialise if all overloading is on class params. -- In ptic, with implicit params, the type args - -- *don't* say what the value of the implicit param is! + -- *don't* say what the value of the implicit param is! || not (spec_tys `lengthIs` n_tyvars) || not ( dicts `lengthIs` n_dicts) || maybeToBool (lookupRule (\act -> True) (substInScope subst) emptyRuleBase f args) diff --git a/ghc/compiler/stgSyn/StgLint.lhs b/ghc/compiler/stgSyn/StgLint.lhs index 0aa6aaa79f..ba1f6c7c36 100644 --- a/ghc/compiler/stgSyn/StgLint.lhs +++ b/ghc/compiler/stgSyn/StgLint.lhs @@ -59,7 +59,7 @@ generation. Solution: don't use it! (KSW 2000-05). lintStgBindings :: String -> [StgBinding] -> [StgBinding] lintStgBindings whodunnit binds - = _scc_ "StgLint" + = {-# SCC "StgLint" #-} case (initL (lint_binds binds)) of Nothing -> binds Just msg -> pprPanic "" (vcat [ diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs index 2e2db8c164..75f6a94eec 100644 --- a/ghc/compiler/stgSyn/StgSyn.lhs +++ b/ghc/compiler/stgSyn/StgSyn.lhs @@ -326,12 +326,12 @@ And so the code for let(rec)-things: | StgLetNoEscape -- remember: ``advanced stuff'' (GenStgLiveVars occ) -- Live in the whole let-expression -- Mustn't overwrite these stack slots - -- *Doesn't* include binders of the let(rec). + -- *Doesn't* include binders of the let(rec). (GenStgLiveVars occ) -- Live in the right hand sides (only) -- These are the ones which must be saved on -- the stack if they aren't there already - -- *Does* include binders of the let(rec) if recursive. + -- *Does* include binders of the let(rec) if recursive. (GenStgBinding bndr occ) -- right hand sides (see below) (GenStgExpr bndr occ) -- body diff --git a/ghc/compiler/stranal/DmdAnal.lhs b/ghc/compiler/stranal/DmdAnal.lhs index 9ac5e38c00..1066b774c6 100644 --- a/ghc/compiler/stranal/DmdAnal.lhs +++ b/ghc/compiler/stranal/DmdAnal.lhs @@ -888,7 +888,7 @@ argDemand d = d ------------------------- -- Consider (if x then y else []) with demand V -- Then the first branch gives {y->V} and the second --- *implicitly* has {y->A}. So we must put {y->(V `lub` A)} +-- *implicitly* has {y->A}. So we must put {y->(V `lub` A)} -- in the result env. lubType (DmdType fv1 ds1 r1) (DmdType fv2 ds2 r2) = DmdType lub_fv2 (lub_ds ds1 ds2) (r1 `lubRes` r2) diff --git a/ghc/compiler/stranal/SaLib.lhs b/ghc/compiler/stranal/SaLib.lhs index 72b3ebbc86..338a351530 100644 --- a/ghc/compiler/stranal/SaLib.lhs +++ b/ghc/compiler/stranal/SaLib.lhs @@ -54,7 +54,7 @@ data AbsVal | AbsBot -- An expression whose abstract value is -- AbsBot is sure to fail to terminate. -- AbsBot represents the abstract - -- *function* bottom too. + -- *function* bottom too. | AbsProd [AbsVal] -- (Lifted) product of abstract values -- "Lifted" means that AbsBot is *different* from diff --git a/ghc/compiler/stranal/WwLib.lhs b/ghc/compiler/stranal/WwLib.lhs index 54a167ddcb..e44e521c83 100644 --- a/ghc/compiler/stranal/WwLib.lhs +++ b/ghc/compiler/stranal/WwLib.lhs @@ -295,7 +295,7 @@ mk_wrap_arg uniq ty dmd one_shot \begin{code} mkWWstr :: [Var] -- Wrapper args; have their demand info on them - -- *Includes type variables* + -- *Includes type variables* -> UniqSM ([Var], -- Worker args CoreExpr -> CoreExpr, -- Wrapper body, lacking the worker call -- and without its lambdas diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs index c71a738de5..ca3596d97c 100644 --- a/ghc/compiler/typecheck/Inst.lhs +++ b/ghc/compiler/typecheck/Inst.lhs @@ -572,7 +572,7 @@ addInst dflags home_ie dfun -- not overlap with anything in the things being looked up -- (since we do unification). -- We use tcSkolType because we don't want to allocate fresh - -- *meta* type variables. + -- *meta* type variables. (tvs', theta', tau') <- tcSkolType (InstSkol dfun) (idType dfun) ; let (cls, tys') = tcSplitDFunHead tau' dfun' = setIdType dfun (mkSigmaTy tvs' theta' tau') diff --git a/ghc/compiler/typecheck/TcArrows.lhs b/ghc/compiler/typecheck/TcArrows.lhs index 794fa093c7..7ec59d84bf 100644 --- a/ghc/compiler/typecheck/TcArrows.lhs +++ b/ghc/compiler/typecheck/TcArrows.lhs @@ -330,7 +330,7 @@ tc_cmd env cmd _ \begin{code} mkPairTy t1 t2 = mkTyConApp pairTyCon [t1,t2] -arrowTyConKind :: Kind -- *->*->* +arrowTyConKind :: Kind -- *->*->* arrowTyConKind = mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind \end{code} diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs index 12192a9d6a..9fd20a0402 100644 --- a/ghc/compiler/typecheck/TcEnv.lhs +++ b/ghc/compiler/typecheck/TcEnv.lhs @@ -467,7 +467,7 @@ checkWellStaged pp_thing bind_lvl use_stage topIdLvl :: Id -> ThLevel -- Globals may either be imported, or may be from an earlier "chunk" -- (separated by declaration splices) of this module. The former --- *can* be used inside a top-level splice, but the latter cannot. +-- *can* be used inside a top-level splice, but the latter cannot. -- Hence we give the former impLevel, but the latter topLevel -- E.g. this is bad: -- x = [| foo |] diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs index 8f8168bc94..1788cf693b 100644 --- a/ghc/compiler/typecheck/TcGenDeriv.lhs +++ b/ghc/compiler/typecheck/TcGenDeriv.lhs @@ -1114,7 +1114,7 @@ gen_Data_binds fix_env tycon emptyLHsBinds (nlHsVar data_type_name) - ------------ $dT + ------------ $dT data_type_name = mkDerivedRdrName tycon_name mkDataTOcc datatype_bind = mkVarBind @@ -1127,7 +1127,7 @@ gen_Data_binds fix_env tycon constrs = [nlHsVar (mk_constr_name con) | con <- data_cons] - ------------ $cT1 etc + ------------ $cT1 etc mk_constr_name con = mkDerivedRdrName (dataConName con) mkDataCOcc mk_con_bind dc = mkVarBind tycon_loc diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs index 59dfa9c4a0..6defe15074 100644 --- a/ghc/compiler/typecheck/TcHsSyn.lhs +++ b/ghc/compiler/typecheck/TcHsSyn.lhs @@ -915,11 +915,11 @@ mkArbitraryType tv kind = tyVarKind tv (args,res) = splitKindFunTys kind - tycon | kind == tyConKind listTyCon -- *->* + tycon | kind == tyConKind listTyCon -- *->* = listTyCon -- No tuples this size | all isLiftedTypeKind args && isLiftedTypeKind res - = tupleTyCon Boxed (length args) -- *-> ... ->*->* + = tupleTyCon Boxed (length args) -- *-> ... ->*->* | otherwise = pprTrace "Urk! Inventing strangely-kinded void TyCon:" (ppr tc_name $$ ppr kind) $ diff --git a/ghc/compiler/typecheck/TcHsType.lhs b/ghc/compiler/typecheck/TcHsType.lhs index 8155820160..fb9f0db50c 100644 --- a/ghc/compiler/typecheck/TcHsType.lhs +++ b/ghc/compiler/typecheck/TcHsType.lhs @@ -775,7 +775,7 @@ been instantiated. \begin{code} data TcSigInfo = TcSigInfo { - sig_id :: TcId, -- *Polymorphic* binder for this value... + sig_id :: TcId, -- *Polymorphic* binder for this value... sig_scoped :: [Name], -- Names for any scoped type variables -- Invariant: correspond 1-1 with an initial diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs index 42c687f56a..8f9dad4b18 100644 --- a/ghc/compiler/typecheck/TcRnDriver.lhs +++ b/ghc/compiler/typecheck/TcRnDriver.lhs @@ -1154,7 +1154,7 @@ tcRnGetInfo :: HscEnv -- Look up a RdrName and return all the TyThings it might be -- A capitalised RdrName is given to us in the DataName namespace, -- but we want to treat it as *both* a data constructor --- *and* as a type or class constructor; +-- *and* as a type or class constructor; -- hence the call to dataTcOccs, and we return up to two results tcRnGetInfo hsc_env ictxt rdr_name = initTcPrintErrors hsc_env iNTERACTIVE $ diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs index 9051e4dfe9..616017798c 100644 --- a/ghc/compiler/typecheck/TcRnMonad.lhs +++ b/ghc/compiler/typecheck/TcRnMonad.lhs @@ -798,6 +798,7 @@ popArrowBinders ArrCtxt {proc_level = curr_lvl + 1, proc_banned = curr_lvl : banned} getBannedProcLevels :: TcM [ProcLevel] +getBannedProcLevels = do { env <- getLclEnv; return (proc_banned (tcl_arrow_ctxt env)) } incProcLevel :: TcM a -> TcM a diff --git a/ghc/compiler/typecheck/TcRules.lhs b/ghc/compiler/typecheck/TcRules.lhs index d78003b487..5365922aef 100644 --- a/ghc/compiler/typecheck/TcRules.lhs +++ b/ghc/compiler/typecheck/TcRules.lhs @@ -61,7 +61,7 @@ tcRule (HsRule name act vars lhs rhs) -- See the 'lhs_dicts' in tcSimplifyAndCheck for the RHS -- We initially quantify over any tyvars free in *either* the rule - -- *or* the bound variables. The latter is important. Consider + -- *or* the bound variables. The latter is important. Consider -- ss (x,(y,z)) = (x,z) -- RULE: forall v. fst (ss v) = fst v -- The type of the rhs of the rule is just a, but v::(a,(b,c)) diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs index 180a99e7c1..2e04d90c90 100644 --- a/ghc/compiler/typecheck/TcSimplify.lhs +++ b/ghc/compiler/typecheck/TcSimplify.lhs @@ -1777,7 +1777,7 @@ reduce stack try_me wanted avails isAvailable :: Avails -> Inst -> Maybe Avail isAvailable avails wanted = lookupFM avails wanted -- NB 1: the Ord instance of Inst compares by the class/type info - -- *not* by unique. So + -- *not* by unique. So -- d1::C Int == d2::C Int addLinearAvailable :: Avails -> Avail -> Inst -> TcM (Avails, [Inst]) diff --git a/ghc/compiler/typecheck/TcSplice.lhs b/ghc/compiler/typecheck/TcSplice.lhs index 67b4e281d9..376b3eaffd 100644 --- a/ghc/compiler/typecheck/TcSplice.lhs +++ b/ghc/compiler/typecheck/TcSplice.lhs @@ -475,7 +475,7 @@ lookupThName th_name -> do { mb_name <- lookupSrcOcc_maybe rdr_name ; case mb_name of - Just name -> return name ; + Just name -> return name Nothing -> failWithTc (notInScope th_name) } } where @@ -490,8 +490,8 @@ tcLookupTh :: Name -> TcM TcTyThing -- tcLookup, failure is a bug. tcLookupTh name = do { (gbl_env, lcl_env) <- getEnvs - ; case lookupNameEnv (tcl_env lcl_env) name of - Just thing -> returnM thing + ; case lookupNameEnv (tcl_env lcl_env) name of { + Just thing -> returnM thing; Nothing -> do { if nameIsLocalOrFrom (tcg_mod gbl_env) name then -- It's defined in this module @@ -507,7 +507,7 @@ tcLookupTh name ; return (AGlobal thing) } -- Imported names should always be findable; -- if not, we fail hard in tcImportDecl - }}} + }}}} mk_uniq :: Int# -> Unique mk_uniq u = mkUniqueGrimily (I# u) diff --git a/ghc/compiler/types/Kind.lhs b/ghc/compiler/types/Kind.lhs index 191dd41f64..ac89b3b76f 100644 --- a/ghc/compiler/types/Kind.lhs +++ b/ghc/compiler/types/Kind.lhs @@ -50,9 +50,9 @@ In particular: \begin{code} data Kind - = LiftedTypeKind -- * + = LiftedTypeKind -- * | OpenTypeKind -- ? - | UnliftedTypeKind -- # + | UnliftedTypeKind -- # | UbxTupleKind -- (##) | ArgTypeKind -- ?? | FunKind Kind Kind -- k1 -> k2 diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs index 7fdf2e3a29..29f4600309 100644 --- a/ghc/compiler/types/TyCon.lhs +++ b/ghc/compiler/types/TyCon.lhs @@ -99,9 +99,9 @@ data TyCon algTcFields :: [(FieldLabel, Type, Id)], -- Its fields (empty if none): - -- * field name - -- * its type (scoped over tby tyConTyVars) - -- * record selector (name = field name) + -- * field name + -- * its type (scoped over tby tyConTyVars) + -- * record selector (name = field name) algTcRhs :: AlgTyConRhs, -- Data constructors in here diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs index bf407e57e0..7fa651ae8e 100644 --- a/ghc/compiler/types/Type.lhs +++ b/ghc/compiler/types/Type.lhs @@ -1037,7 +1037,7 @@ composeTvSubst in_scope env1 env2 -- First apply env1 to the range of env2 -- Then combine the two, making sure that env1 loses if -- both bind the same variable; that's why env1 is the - -- *left* argument to plusVarEnv, because the right arg wins + -- *left* argument to plusVarEnv, because the right arg wins where subst1 = TvSubst in_scope env1 diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs index 45cd457baa..f5bb325ad9 100644 --- a/ghc/compiler/types/TypeRep.lhs +++ b/ghc/compiler/types/TypeRep.lhs @@ -153,7 +153,7 @@ data Type -- (or NoteTy of these) | TyConApp -- Application of a TyCon, including newtypes - TyCon -- *Invariant* saturated appliations of FunTyCon and + TyCon -- *Invariant* saturated appliations of FunTyCon and -- synonyms have their own constructors, below. -- However, *unsaturated* type synonyms, and FunTyCons -- do appear as TyConApps. (Unsaturated type synonyms diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs index 8dbfefaa0b..6b795bea8c 100644 --- a/ghc/compiler/utils/FastString.lhs +++ b/ghc/compiler/utils/FastString.lhs @@ -442,8 +442,10 @@ cmpFS (FastString u1# l1# b1#) (FastString u2# l2# b2#) = else GT )) +#ifndef __HADDOCK__ foreign import ccall "ghc_memcmp" unsafe memcmp :: ByteArray# -> ByteArray# -> Int# -> IO Int +#endif -- ----------------------------------------------------------------------------- -- Outputting 'FastString's diff --git a/ghc/compiler/utils/FiniteMap.lhs b/ghc/compiler/utils/FiniteMap.lhs index 8efb8c0938..9168d3656f 100644 --- a/ghc/compiler/utils/FiniteMap.lhs +++ b/ghc/compiler/utils/FiniteMap.lhs @@ -194,7 +194,7 @@ emptyFM bottom = panic "emptyFM" -} --- #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _) +-- #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _) unitFM key elt = Branch key elt IF_GHC(1#,1) emptyFM emptyFM diff --git a/ghc/compiler/utils/Panic.lhs b/ghc/compiler/utils/Panic.lhs index 6251d1baf4..3766383691 100644 --- a/ghc/compiler/utils/Panic.lhs +++ b/ghc/compiler/utils/Panic.lhs @@ -143,7 +143,7 @@ panic, pgmError :: String -> a panic x = Exception.throwDyn (Panic x) pgmError x = Exception.throwDyn (ProgramError x) --- #-versions because panic can't return an unboxed int, and that's +-- #-versions because panic can't return an unboxed int, and that's -- what TAG_ is with GHC at the moment. Ugh. (Simon) -- No, man -- Too Beautiful! (Will) diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs index a8c7a1ed63..e53dbc89ce 100644 --- a/ghc/compiler/utils/StringBuffer.lhs +++ b/ghc/compiler/utils/StringBuffer.lhs @@ -9,9 +9,9 @@ Buffers for scanning string input stored in external arrays. module StringBuffer ( StringBuffer(..), - -- non-abstract for vs/HaskellService + -- non-abstract for vs\/HaskellService - -- * Creation/destruction + -- * Creation\/destruction hGetStringBuffer, -- :: FilePath -> IO StringBuffer stringToStringBuffer, -- :: String -> IO StringBuffer @@ -24,12 +24,12 @@ module StringBuffer -- * Moving stepOn, stepOnBy, - -- * Conversion + -- * Conversion lexemeToString, -- :: StringBuffer -> Int -> String lexemeToFastString, -- :: StringBuffer -> Int -> FastString -- * Parsing integers - parseInteger, + parseInteger, ) where #include "HsVersions.h" diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs index aa357b8740..52d34d9983 100644 --- a/ghc/compiler/utils/UniqFM.lhs +++ b/ghc/compiler/utils/UniqFM.lhs @@ -334,25 +334,25 @@ plusUFM_C f fm1 fm2 = mix_trees fm1 fm2 -- t1 t2 t1' t2' t1 t2 + j' -- / \ -- t1' t2' - mix_branches (LeftRoot Leftt) -- | trace "LL" True + mix_branches (LeftRoot Leftt) -- | trace "LL" True = mkSLNodeUFM (NodeUFMData j p) (mix_trees t1 right_t) t2 - mix_branches (LeftRoot Rightt) -- | trace "LR" True + mix_branches (LeftRoot Rightt) -- | trace "LR" True = mkLSNodeUFM (NodeUFMData j p) t1 (mix_trees t2 right_t) - mix_branches (RightRoot Leftt) -- | trace "RL" True + mix_branches (RightRoot Leftt) -- | trace "RL" True = mkSLNodeUFM (NodeUFMData j' p') (mix_trees left_t t1') t2' - mix_branches (RightRoot Rightt) -- | trace "RR" True + mix_branches (RightRoot Rightt) -- | trace "RR" True = mkLSNodeUFM (NodeUFMData j' p') t1' |