projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Tidy up rebindable syntax for MDo
[ghc-hetmet.git]
/
compiler
/
deSugar
/
Coverage.lhs
diff --git
a/compiler/deSugar/Coverage.lhs
b/compiler/deSugar/Coverage.lhs
index
2d8afbd
..
b0e92bb
100644
(file)
--- a/
compiler/deSugar/Coverage.lhs
+++ b/
compiler/deSugar/Coverage.lhs
@@
-465,10
+465,8
@@
addTickStmt isGuard stmt@(RecStmt {})
; ret' <- addTickSyntaxExpr hpcSrcSpan (recS_ret_fn stmt)
; mfix' <- addTickSyntaxExpr hpcSrcSpan (recS_mfix_fn stmt)
; bind' <- addTickSyntaxExpr hpcSrcSpan (recS_bind_fn stmt)
; ret' <- addTickSyntaxExpr hpcSrcSpan (recS_ret_fn stmt)
; mfix' <- addTickSyntaxExpr hpcSrcSpan (recS_mfix_fn stmt)
; bind' <- addTickSyntaxExpr hpcSrcSpan (recS_bind_fn stmt)
- ; dicts' <- addTickEvBinds (recS_dicts stmt)
; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
- , recS_mfix_fn = mfix', recS_bind_fn = bind'
- , recS_dicts = dicts' }) }
+ , recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id)
addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id)
addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
@@
-539,9
+537,6
@@
addTickHsCmdTop (HsCmdTop cmd tys ty syntaxtable) =
addTickLHsCmd :: LHsCmd Id -> TM (LHsCmd Id)
addTickLHsCmd x = addTickLHsExpr x
addTickLHsCmd :: LHsCmd Id -> TM (LHsCmd Id)
addTickLHsCmd x = addTickLHsExpr x
-addTickEvBinds :: TcEvBinds -> TM TcEvBinds
-addTickEvBinds x = return x -- No coverage testing for dictionary binding
-
addTickHsRecordBinds :: HsRecordBinds Id -> TM (HsRecordBinds Id)
addTickHsRecordBinds (HsRecFields fields dd)
= do { fields' <- mapM process fields
addTickHsRecordBinds :: HsRecordBinds Id -> TM (HsRecordBinds Id)
addTickHsRecordBinds (HsRecFields fields dd)
= do { fields' <- mapM process fields
@@
-691,7
+686,10
@@
allocATickBox :: BoxLabel -> SrcSpan -> FreeVars -> TM (Maybe (Int,[Id]))
allocATickBox boxLabel pos fvs | isGoodSrcSpan' pos =
sameFileName pos
(return Nothing) $ TM $ \ env st ->
allocATickBox boxLabel pos fvs | isGoodSrcSpan' pos =
sameFileName pos
(return Nothing) $ TM $ \ env st ->
- let me = (pos, declPath env, map (nameOccName.idName) ids, boxLabel)
+ let mydecl_path
+ | null (declPath env), TopLevelBox x <- boxLabel = x
+ | otherwise = declPath env
+ me = (pos, mydecl_path, map (nameOccName.idName) ids, boxLabel)
c = tickBoxCount st
mes = mixEntries st
ids = occEnvElts fvs
c = tickBoxCount st
mes = mixEntries st
ids = occEnvElts fvs