X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FZipCfg.hs;h=67a4ecdde60e9cff77c33f6f7c76f1be6d86e864;hp=228504ce7c577b7ea953d3b639492448d9fe293d;hb=ba60dc74fdb18fe655cfac605130cf6480116e47;hpb=fee569a69a4ce8c8d05b8a1fb8069d804dbd2b9c diff --git a/compiler/cmm/ZipCfg.hs b/compiler/cmm/ZipCfg.hs index 228504c..67a4ecd 100644 --- 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 "" -pprTail (ZLast (LastOther l)) = ppr l +pprTail (ZLast l) = ppr l + +pprLast :: (Outputable l) => ZLast l -> SDoc +pprLast LastExit = text "" +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