Take supportsCustomValues prop into account

reznikmm · reznikmm · commit c75fe6ef30d2 · 2023-10-02T13:05:42.000+03:00
for enumeration types. For this types generate new string, integer or modular type. Fix corresponding array types and optional array types, I/O subprograms. Refs #1172
diff --git a/source/lsp_gen/lsp_gen-enumerations.adb b/source/lsp_gen/lsp_gen-enumerations.adb
@@ -21,6 +21,65 @@ with LSP_Gen.Puts; use LSP_Gen.Puts;
 package body LSP_Gen.Enumerations is
 
    procedure Write_Type (Enum : LSP_Gen.Entities.Enumeration);
+   procedure Write_Pseudo_Enum (Enum : LSP_Gen.Entities.Enumeration);
+   --  When enumeration supports custom values we can't use enumeration type,
+   --  so instead create new string or integer types and set of functions
+   --  for corresponding literals.
+
+   -----------------------
+   -- Write_Pseudo_Enum --
+   -----------------------
+
+   procedure Write_Pseudo_Enum (Enum : LSP_Gen.Entities.Enumeration) is
+      Last : constant Positive := Enum.values.Length;
+   begin
+      Put ("type ");
+      Put_Id (Enum.name);
+      Put_Line (" is ");
+
+      case Enum.a_type.name is
+         when LSP_Gen.Entities.Enum.string =>
+            Put_Line ("new VSS.Strings.Virtual_String with null record");
+         when LSP_Gen.Entities.Enum.integer =>
+            Put_Line ("new Integer");
+         when LSP_Gen.Entities.Enum.uinteger =>
+            Put_Line ("mod 2 ** 16");
+      end case;
+
+      Put_Line (";");
+      Put_Lines (Enum.documentation.Split_Lines, "   --  ");
+
+      for J in 1 .. Last loop
+         declare
+            Item : constant LSP_Gen.Entities.EnumerationEntry :=
+              Enum.values (J);
+         begin
+            New_Line;
+            Put ("function ");
+            Put_Id (Item.name);
+            Put (" return ");
+            Put_Id (Enum.name);
+            Put (" is (");
+
+            case Item.value.Is_String is
+               when True =>
+                  Put ("""");
+                  Put (Item.value.String);
+                  Put ("""");
+               when False =>
+                  Put (Item.value.Integer);
+            end case;
+
+            Put_Line (");");
+
+            if not Item.documentation.Is_Empty then
+               Put_Lines (Item.documentation.Split_Lines, "  --  ");
+            end if;
+         end;
+      end loop;
+
+      New_Line;
+   end Write_Pseudo_Enum;
 
    ----------------
    -- Write_Type --
@@ -43,8 +102,6 @@ package body LSP_Gen.Enumerations is
             if J /= Last then
                Put (", ");
             end if;
-
---            Put_Lines (Item.documentation.Split_Lines, "  --  ");
          end;
       end loop;
 
@@ -77,11 +134,22 @@ package body LSP_Gen.Enumerations is
    begin
       Put_Lines (Model.License_Header, "--  ");
       New_Line;
+      Put_Line ("with VSS.Strings;");
+      New_Line;
       Put_Line ("package LSP.Enumerations is");
       Put_Line ("   pragma Preelaborate;"); New_Line;
 
       for Name of Model.Enumerations loop
-         Write_Type (Model.Enumeration (Name));
+         declare
+            Enum : constant LSP_Gen.Entities.Enumeration :=
+              Model.Enumeration (Name);
+         begin
+            if Enum.supportsCustomValues then
+               Write_Pseudo_Enum (Enum);
+            else
+               Write_Type (Enum);
+            end if;
+         end;
       end loop;
 
       Put_Line ("end LSP.Enumerations;");
diff --git a/source/lsp_gen/lsp_gen-inputs.adb b/source/lsp_gen/lsp_gen-inputs.adb
@@ -817,6 +817,22 @@ package body LSP_Gen.Inputs is
 
       if Spec then
          Put_Line (";");
+      elsif Info.supportsCustomValues then
+         Put_Line (" is");
+         Put_Line ("begin");
+
+         case Info.a_type.name is
+            when LSP_Gen.Entities.Enum.string =>
+               Put_Line ("Value := (Handler.String_Value with null record);");
+
+            when others =>
+               Put ("Value := LSP.Enumerations.");
+               Put_Id (Name);
+               Put_Line (" (Handler.Number_Value.Integer_Value);");
+         end case;
+
+         Put_Line ("Handler.Read_Next;");
+         Put_Line ("end;");
       else
          Put_Line (" is");
          Put_Line ("begin");
@@ -1562,6 +1578,9 @@ package body LSP_Gen.Inputs is
    is
       use all type LSP_Gen.Mappings.Or_Mapping_Kind;
 
+      function Array_Element return LSP_Gen.Entities.AType is
+        (Tipe.Union.an_array.element.Value);
+
    begin
       if Name = "LSPArray" then
          return;  --  TBD
@@ -1636,7 +1655,12 @@ package body LSP_Gen.Inputs is
                Put_Line (";");
                Put_Line ("begin");
 
-               if Name.Ends_With ("_Set") then
+               if Name.Ends_With ("_Set")
+                 and then
+                   (Array_Element.Union.Kind /= reference
+                     or else not Model.Is_Custom_Enumeration
+                       (Array_Element.Union.reference.name))
+               then
                   Put_Line ("Set := (others => False);");
                   Put_Line ("   while not Handler.Is_End_Array loop");
                   Write_Call (Done, Tipe.Union.an_array.element.Value, "");
diff --git a/source/lsp_gen/lsp_gen-meta_models.adb b/source/lsp_gen/lsp_gen-meta_models.adb
@@ -442,6 +442,19 @@ package body LSP_Gen.Meta_Models is
       end case;
    end Is_Base_Type;
 
+   ---------------------------
+   -- Is_Custom_Enumeration --
+   ---------------------------
+
+   function Is_Custom_Enumeration
+     (Self : Meta_Model'Class;
+      Name : VSS.Strings.Virtual_String) return Boolean is
+   begin
+      return Self.Is_Enumeration (Name) and then
+        Self.Model.enumerations (Self.Index (Name).Position)
+          .supportsCustomValues;
+   end Is_Custom_Enumeration;
+
    --------------------
    -- Is_Enumeration --
    --------------------
diff --git a/source/lsp_gen/lsp_gen-meta_models.ads b/source/lsp_gen/lsp_gen-meta_models.ads
@@ -71,6 +71,11 @@ package LSP_Gen.Meta_Models is
      (Self : Meta_Model'Class;
       Name : VSS.Strings.Virtual_String) return Boolean;
 
+   function Is_Custom_Enumeration
+     (Self : Meta_Model'Class;
+      Name : VSS.Strings.Virtual_String) return Boolean;
+   --  Enumeration type that supports custom values
+
    function Is_Base_Type
      (Self : Meta_Model'Class;
       Tipe : LSP_Gen.Entities.AType) return Boolean;
diff --git a/source/lsp_gen/lsp_gen-outputs.adb b/source/lsp_gen/lsp_gen-outputs.adb
@@ -111,6 +111,8 @@ package body LSP_Gen.Outputs is
       and then Tipe.Union.an_array.element.Value.Union.Kind = reference
       and then Model.Is_Enumeration
         (Tipe.Union.an_array.element.Value.Union.reference.name)
+      and then not Model.Is_Custom_Enumeration
+        (Tipe.Union.an_array.element.Value.Union.reference.name)
       and then not Tipe.Union.an_array.element.Value.Union.reference.name
        .Starts_With ("MarkupKind"));
 
