Add pattern-variable inlay hints and map hint rendering

pchalamet · pchalamet · commit 7f72d30729f4 · 2026-02-14T09:00:21.000+01:00
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -2,6 +2,12 @@
 
 All notable changes to FScript are documented in this file.
 
+## [0.29.0]
+
+- Improved LSP inlay/type rendering for map-related inference (`int|string` map-key domain and `unknown map` display).
+- Added LSP inlay type hints for pattern-bound variables (for example `| Some x ->` now shows `x: int`).
+- Added regression coverage for map-key/type inlay rendering and option-pattern variable inlay hints.
+
 ## [0.28.0]
 
 - Added local variable type hover in LSP.
diff --git a/src/FScript.Language/TypeInfer.fs b/src/FScript.Language/TypeInfer.fs
@@ -348,6 +348,7 @@ module TypeInfer =
         | PWildcard _ -> Map.empty, Types.freshVar()
         | PVar (name, _) ->
             let tv = Types.freshVar()
+            recordLocalVariableDeclaration name (Ast.spanOfPattern pat) tv
             Map.ofList [ name, tv ], tv
         | PLiteral (lit, _) ->
             let t =
@@ -691,13 +692,15 @@ module TypeInfer =
                 let caseBoundNames = envPat |> Map.toList |> List.map fst
                 let sBody, tBody, _ =
                     withLocalBindings caseBoundNames (fun () ->
+                        let mutable envBodyCase = envCase'
                         match guard with
                         | Some guardExpr ->
-                            let sGuard, tGuard, _ = inferExpr typeDefs constructors envCase' guardExpr
+                            let sGuard, tGuard, _ = inferExpr typeDefs constructors envBodyCase guardExpr
                             let sGuardBool = unify typeDefs (applyType sGuard tGuard) TBool caseSpan
                             sAcc <- compose sGuardBool (compose sGuard sAcc)
+                            envBodyCase <- applyEnv (compose sGuardBool sGuard) envBodyCase
                         | None -> ()
-                        inferExpr typeDefs constructors envCase' body)
+                        inferExpr typeDefs constructors envBodyCase body)
                 let tBody' = applyType sBody tBody
                 resultTypeOpt <-
                     match resultTypeOpt with
@@ -1069,10 +1072,11 @@ module TypeInfer =
                         let s1, t1, _ = inferExpr typeDefs constructors env exprVal
                         applySubstToCapturedLocals startIndex s1
                         let env' = applyEnv s1 env
-                        validateMapKeyTypes span t1
-                        let scheme = Types.generalize env' t1
+                        let inferred = applyType s1 t1
+                        validateMapKeyTypes span inferred
+                        let scheme = Types.generalize env' inferred
                         env <- env' |> Map.add name scheme
-                        typed.Add(TSLet(name, exprVal, t1, false, isExported, span))
+                        typed.Add(TSLet(name, exprVal, inferred, false, isExported, span))
                 | SLetRecGroup(bindings, isExported, span) ->
                     let startIndex =
                         match telemetry with
diff --git a/src/FScript.LanguageServer/LspHandlers.fs b/src/FScript.LanguageServer/LspHandlers.fs
@@ -266,6 +266,22 @@ module LspHandlers =
                         hint["paddingLeft"] <- JsonValue.Create(true)
                         hints.Add(hint :> JsonNode))
 
+                // Type hints for pattern-bound variables (for example: `Some x`).
+                doc.PatternTypeHints
+                |> List.iter (fun (span, label) ->
+                    let hintLine = max 0 (span.End.Line - 1)
+                    let hintChar = max 0 (span.End.Column - 1)
+                    if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then
+                        let hint = JsonObject()
+                        let pos = JsonObject()
+                        pos["line"] <- JsonValue.Create(hintLine)
+                        pos["character"] <- JsonValue.Create(hintChar)
+                        hint["position"] <- pos
+                        hint["label"] <- JsonValue.Create(label)
+                        hint["kind"] <- JsonValue.Create(1)
+                        hint["paddingLeft"] <- JsonValue.Create(true)
+                        hints.Add(hint :> JsonNode))
+
                 for lineIndex = 0 to lines.Length - 1 do
                     let lineText = lines[lineIndex].TrimEnd('\r')
                     let mutable i = 0
