-------------------------------------------------------------------------------- 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.cs.tufts.edu/~nr/c--/index.html. 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--{-# OPTIONS_GHC -fno-warn-orphans #-}modulePprCmmExpr(pprExpr ,pprLit )whereimportGhcPrelude importCmmExpr importOutputable importDynFlags importData.MaybeimportNumeric(fromRat)-----------------------------------------------------------------------------instanceOutputable CmmExpr whereppr e =pprExpr e instanceOutputable CmmReg whereppr e =pprReg e instanceOutputable CmmLit whereppr l =pprLit l instanceOutputable LocalReg whereppr e =pprLocalReg e instanceOutputable Area whereppr e =pprArea e instanceOutputable GlobalReg whereppr e =pprGlobalReg e -- ---------------------------------------------------------------------------- Expressions--pprExpr::CmmExpr ->SDoc pprExpr e =sdocWithDynFlags $\dflags ->casee ofCmmRegOff reg i ->pprExpr (CmmMachOp (MO_Add rep )[CmmReg reg ,CmmLit (CmmInt (fromIntegrali )rep )])whererep =typeWidth (cmmRegType dflags reg )CmmLit lit ->pprLit lit _other ->pprExpr1 e -- Here's the precedence table from CmmParse.y:-- %nonassoc '>=' '>' '<=' '<' '!=' '=='-- %left '|'-- %left '^'-- %left '&'-- %left '>>' '<<'-- %left '-' '+'-- %left '/' '*' '%'-- %right '~'-- We just cope with the common operators for now, the rest will get-- a default conservative behaviour.-- %nonassoc '>=' '>' '<=' '<' '!=' '=='pprExpr1,pprExpr7,pprExpr8::CmmExpr ->SDoc pprExpr1 (CmmMachOp op [x ,y ])|Justdoc <-infixMachOp1 op =pprExpr7 x <+> doc <+> pprExpr7 y pprExpr1e =pprExpr7 e infixMachOp1,infixMachOp7,infixMachOp8::MachOp ->MaybeSDoc infixMachOp1 (MO_Eq _)=Just(text "==")infixMachOp1(MO_Ne _)=Just(text "!=")infixMachOp1(MO_Shl _)=Just(text "<<")infixMachOp1(MO_U_Shr _)=Just(text ">>")infixMachOp1(MO_U_Ge _)=Just(text ">=")infixMachOp1(MO_U_Le _)=Just(text "<=")infixMachOp1(MO_U_Gt _)=Just(char '>')infixMachOp1(MO_U_Lt _)=Just(char '<')infixMachOp1_=Nothing-- %left '-' '+'pprExpr7 (CmmMachOp (MO_Add rep1 )[x ,CmmLit (CmmInt i rep2 )])|i <0=pprExpr7 (CmmMachOp (MO_Sub rep1 )[x ,CmmLit (CmmInt (negatei )rep2 )])pprExpr7(CmmMachOp op [x ,y ])|Justdoc <-infixMachOp7 op =pprExpr7 x <+> doc <+> pprExpr8 y pprExpr7e =pprExpr8 e infixMachOp7 (MO_Add _)=Just(char '+')infixMachOp7(MO_Sub _)=Just(char '-')infixMachOp7_=Nothing-- %left '/' '*' '%'pprExpr8 (CmmMachOp op [x ,y ])|Justdoc <-infixMachOp8 op =pprExpr8 x <+> doc <+> pprExpr9 y pprExpr8e =pprExpr9 e infixMachOp8 (MO_U_Quot _)=Just(char '/')infixMachOp8(MO_Mul _)=Just(char '*')infixMachOp8(MO_U_Rem _)=Just(char '%')infixMachOp8_=NothingpprExpr9::CmmExpr ->SDoc pprExpr9 e =casee ofCmmLit lit ->pprLit1 lit CmmLoad expr rep ->ppr rep <> brackets (ppr expr )CmmReg reg ->ppr reg CmmRegOff reg off ->parens (ppr reg <+> char '+'<+> int off )CmmStackSlot a off ->parens (ppr a <+> char '+'<+> int off )CmmMachOp mop args ->genMachOp mop args genMachOp::MachOp ->[CmmExpr ]->SDoc genMachOp mop args |Justdoc <-infixMachOp mop =caseargs of-- dyadic[x ,y ]->pprExpr9 x <+> doc <+> pprExpr9 y -- unary[x ]->doc <> pprExpr9 x _->pprTrace "PprCmm.genMachOp: machop with strange number of args"(pprMachOp mop <+> parens (hcat $punctuate comma (mappprExpr args )))empty |isJust(infixMachOp1 mop )||isJust(infixMachOp7 mop )||isJust(infixMachOp8 mop )=parens (pprExpr (CmmMachOp mop args ))|otherwise=char '%'<> ppr_op <> parens (commafy (mappprExpr args ))whereppr_op =text (map(\c ->ifc ==' 'then'_'elsec )(showmop ))-- replace spaces in (show mop) with underscores,---- Unsigned ops on the word size of the machine get nice symbols.-- All else get dumped in their ugly format.--infixMachOp::MachOp ->MaybeSDoc infixMachOp mop =casemop ofMO_And _->Just$char '&'MO_Or _->Just$char '|'MO_Xor _->Just$char '^'MO_Not _->Just$char '~'MO_S_Neg _->Just$char '-'-- there is no unsigned neg :)_->Nothing-- ---------------------------------------------------------------------------- Literals.-- To minimise line noise we adopt the convention that if the literal-- has the natural machine word size, we do not append the type--pprLit::CmmLit ->SDoc pprLit lit =sdocWithDynFlags $\dflags ->caselit ofCmmInt i rep ->hcat [(ifi <0thenparens elseid)(integer i ),ppUnless (rep ==wordWidth dflags )$space <> dcolon <+> ppr rep ]CmmFloat f rep ->hsep [double (fromRatf ),dcolon ,ppr rep ]CmmVec lits ->char '<'<> commafy (mappprLit lits )<> char '>'CmmLabel clbl ->ppr clbl CmmLabelOff clbl i ->ppr clbl <> ppr_offset i CmmLabelDiffOff clbl1 clbl2 i _->ppr clbl1 <> char '-'<> ppr clbl2 <> ppr_offset i CmmBlock id ->ppr id CmmHighStackMark ->text "<highSp>"pprLit1::CmmLit ->SDoc pprLit1 lit @(CmmLabelOff {})=parens (pprLit lit )pprLit1lit =pprLit lit ppr_offset::Int->SDoc ppr_offset i |i ==0=empty |i >=0=char '+'<> int i |otherwise=char '-'<> int (-i )-- ---------------------------------------------------------------------------- Registers, whether local (temps) or global--pprReg::CmmReg ->SDoc pprReg r =caser ofCmmLocal local ->pprLocalReg local CmmGlobal global ->pprGlobalReg global ---- We only print the type of the local reg if it isn't wordRep--pprLocalReg::LocalReg ->SDoc pprLocalReg (LocalReg uniq rep )=sdocWithDynFlags $\dflags ->-- = ppr rep <> char '_' <> ppr uniq-- Temp Jan08char '_'<> pprUnique dflags uniq <> (ifisWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sighthendcolon <> ptr <> ppr rep elsedcolon <> ptr <> ppr rep )wherepprUnique dflags unique =ifgopt Opt_SuppressUniques dflags thentext "_locVar_"elseppr unique ptr =empty --if isGcPtrType rep-- then doubleQuotes (text "ptr")-- else empty-- Stack areaspprArea::Area ->SDoc pprArea Old =text "old"pprArea(Young id )=hcat [text "young<",ppr id ,text ">"]-- needs to be kept in syn with CmmExpr.hs.GlobalReg--pprGlobalReg::GlobalReg ->SDoc pprGlobalReg gr =casegr ofVanillaReg n _->char 'R'<> int n -- Temp Jan08-- VanillaReg n VNonGcPtr -> char 'R' <> int n-- VanillaReg n VGcPtr -> char 'P' <> int nFloatReg n ->char 'F'<> int n DoubleReg n ->char 'D'<> int n LongReg n ->char 'L'<> int n XmmReg n ->text "XMM"<> int n YmmReg n ->text "YMM"<> int n ZmmReg n ->text "ZMM"<> int n Sp ->text "Sp"SpLim ->text "SpLim"Hp ->text "Hp"HpLim ->text "HpLim"MachSp ->text "MachSp"UnwindReturnReg ->text "UnwindReturnReg"CCCS ->text "CCCS"CurrentTSO ->text "CurrentTSO"CurrentNursery ->text "CurrentNursery"HpAlloc ->text "HpAlloc"EagerBlackholeInfo ->text "stg_EAGER_BLACKHOLE_info"GCEnter1 ->text "stg_gc_enter_1"GCFun ->text "stg_gc_fun"BaseReg ->text "BaseReg"PicBaseReg ->text "PicBaseReg"-----------------------------------------------------------------------------commafy::[SDoc ]->SDoc commafy xs =fsep $punctuate comma xs