synth: abstract code for reuse by evaluation

7 files changed, 78 insertions, 52 deletions

diff --git a/src/synth/elab-vhdl_objtypes.adb b/src/synth/elab-vhdl_objtypes.adb
index 4e2401fa0..ba475a723 100644
--- a/src/synth/elab-vhdl_objtypes.adb
+++ b/src/synth/elab-vhdl_objtypes.adb
@@ -679,20 +679,25 @@ package body Elab.Vhdl_Objtypes is
       return Read_Fp64 (Mt.Mem);
    end Read_Fp64;
 
-   function Read_Discrete (Mt : Memtyp) return Int64 is
+   function Read_Discrete (Mem : Memory_Ptr; Typ : Type_Acc) return Int64 is
    begin
-      case Mt.Typ.Sz is
+      case Typ.Sz is
          when 1 =>
-            return Int64 (Read_U8 (Mt.Mem));
+            return Int64 (Read_U8 (Mem));
          when 4 =>
-            return Int64 (Read_I32 (Mt.Mem));
+            return Int64 (Read_I32 (Mem));
          when 8 =>
-            return Int64 (Read_I64 (Mt.Mem));
+            return Int64 (Read_I64 (Mem));
          when others =>
             raise Internal_Error;
       end case;
    end Read_Discrete;
 
+   function Read_Discrete (Mt : Memtyp) return Int64 is
+   begin
+      return Read_Discrete (Mt.Mem, Mt.Typ);
+   end Read_Discrete;
+
    procedure Write_Discrete (Mem : Memory_Ptr; Typ : Type_Acc; Val : Int64) is
    begin
       case Typ.Sz is
diff --git a/src/synth/elab-vhdl_objtypes.ads b/src/synth/elab-vhdl_objtypes.ads
index 0b0af6680..434fc7044 100644
--- a/src/synth/elab-vhdl_objtypes.ads
+++ b/src/synth/elab-vhdl_objtypes.ads
@@ -271,7 +271,9 @@ package Elab.Vhdl_Objtypes is
    function Read_U8 (Mt : Memtyp) return Ghdl_U8;
    function Read_Fp64 (Mt : Memtyp) return Fp64;
 
+   --  TYP is the type of the element.
    procedure Write_Discrete (Mem : Memory_Ptr; Typ : Type_Acc; Val : Int64);
+   function Read_Discrete (Mem : Memory_Ptr; Typ : Type_Acc) return Int64;
    function Read_Discrete (Mt : Memtyp) return Int64;
 
    --  Memory allocation.
diff --git a/src/synth/elab-vhdl_types.adb b/src/synth/elab-vhdl_types.adb
index e2cb469a1..09fbb11da 100644
--- a/src/synth/elab-vhdl_types.adb
+++ b/src/synth/elab-vhdl_types.adb
@@ -147,6 +147,14 @@ package body Elab.Vhdl_Types is
       end case;
    end Synth_Discrete_Range;
 
+   function Synth_Bounds_From_Range (Rng : Discrete_Range_Type)
+                                    return Bound_Type is
+   begin
+      return (Dir => Rng.Dir,
+              Left => Int32 (Rng.Left), Right => Int32 (Rng.Right),
+              Len => Get_Range_Length (Rng));
+   end Synth_Bounds_From_Range;
+
    function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc;
                                      Atype : Node) return Bound_Type
    is
@@ -337,36 +345,40 @@ package body Elab.Vhdl_Types is
       end case;
    end Scalar_Size_To_Size;
 
+   function Elab_Enumeration_Type_Definition (Def : Node) return Type_Acc is
+   begin
+      if Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type
+        or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type
+      then
+         return Logic_Type;
+      elsif Def = Vhdl.Std_Package.Boolean_Type_Definition then
+         return Boolean_Type;
+      elsif Def = Vhdl.Std_Package.Bit_Type_Definition then
+         return Bit_Type;
+      else
+         declare
+            Nbr_El : constant Natural :=
+              Get_Nbr_Elements (Get_Enumeration_Literal_List (Def));
+            Rng : Discrete_Range_Type;
+            W : Uns32;
+         begin
+            W := Uns32 (Clog2 (Uns64 (Nbr_El)));
+            Rng := (Dir => Dir_To,
+                    Is_Signed => False,
+                    Left => 0,
+                    Right => Int64 (Nbr_El - 1));
+            return Create_Discrete_Type (Rng, Scalar_Size_To_Size (Def), W);
+         end;
+      end if;
+   end Elab_Enumeration_Type_Definition;
+
    procedure Elab_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node)
    is
       Typ : Type_Acc;
    begin
       case Get_Kind (Def) is
          when Iir_Kind_Enumeration_Type_Definition =>
