From d396e3c30c4dd5892553932b4078b7ab411679f5 Mon Sep 17 00:00:00 2001 From: Brian Drummond Date: Fri, 13 Dec 2013 13:06:52 +0000 Subject: Patch for multiple 'image and 'value attribute problems, mainly missing functionality. Resolves bugs 7751, 20255 --- evaluation.adb | 138 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 137 insertions(+), 1 deletion(-) (limited to 'evaluation.adb') diff --git a/evaluation.adb b/evaluation.adb index 07cc313f4..3bd18ce16 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -22,6 +22,7 @@ with Iirs_Utils; use Iirs_Utils; with Std_Package; use Std_Package; with Flags; use Flags; with Std_Names; +with Ada.Characters.Handling; package body Evaluation is function Get_Physical_Value (Expr : Iir) return Iir_Int64 @@ -1346,6 +1347,104 @@ package body Evaluation is return Res; end Eval_Floating_Image; + function Eval_Enumeration_Image (Enum, Expr : Iir) return Iir + is + Name : constant String := Image_Identifier (Enum); + Image_Id : constant String_Id := Str_Table.Start; + begin + for i in Name'range loop + Str_Table.Append(Name(i)); + end loop; + Str_Table.Finish; + return Build_String (Image_Id, Nat32(Name'Length), Expr); + end Eval_Enumeration_Image; + + function Build_Enumeration_Value (Val : String; Enum, Expr : Iir) return Iir + is + Value : String(Val'range); + List : constant Iir_List := Get_Enumeration_Literal_List(Enum); + begin + for i in Val'range loop + Value(i) := Ada.Characters.Handling.To_Lower (Val(i)); + end loop; + for i in 0 .. Get_Nbr_Elements(List) - 1 loop + if Value = Image_Identifier(Get_Nth_Element(List, i)) then + return Build_Discrete(Iir_Int64(i), Expr); + end if; + end loop; + Error_Msg_Sem ("value """ & Value & """ not in enumeration", Expr); + return Null_Iir; + end Build_Enumeration_Value; + + function Eval_Physical_Image (Phys, Expr : Iir) return Iir + -- reduces to the base unit (e.g. femtoseconds) + is + Value : constant String := Iir_Int64'image( + Get_Physical_Literal_Value(Phys)); + Unit : constant Iir := Get_Primary_Unit (Get_Base_Type (Get_Type(Phys))); + UnitName : constant String := Image_Identifier (Unit); + Image_Id : constant String_Id := Str_Table.Start; + Length : Nat32 := Value'Length + UnitName'Length + 1; + begin + for i in Value'range loop + -- Suppress the Ada +ve integer'image leading space + if i > Value'first or else Value(i) /= ' ' then + Str_Table.Append(Value(i)); + else + Length := Length - 1; + end if; + end loop; + Str_Table.Append(' '); + for i in UnitName'range loop + Str_Table.Append(UnitName(i)); + end loop; + Str_Table.Finish; + + return Build_String (Image_Id, Length, Expr); + end Eval_Physical_Image; + + function Build_Physical_Value (Val: String; Phys_Type, Expr: Iir) return Iir + is + function White (C : in Character) return Boolean is + NBSP : constant Character := Character'Val (160); + HT : constant Character := Character'Val (9); + begin + return C = ' ' or C = NBSP or C = HT; + end White; + + UnitName : String(Val'range); + Sep : Natural; + Found_Unit : Boolean := false; + Unit : Iir := Get_Primary_Unit (Phys_Type); + begin + -- Separate string into numeric value and make lowercase unit. + for i in reverse Val'range loop + UnitName(i) := Ada.Characters.Handling.To_Lower (Val(i)); + if White(Val(i)) and Found_Unit then + Sep := i; + exit; + else + Found_Unit := true; + end if; + end loop; + -- Unit name is UnitName(Sep+1..Unit'Last) + + -- Chain down the units looking for matching one + Unit := Get_Primary_Unit (Phys_Type); + while Unit /= Null_Iir loop + exit when UnitName(Sep+1..UnitName'Last) = Image_Identifier(Unit); + Unit := Get_Chain (Unit); + end loop; + if Unit = Null_Iir then + Error_Msg_Sem ("Unit """ & UnitName(Sep+1..UnitName'Last) + & """ not in physical type", Expr); + return Null_Iir; + end if; + -- FIXME: Should we support real values too? + return Build_Physical(Iir_Int64'value(Val(Val'first .. Sep)), Expr); + end Build_Physical_Value; + + function Eval_Incdec (Expr : Iir; N : Iir_Int64) return Iir is P : Iir_Int64; @@ -1625,10 +1724,47 @@ package body Evaluation is return Eval_Integer_Image (Get_Value (Param), Expr); when Iir_Kind_Floating_Type_Definition => return Eval_Floating_Image (Get_Fp_Value (Param), Expr); + when Iir_Kind_Enumeration_Type_Definition => + return Eval_Enumeration_Image (Param, Expr); + when Iir_Kind_Physical_Type_Definition => + return Eval_Physical_Image (Param, Expr); when others => - Error_Kind ("eval_static_expr('image)", Param_Type); + Error_Kind ("eval_static_expr('image)", Param); end case; end; + when Iir_Kind_Value_Attribute => + declare + Param : Iir; + Param_Type : Iir; + begin + Param := Get_Parameter (Expr); + Param := Eval_Static_Expr (Param); + Set_Parameter (Expr, Param); + if Get_Kind (Param) /= Iir_Kind_String_Literal then + Error_Msg_Sem ("'value argument not a string", Expr); + return Null_Iir; -- or Expr? + else + -- what type are we converting the string to? + Param_Type := Get_Base_Type (Get_Type (Expr)); + declare + Value : constant String := Image_String_Lit(Param); + begin + case Get_Kind (Param_Type) is + when Iir_Kind_Integer_Type_Definition => + return Build_Discrete(Iir_Int64'value(Value), Expr); + when Iir_Kind_Enumeration_Type_Definition => + return Build_Enumeration_Value (Value, Param_Type, + Expr); + when Iir_Kind_Floating_Type_Definition => + return Build_Floating (Iir_Fp64'value (Value), Expr); + when Iir_Kind_Physical_Type_Definition => + return Build_Physical_Value (Value, Param_Type, Expr); + when others => + Error_Kind ("eval_static_expr('value)", Param); + end case; + end; + end if; + end; when Iir_Kind_Left_Type_Attribute => return Build_Constant -- cgit v1.2.3