diff options
Diffstat (limited to 'evaluation.adb')
| -rw-r--r-- | evaluation.adb | 165 |
1 files changed, 111 insertions, 54 deletions
diff --git a/evaluation.adb b/evaluation.adb index bd6649c0f..28ae73941 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -167,6 +167,7 @@ package body Evaluation is Set_Type (Res, Stype); Set_Literal_Origin (Res, Origin); Set_Expr_Staticness (Res, Locally); + Set_Literal_Subtype (Res, Stype); return Res; end Build_Simple_Aggregate; @@ -206,7 +207,9 @@ package body Evaluation is Prim_Name := Get_Primary_Unit_Name (Get_Base_Type (Get_Type (Origin))); Set_Unit_Name (Res, Prim_Name); - if Get_Unit_Name (Val) = Prim_Name then + if Get_Named_Entity (Get_Unit_Name (Val)) + = Get_Named_Entity (Prim_Name) + then Set_Value (Res, Get_Value (Val)); else raise Internal_Error; @@ -235,6 +238,7 @@ package body Evaluation is when Iir_Kind_Simple_Aggregate => Res := Create_Iir (Iir_Kind_Simple_Aggregate); Set_Simple_Aggregate_List (Res, Get_Simple_Aggregate_List (Val)); + Set_Literal_Subtype (Res, Get_Type (Origin)); when Iir_Kind_Overflow_Literal => Res := Create_Iir (Iir_Kind_Overflow_Literal); @@ -421,6 +425,13 @@ package body Evaluation is return Create_Unidim_Array_From_Index (Base_Type, N_Index_Type, Loc); end Create_Unidim_Array_By_Length; + procedure Free_Eval_Static_Expr (Res : Iir; Orig : Iir) is + begin + if Res /= Orig and then Get_Literal_Origin (Res) = Orig then + Free_Iir (Res); + end if; + end Free_Eval_Static_Expr; + function Eval_String_Literal (Str : Iir) return Iir is Ptr : String_Fat_Acc; @@ -451,17 +462,15 @@ package body Evaluation is end loop; return Build_Simple_Aggregate (List, Str, Get_Type (Str)); end; + when Iir_Kind_Bit_String_Literal => declare - Str_Type : Iir; + Str_Type : constant Iir := Get_Type (Str); List : Iir_List; - Lit_0 : Iir; - Lit_1 : Iir; + Lit_0 : constant Iir := Get_Bit_String_0 (Str); + Lit_1 : constant Iir := Get_Bit_String_1 (Str); begin - Str_Type := Get_Type (Str); List := Create_Iir_List; - Lit_0 := Get_Bit_String_0 (Str); - Lit_1 := Get_Bit_String_1 (Str); Ptr := Get_String_Fat_Acc (Str); Len := Get_String_Length (Str); @@ -478,8 +487,10 @@ package body Evaluation is end loop; return Build_Simple_Aggregate (List, Str, Str_Type); end; + when Iir_Kind_Simple_Aggregate => return Str; + when others => Error_Kind ("eval_string_literal", Str); end case; @@ -806,7 +817,9 @@ package body Evaluation is L : Natural; Res_Type : Iir; Origin_Type : Iir; + Left_Aggr, Right_Aggr : Iir; Left_List, Right_List : Iir_List; + Left_Len : Natural; begin Res_List := Create_Iir_List; -- Do the concatenation. @@ -815,14 +828,19 @@ package body Evaluation is when Iir_Predefined_Element_Array_Concat | Iir_Predefined_Element_Element_Concat => Append_Element (Res_List, Left); + Left_Len := 1; when Iir_Predefined_Array_Element_Concat | Iir_Predefined_Array_Array_Concat => - Left_List := - Get_Simple_Aggregate_List (Eval_String_Literal (Left)); - L := Get_Nbr_Elements (Left_List); - for I in 0 .. L - 1 loop + Left_Aggr := Eval_String_Literal (Left); + Left_List := Get_Simple_Aggregate_List (Left_Aggr); + Left_Len := Get_Nbr_Elements (Left_List); + for I in 0 .. Left_Len - 1 loop Append_Element (Res_List, Get_Nth_Element (Left_List, I)); end loop; + if Left_Aggr /= Left then + Destroy_Iir_List (Left_List); + Free_Iir (Left_Aggr); + end if; end case; -- Right: case Func is @@ -831,12 +849,16 @@ package body Evaluation is Append_Element (Res_List, Right); when Iir_Predefined_Element_Array_Concat | Iir_Predefined_Array_Array_Concat => - Right_List := - Get_Simple_Aggregate_List (Eval_String_Literal (Right)); + Right_Aggr := Eval_String_Literal (Right); + Right_List := Get_Simple_Aggregate_List (Right_Aggr); L := Get_Nbr_Elements (Right_List); for I in 0 .. L - 1 loop Append_Element (Res_List, Get_Nth_Element (Right_List, I)); end loop; + if Right_Aggr /= Right then + Destroy_Iir_List (Right_List); + Free_Iir (Right_Aggr); + end if; end case; L := Get_Nbr_Elements (Res_List); @@ -844,7 +866,7 @@ package body Evaluation is Origin_Type := Get_Type (Orig); Res_Type := Null_Iir; if Func = Iir_Predefined_Array_Array_Concat - and then Get_Nbr_Elements (Left_List) = 0 + and then Left_Len = 0 then if Flags.Vhdl_Std = Vhdl_87 then -- LRM87 7.2.4 @@ -912,24 +934,36 @@ package body Evaluation is function Eval_Array_Equality (Left, Right : Iir) return Boolean is + Left_Val, Right_Val : Iir; L_List : Iir_List; R_List : Iir_List; N : Natural; + Res : Boolean; begin - -- FIXME: the simple aggregates are lost. - L_List := Get_Simple_Aggregate_List (Eval_String_Literal (Left)); - R_List := Get_Simple_Aggregate_List (Eval_String_Literal (Right)); + Left_Val := Eval_String_Literal (Left); + Right_Val := Eval_String_Literal (Right); + + L_List := Get_Simple_Aggregate_List (Left_Val); + R_List := Get_Simple_Aggregate_List (Right_Val); N := Get_Nbr_Elements (L_List); if N /= Get_Nbr_Elements (R_List) then - return False; + -- Cannot be equal if not the same length. + Res := False; + else + Res := True; + for I in 0 .. N - 1 loop + -- FIXME: this is wrong: (eg: evaluated lit) + if Get_Nth_Element (L_List, I) /= Get_Nth_Element (R_List, I) then + Res := False; + exit; + end if; + end loop; end if; - for I in 0 .. N - 1 loop - -- FIXME: this is wrong: (eg: evaluated lit) - if Get_Nth_Element (L_List, I) /= Get_Nth_Element (R_List, I) then - return False; - end if; - end loop; - return True; + + Free_Eval_Static_Expr (Left_Val, Left); + Free_Eval_Static_Expr (Right_Val, Right); + + return Res; end Eval_Array_Equality; -- ORIG is either a dyadic operator or a function call. @@ -1637,24 +1671,24 @@ package body Evaluation is end if; end Build_Physical_Value; - function Eval_Incdec (Expr : Iir; N : Iir_Int64) return Iir + function Eval_Incdec (Expr : Iir; N : Iir_Int64; Origin : Iir) return Iir is P : Iir_Int64; begin case Get_Kind (Expr) is when Iir_Kind_Integer_Literal => - return Build_Integer (Get_Value (Expr) + N, Expr); + return Build_Integer (Get_Value (Expr) + N, Origin); when Iir_Kind_Enumeration_Literal => P := Iir_Int64 (Get_Enum_Pos (Expr)) + N; if P < 0 then Warning_Msg_Sem ("static constant violates bounds", Expr); - return Build_Overflow (Expr); + return Build_Overflow (Origin); else - return Build_Enumeration (Iir_Index32 (P), Expr); + return Build_Enumeration (Iir_Index32 (P), Origin); end if; when Iir_Kind_Physical_Int_Literal | Iir_Kind_Unit_Declaration => - return Build_Physical (Get_Physical_Value (Expr) + N, Expr); + return Build_Physical (Get_Physical_Value (Expr) + N, Origin); when others => Error_Kind ("eval_incdec", Expr); end case; @@ -1696,6 +1730,7 @@ package body Evaluation is Conv_Index_Type : constant Iir := Get_Index_Type (Conv_Type, 0); Val_Index_Type : constant Iir := Get_Index_Type (Val_Type, 0); Index_Type : Iir; + Res_Type : Iir; Res : Iir; Rng : Iir; begin @@ -1727,9 +1762,10 @@ package body Evaluation is Set_Base_Type (Index_Type, Get_Base_Type (Conv_Index_Type)); Set_Type_Staticness (Index_Type, Locally); end if; - Set_Type (Res, - Create_Unidim_Array_From_Index - (Get_Base_Type (Conv_Type), Index_Type, Conv)); + Res_Type := Create_Unidim_Array_From_Index + (Get_Base_Type (Conv_Type), Index_Type, Conv); + Set_Type (Res, Res_Type); + Set_Type_Conversion_Subtype (Conv, Res_Type); return Res; when others => Error_Kind ("eval_array_type_conversion", Conv_Type); @@ -1791,7 +1827,7 @@ package body Evaluation is | Iir_Kind_Overflow_Literal => return Expr; when Iir_Kind_Physical_Int_Literal => - if Get_Unit_Name (Expr) + if Get_Named_Entity (Get_Unit_Name (Expr)) = Get_Primary_Unit (Get_Base_Type (Get_Type (Expr))) then return Expr; @@ -1820,7 +1856,7 @@ package body Evaluation is when Iir_Kind_Object_Alias_Declaration => return Eval_Static_Expr (Get_Name (Expr)); when Iir_Kind_Unit_Declaration => - return Expr; + return Get_Physical_Unit_Value (Expr); when Iir_Kind_Simple_Aggregate => return Expr; @@ -1840,33 +1876,51 @@ package body Evaluation is end; when Iir_Kinds_Dyadic_Operator => declare - Left, Right : Iir; + Left : constant Iir := Get_Left (Expr); + Right : constant Iir := Get_Right (Expr); + Left_Val, Right_Val : Iir; + Res : Iir; begin - Left := Eval_Static_Expr (Get_Left (Expr)); - Right := Eval_Static_Expr (Get_Right (Expr)); + Left_Val := Eval_Static_Expr (Left); + Right_Val := Eval_Static_Expr (Right); - return Eval_Dyadic_Operator - (Expr, Get_Implementation (Expr), Left, Right); + Res := Eval_Dyadic_Operator + (Expr, Get_Implementation (Expr), Left_Val, Right_Val); + + Free_Eval_Static_Expr (Left_Val, Left); + Free_Eval_Static_Expr (Right_Val, Right); + + return Res; end; - when Iir_Kind_Attribute_Value => - -- FIXME: see constant_declaration. - -- Currently, this avoids weird nodes, such as a string literal - -- whose type is an unconstrained array type. - Val := Get_Expression (Get_Attribute_Specification (Expr)); - Res := Build_Constant (Eval_Static_Expr (Val), Expr); - Set_Type (Res, Get_Type (Val)); - return Res; when Iir_Kind_Attribute_Name => - return Eval_Static_Expr (Get_Named_Entity (Expr)); + -- An attribute name designates an attribute value. + declare + Attr_Val : constant Iir := Get_Named_Entity (Expr); + Attr_Expr : constant Iir := + Get_Expression (Get_Attribute_Specification (Attr_Val)); + Val : Iir; + begin + Val := Eval_Static_Expr (Attr_Expr); + -- FIXME: see constant_declaration. + -- Currently, this avoids weird nodes, such as a string literal + -- whose type is an unconstrained array type. + Res := Build_Constant (Val, Expr); + Set_Type (Res, Get_Type (Val)); + return Res; + end; when Iir_Kind_Pos_Attribute => declare + Param : constant Iir := Get_Parameter (Expr); Val : Iir; + Res : Iir; begin - Val := Eval_Static_Expr (Get_Parameter (Expr)); + Val := Eval_Static_Expr (Param); -- FIXME: check bounds, handle overflow. - return Build_Integer (Eval_Pos (Val), Expr); + Res := Build_Integer (Eval_Pos (Val), Expr); + Free_Eval_Static_Expr (Val, Param); + return Res; end; when Iir_Kind_Val_Attribute => declare @@ -2016,11 +2070,13 @@ package body Evaluation is end; when Iir_Kind_Pred_Attribute => - Res := Eval_Incdec (Eval_Static_Expr (Get_Parameter (Expr)), -1); + Res := Eval_Incdec + (Eval_Static_Expr (Get_Parameter (Expr)), -1, Expr); Eval_Check_Bound (Res, Get_Type (Get_Prefix (Expr))); return Res; when Iir_Kind_Succ_Attribute => - Res := Eval_Incdec (Eval_Static_Expr (Get_Parameter (Expr)), +1); + Res := Eval_Incdec + (Eval_Static_Expr (Get_Parameter (Expr)), +1, Expr); Eval_Check_Bound (Res, Get_Type (Get_Prefix (Expr))); return Res; when Iir_Kind_Leftof_Attribute @@ -2047,7 +2103,8 @@ package body Evaluation is when others => raise Internal_Error; end case; - Res := Eval_Incdec (Eval_Static_Expr (Get_Parameter (Expr)), N); + Res := Eval_Incdec + (Eval_Static_Expr (Get_Parameter (Expr)), N, Expr); Eval_Check_Bound (Res, Prefix_Type); return Res; end; |