X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FRegAllocLinear.hs;h=e6491b77ee9a15cdbc437d30e2067c47a5695530;hp=7c7690c798261d7e3ca0fc2920d6c73d108aba35;hb=e3971de1fe67e414060047c09c4d5c64c7083981;hpb=f8c52d7fde2d7408b4f734251c373f8d3e2c558e

diff --git a/compiler/nativeGen/RegAllocLinear.hs b/compiler/nativeGen/RegAllocLinear.hs
index 7c7690c..e6491b7 100644
--- a/compiler/nativeGen/RegAllocLinear.hs
+++ b/compiler/nativeGen/RegAllocLinear.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS -fno-warn-missing-signatures #-}
 -----------------------------------------------------------------------------
 --
 -- The register allocator
@@ -5,7 +6,6 @@
 -- (c) The University of Glasgow 2004
 --
 -----------------------------------------------------------------------------
-{-# OPTIONS -fno-warn-missing-signatures #-}
 
 {-
 The algorithm is roughly:
@@ -155,8 +155,9 @@ getFreeRegs :: RegClass -> FreeRegs -> [RegNo]	-- lazilly
 getFreeRegs cls (FreeRegs g f)
     | RcDouble <- cls = go f (0x80000000) 63
     | RcInteger <- cls = go g (0x80000000) 31
+    | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad cls" (ppr cls)
     where
-        go x 0 i = []
+        go _ 0 _ = []
         go x m i | x .&. m /= 0 = i : (go x (m `shiftR` 1) $! i-1)
                  | otherwise    = go x (m `shiftR` 1) $! i-1
 
@@ -221,7 +222,8 @@ emptyStackMap = StackMap [0..maxSpillSlots] emptyUFM
 
 getStackSlotFor :: StackMap -> Unique -> (StackMap,Int)
 getStackSlotFor (StackMap [] _) _
-	= panic "RegAllocLinear.getStackSlotFor: out of stack slots"
+	= panic "RegAllocLinear.getStackSlotFor: out of stack slots, try -fregs-graph"
+        -- This happens with darcs' SHA1.hs, see #1993
 
 getStackSlotFor fs@(StackMap (freeSlot:stack') reserved) reg =
     case lookupUFM reserved reg of