Merge branch 'topic/lal.1026.context_creation_and_memory_cost' into 'master'

Improve context creation and the memory consumption

Closes eng/libadalang/libadalang#1026

See merge request eng/ide/ada_language_server!1775

Author: AdrienBoulanger

source/ada/lsp-ada_contexts.adb

@@ -34,7 +34,6 @@ with GPR2.Build.Source.Sets;
 with VSS.Strings.Conversions;
 
 with Libadalang.Common;           use Libadalang.Common;
-with Libadalang.Project_Provider;
 with Langkit_Support.Slocs;
 
 with Utils.Command_Lines.Common;
@@ -48,7 +47,8 @@ with LSP.Ada_Projects;
 
 package body LSP.Ada_Contexts is
 
-   Indexing_Trace   : constant Trace_Handle := Create ("ALS.INDEXING", Off);
+   Indexing_Debug_Trace : constant Trace_Handle :=
+     Create ("ALS.INDEXING.DEBUG", Off);
 
    use type Libadalang.Analysis.Analysis_Unit;
 
@@ -575,10 +575,10 @@ package body LSP.Ada_Contexts is
    ------------------
 
    procedure Load_Project
-     (Self    : in out Context;
-      Tree    : GPR2.Project.Tree.Object;
-      Root    : GPR2.Project.View.Object;
-      Charset : String)
+     (Self     : in out Context;
+      Provider : Libadalang.Project_Provider.GPR2_Provider_And_Projects;
+      Tree     : GPR2.Project.Tree.Object;
+      Charset  : String)
    is
       procedure Update_Source_Files;
       --  Update the value of Self.Source_Files
@@ -677,12 +677,14 @@ package body LSP.Ada_Contexts is
 
       begin
          Self.Source_Files.Clear;
