X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FZipCfgCmmRep.hs;h=0b93d1a0ea60202759c130c71b0a70bda1aca489;hb=684fde094dc5b064b49dbef191ca07cb9a018e45;hp=03fc759b3e9e9189df774614332b336d9036f42b;hpb=569348e87434f2a8d9e18dccac8b4a563b4eb363;p=ghc-hetmet.git

diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs
index 03fc759..0b93d1a 100644
--- a/compiler/cmm/ZipCfgCmmRep.hs
+++ b/compiler/cmm/ZipCfgCmmRep.hs
@@ -43,8 +43,7 @@ type CmmZ      = GenCmm    CmmStatic CmmInfo CmmGraph
 type CmmTopZ   = GenCmmTop CmmStatic CmmInfo CmmGraph
 
 data Middle
-  = MidNop
-  | MidComment FastString
+  = MidComment FastString
 
   | MidAssign CmmReg CmmExpr     -- Assign to register
 
@@ -84,7 +83,7 @@ data Last
 
   | LastJump CmmExpr    -- Tail call to another procedure; args in a CopyOut node
 
-  | LastCall {                   -- A call (native or safe foreign)
+  | LastCall {                   -- A call (native or safe foreign); args in CopyOut node
         cml_target :: CmmExpr,   -- never a CmmPrim to a CallishMachOp!
         cml_cont   :: Maybe BlockId }  -- BlockId of continuation, if call returns
 
@@ -152,6 +151,32 @@ fold_cmm_succs _f (LastCall _ Nothing)     z = z
 fold_cmm_succs  f (LastCondBranch _ te fe) z = f te (f fe z)
 fold_cmm_succs  f (LastSwitch _ edges)     z = foldl (flip f) z $ catMaybes edges
 
+----------------------------------------------------------------------
+----- Instance declarations for register use
+
+instance UserOfLocalRegs Middle where
+    foldRegsUsed f z m = middle m
+      where middle (MidComment {})                = z
+            middle (MidAssign _lhs expr)          = foldRegsUsed f z expr
+            middle (MidStore addr rval)           = foldRegsUsed f (foldRegsUsed f z addr) rval
+            middle (MidUnsafeCall tgt _ress args) = foldRegsUsed f (foldRegsUsed f z tgt) args
+            middle (CopyIn _ _formals _)          = z
+            middle (CopyOut _ actuals)            = foldRegsUsed f z actuals
+--            fold = foldRegsUsed
+
+instance UserOfLocalRegs Last where
+    foldRegsUsed f z m = last m
+      where last (LastReturn)           = z
+            last (LastJump e)           = foldRegsUsed f z e
+            last (LastBranch _id)       = z
+            last (LastCall tgt _)       = foldRegsUsed f z tgt
+            last (LastCondBranch e _ _) = foldRegsUsed f z e
+            last (LastSwitch e _tbl)    = foldRegsUsed f z e
+
+instance UserOfLocalRegs (ZLast Last) where
+    foldRegsUsed  f z (LastOther l) = foldRegsUsed f z l
+    foldRegsUsed _f z LastExit      = z
+
 
 ----------------------------------------------------------------------
 ----- Instance declarations for prettyprinting (avoids recursive imports)
@@ -176,8 +201,6 @@ debugPpr = debugIsOn
 pprMiddle :: Middle -> SDoc    
 pprMiddle stmt = (case stmt of
 
-    MidNop -> semi
-
     CopyIn conv args _ ->
         if null args then ptext SLIT("empty CopyIn")
         else commafy (map pprHinted args) <+> equals <+>
@@ -221,7 +244,6 @@ pprMiddle stmt = (case stmt of
   if debugPpr then empty
   else text " //" <+>
        case stmt of
-         MidNop {}     -> text "MidNop"
          CopyIn {}     -> text "CopyIn"
          CopyOut {}    -> text "CopyOut"
          MidComment {} -> text "MidComment"