public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-351] [Ada] Rewrite Sem_Ch4.Find_Boolean_Types
@ 2022-05-12 12:40 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2022-05-12 12:40 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:a4f6f9f1769ab691d28da4579c61c13d5d1c2bda
commit r13-351-ga4f6f9f1769ab691d28da4579c61c13d5d1c2bda
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri Feb 4 18:53:43 2022 +0100
[Ada] Rewrite Sem_Ch4.Find_Boolean_Types
Using a straight implementation like the one in Find_Arithmetic_Types.
gcc/ada/
* sem_ch4.adb (Find_Arithmetic_Types): Use local variables.
(Find_Boolean_Types): Rewrite modeled on Find_Arithmetic_Types.
Diff:
---
gcc/ada/sem_ch4.adb | 142 +++++++++++++++++++++++++---------------------------
1 file changed, 68 insertions(+), 74 deletions(-)
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index ca8e1cd1f24..67e42ce0fdb 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6450,11 +6450,6 @@ package body Sem_Ch4 is
Op_Id : Entity_Id;
N : Node_Id)
is
- Index1 : Interp_Index;
- Index2 : Interp_Index;
- It1 : Interp;
- It2 : Interp;
-
procedure Check_Right_Argument (T : Entity_Id);
-- Check right operand of operator
@@ -6463,19 +6458,27 @@ package body Sem_Ch4 is
--------------------------
procedure Check_Right_Argument (T : Entity_Id) is
+ I : Interp_Index;
+ It : Interp;
+
begin
if not Is_Overloaded (R) then
Check_Arithmetic_Pair (T, Etype (R), Op_Id, N);
else
- Get_First_Interp (R, Index2, It2);
- while Present (It2.Typ) loop
- Check_Arithmetic_Pair (T, It2.Typ, Op_Id, N);
- Get_Next_Interp (Index2, It2);
+ Get_First_Interp (R, I, It);
+ while Present (It.Typ) loop
+ Check_Arithmetic_Pair (T, It.Typ, Op_Id, N);
+ Get_Next_Interp (I, It);
end loop;
end if;
end Check_Right_Argument;
+ -- Local variables
+
+ I : Interp_Index;
+ It : Interp;
+
-- Start of processing for Find_Arithmetic_Types
begin
@@ -6483,10 +6486,10 @@ package body Sem_Ch4 is
Check_Right_Argument (Etype (L));
else
- Get_First_Interp (L, Index1, It1);
- while Present (It1.Typ) loop
- Check_Right_Argument (It1.Typ);
- Get_Next_Interp (Index1, It1);
+ Get_First_Interp (L, I, It);
+ while Present (It.Typ) loop
+ Check_Right_Argument (It.Typ);
+ Get_Next_Interp (I, It);
end loop;
end if;
end Find_Arithmetic_Types;
@@ -6500,86 +6503,77 @@ package body Sem_Ch4 is
Op_Id : Entity_Id;
N : Node_Id)
is
- Index : Interp_Index;
- It : Interp;
+ procedure Check_Boolean_Pair (T1, T2 : Entity_Id);
+ -- Check operand pair of operator
- procedure Check_Numeric_Argument (T : Entity_Id);
- -- Special case for logical operations one of whose operands is an
- -- integer literal. If both are literal the result is any modular type.
+ procedure Check_Right_Argument (T : Entity_Id);
+ -- Check right operand of operator
- ----------------------------
- -- Check_Numeric_Argument --
- ----------------------------
+ ------------------------
+ -- Check_Boolean_Pair --
+ ------------------------
+
+ procedure Check_Boolean_Pair (T1, T2 : Entity_Id) is
+ T : Entity_Id;
- procedure Check_Numeric_Argument (T : Entity_Id) is
begin
- if T = Universal_Integer then
- Add_One_Interp (N, Op_Id, Any_Modular);
+ if Valid_Boolean_Arg (T1)
+ and then Valid_Boolean_Arg (T2)
+ and then (Covers (T1 => T1, T2 => T2)
+ or else Covers (T1 => T2, T2 => T1))
+ then
+ T := Specific_Type (T1, T2);
+
+ if T = Universal_Integer then
+ T := Any_Modular;
+ end if;
- elsif Is_Modular_Integer_Type (T) then
Add_One_Interp (N, Op_Id, T);
end if;
- end Check_Numeric_Argument;
+ end Check_Boolean_Pair;
- -- Start of processing for Find_Boolean_Types
+ --------------------------
+ -- Check_Right_Argument --
+ --------------------------
- begin
- if not Is_Overloaded (L) then
- if Etype (L) = Universal_Integer
- or else Etype (L) = Any_Modular
- then
- if not Is_Overloaded (R) then
- Check_Numeric_Argument (Etype (R));
+ procedure Check_Right_Argument (T : Entity_Id) is
+ I : Interp_Index;
+ It : Interp;
- else
- Get_First_Interp (R, Index, It);
- while Present (It.Typ) loop
- Check_Numeric_Argument (It.Typ);
- Get_Next_Interp (Index, It);
- end loop;
- end if;
+ begin
+ -- Defend against previous error
- -- If operands are aggregates, we must assume that they may be
- -- boolean arrays, and leave disambiguation for the second pass.
- -- If only one is an aggregate, verify that the other one has an
- -- interpretation as a boolean array
+ if Nkind (R) = N_Error then
+ null;
- elsif Nkind (L) = N_Aggregate then
- if Nkind (R) = N_Aggregate then
- Add_One_Interp (N, Op_Id, Etype (L));
+ elsif not Is_Overloaded (R) then
+ Check_Boolean_Pair (T, Etype (R));
- elsif not Is_Overloaded (R) then
- if Valid_Boolean_Arg (Etype (R)) then
- Add_One_Interp (N, Op_Id, Etype (R));
- end if;
+ else
+ Get_First_Interp (R, I, It);
+ while Present (It.Typ) loop
+ Check_Boolean_Pair (T, It.Typ);
+ Get_Next_Interp (I, It);
+ end loop;
+ end if;
+ end Check_Right_Argument;
- else
- Get_First_Interp (R, Index, It);
- while Present (It.Typ) loop
- if Valid_Boolean_Arg (It.Typ) then
- Add_One_Interp (N, Op_Id, It.Typ);
- end if;
+ -- Local variables
- Get_Next_Interp (Index, It);
- end loop;
- end if;
+ I : Interp_Index;
+ It : Interp;
- elsif Valid_Boolean_Arg (Etype (L))
- and then Has_Compatible_Type (R, Etype (L))
- then
- Add_One_Interp (N, Op_Id, Etype (L));
- end if;
+ -- Start of processing for Find_Boolean_Types
+
+ begin
+ if not Is_Overloaded (L) then
+ Check_Right_Argument (Etype (L));
else
- Get_First_Interp (L, Index, It);
+ Get_First_Interp (L, I, It);
while Present (It.Typ) loop
- if Valid_Boolean_Arg (It.Typ)
- and then Has_Compatible_Type (R, It.Typ)
- then
- Add_One_Interp (N, Op_Id, It.Typ);
- end if;
-
- Get_Next_Interp (Index, It);
+ Check_Right_Argument (It.Typ);
+ Get_Next_Interp (I, It);
end loop;
end if;
end Find_Boolean_Types;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-05-12 12:40 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-12 12:40 [gcc r13-351] [Ada] Rewrite Sem_Ch4.Find_Boolean_Types Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).