[gcc r12-3751] [Ada] Add "optional" node subtypes that allow Empty

[gcc r12-3751] [Ada] Add "optional" node subtypes that allow Empty

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:bd413702ce3106573655490668bdf8dcd6a680c9

commit r12-3751-gbd413702ce3106573655490668bdf8dcd6a680c9
Author: Bob Duff <duff@adacore.com>
Date:   Thu Jul 8 13:26:53 2021 -0400

    [Ada] Add "optional" node subtypes that allow Empty
    
    gcc/ada/
    
            * gen_il-gen.adb (Put_Opt_Subtype): Print out subtypes of the
            form:
            subtype Opt_N_Declaration is
            Node_Id with Predicate =>
            Opt_N_Declaration = Empty or else
            Opt_N_Declaration in N_Declaration_Id;
            One for each node or entity type, with the predicate allowing
            Empty.
            * atree.adb (Parent, Set_Parent): Remove unnecessary "Atree.".

Diff:
---
 gcc/ada/atree.adb      |  4 ++--
 gcc/ada/gen_il-gen.adb | 42 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 43 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 3be7e0395e0..540d4ff74af 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -1828,7 +1828,7 @@ package body Atree is
 
    function Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id is
    begin
-      pragma Assert (Atree.Present (N));
+      pragma Assert (Present (N));
 
       if Is_List_Member (N) then
          return Parent (List_Containing (N));
@@ -2151,7 +2151,7 @@ package body Atree is
 
    procedure Set_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id) is
    begin
-      pragma Assert (Atree.Present (N));
+      pragma Assert (Present (N));
       pragma Assert (not In_List (N));
       Set_Link (N, Union_Id (Val));
    end Set_Parent;
diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb
index a9c7bd7cfff..db2a5fc15b2 100644
--- a/gcc/ada/gen_il-gen.adb
+++ b/gcc/ada/gen_il-gen.adb
@@ -1405,6 +1405,10 @@ package body Gen_IL.Gen is
          --  Print out a subtype (of type Node_Id or Entity_Id) for a given
          --  nonroot abstract type.
 
+         procedure Put_Opt_Subtype (T : Node_Or_Entity_Type);
+         --  Print out an "optional" subtype; that is, one that allows
+         --  Empty. Their names start with "Opt_".
+
          procedure Put_Enum_Type is
             procedure Put_Enum_Lit (T : Node_Or_Entity_Type);
             --  Print out one enumeration literal in the declaration of
@@ -1496,6 +1500,29 @@ package body Gen_IL.Gen is
             end if;
          end Put_Id_Subtype;
 
+         procedure Put_Opt_Subtype (T : Node_Or_Entity_Type) is
+         begin
+            if Type_Table (T).Parent /= No_Type then
+               Put (S, "subtype Opt_" & Image (T) & " is" & LF);
+               Increase_Indent (S, 2);
+               Put (S, Id_Image (Root));
+
+               --  Assert that the Opt_XXX subtype is empty or in the XXX
+               --  subtype.
+
+               if Enable_Assertions then
+                  Put (S, " with Predicate =>" & LF);
+                  Increase_Indent (S, 2);
+                  Put (S, "Opt_" & Image (T) & " = Empty or else" & LF);
+                  Put (S, "Opt_" & Image (T) & " in " & Id_Image (T));
+                  Decrease_Indent (S, 2);
+               end if;
+
+               Put (S, ";" & LF);
+               Decrease_Indent (S, 2);
+            end if;
+         end Put_Opt_Subtype;
+
       begin -- Put_Type_And_Subtypes
          Put_Enum_Type;
 
@@ -1544,7 +1571,20 @@ package body Gen_IL.Gen is
             end if;
          end loop;
 
-         Put (S, "subtype Flag is Boolean;" & LF & LF);
+         Put (S, LF & "--  Optional subtypes of " & Id_Image (Root) & "." &
+              " These allow Empty." & LF & LF);
+
+         Iterate_Types (Root, Pre => Put_Opt_Subtype'Access);
+
+         Put (S, LF & "--  Optional union types:" & LF & LF);
+
+         for T in First_Abstract (Root) .. Last_Abstract (Root) loop
+            if Type_Table (T) /= null and then Type_Table (T).Is_Union then
+               Put_Opt_Subtype (T);
+            end if;
+         end loop;
+
+         Put (S, LF & "subtype Flag is Boolean;" & LF & LF);
       end Put_Type_And_Subtypes;
 
       function Low_Level_Getter_Name (T : Type_Enum) return String is