diff --git a/src/FScript.LanguageServer/LspModel.fs b/src/FScript.LanguageServer/LspModel.fs
@@ -57,6 +57,7 @@ module LspModel =
           ParameterTypeTargets: Map<string, string>
           FunctionParameters: Map<string, string list>
           ParameterTypeHints: (Span * string) list
+          PatternTypeHints: (Span * string) list
           LocalVariableTypeHints: (Span * string * string) list
           // Variable occurrences keyed by identifier, sourced from AST spans.
           // This avoids text-based false positives (for example record field labels).
diff --git a/src/FScript.LanguageServer/LspSymbols.fs b/src/FScript.LanguageServer/LspSymbols.fs
@@ -8,6 +8,60 @@ open FScript.Language
 module LspSymbols =
     open LspModel
 
+    let private collectMapKeyDomainVars (t: Type) =
+        let rec collect acc ty =
+            match ty with
+            | TMap (TVar v, valueType) ->
+                collect (Set.add v acc) valueType
+            | TMap (keyType, valueType) ->
+                collect (collect acc keyType) valueType
+            | TList inner
+            | TOption inner -> collect acc inner
+            | TTuple items ->
+                items |> List.fold collect acc
+            | TRecord fields ->
+                fields |> Map.values |> Seq.fold collect acc
+            | TFun (a, b) ->
+                collect (collect acc a) b
+            | _ -> acc
+
+        collect Set.empty t
+
+    let private lspTypeToStringWithKeyDomainVars (keyDomainVars: Set<int>) (t: Type) =
+        let rec go t =
+            match t with
+            | TUnit -> "unit"
+            | TInt -> "int"
+            | TFloat -> "float"
+            | TBool -> "bool"
+            | TString -> "string"
+            | TList t1 -> sprintf "%s list" (postfixArg t1)
+            | TTuple ts -> ts |> List.map go |> String.concat " * " |> sprintf "(%s)"
+            | TRecord fields ->
+                fields
+                |> Map.toList
+                |> List.map (fun (name, fieldType) -> sprintf "%s: %s" name (go fieldType))
+                |> String.concat "; "
+                |> sprintf "{ %s }"
+            | TMap (_, tv) ->
+                sprintf "%s map" (postfixArg tv)
+            | TOption t1 -> sprintf "%s option" (postfixArg t1)
+            | TFun (a, b) -> sprintf "(%s -> %s)" (go a) (go b)
+            | TNamed n -> n
+            | TUnion (name, _) -> name
+            | TTypeToken -> "type"
+            | TVar v when Set.contains v keyDomainVars -> "int|string"
+            | TVar _ -> "unknown"
+        and postfixArg t =
+            match t with
+            | TFun _ | TTuple _ | TRecord _ -> sprintf "(%s)" (go t)
+            | _ -> go t
+        go t
+
+    let private lspTypeToString (t: Type) =
+        let keyDomainVars = collectMapKeyDomainVars t
+        lspTypeToStringWithKeyDomainVars keyDomainVars t
+
     let rec private typeRefToString (typeRef: TypeRef) =
         match typeRef with
         | TRName name -> name
@@ -91,15 +145,15 @@ module LspSymbols =
             | true, TypeInfer.TSLet(_, _, t, _, _, _) ->
                 { Name = name
                   Kind = symbolKindForType t
-                  TypeText = Some (Types.typeToString t)
+                  TypeText = Some (lspTypeToString t)
                   TypeTargetName = typeTargetFromType t
                   Span = span }
             | true, TypeInfer.TSLetRecGroup(bindings, _, _) ->
                 match bindings |> List.tryFind (fun (n, _, _, _) -> n = name) with
                 | Some (_, _, t, _) ->
                     { Name = name
                       Kind = symbolKindForType t
-                      TypeText = Some (Types.typeToString t)
+                      TypeText = Some (lspTypeToString t)
                       TypeTargetName = typeTargetFromType t
                       Span = span }
                 | None ->
@@ -419,13 +473,14 @@ module LspSymbols =
             match typedByName.TryGetValue(name) with
             | true, t when not parameters.IsEmpty ->
                 let argTypes = takeParamTypes t parameters.Length
+                let keyDomainVars = collectMapKeyDomainVars t
                 (parameters, argTypes)
                 ||> List.zip
                 |> List.choose (fun (param, argType) ->
                     if param.Annotation.IsSome then
                         None
                     else
-                        Some (param.Span, $": {Types.typeToString argType}"))
+                        Some (param.Span, $": {lspTypeToStringWithKeyDomainVars keyDomainVars argType}"))
             | _ ->
                 []
 
