-- For (a <= b) we convert to not (a > b)
- if Chars (N) = Name_Op_Le then
- Rewrite (N,
- Make_Op_Not (Loc,
- Right_Opnd =>
- Make_Op_Gt (Loc,
- Left_Opnd => Op1,
- Right_Opnd => Op2)));
- Analyze_And_Resolve (N, Standard_Boolean);
- return;
+ case Nkind (N) is
+ when N_Op_Le =>
+ Rewrite (N,
+ Make_Op_Not (Loc,
+ Right_Opnd =>
+ Make_Op_Gt (Loc,
+ Left_Opnd => Op1,
+ Right_Opnd => Op2)));
+ Analyze_And_Resolve (N, Standard_Boolean);
+ return;
- -- For < the Boolean expression is
- -- greater__nn (op2, op1)
+ -- For < the Boolean expression is
+ -- greater__nn (op2, op1)
- elsif Chars (N) = Name_Op_Lt then
- Func_Body := Make_Array_Comparison_Op (Typ1, N);
+ when N_Op_Lt =>
+ Func_Body := Make_Array_Comparison_Op (Typ1, N);
- -- Switch operands
+ -- Switch operands
- Op1 := Right_Opnd (N);
- Op2 := Left_Opnd (N);
+ Op1 := Right_Opnd (N);
+ Op2 := Left_Opnd (N);
- -- For (a >= b) we convert to not (a < b)
+ -- For (a >= b) we convert to not (a < b)
- elsif Chars (N) = Name_Op_Ge then
- Rewrite (N,
- Make_Op_Not (Loc,
- Right_Opnd =>
- Make_Op_Lt (Loc,
- Left_Opnd => Op1,
- Right_Opnd => Op2)));
- Analyze_And_Resolve (N, Standard_Boolean);
- return;
+ when N_Op_Ge =>
+ Rewrite (N,
+ Make_Op_Not (Loc,
+ Right_Opnd =>
+ Make_Op_Lt (Loc,
+ Left_Opnd => Op1,
+ Right_Opnd => Op2)));
+ Analyze_And_Resolve (N, Standard_Boolean);
+ return;
- -- For > the Boolean expression is
- -- greater__nn (op1, op2)
+ -- For > the Boolean expression is
+ -- greater__nn (op1, op2)
- else
- pragma Assert (Chars (N) = Name_Op_Gt);
- Func_Body := Make_Array_Comparison_Op (Typ1, N);
- end if;
+ when N_Op_Gt =>
+ Func_Body := Make_Array_Comparison_Op (Typ1, N);
+
+ when others => raise Program_Error;
+ end case;
Func_Name := Defining_Unit_Name (Specification (Func_Body));
Expr :=
(Sy (Char_Literal_Value, Unat)));
Ab (N_Op, N_Has_Entity,
- (Sm (Chars, Name_Id),
- Sm (Do_Overflow_Check, Flag),
+ (Sm (Do_Overflow_Check, Flag),
Sm (Has_Private_View, Flag),
Sm (Has_Secondary_Private_View, Flag)));
Ab (N_Binary_Op, N_Op,
(Sy (Left_Opnd, Node_Id),
- Sy (Right_Opnd, Node_Id)));
+ Sy (Right_Opnd, Node_Id),
+ Sy (Chars, Name_Id, Default_No_Name)));
+ -- N_Binary_Op and N_Unary_Op do not strictly need Chars, since the value
+ -- is fully determined by the Nkind. However, for example, Errout refers to
+ -- Chars without knowing statically whether the Nkind is in N_Op.
+ -- In any case, we don't inherit Chars from N_Op, because we want it to
+ -- come after the other syntactic fields, so that positional notation can
+ -- be used in calls to Make_Op_Add and friends.
+ --
+ -- Make_Op_Add and friends will now have a Chars parameter. Callers
+ -- should always use the default, because the Chars field is set
+ -- properly as a special case (see Gen_IL.Gen).
Cc (N_Op_Add, N_Binary_Op);
Cc (N_Op_Shift_Right_Arithmetic, N_Op_Shift);
Ab (N_Unary_Op, N_Op,
- (Sy (Right_Opnd, Node_Id)));
+ (Sy (Right_Opnd, Node_Id),
+ Sy (Chars, Name_Id, Default_No_Name)));
Cc (N_Op_Abs, N_Unary_Op);
Cc (N_Op_Minus, N_Unary_Op);
-- Check that syntactic fields precede semantic fields. Note that this
-- check is happening before we compute inherited fields.
- -- Exempt Chars and Actions from this rule, for now.
+ -- Exempt Actions from this rule, for now.
declare
Semantic_Seen : Boolean := False;
end if;
else
- if Fields (J).F not in Chars | Actions then
+ if Fields (J).F /= Actions then
Semantic_Seen := True;
end if;
end if;
-- For example, Left_Opnd comes before Right_Opnd,
-- which wouldn't be the case if Right_Opnd were
-- inherited from N_Op.
- ((T = N_Op and then F = Right_Opnd)
+ ((T = N_Op and then F in Right_Opnd | Chars)
or else (T = N_Renaming_Declaration and then F = Name)
or else (T = N_Generic_Renaming_Declaration and then F = Name)
or else F in Defining_Unit_Name
-- for now. At least, we don't want to add any new cases of
-- syntactic/semantic mismatch.
- if F in Chars | Actions | Expression | Default_Expression
+ if F in Actions | Expression | Default_Expression
then
pragma Assert (Syntactic_Seen and Semantic_Seen);
if Is_Descendant (N_Op, T) then
-- Special cases for N_Op nodes: fill in the Chars and Entity
- -- fields even though they were not passed in.
+ -- fields. Assert that the Chars passed in is defaulted.
declare
Op : constant String := Image_Sans_N (T);
-- "Op_", but the Name_Id constant does not.
begin
+ Put (S, "pragma Assert (Chars = No_Name);" & LF);
Put (S, "Set_Chars (N, Name_" & Op_Name & ");" & LF);
Put (S, "Set_Entity (N, Standard_" & Op & ");" & LF);
end;
(if T in Entity_Type and then F in Node_Field then
" -- N" else "");
-- A comment to put out for fields of entities that are
- -- shared with nodes, such as Chars.
+ -- shared with nodes.
begin
while First_Bit < Type_Bit_Size_Aligned (T) loop
and then Scope (Op) = Standard_Standard
and then not Strict
then
- declare
- Op_Chars : constant Any_Operator_Name := Chars (Op);
- -- Nonassociative ops like division are unlikely
- -- to come up in practice, but they are legal.
- begin
- case Op_Chars is
- when Name_Op_Add
- | Name_Op_Subtract
- | Name_Op_Multiply
- | Name_Op_Divide
- | Name_Op_Expon
- =>
- return Is_Numeric_Type (Typ);
-
- when Name_Op_Mod | Name_Op_Rem =>
- return Is_Numeric_Type (Typ)
- and then Is_Discrete_Type (Typ);
-
- when Name_Op_And | Name_Op_Or | Name_Op_Xor =>
- -- No Boolean array operators in Standard
- return Is_Boolean_Type (Typ)
- or else Is_Modular_Integer_Type (Typ);
+ -- Nonassociative ops like division are unlikely to
+ -- come up in practice, but they are legal.
+
+ case Any_Operator_Name'(Chars (Op)) is
+ when Name_Op_Add
+ | Name_Op_Subtract
+ | Name_Op_Multiply
+ | Name_Op_Divide
+ | Name_Op_Expon
+ =>
+ return Is_Numeric_Type (Typ);
+
+ when Name_Op_Mod | Name_Op_Rem =>
+ return Is_Numeric_Type (Typ)
+ and then Is_Discrete_Type (Typ);
+
+ when Name_Op_And | Name_Op_Or | Name_Op_Xor =>
+ -- No Boolean array operators in Standard
+ return Is_Boolean_Type (Typ)
+ or else Is_Modular_Integer_Type (Typ);
+
+ when Name_Op_Concat =>
+ return Is_Array_Type (Typ)
+ and then Number_Dimensions (Typ) = 1;
+
+ when Name_Op_Eq | Name_Op_Ne
+ | Name_Op_Lt | Name_Op_Le
+ | Name_Op_Gt | Name_Op_Ge
+ =>
+ return Is_Boolean_Type (Typ);
+
+ when Name_Op_Abs | Name_Op_Not =>
+ -- unary ops were already handled
+
+ raise Program_Error;
+ end case;
- when Name_Op_Concat =>
- return Is_Array_Type (Typ)
- and then Number_Dimensions (Typ) = 1;
-
- when Name_Op_Eq | Name_Op_Ne
- | Name_Op_Lt | Name_Op_Le
- | Name_Op_Gt | Name_Op_Ge
- =>
- return Is_Boolean_Type (Typ);
-
- when Name_Op_Abs | Name_Op_Not =>
- -- unary ops were already handled
- pragma Assert (False);
- raise Program_Error;
- end case;
- end;
else
return False;
end if;
-- the order of their corresponding scopes on the scope stack. For
-- example, if package P and the enclosing scope both contain entities
-- named E, then when compiling the package body the chain for E will
- -- hold the global entity first, and the local one (corresponding to
+ -- hold the global entity first, and the local one (corresponding to
-- the current inner scope) next. As a result, name resolution routines
-- do not assume any relative ordering of the homonym chains, either
-- for scope nesting or to order of appearance of context clauses.
-- a private or incomplete type declaration, or a protected type speci-
-- fication) and re-chained when compiling the second view.
- -- In the case of operators, we do not make operators on derived types
+ -- In the case of operators, we do not make operators on derived types
-- explicit. As a result, the notation P."+" may denote either a user-
-- defined function with name "+", or else an implicit declaration of the
-- operator "+" in package P. The resolution of expanded names always
Old_S := Find_Renamed_Entity (N, Selector_Name (Nam), New_S);
if Old_S = Any_Id then
- Error_Msg_N ("no subprogram or entry matches specification", N);
+ Error_Msg_N ("no subprogram or entry matches specification", N);
else
if Is_Body then
Check_Subtype_Conformant (New_S, Old_S, N);
end if;
if Old_S = Any_Id then
- Error_Msg_N ("no subprogram or entry matches specification", N);
+ Error_Msg_N ("no subprogram or entry matches specification", N);
else
if Is_Body then
elsif Ekind (Old_S) /= E_Operator then
-- If this a defaulted subprogram for a class-wide actual there is
- -- no check for mode conformance, given that the signatures don't
+ -- no check for mode conformance, given that the signatures don't
-- match (the source mentions T but the actual mentions T'Class).
if CW_Actual then
-- An entity in the current scope is not necessarily the first one
-- on its homonym chain. Find its predecessor if any,
-- If it is an internal entity, it will not be in the visibility
- -- chain altogether, and there is nothing to unchain.
+ -- chain altogether, and there is nothing to unchain.
if Id /= Current_Entity (Id) then
Prev := Current_Entity (Id);
Set_Name_Entity_Id (Chars (Id), Outer);
elsif Scope (Prev) /= Scope (Id) then
- Set_Homonym (Prev, Outer);
+ Set_Homonym (Prev, Outer);
end if;
<<Next_Ent>>
and then Scope (S) /= Standard_Standard
and then not Is_Child_Unit (S)
then
- if Nkind (E) not in N_Entity then
- return;
- end if;
+ pragma Assert (Nkind (E) in N_Entity);
-- Copy categorization flags from Scope (S) to S, this is not done
-- when Scope (S) is Standard_Standard since propagation is from
function Operator_Kind
(Op_Name : Name_Id;
- Is_Binary : Boolean) return Node_Kind;
- -- Utility to map the name of an operator into the corresponding Node. Used
- -- by other node rewriting procedures.
+ Is_Binary : Boolean) return N_Op;
+ -- Map the name of an operator into the corresponding Node_Kind
procedure Resolve_Actuals (N : Node_Id; Nam : Entity_Id);
-- Resolve actuals of call, and add default expressions for missing ones.
function Operator_Kind
(Op_Name : Name_Id;
- Is_Binary : Boolean) return Node_Kind
+ Is_Binary : Boolean) return N_Op
is
Kind : Node_Kind;
projects / thirdparty / gcc.git / commitdiff
