PprCmmDecl.hs 5.59 KB
Newer Older
1 2
{-# LANGUAGE CPP #-}

3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
----------------------------------------------------------------------------
--
-- Pretty-printing of common Cmm types
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------

--
-- This is where we walk over Cmm emitting an external representation,
-- suitable for parsing, in a syntax strongly reminiscent of C--. This
-- is the "External Core" for the Cmm layer.
--
-- As such, this should be a well-defined syntax: we want it to look nice.
-- Thus, we try wherever possible to use syntax defined in [1],
-- "The C-- Reference Manual", http://www.cminusminus.org/. We differ
-- slightly, in some cases. For one, we use I8 .. I64 for types, rather
-- than C--'s bits8 .. bits64.
--
-- We try to ensure that all information available in the abstract
-- syntax is reproduced, or reproducible, in the concrete syntax.
-- Data that is not in printed out can be reconstructed according to
-- conventions used in the pretty printer. There are at least two such
-- cases:
--      1) if a value has wordRep type, the type is not appended in the
--      output.
--      2) MachOps that operate over wordRep type are printed in a
--      C-style, rather than as their internal MachRep name.
--
-- These conventions produce much more readable Cmm output.
--
-- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
--

37
{-# OPTIONS_GHC -fno-warn-orphans #-}
38
module PprCmmDecl
Simon Peyton Jones's avatar
Simon Peyton Jones committed
39
    ( writeCmms, pprCmms, pprCmmGroup, pprSection, pprStatic
40 41 42 43
    )
where

import PprCmmExpr
44
import Cmm
45

46
import DynFlags
47 48 49 50 51 52 53 54 55 56 57
import Outputable
import FastString

import Data.List
import System.IO

-- Temp Jan08
import SMRep
#include "../includes/rts/storage/FunTypes.h"


Ian Lynagh's avatar
Ian Lynagh committed
58
pprCmms :: (Outputable info, Outputable g)
59 60
        => [GenCmmGroup CmmStatics info g] -> SDoc
pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
61
        where
62
          separator = space $$ text "-------------------" $$ space
63

Ian Lynagh's avatar
Ian Lynagh committed
64
writeCmms :: (Outputable info, Outputable g)
65
          => DynFlags -> Handle -> [GenCmmGroup CmmStatics info g] -> IO ()
66
writeCmms dflags handle cmms = printForC dflags handle (pprCmms cmms)
67 68 69

-----------------------------------------------------------------------------

Ian Lynagh's avatar
Ian Lynagh committed
70 71
instance (Outputable d, Outputable info, Outputable i)
      => Outputable (GenCmmDecl d info i) where
72
    ppr t = pprTop t
73

Ian Lynagh's avatar
Ian Lynagh committed
74
instance Outputable CmmStatics where
75
    ppr = pprStatics
76

Ian Lynagh's avatar
Ian Lynagh committed
77
instance Outputable CmmStatic where
78
    ppr = pprStatic
79

Ian Lynagh's avatar
Ian Lynagh committed
80
instance Outputable CmmInfoTable where
81
    ppr = pprInfoTable
82 83 84 85


-----------------------------------------------------------------------------

Ian Lynagh's avatar
Ian Lynagh committed
86
pprCmmGroup :: (Outputable d, Outputable info, Outputable g)
87 88 89
            => GenCmmGroup d info g -> SDoc
pprCmmGroup tops
    = vcat $ intersperse blankLine $ map pprTop tops
90 91 92 93

-- --------------------------------------------------------------------------
-- Top level `procedure' blocks.
--
Ian Lynagh's avatar
Ian Lynagh committed
94
pprTop :: (Outputable d, Outputable info, Outputable i)
95
       => GenCmmDecl d info i -> SDoc
96

97
pprTop (CmmProc info lbl live graph)
98

99
  = vcat [ ppr lbl <> lparen <> rparen <+> text "// " <+> ppr live
Ian Lynagh's avatar
Ian Lynagh committed
100 101
         , nest 8 $ lbrace <+> ppr info $$ rbrace
         , nest 4 $ ppr graph
102 103 104 105 106 107 108
         , rbrace ]

-- --------------------------------------------------------------------------
-- We follow [1], 4.5
--
--      section "data" { ... }
--
109
pprTop (CmmData section ds) =
Ian Lynagh's avatar
Ian Lynagh committed
110
    (hang (pprSection section <+> lbrace) 4 (ppr ds))
111 112 113 114 115
    $$ rbrace

-- --------------------------------------------------------------------------
-- Info tables.

116 117
pprInfoTable :: CmmInfoTable -> SDoc
pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
118
                           , cit_prof = prof_info
119
                           , cit_srt = _srt })
120 121
  = vcat [ text "label:" <+> ppr lbl
         , text "rep:" <> ppr rep
122
         , case prof_info of
123
             NoProfilingInfo -> empty
124 125
             ProfilingInfo ct cd -> vcat [ text "type:" <+> pprWord8String ct
                                         , text "desc: " <> pprWord8String cd ] ]
126

Ian Lynagh's avatar
Ian Lynagh committed
127
instance Outputable C_SRT where
128
  ppr NoC_SRT = text "_no_srt_"
Ian Lynagh's avatar
Ian Lynagh committed
129
  ppr (C_SRT label off bitmap)
130
      = parens (ppr label <> comma <> ppr off <> comma <> ppr bitmap)
131 132 133 134 135 136 137 138 139 140 141 142 143

instance Outputable ForeignHint where
  ppr NoHint     = empty
  ppr SignedHint = quotes(text "signed")
--  ppr AddrHint   = quotes(text "address")
-- Temp Jan08
  ppr AddrHint   = (text "PtrHint")

-- --------------------------------------------------------------------------
-- Static data.
--      Strings are printed as C strings, and we print them as I8[],
--      following C--
--
144 145
pprStatics :: CmmStatics -> SDoc
pprStatics (Statics lbl ds) = vcat ((ppr lbl <> colon) : map ppr ds)
146

147 148
pprStatic :: CmmStatic -> SDoc
pprStatic s = case s of
149
    CmmStaticLit lit   -> nest 4 $ text "const" <+> pprLit lit <> semi
150 151 152 153 154 155 156
    CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
    CmmString s'       -> nest 4 $ text "I8[]" <+> text (show s')

-- --------------------------------------------------------------------------
-- data sections
--
pprSection :: Section -> SDoc
157 158 159
pprSection (Section t suffix) =
  section <+> doubleQuotes (pprSectionType t <+> char '.' <+> ppr suffix)
  where
160
    section = text "section"
161 162 163 164 165 166 167 168 169 170 171 172

pprSectionType :: SectionType -> SDoc
pprSectionType s = doubleQuotes (ptext t)
 where
  t = case s of
    Text              -> sLit "text"
    Data              -> sLit "data"
    ReadOnlyData      -> sLit "readonly"
    ReadOnlyData16    -> sLit "readonly16"
    RelocatableReadOnlyData
                      -> sLit "relreadonly"
    UninitialisedData -> sLit "uninitialised"
173
    CString           -> sLit "cstring"
174
    OtherSection s'   -> sLit s' -- Not actually a literal though.