@@ -445,6 +500,134 @@ module LspSymbols =
             | _ ->
                 [])
 
+    let private collectPatternVariableSpans (program: Program) =
+        let rec collectPattern (acc: (string * Span) list) (pattern: Pattern) =
+            match pattern with
+            | PVar (name, span) ->
+                (name, span) :: acc
+            | PCons (head, tail, _) ->
+                collectPattern (collectPattern acc head) tail
+            | PTuple (items, _) ->
+                items |> List.fold collectPattern acc
+            | PRecord (fields, _) ->
+                fields |> List.fold (fun state (_, p) -> collectPattern state p) acc
+            | PMap (clauses, tailOpt, _) ->
+                let withClauses =
+                    clauses
+                    |> List.fold (fun state (k, v) ->
+                        let withKey = collectPattern state k
+                        collectPattern withKey v) acc
+                match tailOpt with
+                | Some tail -> collectPattern withClauses tail
+                | None -> withClauses
+            | PSome (inner, _) ->
+                collectPattern acc inner
+            | PUnionCase (_, _, payload, _) ->
+                match payload with
+                | Some p -> collectPattern acc p
+                | None -> acc
+            | PWildcard _
+            | PLiteral _
+            | PNil _
+            | PNone _
+            | PTypeRef _ -> acc
+
+        let rec collectExpr (acc: (string * Span) list) (expr: Expr) =
+            match expr with
+            | EMatch (scrutinee, cases, _) ->
+                let withScrutinee = collectExpr acc scrutinee
+                cases
+                |> List.fold (fun state (pat, guard, body, _) ->
+                    let withPattern = collectPattern state pat
+                    let withGuard =
+                        match guard with
+                        | Some g -> collectExpr withPattern g
+                        | None -> withPattern
+                    collectExpr withGuard body) withScrutinee
+            | ELambda (_, body, _) ->
+                collectExpr acc body
+            | EApply (f, a, _) ->
+                collectExpr (collectExpr acc f) a
+            | EIf (c, t, f, _) ->
+                collectExpr (collectExpr (collectExpr acc c) t) f
+            | ERaise (inner, _) ->
+                collectExpr acc inner
+            | EFor (_, source, body, _) ->
+                collectExpr (collectExpr acc source) body
+            | ELet (_, value, body, _, _) ->
+                collectExpr (collectExpr acc value) body
+            | ELetRecGroup (bindings, body, _) ->
+                let withBindings =
+                    bindings |> List.fold (fun state (_, _, value, _) -> collectExpr state value) acc
+                collectExpr withBindings body
+            | EList (items, _)
+            | ETuple (items, _) ->
+                items |> List.fold collectExpr acc
+            | ERange (startExpr, endExpr, _) ->
+                collectExpr (collectExpr acc startExpr) endExpr
+            | ERecord (fields, _)
+            | EStructuralRecord (fields, _) ->
+                fields |> List.fold (fun state (_, value) -> collectExpr state value) acc
+            | EMap (entries, _) ->
+                entries
+                |> List.fold (fun state entry ->
+                    match entry with
+                    | MEKeyValue (k, v) ->
+                        collectExpr (collectExpr state k) v
+                    | MESpread spread ->
+                        collectExpr state spread) acc
+            | ERecordUpdate (baseExpr, fields, _)
+            | EStructuralRecordUpdate (baseExpr, fields, _) ->
+                let withBase = collectExpr acc baseExpr
+                fields |> List.fold (fun state (_, value) -> collectExpr state value) withBase
+            | EFieldGet (target, _, _) ->
+                collectExpr acc target
+            | EIndexGet (target, key, _)
+            | ECons (target, key, _)
+            | EAppend (target, key, _)
+            | EBinOp (_, target, key, _) ->
+                collectExpr (collectExpr acc target) key
+            | ESome (inner, _)
+            | EParen (inner, _) ->
+                collectExpr acc inner
+            | EInterpolatedString (parts, _) ->
+                parts
+                |> List.fold (fun state part ->
+                    match part with
+                    | IPText _ -> state
+                    | IPExpr embedded -> collectExpr state embedded) acc
+            | EUnit _
+            | ELiteral _
+            | EVar _
+            | ENone _
+            | ETypeOf _
+            | ENameOf _ -> acc
+
+        program
+        |> List.fold (fun state stmt ->
+            match stmt with
+            | SLet (_, _, expr, _, _, _) ->
+                collectExpr state expr
+            | SLetRecGroup (bindings, _, _) ->
+                bindings |> List.fold (fun inner (_, _, expr, _) -> collectExpr inner expr) state
+            | SExpr expr ->
+                collectExpr state expr
+            | _ -> state) []
+        |> List.rev
+
+    let private buildPatternTypeHints (program: Program) (localTypes: TypeInfer.LocalVariableTypeInfo list) =
+        let localByNameAndSpan =
+            localTypes
+            |> List.map (fun entry -> (entry.Name, entry.Span.Start.Line, entry.Span.Start.Column, entry.Span.End.Line, entry.Span.End.Column), entry.Type)
+            |> Map.ofList
+
+        collectPatternVariableSpans program
+        |> List.choose (fun (name, span) ->
+            let key = (name, span.Start.Line, span.Start.Column, span.End.Line, span.End.Column)
+            localByNameAndSpan
+            |> Map.tryFind key
+            |> Option.map (fun t -> span, $": {lspTypeToString t}"))
+
     let analyzeDocument (uri: string) (text: string) =
         let sourceName =
             if uri.StartsWith("file://", StringComparison.OrdinalIgnoreCase) then
