never executed always true always false
    1 {-# LANGUAGE GADTs #-}
    2 {-# LANGUAGE TypeFamilies #-}
    3 {-# LANGUAGE FlexibleContexts #-}
    4 {-# LANGUAGE MultiParamTypeClasses #-}
    5 {-# LANGUAGE FlexibleInstances #-}
    6 {-# LANGUAGE LambdaCase #-}
    7 
    8 {-# OPTIONS_GHC -fno-warn-orphans #-}
    9 
   10 ----------------------------------------------------------------------------
   11 --
   12 -- Pretty-printing of Cmm as (a superset of) C--
   13 --
   14 -- (c) The University of Glasgow 2004-2006
   15 --
   16 -----------------------------------------------------------------------------
   17 --
   18 -- This is where we walk over CmmNode emitting an external representation,
   19 -- suitable for parsing, in a syntax strongly reminiscent of C--. This
   20 -- is the "External Core" for the Cmm layer.
   21 --
   22 -- As such, this should be a well-defined syntax: we want it to look nice.
   23 -- Thus, we try wherever possible to use syntax defined in [1],
   24 -- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We
   25 -- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather
   26 -- than C--'s bits8 .. bits64.
   27 --
   28 -- We try to ensure that all information available in the abstract
   29 -- syntax is reproduced, or reproducible, in the concrete syntax.
   30 -- Data that is not in printed out can be reconstructed according to
   31 -- conventions used in the pretty printer. There are at least two such
   32 -- cases:
   33 --      1) if a value has wordRep type, the type is not appended in the
   34 --      output.
   35 --      2) MachOps that operate over wordRep type are printed in a
   36 --      C-style, rather than as their internal MachRep name.
   37 --
   38 -- These conventions produce much more readable Cmm output.
   39 --
   40 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
   41 
   42 module GHC.Cmm.Ppr
   43   ( module GHC.Cmm.Ppr.Decl
   44   , module GHC.Cmm.Ppr.Expr
   45   )
   46 where
   47 
   48 import GHC.Prelude hiding (succ)
   49 
   50 import GHC.Platform
   51 import GHC.Cmm.CLabel
   52 import GHC.Cmm
   53 import GHC.Cmm.Utils
   54 import GHC.Cmm.Switch
   55 import GHC.Data.FastString
   56 import GHC.Utils.Outputable
   57 import GHC.Cmm.Ppr.Decl
   58 import GHC.Cmm.Ppr.Expr
   59 import GHC.Utils.Constants (debugIsOn)
   60 
   61 import GHC.Types.Basic
   62 import GHC.Cmm.Dataflow.Block
   63 import GHC.Cmm.Dataflow.Graph
   64 
   65 -------------------------------------------------
   66 -- Outputable instances
   67 instance OutputableP Platform InfoProvEnt where
   68   pdoc platform (InfoProvEnt clabel _ _ _ _) = pdoc platform clabel
   69 
   70 instance Outputable CmmStackInfo where
   71     ppr = pprStackInfo
   72 
   73 instance OutputableP Platform CmmTopInfo where
   74     pdoc = pprTopInfo
   75 
   76 
   77 instance OutputableP Platform (CmmNode e x) where
   78     pdoc = pprNode
   79 
   80 instance Outputable Convention where
   81     ppr = pprConvention
   82 
   83 instance Outputable ForeignConvention where
   84     ppr = pprForeignConvention
   85 
   86 instance OutputableP Platform ForeignTarget where
   87     pdoc = pprForeignTarget
   88 
   89 instance Outputable CmmReturnInfo where
   90     ppr = pprReturnInfo
   91 
   92 instance OutputableP Platform (Block CmmNode C C) where
   93     pdoc = pprBlock
   94 instance OutputableP Platform (Block CmmNode C O) where
   95     pdoc = pprBlock
   96 instance OutputableP Platform (Block CmmNode O C) where
   97     pdoc = pprBlock
   98 instance OutputableP Platform (Block CmmNode O O) where
   99     pdoc = pprBlock
  100 
  101 instance OutputableP Platform (Graph CmmNode e x) where
  102     pdoc = pprGraph
  103 
  104 instance OutputableP Platform CmmGraph where
  105     pdoc = pprCmmGraph
  106 
  107 ----------------------------------------------------------
  108 -- Outputting types Cmm contains
  109 
  110 pprStackInfo :: CmmStackInfo -> SDoc
  111 pprStackInfo (StackInfo {arg_space=arg_space}) =
  112   text "arg_space: " <> ppr arg_space
  113 
  114 pprTopInfo :: Platform -> CmmTopInfo -> SDoc
  115 pprTopInfo platform (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =
  116   vcat [text "info_tbls: " <> pdoc platform info_tbl,
  117         text "stack_info: " <> ppr stack_info]
  118 
  119 ----------------------------------------------------------
  120 -- Outputting blocks and graphs
  121 
  122 pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
  123          => Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
  124 pprBlock platform block
  125     = foldBlockNodesB3 ( ($$) . pdoc platform
  126                        , ($$) . (nest 4) . pdoc platform
  127                        , ($$) . (nest 4) . pdoc platform
  128                        )
  129                        block
  130                        empty
  131 
  132 pprGraph :: Platform -> Graph CmmNode e x -> SDoc
  133 pprGraph platform = \case
  134    GNil                  -> empty
  135    GUnit block           -> pdoc platform block
  136    GMany entry body exit ->
  137          text "{"
  138       $$ nest 2 (pprMaybeO entry $$ (vcat $ map (pdoc platform) $ bodyToBlockList body) $$ pprMaybeO exit)
  139       $$ text "}"
  140       where pprMaybeO :: OutputableP Platform (Block CmmNode e x)
  141                       => MaybeO ex (Block CmmNode e x) -> SDoc
  142             pprMaybeO NothingO = empty
  143             pprMaybeO (JustO block) = pdoc platform block
  144 
  145 pprCmmGraph :: Platform -> CmmGraph -> SDoc
  146 pprCmmGraph platform g
  147    = text "{" <> text "offset"
  148   $$ nest 2 (vcat $ map (pdoc platform) blocks)
  149   $$ text "}"
  150   where blocks = revPostorder g
  151     -- revPostorder has the side-effect of discarding unreachable code,
  152     -- so pretty-printed Cmm will omit any unreachable blocks.  This can
  153     -- sometimes be confusing.
  154 
  155 ---------------------------------------------
  156 -- Outputting CmmNode and types which it contains
  157 
  158 pprConvention :: Convention -> SDoc
  159 pprConvention (NativeNodeCall   {}) = text "<native-node-call-convention>"
  160 pprConvention (NativeDirectCall {}) = text "<native-direct-call-convention>"
  161 pprConvention (NativeReturn {})     = text "<native-ret-convention>"
  162 pprConvention  Slow                 = text "<slow-convention>"
  163 pprConvention  GC                   = text "<gc-convention>"
  164 
  165 pprForeignConvention :: ForeignConvention -> SDoc
  166 pprForeignConvention (ForeignConvention c args res ret) =
  167           doubleQuotes (ppr c) <+> text "arg hints: " <+> ppr args <+> text " result hints: " <+> ppr res <+> ppr ret
  168 
  169 pprReturnInfo :: CmmReturnInfo -> SDoc
  170 pprReturnInfo CmmMayReturn = empty
  171 pprReturnInfo CmmNeverReturns = text "never returns"
  172 
  173 pprForeignTarget :: Platform -> ForeignTarget -> SDoc
  174 pprForeignTarget platform (ForeignTarget fn c) = ppr c <+> ppr_target fn
  175   where
  176         ppr_target :: CmmExpr -> SDoc
  177         ppr_target t@(CmmLit _) = pdoc platform t
  178         ppr_target fn'          = parens (pdoc platform fn')
  179 
  180 pprForeignTarget platform (PrimTarget op)
  181  -- HACK: We're just using a ForeignLabel to get this printed, the label
  182  --       might not really be foreign.
  183  = pdoc platform
  184                (CmmLabel (mkForeignLabel
  185                          (mkFastString (show op))
  186                          Nothing ForeignLabelInThisPackage IsFunction))
  187 
  188 pprNode :: Platform -> CmmNode e x -> SDoc
  189 pprNode platform node = pp_node <+> pp_debug
  190   where
  191     pp_node :: SDoc
  192     pp_node = case node of
  193       -- label:
  194       CmmEntry id tscope ->
  195          (sdocOption sdocSuppressUniques $ \case
  196             True  -> text "_lbl_"
  197             False -> ppr id
  198          )
  199          <> colon
  200          <+> ppUnlessOption sdocSuppressTicks (text "//" <+> ppr tscope)
  201 
  202       -- // text
  203       CmmComment s -> text "//" <+> ftext s
  204 
  205       -- //tick bla<...>
  206       CmmTick t -> ppUnlessOption sdocSuppressTicks
  207                      (text "//tick" <+> ppr t)
  208 
  209       -- unwind reg = expr;
  210       CmmUnwind regs ->
  211           text "unwind "
  212           <> commafy (map (\(r,e) -> ppr r <+> char '=' <+> pdoc platform e) regs) <> semi
  213 
  214       -- reg = expr;
  215       CmmAssign reg expr -> ppr reg <+> equals <+> pdoc platform expr <> semi
  216 
  217       -- rep[lv] = expr;
  218       CmmStore lv expr -> rep <> brackets (pdoc platform lv) <+> equals <+> pdoc platform expr <> semi
  219           where
  220             rep = ppr ( cmmExprType platform expr )
  221 
  222       -- call "ccall" foo(x, y)[r1, r2];
  223       -- ToDo ppr volatile
  224       CmmUnsafeForeignCall target results args ->
  225           hsep [ ppUnless (null results) $
  226                     parens (commafy $ map ppr results) <+> equals,
  227                  text "call",
  228                  pdoc platform target <> parens (commafy $ map (pdoc platform) args) <> semi]
  229 
  230       -- goto label;
  231       CmmBranch ident -> text "goto" <+> ppr ident <> semi
  232 
  233       -- if (expr) goto t; else goto f;
  234       CmmCondBranch expr t f l ->
  235           hsep [ text "if"
  236                , parens (pdoc platform expr)
  237                , case l of
  238                    Nothing -> empty
  239                    Just b -> parens (text "likely:" <+> ppr b)
  240                , text "goto"
  241                , ppr t <> semi
  242                , text "else goto"
  243                , ppr f <> semi
  244                ]
  245 
  246       CmmSwitch expr ids ->
  247           hang (hsep [ text "switch"
  248                      , range
  249                      , if isTrivialCmmExpr expr
  250                        then pdoc platform expr
  251                        else parens (pdoc platform expr)
  252                      , text "{"
  253                      ])
  254              4 (vcat (map ppCase cases) $$ def) $$ rbrace
  255           where
  256             (cases, mbdef) = switchTargetsFallThrough ids
  257             ppCase (is,l) = hsep
  258                             [ text "case"
  259                             , commafy $ map integer is
  260                             , text ": goto"
  261                             , ppr l <> semi
  262                             ]
  263             def | Just l <- mbdef = hsep
  264                             [ text "default:"
  265                             , braces (text "goto" <+> ppr l <> semi)
  266                             ]
  267                 | otherwise = empty
  268 
  269             range = brackets $ hsep [integer lo, text "..", integer hi]
  270               where (lo,hi) = switchTargetsRange ids
  271 
  272       CmmCall tgt k regs out res updfr_off ->
  273           hcat [ text "call", space
  274                , pprFun tgt, parens (interpp'SP regs), space
  275                , returns <+>
  276                  text "args: " <> ppr out <> comma <+>
  277                  text "res: " <> ppr res <> comma <+>
  278                  text "upd: " <> ppr updfr_off
  279                , semi ]
  280           where pprFun f@(CmmLit _) = pdoc platform f
  281                 pprFun f = parens (pdoc platform f)
  282 
  283                 returns
  284                   | Just r <- k = text "returns to" <+> ppr r <> comma
  285                   | otherwise   = empty
  286 
  287       CmmForeignCall {tgt=t, res=rs, args=as, succ=s, ret_args=a, ret_off=u, intrbl=i} ->
  288           hcat $ if i then [text "interruptible", space] else [] ++
  289                [ text "foreign call", space
  290                , pdoc platform t, text "(...)", space
  291                , text "returns to" <+> ppr s
  292                     <+> text "args:" <+> parens (pdoc platform as)
  293                     <+> text "ress:" <+> parens (ppr rs)
  294                , text "ret_args:" <+> ppr a
  295                , text "ret_off:" <+> ppr u
  296                , semi ]
  297 
  298     pp_debug :: SDoc
  299     pp_debug =
  300       if not debugIsOn then empty
  301       else case node of
  302              CmmEntry {}             -> empty -- Looks terrible with text "  // CmmEntry"
  303              CmmComment {}           -> empty -- Looks also terrible with text "  // CmmComment"
  304              CmmTick {}              -> empty
  305              CmmUnwind {}            -> text "  // CmmUnwind"
  306              CmmAssign {}            -> text "  // CmmAssign"
  307              CmmStore {}             -> text "  // CmmStore"
  308              CmmUnsafeForeignCall {} -> text "  // CmmUnsafeForeignCall"
  309              CmmBranch {}            -> text "  // CmmBranch"
  310              CmmCondBranch {}        -> text "  // CmmCondBranch"
  311              CmmSwitch {}            -> text "  // CmmSwitch"
  312              CmmCall {}              -> text "  // CmmCall"
  313              CmmForeignCall {}       -> text "  // CmmForeignCall"
  314 
  315     commafy :: [SDoc] -> SDoc
  316     commafy xs = hsep $ punctuate comma xs