-            if Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type
-              or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type
-            then
-               Typ := Logic_Type;
-            elsif Def = Vhdl.Std_Package.Boolean_Type_Definition then
-               Typ := Boolean_Type;
-            elsif Def = Vhdl.Std_Package.Bit_Type_Definition then
-               Typ := Bit_Type;
-            else
-               declare
-                  Nbr_El : constant Natural :=
-                    Get_Nbr_Elements (Get_Enumeration_Literal_List (Def));
-                  Rng : Discrete_Range_Type;
-                  W : Uns32;
-               begin
-                  W := Uns32 (Clog2 (Uns64 (Nbr_El)));
-                  Rng := (Dir => Dir_To,
-                          Is_Signed => False,
-                          Left => 0,
-                          Right => Int64 (Nbr_El - 1));
-                  Typ := Create_Discrete_Type
-                    (Rng, Scalar_Size_To_Size (Def), W);
-               end;
-            end if;
+            Typ := Elab_Enumeration_Type_Definition (Def);
          when Iir_Kind_Array_Type_Definition =>
             Typ := Synth_Array_Type_Definition (Syn_Inst, Def);
          when Iir_Kind_Access_Type_Definition =>
@@ -387,6 +399,20 @@ package body Elab.Vhdl_Types is
       end if;
    end Elab_Type_Definition;
 
+   function Elab_Scalar_Type_Definition (Def : Node; St : Node) return Type_Acc
+   is
+      Cst : constant Node := Get_Range_Constraint (St);
+      L, R : Int64;
+      Rng : Discrete_Range_Type;
+      W : Uns32;
+   begin
+      L := Get_Value (Get_Left_Limit (Cst));
+      R := Get_Value (Get_Right_Limit (Cst));
+      Rng := Build_Discrete_Range_Type (L, R, Get_Direction (Cst));
+      W := Discrete_Range_Width (Rng);
+      return Create_Discrete_Type (Rng, Scalar_Size_To_Size (Def), W);
+   end Elab_Scalar_Type_Definition;
+
    procedure Elab_Anonymous_Type_Definition
      (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node)
    is
@@ -395,19 +421,7 @@ package body Elab.Vhdl_Types is
       case Get_Kind (Def) is
          when Iir_Kind_Integer_Type_Definition
            | Iir_Kind_Physical_Type_Definition =>
-            declare
-               Cst : constant Node := Get_Range_Constraint (St);
-               L, R : Int64;
-               Rng : Discrete_Range_Type;
-               W : Uns32;
-            begin
-               L := Get_Value (Get_Left_Limit (Cst));
-               R := Get_Value (Get_Right_Limit (Cst));
-               Rng := Build_Discrete_Range_Type (L, R, Get_Direction (Cst));
-               W := Discrete_Range_Width (Rng);
-               Typ := Create_Discrete_Type
-                 (Rng, Scalar_Size_To_Size (Def), W);
-            end;
+            Typ := Elab_Scalar_Type_Definition (Def, St);
          when Iir_Kind_Floating_Type_Definition =>
             declare
                Cst : constant Node := Get_Range_Constraint (St);
diff --git a/src/synth/elab-vhdl_types.ads b/src/synth/elab-vhdl_types.ads
index 941ba80d6..7f1d2c55e 100644
--- a/src/synth/elab-vhdl_types.ads
+++ b/src/synth/elab-vhdl_types.ads
@@ -40,7 +40,8 @@ package Elab.Vhdl_Types is
    procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc;
                                    Bound : Node;
                                    Rng : out Discrete_Range_Type);
-
+   function Synth_Bounds_From_Range (Rng : Discrete_Range_Type)
+                                    return Bound_Type;
    function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc;
                                      Atype : Node) return Bound_Type;
 
@@ -59,6 +60,11 @@ package Elab.Vhdl_Types is
    procedure Elab_Anonymous_Type_Definition
      (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node);
 
