PprCmmDecl.hs 6.6 KB
Newer Older
1 2 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
----------------------------------------------------------------------------
--
-- 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
--

Ian Lynagh's avatar
Ian Lynagh committed
35 36 37 38 39 40 41
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

42
module PprCmmDecl
Simon Peyton Jones's avatar
Simon Peyton Jones committed
43
    ( writeCmms, pprCmms, pprCmmGroup, pprSection, pprStatic
44 45 46 47 48
    )
where

import CLabel
import PprCmmExpr
49
import Cmm
50 51

import Outputable
52
import Platform
53 54 55 56 57 58 59 60 61 62
import FastString

import Data.List
import System.IO

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


63
pprCmms :: (PlatformOutputable info, PlatformOutputable g)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
64
        => Platform -> [GenCmmGroup CmmStatics info g] -> SDoc
65
pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pprPlatform platform) cmms))
66 67 68
        where
          separator = space $$ ptext (sLit "-------------------") $$ space

69
writeCmms :: (PlatformOutputable info, PlatformOutputable g)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
70
          => Platform -> Handle -> [GenCmmGroup CmmStatics info g] -> IO ()
71
writeCmms platform handle cmms = printForC handle (pprCmms platform cmms)
72 73 74

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

75
instance (PlatformOutputable d, PlatformOutputable info, PlatformOutputable i)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
76
      => PlatformOutputable (GenCmmDecl d info i) where
77
    pprPlatform platform t = pprTop platform t
78

79 80
instance PlatformOutputable CmmStatics where
    pprPlatform = pprStatics
81

82 83
instance PlatformOutputable CmmStatic where
    pprPlatform = pprStatic
84

85 86
instance PlatformOutputable CmmInfoTable where
    pprPlatform = pprInfoTable
87 88 89 90


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

91 92 93 94
pprCmmGroup :: (PlatformOutputable d,
                PlatformOutputable info,
                PlatformOutputable g)
            => Platform -> GenCmmGroup d info g -> SDoc
Simon Peyton Jones's avatar
Simon Peyton Jones committed
95
pprCmmGroup platform tops
96
    = vcat $ intersperse blankLine $ map (pprTop platform) tops
97 98 99 100

-- --------------------------------------------------------------------------
-- Top level `procedure' blocks.
--
101
pprTop :: (PlatformOutputable d, PlatformOutputable info, PlatformOutputable i)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
102
       => Platform -> GenCmmDecl d info i -> SDoc
103

104
pprTop platform (CmmProc info lbl graph)
105

106 107
  = vcat [ pprCLabel platform lbl <> lparen <> rparen
         , nest 8 $ lbrace <+> pprPlatform platform info $$ rbrace
108
         , nest 4 $ pprPlatform platform graph
109 110 111 112 113 114 115
         , rbrace ]

-- --------------------------------------------------------------------------
-- We follow [1], 4.5
--
--      section "data" { ... }
--
116 117
pprTop platform (CmmData section ds) =
    (hang (pprSection section <+> lbrace) 4 (pprPlatform platform ds))
118 119 120 121 122
    $$ rbrace

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

123 124
pprInfoTable :: Platform -> CmmInfoTable -> SDoc
pprInfoTable _ CmmNonInfoTable
125
  = empty
126 127
pprInfoTable platform
             (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
128 129
                           , cit_prof = prof_info
                           , cit_srt = _srt })  
130
  = vcat [ ptext (sLit "label:") <+> pprPlatform platform lbl
131 132 133 134 135 136
         , ptext (sLit "rep:") <> ppr rep
         , case prof_info of
	     NoProfilingInfo -> empty
             ProfilingInfo ct cd -> vcat [ ptext (sLit "type:") <+> pprWord8String ct
                                         , ptext (sLit "desc: ") <> pprWord8String cd ] ]

137 138 139 140 141
instance PlatformOutputable C_SRT where
  pprPlatform _ (NoC_SRT) = ptext (sLit "_no_srt_")
  pprPlatform platform (C_SRT label off bitmap)
      = parens (pprPlatform platform label <> comma <> ppr off
                                           <> comma <> text (show bitmap))
142 143 144 145 146 147 148

instance Outputable ForeignHint where
  ppr NoHint     = empty
  ppr SignedHint = quotes(text "signed")
--  ppr AddrHint   = quotes(text "address")
-- Temp Jan08
  ppr AddrHint   = (text "PtrHint")
149 150
instance PlatformOutputable ForeignHint where
    pprPlatform _ = ppr
151 152 153 154 155 156

-- --------------------------------------------------------------------------
-- Static data.
--      Strings are printed as C strings, and we print them as I8[],
--      following C--
--
157 158
pprStatics :: Platform -> CmmStatics -> SDoc
pprStatics platform (Statics lbl ds) = vcat ((pprCLabel platform lbl <> colon) : map (pprPlatform platform) ds)
159

160 161 162
pprStatic :: Platform -> CmmStatic -> SDoc
pprStatic platform s = case s of
    CmmStaticLit lit   -> nest 4 $ ptext (sLit "const") <+> pprLit platform lit <> semi
163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
    CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
    CmmString s'       -> nest 4 $ text "I8[]" <+> text (show s')

-- --------------------------------------------------------------------------
-- data sections
--
pprSection :: Section -> SDoc
pprSection s = case s of
    Text              -> section <+> doubleQuotes (ptext (sLit "text"))
    Data              -> section <+> doubleQuotes (ptext (sLit "data"))
    ReadOnlyData      -> section <+> doubleQuotes (ptext (sLit "readonly"))
    ReadOnlyData16    -> section <+> doubleQuotes (ptext (sLit "readonly16"))
    RelocatableReadOnlyData
                      -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
    UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
    OtherSection s'   -> section <+> doubleQuotes (text s')
 where
    section = ptext (sLit "section")