{-# LANGUAGE OverloadedStrings #-}
module Swarm.Language.LSP.VarUsage where
import Control.Monad (guard)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Set (Set)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Language.LSP.Types qualified as J
import Swarm.Language.Parse qualified as P
import Swarm.Language.Syntax
import Swarm.Util qualified as U
data BindingType
= Lambda
| Let
| Bind
deriving (BindingType -> BindingType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindingType -> BindingType -> Bool
$c/= :: BindingType -> BindingType -> Bool
== :: BindingType -> BindingType -> Bool
$c== :: BindingType -> BindingType -> Bool
Eq, Int -> BindingType -> ShowS
[BindingType] -> ShowS
BindingType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindingType] -> ShowS
$cshowList :: [BindingType] -> ShowS
show :: BindingType -> String
$cshow :: BindingType -> String
showsPrec :: Int -> BindingType -> ShowS
$cshowsPrec :: Int -> BindingType -> ShowS
Show)
data VarUsage = VarUsage LocVar BindingType
type BindingSites = Map Var (NonEmpty SrcLoc)
data Usage = Usage
{ Usage -> Set LocVar
usages :: Set LocVar
, Usage -> [VarUsage]
problems :: [VarUsage]
}
instance Semigroup Usage where
Usage Set LocVar
y1 [VarUsage]
z1 <> :: Usage -> Usage -> Usage
<> Usage Set LocVar
y2 [VarUsage]
z2 =
Set LocVar -> [VarUsage] -> Usage
Usage
(Set LocVar
y1 forall a. Semigroup a => a -> a -> a
<> Set LocVar
y2)
([VarUsage]
z1 forall a. Semigroup a => a -> a -> a
<> [VarUsage]
z2)
instance Monoid Usage where
mempty :: Usage
mempty = Set LocVar -> [VarUsage] -> Usage
Usage forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
toErrPos :: Text -> VarUsage -> Maybe (J.Range, Text)
toErrPos :: Text -> VarUsage -> Maybe (Range, Text)
toErrPos Text
code (VarUsage (LV SrcLoc
loc Text
v) BindingType
scope) = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text
"_" Text -> Text -> Bool
`T.isPrefixOf` Text
v
(Int, Int)
rangePair <- case SrcLoc
loc of
SrcLoc Int
s Int
e -> forall a. a -> Maybe a
Just (Int
s, Int
e)
SrcLoc
_ -> forall a. Maybe a
Nothing
let ((Int, Int)
start, (Int, Int)
end) = Text -> (Int, Int) -> ((Int, Int), (Int, Int))
P.getLocRange Text
code (Int, Int)
rangePair
((Int
startLine, Int
startCol), (Int
endLine, Int
endCol)) = (forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b)
minusOne (Int, Int)
start, forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b)
minusOne (Int, Int)
end)
range :: Range
range =
Position -> Position -> Range
J.Range
(UInt -> UInt -> Position
J.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startLine) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startCol))
(UInt -> UInt -> Position
J.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endLine) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endCol))
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
range, Text
txt)
where
txt :: Text
txt =
[Text] -> Text
T.unwords
[ Text
"Unused variable"
, Text -> Text
U.quote Text
v
, Text
"in"
, String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show BindingType
scope
, Text
"expression"
]
minusOne :: (a, b) -> (a, b)
minusOne (a
x, b
y) = (a
x forall a. Num a => a -> a -> a
- a
1, b
y forall a. Num a => a -> a -> a
- b
1)
checkOccurrences ::
BindingSites ->
LocVar ->
BindingType ->
[Syntax] ->
Usage
checkOccurrences :: BindingSites -> LocVar -> BindingType -> [Syntax] -> Usage
checkOccurrences BindingSites
bindings lv :: LocVar
lv@(LV SrcLoc
loc Text
v) BindingType
declType [Syntax]
childSyntaxes =
Set LocVar -> [VarUsage] -> Usage
Usage Set LocVar
childUsages forall a b. (a -> b) -> a -> b
$ [VarUsage]
missing forall a. Semigroup a => a -> a -> a
<> [VarUsage]
deeperMissing
where
deeperBindings :: BindingSites
deeperBindings = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Semigroup a => a -> a -> a
(<>) Text
v (forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc) BindingSites
bindings
Usage Set LocVar
childUsages [VarUsage]
deeperMissing = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (BindingSites -> Syntax -> Usage
getUsage BindingSites
deeperBindings) [Syntax]
childSyntaxes
missing :: [VarUsage]
missing = [LocVar -> BindingType -> VarUsage
VarUsage LocVar
lv BindingType
declType | LocVar
lv forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set LocVar
childUsages]
getUsage ::
BindingSites ->
Syntax ->
Usage
getUsage :: BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings (Syntax SrcLoc
_pos Term
t) = case Term
t of
TVar Text
v -> Set LocVar -> [VarUsage] -> Usage
Usage Set LocVar
myUsages forall a. Monoid a => a
mempty
where
myUsages :: Set LocVar
myUsages = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
v BindingSites
bindings of
Maybe (NonEmpty SrcLoc)
Nothing -> forall a. Monoid a => a
mempty
Just (SrcLoc
loc :| [SrcLoc]
_) -> forall a. a -> Set a
S.singleton forall a b. (a -> b) -> a -> b
$ SrcLoc -> Text -> LocVar
LV SrcLoc
loc Text
v
SLam LocVar
v Maybe Type
_ Syntax
s -> BindingSites -> LocVar -> BindingType -> [Syntax] -> Usage
checkOccurrences BindingSites
bindings LocVar
v BindingType
Lambda [Syntax
s]
SApp Syntax
s1 Syntax
s2 -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
SLet Bool
_ LocVar
v Maybe Polytype
_ Syntax
s1 Syntax
s2 -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 forall a. Semigroup a => a -> a -> a
<> BindingSites -> LocVar -> BindingType -> [Syntax] -> Usage
checkOccurrences BindingSites
bindings LocVar
v BindingType
Let [Syntax
s2]
SPair Syntax
s1 Syntax
s2 -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
SDef Bool
_ LocVar
_v Maybe Polytype
_ Syntax
s -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s
SBind Maybe LocVar
maybeVar Syntax
s1 Syntax
s2 -> case Maybe LocVar
maybeVar of
Just LocVar
v -> BindingSites -> LocVar -> BindingType -> [Syntax] -> Usage
checkOccurrences BindingSites
bindings LocVar
v BindingType
Bind [Syntax
s1, Syntax
s2]
Maybe LocVar
Nothing -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
SDelay DelayType
_ Syntax
s -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s
Term
_ -> forall a. Monoid a => a
mempty