Save the type of breakpoints in the Breakpoint tick in STG

GHCi needs to know the types of all breakpoints, but it's
not possible to get the exprType of any expression in STG.

This is preparation for the upcoming change to make GHCi
bytecode from STG instead of Core.

1 files changed, 21 insertions, 9 deletions

diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index bfe9a6c89b..7b930b9c01 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -413,13 +413,14 @@ coreToStgExpr expr@(Lam _ _)
         text "Unexpected value lambda:" $$ ppr expr
 
 coreToStgExpr (Tick tick expr)
-  = do case tick of
-         HpcTick{}    -> return ()
-         ProfNote{}   -> return ()
-         SourceNote{} -> return ()
-         Breakpoint{} -> panic "coreToStgExpr: breakpoint should not happen"
+  = do stg_tick <- case tick of
+                     HpcTick m i        -> return (HpcTick m i)
+                     ProfNote cc cnt sc -> return (ProfNote cc cnt sc)
+                     SourceNote span nm -> return (SourceNote span nm)
+                     Breakpoint{} ->
+                       panic "coreToStgExpr: breakpoint should not happen"
        expr2 <- coreToStgExpr expr
-       return (StgTick tick expr2)
+       return (StgTick stg_tick expr2)
 
 coreToStgExpr (Cast expr _)
   = coreToStgExpr expr
@@ -568,7 +569,12 @@ coreToStgApp f args ticks = do
                 TickBoxOpId {}   -> pprPanic "coreToStg TickBox" $ ppr (f,args')
                 _other           -> StgApp f args'
 
-        tapp = foldr StgTick app (ticks ++ ticks')
+        convert_tick (Breakpoint _ bid fvs)  = res_ty `seq` Breakpoint res_ty bid fvs
+        convert_tick (HpcTick m i)           = HpcTick m i
+        convert_tick (SourceNote span nm)    = SourceNote span nm
+        convert_tick (ProfNote cc cnt scope) = ProfNote cc cnt scope
+        add_tick !t !e = StgTick t e
+        tapp = foldr add_tick app (map convert_tick ticks ++ ticks')
 
     -- Forcing these fixes a leak in the code generator, noticed while
     -- profiling for trac #4367
@@ -579,7 +585,7 @@ coreToStgApp f args ticks = do
 -- This is the guy that turns applications into A-normal form
 -- ---------------------------------------------------------------------------
 
-coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [Tickish Id])
+coreToStgArgs :: [CoreArg] -> CtsM ([StgArg], [StgTickish Id])
 coreToStgArgs []
   = return ([], [])
 
@@ -594,7 +600,13 @@ coreToStgArgs (Coercion _ : args) -- Coercion argument; See Note [Coercion token
 coreToStgArgs (Tick t e : args)
   = ASSERT( not (tickishIsCode t) )
     do { (args', ts) <- coreToStgArgs (e : args)
-       ; return (args', t:ts) }
+       ; let convert_tick (Breakpoint _ bid fvs) =
+               let !ty = exprType e in Breakpoint ty bid fvs
+             convert_tick (HpcTick m i)           = HpcTick m i
+             convert_tick (SourceNote span nm)    = SourceNote span nm
+             convert_tick (ProfNote cc cnt scope) = ProfNote cc cnt scope
+             !t' = convert_tick t
+       ; return (args', t':ts) }
 
 coreToStgArgs (arg : args) = do         -- Non-type argument
     (stg_args, ticks) <- coreToStgArgs args