diff options
Diffstat (limited to 'src/vhdl')
| -rw-r--r-- | src/vhdl/sem.adb | 27 | ||||
| -rw-r--r-- | src/vhdl/sem_inst.adb | 102 | ||||
| -rw-r--r-- | src/vhdl/sem_inst.ads | 4 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 2 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap5.adb | 2 |
5 files changed, 131 insertions, 6 deletions
diff --git a/src/vhdl/sem.adb b/src/vhdl/sem.adb index 8187ffd36..d26bbfe6e 100644 --- a/src/vhdl/sem.adb +++ b/src/vhdl/sem.adb @@ -2604,13 +2604,28 @@ package body Sem is Push_Signals_Declarative_Part (Implicit, Decl); if Header /= Null_Iir then - Sem_Interface_Chain - (Get_Generic_Chain (Header), Generic_Interface_List); - if Get_Generic_Map_Aspect_Chain (Header) /= Null_Iir then - if not Sem_Generic_Association_Chain (Header, Header) then - null; + declare + Generic_Chain : constant Iir := Get_Generic_Chain (Header); + Generic_Map : constant Iir := + Get_Generic_Map_Aspect_Chain (Header); + El : Iir; + begin + Sem_Interface_Chain (Generic_Chain, Generic_Interface_List); + if Generic_Map /= Null_Iir then + if Sem_Generic_Association_Chain (Header, Header) then + El := Get_Generic_Map_Aspect_Chain (Header); + while Is_Valid (El) loop + if Get_Kind (El) = Iir_Kind_Association_Element_Type then + Sem_Inst.Substitute_On_Chain + (Generic_Chain, + Get_Type (Get_Associated_Interface (El)), + Get_Type (Get_Named_Entity (Get_Actual (El)))); + end if; + El := Get_Chain (El); + end loop; + end if; end if; - end if; + end; end if; Sem_Declaration_Chain (Decl); diff --git a/src/vhdl/sem_inst.adb b/src/vhdl/sem_inst.adb index ae4a6975b..8799ac7a5 100644 --- a/src/vhdl/sem_inst.adb +++ b/src/vhdl/sem_inst.adb @@ -648,4 +648,106 @@ package body Sem_Inst is Instantiate_Loc := Prev_Loc; Restore_Origin (Mark); end Instantiate_Package_Declaration; + + procedure Substitute_On_Iir_List (L : Iir_List; E : Iir; Rep : Iir); + + procedure Substitute_On_Iir (N : Iir; E : Iir; Rep : Iir) is + begin + if N = Null_Iir then + return; + end if; + + pragma Assert (N /= E); + + declare + use Nodes_Meta; + Kind : constant Iir_Kind := Get_Kind (N); + Fields : constant Fields_Array := Get_Fields (Kind); + F : Fields_Enum; + begin + for I in Fields'Range loop + F := Fields (I); + + case Get_Field_Type (F) is + when Type_Iir => + declare + S : constant Iir := Get_Iir (N, F); + begin + if S = E then + -- Substitute + Set_Iir (N, F, Rep); + pragma Assert (Get_Field_Attribute (F) = Attr_Ref); + else + case Get_Field_Attribute (F) is + when Attr_None => + Substitute_On_Iir (S, E, Rep); + when Attr_Ref => + null; + when Attr_Maybe_Ref => + if not Get_Is_Ref (N) then + Substitute_On_Iir (S, E, Rep); + end if; + when Attr_Chain => + Substitute_On_Chain (S, E, Rep); + when Attr_Chain_Next => + null; + when Attr_Of_Ref => + -- Can only appear in list. + raise Internal_Error; + end case; + end if; + end; + when Type_Iir_List => + declare + S : constant Iir_List := Get_Iir_List (N, F); + begin + case Get_Field_Attribute (F) is + when Attr_None => + Substitute_On_Iir_List (S, E, Rep); + when Attr_Of_Ref + | Attr_Ref => + null; + when others => + -- Ref is specially handled in Instantiate_Iir. + -- Others cannot appear for lists. + raise Internal_Error; + end case; + end; + when others => + null; + end case; + end loop; + end; + end Substitute_On_Iir; + + procedure Substitute_On_Iir_List (L : Iir_List; E : Iir; Rep : Iir) + is + El : Iir; + begin + case L is + when Null_Iir_List + | Iir_List_All + | Iir_List_Others => + return; + when others => + for I in Natural loop + El := Get_Nth_Element (L, I); + exit when El = Null_Iir; + + Substitute_On_Iir (El, E, Rep); + end loop; + end case; + end Substitute_On_Iir_List; + + procedure Substitute_On_Chain (Chain : Iir; E : Iir; Rep : Iir) + is + El : Iir; + begin + El := Chain; + while Is_Valid (El) loop + Substitute_On_Iir (El, E, Rep); + El := Get_Chain (El); + end loop; + end Substitute_On_Chain; + end Sem_Inst; diff --git a/src/vhdl/sem_inst.ads b/src/vhdl/sem_inst.ads index da8cd5d27..5da4a8d09 100644 --- a/src/vhdl/sem_inst.ads +++ b/src/vhdl/sem_inst.ads @@ -23,4 +23,8 @@ package Sem_Inst is -- Create declaration chain and generic declarations for INST from PKG. procedure Instantiate_Package_Declaration (Inst : Iir; Pkg : Iir); + + -- In CHAIN, substitute all references to E by REP. + procedure Substitute_On_Chain (Chain : Iir; E : Iir; Rep : Iir); + end Sem_Inst; diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index a61246c57..ca0bff60b 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -1631,6 +1631,8 @@ package body Trans.Chap4 is Create_Object (Decl); when Iir_Kind_Interface_Package_Declaration => Create_Package_Interface (Decl); + when Iir_Kind_Interface_Type_Declaration => + null; when others => Error_Kind ("translate_generic_chain", Decl); end case; diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index 7bdb84385..cc5f349d0 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -802,6 +802,8 @@ package body Trans.Chap5 is (Actual_Info.Package_Instance_Body_Scope), Uninst_Info.Package_Body_Ptr_Type)); end; + when Iir_Kind_Association_Element_Type => + null; when others => Error_Kind ("elab_generic_map_aspect(1)", Assoc); end case; |