X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsExpr.lhs;h=9bcd06e47f74d57bf0abeeea36324bfea08e439c;hp=2360337759a44c1b9a7cd2bedf0f9a01f17e2d4e;hb=d5934bbb856aa0aa620c9b2e0fa51c90a1a5a048;hpb=33b8b60e0aa925962cd11a8be98d9818666d58a0 diff --git a/compiler/hsSyn/HsExpr.lhs b/compiler/hsSyn/HsExpr.lhs index 2360337..9bcd06e 100644 --- a/compiler/hsSyn/HsExpr.lhs +++ b/compiler/hsSyn/HsExpr.lhs @@ -202,6 +202,18 @@ data HsExpr id -- always has an empty stack --------------------------------------- + -- Hpc Support + + | HsTick + Int -- module-local tick number + (LHsExpr id) -- sub-expression + + | HsBinTick + Int -- module-local tick number for True + Int -- module-local tick number for False + (LHsExpr id) -- sub-expression + + --------------------------------------- -- The following are commands, not expressions proper | HsArrApp -- Arrow tail, or arrow application (f -< arg) @@ -391,6 +403,16 @@ ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("pending") <+> ppr ps ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _))) = hsep [ptext SLIT("proc"), ppr pat, ptext SLIT("->"), ppr cmd] +ppr_expr (HsTick tickId exp) + = hcat [ptext SLIT("tick<"), ppr tickId,ptext SLIT(">("), ppr exp,ptext SLIT(")")] +ppr_expr (HsBinTick tickIdTrue tickIdFalse exp) + = hcat [ptext SLIT("bintick<"), + ppr tickIdTrue, + ptext SLIT(","), + ppr tickIdFalse, + ptext SLIT(">("), + ppr exp,ptext SLIT(")")] + ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True) = hsep [ppr_lexpr arrow, ptext SLIT("-<"), ppr_lexpr arg] ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)