Generalized Coverage pass to allow adding multiple types of Tickishs

This allows having, say, HPC ticks, automatic cost centres and source
notes active at the same time. We especially take care to un-tangle the
infrastructure involved in generating them.

(From Phabricator D169)

10 files changed, 158 insertions, 132 deletions

diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index b9faf26e93..d81599d30e 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -26,7 +26,7 @@ import Data.List
 import FastString
 import HscTypes
 import TyCon
-import Unique
+import UniqSupply
 import BasicTypes
 import MonadUtils
 import Maybes
@@ -63,21 +63,19 @@ addTicksToBinds
         -> LHsBinds Id
         -> IO (LHsBinds Id, HpcInfo, ModBreaks)
 
-addTicksToBinds dflags mod mod_loc exports tyCons binds =
-
- case ml_hs_file mod_loc of
-   Nothing        -> return (binds, emptyHpcInfo False, emptyModBreaks)
-   Just orig_file -> do
+addTicksToBinds dflags mod mod_loc exports tyCons binds
+  | let passes = coveragePasses dflags, not (null passes),
+    Just orig_file <- ml_hs_file mod_loc = do
 
      if "boot" `isSuffixOf` orig_file
          then return (binds, emptyHpcInfo False, emptyModBreaks)
          else do
 
+     us <- mkSplitUniqSupply 'C' -- for cost centres
      let  orig_file2 = guessSourceFile binds orig_file
 
-          (binds1,_,st)
-                 = unTM (addTickLHsBinds binds)
-                   (TTE
+          tickPass tickish (binds,st) =
+            let env = TTE
                       { fileName     = mkFastString orig_file2
                       , declPath     = []
                       , tte_dflags   = dflags
@@ -87,33 +85,34 @@ addTicksToBinds dflags mod mod_loc exports tyCons binds =
                       , blackList    = Map.fromList
                                           [ (getSrcSpan (tyConName tyCon),())
                                           | tyCon <- tyCons ]
-                      , density      = mkDensity dflags
+                      , density      = mkDensity tickish dflags
                       , this_mod     = mod
-                      , tickishType  = case hscTarget dflags of
-                          HscInterpreted            -> Breakpoints
-                          _ | gopt Opt_Hpc dflags   -> HpcTicks
-                            | gopt Opt_SccProfilingOn dflags
-                                                    -> ProfNotes
-                            | gopt Opt_Debug dflags -> SourceNotes
-                            | otherwise             -> error "addTicksToBinds: No way to annotate!"
-                       })
-                   (TT
-                      { tickBoxCount = 0
-                      , mixEntries   = []
-                      })
-
-     let entries = reverse $ mixEntries st
-
-     let count = tickBoxCount st
-     hashNo <- writeMixEntries dflags mod count entries orig_file2
-     modBreaks <- mkModBreaks dflags count entries
+                      , tickishType  = tickish
+                      }
+                (binds',_,st') = unTM (addTickLHsBinds binds) env st
+            in (binds', st')
+
+          initState = TT { tickBoxCount = 0
+                         , mixEntries   = []
+                         , breakCount   = 0
+                         , breaks       = []
+                         , uniqSupply   = us
+                         }
+
+          (binds1,st) = foldr tickPass (binds, initState) passes
+
+     let tickCount = tickBoxCount st
+     hashNo <- writeMixEntries dflags mod tickCount (reverse $ mixEntries st)
+                               orig_file2
+     modBreaks <- mkModBreaks dflags (breakCount st) (reverse $ breaks st)
 
      when (dopt Opt_D_dump_ticked dflags) $
          log_action dflags dflags SevDump noSrcSpan defaultDumpStyle
              (pprLHsBinds binds1)
 
-     return (binds1, HpcInfo count hashNo, modBreaks)
+     return (binds1, HpcInfo tickCount hashNo, modBreaks)
 
+  | otherwise = return (binds, emptyHpcInfo False, emptyModBreaks)
 
 guessSourceFile :: LHsBinds Id -> FilePath -> FilePath
 guessSourceFile binds orig_file =
@@ -183,21 +182,18 @@ data TickDensity
   | TickCallSites         -- for stack tracing
   deriving Eq
 
