never executed always true always false
    1 {-# LANGUAGE GADTs #-}
    2 {-# LANGUAGE MultiParamTypeClasses #-}
    3 {-# LANGUAGE FlexibleInstances #-}
    4 {-# LANGUAGE FlexibleContexts #-}
    5 
    6 
    7 ----------------------------------------------------------------------------
    8 --
    9 -- Pretty-printing of common Cmm types
   10 --
   11 -- (c) The University of Glasgow 2004-2006
   12 --
   13 -----------------------------------------------------------------------------
   14 
   15 --
   16 -- This is where we walk over Cmm emitting an external representation,
   17 -- suitable for parsing, in a syntax strongly reminiscent of C--. This
   18 -- is the "External Core" for the Cmm layer.
   19 --
   20 -- As such, this should be a well-defined syntax: we want it to look nice.
   21 -- Thus, we try wherever possible to use syntax defined in [1],
   22 -- "The C-- Reference Manual", http://www.cs.tufts.edu/~nr/c--/index.html. We
   23 -- differ slightly, in some cases. For one, we use I8 .. I64 for types, rather
   24 -- than C--'s bits8 .. bits64.
   25 --
   26 -- We try to ensure that all information available in the abstract
   27 -- syntax is reproduced, or reproducible, in the concrete syntax.
   28 -- Data that is not in printed out can be reconstructed according to
   29 -- conventions used in the pretty printer. There are at least two such
   30 -- cases:
   31 --      1) if a value has wordRep type, the type is not appended in the
   32 --      output.
   33 --      2) MachOps that operate over wordRep type are printed in a
   34 --      C-style, rather than as their internal MachRep name.
   35 --
   36 -- These conventions produce much more readable Cmm output.
   37 --
   38 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
   39 --
   40 
   41 {-# OPTIONS_GHC -fno-warn-orphans #-}
   42 module GHC.Cmm.Ppr.Decl
   43     ( pprCmms, pprCmmGroup, pprSection, pprStatic
   44     )
   45 where
   46 
   47 import GHC.Prelude
   48 
   49 import GHC.Platform
   50 import GHC.Cmm.Ppr.Expr
   51 import GHC.Cmm
   52 
   53 import GHC.Utils.Outputable
   54 
   55 import Data.List (intersperse)
   56 
   57 import qualified Data.ByteString as BS
   58 
   59 
   60 pprCmms :: (OutputableP Platform info, OutputableP Platform g)
   61         => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
   62 pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms))
   63         where
   64           separator = space $$ text "-------------------" $$ space
   65 
   66 -----------------------------------------------------------------------------
   67 
   68 instance (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
   69       => OutputableP Platform (GenCmmDecl d info i) where
   70     pdoc = pprTop
   71 
   72 instance OutputableP Platform (GenCmmStatics a) where
   73     pdoc = pprStatics
   74 
   75 instance OutputableP Platform CmmStatic where
   76     pdoc = pprStatic
   77 
   78 instance OutputableP Platform CmmInfoTable where
   79     pdoc = pprInfoTable
   80 
   81 
   82 -----------------------------------------------------------------------------
   83 
   84 pprCmmGroup :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform g)
   85             => Platform -> GenCmmGroup d info g -> SDoc
   86 pprCmmGroup platform tops
   87     = vcat $ intersperse blankLine $ map (pprTop platform) tops
   88 
   89 -- --------------------------------------------------------------------------
   90 -- Top level `procedure' blocks.
   91 --
   92 pprTop :: (OutputableP Platform d, OutputableP Platform info, OutputableP Platform i)
   93        => Platform -> GenCmmDecl d info i -> SDoc
   94 
   95 pprTop platform (CmmProc info lbl live graph)
   96 
   97   = vcat [ pdoc platform lbl <> lparen <> rparen <+> lbrace <+> text "// " <+> ppr live
   98          , nest 8 $ lbrace <+> pdoc platform info $$ rbrace
   99          , nest 4 $ pdoc platform graph
  100          , rbrace ]
  101 
  102 -- --------------------------------------------------------------------------
  103 -- We follow [1], 4.5
  104 --
  105 --      section "data" { ... }
  106 --
  107 pprTop platform (CmmData section ds) =
  108     (hang (pprSection platform section <+> lbrace) 4 (pdoc platform ds))
  109     $$ rbrace
  110 
  111 -- --------------------------------------------------------------------------
  112 -- Info tables.
  113 
  114 pprInfoTable :: Platform -> CmmInfoTable -> SDoc
  115 pprInfoTable platform (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
  116                            , cit_prof = prof_info
  117                            , cit_srt = srt })
  118   = vcat [ text "label: " <> pdoc platform lbl
  119          , text "rep: " <> ppr rep
  120          , case prof_info of
  121              NoProfilingInfo -> empty
  122              ProfilingInfo ct cd ->
  123                vcat [ text "type: " <> text (show (BS.unpack ct))
  124                     , text "desc: " <> text (show (BS.unpack cd)) ]
  125          , text "srt: " <> pdoc platform srt ]
  126 
  127 instance Outputable ForeignHint where
  128   ppr NoHint     = empty
  129   ppr SignedHint = quotes(text "signed")
  130 --  ppr AddrHint   = quotes(text "address")
  131 -- Temp Jan08
  132   ppr AddrHint   = (text "PtrHint")
  133 
  134 -- --------------------------------------------------------------------------
  135 -- Static data.
  136 --      Strings are printed as C strings, and we print them as I8[],
  137 --      following C--
  138 --
  139 
  140 pprStatics :: Platform -> GenCmmStatics a -> SDoc
  141 pprStatics platform (CmmStatics lbl itbl ccs payload) =
  142   pdoc platform lbl <> colon <+> pdoc platform itbl <+> ppr ccs <+> pdoc platform payload
  143 pprStatics platform (CmmStaticsRaw lbl ds) = vcat ((pdoc platform lbl <> colon) : map (pprStatic platform) ds)
  144 
  145 pprStatic :: Platform -> CmmStatic -> SDoc
  146 pprStatic platform s = case s of
  147     CmmStaticLit lit   -> nest 4 $ text "const" <+> pprLit platform lit <> semi
  148     CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
  149     CmmString s'       -> nest 4 $ text "I8[]" <+> text (show s')
  150     CmmFileEmbed path  -> nest 4 $ text "incbin " <+> text (show path)
  151 
  152 -- --------------------------------------------------------------------------
  153 -- data sections
  154 --
  155 pprSection :: Platform -> Section -> SDoc
  156 pprSection platform (Section t suffix) =
  157   section <+> doubleQuotes (pprSectionType t <+> char '.' <+> pdoc platform suffix)
  158   where
  159     section = text "section"
  160 
  161 pprSectionType :: SectionType -> SDoc
  162 pprSectionType s = doubleQuotes $ case s of
  163   Text                    -> text "text"
  164   Data                    -> text "data"
  165   ReadOnlyData            -> text "readonly"
  166   ReadOnlyData16          -> text "readonly16"
  167   RelocatableReadOnlyData -> text "relreadonly"
  168   UninitialisedData       -> text "uninitialised"
  169   CString                 -> text "cstring"
  170   OtherSection s'         -> text s'