Implement a smart constructor mkUnsafeCoercion, and use it

[ghc-hetmet.git] / compiler / deSugar / Coverage.lhs

diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index dce7962..52c0f04 100644 (file)
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -52,12 +52,10 @@ addCoverageTicksToBinds
         -> LHsBinds Id
         -> IO (LHsBinds Id, HpcInfo, ModBreaks)
 
-addCoverageTicksToBinds dflags mod mod_loc tyCons binds = do 
-
-  let orig_file = 
-             case ml_hs_file mod_loc of
-                   Just file -> file
-                   Nothing -> panic "can not find the original file during hpc trans"
+addCoverageTicksToBinds dflags mod mod_loc tyCons binds = 
+ case ml_hs_file mod_loc of
+ Nothing -> return (binds, emptyHpcInfo False, emptyModBreaks)
+ Just orig_file -> do
 
   if "boot" `isSuffixOf` orig_file then return (binds, emptyHpcInfo False, emptyModBreaks) else do
 
@@ -461,13 +459,15 @@ addTickStmt isGuard (GroupStmt (stmts, binderMap) groupByClause) = do
           case x of
             Left a -> f a >>= (return . Left)
             Right b -> g b >>= (return . Right)
-addTickStmt isGuard (RecStmt stmts ids1 ids2 tys dictbinds) = do
-       liftM5 RecStmt 
-               (addTickLStmts isGuard stmts)
-               (return ids1)
-               (return ids2)
-               (return tys)
-               (addTickDictBinds dictbinds)
+addTickStmt isGuard stmt@(RecStmt {})
+  = do { stmts' <- addTickLStmts isGuard (recS_stmts stmt)
+       ; ret'   <- addTickSyntaxExpr hpcSrcSpan (recS_ret_fn stmt)
+       ; mfix'  <- addTickSyntaxExpr hpcSrcSpan (recS_mfix_fn stmt)
+       ; bind'  <- addTickSyntaxExpr hpcSrcSpan (recS_bind_fn stmt)
+       ; dicts' <- addTickDictBinds (recS_dicts stmt)
+       ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
+                      , recS_mfix_fn = mfix', recS_bind_fn = bind'
+                      , recS_dicts = dicts' }) }
 
 addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id)
 addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
@@ -740,9 +740,9 @@ mkHpcPos pos
    start = srcSpanStart pos
    end   = srcSpanEnd pos
    hpcPos = toHpcPos ( srcLocLine start
-                    , srcLocCol start + 1
+                    , srcLocCol start
                     , srcLocLine end
-                    , srcLocCol end
+                    , srcLocCol end - 1
                     )
 
 hpcSrcSpan :: SrcSpan