@@ -158,12 +160,12 @@ package body LSP_Gen.Outputs is
       New_Line;
       Put_Line ("with Ada.Containers;");
       Put_Line ("with Interfaces;");
+      Put_Line ("with VSS.Strings;");
       Put_Line ("with LSP.Output_Tools;");
       New_Line;
 
       Put_Line ("package body LSP.Outputs is"); New_Line;
       Put_Line ("pragma Warnings (Off, ""is not referenced"");");
-      Put_Line ("use type Interfaces.Integer_64;"); New_Line;
       Put_Line ("use type Ada.Containers.Count_Type;"); New_Line;
 
       for Cursor in Done.Iterate loop
@@ -299,6 +301,23 @@ package body LSP_Gen.Outputs is
 
       if Spec then
          Put_Line (";");
+
+      elsif Info.supportsCustomValues then
+         Put_Line (" is");
+         Put_Line ("begin");
+
+         case Info.a_type.name is
+            when LSP_Gen.Entities.Enum.string =>
+               Put ("Handler.String_Value");
+               Put_Line (" (VSS.Strings.Virtual_String (Value));");
+
+            when others =>
+               Put ("Handler.Integer_Value (LSP.Enumerations.");
+               Put_Id (Name);
+               Put_Line ("'Pos (Value));");
+         end case;
+
+         Put_Line ("end;");
       else
          Put_Line (" is");
          Put_Line ("begin");
@@ -609,7 +628,11 @@ package body LSP_Gen.Outputs is
       Done  : LSP_Gen.Dependencies.Dependency_Map;
       Name  : VSS.Strings.Virtual_String;
       Tipe  : LSP_Gen.Entities.AType;
-      Spec  : Boolean) is
+      Spec  : Boolean)
+   is
+      function Array_Element return LSP_Gen.Entities.AType is
+        (Tipe.Union.an_array.element.Value);
+
    begin
       if Name = "LSPArray" then
          return;  --  TBD
