From bd413702ce3106573655490668bdf8dcd6a680c9 Mon Sep 17 00:00:00 2001
From: Bob Duff <duff@adacore.com>
Date: Thu, 8 Jul 2021 13:26:53 -0400
Subject: [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.".
---
 gcc/ada/atree.adb      |  4 ++--
 gcc/ada/gen_il-gen.adb | 42 +++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 43 insertions(+), 3 deletions(-)

(limited to 'gcc')

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 3be7e03..540d4ff 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 a9c7bd7..db2a5fc 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
-- 
cgit v1.1