aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/vhdl/sem_assocs.adb126
-rw-r--r--src/vhdl/sem_names.adb61
2 files changed, 112 insertions, 75 deletions
diff --git a/src/vhdl/sem_assocs.adb b/src/vhdl/sem_assocs.adb
index 4c9617b58..07fb470e1 100644
--- a/src/vhdl/sem_assocs.adb
+++ b/src/vhdl/sem_assocs.adb
@@ -1260,13 +1260,14 @@ package body Sem_Assocs is
-- ASSOC is an association element not analyzed and whose formal is a
-- parenthesis name. Try to extract a conversion function/type. In case
- -- of success, return a new association element. In case of failure,
- -- return NULL_IIR.
+ -- of success, modify the association to represent the conversion and
+ -- returns the parenthesis_name node (to be freed or to revert the change).
+ -- In case of failure, return NULL_IIR.
function Sem_Formal_Conversion (Assoc : Iir) return Iir
is
Formal : constant Iir := Get_Formal (Assoc);
+ pragma Assert (Get_Kind (Formal) = Iir_Kind_Parenthesis_Name);
Assoc_Chain : constant Iir := Get_Association_Chain (Formal);
- Res : Iir;
Conv : Iir;
Name : Iir;
Conv_Func : Iir;
@@ -1303,14 +1304,20 @@ package body Sem_Assocs is
end if;
Set_Type (Conv, Conv_Type);
- -- Create a new association with a conversion function.
- Res := Create_Iir (Iir_Kind_Association_Element_By_Expression);
- Set_Out_Conversion (Res, Conv);
- Set_Formal (Res, Name);
- Set_Actual (Res, Get_Actual (Assoc));
- return Res;
+ Set_Out_Conversion (Assoc, Conv);
+ Set_Formal (Assoc, Name);
+
+ return Formal;
end Sem_Formal_Conversion;
+ procedure Revert_Formal_Conversion (Assoc : Iir; Saved_Assoc : Iir) is
+ begin
+ Sem_Name_Clean (Get_Out_Conversion (Assoc));
+ Set_Out_Conversion (Assoc, Null_Iir);
+ Sem_Name_Clean (Get_Formal (Assoc));
+ Set_Formal (Assoc, Saved_Assoc);
+ end Revert_Formal_Conversion;
+
-- NAME is the formal name of an association, without any conversion
-- function or type.
-- Try to analyze NAME with INTERFACE.
@@ -1495,7 +1502,7 @@ package body Sem_Assocs is
return Is_Valid_Conversion (Get_Named_Entity (Func),
Res_Base_Type, Param_Base_Type);
when others =>
- Error_Kind ("is_valid_conversion(2)", Func);
+ return False;
end case;
end Is_Valid_Conversion;
@@ -2316,6 +2323,13 @@ package body Sem_Assocs is
end case;
end Sem_Association;
+ procedure Revert_Sem_Association (Assoc : Iir) is
+ begin
+ pragma Assert
+ (Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression);
+ Sem_Name_Clean (Get_Formal (Assoc));
+ end Revert_Sem_Association;
+
procedure Sem_Association_Chain
(Interface_Chain : Iir;
Assoc_Chain: in out Iir;
@@ -2360,7 +2374,7 @@ package body Sem_Assocs is
Interface_1 : Iir;
Pos_1 : Integer;
- Assoc_1 : Iir;
+ Saved_Assoc : Iir;
begin
Match := Fully_Compatible;
Has_Individual := False;
@@ -2406,46 +2420,66 @@ package body Sem_Assocs is
else
-- FIXME: directly search the formal if finish is true.
-- Find the Interface.
- case Get_Kind (Formal) is
- when Iir_Kind_Parenthesis_Name =>
- Assoc_1 := Sem_Formal_Conversion (Assoc);
- if Assoc_1 /= Null_Iir then
- Search_Interface (Assoc_1, Interface_1, Pos_1);
- -- LRM 4.3.2.2 Association Lists
- -- The formal part of a named element association may be
- -- in the form of a function call, [...], if and only
- -- if the mode of the formal is OUT, INOUT, BUFFER, or
- -- LINKAGE, and the actual is not OPEN.
- if Interface_1 = Null_Iir
- or else Get_Mode (Interface_1) = Iir_In_Mode
- then
- Sem_Name_Clean (Get_Out_Conversion (Assoc_1));
- Free_Iir (Assoc_1);
- Assoc_1 := Null_Iir;
- end if;
+
+ -- Try as 'normal' or individual assoc.
+ Search_Interface (Assoc, Inter, Pos);
+
+ if Get_Kind (Formal) = Iir_Kind_Parenthesis_Name then
+ -- Try as formal conversion.
+ Revert_Sem_Association (Assoc);
+ Saved_Assoc := Sem_Formal_Conversion (Assoc);
+
+ if Saved_Assoc /= Null_Iir then
+ -- ASSOC could be interpreted as a formal conversion.
+ Search_Interface (Assoc, Interface_1, Pos_1);
+ -- LRM 4.3.2.2 Association Lists
+ -- The formal part of a named element association may be
+ -- in the form of a function call, [...], if and only
+ -- if the mode of the formal is OUT, INOUT, BUFFER, or
+ -- LINKAGE, and the actual is not OPEN.
+ if Interface_1 = Null_Iir
+ or else Get_Mode (Interface_1) = Iir_In_Mode
+ then
+ -- Failed to analyze the out conversion.
+ Revert_Formal_Conversion (Assoc, Saved_Assoc);
+ Interface_1 := Null_Iir;
end if;
- Search_Interface (Assoc, Inter, Pos);
- if Inter = Null_Iir then
- if Assoc_1 /= Null_Iir then
- Inter := Interface_1;
- Pos := Pos_1;
+ else
+ Interface_1 := Null_Iir;
+ end if;
+
+ if Inter = Null_Iir then
+ -- FORMAL cannot be interpreted as an individual assoc.
+ if Interface_1 /= Null_Iir then
+ -- But can be interpreted as a formal conversion.
+ Inter := Interface_1;
+ Pos := Pos_1;
+
+ if Finish then
+ -- Free the now unused parenthesis_name.
Free_Parenthesis_Name
- (Get_Formal (Assoc), Get_Out_Conversion (Assoc_1));
- Set_Formal (Assoc, Get_Formal (Assoc_1));
- Set_Out_Conversion
- (Assoc, Get_Out_Conversion (Assoc_1));
- Set_Whole_Association_Flag
- (Assoc, Get_Whole_Association_Flag (Assoc_1));
- Free_Iir (Assoc_1);
+ (Saved_Assoc, Get_Out_Conversion (Assoc));
+ else
+ Revert_Formal_Conversion (Assoc, Saved_Assoc);
end if;
+ end if;
+ else
+ -- FORMAL cannot be interpreted as an individual assoc.
+ if Interface_1 /= Null_Iir then
+ -- But also as a formal conversion.
+
+ -- FIXME: todo.
+ raise Internal_Error;
else
- if Assoc_1 /= Null_Iir then
- raise Internal_Error;
- end if;
+ declare
+ I_Match : Compatibility_Level;
+ begin
+ Sem_Association (Assoc, Inter, False, I_Match);
+ pragma Assert (I_Match /= Not_Compatible);
+ end;
end if;
- when others =>
- Search_Interface (Assoc, Inter, Pos);
- end case;
+ end if;
+ end if;
if Inter /= Null_Iir then
if Get_Whole_Association_Flag (Assoc) then
diff --git a/src/vhdl/sem_names.adb b/src/vhdl/sem_names.adb
index 21b88a610..f07ae3c28 100644
--- a/src/vhdl/sem_names.adb
+++ b/src/vhdl/sem_names.adb
@@ -3729,42 +3729,45 @@ package body Sem_Names is
end case;
end Sem_Name_Soft;
- procedure Sem_Name_Clean (Name : Iir)
+ procedure Sem_Name_Clean_1 (Name : Iir)
is
- N : Iir;
- Next_N : Iir;
Named_Entity : Iir;
Atype : Iir;
begin
- N := Name;
- while N /= Null_Iir loop
- case Get_Kind (N) is
- when Iir_Kind_Simple_Name
- | Iir_Kind_Operator_Symbol =>
- Next_N := Null_Iir;
- when others =>
- Error_Kind ("sem_name_clean", N);
- end case;
+ if Name = Null_Iir then
+ return;
+ end if;
- -- Clear and free overload lists of Named_entity and type.
- Named_Entity := Get_Named_Entity (N);
- Set_Named_Entity (N, Null_Iir);
- if Named_Entity /= Null_Iir
- and then Is_Overload_List (Named_Entity)
- then
- Free_Iir (Named_Entity);
- end if;
+ -- Clear and free overload lists of Named_entity and type.
+ Named_Entity := Get_Named_Entity (Name);
+ Set_Named_Entity (Name, Null_Iir);
+ if Named_Entity /= Null_Iir
+ and then Is_Overload_List (Named_Entity)
+ then
+ Free_Iir (Named_Entity);
+ end if;
- Atype := Get_Type (N);
- Set_Type (N, Null_Iir);
- if Atype /= Null_Iir
- and then Is_Overload_List (Atype)
- then
- Free_Iir (Atype);
- end if;
+ Atype := Get_Type (Name);
+ Set_Type (Name, Null_Iir);
+ if Atype /= Null_Iir
+ and then Is_Overload_List (Atype)
+ then
+ Free_Iir (Atype);
+ end if;
+ end Sem_Name_Clean_1;
- N := Next_N;
- end loop;
+ procedure Sem_Name_Clean (Name : Iir) is
+ begin
+ case Get_Kind (Name) is
+ when Iir_Kind_Simple_Name
+ | Iir_Kind_Operator_Symbol =>
+ Sem_Name_Clean_1 (Name);
+ when Iir_Kind_Parenthesis_Name =>
+ Sem_Name_Clean_1 (Get_Prefix (Name));
+ Sem_Name_Clean_1 (Name);
+ when others =>
+ Error_Kind ("sem_name_clean", Name);
+ end case;
end Sem_Name_Clean;
-- Remove procedure specification from LIST.
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-03 18:51:10 +0000