diff options
| -rw-r--r-- | compiler/deSugar/Coverage.hs | 227 | ||||
| -rw-r--r-- | compiler/deSugar/Desugar.hs | 9 | ||||
| -rw-r--r-- | compiler/deSugar/DsUtils.hs | 9 | ||||
| -rw-r--r-- | compiler/hsSyn/Convert.hs | 2 | ||||
| -rw-r--r-- | compiler/hsSyn/HsBinds.hs | 13 | ||||
| -rw-r--r-- | compiler/hsSyn/HsUtils.hs | 4 | ||||
| -rw-r--r-- | compiler/parser/Parser.y | 2 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 9 | ||||
| -rw-r--r-- | compiler/typecheck/TcBinds.hs | 11 | ||||
| -rw-r--r-- | compiler/typecheck/TcPatSyn.hs | 4 |
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 |