diff options
| -rw-r--r-- | canon.adb | 12 | ||||
| -rw-r--r-- | sem_expr.adb | 39 | ||||
| -rw-r--r-- | sem_expr.ads | 5 | ||||
| -rw-r--r-- | sem_names.adb | 13 | ||||
| -rw-r--r-- | sem_names.ads | 16 | ||||
| -rw-r--r-- | sem_stmts.adb | 15 |
6 files changed, 91 insertions, 9 deletions
@@ -65,6 +65,7 @@ package body Canon is procedure Canon_Block_Configuration (Top : Iir_Design_Unit; Conf : Iir_Block_Configuration); + procedure Canon_Subtype_Indication (Def : Iir); procedure Canon_Subtype_Indication_If_Anonymous (Def : Iir); procedure Canon_Extract_Sensitivity_Aggregate @@ -662,7 +663,13 @@ package body Canon is when Iir_Kind_Allocator_By_Expression => Canon_Expression (Get_Expression (Expr)); when Iir_Kind_Allocator_By_Subtype => - null; + declare + Ind : constant Iir := Get_Expression (Expr); + begin + if Get_Kind (Ind) = Iir_Kind_Array_Subtype_Definition then + Canon_Subtype_Indication (Ind); + end if; + end; when Iir_Kinds_Literal | Iir_Kind_Simple_Aggregate @@ -2163,8 +2170,7 @@ package body Canon is case Get_Kind (Def) is when Iir_Kind_Array_Subtype_Definition => declare - Indexes : constant Iir_List := - Get_Index_Subtype_List (Def); + Indexes : constant Iir_List := Get_Index_Subtype_List (Def); Index : Iir; begin for I in Natural loop diff --git a/sem_expr.adb b/sem_expr.adb index 33addfd..e29ce87 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -4000,6 +4000,45 @@ package body Sem_Expr is return Res; end Sem_Expression; + function Sem_Composite_Expression (Expr : Iir) return Iir + is + Res : Iir; + begin + Res := Sem_Expression_Ov (Expr, Null_Iir); + if Is_Overloaded (Res) then + declare + List : constant Iir_List := Get_Overload_List (Get_Type (Res)); + Res_Type : Iir; + Atype : Iir; + begin + Res_Type := Null_Iir; + for I in Natural loop + Atype := Get_Nth_Element (List, I); + exit when Atype = Null_Iir; + if Is_Aggregate_Type (Atype) then + Add_Result (Res_Type, Atype); + end if; + end loop; + + if Res_Type = Null_Iir then + Error_Overload (Expr); + return Null_Iir; + elsif Is_Overload_List (Res_Type) then + Error_Overload (Expr); + Disp_Overload_List (Get_Overload_List (Res_Type), Expr); + Free_Overload_List (Res_Type); + return Null_Iir; + else + return Sem_Expression_Ov (Expr, Res_Type); + end if; + end; + else + -- Either an error (already handled) or not overloaded. Type + -- matching will be done later (when the target is analyzed). + return Res; + end if; + end Sem_Composite_Expression; + function Sem_Expression_Universal (Expr : Iir) return Iir is Expr1 : Iir; diff --git a/sem_expr.ads b/sem_expr.ads index 3304923..d8c006b 100644 --- a/sem_expr.ads +++ b/sem_expr.ads @@ -69,6 +69,11 @@ package Sem_Expr is -- A check is made that COND can be read. function Sem_Condition (Cond : Iir) return Iir; + -- Same as Sem_Expression but knowing that the type of EXPR must be a + -- composite type. Used for expressions in assignment statement when the + -- target is an aggregate. + function Sem_Composite_Expression (Expr : Iir) return Iir; + -- Check EXPR can be read. procedure Check_Read (Expr : Iir); diff --git a/sem_names.adb b/sem_names.adb index 45ce377..48f4d28 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -87,6 +87,16 @@ package body Sem_Names is return Res; end Create_Overload_List; + procedure Free_Overload_List (N : in out Iir_Overload_List) + is + List : Iir_List; + begin + List := Get_Overload_List (N); + Destroy_Iir_List (List); + Free_Iir (N); + N := Null_Iir; + end Free_Overload_List; + function Simplify_Overload_List (List : Iir_List) return Iir is Res : Iir; @@ -144,9 +154,6 @@ package body Sem_Names is return Simplify_Overload_List (Res_List); end Create_List_Of_Types; - -- Add new interpretation DECL to RES. - -- Create an overload_list if necessary. - -- Before the first call, RES should be set to NULL_IIR. procedure Add_Result (Res : in out Iir; Decl : Iir) is Nres : Iir; diff --git a/sem_names.ads b/sem_names.ads index 8e9ffd0..75db2fc 100644 --- a/sem_names.ads +++ b/sem_names.ads @@ -64,20 +64,32 @@ package Sem_Names is function Is_Overload_List (An_Iir: Iir) return Boolean; pragma Inline (Is_Overload_List); - -- Create an overload list. - -- must be destroyed with free_iir. + -- Create an overload list, that must be destroyed by Destroy_Overload_List. function Get_Overload_List return Iir_Overload_List; pragma Inline (Get_Overload_List); + function Create_Overload_List (List : Iir_List) return Iir_Overload_List; pragma Inline (Create_Overload_List); + -- Free the list node (and the list itself). + procedure Free_Overload_List (N : in out Iir_Overload_List); + pragma Unreferenced (Free_Overload_List); + + -- Display an error message if the overload resolution for EXPR find more + -- than one interpretation. procedure Error_Overload (Expr: Iir); + -- Disp the overload list LIST. procedure Disp_Overload_List (List : Iir_List; Loc : Iir); -- Convert a list to either Null_Iir, an element or an overload list. function Simplify_Overload_List (List : Iir_List) return Iir; + -- Add new interpretation DECL to RES. + -- Create an overload_list if necessary. + -- Before the first call, RES should be set to NULL_IIR. + procedure Add_Result (Res : in out Iir; Decl : Iir); + -- Return TRUE iff TYPE1 and TYPE2 are closely related. function Are_Types_Closely_Related (Type1, Type2 : Iir) return Boolean; diff --git a/sem_stmts.adb b/sem_stmts.adb index 864cec6..8067abb 100644 --- a/sem_stmts.adb +++ b/sem_stmts.adb @@ -687,18 +687,31 @@ package body Sem_Stmts is -- Find the variable. Target := Get_Target (Stmt); Expr := Get_Expression (Stmt); + + -- LRM93 8.5 Variable assignment statement + -- If the target of the variable assignment statement is in the form of + -- an aggregate, then the type of the aggregate must be determinable + -- from the context, excluding the aggregate itself but including the + -- fact that the type of the aggregate must be a composite type. The + -- base type of the expression on the right-hand side must be the + -- same as the base type of the aggregate. + -- + -- GHDL: this means that the type can only be deduced from the + -- expression (and not from the target). if Get_Kind (Target) = Iir_Kind_Aggregate then if Get_Kind (Expr) = Iir_Kind_Aggregate then Error_Msg_Sem ("can't determine type, use type qualifier", Expr); return; end if; - Expr := Sem_Expression (Get_Expression (Stmt), Null_Iir); + Expr := Sem_Composite_Expression (Get_Expression (Stmt)); if Expr = Null_Iir then return; end if; Check_Read (Expr); Set_Expression (Stmt, Expr); Target_Type := Get_Type (Expr); + + -- FIXME: check elements are identified at most once. else Target_Type := Null_Iir; end if; |