+   --  Exported only for Vhdl.Evaluation to create temporary types.
+   function Elab_Enumeration_Type_Definition (Def : Node) return Type_Acc;
+   function Elab_Scalar_Type_Definition (Def : Node; St : Node)
+                                        return Type_Acc;
+
    --  Elaborate the type of DECL.
    procedure Elab_Declaration_Type
      (Syn_Inst : Synth_Instance_Acc; Decl : Node);
diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb
index 6d07c1087..504e49c04 100644
--- a/src/synth/synth-static_oper.adb
+++ b/src/synth/synth-static_oper.adb
@@ -671,7 +671,6 @@ package body Synth.Static_Oper is
 
    function Synth_Static_Monadic_Predefined (Imp : Node;
                                              Operand : Memtyp;
-                                             Oper_Typ : Type_Acc;
                                              Expr : Node) return Memtyp
    is
       Def : constant Iir_Predefined_Functions :=
@@ -680,25 +679,26 @@ package body Synth.Static_Oper is
       case Def is
          when Iir_Predefined_Boolean_Not
            | Iir_Predefined_Bit_Not =>
-            return Create_Memory_U8 (1 - Read_U8 (Operand), Oper_Typ);
+            return Create_Memory_U8 (1 - Read_U8 (Operand), Operand.Typ);
 
          when Iir_Predefined_Integer_Negation
            | Iir_Predefined_Physical_Negation =>
-            return Create_Memory_Discrete (-Read_Discrete (Operand), Oper_Typ);
+            return Create_Memory_Discrete
+              (-Read_Discrete (Operand), Operand.Typ);
          when Iir_Predefined_Integer_Absolute
            | Iir_Predefined_Physical_Absolute =>
             return Create_Memory_Discrete
-              (abs Read_Discrete(Operand), Oper_Typ);
+              (abs Read_Discrete(Operand), Operand.Typ);
          when Iir_Predefined_Integer_Identity
            | Iir_Predefined_Physical_Identity =>
             return Operand;
 
          when Iir_Predefined_Floating_Negation =>
-            return Create_Memory_Fp64 (-Read_Fp64 (Operand), Oper_Typ);
+            return Create_Memory_Fp64 (-Read_Fp64 (Operand), Operand.Typ);
          when Iir_Predefined_Floating_Identity =>
             return Operand;
          when Iir_Predefined_Floating_Absolute =>
-            return Create_Memory_Fp64 (abs Read_Fp64 (Operand), Oper_Typ);
+            return Create_Memory_Fp64 (abs Read_Fp64 (Operand), Operand.Typ);
 
          when Iir_Predefined_Ieee_1164_Condition_Operator =>
             --  Constant std_logic: need to convert.
@@ -722,7 +722,7 @@ package body Synth.Static_Oper is
          when Iir_Predefined_Ieee_1164_Scalar_Not =>
             return Create_Memory_U8
               (Std_Ulogic'Pos (Not_Table (Read_Std_Logic (Operand.Mem, 0))),
-               Oper_Typ);
+               Operand.Typ);
 
          when Iir_Predefined_Ieee_Numeric_Std_And_Uns =>
             return Synth_Vector_Reduce ('1', Operand, And_Table);
diff --git a/src/synth/synth-static_oper.ads b/src/synth/synth-static_oper.ads
index 43502c105..dde835864 100644
--- a/src/synth/synth-static_oper.ads
+++ b/src/synth/synth-static_oper.ads
@@ -29,7 +29,6 @@ package Synth.Static_Oper is
                                             Expr : Node) return Memtyp;
    function Synth_Static_Monadic_Predefined (Imp : Node;
                                              Operand : Memtyp;
-                                             Oper_Typ : Type_Acc;
                                              Expr : Node) return Memtyp;
 
    function Synth_Static_Predefined_Function_Call (Param1 : Valtyp;
diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb
index 53387cd6b..6eb228ac4 100644
--- a/src/synth/synth-vhdl_oper.adb
+++ b/src/synth/synth-vhdl_oper.adb
@@ -1684,7 +1684,7 @@ package body Synth.Vhdl_Oper is
       if Is_Static_Val (Operand.Val) then
          return Create_Value_Memtyp
            (Synth_Static_Monadic_Predefined
-              (Imp, Get_Value_Memtyp (Operand), Oper_Typ, Loc));
+              (Imp, Get_Value_Memtyp (Operand), Loc));
       end if;
 
       case Def is