Skip to content

Commit 21e4959

Browse files
ChrisPennerChrisPenner
committed
Don't typecheck twice, correctly find best match for each var.
1 parent 5fdf1f7 commit 21e4959

File tree

6 files changed

+149
-35
lines changed

6 files changed

+149
-35
lines changed

‎parser-typechecker/src/Unison/Typechecker/Context.hs

Lines changed: 14 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -358,11 +358,12 @@ data InfoNote v loc
358358
= SolvedBlank (B.Recorded loc) v (Type v loc)
359359
| Decision v loc (Term.Term v loc)
360360
| TopLevelComponent [(v, Type.Type v loc, RedundantTypeAnnotation)]
361-
| -- The inferred type of a local binding, and the scope of that binding as a loc.
361+
| -- The inferred type of a let or argument binding, and the scope of that binding as a loc.
362362
-- Note that if interpreting the type of a 'v' at a given usage site, it is the caller's
363363
-- job to use the binding with the smallest containing scope so as to respect variable
364364
-- shadowing.
365-
LetBinding v loc (Type.Type v loc)
365+
-- This is used in the LSP.
366+
VarBinding v loc (Type.Type v loc)
366367
deriving (Show)
367368

368369
topLevelComponent :: (Var v) => [(v, Type.Type v loc, RedundantTypeAnnotation)] -> InfoNote v loc
@@ -1109,13 +1110,16 @@ noteBindingType top span v binding typ = case binding of
11091110
[(Var.reset v, generalizeAndUnTypeVar typ, True)]
11101111
where
11111112
note :: (Var v) => [(v, Type.Type v loc, RedundantTypeAnnotation)] -> M v loc ()
1112-
note infos =
1113-
if top
1114-
then btw $ topLevelComponent infos
1115-
else for_ infos \(v, t, _r) -> noteLocalBinding v span t
1113+
note infos = do
1114+
-- Also note top-level components as standard let bindings for the LSP
1115+
for_ infos \(v, t, _r) -> noteBinding v span t
1116+
when top (btw $ topLevelComponent infos)
11161117

1117-
noteLocalBinding :: (Var v) => v -> loc -> Type.Type v loc -> M v loc ()
1118-
noteLocalBinding v span t = btw $ LetBinding v span t
1118+
-- | Take note of the types and locations of all bindings, including let bindings, letrec
1119+
-- bindings, lambda argument bindings and top-level bindings.
1120+
-- This information is used to provide information to the LSP after typechecking.
1121+
noteBinding :: (Var v) => v -> loc -> Type.Type v loc -> M v loc ()
1122+
noteBinding v span t = btw $ VarBinding v span t
11191123

11201124
synthesizeTop ::
11211125
(Var v) =>
@@ -1344,7 +1348,7 @@ synthesizeWanted e
13441348
ctx <- getContext
13451349
let t = apply ctx $ Type.arrow l it (Type.effect l [et] ot)
13461350
let solvedInputType = fromMaybe it . fmap Type.getPolytype $ Map.lookup i . solvedExistentials . info $ ctx
1347-
noteLocalBinding i l (TypeVar.lowerType $ solvedInputType)
1351+
noteBinding i l (TypeVar.lowerType $ solvedInputType)
13481352
pure (t, [])
13491353
| Term.If' cond t f <- e = do
13501354
cwant <- scope InIfCond $ check cond (Type.boolean l)
@@ -1873,7 +1877,7 @@ annotateLetRecBindings span isTop letrec =
18731877
pure body
18741878
else do -- If this isn't a top-level letrec, then we don't have to do anything special
18751879
(body, vts) <- annotateLetRecBindings' True
1876-
for_ vts \(v, t) -> noteLocalBinding v span (TypeVar.lowerType t)
1880+
for_ vts \(v, t) -> noteBinding v span (TypeVar.lowerType t)
18771881
pure body
18781882
where
18791883
annotateLetRecBindings' useUserAnnotations = do

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

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@ import Data.Foldable qualified as Foldable
1111
import Data.IntervalMap.Lazy (IntervalMap)
1212
import Data.IntervalMap.Lazy qualified as IM
1313
import Data.Map qualified as Map
14-
import Data.Map.Monoidal qualified as MonoidalMap
1514
import Data.Set qualified as Set
1615
import Data.Text qualified as Text
1716
import Data.These
@@ -25,6 +24,7 @@ import Language.LSP.Protocol.Types
2524
TextDocumentIdentifier (TextDocumentIdentifier),
2625
Uri (getUri),
2726
)
27+
import Language.LSP.Protocol.Types qualified as LSP
2828
import Unison.ABT qualified as ABT
2929
import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
3030
import Unison.Cli.UniqueTypeGuidLookup qualified as Cli
@@ -39,6 +39,7 @@ import Unison.LSP.Conversions qualified as Cv
3939
import Unison.LSP.Diagnostics (DiagnosticSeverity (..), mkDiagnostic, reportDiagnostics)
4040
import Unison.LSP.Orphans ()
4141
import Unison.LSP.Types
42+
import Unison.LSP.Util.IntersectionMap (keyedSingleton)
4243
import Unison.LSP.VFS qualified as VFS
4344
import Unison.Name (Name)
4445
import Unison.Names (Names)
@@ -115,12 +116,12 @@ checkFile doc = runMaybeT do
115116
-- Debug.debugM Debug.Temp "After typechecking notes" afterTDNRTypecheckingNotes'
116117
-- afterTDNRTypecheckingNotes'
117118
typecheckingNotes
118-
& mapMaybe \case
119-
Result.TypeInfo (Context.LetBinding (Symbol.Symbol _ (Var.User v)) loc typ) ->
120-
Cv.annToInterval loc <&> \interval -> (v, (IM.singleton interval typ))
121-
_ -> Nothing
122119
& Foldable.toList
123-
& MonoidalMap.fromList
120+
& reverse -- Type notes that come later in typechecking have more information filled in.
121+
& foldMap \case
122+
Result.TypeInfo (Context.VarBinding (Symbol.Symbol _ (Var.User v)) loc typ) ->
123+
Cv.annToRange loc & foldMap (\(LSP.Range start end) -> (keyedSingleton v (start, end) typ))
124+
_ -> mempty
124125
& pure
125126
pure (localBindings, typecheckingNotes, Just parsedFile, maybeTypecheckedFile)
126127
Debug.debugM Debug.Temp "Local Bindings" localBindingTypes