-
-         Process_Closure (Root, Add_Sources_From_View'Access);
-
          Self.Source_Dirs.Clear;
 
-         Process_Closure (Root, Add_Dirs_From_View'Access);
+         --  Iterate on all the projects coexisting inside the Provider
+         --  By design there is no source collision so merge them.
+         for Project of Provider.Projects loop
+            Process_Closure (Project, Add_Sources_From_View'Access);
+            Process_Closure (Project, Add_Dirs_From_View'Access);
+         end loop;
 
          Self.Extension_Set.Clear;
 
@@ -725,7 +727,7 @@ package body LSP.Ada_Contexts is
 
          --  Initialize an gnatpp command line object
 
-         if Root.Check_Attribute
+         if Provider.Projects.First_Element.Check_Attribute
            (Name   => LSP.Ada_Projects.Pretty_Printer.Switches,
             Index  => LSP.Ada_Projects.Pretty_Printer.Ada_Index,
             Result => Attribute)
@@ -776,13 +778,11 @@ package body LSP.Ada_Contexts is
       --  sharing the same name. For example for GNATTest stubs.
       Self.Id := VSS.Strings.Conversions.To_Virtual_String
         (URIs.Conversions.From_File
-           (String (Root.Path_Name.Value)));
+           (String (Provider.Projects.First_Element.Path_Name.Value)));
       Self.Tree := Tree;
       Self.Charset := Ada.Strings.Unbounded.To_Unbounded_String (Charset);
 
-      Self.Unit_Provider :=
-        Libadalang.Project_Provider.Create_Project_Unit_Provider
-          (Tree => Tree, Project => Root);
+      Self.Unit_Provider := Provider.Provider;
 
       Self.Event_Handler := Libadalang.Analysis.Create_Event_Handler_Reference
         (LSP_Context_Event_Handler_Type'(Tracer => Self.Tracer));
@@ -791,7 +791,11 @@ package body LSP.Ada_Contexts is
       Update_Source_Files;
 
       Pretty_Printer_Setup;
-      Self.Format_Options := Gnatformat.Configuration.From_Project (Root);
+      --  Choose the first project in case of aggregate context, assuming
+      --  they all share the gnatformat options.
+      Self.Format_Options :=
+        Gnatformat.Configuration.From_Project
+          (Provider.Projects.First_Element);
    end Load_Project;
 
    ------------
@@ -846,7 +850,7 @@ package body LSP.Ada_Contexts is
       --  Add a trace before the call to Get_AU, so we can see in the traces
       --  the memory being consumed by Get_AU + Indexing for this file.
       Trace
-        (Indexing_Trace,
+        (Indexing_Debug_Trace,
          "Indexing " & (if PLE then "(PLE) " else "") &
            File.Display_Full_Name);
 
@@ -856,7 +860,7 @@ package body LSP.Ada_Contexts is
          Unit := Self.Get_AU (File, Reparse => Reparse);
 
          if Unit = Libadalang.Analysis.No_Analysis_Unit then
-            Trace (Indexing_Trace, "No AU found: not indexing");
+            Trace (Indexing_Debug_Trace, "No AU found: not indexing");
             return;
          end if;
 
@@ -867,12 +871,24 @@ package body LSP.Ada_Contexts is
          end if;
 
          Trace
-           (Indexing_Trace,
+           (Indexing_Debug_Trace,
             "Done indexing." & Integer'Image (Unit.Diagnostics'Length) &
               " diagnostic(s) found.");
       end;
    end Index_File;
 
+   ---------------------------
+   -- Add_Invisible_Symbols --
+   ---------------------------
+
+   procedure Add_Invisible_Symbols
+     (Self : in out Context;
+      File : GNATCOLL.VFS.Virtual_File;
+      Unit : Libadalang.Analysis.Analysis_Unit) is
+   begin
+      Self.Source_Files.Index_File (File, Unit);
+   end Add_Invisible_Symbols;
+
    ------------------
    -- Include_File --
    ------------------
@@ -970,14 +986,17 @@ package body LSP.Ada_Contexts is
    begin
       Is_Known := False;
 
-      if View.Check_Attribute
+      if View.Is_Defined then
+
+         if View.Check_Attribute
            (Name   => Attribute,
             Index  => Attribute_Index,
             Result => Attribute_Value)
-      then
-         Is_List_Attribute := (Attribute_Value.Kind = List);
-         Is_Known := True;
-         return Convert (Attribute_Value.Values);
+         then
+            Is_List_Attribute := (Attribute_Value.Kind = List);
+            Is_Known := True;
+            return Convert (Attribute_Value.Values);
+         end if;
       end if;
 
       return [];

source/ada/lsp-ada_contexts.ads

@@ -33,6 +33,7 @@ with Laltools.Common;
 
 with Libadalang.Analysis;
 with Libadalang.Common;
+with Libadalang.Project_Provider;
 
 with Utils.Command_Lines;
 with Pp.Command_Lines;
@@ -66,10 +67,10 @@ package LSP.Ada_Contexts is
    --  in particular.
 
    procedure Load_Project
-     (Self    : in out Context;
-      Tree    : GPR2.Project.Tree.Object;
-      Root    : GPR2.Project.View.Object;
-      Charset : String);
+     (Self     : in out Context;
+      Provider : Libadalang.Project_Provider.GPR2_Provider_And_Projects;
+      Tree     : GPR2.Project.Tree.Object;
+      Charset  : String);
    --  Use the given project tree, and root project within this project
    --  tree, as project for this context. Root must be a non-aggregate
    --  project tree representing the root of a hierarchy inside Tree.
@@ -232,6 +233,13 @@ package LSP.Ada_Contexts is
    --  If PLE is True, Populate_Lexical_Env is called at the end, which will
    --  increase the speed of semantic requests.
 
+   procedure Add_Invisible_Symbols
+     (Self : in out Context;
+      File : GNATCOLL.VFS.Virtual_File;
+      Unit : Libadalang.Analysis.Analysis_Unit);
+   --  Add invisible symbols present in Unit to the given context's cache,
+   --  even if Unit is not known by this context.
+
    procedure Include_File
      (Self : in out Context; File : GNATCOLL.VFS.Virtual_File);
    --  Includes File in Self's source files
@@ -342,7 +350,7 @@ private
       --  Indicate that this is a "fallback" context, ie the context
       --  holding any file, in the case no valid project was loaded.
 
-      Tree           : GPR2.Project.Tree.Object;
+      Tree           : GPR2.Project.Tree.Object := GPR2.Project.Tree.Undefined;
       --  The loaded project tree: we need to keep a reference to this
       --  in order to figure out which files are Ada and which are not.
 

source/ada/lsp-ada_handlers-project_loading.adb

@@ -35,6 +35,7 @@ pragma Warnings (Off, "unit ""GPR2.Build.Source.Sets"" is not referenced");
 with GPR2.Build.Source.Sets;
 
 with Libadalang.Preprocessing;
+with Libadalang.Project_Provider;
 with LSP.Ada_Contexts;
 with LSP.Ada_Context_Sets;
 with LSP.Ada_Documents; use LSP.Ada_Documents;
@@ -349,9 +350,23 @@ package body LSP.Ada_Handlers.Project_Loading is
       end if;
 
       Reload_Implicit_Project_Dirs (Self);
-      C.Load_Project (Self.Project_Tree,
-                      Self.Project_Tree.Root_Project,
-                      "iso-8859-1");
+
+      --  Create a basic GPR2_Provider_And_Projects containing only the
+      --  implicit project and load it.
+      declare
+         Provider : Libadalang.Project_Provider.GPR2_Provider_And_Projects :=
+           (Provider =>
+              Libadalang.Project_Provider.Create_Project_Unit_Provider
+                (Tree    => Self.Project_Tree,
+                 Project => Self.Project_Tree.Root_Project),
+            Projects => <>);
+      begin
+         Provider.Projects.Append (Self.Project_Tree.Root_Project);
+         C.Load_Project
+           (Provider => Provider,
+            Tree     => Self.Project_Tree,
+            Charset  => "iso-8859-1");
+      end;
 
       Update_Project_Predefined_Sources (Self);
 
@@ -373,6 +388,7 @@ package body LSP.Ada_Handlers.Project_Loading is
       Environment     : GPR2.Environment.Object;
       Charset         : VSS.Strings.Virtual_String)
    is
+      use Libadalang.Project_Provider;
       use type VSS.Strings.Virtual_String;
       use type GNATCOLL.VFS.Virtual_File;
 
@@ -384,8 +400,11 @@ package body LSP.Ada_Handlers.Project_Loading is
       Root            : GNATCOLL.VFS.Virtual_File;
 
       procedure Create_Context_For_Non_Aggregate
-        (View : GPR2.Project.View.Object);
+        (View     : GPR2.Project.View.Object;
+         Provider : GPR2_Provider_And_Projects);
       --  Create a new context for the given project view.
+      --  It will use the same LAL provider (Provider.Provider) for the all the
+      --  subprojects (Provider.Projects)
 
       procedure Log_GPR2_Diagnostics;
       --  Log the GPR2 messages
@@ -395,7 +414,8 @@ package body LSP.Ada_Handlers.Project_Loading is
       --------------------------------------
 
       procedure Create_Context_For_Non_Aggregate
-        (View : GPR2.Project.View.Object)
+        (View     : GPR2.Project.View.Object;
+         Provider : GPR2_Provider_And_Projects)
       is
          use LSP.Ada_Context_Sets;
          use LSP.Ada_Contexts;
@@ -453,12 +473,12 @@ package body LSP.Ada_Handlers.Project_Loading is
             Follow_Symlinks => Self.Configuration.Follow_Symlinks);
 
          C.Load_Project
-           (Tree    => Self.Project_Tree,
-            Root    => View,
-            Charset => VSS.Strings.Conversions.To_UTF_8_String (Charset));
+           (Provider => Provider,
+            Tree     => Self.Project_Tree,
+            Charset  => VSS.Strings.Conversions.To_UTF_8_String (Charset));
 
          Tracer.Trace ("Prepend Context Id: "
-                            & VSS.Strings.Conversions.To_UTF_8_String (C.Id));
+                       & VSS.Strings.Conversions.To_UTF_8_String (C.Id));
          Self.Contexts.Prepend (C);
       end Create_Context_For_Non_Aggregate;
 
@@ -599,12 +619,33 @@ package body LSP.Ada_Handlers.Project_Loading is
          Update_Project_Predefined_Sources (Self);
 
          if Self.Project_Tree.Root_Project.Kind in GPR2.Aggregate_Kind then
-            for View of Self.Project_Tree.Root_Project.Aggregated loop
-               Create_Context_For_Non_Aggregate (View);
-            end loop;
+            --  For aggregated root project, use LAL to create sets of
+            --  aggregated projects and sub-projects which can coexist in
+            --  the same LAL provider to reduce the memory footprint.
+            declare
+               Providers : GPR2_Provider_And_Projects_Array_Access :=
+                 Create_Project_Unit_Providers (Self.Project_Tree);
+            begin
+               for Provider of Providers.all loop
+                  Create_Context_For_Non_Aggregate
+                    (View     => Self.Project_Tree.Root_Project,
+                     Provider => Provider);
+               end loop;
+               Free (Providers);
+            end;
          else
-            Create_Context_For_Non_Aggregate
-              (Self.Project_Tree.Root_Project);
+            declare
+               Provider : GPR2_Provider_And_Projects :=
+                 (Provider => Create_Project_Unit_Provider
+                    (Tree    => Self.Project_Tree,
+                     Project => Self.Project_Tree.Root_Project),
+                  Projects => <>);
+            begin
+               Provider.Projects.Append (Self.Project_Tree.Root_Project);
+               Create_Context_For_Non_Aggregate
+                 (View     => Self.Project_Tree.Root_Project,
+                  Provider => Provider);
+            end;
          end if;
       end if;
 
@@ -680,17 +721,16 @@ package body LSP.Ada_Handlers.Project_Loading is
          end loop;
       end loop;
 
-      if Runtime_Indexing.Is_Active then
+      --  Avoid indexing the runtime in case of aggregate projects:
+      --  runtime files are present in all contexts, indexing them
+      --  in all contexts would cost too much memory
+      if Runtime_Indexing.Is_Active
+        and then Self.Project_Tree.Is_Defined
+        and then Self.Project_Tree.Root_Project.Kind not in GPR2.Aggregate_Kind
+      then
          --  Mark all the predefined sources too (runtime)
          for F in Self.Project_Predefined_Sources.Iterate loop
-            declare
-               File : GNATCOLL.VFS.Virtual_File
-                 renames LSP.Ada_File_Sets.File_Sets.Element (F);
-            begin
-               for Context of Self.Contexts.Each_Context loop
-                  Files.Include (File);
-               end loop;
-            end;
+            Files.Include (LSP.Ada_File_Sets.File_Sets.Element (F));
          end loop;
       end if;
 

source/ada/lsp-ada_handlers-renaming.adb

@@ -173,6 +173,7 @@ package body LSP.Ada_Handlers.Renaming is
          elsif Versioned_Documents then
 
             Result.documentChanges.Append (Item);
+            --  Here we should avoid/remove duplicates
 
          else
 
@@ -183,7 +184,12 @@ package body LSP.Ada_Handlers.Renaming is
             end if;
 
             for X of Item.Variant_1.edits loop
-               Result.changes (URI).Append (X.TextEdit);
+               --  Search if this exact textEdit was already added by
+               --  another context
+               if not Result.changes (URI).Find (X.TextEdit).Has_Element
+               then
+                  Result.changes (URI).Append (X.TextEdit);
+               end if;
             end loop;
          end if;
       end Append;