synth: Add width field in type_type record.

6 files changed, 119 insertions, 109 deletions

diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index d7af882b5..12ad60ed4 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -290,7 +290,7 @@ package body Synth.Context is
                Off := Off + 1;
             end;
          when Type_Discrete =>
-            for I in reverse 0 .. Val.Typ.Drange.W - 1 loop
+            for I in reverse 0 .. Val.Typ.W - 1 loop
                declare
                   B : constant Uns32 :=
                     Uns32 (Shift_Right (To_Uns64 (Val.Scal), Natural (I)))
@@ -381,9 +381,9 @@ package body Synth.Context is
                   Value2net (Val, 1, V, Res);
                   return Res;
                end;
-            elsif Val.Typ.Drange.W <= 32 then
+            elsif Val.Typ.W <= 32 then
                return Build_Const_UB32
-                 (Build_Context, Uns32 (Val.Scal), Val.Typ.Drange.W);
+                 (Build_Context, Uns32 (Val.Scal), Val.Typ.W);
             else
                raise Internal_Error;
             end if;
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index d411ded68..20bd9323b 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -105,13 +105,14 @@ package body Synth.Decls is
                   Nbr_El : constant Natural :=
                     Get_Nbr_Elements (Get_Enumeration_Literal_List (Def));
                   Rng : Discrete_Range_Type;
+                  W : Width;
                begin
+                  W := Uns32 (Clog2 (Uns64 (Nbr_El)));
                   Rng := (Dir => Iir_Downto,
                           Is_Signed => False,
-                          W => Uns32 (Clog2 (Uns64 (Nbr_El))),
                           Left => Int64 (Nbr_El - 1),
                           Right => 0);
-                  Typ := Create_Discrete_Type (Rng);
+                  Typ := Create_Discrete_Type (Rng, W);
                end;
             end if;
             Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ));
@@ -146,7 +147,7 @@ package body Synth.Decls is
                                                       Typ => El_Typ);
                   Off := Off + Get_Type_Width (El_Typ);
                end loop;
-               Typ.Rec_W := Off;
+               Typ.W := Off;
             end;
          when others =>
             Error_Kind ("synth_type_definition", Def);
@@ -165,12 +166,14 @@ package body Synth.Decls is
                Cst : constant Node := Get_Range_Constraint (St);
                L, R : Int64;
                Rng : Discrete_Range_Type;
+               W : Width;
             begin
                L := Get_Value (Get_Left_Limit (Cst));
                R := Get_Value (Get_Right_Limit (Cst));
                Rng := Synth_Discrete_Range_Expression
                  (L, R, Get_Direction (Cst));
-               Typ := Create_Discrete_Type (Rng);
+               W := Discrete_Range_Width (Rng);
+               Typ := Create_Discrete_Type (Rng, W);
                Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ));
             end;
          when Iir_Kind_Floating_Type_Definition =>
@@ -274,6 +277,7 @@ package body Synth.Decls is
                Btype : constant Type_Acc :=
                  Get_Value_Type (Syn_Inst, Get_Base_Type (Atype));
                Rng : Discrete_Range_Type;
+               W : Width;
             begin
                if Btype.Kind = Type_Bit then
                   --  A subtype of a bit type is still a bit.
@@ -281,7 +285,8 @@ package body Synth.Decls is
                else
                   Rng := Synth_Discrete_Range_Constraint
                     (Syn_Inst, Get_Range_Constraint (Atype));
-                  Typ := Create_Discrete_Type (Rng);
+                  W := Discrete_Range_Width (Rng);
+                  Typ := Create_Discrete_Type (Rng, W);
                end if;
             end;
          when Iir_Kind_Floating_Subtype_Definition =>
diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb
index f678c367f..61bf31534 100644
--- a/src/synth/synth-disp_vhdl.adb
+++ b/src/synth/synth-disp_vhdl.adb
@@ -97,7 +97,7 @@ package body Synth.Disp_Vhdl is
             else
                --  Any other enum.
                --  TODO: width = 1
