-------------------------------------------------------------------------------- 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 )whereimportGhcPreludeimportCmmExpr importOutputableimportDynFlagsimportData.MaybeimportNumeric(fromRat)-----------------------------------------------------------------------------instanceOutputableCmmExpr whereppr e =pprExpr e instanceOutputableCmmReg whereppr e =pprReg e instanceOutputableCmmLit whereppr l =pprLit l instanceOutputableLocalReg whereppr e =pprLocalReg e instanceOutputableArea whereppr e =pprArea e instanceOutputableGlobalReg whereppr e =pprGlobalReg e -- ---------------------------------------------------------------------------- Expressions--pprExpr::CmmExpr ->SDocpprExpr 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 ->SDocpprExpr1 (CmmMachOp op [x ,y ])|Justdoc <-infixMachOp1 op =pprExpr7 x <+>doc <+>pprExpr7 y pprExpr1e =pprExpr7 e infixMachOp1,infixMachOp7,infixMachOp8::MachOp ->MaybeSDocinfixMachOp1 (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 ->SDocpprExpr9 e =casee ofCmmLit lit ->pprLit1 lit CmmLoad expr rep ->pprrep <>brackets(pprexpr )CmmReg reg ->pprreg CmmRegOff reg off ->parens(pprreg <+>char'+'<+>intoff )CmmStackSlot a off ->parens(ppra <+>char'+'<+>intoff )CmmMachOp mop args ->genMachOp mop args genMachOp::MachOp ->[CmmExpr ]->SDocgenMachOp 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$punctuatecomma(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 ->MaybeSDocinfixMachOp 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 ->SDocpprLit lit =sdocWithDynFlags$\dflags ->caselit ofCmmInt i rep ->hcat[(ifi <0thenparenselseid)(integeri ),ppUnless(rep ==wordWidthdflags )$space<>dcolon<+>pprrep ]CmmFloat f rep ->hsep[double(fromRatf ),dcolon,pprrep ]CmmVec lits ->char'<'<>commafy (mappprLit lits )<>char'>'CmmLabel clbl ->pprclbl CmmLabelOff clbl i ->pprclbl <>ppr_offset i CmmLabelDiffOff clbl1 clbl2 i _->pprclbl1 <>char'-'<>pprclbl2 <>ppr_offset i CmmBlock id ->pprid CmmHighStackMark ->text"<highSp>"pprLit1::CmmLit ->SDocpprLit1 lit @(CmmLabelOff {})=parens(pprLit lit )pprLit1lit =pprLit lit ppr_offset::Int->SDocppr_offset i |i ==0=empty|i >=0=char'+'<>inti |otherwise=char'-'<>int(-i )-- ---------------------------------------------------------------------------- Registers, whether local (temps) or global--pprReg::CmmReg ->SDocpprReg 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 ->SDocpprLocalReg (LocalReg uniq rep )=sdocWithDynFlags$\dflags ->-- = ppr rep <> char '_' <> ppr uniq-- Temp Jan08char'_'<>pprUnique dflags uniq <>(ifisWord32rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sighthendcolon<>ptr <>pprrep elsedcolon<>ptr <>pprrep )wherepprUnique dflags unique =ifgoptOpt_SuppressUniquesdflags thentext"_locVar_"elsepprunique ptr =empty--if isGcPtrType rep-- then doubleQuotes (text "ptr")-- else empty-- Stack areaspprArea::Area ->SDocpprArea Old =text"old"pprArea(Young id )=hcat[text"young<",pprid ,text">"]-- needs to be kept in syn with CmmExpr.hs.GlobalReg--pprGlobalReg::GlobalReg ->SDocpprGlobalReg gr =casegr ofVanillaReg n _->char'R'<>intn -- Temp Jan08-- VanillaReg n VNonGcPtr -> char 'R' <> int n-- VanillaReg n VGcPtr -> char 'P' <> int nFloatReg n ->char'F'<>intn DoubleReg n ->char'D'<>intn LongReg n ->char'L'<>intn XmmReg n ->text"XMM"<>intn YmmReg n ->text"YMM"<>intn ZmmReg n ->text"ZMM"<>intn 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]->SDoccommafy xs =fsep$punctuatecommaxs