From fa719676416bb6271bdac979ec294e81ed7404c3 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Mon, 29 Dec 2008 16:46:18 +0000 Subject: [PATCH] Fix warnings in ClosureInfo --- compiler/codeGen/ClosureInfo.lhs | 77 +++++++++++++++++++++----------------- 1 file changed, 43 insertions(+), 34 deletions(-) diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index d819873..bc7dfec 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -12,13 +12,6 @@ Much of the rationale for these things is in the ``details'' part of the STG paper. \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module ClosureInfo ( ClosureInfo(..), LambdaFormInfo(..), -- would be abstract but StandardFormInfo(..), -- mkCmmInfo looks inside @@ -36,9 +29,9 @@ module ClosureInfo ( closureGoodStuffSize, closurePtrsSize, slopSize, - closureName, infoTableLabelFromCI, + infoTableLabelFromCI, closureLabelFromCI, - closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd, + isLFThunk, closureUpdReqd, closureNeedsUpdSpace, closureIsThunk, closureSingleEntry, closureReEntrant, isConstrClosure_maybe, closureFunInfo, isStandardFormThunk, isKnownFun, @@ -72,9 +65,9 @@ import SMRep import CLabel -import Packages -import PackageConfig +import Unique import StaticFlags +import Var import Id import IdInfo import DataCon @@ -265,6 +258,7 @@ mkLFReEntrant :: TopLevelFlag -- True of top level mkLFReEntrant top fvs args arg_descr = LFReEntrant top (length args) (null fvs) arg_descr +mkLFThunk :: Type -> TopLevelFlag -> [Var] -> UpdateFlag -> LambdaFormInfo mkLFThunk thunk_ty top fvs upd_flag = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) ) LFThunk top (null fvs) @@ -291,10 +285,12 @@ maybeIsLFCon :: LambdaFormInfo -> Maybe DataCon maybeIsLFCon (LFCon con) = Just con maybeIsLFCon _ = Nothing +mkSelectorLFInfo :: Id -> WordOff -> Bool -> LambdaFormInfo mkSelectorLFInfo id offset updatable = LFThunk NotTopLevel False updatable (SelectorThunk offset) (might_be_a_function (idType id)) +mkApLFInfo :: Id -> UpdateFlag -> Int -> LambdaFormInfo mkApLFInfo id upd_flag arity = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity) (might_be_a_function (idType id)) @@ -303,15 +299,17 @@ mkApLFInfo id upd_flag arity Miscellaneous LF-infos. \begin{code} +mkLFArgument :: Id -> LambdaFormInfo mkLFArgument id = LFUnknown (might_be_a_function (idType id)) +mkLFLetNoEscape :: Int -> LambdaFormInfo mkLFLetNoEscape = LFLetNoEscape mkLFImported :: Id -> LambdaFormInfo mkLFImported id = case idArity id of n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0 - other -> mkLFArgument id -- Not sure of exact arity + _ -> mkLFArgument id -- Not sure of exact arity \end{code} \begin{code} @@ -407,6 +405,7 @@ Slop Requirements: every thunk gets an extra padding word in the header, which takes the the updated value. \begin{code} +slopSize :: ClosureInfo -> WordOff slopSize cl_info = computeSlopSize payload_size cl_info where payload_size = closureGoodStuffSize cl_info @@ -421,6 +420,7 @@ computeSlopSize payload_size cl_info -- or (b) it is a static thunk. This is because a static thunk needs -- a static link field in a predictable place (after the slop), regardless -- of whether it is updatable or not. +closureNeedsUpdSpace :: ClosureInfo -> Bool closureNeedsUpdSpace (ClosureInfo { closureLFInfo = LFThunk TopLevel _ _ _ _ }) = True closureNeedsUpdSpace cl_info = closureUpdReqd cl_info @@ -469,7 +469,7 @@ chooseSMRep is_static lf_info tot_wds ptr_wds getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType getClosureType is_static ptr_wds lf_info = case lf_info of - LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf + LFCon _ | is_static && ptr_wds == 0 -> ConstrNoCaf | otherwise -> Constr LFReEntrant _ _ _ _ -> Fun LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector @@ -521,7 +521,7 @@ nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _) -- or profiling (in which case we need to recover the cost centre -- from inside it) -nodeMustPointToIt (LFThunk _ no_fvs updatable some_standard_form_thunk _) +nodeMustPointToIt (LFThunk _ _ _ _ _) = True -- Node must point to any standard-form thunk nodeMustPointToIt (LFUnknown _) = True @@ -584,7 +584,7 @@ getCallMethod :: DynFlags -> Int -- Number of available arguments -> CallMethod -getCallMethod _ name _ lf_info n_args +getCallMethod _ _ _ lf_info _ | nodeMustPointToIt lf_info && opt_Parallel = -- If we're parallel, then we must always enter via node. -- The reason is that the closure may have been @@ -597,7 +597,7 @@ getCallMethod _ name caf (LFReEntrant _ arity _ _) n_args | n_args < arity = SlowCall -- Not enough args | otherwise = DirectEntry (enterIdLabel name caf) arity -getCallMethod _ name _ (LFCon con) n_args +getCallMethod _ _ _ (LFCon con) n_args = ASSERT( n_args == 0 ) ReturnCon con @@ -626,7 +626,7 @@ getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_arg = ASSERT( n_args == 0 ) JumpToIt (thunkEntryLabel name caf std_form_info updatable) -getCallMethod _ name _ (LFUnknown True) n_args +getCallMethod _ _ _ (LFUnknown True) _ = SlowCall -- Might be a function getCallMethod _ name _ (LFUnknown False) n_args @@ -637,12 +637,12 @@ getCallMethod _ name _ (LFUnknown False) n_args | otherwise = EnterIt -- Not a function -getCallMethod _ name _ (LFBlackHole _) n_args +getCallMethod _ _ _ (LFBlackHole _) _ = SlowCall -- Presumably the black hole has by now -- been updated, but we don't know with -- what, so we slow call it -getCallMethod _ name _ (LFLetNoEscape 0) n_args +getCallMethod _ name _ (LFLetNoEscape 0) _ = JumpToIt (enterReturnPtLabel (nameUnique name)) getCallMethod _ name _ (LFLetNoEscape arity) n_args @@ -672,12 +672,12 @@ blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = r -- the former to catch double entry, -- and the latter to plug space-leaks. KSW/SDM 1999-04. - other -> panic "blackHoleOnEntry" -- Should never happen + _ -> panic "blackHoleOnEntry" -- Should never happen isStandardFormThunk :: LambdaFormInfo -> Bool isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True -isStandardFormThunk other_lf_info = False +isStandardFormThunk _ = False isKnownFun :: LambdaFormInfo -> Bool isKnownFun (LFReEntrant _ _ _ _) = True @@ -821,13 +821,13 @@ staticClosureRequired -> StgBinderInfo -> LambdaFormInfo -> Bool -staticClosureRequired binder bndr_info +staticClosureRequired _ bndr_info (LFReEntrant top_level _ _ _) -- It's a function = ASSERT( isTopLevel top_level ) -- Assumption: it's a top-level, no-free-var binding not (satCallsOnly bndr_info) -staticClosureRequired binder other_binder_info other_lf_info = True +staticClosureRequired _ _ _ = True \end{code} %************************************************************************ @@ -858,11 +858,11 @@ closureIsThunk ConInfo{} = False closureSingleEntry :: ClosureInfo -> Bool closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd -closureSingleEntry other_closure = False +closureSingleEntry _ = False closureReEntrant :: ClosureInfo -> Bool closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True -closureReEntrant other_closure = False +closureReEntrant _ = False isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con @@ -903,7 +903,7 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info }) = case lf_info of LFReEntrant TopLevel _ _ _ -> True LFThunk TopLevel _ _ _ _ -> True - other -> False + _ -> False isToplevClosure _ = False \end{code} @@ -912,8 +912,7 @@ Label generation. \begin{code} infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel infoTableLabelFromCI (ClosureInfo { closureName = name, - closureLFInfo = lf_info, - closureSMRep = rep }) caf + closureLFInfo = lf_info }) caf = case lf_info of LFBlackHole info -> info @@ -927,7 +926,7 @@ infoTableLabelFromCI (ClosureInfo { closureName = name, LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name caf - other -> panic "infoTableLabelFromCI" + _ -> panic "infoTableLabelFromCI" infoTableLabelFromCI (ConInfo { closureCon = con, closureSMRep = rep }) caf @@ -937,35 +936,42 @@ infoTableLabelFromCI (ConInfo { closureCon = con, name = dataConName con -- ClosureInfo for a closure (as opposed to a constructor) is always local +closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf closureLabelFromCI _ _ = panic "closureLabelFromCI" -- thunkEntryLabel is a local help function, not exported. It's used from both -- entryLabelFromCI and getCallMethod. -thunkEntryLabel thunk_id _ (ApThunk arity) is_updatable +thunkEntryLabel :: Name -> CafInfo -> StandardFormInfo -> Bool -> CLabel +thunkEntryLabel _thunk_id _ (ApThunk arity) is_updatable = enterApLabel is_updatable arity -thunkEntryLabel thunk_id _ (SelectorThunk offset) upd_flag +thunkEntryLabel _thunk_id _ (SelectorThunk offset) upd_flag = enterSelectorLabel upd_flag offset -thunkEntryLabel thunk_id caf _ is_updatable +thunkEntryLabel thunk_id caf _ _is_updatable = enterIdLabel thunk_id caf +enterApLabel :: Bool -> Int -> CLabel enterApLabel is_updatable arity | tablesNextToCode = mkApInfoTableLabel is_updatable arity | otherwise = mkApEntryLabel is_updatable arity +enterSelectorLabel :: Bool -> Int -> CLabel enterSelectorLabel upd_flag offset | tablesNextToCode = mkSelectorInfoLabel upd_flag offset | otherwise = mkSelectorEntryLabel upd_flag offset +enterIdLabel :: Name -> CafInfo -> CLabel enterIdLabel id | tablesNextToCode = mkInfoTableLabel id | otherwise = mkEntryLabel id +enterLocalIdLabel :: Name -> CafInfo -> CLabel enterLocalIdLabel id | tablesNextToCode = mkLocalInfoTableLabel id | otherwise = mkLocalEntryLabel id +enterReturnPtLabel :: Unique -> CLabel enterReturnPtLabel name | tablesNextToCode = mkReturnInfoLabel name | otherwise = mkReturnPtLabel name @@ -978,6 +984,7 @@ ways to build an LFBlackHole, maintaining the invariant that it really is a black hole and not something else. \begin{code} +cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo cafBlackHoleClosureInfo (ClosureInfo { closureName = nm, closureType = ty }) = ClosureInfo { closureName = nm, @@ -1031,6 +1038,8 @@ getTyDescription ty fun_result (FunTy _ res) = '>' : fun_result res fun_result other = getTyDescription other -getPredTyDescription (ClassP cl tys) = getOccString cl -getPredTyDescription (IParam ip ty) = getOccString (ipNameName ip) +getPredTyDescription :: PredType -> String +getPredTyDescription (ClassP cl _) = getOccString cl +getPredTyDescription (IParam ip _) = getOccString (ipNameName ip) +getPredTyDescription (EqPred _ _) = panic "getPredTyDescription EqPred" \end{code} -- 1.7.10.4