-               W := Typ.Drange.W;
+               W := Typ.W;
                Disp_In_Lhs (Mname, Off, W, Full);
                Put ("std_logic_vector(to_unsigned(");
                Put (Name_Table.Image (Get_Identifier
@@ -107,7 +107,7 @@ package body Synth.Disp_Vhdl is
             end if;
          when Iir_Kind_Integer_Type_Definition =>
             --  FIXME: signed or unsigned ?
-            W := Typ.Drange.W;
+            W := Typ.W;
             Disp_In_Lhs (Mname, Off, W, Full);
             if W > 1 then
                Put ("std_logic_vector(");
@@ -211,7 +211,7 @@ package body Synth.Disp_Vhdl is
                Put_Line (";");
             else
                --  Any other enum.
-               W := Typ.Drange.W;
+               W := Typ.W;
                Put ("  " & Pfx & " <= ");
                Put (Name_Table.Image (Get_Identifier
                                         (Get_Type_Declarator (Ptype))));
@@ -221,7 +221,7 @@ package body Synth.Disp_Vhdl is
             end if;
          when Iir_Kind_Integer_Type_Definition =>
             --  FIXME: signed or unsigned ?
-            W := Typ.Drange.W;
+            W := Typ.W;
             Put ("  " & Pfx & " <= to_integer (unsigned");
             if W = 1 then
                Put ("'(0 => ");
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index d0abeec7b..b68637498 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -228,7 +228,7 @@ package body Synth.Expr is
    --  Resize for a discrete value.
    function Synth_Resize (Val : Value_Acc; W : Width; Loc : Node) return Net
    is
-      Wn : constant Width := Val.Typ.Drange.W;
+      Wn : constant Width := Val.Typ.W;
       N : Net;
       Res : Net;
    begin
@@ -547,49 +547,12 @@ package body Synth.Expr is
    end Vectorize_Array;
 
    function Synth_Discrete_Range_Expression
-     (L : Int64; R : Int64; Dir : Iir_Direction) return Discrete_Range_Type
-   is
-      V : Discrete_Range_Type;
-      Lo, Hi : Int64;
+     (L : Int64; R : Int64; Dir : Iir_Direction) return Discrete_Range_Type is
    begin
-      V.Dir := Dir;
-      V.Left := L;
-      V.Right := R;
-
-      case V.Dir is
-         when Iir_To =>
-            Lo := V.Left;
-            Hi := V.Right;
-         when Iir_Downto =>
-            Lo := V.Right;
-            Hi := V.Left;
-      end case;
-      if Lo > Hi then
-         --  Null range.
-         V.Is_Signed := False;
-         V.W := 0;
-      elsif Lo >= 0 then
-         --  Positive.
-         V.Is_Signed := False;
-         V.W := Width (Clog2 (Uns64 (Hi) + 1));
-      elsif Lo = Int64'First then
-         --  Handle possible overflow.
-         V.Is_Signed := True;
-         V.W := 64;
-      elsif Hi < 0 then
-         --  Negative only.
-         V.Is_Signed := True;
-         V.W := Width (Clog2 (Uns64 (-Lo))) + 1;
-      else
-         declare
-            Wl : constant Width := Width (Clog2 (Uns64 (-Lo)));
-            Wh : constant Width := Width (Clog2 (Uns64 (Hi)));
-         begin
-            V.Is_Signed := True;
-            V.W := Width'Max (Wl, Wh) + 1;
-         end;
-      end if;
-      return V;
+      return (Dir => Dir,
+              Left => L,
+              Right => R,
+              Is_Signed => L < 0 or R < 0);
    end Synth_Discrete_Range_Expression;
 
    function Synth_Discrete_Range_Expression
@@ -605,8 +568,10 @@ package body Synth.Expr is
          raise Internal_Error;
       end if;
 
-      return Synth_Discrete_Range_Expression
-        (L.Scal, R.Scal, Get_Direction (Rng));
+      return (Dir => Get_Direction (Rng),
+              Left => L.Scal,
+              Right => R.Scal,
+              Is_Signed => L.Scal < 0 or R.Scal < 0);
    end Synth_Discrete_Range_Expression;
 
    function Synth_Float_Range_Expression
@@ -639,31 +604,40 @@ package body Synth.Expr is
       end if;
    end Synth_Array_Attribute;
 
-   function Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; Bound : Node)
-                                 return Discrete_Range_Type is
+   procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc;
+                                   Bound : Node;
+                                   Rng : out Discrete_Range_Type;
+                                   W : out Width) is
    begin
       case Get_Kind (Bound) is
          when Iir_Kind_Range_Expression =>
