diff mbox series

[Ada] Add "optional" node subtypes that allow Empty

Message ID 20210921152630.GA3094909@adacore.com
State New
Headers show
Series [Ada] Add "optional" node subtypes that allow Empty | expand

Commit Message

Pierre-Marie de Rodat Sept. 21, 2021, 3:26 p.m. UTC 
This patch adds new Opt_... subtypes to Sinfo.Nodes and Einfo.Entities.
The predicates say "Opt_N_Declaration = Empty" rather than "No
(Opt_N_Declaration)" because No is not visible. It can't be made visible
with "with Atree;", because that would introduce cycles. It could be
made visible by moving it to Types, but that causes a minor earthquake
(changes in compiler, codepeer, and spark), so we're leaving No where it
is.

Tested on x86_64-pc-linux-gnu, committed on trunk

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 mbox series

Patch

diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
--- 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
--- 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