‎unison-cli/src/Unison/LSP/Hover.hs

Lines changed: 14 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -5,9 +5,6 @@ module Unison.LSP.Hover where
55

66
import Control.Lens hiding (List)
77
import Control.Monad.Reader
8-
import Data.IntervalMap.Lazy qualified as IM
9-
import Data.IntervalMap.Lazy qualified as IntervalMap
10-
import Data.Map.Monoidal qualified as MonMap
118
import Data.Text qualified as Text
129
import Language.LSP.Protocol.Lens
1310
import Language.LSP.Protocol.Message qualified as Msg
@@ -19,6 +16,7 @@ import Unison.LSP.FileAnalysis (ppedForFile)
1916
import Unison.LSP.FileAnalysis qualified as FileAnalysis
2017
import Unison.LSP.Queries qualified as LSPQ
2118
import Unison.LSP.Types
19+
import Unison.LSP.Util.IntersectionMap qualified as IM
2220
import Unison.LSP.VFS qualified as VFS
2321
import Unison.LabeledDependency qualified as LD
2422
import Unison.Parser.Ann (Ann)
@@ -127,22 +125,21 @@ hoverInfo uri pos =
127125

128126
hoverInfoForLocalVar :: MaybeT Lsp Text
129127
hoverInfoForLocalVar = do
130-
node <- LSPQ.nodeAtPosition uri pos
131-
Debug.debugM Debug.Temp "node" node
132-
localVar <- case node of
133-
LSPQ.TermNode (Term.Var' (Symbol.Symbol _ (Var.User v))) -> pure $ v
134-
LSPQ.TermNode {} -> empty
135-
LSPQ.TypeNode {} -> empty
136-
LSPQ.PatternNode _pat -> empty
128+
let varFromNode = do
129+
node <- LSPQ.nodeAtPosition uri pos
130+
Debug.debugM Debug.Temp "node" node
131+
case node of
132+
LSPQ.TermNode (Term.Var' (Symbol.Symbol _ (Var.User v))) -> pure $ v
133+
LSPQ.TermNode {} -> empty
134+
LSPQ.TypeNode {} -> empty
135+
LSPQ.PatternNode _pat -> empty
136+
let varFromText = VFS.identifierAtPosition uri pos
137+
localVar <- varFromNode <|> varFromText
137138
Debug.debugM Debug.Temp "localVar" localVar
138139
FileAnalysis {localBindingTypes} <- FileAnalysis.getFileAnalysis uri
139-
varContexts <- hoistMaybe $ MonMap.lookup localVar localBindingTypes
140-
141-
Debug.debugM Debug.Temp "varContexts" varContexts
142-
-- An interval contining the exact location of the cursor
143-
let posInterval = (IM.ClosedInterval pos pos)
144-
Debug.debugM Debug.Temp "posInterval" posInterval
145-
(_range, typ) <- hoistMaybe $ IntervalMap.lookupLT posInterval varContexts
140+
Debug.debugM Debug.Temp "pos" pos
141+
Debug.debugM Debug.Temp "localBindingTypes" localBindingTypes
142+
(_range, typ) <- hoistMaybe $ IM.keyedSmallestIntersection localVar pos localBindingTypes
146143
pped <- lift $ ppedForFile uri
147144
pure $ renderTypeSigForHover pped localVar typ
148145

‎unison-cli/src/Unison/LSP/Types.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,6 @@ import Data.Aeson qualified as Aeson
1515
import Data.IntervalMap.Lazy (IntervalMap)
1616
import Data.IntervalMap.Lazy qualified as IM
1717
import Data.Map qualified as Map
18-
import Data.Map.Monoidal (MonoidalMap)
1918
import Ki qualified
2019
import Language.LSP.Logging qualified as LSP
2120
import Language.LSP.Protocol.Lens
@@ -29,6 +28,7 @@ import Unison.Codebase.Path qualified as Path
2928
import Unison.Codebase.Runtime (Runtime)
3029
import Unison.Debug qualified as Debug
3130
import Unison.LSP.Orphans ()
31+
import Unison.LSP.Util.IntersectionMap (KeyedIntersectionMap)
3232
import Unison.LabeledDependency (LabeledDependency)
3333
import Unison.Name (Name)
3434
import Unison.NameSegment (NameSegment)
@@ -129,7 +129,7 @@ data FileAnalysis = FileAnalysis
129129
-- There may be many mentions of the same symbol in the file, and their may be several
130130
-- bindings which shadow each other, use this map to find the smallest spanning position
131131
-- which contains the symbol you're interested in.
132-
localBindingTypes :: MonoidalMap Text (IntervalMap Position (Type Symbol Ann)),
132+
localBindingTypes :: KeyedIntersectionMap Text Position (Type Symbol Ann),
133133
typeSignatureHints :: Map Symbol TypeSignatureHint,
134134
fileSummary :: Maybe FileSummary
135135
}

‎unison-cli/src/Unison/LSP/Util/IntersectionMap.hs

Lines changed: 111 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,111 @@
1+
module Unison.LSP.Util.IntersectionMap
2+
( -- * Intersection map
3+
intersectionsFromList,
4+
intersectionsSingleton,
5+
IntersectionRange (..),
6+
IntersectionMap,
7+
smallestIntersection,
8+
9+
-- * Keyed intersection map
10+
KeyedIntersectionMap,
11+
keyedFromList,
12+
keyedSingleton,
13+
keyedSmallestIntersection,
14+
)
15+
where
16+
17+
import Data.List qualified as List
18+
import Data.Map qualified as Map
19+
import Language.LSP.Protocol.Types qualified as LSP
20+
import Unison.Prelude
21+
import Unison.Util.List (safeHead)
22+
23+
-- | An intersection map where intersections are partitioned by a key.
24+
newtype KeyedIntersectionMap k pos a = KeyedIntersectionMap (Map k (IntersectionMap pos a))
25+
deriving stock (Show, Eq)
26+
27+
instance (Ord k, Ord pos) => Semigroup (KeyedIntersectionMap k pos a) where
28+
KeyedIntersectionMap a <> KeyedIntersectionMap b = KeyedIntersectionMap (Map.unionWith (<>) a b)
29+
30+
instance (Ord k, Ord pos) => Monoid (KeyedIntersectionMap k pos a) where
31+
mempty = KeyedIntersectionMap Map.empty
32+
33+
keyedFromList :: (Ord k, IntersectionRange pos) => [(k, ((pos, pos), a))] -> KeyedIntersectionMap k pos a
34+
keyedFromList elems =
35+
KeyedIntersectionMap $
36+
elems
37+
& fmap (\(k, (range, v)) -> (k, intersectionsSingleton range v))
38+
& Map.fromListWith (<>)
39+
40+
keyedSingleton :: (Ord k, IntersectionRange pos) => k -> (pos, pos) -> a -> KeyedIntersectionMap k pos a
41+
keyedSingleton k range a = keyedFromList [(k, (range, a))]
42+
43+
-- | NOTE: Assumes that ranges only NEST and never overlap, which is an invariant that should
44+
-- be maintained by the ABT annotations.
45+
--
46+
-- Returns the value associated with the tightest span which intersects with the given position.
47+
keyedSmallestIntersection :: (Ord k, IntersectionRange pos) => k -> pos -> KeyedIntersectionMap k pos a -> Maybe ((pos, pos), a)
48+
keyedSmallestIntersection k p (KeyedIntersectionMap m) = do
49+
intersections <- Map.lookup k m
50+
smallestIntersection p intersections
51+
52+
newtype IntersectionMap pos a = IntersectionMap (Map (pos, pos) a)
53+
deriving stock (Show, Eq)
54+
55+
instance (Ord pos) => Semigroup (IntersectionMap pos a) where
56+
IntersectionMap a <> IntersectionMap b = IntersectionMap (a <> b)
57+
58+
instance (Ord pos) => Monoid (IntersectionMap pos a) where
59+
mempty = IntersectionMap mempty
60+
61+
-- | Class for types that can be used as ranges for intersection maps.
62+
class Ord pos => IntersectionRange pos where
63+
intersects :: pos -> (pos, pos) -> Bool
64+
65+
-- Returns true if the first bound is tighter than the second.
66+
isTighterThan :: (pos, pos) -> (pos, pos) -> Bool
67+
68+
instance IntersectionRange LSP.Position where
69+
intersects (LSP.Position l c) ((LSP.Position lStart cStart), (LSP.Position lEnd cEnd)) =
70+
(l >= lStart && l <= lEnd)
71+
&& if
72+
| l == lStart && l == lEnd -> c >= cStart && c <= cEnd
73+
| l == lStart -> c >= cStart
74+
| l == lEnd -> c <= cEnd
75+
| otherwise -> True
76+
77+
((LSP.Position lStartA cStartA), (LSP.Position lEndA cEndA)) `isTighterThan` ((LSP.Position lStartB cStartB), (LSP.Position lEndB cEndB)) =
78+
if lStartA == lStartB && lEndA == lEndB
79+
then cStartA >= cStartB && cEndA <= cEndB
80+
else lStartA >= lStartB && lEndA <= lEndB
81+
82+
-- | Construct an intersection map from a list of ranges and values.
83+
-- Duplicates are dropped.
84+
intersectionsFromList :: (Ord pos) => [((pos, pos), a)] -> IntersectionMap pos a
85+
intersectionsFromList elems =
86+
IntersectionMap $ Map.fromList elems
87+
88+
intersectionsSingleton :: (pos, pos) -> a -> IntersectionMap pos a
89+
intersectionsSingleton range a = IntersectionMap $ Map.singleton range a
90+
91+
-- | NOTE: Assumes that ranges only NEST and never overlap, which is an invariant that should
92+
-- be maintained by the ABT annotations.
93+
--
94+
-- Returns the value associated with the tightest span which intersects with the given position.
95+
--
96+
-- >>> smallestIntersection (LSP.Position 5 1) (intersectionsFromList [((LSP.Position 1 1, LSP.Position 3 1), "a"), ((LSP.Position 2 1, LSP.Position 8 1), "b"), ((LSP.Position 4 1, LSP.Position 6 1), "c")])
97+
-- Just ((Position {_line = 4, _character = 1},Position {_line = 6, _character = 1}),"c")
98+
-- >>> smallestIntersection (LSP.Position 5 3) (intersectionsFromList [((LSP.Position 1 1, LSP.Position 3 1), "a"), ((LSP.Position 4 2, LSP.Position 6 5), "b"), ((LSP.Position 4 1, LSP.Position 6 6), "c"), ((LSP.Position 7 1, LSP.Position 9 1), "d")])
99+
-- Just ((Position {_line = 4, _character = 2},Position {_line = 6, _character = 5}),"b")
100+
smallestIntersection :: IntersectionRange pos => pos -> IntersectionMap pos a -> Maybe ((pos, pos), a)
101+
smallestIntersection p (IntersectionMap bounds) =
102+
bounds
103+
& Map.filterWithKey (\b _ -> p `intersects` b)
104+
& Map.toList
105+
& List.sortBy cmp
106+
& safeHead
107+
where
108+
cmp (a, _) (b, _) =
109+
if a `isTighterThan` b
110+
then LT
111+
else GT

‎unison-cli/unison-cli.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -132,6 +132,7 @@ library
132132
Unison.LSP.Queries
133133
Unison.LSP.Types
134134
Unison.LSP.UCMWorker
135+
Unison.LSP.Util.IntersectionMap
135136
Unison.LSP.VFS
136137
Unison.Main
137138
Unison.Share.Codeserver

0 commit comments

Comments
 (0)