-mkDensity :: DynFlags -> TickDensity
-mkDensity dflags
-  | gopt Opt_Hpc dflags
-    || gopt Opt_Debug dflags             = TickForCoverage
-  | HscInterpreted  <- hscTarget dflags  = TickForBreakPoints
-  | ProfAutoAll     <- profAuto dflags   = TickAllFunctions
-  | ProfAutoTop     <- profAuto dflags   = TickTopFunctions
-  | ProfAutoExports <- profAuto dflags   = TickExportedFunctions
-  | ProfAutoCalls   <- profAuto dflags   = TickCallSites
-  | otherwise                            = panic "density"
-  -- ToDo: -fhpc is taking priority over -fprof-auto here.  It seems
-  -- that coverage works perfectly well with profiling, but you don't
-  -- get any auto-generated SCCs.  It would make perfect sense to
-  -- allow both of them, and indeed to combine some of the other flags
-  -- (-fprof-auto-calls -fprof-auto-top, for example)
+mkDensity :: TickishType -> DynFlags -> TickDensity
+mkDensity tickish dflags = case tickish of
+  HpcTicks             -> TickForCoverage
+  SourceNotes          -> TickForCoverage
+  Breakpoints          -> TickForBreakPoints
+  ProfNotes ->
+    case profAuto dflags of
+      ProfAutoAll      -> TickAllFunctions
+      ProfAutoTop      -> TickTopFunctions
+      ProfAutoExports  -> TickExportedFunctions
+      ProfAutoCalls    -> TickCallSites
+      _other           -> panic "mkDensity"
 
 -- | Decide whether to add a tick to a binding or not.
 shouldTickBind  :: TickDensity
@@ -261,8 +257,6 @@ addTickLHsBind (L pos bind@(AbsBinds { abs_binds   = binds,
 
 
 addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id)  }))) = do
-  env <- getEnv
-  let dflags = tte_dflags env
   let name = getOccString id
   decl_path <- getPathEntry
   density <- getDensity
@@ -272,7 +266,8 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id)  }))) = do
                  || id `elemVarSet` inline_ids
 
   -- See Note [inline sccs]
-  if inline && gopt Opt_SccProfilingOn dflags then return (L pos funBind) else do
+  tickish <- tickishType `liftM` getEnv
+  if inline && tickish == ProfNotes then return (L pos funBind) else do
 
   (fvs, mg@(MG { mg_alts = matches' })) <-
         getFreeVars $
@@ -296,8 +291,9 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id)  }))) = do
              else
                 return Nothing
 
+  let mbCons = maybe Prelude.id (:)
   return $ L pos $ funBind { fun_matches = mg { mg_alts = matches' }
-                           , fun_tick = tick }
+                           , fun_tick = tick `mbCons` fun_tick funBind }
 
    where
    -- a binding is a simple pattern binding if it is a funbind with zero patterns
@@ -308,23 +304,25 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id)  }))) = do
 addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs, pat_rhs = rhs }))) = do
   let name = "(...)"
   (fvs, rhs') <- getFreeVars $ addPathEntry name $ addTickGRHSs False False rhs
+  let pat' = pat { pat_rhs = rhs'}
 
+  -- Should create ticks here?
   density <- getDensity
   decl_path <- getPathEntry
   let top_lev = null decl_path
