netlists: optimize trunc.

4 files changed, 64 insertions, 8 deletions

diff --git a/src/synth/netlists-folds.adb b/src/synth/netlists-folds.adb
index 9028c15ea..6b8a57fb8 100644
--- a/src/synth/netlists-folds.adb
+++ b/src/synth/netlists-folds.adb
@@ -22,7 +22,7 @@ with Types_Utils; use Types_Utils;
 
 with Netlists.Gates; use Netlists.Gates;
 with Netlists.Utils; use Netlists.Utils;
-with Netlists.Locations;
+with Netlists.Locations; use Netlists.Locations;
 
 package body Netlists.Folds is
 
@@ -125,6 +125,53 @@ package body Netlists.Folds is
       return N;
    end Build2_Concat;
 
+   function Build2_Trunc (Ctxt : Context_Acc;
+                          Id : Module_Id;
+                          I : Net;
+                          W : Width;
+                          Loc : Location_Type)
+                         return Net
+   is
+      I_Inst : constant Instance := Get_Net_Parent (I);
+      I_Id : constant Module_Id := Get_Id (I_Inst);
+      Res : Net;
+   begin
+      if I_Id not in Extend_Module_Id then
+         Res := Build_Trunc (Ctxt, Id, I, W);
+         Set_Location (Res, Loc);
+         return Res;
+      end if;
+
+      --  So there are 3 widths:
+      --    W: the width of the result
+      --    Iw : the width of the input
+      --    Vw : the width of the original value.
+      --  And we have:
+      --    Iw > W (as we truncate)
+      --    Iw > Vw  (as V was extended)
+      declare
+         Iw : constant Width := Get_Width (I);
+         V : constant Net := Get_Input_Net (I_Inst, 0);
+         Vw : constant Width := Get_Width (V);
+         pragma Assert (Iw > W);
+         pragma Assert (Iw > Vw);
+      begin
+         if W = Vw then
+            --  Truncation of an extension with no size change -> no-op.
+            return V;
+         elsif W < Vw then
+            --  At the end, the initial value is truncated.
+            Res := Build_Trunc (Ctxt, Id, V, W);
+         else
+            pragma Assert (W > Vw);
+            --  Just extend less.
+            Res := Build_Extend (Ctxt, I_Id, V, W);
+         end if;
+         Set_Location (Res, Loc);
+         return Res;
+      end;
+   end Build2_Trunc;
+
    function Build2_Uresize (Ctxt : Context_Acc;
                             I : Net;
                             W : Width;
@@ -155,7 +202,7 @@ package body Netlists.Folds is
             end;
          else
             if Wn > W then
-               Res := Build_Trunc (Ctxt, Id_Utrunc, I, W);
+               return Build2_Trunc (Ctxt, Id_Utrunc, I, W, Loc);
             else
                pragma Assert (Wn < W);
                Res := Build_Extend (Ctxt, Id_Uextend, I, W);
@@ -190,13 +237,13 @@ package body Netlists.Folds is
             end;
          else
             if Wn > W then
-               Res := Build_Trunc (Ctxt, Id_Strunc, I, W);
+               return Build2_Trunc (Ctxt, Id_Strunc, I, W, Loc);
             else
                pragma Assert (Wn < W);
                Res := Build_Extend (Ctxt, Id_Sextend, I, W);
             end if;
          end if;
-         Locations.Set_Location (Res, Loc);
+         Set_Location (Res, Loc);
          return Res;
       end if;
    end Build2_Sresize;
diff --git a/src/synth/netlists-folds.ads b/src/synth/netlists-folds.ads
index 22ab60949..c789037b8 100644
--- a/src/synth/netlists-folds.ads
+++ b/src/synth/netlists-folds.ads
@@ -36,6 +36,14 @@ package Netlists.Folds is
    --  ELS(L) will be at offset 0.
    function Build2_Concat (Ctxt : Context_Acc; Els : Net_Array) return Net;
 
+   --  Truncate I to width W.  Merge if the input is an extend.
+   function Build2_Trunc (Ctxt : Context_Acc;
+                          Id : Module_Id;
+                          I : Net;
+                          W : Width;
+                          Loc : Location_Type)
+                         return Net;
+
    --  Zero extend, noop or truncate I so that its width is W.
    function Build2_Uresize (Ctxt : Context_Acc;
                             I : Net;
diff --git a/src/synth/netlists-memories.adb b/src/synth/netlists-memories.adb
index 07c063cbf..d41468f86 100644
--- a/src/synth/netlists-memories.adb
+++ b/src/synth/netlists-memories.adb
@@ -26,6 +26,7 @@ with Netlists.Locations; use Netlists.Locations;
 with Netlists.Internings;
 with Netlists.Errors; use Netlists.Errors;
 with Netlists.Concats;
+with Netlists.Folds; use Netlists.Folds;
 
 with Synth.Errors; use Synth.Errors;
 
@@ -354,7 +355,8 @@ package body Netlists.Memories is
             end if;
             if Addr_W > Max_W then
                --  Need to truncate.
-               Sub_Addr1 := Build_Trunc (Ctxt, Id_Utrunc, Sub_Addr, Max_W);
+               Sub_Addr1 := Build2_Trunc
+                 (Ctxt, Id_Utrunc, Sub_Addr, Max_W, No_Location);
             else
                Sub_Addr1 := Sub_Addr;
             end if;
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index b848265a6..f3722595f 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -161,9 +161,8 @@ package body Synth.Expr is
 
       N := Get_Net (Val);
       if Wn > W then
-         Res := Build_Trunc (Build_Context, Id_Utrunc, N, W);
-         Set_Location (Res, Loc);
-         return Res;
+         return Build2_Trunc (Build_Context, Id_Utrunc, N, W,
+                              Get_Location (Loc));
       elsif Wn < W then
          if Val.Typ.Drange.Is_Signed then
             Res := Build_Extend (Build_Context, Id_Sextend, N, W);