synth-values-debug: add debug_typ.

2 files changed, 48 insertions, 0 deletions

diff --git a/src/synth/synth-values-debug.adb b/src/synth/synth-values-debug.adb
index fd797d81c..7be7d667d 100644
--- a/src/synth/synth-values-debug.adb
+++ b/src/synth/synth-values-debug.adb
@@ -40,6 +40,53 @@ package body Synth.Values.Debug is
       Put (']');
    end Debug_Bound;
 
+   procedure Debug_Typ1 (T : Type_Acc) is
+   begin
+      case T.Kind is
+         when Type_Bit
+           | Type_Logic =>
+            Put ("bit/logic");
+         when Type_Vector =>
+            Put ("vector (");
+            Debug_Bound (T.Vbound);
+            Put (") of ");
+            Debug_Typ1 (T.Vec_El);
+         when Type_Array =>
+            Put ("arr (");
+            for I in 1 .. T.Abounds.Ndim loop
+               if I > 1 then
+                  Put (", ");
+               end if;
+               Debug_Bound (T.Abounds.D (I));
+            end loop;
+            Put (") of ");
+            Debug_Typ1 (T.Arr_El);
+         when Type_Record =>
+            Put ("rec: (");
+            Put (")");
+         when Type_Discrete =>
+            Put ("discrete: ");
+         when Type_Access =>
+            Put ("access");
+         when Type_File =>
+            Put ("file");
+         when Type_Float =>
+            Put ("float");
+         when Type_Slice =>
+            Put ("slice");
+         when Type_Unbounded_Vector =>
+            Put ("unbounded vector");
+         when Type_Unbounded_Array =>
+            Put ("unbounded array");
+      end case;
+   end Debug_Typ1;
+
+   procedure Debug_Typ (T : Type_Acc) is
+   begin
+      Debug_Typ1 (T);
+      New_Line;
+   end Debug_Typ;
+
    procedure Debug_Memtyp (M : Memtyp) is
    begin
       case M.Typ.Kind is
diff --git a/src/synth/synth-values-debug.ads b/src/synth/synth-values-debug.ads
index 8084b7ef6..991b68d40 100644
--- a/src/synth/synth-values-debug.ads
+++ b/src/synth/synth-values-debug.ads
@@ -21,4 +21,5 @@
 package Synth.Values.Debug is
    procedure Debug_Valtyp (V : Valtyp);
    procedure Debug_Memtyp (M : Memtyp);
+   procedure Debug_Typ (T : Type_Acc);
 end Synth.Values.Debug;