-  let add_ticks = shouldTickPatBind density top_lev
-
-  tickish <- if add_ticks
-                then bindTick density name pos fvs
-                else return Nothing
+  if not (shouldTickPatBind density top_lev) then return (L pos pat') else do
 
-  let patvars = map getOccString (collectPatBinders lhs)
-  patvar_ticks <- if add_ticks
-                     then mapM (\v -> bindTick density v pos fvs) patvars
-                     else return []
+    -- Allocate the ticks
+    rhs_tick <- bindTick density name pos fvs
+    let patvars = map getOccString (collectPatBinders lhs)
+    patvar_ticks <- mapM (\v -> bindTick density v pos fvs) patvars
 
-  return $ L pos $ pat { pat_rhs = rhs',
-                         pat_ticks = (tickish, patvar_ticks)}
+    -- Add to pattern
+    let mbCons = maybe id (:)
+        rhs_ticks = rhs_tick `mbCons` fst (pat_ticks pat')
+        patvar_tickss = zipWith mbCons patvar_ticks
+                        (snd (pat_ticks pat') ++ repeat [])
+    return $ L pos $ pat' { pat_ticks = (rhs_ticks, patvar_tickss) }
 
 -- Only internal stuff, not from source, uses VarBind, so we ignore it.
 addTickLHsBind var_bind@(L _ (VarBind {})) = return var_bind
@@ -562,6 +560,13 @@ addTickHsExpr (ArithSeq  ty wit arith_seq) =
              where addTickWit Nothing = return Nothing
                    addTickWit (Just fl) = do fl' <- addTickHsExpr fl
                                              return (Just fl')
+
+-- We might encounter existing ticks (multiple Coverage passes)
+addTickHsExpr (HsTick t e) =
+        liftM (HsTick t) (addTickLHsExprNever e)
+addTickHsExpr (HsBinTick t0 t1 e) =
+        liftM (HsBinTick t0 t1) (addTickLHsExprNever e)
+
 addTickHsExpr (HsTickPragma _ (L pos e0)) = do
     e2 <- allocTickBox (ExpBox False) False False pos $
                 addTickHsExpr e0
@@ -925,6 +930,9 @@ liftL f (L loc a) = do
 
 data TickTransState = TT { tickBoxCount:: Int
                          , mixEntries  :: [MixEntry_]
+                         , breakCount  :: Int
+                         , breaks      :: [MixEntry_]
+                         , uniqSupply  :: UniqSupply
                          }
 
 data TickTransEnv = TTE { fileName     :: FastString
@@ -942,7 +950,17 @@ data TickTransEnv = TTE { fileName     :: FastString
 --      deriving Show
 
 data TickishType = ProfNotes | HpcTicks | Breakpoints | SourceNotes
-
+                 deriving (Eq)
+
+coveragePasses :: DynFlags -> [TickishType]
+coveragePasses dflags =
+    ifa (hscTarget dflags == HscInterpreted) Breakpoints $
+    ifa (gopt Opt_Hpc dflags)                HpcTicks $
+    ifa (gopt Opt_SccProfilingOn dflags &&
+         profAuto dflags /= NoProfAuto)      ProfNotes $
+    ifa (gopt Opt_Debug dflags)              SourceNotes []
+  where ifa f x xs | f         = x:xs
+                   | otherwise = xs
 
 -- | Tickishs that only make sense when their source code location
 -- refers to the current file. This might not always be true due to
@@ -987,11 +1005,19 @@ instance Monad TM where
                                        (r2,fv2,st2) ->
                                           (r2, fv1 `plusOccEnv` fv2, st2)
 
--- getState :: TM TickTransState
--- getState = TM $ \ env st -> (st, noFVs, st)
+instance HasDynFlags TM where
+  getDynFlags = TM $ \ env st -> (tte_dflags env, noFVs, st)
+
+instance MonadUnique TM where
+  getUniqueSupplyM = TM $ \_ st -> (uniqSupply st, noFVs, st)
+  getUniqueM = TM $ \_ st -> let (u, us') = takeUniqFromSupply (uniqSupply st)
+                             in (u, noFVs, st { uniqSupply = us' })
+
+getState :: TM TickTransState
+getState = TM $ \ _ st -> (st, noFVs, st)
 
--- setState :: (TickTransState -> TickTransState) -> TM ()
--- setState f = TM $ \ env st -> ((), noFVs, f st)
+setState :: (TickTransState -> TickTransState) -> TM ()
+setState f = TM $ \ _ st -> ((), noFVs, f st)
 
 getEnv :: TM TickTransEnv
 getEnv = TM $ \ env st -> (env, noFVs, st)
@@ -1089,40 +1115,45 @@ allocATickBox boxLabel countEntries topOnly  pos fvs =
 
 mkTickish :: BoxLabel -> Bool -> Bool -> SrcSpan -> OccEnv Id -> [String]
           -> TM (Tickish Id)
-mkTickish boxLabel countEntries topOnly pos fvs decl_path =
-  TM $ \ env st ->
-    let c = tickBoxCount st
-        ids = filter (not . isUnLiftedType . idType) $ occEnvElts fvs
-            -- unlifted types cause two problems here:
-            --   * we can't bind them  at the GHCi prompt
-            --     (bindLocalsAtBreakpoint already fliters them out),
-            --   * the simplifier might try to substitute a literal for
-            --     the Id, and we can't handle that.
-
-        mes = mixEntries st
-        me = (pos, decl_path, map (nameOccName.idName) ids, boxLabel)
-
-        cc_name | topOnly   = head decl_path
-                | otherwise = concat (intersperse "." decl_path)
-
-        cc = mkUserCC (mkFastString cc_name) (this_mod env) pos (mkCostCentreUnique c)
-
-        dflags = tte_dflags env
-
-        count = countEntries && gopt Opt_ProfCountEntries dflags
-
-        tickish = case tickishType env of
-          HpcTicks    -> HpcTick (this_mod env) c
-          ProfNotes   -> ProfNote cc count True{-scopes-}
-          Breakpoints -> Breakpoint c ids
-          SourceNotes | RealSrcSpan pos' <- pos
-                      -> SourceNote pos' cc_name
-          _otherwise  -> panic "mkTickish: bad source span!"
-    in
-    ( tickish
-    , fvs
-    , st {tickBoxCount=c+1,mixEntries=me:mes}
-    )
+mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
+
+  let ids = filter (not . isUnLiftedType . idType) $ occEnvElts fvs
+          -- unlifted types cause two problems here:
+          --   * we can't bind them  at the GHCi prompt
+          --     (bindLocalsAtBreakpoint already fliters them out),
+          --   * the simplifier might try to substitute a literal for
+          --     the Id, and we can't handle that.
+
+      me = (pos, decl_path, map (nameOccName.idName) ids, boxLabel)
+
+      cc_name | topOnly   = head decl_path
+              | otherwise = concat (intersperse "." decl_path)
+
+  dflags <- getDynFlags
+  env <- getEnv
+  case tickishType env of
+    HpcTicks -> do
+      c <- liftM tickBoxCount getState
+      setState $ \st -> st { tickBoxCount = c + 1
+                           , mixEntries = me : mixEntries st }
+      return $ HpcTick (this_mod env) c
+
+    ProfNotes -> do
+      ccUnique <- getUniqueM
+      let cc = mkUserCC (mkFastString cc_name) (this_mod env) pos ccUnique
+          count = countEntries && gopt Opt_ProfCountEntries dflags
+      return $ ProfNote cc count True{-scopes-}
+
+    Breakpoints -> do
+      c <- liftM breakCount getState
+      setState $ \st -> st { breakCount = c + 1
+                           , breaks = me:breaks st }
+      return $ Breakpoint c ids
+
+    SourceNotes | RealSrcSpan pos' <- pos ->
+      return $ SourceNote pos' cc_name
+
+    _otherwise -> panic "mkTickish: bad source span!"
 
 
 allocBinTickBox :: (Bool -> BoxLabel) -> SrcSpan -> TM (HsExpr Id)
diff --git a/compiler/deSugar/Desugar.hs b/compiler/deSugar/Desugar.hs
index 6d754c6d0b..ac354643b0 100644
--- a/compiler/deSugar/Desugar.hs
+++ b/compiler/deSugar/Desugar.hs
@@ -103,16 +103,9 @@ deSugar hsc_env
         ; let export_set = availsToNameSet exports
               target     = hscTarget dflags
               hpcInfo    = emptyHpcInfo other_hpc_info
-              want_ticks = gopt Opt_Hpc dflags
-                        || gopt Opt_Debug dflags
-                        || target == HscInterpreted
-                        || (gopt Opt_SccProfilingOn dflags
-                            && case profAuto dflags of
-                                 NoProfAuto -> False
-                                 _          -> True)
 
         ; (binds_cvr, ds_hpc_info, modBreaks)
-                         <- if want_ticks && not (isHsBootOrSig hsc_src)
+                         <- if not (isHsBootOrSig hsc_src)
                               then addTicksToBinds dflags mod mod_loc export_set
                                           (typeEnvTyCons type_env) binds
                               else return (binds, hpcInfo, emptyModBreaks)
diff --git a/compiler/deSugar/DsUtils.hs b/compiler/deSugar/DsUtils.hs
index 1a7985fec3..f94b831a6f 100644
--- a/compiler/deSugar/DsUtils.hs
+++ b/compiler/deSugar/DsUtils.hs
@@ -599,7 +599,7 @@ cases like
      (p,q) = e
 -}
 
-mkSelectorBinds :: [Maybe (Tickish Id)]  -- ticks to add, possibly
+mkSelectorBinds :: [[Tickish Id]] -- ticks to add, possibly
                 -> LPat Id      -- The pattern
                 -> CoreExpr     -- Expression to which the pattern is bound
                 -> DsM [(Id,CoreExpr)]
@@ -650,7 +650,7 @@ mkSelectorBinds ticks pat val_expr
        ; return ( (tuple_var, tuple_expr) : zipWith mk_tup_bind ticks' binders ) }
   where
     binders       = collectPatBinders pat
-    ticks'        = ticks ++ repeat Nothing
+    ticks'        = ticks ++ repeat []
 
     local_binders = map localiseId binders      -- See Note [Localise pattern binders]
     local_tuple   = mkBigCoreVarTup binders
@@ -807,9 +807,8 @@ CPR-friendly.  This matters a lot: if you don't get it right, you lose
 the tail call property.  For example, see Trac #3403.
 -}
 
-mkOptTickBox :: Maybe (Tickish Id) -> CoreExpr -> CoreExpr
-mkOptTickBox Nothing e        = e
-mkOptTickBox (Just tickish) e = Tick tickish e
+mkOptTickBox :: [Tickish Id] -> CoreExpr -> CoreExpr
+mkOptTickBox = flip (foldr Tick)
 
 mkBinaryTickBox :: Int -> Int -> CoreExpr -> DsM CoreExpr
 mkBinaryTickBox ixT ixF e = do
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index e6120976b2..3c2b5e7fdb 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -153,7 +153,7 @@ cvtDec (TH.ValD pat body ds)
         ; returnJustL $ Hs.ValD $
           PatBind { pat_lhs = pat', pat_rhs = GRHSs body' ds'
                   , pat_rhs_ty = placeHolderType, bind_fvs = placeHolderNames
-                  , pat_ticks = (Nothing,[]) } }
+                  , pat_ticks = ([],[]) } }
 
 cvtDec (TH.FunD nm cls)
   | null cls
diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs
index 555139ac12..ef14fab248 100644
--- a/compiler/hsSyn/HsBinds.hs
+++ b/compiler/hsSyn/HsBinds.hs
@@ -154,7 +154,7 @@ data HsBindLR idL idR
                                 -- See Note [Bind free vars]
 
 
-        fun_tick :: Maybe (Tickish Id)  -- ^ Tick to put on the rhs, if any
+        fun_tick :: [Tickish Id]  -- ^ Ticks to put on the rhs, if any
     }
 
   -- | The pattern is never a simple variable;
@@ -168,8 +168,8 @@ data HsBindLR idL idR
         pat_rhs    :: GRHSs idR (LHsExpr idR),
         pat_rhs_ty :: PostTc idR Type,      -- ^ Type of the GRHSs
         bind_fvs   :: PostRn idL NameSet, -- ^ See Note [Bind free vars]
-        pat_ticks  :: (Maybe (Tickish Id), [Maybe (Tickish Id)])
-               -- ^ Tick to put on the rhs, if any, and ticks to put on
+        pat_ticks  :: ([Tickish Id], [[Tickish Id]])
+               -- ^ Ticks to put on the rhs, if any, and ticks to put on
                -- the bound variables.
     }
 
@@ -465,10 +465,9 @@ ppr_monobind (VarBind { var_id = var, var_rhs = rhs })
 ppr_monobind (FunBind { fun_id = fun, fun_infix = inf,
                         fun_co_fn = wrap,
                         fun_matches = matches,
-                        fun_tick = tick })
-  = pprTicks empty (case tick of
-                        Nothing -> empty
-                        Just t  -> text "-- tick id = " <> ppr t)
+                        fun_tick = ticks })
+  = pprTicks empty (if null ticks then empty
+                    else text "-- ticks = " <> ppr ticks)
     $$  ifPprDebug (pprBndr LetBind (unLoc fun))
     $$  pprFunBind (unLoc fun) inf matches
     $$  ifPprDebug (ppr wrap)
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 57109fbb33..6694138d57 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -525,7 +525,7 @@ mkFunBind fn ms = FunBind { fun_id = fn, fun_infix = False
                           , fun_matches = mkMatchGroup Generated ms
                           , fun_co_fn = idHsWrapper
                           , bind_fvs = placeHolderNames
-                          , fun_tick = Nothing }
+                          , fun_tick = [] }
 
 mkTopFunBind :: Origin -> Located Name -> [LMatch Name (LHsExpr Name)]
              -> HsBind Name
@@ -535,7 +535,7 @@ mkTopFunBind origin fn ms = FunBind { fun_id = fn, fun_infix = False
                                     , fun_co_fn = idHsWrapper
                                     , bind_fvs = emptyNameSet -- NB: closed
                                                               --     binding
-                                    , fun_tick = Nothing }
+                                    , fun_tick = [] }
 
 mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr RdrName -> LHsBind RdrName
 mkHsVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 235d34aaf1..023ea46da3 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1768,7 +1768,7 @@ decl_no_th :: { Located (OrdList (LHsDecl RdrName)) }
                                             PatBind pat (snd $ unLoc $3)
                                                     placeHolderType
                                                     placeHolderNames
