X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FstgSyn%2FStgSyn.lhs;h=527848f41bfd19eeb7728bf282cc3699f0c74f4c;hb=0b34654125ca8551a1ce82919236d67a862b59bd;hp=74832a24aa35728f91288d944e6a9e1ed99e9775;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git

diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index 74832a2..527848f 100644
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -67,6 +67,7 @@ import UniqSet		( isEmptyUniqSet, uniqSetToList, UniqSet )
 import Unique		( Unique )
 import Bitmap
 import StaticFlags	( opt_SccProfilingOn )
+import Module		( Module, pprModule )
 \end{code}
 
 %************************************************************************
@@ -167,13 +168,16 @@ constructors, primitives, and literals.
 \begin{code}
   | StgLit	Literal
   
+	-- StgConApp is vital for returning unboxed tuples
+	-- which can't be let-bound first
   | StgConApp	DataCon
 		[GenStgArg occ]	-- Saturated
 
   | StgOpApp	StgOp		-- Primitive op or foreign call
 		[GenStgArg occ]	-- Saturated
-		Type		-- Result type; we need to know the result type
-				-- so that we can assign result registers.
+		Type		-- Result type
+				-- We need to know this so that we can 
+				-- assign result registers
 \end{code}
 
 %************************************************************************
@@ -349,6 +353,21 @@ Finally for @scc@ expressions we introduce a new STG construct.
   | StgSCC
 	CostCentre		-- label of SCC expression
 	(GenStgExpr bndr occ)	-- scc expression
+\end{code}
+
+%************************************************************************
+%*									*
+\subsubsection{@GenStgExpr@: @hpc@ expressions}
+%*									*
+%************************************************************************
+
+Finally for @scc@ expressions we introduce a new STG construct.
+
+\begin{code}
+  | StgTick
+    Module			-- the module of the source of this tick
+    Int				-- tick number
+    (GenStgExpr bndr occ)	-- sub expression
   -- end of GenStgExpr
 \end{code}
 
@@ -719,6 +738,10 @@ pprStgExpr (StgSCC cc expr)
   = sep [ hsep [ptext SLIT("_scc_"), ppr cc],
 	  pprStgExpr expr ]
 
+pprStgExpr (StgTick m n expr)
+  = sep [ hsep [ptext SLIT("_tick_"),  pprModule m,text (show n)],
+	  pprStgExpr expr ]
+
 pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
   = sep [sep [ptext SLIT("case"),
 	   nest 4 (hsep [pprStgExpr expr,