From 463bbe95172eba825434b7a706040708797c08af Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 28 Jan 2011 10:36:39 +0000 Subject: [PATCH] Fix warnings --- compiler/cmm/Cmm.hs | 8 ++++++-- compiler/cmm/CmmNode.hs | 9 +++++++-- compiler/cmm/CmmSpillReload.hs | 8 +++++++- compiler/cmm/CmmStackLayout.hs | 7 +++++++ 4 files changed, 27 insertions(+), 5 deletions(-) diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index 076922e..2e9f952 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -2,6 +2,12 @@ {-# LANGUAGE GADTs #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +#if __GLASGOW_HASKELL__ >= 701 +-- GHC 7.0.1 improved incomplete pattern warnings with GADTs +{-# OPTIONS_GHC -fwarn-incomplete-patterns #-} +#endif + module Cmm ( CmmGraph(..), CmmBlock , CmmStackInfo(..), CmmTopInfo(..), Cmm, CmmTop @@ -52,7 +58,6 @@ type CmmTop = GenCmmTop CmmStatic CmmTopInfo CmmGraph toBlockMap :: CmmGraph -> LabelMap CmmBlock toBlockMap (CmmGraph {g_graph=GMany NothingO body NothingO}) = body ---toBlockMap _ = panic "Cmm.toBlockMap" ofBlockMap :: BlockId -> LabelMap CmmBlock -> CmmGraph ofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyMap NothingO} @@ -131,7 +136,6 @@ insertBetween b ms succId = insert $ lastNode b panic "unimp: insertBetween after a call -- probably not a good idea" insert (CmmForeignCall {}) = panic "unimp: insertBetween after a foreign call -- probably not a good idea" - --insert _ = panic "Cmm.insertBetween.insert" newBlocks :: MonadUnique m => m (BlockId, [CmmBlock]) newBlocks = do id <- liftM mkBlockId $ getUniqueM diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs index 12d534e..93564ac 100644 --- a/compiler/cmm/CmmNode.hs +++ b/compiler/cmm/CmmNode.hs @@ -1,5 +1,12 @@ -- CmmNode type for representation using Hoopl graphs. {-# LANGUAGE GADTs #-} + +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +#if __GLASGOW_HASKELL__ >= 701 +-- GHC 7.0.1 improved incomplete pattern warnings with GADTs +{-# OPTIONS_GHC -fwarn-incomplete-patterns #-} +#endif + module CmmNode ( CmmNode(..) , UpdFrameOffset, Convention(..), ForeignConvention(..), ForeignTarget(..) @@ -129,14 +136,12 @@ instance Eq (CmmNode e x) where instance NonLocal CmmNode where entryLabel (CmmEntry l) = l - -- entryLabel _ = error "CmmNode.entryLabel" successors (CmmBranch l) = [l] successors (CmmCondBranch {cml_true=t, cml_false=f}) = [f, t] -- meets layout constraint successors (CmmSwitch _ ls) = catMaybes ls successors (CmmCall {cml_cont=l}) = maybeToList l successors (CmmForeignCall {succ=l}) = [l] - -- successors _ = error "CmmNode.successors" instance HooplNode CmmNode where diff --git a/compiler/cmm/CmmSpillReload.hs b/compiler/cmm/CmmSpillReload.hs index 0c00994..4e2dd38 100644 --- a/compiler/cmm/CmmSpillReload.hs +++ b/compiler/cmm/CmmSpillReload.hs @@ -1,7 +1,13 @@ -{-# OPTIONS_GHC -XGADTs -XNoMonoLocalBinds #-} +{-# LANGUAGE GADTs,NoMonoLocalBinds #-} -- Norman likes local bindings -- If this module lives on I'd like to get rid of this flag in due course +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +#if __GLASGOW_HASKELL__ >= 701 +-- GHC 7.0.1 improved incomplete pattern warnings with GADTs +{-# OPTIONS_GHC -fwarn-incomplete-patterns #-} +#endif + module CmmSpillReload ( DualLive(..) , dualLiveLattice, dualLiveTransfers, dualLiveness diff --git a/compiler/cmm/CmmStackLayout.hs b/compiler/cmm/CmmStackLayout.hs index 4756bbd..01543c4 100644 --- a/compiler/cmm/CmmStackLayout.hs +++ b/compiler/cmm/CmmStackLayout.hs @@ -5,6 +5,12 @@ -- Todo: remove {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +#if __GLASGOW_HASKELL__ >= 701 +-- GHC 7.0.1 improved incomplete pattern warnings with GADTs +{-# OPTIONS_GHC -fwarn-incomplete-patterns #-} +#endif + module CmmStackLayout ( SlotEnv, liveSlotAnal, liveSlotTransfers, removeLiveSlotDefs , layout, manifestSP, igraph, areaBuilder @@ -123,6 +129,7 @@ liveSlotTransfers :: BwdTransfer CmmNode SubAreaSet liveSlotTransfers = mkBTransfer3 frt mid lst where frt :: CmmNode C O -> SubAreaSet -> SubAreaSet frt (CmmEntry l) f = Map.delete (CallArea (Young l)) f + mid :: CmmNode O O -> SubAreaSet -> SubAreaSet mid n f = foldSlotsUsed addSlot (removeLiveSlotDefs f n) n lst :: CmmNode O C -> FactBase SubAreaSet -> SubAreaSet -- 1.7.10.4