synth-insts: handle record in generics.

2 files changed, 57 insertions, 23 deletions

diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index 2824e4ce3..95597ea5d 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -183,7 +183,9 @@ package body Synth.Insts is
       end case;
    end Hash_Bounds;
 
-   procedure Hash_Const (C : in out GNAT.SHA1.Context; Val : Value_Acc) is
+   procedure Hash_Const (C : in out GNAT.SHA1.Context;
+                         Val : Value_Acc;
+                         Typ : Type_Acc) is
    begin
       case Val.Kind is
          when Value_Discrete =>
@@ -191,18 +193,27 @@ package body Synth.Insts is
          when Value_Float =>
             Hash_Uns64 (C, To_Uns64 (Val.Fp));
          when Value_Const_Array =>
-            --  Bounds.
-            Hash_Bounds (C, Val.Typ);
-            --  Values.
-            for I in Val.Arr.V'Range loop
-               Hash_Const (C, Val.Arr.V (I));
-            end loop;
+            declare
+               El_Typ : constant Type_Acc := Get_Array_Element (Typ);
+            begin
+               --  Bounds.
+               Hash_Bounds (C, Typ);
+               --  Values.
+               for I in Val.Arr.V'Range loop
+                  Hash_Const (C, Val.Arr.V (I), El_Typ);
+               end loop;
+            end;
          when Value_Const_Record =>
             for I in Val.Rec.V'Range loop
-               Hash_Const (C, Val.Rec.V (I));
+               Hash_Const (C, Val.Rec.V (I), Typ.Rec.E (I).Typ);
             end loop;
          when Value_Const =>
-            Hash_Const (C, Val.C_Val);
+            Hash_Const (C, Val.C_Val, Typ);
+         when Value_Alias =>
+            if Val.A_Off /= 0 then
+               raise Internal_Error;
+            end if;
+            Hash_Const (C, Val.A_Obj, Typ);
          when Value_Net
            | Value_Wire
            | Value_Array
@@ -210,7 +221,6 @@ package body Synth.Insts is
            | Value_Access
            | Value_File
            | Value_Instance
-           | Value_Alias
            | Value_Subtype =>
             raise Internal_Error;
       end case;
@@ -263,7 +273,7 @@ package body Synth.Insts is
                      begin
                         if Len + S'Length > Str_Len then
                            Has_Hash := True;
-                           Hash_Const (Ctxt, Gen);
+                           Hash_Const (Ctxt, Gen, Gen.Typ);
                         else
                            Str (Len + 1 .. Len + S'Length) := S;
                            pragma Assert (Str (Len + 1) = ' ');
@@ -273,7 +283,7 @@ package body Synth.Insts is
                      end;
                   when others =>
                      Has_Hash := True;
-                     Hash_Const (Ctxt, Gen);
+                     Hash_Const (Ctxt, Gen, Gen.Typ);
                end case;
                Gen_Decl := Get_Chain (Gen_Decl);
             end loop;
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index bd0fc9f61..7381c9f78 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -118,32 +118,56 @@ package body Synth.Values is
       end case;
    end Is_Bounded_Type;
 
-   function Is_Equal (L, R : Value_Acc) return Boolean is
+   function Strip_Alias_Const (V : Value_Acc) return Value_Acc
+   is
+      Res : Value_Acc;
+   begin
+      Res := V;
+      loop
+         case Res.Kind is
+            when Value_Const =>
+               Res := Res.C_Val;
+            when Value_Alias =>
+               if Res.A_Off /= 0 then
+                  raise Internal_Error;
+               end if;
+               Res := Res.A_Obj;
+            when others =>
+               return Res;
+         end case;
+      end loop;
+   end Strip_Alias_Const;
+
+   function Is_Equal (L, R : Value_Acc) return Boolean
+   is
+      L1 : constant Value_Acc := Strip_Alias_Const (L);
+      R1 : constant Value_Acc := Strip_Alias_Const (R);
    begin
-      if L.Kind /= R.Kind then
+      pragma Unreferenced (L, R);
+      if L1.Kind /= R1.Kind then
          return False;
       end if;
-      if L = R then
+      if L1 = R1 then
          return True;
       end if;
 
-      case L.Kind is
+      case L1.Kind is
          when Value_Discrete =>
-            return L.Scal = R.Scal;
+            return L1.Scal = R1.Scal;
+         when Value_Float =>
+            return L1.Fp = R1.Fp;
          when Value_Const_Array =>
-            if L.Arr.Len /= R.Arr.Len then
+            if L1.Arr.Len /= R1.Arr.Len then
                return False;
             end if;
-            for I in L.Arr.V'Range loop
-               if not Is_Equal (L.Arr.V (I), R.Arr.V (I)) then
+            for I in L1.Arr.V'Range loop
+               if not Is_Equal (L1.Arr.V (I), R1.Arr.V (I)) then
                   return False;
                end if;
             end loop;
             return True;
          when Value_Const =>
-            return Is_Equal (L.C_Val, R.C_Val);
-         when Value_Float =>
-            return L.Fp = R.Fp;
+            raise Internal_Error;
          when others =>
             --  TODO.
             raise Internal_Error;