mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
Fix unused-binding-detection in case patterns
This commit is contained in:
parent
8a3e2efafc
commit
3e87dc3854
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|]
|
||||
)
|
||||
]
|
||||
|
Loading…
Reference in New Issue
Block a user