Interruptible FFI calls with pthread_kill and CancelSynchronousIO. v4

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

diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 1160273..f5c5a49 100644 (file)
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -143,6 +143,7 @@ pprTop (CmmData section ds) =
 instance Outputable CmmSafety where
   ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
   ppr (CmmSafe srt) = ppr srt
 instance Outputable CmmSafety where
   ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
   ppr (CmmSafe srt) = ppr srt

+  ppr CmmInterruptible = ptext (sLit "_interruptible_call_")

 
 -- --------------------------------------------------------------------------
 -- Info tables. The current pretty printer needs refinement
 
 -- --------------------------------------------------------------------------
 -- Info tables. The current pretty printer needs refinement

@@ -265,6 +266,8 @@ pprStmt stmt = case stmt of
          pp_lhs | null results = empty
                 | otherwise    = commafy (map ppr_ar results) <+> equals
                -- Don't print the hints on a native C-- call
          pp_lhs | null results = empty
                 | otherwise    = commafy (map ppr_ar results) <+> equals
                -- Don't print the hints on a native C-- call

+
+          ppr_ar :: Outputable a => CmmHinted a -> SDoc

          ppr_ar (CmmHinted ar k) = case cconv of
                            CmmCallConv -> ppr ar
                            _           -> ppr (ar,k)
          ppr_ar (CmmHinted ar k) = case cconv of
                            CmmCallConv -> ppr ar
                            _           -> ppr (ar,k)