diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/ghci/ByteCodeAsm.lhs | 14 | ||||
| -rw-r--r-- | compiler/nativeGen/PPC/RegInfo.hs | 7 | ||||
| -rw-r--r-- | compiler/rename/RnPat.lhs | 20 |
3 files changed, 26 insertions, 15 deletions
diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index 4ff09eff66..17b30424c6 100644 --- a/compiler/ghci/ByteCodeAsm.lhs +++ b/compiler/ghci/ByteCodeAsm.lhs @@ -207,8 +207,8 @@ sizeSS (SizedSeq n _) = n data Operand = Op Word | SmallOp Word16 - | LargeOp Word | LabelOp Word16 +-- (unused) | LargeOp Word data Assembler a = AllocPtr (IO BCOPtr) (Word -> Assembler a) @@ -244,10 +244,10 @@ type LabelEnv = Word16 -> Word largeOp :: Bool -> Operand -> Bool largeOp long_jumps op = case op of - LargeOp _ -> True - SmallOp _ -> False - Op w -> isLarge w - LabelOp _ -> long_jumps + SmallOp _ -> False + Op w -> isLarge w + LabelOp _ -> long_jumps +-- LargeOp _ -> True runAsm :: DynFlags -> Bool -> LabelEnv -> Assembler a -> State AsmState IO a runAsm dflags long_jumps e = go @@ -272,9 +272,9 @@ runAsm dflags long_jumps e = go | otherwise = w words = concatMap expand ops expand (SmallOp w) = [w] - expand (LargeOp w) = largeArg dflags w expand (LabelOp w) = expand (Op (e w)) expand (Op w) = if largeOps then largeArg dflags w else [fromIntegral w] +-- expand (LargeOp w) = largeArg dflags w State $ \(st_i0,st_l0,st_p0) -> do let st_i1 = addListToSS st_i0 (opcode : words) return ((st_i1,st_l0,st_p0), ()) @@ -306,9 +306,9 @@ inspectAsm dflags long_jumps initial_offset size = sum (map count ops) + 1 largeOps = any (largeOp long_jumps) ops count (SmallOp _) = 1 - count (LargeOp _) = largeArg16s dflags count (LabelOp _) = count (Op 0) count (Op _) = if largeOps then largeArg16s dflags else 1 +-- count (LargeOp _) = largeArg16s dflags -- Bring in all the bci_ bytecode constants. #include "rts/Bytecodes.h" diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs index 019cf82f6a..2b74d1daea 100644 --- a/compiler/nativeGen/PPC/RegInfo.hs +++ b/compiler/nativeGen/PPC/RegInfo.hs @@ -26,21 +26,18 @@ where #include "nativeGen/NCG.h" #include "HsVersions.h" -import PPC.Regs import PPC.Instr import BlockId import OldCmm import CLabel -import Outputable import Unique -data JumpDest = DestBlockId BlockId | DestImm Imm +data JumpDest = DestBlockId BlockId getJumpDestBlockId :: JumpDest -> Maybe BlockId getJumpDestBlockId (DestBlockId bid) = Just bid -getJumpDestBlockId _ = Nothing canShortcut :: Instr -> Maybe JumpDest canShortcut _ = Nothing @@ -80,7 +77,5 @@ shortBlockId fn blockid = case fn blockid of Nothing -> mkAsmTempLabel uq Just (DestBlockId blockid') -> shortBlockId fn blockid' - Just (DestImm (ImmCLbl lbl)) -> lbl - _other -> panic "shortBlockId" where uq = getUnique blockid diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs index c3b40fe0f2..9738585aa4 100644 --- a/compiler/rename/RnPat.lhs +++ b/compiler/rename/RnPat.lhs @@ -121,10 +121,26 @@ wrapSrcSpanCps fn (L loc a) lookupConCps :: Located RdrName -> CpsRn (Located Name) lookupConCps con_rdr = CpsRn (\k -> do { con_name <- lookupLocatedOccRn con_rdr - ; (r, fvs) <- k con_name - ; return (r, fvs `plusFV` unitFV (unLoc con_name)) }) + ; k con_name }) + -- We do not add the constructor name to the free vars + -- See Note [Patterns are not uses] \end{code} +Note [Patterns are not uses] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + module Foo( f, g ) where + data T = T1 | T2 + + f T1 = True + f T2 = False + + g _ = T1 + +Arguaby we should report T2 as unused, even though it appears in a +pattern, because it never occurs in a constructed position. See +Trac #7336. + %********************************************************* %* * Name makers |