Fix unused-binding-detection in case patterns

parser-typechecker/src/Unison/Syntax/TermParser.hs

@@ -294,12 +294,13 @@ parsePattern = label "pattern" root
               do _ <- anyToken; pure (Set.findMin s <$ tok)
       where
         isLower = Text.all Char.isLower . Text.take 1 . Name.toText
+        isIgnored n = Text.take 1 (Name.toText n) == "_"
         die hq s = case L.payload hq of
           -- if token not hash qualified or uppercase,
           -- fail w/out consuming it to allow backtracking
           HQ.NameOnly n
             | Set.null s
-                && isLower n ->
+                && (isLower n || isIgnored n) ->
                 fail $ "not a constructor name: " <> show n
           -- it was hash qualified, and wasn't found in the env, that's a failure!
           _ -> failCommitted $ err hq s

unison-cli/src/Unison/LSP/FileAnalysis/UnusedBindings.hs

@@ -14,20 +14,42 @@ import Unison.Parser.Ann (Ann)
 import Unison.Prelude
 import Unison.Symbol (Symbol (..))
 import Unison.Term (Term)
+import Unison.Term qualified as Term
+import Unison.Util.List qualified as ListUtils
 import Unison.Util.Range qualified as Range
 import Unison.Var qualified as Var
 
+data VarUsages
+  = VarUsages
+  { unusedVars :: Map Symbol (Set Ann),
+    usedVars :: Set Symbol,
+    -- This is generally a copy of usedVars, except that we _don't_ remove variables when they go out of scope.
+    -- This is solely so we have the information to handle an edge case in pattern guards where vars are independently
+    -- brought into scope in BOTH the guards and the body of a match case, and we want to count a var as used if it
+    -- appears in _either_.
+    allUsedVars :: Set Symbol
+  }
+
+instance Semigroup VarUsages where
+  VarUsages a b c <> VarUsages a' b' c' =
+    VarUsages (Map.unionWith (<>) a a') (b <> b') (c <> c')
+
+instance Monoid VarUsages where
+  mempty = VarUsages mempty mempty mempty
+
 analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic]
 analyseTerm fileUri tm =
-  let (unusedVars, _) = ABT.cata alg tm
+  let (VarUsages {unusedVars}) = ABT.cata alg tm
       vars =
         Map.toList unusedVars & mapMaybe \(v, ann) -> do
           (,ann) <$> getRelevantVarName v
       diagnostics =
-        vars & mapMaybe \(varName, ann) -> do
+        vars & foldMap \(varName, anns) -> do
+          ann <- Set.toList anns
+          range <- maybeToList $ Cv.annToURange ann
           -- Limit the range to the first line of the binding to not be too annoying.
           -- Maybe in the future we can get the actual annotation of the variable name.
-          lspRange <- Cv.uToLspRange . Range.startingLine <$> Cv.annToURange ann
+          let lspRange = Cv.uToLspRange . Range.startingLine $ range
           pure $ Diagnostic.mkDiagnostic fileUri lspRange Diagnostic.DiagnosticSeverity_Warning [Lsp.DiagnosticTag_Unnecessary] ("Unused binding " <> tShow varName <> ". Use the binding, or prefix it with an _ to dismiss this warning.") []
    in diagnostics
   where
@@ -41,12 +63,39 @@ analyseTerm fileUri tm =
         guard (not (Text.isPrefixOf "_" n))
         Just n
       _ -> Nothing
-    alg :: (Foldable f, Ord v) => Ann -> ABT f v (Map v Ann, Set v) -> (Map v Ann, Set v)
+    alg ::
+      Ann ->
+      (ABT (Term.F Symbol Ann Ann) Symbol VarUsages -> VarUsages)
     alg ann abt = case abt of
-      Var v -> (mempty, Set.singleton v)
+      Var v -> VarUsages {unusedVars = mempty, usedVars = Set.singleton v, allUsedVars = Set.singleton v}
       Cycle x -> x
-      Abs v (unusedBindings, usedVars) ->
+      Abs v (VarUsages {unusedVars, usedVars, allUsedVars}) ->
         if v `Set.member` usedVars
