Commit 853e20a3 authored by simonmar's avatar simonmar
Browse files

[project @ 2005-03-31 10:16:33 by simonmar]

Tweaks to get the GHC sources through Haddock.  Doesn't quite work
yet, because Haddock complains about the recursive modules.  Haddock
needs to understand SOURCE imports (it can probably just ignore them
as a first attempt).
parent ca739e85
......@@ -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
......
......@@ -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
......
......@@ -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 -> ...
......
......@@ -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
......
......@@ -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.
......
......@@ -134,7 +134,7 @@ pprStmt stmt = case stmt of
-- ;
CmmNop -> semi
-- // text
-- // text
CmmComment s -> text "//" <+> ftext s
-- reg = expr;
......
......@@ -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.
......
......@@ -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
......
%
% (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)
......
%
% (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
......
%
% (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
......
......@@ -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
......
......@@ -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)
......
%
% (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.
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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}
......
......@@ -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
......
......@@ -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 _ _)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment