Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/910a642294eb3547d0cbb3d5735ad81b964f137b >--------------------------------------------------------------- commit 910a642294eb3547d0cbb3d5735ad81b964f137b Author: Simon Peyton Jones <simo...@microsoft.com> Date: Mon Oct 29 23:25:25 2012 +0000 Do not treat a constructor in a *pattern* as a *use* of that constructor Occurrences in terms are uses, in patterns they are not. In this way we get unused-constructor warnings from modules like this module M( f, g, T ) where data T = T1 | T2 Bool f x = T2 x g T1 = True g (T2 x) = x Here a T1 value cannot be constructed, so we can warn. The use in a pattern doesn't count. See Note [Patterns are not uses] in RnPat. Interestingly this change exposed three module in GHC itself that had unused constructors, which I duly removed: * ghc/Main.hs * compiler/ghci/ByteCodeAsm * compiler/nativeGen/PPC/RegInfo Their changes are in this patch. >--------------------------------------------------------------- compiler/ghci/ByteCodeAsm.lhs | 14 +++++++------- compiler/nativeGen/PPC/RegInfo.hs | 7 +------ compiler/rename/RnPat.lhs | 20 ++++++++++++++++++-- ghc/Main.hs | 2 -- 4 files changed, 26 insertions(+), 17 deletions(-) diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index 4ff09ef..17b3042 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 019cf82..2b74d1d 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 c3b40fe..9738585 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 diff --git a/ghc/Main.hs b/ghc/Main.hs index f05ddab..a84f2ac 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -110,7 +110,6 @@ main = do ShowSupportedExtensions -> showSupportedExtensions ShowVersion -> showVersion ShowNumVersion -> putStrLn cProjectVersion - Print str -> putStrLn str Right postStartupMode -> -- start our GHC session GHC.runGhc mbMinusB $ do @@ -361,7 +360,6 @@ data PreStartupMode = ShowVersion -- ghc -V/--version | ShowNumVersion -- ghc --numeric-version | ShowSupportedExtensions -- ghc --supported-extensions - | Print String -- ghc --print-foo showVersionMode, showNumVersionMode, showSupportedExtensionsMode :: Mode showVersionMode = mkPreStartupMode ShowVersion _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
