minor changes to Cmm left over from September 2007

[ghc-hetmet.git] / compiler / cmm / ZipCfg.hs

diff --git a/compiler/cmm/ZipCfg.hs b/compiler/cmm/ZipCfg.hs
index 228504c..67a4ecd 100644 (file)
--- a/compiler/cmm/ZipCfg.hs
+++ b/compiler/cmm/ZipCfg.hs
@@ -37,6 +37,8 @@ where
 
 #include "HsVersions.h"
 
+import CmmExpr ( UserOfLocalRegs(..) ) --for an instance
+
 import Outputable hiding (empty)
 import Panic
 import Unique
@@ -140,6 +142,14 @@ data ZLast l
                  -- so we don't want to pollute the 'l' type parameter with it
   | LastOther l
 
+--So that we don't have orphan instances, this goes here or in CmmExpr.
+--At least UserOfLocalRegs (ZLast Last) is needed (Last defined elsewhere),
+--but there's no need for non-Haskell98 instances for that.
+instance UserOfLocalRegs a => UserOfLocalRegs (ZLast a) where
+    foldRegsUsed  f z (LastOther l) = foldRegsUsed f z l
+    foldRegsUsed _f z LastExit      = z
+
+
 data ZHead m   = ZFirst BlockId  | ZHead (ZHead m) m
     -- ZHead is a (reversed) sequence of middle nodes labeled by a BlockId
 data ZTail m l = ZLast (ZLast l) | ZTail m (ZTail m l)
@@ -678,10 +688,19 @@ mkBlockSet = mkUniqSet
 instance (Outputable m, Outputable l) => Outputable (ZTail m l) where
     ppr = pprTail
 
+instance (Outputable m, Outputable l, LastNode l) => Outputable (LGraph m l) where
+    ppr = pprLgraph
+
+instance (Outputable l) => Outputable (ZLast l) where
+    ppr = pprLast
+
 pprTail :: (Outputable m, Outputable l) => ZTail m l -> SDoc 
 pprTail (ZTail m t) = ppr m $$ ppr t
-pprTail (ZLast LastExit) = text "<exit>"
-pprTail (ZLast (LastOther l)) = ppr l
+pprTail (ZLast l) = ppr l
+
+pprLast :: (Outputable l) => ZLast l -> SDoc
+pprLast LastExit = text "<exit>"
+pprLast (LastOther l) = ppr l
 
 pprLgraph :: (Outputable m, Outputable l, LastNode l) => LGraph m l -> SDoc
 pprLgraph g = text "{" $$ nest 2 (vcat $ map pprBlock blocks) $$ text "}"
@@ -694,5 +713,3 @@ pprGraph (Graph tail blockenv) =
     where pprBlock (Block id tail) = ppr id <> colon $$ ppr tail
           blocks = postorder_dfs_from blockenv tail
 
-_unused :: FS.FastString
-_unused = undefined