diff options
Diffstat (limited to 'compiler/deSugar/Coverage.hs')
| -rw-r--r-- | compiler/deSugar/Coverage.hs | 23 |
1 files changed, 23 insertions, 0 deletions
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs index b0543ed88e..6dc7383d8b 100644 --- a/compiler/deSugar/Coverage.hs +++ b/compiler/deSugar/Coverage.hs @@ -294,6 +294,29 @@ addTickLHsBind (L pos bind@(AbsBinds { abs_binds = binds, | ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports , isAnyInlinePragma (idInlinePragma pid) ] } +addTickLHsBind (L pos bind@(AbsBindsSig { abs_sig_bind = val_bind + , abs_sig_export = poly_id })) + | L _ FunBind { fun_id = L _ mono_id } <- val_bind + = do withEnv (add_export mono_id) $ do + withEnv (add_inlines mono_id) $ do + val_bind' <- addTickLHsBind val_bind + return $ L pos $ bind { abs_sig_bind = val_bind' } + + | otherwise + = pprPanic "addTickLHsBind" (ppr bind) + where + -- see AbsBinds comments + add_export mono_id env + | idName poly_id `elemNameSet` exports env + = env { exports = exports env `extendNameSet` idName mono_id } + | otherwise + = env + + add_inlines mono_id env + | isAnyInlinePragma (idInlinePragma poly_id) + = env { inlines = inlines env `extendVarSet` mono_id } + | otherwise + = env addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id) }))) = do let name = getOccString id |