-            return Synth_Discrete_Range_Expression (Syn_Inst, Bound);
+            Rng := Synth_Discrete_Range_Expression (Syn_Inst, Bound);
+            W := Discrete_Range_Width (Rng);
          when Iir_Kind_Integer_Subtype_Definition
            | Iir_Kind_Enumeration_Subtype_Definition =>
             if Get_Type_Declarator (Bound) /= Null_Node then
-               --  This is a named subtype, so it has been evaluated.
-               return Get_Value_Type (Syn_Inst, Bound).Drange;
+               declare
+                  Typ : Type_Acc;
+               begin
+                  --  This is a named subtype, so it has been evaluated.
+                  Typ := Get_Value_Type (Syn_Inst, Bound);
+                  Rng := Typ.Drange;
+                  W := Typ.W;
+               end;
             else
-               return Synth_Discrete_Range
-                 (Syn_Inst, Get_Range_Constraint (Bound));
+               Synth_Discrete_Range
+                 (Syn_Inst, Get_Range_Constraint (Bound), Rng, W);
             end if;
          when Iir_Kind_Range_Array_Attribute =>
             declare
                B : Bound_Type;
             begin
                B := Synth_Array_Attribute (Syn_Inst, Bound);
-               return Discrete_Range_Type'(Dir => B.Dir,
+               Rng := Discrete_Range_Type'(Dir => B.Dir,
                                            Is_Signed => True,
-                                           W => B.Wbounds,
                                            Left => Int64 (B.Left),
                                            Right => Int64 (B.Right));
+               W := B.Wbounds;
             end;
          when others =>
             Error_Kind ("synth_discrete_range", Bound);
@@ -704,9 +678,10 @@ package body Synth.Expr is
                                      Atype : Node) return Bound_Type
    is
       Rng : Discrete_Range_Type;
+      W : Width;
       Len : Int64;
    begin
-      Rng := Synth_Discrete_Range (Syn_Inst, Atype);
+      Synth_Discrete_Range (Syn_Inst, Atype, Rng, W);
       case Rng.Dir is
          when Iir_To =>
             Len := Rng.Right - Rng.Left + 1;
@@ -718,7 +693,7 @@ package body Synth.Expr is
       end if;
       return (Dir => Rng.Dir,
               Wlen => Width (Clog2 (Uns64 (Len))),
-              Wbounds => Rng.W,
+              Wbounds => W,
               Left => Int32 (Rng.Left), Right => Int32 (Rng.Right),
               Len => Uns32 (Len));
    end Synth_Bounds_From_Range;
@@ -851,13 +826,14 @@ package body Synth.Expr is
    is
       Res : Bound_Type;
       Index_Bounds : Discrete_Range_Type;
+      W : Width;
    begin
-      Index_Bounds := Synth_Discrete_Range (Syn_Inst, Atype);
+      Synth_Discrete_Range (Syn_Inst, Atype, Index_Bounds, W);
 
       Res := (Left => Int32 (Index_Bounds.Left),
               Right => 0,
               Dir => Index_Bounds.Dir,
-              Wbounds => Index_Bounds.W,
+              Wbounds => W,
               Wlen => Width (Clog2 (Uns64 (Len))),
               Len => Uns32 (Len));
 
@@ -894,18 +870,17 @@ package body Synth.Expr is
          when Type_Discrete =>
             pragma Assert (Vtype.Kind = Type_Discrete);
             declare
-               Vrng : Discrete_Range_Type renames Vtype.Drange;
-               Drng : Discrete_Range_Type renames Dtype.Drange;
                N : Net;
             begin