-          then (unusedBindings, Set.delete v usedVars)
-          else (Map.insert v ann unusedBindings, usedVars)
-      Tm fx -> Foldable.fold fx
+          then VarUsages {unusedVars, usedVars = Set.delete v usedVars, allUsedVars}
+          else VarUsages {unusedVars = Map.insert v (Set.singleton ann) unusedVars, usedVars, allUsedVars}
+      Tm fx ->
+        case fx of
+          -- We need to special-case pattern guards because the pattern, guard, and body treat each of their vars in
+          -- their own independent scopes, even though the vars created in the pattern are the same ones used in the
+          -- guards and bindings :shrug:
+          Term.Match scrutinee cases ->
+            let -- There's a separate case for every guard on a single pattern, so we first do our best to group up cases with the same pattern.
+                -- Otherwise, a var may be reported unused in one branch of a guard even though it's used in another branch.
+                groupedCases = ListUtils.groupBy (\(Term.MatchCase pat _ _) -> pat) cases
+                caseVars =
+                  groupedCases & foldMap \singlePatCases ->
+                    let (VarUsages {unusedVars = unused, usedVars = used, allUsedVars = allUsed}) =
+                          singlePatCases
+                            & foldMap
+                              ( \(Term.MatchCase pat guard body) ->
+                                  -- This is imprecise, but it's quite annoying to get the actual ann of the unused bindings, so
+                                  -- we just use the FULL span of the pattern for now. We could fix this with a bit
+                                  -- of elbow grease.
+                                  let patSpanAnn = fold pat
+                                      combindedVarUsages = fold guard <> body
+                                   in combindedVarUsages {unusedVars = (unusedVars combindedVarUsages) $> (Set.singleton patSpanAnn)}
+                              )
+                        actuallyUnusedVars = unused & Map.filterWithKey \k _ -> k `Set.notMember` allUsed
+                     in VarUsages {unusedVars = actuallyUnusedVars, usedVars = used, allUsedVars = allUsed}
+             in scrutinee <> caseVars
+          _ -> Foldable.fold fx

unison-cli/tests/Unison/Test/LSP.hs

@@ -416,21 +416,24 @@ withTestCodebase action = do
 
 makeDiagnosticRangeTest :: (String, Text) -> Test ()
 makeDiagnosticRangeTest (testName, testSrc) = scope testName $ do
-  (ann, _block, cleanSrc) <- case extractDelimitedBlock ('«', '»') testSrc of
-    Nothing -> crash "expected exactly one delimited block"
-    Just r -> pure r
+  let (cleanSrc, mayExpectedDiagnostic) = case extractDelimitedBlock ('«', '»') testSrc of
+        Nothing -> (testSrc, Nothing)
+        Just (ann, block, clean) -> (clean, Just (ann, block))
   (pf, _mayTypecheckedFile) <- typecheckSrc testName cleanSrc
   UF.terms pf
     & Map.elems
     & \case
       [(_a, trm)] -> do
-        case UnusedBindings.analyseTerm (LSP.Uri "test") trm of
-          [diag] -> do
+        case (mayExpectedDiagnostic, UnusedBindings.analyseTerm (LSP.Uri "test") trm) of
+          (Just (ann, _block), [diag]) -> do
             let expectedRange = Cv.annToRange ann
             let actualRange = Just (diag ^. LSP.range)
             when (expectedRange /= actualRange) do
               crash $ "Expected diagnostic at range: " <> show expectedRange <> ", got: " <> show actualRange
-          _ -> crash "Expected exactly one diagnostic"
+          (Nothing, []) -> pure ()
+          (expected, actual) -> case expected of
+            Nothing -> crash $ "Expected no diagnostics, got: " <> show actual
+            Just _ -> crash $ "Expected exactly one diagnostic, but got " <> show actual
       _ -> crash "Expected exactly one term"
 
 unusedBindingLocations :: Test ()
@@ -446,5 +449,18 @@ unusedBindingLocations =
       ),
       ( "Unused argument",
         [here|term «unused» = 1|]
+      ),
+      ( "Unused binding in cases block",
+        [here|term = cases
+  -- Note: the diagnostic _should_ only wrap the unused bindings, but right now it just wraps the whole pattern.
+  («unused, used»)
+    | used > 0 -> true
+    | otherwise -> false
+    |]
+      ),
+      ( "Ignored unused binding in cases block shouldn't error",
+        [here|term = cases
+  (used, _ignored) -> used
+    |]
       )
     ]