diff options
author | Ian Lynagh <igloo@earth.li> | 2011-09-09 01:49:54 +0100 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2011-09-11 13:50:43 +0100 |
commit | af536aca1f03adc5ec7d3e523b0f63dcc615cfd9 (patch) | |
tree | b4d6c7f80192b7df15f16be7737d93842cb0f943 /compiler/codeGen/CgUtils.hs | |
parent | 2818cfd7f2b953035ce00178c8d5f2be073af0b7 (diff) | |
download | haskell-af536aca1f03adc5ec7d3e523b0f63dcc615cfd9.tar.gz |
Fix warnings in codeGen/CgUtils.hs
Diffstat (limited to 'compiler/codeGen/CgUtils.hs')
-rw-r--r-- | compiler/codeGen/CgUtils.hs | 76 |
1 files changed, 38 insertions, 38 deletions
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index 1e7f0fc7ea..aa86690612 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -1,10 +1,3 @@ -{-# 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 - ----------------------------------------------------------------------------- -- -- Code generator utilities; mostly monadic @@ -74,11 +67,9 @@ import ListSetOps import Util import DynFlags import FastString -import PackageConfig import Outputable import Data.Char -import Data.Bits import Data.Word import Data.Maybe @@ -116,6 +107,7 @@ mkSimpleLit (MachLabel fs ms fod) where -- TODO: Literal labels might not actually be in the current package... labelSrc = ForeignLabelInThisPackage +mkSimpleLit (MachStr _) = panic "mkSimpleLit: MachStr" mkLtOp :: Literal -> MachOp -- On signed literals we must do a signed comparison @@ -144,8 +136,10 @@ mkLtOp lit = MO_U_Lt (typeWidth (cmmLitType (mkSimpleLit lit))) Big families only use the tag value 1 to represent evaluatedness. -} +isSmallFamily :: Int -> Bool isSmallFamily fam_size = fam_size <= mAX_PTR_TAG +tagForCon :: DataCon -> ConTagZ tagForCon con = tag where con_tag = dataConTagZ con @@ -154,6 +148,7 @@ tagForCon con = tag | otherwise = 1 --Tag an expression, to do: refactor, this appears in some other module. +tagCons :: DataCon -> CmmExpr -> CmmExpr tagCons con expr = cmmOffsetB expr (tagForCon con) -------------------------------------------------------------------------- @@ -440,7 +435,7 @@ emitDataLits lbl lits = emitDecl (mkDataLits Data lbl lits) emitRODataLits :: String -> CLabel -> [CmmLit] -> Code -- Emit a read-only data block -emitRODataLits caller lbl lits +emitRODataLits _caller lbl lits = emitDecl (mkRODataLits lbl lits) newStringCLit :: String -> FCode CmmLit @@ -503,7 +498,7 @@ emitSwitch -> Code -- ONLY A DEFAULT BRANCH: no case analysis to do -emitSwitch tag_expr [] (Just stmts) _ _ +emitSwitch _ [] (Just stmts) _ _ = emitCgStmts stmts -- Right, off we go @@ -531,13 +526,13 @@ mk_switch :: CmmExpr -> [(ConTagZ, CgStmts)] -> FCode CgStmts -- SINGLETON TAG RANGE: no case analysis to do -mk_switch tag_expr [(tag,stmts)] _ lo_tag hi_tag via_C +mk_switch _tag_expr [(tag,stmts)] _ lo_tag hi_tag _via_C | lo_tag == hi_tag = ASSERT( tag == lo_tag ) return stmts --- SINGLETON BRANCH, NO DEFUALT: no case analysis to do -mk_switch tag_expr [(tag,stmts)] Nothing lo_tag hi_tag via_C +-- SINGLETON BRANCH, NO DEFAULT: no case analysis to do +mk_switch _tag_expr [(_tag,stmts)] Nothing _lo_tag _hi_tag _via_C = return stmts -- The simplifier might have eliminated a case -- so we may have e.g. case xs of @@ -546,7 +541,7 @@ mk_switch tag_expr [(tag,stmts)] Nothing lo_tag hi_tag via_C -- can't happen, so no need to test -- SINGLETON BRANCH: one equality check to do -mk_switch tag_expr [(tag,stmts)] (Just deflt) lo_tag hi_tag via_C +mk_switch tag_expr [(tag,stmts)] (Just deflt) _lo_tag _hi_tag _via_C = return (CmmCondBranch cond deflt `consCgStmt` stmts) where cond = cmmNeWord tag_expr (CmmLit (mkIntCLit tag)) @@ -670,7 +665,7 @@ mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C (lo_branches, hi_branches) = span is_lo branches is_lo (t,_) = t < mid_tag - +assignTemp' :: CmmExpr -> FCode (CmmStmt, CmmExpr) assignTemp' e | isTrivialCmmExpr e = return (CmmNop, e) | otherwise = do { reg <- newTemp (cmmExprType e) @@ -686,8 +681,7 @@ emitLitSwitch :: CmmExpr -- Tag to switch on -- -- ToDo: for integers we could do better here, perhaps by generalising -- mk_switch and using that. --SDM 15/09/2004 -emitLitSwitch scrut [] deflt - = emitCgStmts deflt +emitLitSwitch _ [] deflt = emitCgStmts deflt emitLitSwitch scrut branches deflt_blk = do { scrut' <- assignTemp scrut ; deflt_blk_id <- forkCgStmts deflt_blk @@ -771,12 +765,14 @@ doSimultaneously1 vertices -- do_components deal with one strongly-connected component -- Not cyclic, or singleton? Just do it - do_component (AcyclicSCC (n,stmt)) = stmtC stmt - do_component (CyclicSCC [(n,stmt)]) = stmtC stmt + do_component (AcyclicSCC (_n, stmt)) = stmtC stmt + do_component (CyclicSCC []) + = panic "doSimultaneously1: do_component (CyclicSCC [])" + do_component (CyclicSCC [(_n, stmt)]) = stmtC stmt -- Cyclic? Then go via temporaries. Pick one to -- break the loop and try again with the rest. - do_component (CyclicSCC ((n,first_stmt) : rest)) + do_component (CyclicSCC ((_n, first_stmt) : rest)) = do { from_temp <- go_via_temp first_stmt ; doSimultaneously1 rest ; stmtC from_temp } @@ -786,50 +782,53 @@ doSimultaneously1 vertices ; stmtC (CmmAssign (CmmLocal tmp) src) ; return (CmmAssign dest (CmmReg (CmmLocal tmp))) } go_via_temp (CmmStore dest src) - = do { tmp <- newTemp (cmmExprType src) -- TODO FIXME NOW if the pair of assignemnts move across a call this will be wrong + = do { tmp <- newTemp (cmmExprType src) -- TODO FIXME NOW if the pair of assignments move across a call this will be wrong ; stmtC (CmmAssign (CmmLocal tmp) src) ; return (CmmStore dest (CmmReg (CmmLocal tmp))) } + go_via_temp _ = panic "doSimultaneously1: go_via_temp" in mapCs do_component components mustFollow :: CmmStmt -> CmmStmt -> Bool CmmAssign reg _ `mustFollow` stmt = anySrc (reg `regUsedIn`) stmt CmmStore loc e `mustFollow` stmt = anySrc (locUsedIn loc (cmmExprType e)) stmt -CmmNop `mustFollow` stmt = False -CmmComment _ `mustFollow` stmt = False +CmmNop `mustFollow` _ = False +CmmComment _ `mustFollow` _ = False +_ `mustFollow` _ = panic "mustFollow" anySrc :: (CmmExpr -> Bool) -> CmmStmt -> Bool -- True if the fn is true of any input of the stmt anySrc p (CmmAssign _ e) = p e anySrc p (CmmStore e1 e2) = p e1 || p e2 -- Might be used in either side -anySrc p (CmmComment _) = False -anySrc p CmmNop = False -anySrc p other = True -- Conservative +anySrc _ (CmmComment _) = False +anySrc _ CmmNop = False +anySrc _ _ = True -- Conservative locUsedIn :: CmmExpr -> CmmType -> CmmExpr -> Bool -- (locUsedIn a r e) checks whether writing to r[a] could affect the value of -- 'e'. Returns True if it's not sure. -locUsedIn loc rep (CmmLit _) = False +locUsedIn _ _ (CmmLit _) = False locUsedIn loc rep (CmmLoad e ld_rep) = possiblySameLoc loc rep e ld_rep -locUsedIn loc rep (CmmReg reg') = False -locUsedIn loc rep (CmmRegOff reg' _) = False +locUsedIn _ _ (CmmReg _) = False +locUsedIn _ _ (CmmRegOff _ _) = False locUsedIn loc rep (CmmMachOp _ es) = any (locUsedIn loc rep) es +locUsedIn _ _ (CmmStackSlot _ _) = panic "locUsedIn: CmmStackSlot" possiblySameLoc :: CmmExpr -> CmmType -> CmmExpr -> CmmType -> Bool -- Assumes that distinct registers (eg Hp, Sp) do not -- point to the same location, nor any offset thereof. -possiblySameLoc (CmmReg r1) rep1 (CmmReg r2) rep2 = r1==r2 -possiblySameLoc (CmmReg r1) rep1 (CmmRegOff r2 0) rep2 = r1==r2 -possiblySameLoc (CmmRegOff r1 0) rep1 (CmmReg r2) rep2 = r1==r2 +possiblySameLoc (CmmReg r1) _ (CmmReg r2) _ = r1 == r2 +possiblySameLoc (CmmReg r1) _ (CmmRegOff r2 0) _ = r1 == r2 +possiblySameLoc (CmmRegOff r1 0) _ (CmmReg r2) _ = r1 == r2 possiblySameLoc (CmmRegOff r1 start1) rep1 (CmmRegOff r2 start2) rep2 = r1==r2 && end1 > start2 && end2 > start1 where end1 = start1 + widthInBytes (typeWidth rep1) end2 = start2 + widthInBytes (typeWidth rep2) -possiblySameLoc l1 rep1 (CmmLit _) rep2 = False -possiblySameLoc l1 rep1 l2 rep2 = True -- Conservative +possiblySameLoc _ _ (CmmLit _) _ = False +possiblySameLoc _ _ _ _ = True -- Conservative ------------------------------------------------------------------------- -- @@ -860,12 +859,12 @@ getSRTInfo = do : map mkWordCLit bmp) return (C_SRT srt_desc_lbl 0 srt_escape) - SRT off len bmp | otherwise -> return (C_SRT srt_lbl off (fromIntegral (head bmp))) -- The fromIntegral converts to StgHalfWord -srt_escape = (-1) :: StgHalfWord +srt_escape :: StgHalfWord +srt_escape = -1 -- ----------------------------------------------------------------------------- -- @@ -947,11 +946,12 @@ get_GlobalReg_addr mid = get_Regtable_addr_from_offset -- Calculate a literal representing an offset into the register table. -- Used when we don't have an actual BaseReg to offset from. +regTableOffset :: Int -> CmmExpr regTableOffset n = CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n)) get_Regtable_addr_from_offset :: CmmType -> Int -> CmmExpr -get_Regtable_addr_from_offset rep offset = +get_Regtable_addr_from_offset _ offset = #ifdef REG_Base CmmRegOff (CmmGlobal BaseReg) offset #else |