parser: scope stage

QSParse/ParserGeneric.fs

@@ -70,17 +70,18 @@ type DocumentHighlightKind =
 type VarHighlightKind =
     | ReadAccess
     | WriteAccess
-// type Var =
+
 type VarHighlights =
     {
-        Ma: Map<Ast.Var, (Tokens.InlineRange * VarHighlightKind) list>
-        Ranges: (Tokens.InlineRange * Ast.Var) list
+        VarScopeSystem: Scope.ScopeSystem<Ast.Var, Tokens.InlineRange * VarHighlightKind>
+        Ranges: (Tokens.InlineRange * Scope.VarId) list
     }
 let varHighlightsEmpty =
     {
-        Ma = Map.empty
+        VarScopeSystem = Scope.scopeSystemEmpty
         Ranges = []
     }
+
 type LocHighlights =
     {
         Ma: Map<Ast.LocationName, (Tokens.InlineRange * VarHighlightKind) list>
@@ -167,13 +168,23 @@ let appendVarHighlight (r:Tokens.InlineRange) (var:Ast.Var) highlightKind =
                 {
                     st.Highlights with
                         VarHighlights =
-                            {
-                                Ranges = (r, var)::st.Highlights.VarHighlights.Ranges
-                                Ma =
-                                    let v = r, highlightKind
-                                    st.Highlights.VarHighlights.Ma
-                                    |> Map.addOrMod var [v] (fun xs -> v::xs)
-                            }
+                            let varHighlights = st.Highlights.VarHighlights
+
+                            match highlightKind with
+                            | ReadAccess ->
+                                let v = r, highlightKind
+                                let varId, ss = Scope.addAsRead (var, (fun xs -> v::xs)) varHighlights.VarScopeSystem
+                                {
+                                    Ranges = (r, varId)::st.Highlights.VarHighlights.Ranges
+                                    VarScopeSystem = ss
+                                }
+                            | WriteAccess ->
+                                let v = r, highlightKind
+                                let varId, ss = Scope.addAsWrite (var, v) varHighlights.VarScopeSystem
+                                {
+                                    Ranges = (r, varId)::st.Highlights.VarHighlights.Ranges
+                                    VarScopeSystem = ss
+                                }
                 }
         }
     )

QSParse/QSParse.fsproj

@@ -13,6 +13,7 @@
   </ItemGroup>
   <ItemGroup>
     <None Include="App.config" />
+    <Compile Include="Scope.fs" />
     <Compile Include="Defines.fs" />
     <Compile Include="Ast.fs" />
     <Compile Include="Tokens.fs" />

QSParse/Scope.fs

@@ -0,0 +1,104 @@
+module Qsp.Parser.Scope
+open FsharpMyExtension
+
+type VarId = int
+type 'VarName Scopes when 'VarName : comparison = Map<'VarName, VarId> list
+
+type ScopeSystem<'VarName, 'Value> when 'VarName : comparison =
+    {
+        Scopes: 'VarName Scopes
+        NewVarId: VarId
+        Result : Map<VarId, 'VarName * 'Value list>
+    }
+let scopeSystemEmpty =
+    {
+        Scopes = [Map.empty]
+        NewVarId = 0
+        Result = Map.empty
+    }
+let addAsRead (varName:'VarName, getValue) (scopeSystem: ScopeSystem<_,_>) =
+    let result = scopeSystem.Result
+    let rec f acc (scopes:_ Scopes) =
+        match scopes with
+        | [m] ->
+            match Map.tryFind varName m with
+            | Some varId ->
+                let result =
+                    let x = mapSnd getValue result.[varId]
+                    Map.add varId x result
+                let scopes =
+                    List.fold (fun xs x -> x::xs) scopes acc
+                let x =
+                    {
+                        Scopes = scopes
+                        NewVarId = scopeSystem.NewVarId
+                        Result = result
+                    }
+                varId, x
+            | None ->
+                let m = Map.add varName scopeSystem.NewVarId m
+                let result =
+                    Map.add scopeSystem.NewVarId (varName, getValue []) result
+                let scopes =
+                    List.fold (fun xs x -> x::xs) [m] acc
+                let x =
+                    {
+                        Scopes = scopes
+                        NewVarId = scopeSystem.NewVarId + 1
+                        Result = result
+                    }
+                scopeSystem.NewVarId, x
+        | m::ms ->
+            match Map.tryFind varName m with
+            | Some varId ->
+                let result =
+                    let x = mapSnd getValue result.[varId]
+                    Map.add varId x result
+                let scopes =
+                    List.fold (fun xs x -> x::xs) scopes acc
+                let x =
+                    {
+                        Scopes = scopes
+                        NewVarId = scopeSystem.NewVarId
+                        Result = result
+                    }
+                varId, x
+            | None ->
+                f (m::acc) ms
+        | [] -> failwith "the scope cannot be empty"
+    f [] scopeSystem.Scopes
+
+let addAsWrite (varName, value) (scopeSystem: ScopeSystem<_,_>) =
+    match scopeSystem.Scopes with
+    | m::ms ->
+        let newVarId = scopeSystem.NewVarId
+        let m = Map.add varName newVarId m // that's ok: variables can be overwritten
+        let result =
+            Map.add newVarId (varName, [value]) scopeSystem.Result
+        let scopes = m::ms
+        let x =
+            {
+                NewVarId = newVarId + 1
+                Scopes = scopes
+                Result = result
+            }
+        newVarId, x
+    | [] -> failwith "the scope cannot be empty"
+
+let appendScope (scopes:_ Scopes) = Map.empty::scopes
+
+let removeScope (scopes:_ Scopes) =
+    match scopes with
+    | x::xs -> xs
+    | [] -> failwith "scopes is empty"
+
+let test () =
+    let init =
+        {
+            Scopes = [Map.empty]
+            NewVarId = 0
+            Result = Map.empty
+        }
+
+    let (_, x) = addAsRead ("x", (fun xs -> (0, 0)::xs)) init
+    addAsRead ("x", (fun xs -> (0, 0)::xs)) x

QspServer/Program.fs

@@ -254,8 +254,10 @@ type BackgroundServiceServer(state: State, client: FsacClient) =
             else
                 false
         )
-        |> Option.map (fun (_, var) ->
-            Map.find var highlights.VarHighlights.Ma) // находить должно всегда
+        |> Option.map (fun (_, varId) ->
+            Map.find varId highlights.VarHighlights.VarScopeSystem.Result // находить должно всегда
+            |> snd
+        )
     let getLocHighlight (pos:Position) =
         highlights.LocHighlights.Ranges
         |> List.tryFind (fun (r, _) ->