diff options
author | Bob Duff <duff@adacore.com> | 2021-07-08 13:26:53 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-09-21 15:25:02 +0000 |
commit | bd413702ce3106573655490668bdf8dcd6a680c9 (patch) | |
tree | 3a48faf51478316110c194b1784009be50739715 /gcc | |
parent | 0df911d9056437a79cf40fc643c49fced56574bd (diff) | |
download | gcc-bd413702ce3106573655490668bdf8dcd6a680c9.zip gcc-bd413702ce3106573655490668bdf8dcd6a680c9.tar.gz gcc-bd413702ce3106573655490668bdf8dcd6a680c9.tar.bz2 |
[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.".
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/atree.adb | 4 | ||||
-rw-r--r-- | 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 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 |