-               if Vrng.W > Drng.W then
+               if Vtype.W > Dtype.W then
                   --  Truncate.
                   --  TODO: check overflow.
                   case Val.Kind is
                      when Value_Net
                        | Value_Wire =>
                         N := Get_Net (Val);
-                        N := Build_Trunc (Build_Context, Id_Utrunc, N, Drng.W);
+                        N := Build_Trunc
+                          (Build_Context, Id_Utrunc, N, Dtype.W);
                         Set_Location (N, Loc);
                         return Create_Value_Net (N, Dtype);
                      when Value_Discrete =>
@@ -913,7 +888,7 @@ package body Synth.Expr is
                      when others =>
                         raise Internal_Error;
                   end case;
-               elsif Vrng.W < Drng.W then
+               elsif Vtype.W < Dtype.W then
                   --  Extend.
                   case Val.Kind is
                      when Value_Discrete =>
@@ -921,12 +896,12 @@ package body Synth.Expr is
                      when Value_Net
                        | Value_Wire =>
                         N := Get_Net (Val);
-                        if Vrng.Is_Signed then
+                        if Vtype.Drange.Is_Signed then
                            N := Build_Extend
-                             (Build_Context, Id_Sextend, N, Drng.W);
+                             (Build_Context, Id_Sextend, N, Dtype.W);
                         else
                            N := Build_Extend
-                             (Build_Context, Id_Uextend, N, Drng.W);
+                             (Build_Context, Id_Uextend, N, Dtype.W);
                         end if;
                         Set_Location (N, Loc);
                         return Create_Value_Net (N, Dtype);
@@ -2261,7 +2236,7 @@ package body Synth.Expr is
             begin
                return Create_Value_Net
                  (Synth_Uresize (Get_Net (Subprg_Inst.Objects (1)),
-                                 Nat_Type.Drange.W, Expr),
+                                 Nat_Type.W, Expr),
                   Nat_Type);
             end;
          when Iir_Predefined_Ieee_Numeric_Std_Resize_Uns_Nat =>
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index 6265a64dd..e199d8698 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -20,7 +20,7 @@
 
 with Ada.Unchecked_Conversion;
 with System;
-with Mutils;
+with Mutils; use Mutils;
 
 package body Synth.Values is
    function To_Bound_Array_Acc is new Ada.Unchecked_Conversion
@@ -52,20 +52,58 @@ package body Synth.Values is
       end case;
    end Is_Equal;
 
+   function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width
+   is
+      Lo, Hi : Int64;
+      W : Width;
+   begin
+      case Rng.Dir is
+         when Iir_To =>
+            Lo := Rng.Left;
+            Hi := Rng.Right;
+         when Iir_Downto =>
+            Lo := Rng.Right;
+            Hi := Rng.Left;
+      end case;
+      if Lo > Hi then
+         --  Null range.
+         W := 0;
+      elsif Lo >= 0 then
+         --  Positive.
+         W := Width (Clog2 (Uns64 (Hi) + 1));
+      elsif Lo = Int64'First then
+         --  Handle possible overflow.
+         W := 64;
+      elsif Hi < 0 then
+         --  Negative only.
+         W := Width (Clog2 (Uns64 (-Lo))) + 1;
+      else
+         declare
+            Wl : constant Width := Width (Clog2 (Uns64 (-Lo)));
+            Wh : constant Width := Width (Clog2 (Uns64 (Hi)));
+         begin
+            W := Width'Max (Wl, Wh) + 1;
+         end;
+      end if;
+      return W;
+   end Discrete_Range_Width;
+
    function Create_Bit_Type return Type_Acc
    is
       subtype Bit_Type_Type is Type_Type (Type_Bit);
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Bit_Type_Type);
    begin
-      return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Bit)));
+      return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Bit, W => 1)));
    end Create_Bit_Type;
 
-   function Create_Discrete_Type (Rng : Discrete_Range_Type) return Type_Acc
+   function Create_Discrete_Type (Rng : Discrete_Range_Type; W : Width)
+                                 return Type_Acc
    is
       subtype Discrete_Type_Type is Type_Type (Type_Discrete);
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Discrete_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Discrete,
+                                                W => W,
                                                 Drange => Rng)));
    end Create_Discrete_Type;
 
