[Git][ghc/ghc][wip/rafl/hpc-viewpatterns] hpc: Traverse patterns to tick contained HsExprs

14 Oct 2026

Florian Ragwitz pushed to branch wip/rafl/hpc-viewpatterns at Glasgow Haskell Compiler / GHC


Commits:
1abc1855 by Florian Ragwitz at 2026-10-13T19:31:03-07:00
hpc: Traverse patterns to tick contained HsExprs

So we can have coverage for view patterns.

Fixes #18590.

- - - - -


5 changed files:

- + changelog.d/hpc-viewpats
- compiler/GHC/HsToCore/Ticks.hs
- testsuite/tests/hpc/all.T
- + testsuite/tests/hpc/viewpats.hs
- + testsuite/tests/hpc/viewpats.stdout


Changes:

=====================================
changelog.d/hpc-viewpats
=====================================
@@ -0,0 +1,14 @@
+section: compiler
+synopsis: Support coverage reporting for view patterns
+issues: #18590
+mrs: !16805
+description:
+  Coverage reporting (:ghc-flag:`-fhpc`) now traverses into patterns and
+  creates ticks for expressions contained within :extension:`ViewPatterns`.
+
+  This provides normal coverage semantics for those embedded expressions,
+  which were previously entirely ignored in coverage reporting.
+
+  Since tick insertion is shared by coverage reporting, source notes,
+  breakpoints, and profiling, this also allows those other modes to instrument
+  expressions inside patterns where applicable.