-                                                    (Nothing,[]) } }
+                                                    ([],[]) } }
                                 -- Turn it all into an expression so that
                                 -- checkPattern can check that bangs are enabled
 
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 601d6fed46..7628227d99 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -927,8 +927,11 @@ makeFunBind :: Located RdrName -> Bool -> [LMatch RdrName (LHsExpr RdrName)]
             -> HsBind RdrName
 -- Like HsUtils.mkFunBind, but we need to be able to set the fixity too
 makeFunBind fn is_infix ms
-  = FunBind { fun_id = fn, fun_infix = is_infix, fun_matches = mkMatchGroup FromSource ms,
-              fun_co_fn = idHsWrapper, bind_fvs = placeHolderNames, fun_tick = Nothing }
+  = FunBind { fun_id = fn, fun_infix = is_infix,
+              fun_matches = mkMatchGroup FromSource ms,
+              fun_co_fn = idHsWrapper,
+              bind_fvs = placeHolderNames,
+              fun_tick = [] }
 
 checkPatBind :: SDoc
              -> LHsExpr RdrName
@@ -937,7 +940,7 @@ checkPatBind :: SDoc
 checkPatBind msg lhs (L _ (_,grhss))
   = do  { lhs <- checkPattern msg lhs
         ; return (PatBind lhs grhss placeHolderType placeHolderNames
-                    (Nothing,[])) }
+                    ([],[])) }
 
 checkValSig
         :: LHsExpr RdrName
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index a0bc89e535..842ccfa115 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -1146,9 +1146,10 @@ tcMonoBinds is_rec sig_fn no_gen
                                  -- type of the thing whose rhs we are type checking
                                tcMatchesFun name inf matches rhs_ty
 