@@ -75,6 +113,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Float_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Float,
+                                                W => 64,
                                                 Frange => Rng)));
    end Create_Float_Type;
 
@@ -85,6 +124,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Vector_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Vector,
+                                                W => Bnd.Len,
                                                 Vbound => Bnd,
                                                 Vec_El => El_Type)));
    end Create_Vector_Type;
@@ -92,7 +132,7 @@ package body Synth.Values is
    function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc)
                                       return Type_Acc
    is
-      W : constant Width := Uns32 (Mutils.Clog2 (Uns64 (Len)));
+      W : constant Width := Uns32 (Clog2 (Uns64 (Len)));
    begin
       return Create_Vector_Type ((Dir => Iir_Downto,
                                   Wlen => W,
@@ -135,8 +175,14 @@ package body Synth.Values is
    is
       subtype Array_Type_Type is Type_Type (Type_Array);
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Array_Type_Type);
+      W : Width;
    begin
+      W := El_Type.W;
+      for I in Bnd.D'Range loop
+         W := W * Bnd.D (I).Len;
+      end loop;
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Array,
+                                                W => W,
                                                 Abounds => Bnd,
                                                 Arr_El => El_Type)));
    end Create_Array_Type;
@@ -147,6 +193,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Unbounded_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Array,
+                                                W => 0,
                                                 Uarr_El => El_Type)));
    end Create_Unbounded_Array;
 
@@ -198,7 +245,7 @@ package body Synth.Values is
       function Alloc is new Areapools.Alloc_On_Pool_Addr (Record_Type_Type);
    begin
       return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Record,
-                                                Rec_W => W,
+                                                W => W,
                                                 Rec => Els)));
    end Create_Record_Type;
 
@@ -441,28 +488,8 @@ package body Synth.Values is
 
    function Get_Type_Width (Atype : Type_Acc) return Width is
    begin
-      case Atype.Kind is
-         when Type_Bit =>
-            return 1;
-         when Type_Discrete =>
-            return Atype.Drange.W;
-         when Type_Vector =>
-            return Atype.Vbound.Len;
-         when Type_Array =>
-            declare
-               Res : Width;
-            begin
-               Res := Get_Type_Width (Atype.Arr_El);
-               for I in Atype.Abounds.D'Range loop
-                  Res := Res * Atype.Abounds.D (I).Len;
-               end loop;
-               return Res;
-            end;
-         when Type_Record =>
-            return Atype.Rec_W;
-         when others =>
-            raise Internal_Error;
-      end case;
+      pragma Assert (Atype.Kind /= Type_Unbounded_Array);
+      return Atype.W;
    end Get_Type_Width;
 
    procedure Init is
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index a0db0f5fb..fa6f0908f 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -32,12 +32,14 @@ package Synth.Values is
 
       --  Netlist representation: signed or unsigned, width of vector.
       Is_Signed : Boolean;
-      W : Width;
 
       Left : Int64;
       Right : Int64;
    end record;
 
+   --  Return the width of RNG.
+   function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width;
+
    type Float_Range_Type is record
       Dir : Iir_Direction;
       Left : Fp64;
@@ -95,6 +97,7 @@ package Synth.Values is
    type Rec_El_Array_Acc is access Rec_El_Array;
 
    type Type_Type (Kind : Type_Kind) is record
+      W : Width;
       case Kind is
          when Type_Bit =>
             null;
@@ -111,7 +114,6 @@ package Synth.Values is
          when Type_Unbounded_Array =>
             Uarr_El : Type_Acc;
          when Type_Record =>
-            Rec_W : Width;
             Rec : Rec_El_Array_Acc;
       end case;
    end record;
@@ -210,7 +212,8 @@ package Synth.Values is
    Instance_Pool : Areapool_Acc;
 
    --  Types.
-   function Create_Discrete_Type (Rng : Discrete_Range_Type) return Type_Acc;
+   function Create_Discrete_Type (Rng : Discrete_Range_Type; W : Width)
+                                 return Type_Acc;
    function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc;
    function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc)
                                       return Type_Acc;