=====================================
compiler/GHC/HsToCore/Ticks.hs
=====================================
@@ -401,8 +401,9 @@ addTickLHsBind (L pos (pat@(PatBind { pat_lhs = lhs
   -- TODO: better name for rhs's for non-simple patterns?
   let name = maybe "(...)" getOccString simplePatId
 
+  lhs' <- addTickLPat lhs
   (fvs, rhs') <- getFreeVars $ addPathEntry name $ addTickGRHSs False False False rhs
-  let pat' = pat { pat_rhs = rhs'}
+  let pat' = pat { pat_lhs = lhs', pat_rhs = rhs'}
 
   -- Should create ticks here?
   density <- getDensity
@@ -752,11 +753,12 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = L l matches, mg_ext = ctxt }) = do
 
 addTickMatch :: Bool -> Bool -> Bool {-Is this Do Expansion-} ->  Match GhcTc (LHsExpr GhcTc)
              -> TM (Match GhcTc (LHsExpr GhcTc))
-addTickMatch isOneOfMany isLambda isDoExp match@(Match { m_pats = L _ pats
+addTickMatch isOneOfMany isLambda isDoExp match@(Match { m_pats = L l pats
                                                        , m_grhss = gRHSs }) =
   bindLocals pats $ do
+    pats' <- mapM addTickLPat pats
     gRHSs' <- addTickGRHSs isOneOfMany isLambda isDoExp gRHSs
-    return $ match { m_grhss = gRHSs' }
+    return $ match { m_pats = L l pats', m_grhss = gRHSs' }
 
 addTickGRHSs :: Bool -> Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
              -> TM (GRHSs GhcTc (LHsExpr GhcTc))
@@ -936,9 +938,60 @@ addTickSyntaxExpr pos syn@(SyntaxExprTc { syn_expr = x }) = do
         return $ syn { syn_expr = x' }
 addTickSyntaxExpr _ NoSyntaxExprTc = return NoSyntaxExprTc

--- we do not walk into patterns.
+-- ViewPat contains an LHsExpr, so we have to walk into patterns.
 addTickLPat :: LPat GhcTc -> TM (LPat GhcTc)
-addTickLPat pat = return pat
+addTickLPat = traverse addTickPat
+
+addTickPat :: Pat GhcTc -> TM (Pat GhcTc)
+addTickPat (ViewPat x expr pat) =
+  ViewPat x <$> addTickLHsExpr expr <*> addTickLPat pat
+addTickPat (LazyPat x pat) = LazyPat x <$> addTickLPat pat
+addTickPat (AsPat x var pat) = AsPat x var <$> addTickLPat pat
+addTickPat (ParPat x pat) = ParPat x <$> addTickLPat pat
+addTickPat (BangPat x pat) = BangPat x <$> addTickLPat pat
+addTickPat (SigPat x pat sig) = SigPat x <$> addTickLPat pat <*> pure sig
+addTickPat (ModifiedPat x mods pat) = ModifiedPat x mods <$> addTickLPat pat
+addTickPat (ListPat x pats) = ListPat x <$> mapM addTickLPat pats
+addTickPat (TuplePat x pats boxity) =
+  TuplePat x <$> mapM addTickLPat pats <*> pure boxity
+addTickPat (OrPat x pats) = OrPat x <$> mapM addTickLPat pats
+addTickPat (SumPat x pat alt arity) =
+  SumPat x <$> addTickLPat pat <*> pure alt <*> pure arity
+addTickPat pat@ConPat{ pat_args } = do
+  pat_args' <- addTickConPatDetails pat_args
+  pure pat{ pat_args = pat_args' }
+  where
+    addTickConPatDetails :: HsConPatDetails GhcTc -> TM (HsConPatDetails GhcTc)
+    addTickConPatDetails (PrefixCon x pats) =
+      PrefixCon x <$> mapM addTickLPat pats
+    addTickConPatDetails (InfixCon x pat1 pat2) =
+      InfixCon x <$> addTickLPat pat1 <*> addTickLPat pat2
+    addTickConPatDetails (RecCon x fields) =
+      RecCon x <$> addTickRecFields fields
+      where
+        addTickRecFields flds@HsRecFields{ rec_flds } = do
+          rec_flds' <- mapM (traverse addTickRecField) rec_flds
+          pure flds{ rec_flds = rec_flds' }
+        addTickRecField fld = do
+          rhs' <- addTickLPat (hfbRHS fld)
+          pure fld{ hfbRHS = rhs' }
+addTickPat (NPat x lit neg eq) =
+  NPat x lit <$> traverse (addTickSyntaxExpr hpcSrcSpan) neg
+             <*> addTickSyntaxExpr hpcSrcSpan eq
+addTickPat (NPlusKPat x n k lit ge minus) =
+  NPlusKPat x n k lit <$> addTickSyntaxExpr hpcSrcSpan ge
+                      <*> addTickSyntaxExpr hpcSrcSpan minus
+addTickPat (XPat ext@CoPat{ co_pat_inner }) =
+  XPat . (\pat -> ext{ co_pat_inner = pat }) <$> addTickPat co_pat_inner
+addTickPat (XPat (ExpansionPat orig expansion)) =
+  XPat . ExpansionPat orig <$> addTickPat expansion
+addTickPat p@WildPat{} = pure p
+addTickPat p@VarPat{} = pure p
+addTickPat p@LitPat{} = pure p
+addTickPat p@QualLitPat{} = pure p
+addTickPat p@SplicePat{} = pure p
+addTickPat p@EmbTyPat{} = pure p
+addTickPat p@InvisPat{} = pure p
 
 addTickHsCmdTop :: HsCmdTop GhcTc -> TM (HsCmdTop GhcTc)
 addTickHsCmdTop (HsCmdTop x cmd) =
@@ -1012,10 +1065,11 @@ addTickCmdMatchGroup mg@(MG { mg_alts = (L l matches) }) = do
   return $ mg { mg_alts = L l matches' }
 
 addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
-addTickCmdMatch match@(Match { m_pats = L _ pats, m_grhss = gRHSs }) =
+addTickCmdMatch match@(Match { m_pats = L l pats, m_grhss = gRHSs }) =
   bindLocals pats $ do
+    pats' <- mapM addTickLPat pats
     gRHSs' <- addTickCmdGRHSs gRHSs
-    return $ match { m_grhss = gRHSs' }
+    return $ match { m_pats = L l pats', m_grhss = gRHSs' }
 
 addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
 addTickCmdGRHSs (GRHSs x guarded local_binds) =


=====================================
testsuite/tests/hpc/all.T
=====================================
@@ -7,6 +7,8 @@ test('T10138', [extra_files(['.keepme.hpc.T10138/']),
 
 test('T11798', normal, makefile_test, [])
 
+test('viewpats', normal, compile_and_run, ['-fhpc'])
+
 # Run tests below only for the hpc way.
 #
 # Do not explicitly specify '-fhpc' in extra_hc_opts, unless also setting


=====================================
testsuite/tests/hpc/viewpats.hs
=====================================
@@ -0,0 +1,271 @@
+{-# LANGUAGE ViewPatterns, Modifiers, OrPatterns, UnboxedSums, NPlusKPatterns, TypeFamilies, OverloadedLists, QualifiedStrings, LambdaCase, Arrows #-}
+
+module Main where
+
+import Control.Exception
+import Data.List
+import Data.Tree
+import Trace.Hpc.Mix
+import Trace.Hpc.Reflect
+import Trace.Hpc.Tix
+import Trace.Hpc.Util
+import qualified Data.String as S
+import Control.Arrow
+
+testView :: Int -> Bool
+testView (id -> 1) = True
+testView _ = False
+
+testLazyForced :: Int -> Int
+testLazyForced ~(id -> x) = x + 1
+
+testLazyUnforced :: Int -> Int
+testLazyUnforced ~(id -> x) = 42
+
+testAsCovered :: Int -> Int
+testAsCovered x@(id -> y) = x + y
+
+testAsUncovered :: Int -> Int
+testAsUncovered ~(_x@(id -> _y)) = 42
+
+testBangCovered :: Int -> Int
+testBangCovered !(id -> x) = x + 1
+
+testBangUncovered :: Int -> Int
+testBangUncovered ~(!(id -> x)) = 42
+
+testSigCovered :: Int -> Int
+testSigCovered ((id -> x) :: Int) = x + 1
+
+testSigUncovered :: Int -> Int
+testSigUncovered ((id -> x) :: Int) = 42
+
+testModifiedCovered :: Int -> Int
+testModifiedCovered (%() (id -> x)) = x + 1
+
+testModifiedUncovered :: Int -> Int
+testModifiedUncovered (%() (id -> x)) = 42
+
+testList :: [Int] -> Int
+testList [id -> x] = x + 1
+testList [] = 42
+
+testTuple :: (Int, Int) -> Int
+testTuple (id -> x, id -> _y) = x + 1
+
+testOr :: [Int] -> Bool
+testOr (id -> []; reverse -> [_]) = True
+testOr _ = False
+
+testSum :: (# Int | Int #) -> Int
+testSum (# (id -> x) | #) = x + 1
+testSum (# | (id -> y) #) = y + 2
+
+testNPat :: Int -> Int
+testNPat 1 = 10
+testNPat (-1) = 20
+testNPat _ = 30
+
+testNPlusKPat :: Int -> Int
+testNPlusKPat (n+3) = n * 2
+testNPlusKPat _ = 0
+
+type family CoList a where
+  CoList Bool = [Int]
+
+testCoPat :: CoList Bool -> Int
+testCoPat [id -> x] = x + 1
+testCoPat [] = 0
+
+testQualifiedString :: String -> Int
+testQualifiedString S."hello" = 1
+testQualifiedString _ = 0
+
+testPrefix :: Maybe Int -> Int
+testPrefix (Just (id -> x)) = x + 1
+testPrefix _ = 0
+
+testInfix :: [Int] -> Int
+testInfix ((id -> x) : _) = x + 1
+testInfix _ = 0
+
+data Record = Record { recVal :: Int }
+
+testRec :: Record -> Int
+testRec Record{ recVal = (id -> x) } = x + 1
+
+testLambda :: Int -> Int
+testLambda = \(id -> x) -> x + 1
+
+testLambdaCase :: Int -> Int
+testLambdaCase = \case
+  (id -> 5) -> 1
+  _ -> 0
+
+testLambdaCases :: Int -> Int -> Int
+testLambdaCases = \cases
+  (id -> 5) (id -> y) -> y + 1
+  _ _ -> 0
+
+testCase :: Int -> Int
+testCase n = case n of
+  (id -> 5) -> 1
+  _ -> 0
+
+testDoExpansion :: Maybe Int -> Maybe Int
+testDoExpansion m = do
+  (id -> 5) <- m
+  pure 42
+
+testPatBindLet :: Int -> Int
+testPatBindLet n =
+  let (id -> x) = n
+      (id -> _) = undefined
+  in x + 1
+
+testPatBindWhere :: Int -> Int
+testPatBindWhere n = x + 1
+  where (id -> x) = n
+
+testPatBindComp :: Int -> Int
+testPatBindComp n =
+  head [ x + 1
+       | let (id -> x) = n
+       , let (id -> _) = undefined ]
+
+testPatBindGuard :: Int -> Int
+testPatBindGuard n
+  | let (id -> x) = n, x > 0 = x + 1
+  | otherwise = 0
+
+testPatBindDo :: Int -> Maybe Int
+testPatBindDo n = do
+  let (id -> x) = n
+  pure (x + 1)
+
+testPatBindCmdLet :: Int -> Int
+testPatBindCmdLet = proc n ->
+  let (id -> x) = n
+  in returnA -< x + 1
+
+(id -> testTopValue) = (5 :: Int)
+
+testPatBindTopLevel :: Int
+testPatBindTopLevel = testTopValue + 1
+
+testCmdLam :: Int -> Int
+testCmdLam = proc n ->
+  (\(id -> x) -> returnA -< x + 1) n
+
+testCmdCase :: Int -> Int
+testCmdCase = proc n ->
+  case n of
+    (id -> 5) -> returnA -< 1
+    _ -> returnA -< 0
+
+testCmdLambdaCase :: Int -> Int
+testCmdLambdaCase = proc n ->
+  (\case
+    (id -> 5) -> returnA -< 1
+    _ -> returnA -< 0) n
+
+testCmdLambdaCases :: Int -> Int
+testCmdLambdaCases = proc n ->
+  (\cases
+    (id -> 5) (id -> y) -> returnA -< y + 1
+    _ _ -> returnA -< 0) n n
+
+main :: IO ()
+main = do
+  evaluate (testView 1)
+  evaluate (testLazyForced 5)
+  evaluate (testLazyUnforced undefined)
+  evaluate (testAsCovered 5)
+  evaluate (testAsUncovered undefined)
+  evaluate (testBangCovered 5)
+  evaluate (testBangUncovered undefined)
+  evaluate (testSigCovered 5)
+  evaluate (testSigUncovered undefined)
+  evaluate (testModifiedCovered 5)
+  evaluate (testModifiedUncovered undefined)
+  evaluate (testList [5])
+  evaluate (testList [])
+  evaluate (testTuple (5, undefined))
+  evaluate (testOr [])
+  evaluate (testOr [5])
+  evaluate (testOr [5, 6])
+  evaluate (testSum (# 5 | #))
+  evaluate (testNPat 1)
+  evaluate (testNPat (-1))
+  evaluate (testNPlusKPat 5)
+  evaluate (testNPlusKPat 2)
+  evaluate (testCoPat [5])
+  evaluate (testCoPat [])
+  evaluate (testQualifiedString "hello")
+  evaluate (testQualifiedString "world")
+  evaluate (testPrefix (Just 5))
+  evaluate (testPrefix Nothing)
+  evaluate (testInfix [5])
+  evaluate (testInfix [])
+  evaluate (testRec (Record 5))
+  evaluate (testLambda 5)
+  evaluate (testLambdaCase 5)
+  evaluate (testLambdaCase 6)
+  evaluate (testLambdaCases 5 7)
+  evaluate (testLambdaCases 6 7)
+  evaluate (testCase 5)
+  evaluate (testCase 6)
+  evaluate (maybe 0 id (testDoExpansion (Just 5)))
+  evaluate (maybe 0 id (testDoExpansion (Just 6)))
+  evaluate (maybe 0 id (testDoExpansion Nothing))
+  evaluate (testPatBindLet 5)
+  evaluate (testPatBindWhere 5)
+  evaluate (testPatBindComp 5)
+  evaluate (testPatBindGuard 5)
+  evaluate (testPatBindGuard (-5))
+  evaluate (maybe 0 id (testPatBindDo 5))
+  evaluate (testPatBindCmdLet 5)
+  evaluate testPatBindTopLevel
+  evaluate (testCmdLam 5)
+  evaluate (testCmdCase 5)
+  evaluate (testCmdCase 6)
+  evaluate (testCmdLambdaCase 5)
+  evaluate (testCmdLambdaCase 6)
+  evaluate (testCmdLambdaCases 5)
+  evaluate (testCmdLambdaCases 6)
+  dumpCoverage
+
+dumpCoverage :: IO ()
+dumpCoverage = do
+  Mix path _ _ _ entries <- readMix [".hpc"] (Left "Main")
+  Tix [TixModule "Main" _ _ counts] <- examineTix
+  src <- readFileUtf8 path
+  putStr . compactForest . map (fmap (describe src)) . filter interesting $
+    createMixEntryDom [ (pos, (label, count)) | ((pos, label), count) <- zip entries counts ]
+  where
+    interesting (Node (_, boxes) _) = any (interestingBox . fst) boxes
+    interestingBox (TopLevelBox [name]) = "test" `isPrefixOf` name
+    interestingBox ExpBox{} = True
+    interestingBox _ = False
+    describe src (pos, boxes) =
+      intercalate ", " [ describeBox label ++ ": " ++ show count | (label, count) <- boxes ]
+        ++ if any (hasSource . fst) boxes then " " ++ show (sourceAt src pos) else ""
+    hasSource (ExpBox{}; BinBox{}) = True
+    hasSource _ = False
+    describeBox (TopLevelBox names) = intercalate "." names
+    describeBox (ExpBox False) = "exp"
+    describeBox (ExpBox True) = "exp-alt"
+    describeBox (BinBox kind side) = show kind ++ " " ++ show side
+    compactForest = unlines . filter (not . all (`elem` " |")) . lines . drawForest
+
+-- candidate for HPC.Utils, maybe?
+sourceAt :: String -> HpcPos -> String
+sourceAt src pos
+  | l1 == l2 = take (c2 - c1 + 1) . drop (c1 - 1) $ ls !! (l1 - 1)
+  | otherwise = intercalate "\n" $ first : (middle ++ [last])
+  where
+    (l1, c1, l2, c2) = fromHpcPos pos
+    ls = lines src
+    first = drop (c1 - 1) $ ls !! (l1 - 1)
+    middle = take (l2 - l1 - 1) $ drop l1 ls
+    last = take c2 $ ls !! (l2 - 1)


=====================================
testsuite/tests/hpc/viewpats.stdout
=====================================
@@ -0,0 +1,231 @@
+testCmdLambdaCases: 1
+`- exp: 1 "proc n ->\n  (\\cases\n    (id -> 5) (id -> y) -> returnA -< y + 1\n    _ _ -> returnA -< 0) n n"
+   +- exp: 2 "id"
+   +- exp: 1 "id"
+   +- exp: 1 "returnA"
+   +- exp: 1 "y + 1"
+   |  +- exp: 1 "y"
+   |  `- exp: 1 "1"
+   +- exp: 1 "returnA"
+   +- exp: 1 "0"
+   +- exp: 2 "n"
+   `- exp: 1 "n"
+testCmdLambdaCase: 1
+`- exp: 1 "proc n ->\n  (\\case\n    (id -> 5) -> returnA -< 1\n    _ -> returnA -< 0) n"
+   +- exp: 2 "id"
+   +- exp: 1 "returnA"
+   +- exp: 1 "1"
+   +- exp: 1 "returnA"
+   +- exp: 1 "0"
+   `- exp: 2 "n"
+testCmdCase: 1
+`- exp: 1 "proc n ->\n  case n of\n    (id -> 5) -> returnA -< 1\n    _ -> returnA -< 0"
+   +- exp: 2 "n"
+   +- exp: 2 "id"
+   +- exp: 1 "returnA"
+   +- exp: 1 "1"
+   +- exp: 1 "returnA"
+   `- exp: 1 "0"
+testCmdLam: 1
+`- exp: 1 "proc n ->\n  (\\(id -> x) -> returnA -< x + 1) n"
+   +- exp: 1 "id"
+   +- exp: 1 "returnA"
+   +- exp: 1 "x + 1"
+   |  +- exp: 1 "x"
+   |  `- exp: 1 "1"
+   `- exp: 1 "n"
+exp: 1 "id"
+exp: 1 "(5 :: Int)"
+testPatBindTopLevel: 1
+`- exp: 1 "testTopValue + 1"
+   +- exp: 1 "testTopValue"
+   `- exp: 1 "1"
+testPatBindCmdLet: 1
+`- exp: 1 "proc n ->\n  let (id -> x) = n\n  in returnA -< x + 1"
+   +- exp: 1 "id"
+   +- exp: 1 "n"
+   +- exp: 1 "returnA"
+   `- exp: 1 "x + 1"
+      +- exp: 1 "x"
+      `- exp: 1 "1"
+testPatBindDo: 1
+`- exp: 1 "do\n  let (id -> x) = n\n  pure (x + 1)"
+   +- exp: 1 "pure (x + 1)"
+   |  `- exp: 1 "(x + 1)"
+   |     +- exp: 1 "x"
+   |     `- exp: 1 "1"
+   `- exp: 1 "let (id -> x) = n"
+      +- exp: 1 "id"
+      `- exp: 1 "n"
+testPatBindGuard: 2
++- exp: 2 "id"
++- exp: 2 "n"
++- GuardBinBox True: 1, GuardBinBox False: 1, exp: 2 "x > 0"
+|  +- exp: 2 "x"
+|  `- exp: 2 "0"
++- exp-alt: 1 "x + 1"
+|  +- exp: 1 "x"
+|  `- exp: 1 "1"
++- GuardBinBox True: 1, GuardBinBox False: 0, exp: 1 "otherwise"
+`- exp-alt: 1 "0"
+testPatBindComp: 1
+`- exp: 1 "head [ x + 1\n       | let (id -> x) = n\n       , let (id -> _) = undefined ]"
+   `- exp: 1 "[ x + 1\n       | let (id -> x) = n\n       , let (id -> _) = undefined ]"
+      +- exp: 1 "id"
+      +- exp: 1 "n"
+      +- exp: 0 "id"
+      +- exp: 0 "undefined"
+      `- exp: 1 "x + 1"
+         +- exp: 1 "x"
+         `- exp: 1 "1"
+testPatBindWhere: 1
++- exp: 1 "id"
++- exp: 1 "n"
+`- exp: 1 "x + 1"
+   +- exp: 1 "x"
+   `- exp: 1 "1"
+testPatBindLet: 1
+`- exp: 1 "let (id -> x) = n\n      (id -> _) = undefined\n  in x + 1"
+   +- exp: 0 "id"
+   +- exp: 0 "undefined"
+   +- exp: 1 "id"
+   +- exp: 1 "n"
+   +- exp: 1 "x"
+   `- exp: 1 "1"
+testDoExpansion: 3
+`- exp: 3 "do\n  (id -> 5) <- m\n  pure 42"
+   +- exp: 1 "pure 42"
+   |  `- exp: 1 "42"
+   `- exp: 3 "(id -> 5) <- m"
+      +- exp: 3 "m"
+      `- exp: 2 "id"
+testCase: 2
+`- exp: 2 "case n of\n  (id -> 5) -> 1\n  _ -> 0"
+   +- exp: 2 "n"
+   +- exp: 2 "id"
+   +- exp-alt: 1 "1"
+   `- exp-alt: 1 "0"
+testLambdaCases: 1
+`- exp: 1 "\\cases\n  (id -> 5) (id -> y) -> y + 1\n  _ _ -> 0"
+   +- exp: 2 "id"
+   +- exp: 1 "id"
+   +- exp-alt: 1 "y + 1"
+   |  +- exp: 1 "y"
+   |  `- exp: 1 "1"
+   `- exp-alt: 1 "0"
+testLambdaCase: 1
+`- exp: 1 "\\case\n  (id -> 5) -> 1\n  _ -> 0"
+   +- exp: 2 "id"
+   +- exp-alt: 1 "1"
+   `- exp-alt: 1 "0"
+testLambda: 1
+`- exp: 1 "\\(id -> x) -> x + 1"
+   +- exp: 1 "id"
+   `- exp: 1 "x + 1"
+      +- exp: 1 "x"
+      `- exp: 1 "1"
+testRec: 1
++- exp: 1 "id"
+`- exp: 1 "x + 1"
+   +- exp: 1 "x"
+   `- exp: 1 "1"
+testInfix: 2
++- exp: 1 "id"
++- exp-alt: 1 "x + 1"
+|  +- exp: 1 "x"
+|  `- exp: 1 "1"
+`- exp-alt: 1 "0"
+testPrefix: 2
++- exp: 1 "id"
++- exp-alt: 1 "x + 1"
+|  +- exp: 1 "x"
+|  `- exp: 1 "1"
+`- exp-alt: 1 "0"
+testQualifiedString: 2
++- exp-alt: 1 "1"
+`- exp-alt: 1 "0"
+testCoPat: 2
++- exp: 1 "id"
++- exp-alt: 1 "x + 1"
+|  +- exp: 1 "x"
+|  `- exp: 1 "1"
+`- exp-alt: 1 "0"
+testNPlusKPat: 2
++- exp-alt: 1 "n * 2"
+|  +- exp: 1 "n"
+|  `- exp: 1 "2"
+`- exp-alt: 1 "0"
+testNPat: 2
++- exp-alt: 1 "10"
++- exp-alt: 1 "20"
+`- exp-alt: 0 "30"
+testSum: 1
++- exp: 1 "id"
++- exp-alt: 1 "x + 1"
+|  +- exp: 1 "x"
+|  `- exp: 1 "1"
++- exp: 0 "id"
+`- exp-alt: 0 "y + 2"
+   +- exp: 0 "y"
+   `- exp: 0 "2"
+testOr: 3
++- exp: 3 "id"
++- exp: 2 "reverse"
++- exp-alt: 2 "True"
+`- exp-alt: 1 "False"
+testTuple: 1
++- exp: 1 "id"
++- exp: 0 "id"
+`- exp: 1 "x + 1"
+   +- exp: 1 "x"
+   `- exp: 1 "1"
+testList: 2
++- exp: 1 "id"
++- exp-alt: 1 "x + 1"
+|  +- exp: 1 "x"
+|  `- exp: 1 "1"
+`- exp-alt: 1 "42"
+testModifiedUncovered: 1
++- exp: 0 "id"
+`- exp: 1 "42"
+testModifiedCovered: 1
++- exp: 1 "id"
+`- exp: 1 "x + 1"
+   +- exp: 1 "x"
+   `- exp: 1 "1"
+testSigUncovered: 1
++- exp: 0 "id"
+`- exp: 1 "42"
+testSigCovered: 1
++- exp: 1 "id"
+`- exp: 1 "x + 1"
+   +- exp: 1 "x"
+   `- exp: 1 "1"
+testBangUncovered: 1
++- exp: 0 "id"
+`- exp: 1 "42"
+testBangCovered: 1
++- exp: 1 "id"
+`- exp: 1 "x + 1"
+   +- exp: 1 "x"
+   `- exp: 1 "1"
+testAsUncovered: 1
++- exp: 0 "id"
+`- exp: 1 "42"
+testAsCovered: 1
++- exp: 1 "id"
+`- exp: 1 "x + y"
+   +- exp: 1 "x"
+   `- exp: 1 "y"
+testLazyUnforced: 1
++- exp: 0 "id"
+`- exp: 1 "42"
+testLazyForced: 1
++- exp: 1 "id"
+`- exp: 1 "x + 1"
+   +- exp: 1 "x"
+   `- exp: 1 "1"
+testView: 1
++- exp: 1 "id"
++- exp-alt: 1 "True"
+`- exp-alt: 0 "False"



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1abc18550fa898d37a5b8213cb14fb6a...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1abc18550fa898d37a5b8213cb14fb6a...
You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help

    

[Git][ghc/ghc][wip/rafl/hpc-viewpatterns] hpc: Traverse patterns to tick contained HsExprs

Florian Ragwitz (＠rafl)