@@ -459,6 +642,7 @@ module LspSymbols =
         let mutable parameterTypeTargets : Map<string, string> = Map.empty
         let mutable functionParameters : Map<string, string list> = Map.empty
         let mutable parameterTypeHints : (Span * string) list = []
+        let mutable patternTypeHints : (Span * string) list = []
         let mutable localVariableTypeHints : (Span * string * string) list = []
 
         let mutable parsedProgram : Program option = None
@@ -473,23 +657,26 @@ module LspSymbols =
             if isIncludeProgram program then
                 symbols <- buildSymbolsFromProgram program None
                 parameterTypeHints <- buildParameterTypeHints program None
+                patternTypeHints <- []
             else
                 try
                     let typed, localTypes = TypeInfer.inferProgramWithLocalVariableTypes program
                     symbols <- buildSymbolsFromProgram program (Some typed)
                     parameterTypeHints <- buildParameterTypeHints program (Some typed)
+                    patternTypeHints <- buildPatternTypeHints program localTypes
                     localVariableTypeHints <-
                         localTypes
                         |> List.filter (fun entry ->
                             match entry.Span.Start.File with
                             | Some file -> String.Equals(file, sourceName, StringComparison.OrdinalIgnoreCase)
                             | None -> true)
-                        |> List.map (fun entry -> entry.Span, entry.Name, Types.typeToString entry.Type)
+                        |> List.map (fun entry -> entry.Span, entry.Name, lspTypeToString entry.Type)
                 with
                 | TypeException err ->
                     diagnostics.Add(diagnostic 1 "type" err.Span err.Message)
                     symbols <- buildSymbolsFromProgram program None
                     parameterTypeHints <- buildParameterTypeHints program None
+                    patternTypeHints <- []
 
         with
         | ParseException err ->
@@ -512,7 +699,7 @@ module LspSymbols =
                         diagnostics.Add(diagnostic 2 "unused" span $"Unused top-level binding '{name}'")
         | None -> ()
 
-        documents[uri] <- { Text = text; Symbols = symbols; RecordParameterFields = recordParamFields; ParameterTypeTargets = parameterTypeTargets; FunctionParameters = functionParameters; ParameterTypeHints = parameterTypeHints; LocalVariableTypeHints = localVariableTypeHints; VariableOccurrences = occurrences }
+        documents[uri] <- { Text = text; Symbols = symbols; RecordParameterFields = recordParamFields; ParameterTypeTargets = parameterTypeTargets; FunctionParameters = functionParameters; ParameterTypeHints = parameterTypeHints; PatternTypeHints = patternTypeHints; LocalVariableTypeHints = localVariableTypeHints; VariableOccurrences = occurrences }
         publishDiagnostics uri (diagnostics |> Seq.toList)
 
     let tryResolveSymbol (doc: DocumentState) (line: int) (character: int) : TopLevelSymbol option =
diff --git a/tests/FScript.LanguageServer.Tests/LspServerTests.fs b/tests/FScript.LanguageServer.Tests/LspServerTests.fs