@@ -656,15 +679,24 @@ package body LSP_Gen.Outputs is
             when an_array =>
                Put_Line ("Handler.Start_Array;");
 
-               if Name.Ends_With ("_Set") then
+               if Array_Element.Union.Kind = reference
+                 and then Model.Is_Custom_Enumeration
+                   (Array_Element.Union.reference.name)
+               then
+                  Put_Line
+                       ("for J in Value.First_Index .. Value.Last_Index loop");
+                  Write_Call (Done, Array_Element, " (J)");
+                  Put_Line ("end loop;");
+
+               elsif Name.Ends_With ("_Set") then
                   Put_Line ("declare");
                   Put ("Set : LSP.Structures.");
                   Put (Name);
                   Put_Line (" renames Value;");
                   Put_Line ("begin");
                   Put_Line ("   for Value in Set'Range loop");
                   Put_Line ("      if Set (Value) then");
-                  Write_Call (Done, Tipe.Union.an_array.element.Value, "");
+                  Write_Call (Done, Array_Element, "");
                   Put_Line ("      end if;");
                   Put_Line ("   end loop;");
                   Put_Line ("end;");
@@ -678,8 +710,7 @@ package body LSP_Gen.Outputs is
                        ("for J in Value.First_Index .. Value.Last_Index loop");
                   end if;
 
-                  Write_Call
-                    (Done, Tipe.Union.an_array.element.Value, " (J)");
+                  Write_Call (Done, Array_Element, " (J)");
                   Put_Line ("end loop;");
                end if;
                Put_Line ("Handler.End_Array;");
diff --git a/source/lsp_gen/lsp_gen-structures.adb b/source/lsp_gen/lsp_gen-structures.adb
@@ -76,9 +76,10 @@ package body LSP_Gen.Structures is
       Done   : Dependency_Map);
    procedure Write_Optional_Type (Name : VSS.Strings.Virtual_String);
    procedure Write_Vector_Type
-     (Model : LSP_Gen.Meta_Models.Meta_Model;
-      Name  : VSS.Strings.Virtual_String;
-      Item  : VSS.Strings.Virtual_String);
+     (Model    : LSP_Gen.Meta_Models.Meta_Model;
+      Name     : VSS.Strings.Virtual_String;
+      Element  : LSP_Gen.Entities.AType;
+      Fallback : VSS.Strings.Virtual_String);
    procedure Write_Enumeration
      (Name : VSS.Strings.Virtual_String;
       List : LSP_Gen.Entities.AType_Vector);
@@ -1010,19 +1011,12 @@ package body LSP_Gen.Structures is
                   null;
             end case;
          when an_array =>
-            declare
-               Element : constant VSS.Strings.Virtual_String :=
-                 Short_Name
-                   (Model,
-                    Item.Union.an_array.element.Value,
-                    Fallback & "_Item");
-            begin
-               if Name /= "LSPAny_Vector"
-                 and Name /= "Virtual_String_Vector"
-               then
-                  Write_Vector_Type (Model, Name, Element);
-               end if;
-            end;
+            if Name /= "LSPAny_Vector"
+              and Name /= "Virtual_String_Vector"
+            then
+               Write_Vector_Type
+                 (Model, Name, Item.Union.an_array.element.Value, Fallback);
+            end if;
          when map =>
             declare
                Element : constant VSS.Strings.Virtual_String := Short_Name
@@ -1775,11 +1769,16 @@ package body LSP_Gen.Structures is
    -----------------------
 
    procedure Write_Vector_Type
-     (Model : LSP_Gen.Meta_Models.Meta_Model;
-      Name  : VSS.Strings.Virtual_String;
-      Item  : VSS.Strings.Virtual_String)
+     (Model    : LSP_Gen.Meta_Models.Meta_Model;
+      Name     : VSS.Strings.Virtual_String;
+      Element  : LSP_Gen.Entities.AType;
+      Fallback : VSS.Strings.Virtual_String)
    is
-      pragma Unreferenced (Model);
+      Item : constant VSS.Strings.Virtual_String :=
+        Short_Name
+          (Model,
+           Element,
+           Fallback & "_Item");
    begin
       if Name = "DocumentSymbol_Vector" or Name = "SelectionRange_Vector" then
          declare
@@ -1797,6 +1796,17 @@ package body LSP_Gen.Structures is
             New_Line;
             return;
          end;
+
+      elsif Element.Union.Kind = reference
+        and then Model.Is_Custom_Enumeration (Element.Union.reference.name)
+      then
+         --  array of enum that supports custom values.
+         --
+         --  For string-based enumeration do nothing and create ordinary
+         --  vector of enum (strings). Current LSP doesn't have non-string
+         --  "custom" enums in arrays.
+         null;
+
       elsif Name.Ends_With ("_Set") then
          --  It looks like any enum array in LSP is a set. Let's define them
          --  as sets.