-        ; return (unitBag $ L b_loc (FunBind { fun_id = L nm_loc mono_id, fun_infix = inf,
-                                               fun_matches = matches', bind_fvs = fvs,
-                                               fun_co_fn = co_fn, fun_tick = Nothing }),
+        ; return (unitBag $ L b_loc $
+                     FunBind { fun_id = L nm_loc mono_id, fun_infix = inf,
+                               fun_matches = matches', bind_fvs = fvs,
+                               fun_co_fn = co_fn, fun_tick = [] },
                   [(name, Nothing, mono_id)]) }
 
 tcMonoBinds _ sig_fn no_gen binds
@@ -1244,7 +1245,7 @@ tcRhs (TcFunBind (_, mb_sig, mono_id) loc inf matches)
                           , fun_matches = matches'
                           , fun_co_fn = co_fn
                           , bind_fvs = placeHolderNamesTc
-                          , fun_tick = Nothing }) }
+                          , fun_tick = [] }) }
     where
       tvsAndNwcs = maybe [] (\sig -> [(n, tv) | (Just n, tv) <- sig_tvs sig]
                                      ++ sig_nwcs sig) mb_sig
@@ -1257,7 +1258,7 @@ tcRhs (TcPatBind infos pat' grhss pat_ty)
                     tcGRHSsPat grhss pat_ty
         ; return (PatBind { pat_lhs = pat', pat_rhs = grhss', pat_rhs_ty = pat_ty
                           , bind_fvs = placeHolderNamesTc
-                          , pat_ticks = (Nothing,[]) }) }
+                          , pat_ticks = ([],[]) }) }
 
 
 ---------------------
diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index 65339818fe..4c49fb6dcb 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -297,7 +297,7 @@ tcPatSynMatcher (L loc name) lpat
                            , fun_matches = mg
                            , fun_co_fn = idHsWrapper
                            , bind_fvs = emptyNameSet
-                           , fun_tick = Nothing }
+                           , fun_tick = [] }
              matcher_bind = unitBag (noLoc bind)
 
        ; traceTc "tcPatSynMatcher" (ppr name $$ ppr (idType matcher_id))
@@ -364,7 +364,7 @@ tcPatSynBuilderBind PSB{ psb_id = L loc name, psb_def = lpat
                             , fun_matches = mg'
                             , fun_co_fn = idHsWrapper
                             , bind_fvs = placeHolderNamesTc
-                            , fun_tick = Nothing }
+                            , fun_tick = [] }
 
              sig = TcSigInfo{ sig_id = worker_id
                             , sig_tvs = map (\tv -> (Nothing, tv)) worker_tvs