synth: extract netlists-folds from netlists-builders.

11 files changed, 216 insertions, 160 deletions

diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb
index b1f9eb826..d7bb2c117 100644
--- a/src/synth/netlists-builders.adb
+++ b/src/synth/netlists-builders.adb
@@ -21,7 +21,6 @@
 with Types_Utils; use Types_Utils;
 with Name_Table; use Name_Table;
 with Std_Names; use Std_Names;
-with Netlists.Locations;
 
 package body Netlists.Builders is
    function Create_Input (Id : String; W : Width := 0) return Port_Desc is
@@ -831,69 +830,6 @@ package body Netlists.Builders is
       return Inst;
    end Build_Const_Log;
 
-   function Build2_Const_Uns (Ctxt : Context_Acc; Val : Uns64; W : Width)
-                             return Net is
-   begin
-      if Val < 2**32 then
-         return Build_Const_UB32 (Ctxt, Uns32 (Val), W);
-      else
-         pragma Assert (W > 32);
-         declare
-            Inst : Instance;
-         begin
-            Inst := Build_Const_Bit (Ctxt, W);
-            Set_Param_Uns32 (Inst, 0, Uns32 (Val and 16#ffff_ffff#));
-            Set_Param_Uns32 (Inst, 1, Uns32 (Shift_Right (Val, 32)));
-            for I in 2 .. (W + 31) / 32 loop
-               Set_Param_Uns32 (Inst, Param_Idx (I), 0);
-            end loop;
-            return Get_Output (Inst, 0);
-         end;
-      end if;
-   end Build2_Const_Uns;
-
-   function Build2_Const_Vec (Ctxt : Context_Acc; W : Width; V : Uns32_Arr)
-                             return Net is
-   begin
-      if W <= 32 then
-         return Build_Const_UB32 (Ctxt, V (V'First), W);
-      else
-         declare
-            Inst : Instance;
-         begin
-            Inst := Build_Const_Bit (Ctxt, W);
-            for I in V'Range loop
-               Set_Param_Uns32 (Inst, Param_Idx (I - V'First), V (I));
-            end loop;
-            return Get_Output (Inst, 0);
-         end;
-      end if;
-   end Build2_Const_Vec;
-
-   function Build2_Const_Int (Ctxt : Context_Acc; Val : Int64; W : Width)
-                             return Net is
-   begin
-      if Val in -2**31 .. 2**31 - 1 then
-         return Build_Const_SB32 (Ctxt, Int32 (Val), W);
-      else
-         pragma Assert (W > 32);
-         declare
-            V : constant Uns64 := To_Uns64 (Val);
-            S : constant Uns32 :=
-              Uns32 (Shift_Right_Arithmetic (V, 63) and 16#ffff_ffff#);
-            Inst : Instance;
-         begin
-            Inst := Build_Const_Bit (Ctxt, W);
-            Set_Param_Uns32 (Inst, 0, Uns32 (V and 16#ffff_ffff#));
-            Set_Param_Uns32 (Inst, 1, Uns32 (Shift_Right (V, 32)));
-            for I in 2 .. (W + 31) / 32 loop
-               Set_Param_Uns32 (Inst, Param_Idx (I), S);
-            end loop;
-            return Get_Output (Inst, 0);
-         end;
-      end if;
-   end Build2_Const_Int;
-
    function Build_Edge (Ctxt : Context_Acc; Src : Net) return Net
    is
       pragma Assert (Get_Width (Src) = 1);
@@ -1012,42 +948,6 @@ package body Netlists.Builders is
       return O;
    end Build_Concatn;
 
-   function Build2_Concat (Ctxt : Context_Acc; Els : Net_Array) return Net
-   is
-      F : constant Int32 := Els'First;
-      Len : constant Natural := Els'Length;
-      Wd : Width;
-      Inst : Instance;
-      N : Net;
-   begin
-      case Len is
-         when 0 =>
-            raise Internal_Error;
-         when 1 =>
-            N := Els (F);
-         when 2 =>
-            N := Build_Concat2 (Ctxt, Els (F + 1), Els (F));
-         when 3 =>
-            N := Build_Concat3 (Ctxt, Els (F + 2), Els (F + 1), Els (F));
-         when 4 =>
-            N := Build_Concat4
-              (Ctxt, Els (F + 3), Els (F + 2), Els (F + 1), Els (F));
-         when 5 .. Natural'Last =>
-            --  Compute length.
-            Wd := 0;
-            for I in Els'Range loop
-               Wd := Wd + Get_Width (Els (I));
-            end loop;
-
-            N := Build_Concatn (Ctxt, Wd, Uns32 (Len));
-            Inst := Get_Net_Parent (N);
-            for I in Els'Range loop
-               Connect (Get_Input (Inst, Port_Idx (Els'Last - I)), Els (I));
-            end loop;
-      end case;
-      return N;
-   end Build2_Concat;
-
    function Build_Trunc
      (Ctxt : Context_Acc; Id : Module_Id; I : Net; W : Width) return Net
    is
@@ -1076,29 +976,6 @@ package body Netlists.Builders is
       return O;
    end Build_Extend;
 
-   function Build2_Uresize (Ctxt : Context_Acc;
-                            I : Net;
-                            W : Width;
-                            Loc : Location_Type := No_Location)
-                           return Net
-   is
-      Wn : constant Width := Get_Width (I);
-      Res : Net;
-   begin
-      if Wn = W then
-         return I;
-      else
-         if Wn > W then
-            Res := Build_Trunc (Ctxt, Id_Utrunc, I, W);
-         else
-            pragma Assert (Wn < W);
-            Res := Build_Extend (Ctxt, Id_Uextend, I, W);
-         end if;
-         Locations.Set_Location (Res, Loc);
-         return Res;
-      end if;
-   end Build2_Uresize;
-
    function Build_Dyn_Insert
      (Ctxt : Context_Acc; I : Net; V : Net; P : Net; Off : Uns32) return Net
    is
@@ -1410,16 +1287,6 @@ package body Netlists.Builders is
       return O;
    end Build_Extract;
 
-   function Build2_Extract
-     (Ctxt : Context_Acc; I : Net; Off, W : Width) return Net is
-   begin
-      if Off = 0 and then W = Get_Width (I) then
-         return I;
-      else
-         return Build_Extract (Ctxt, I, Off, W);
-      end if;
-   end Build2_Extract;
-
    function Build_Dyn_Extract
      (Ctxt : Context_Acc; I : Net; P : Net; Off : Uns32; W : Width) return Net
    is
diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads
index bff411e64..4a761738b 100644
--- a/src/synth/netlists-builders.ads
+++ b/src/synth/netlists-builders.ads
@@ -76,17 +76,6 @@ package Netlists.Builders is
                               Val : Int32;
                               W : Width) return Net;
 
-   --  Build a const from VAL.  Result is either a Const_UB32 or a Const_Bit.
-   function Build2_Const_Uns (Ctxt : Context_Acc; Val : Uns64; W : Width)
-                             return Net;
-
-   --  Build a const from VAL.  Result is either a Const_SB32 or a Const_Bit.
-   function Build2_Const_Int (Ctxt : Context_Acc; Val : Int64; W : Width)
-                             return Net;
-
-   function Build2_Const_Vec (Ctxt : Context_Acc; W : Width; V : Uns32_Arr)
-                             return Net;
-
    --  Large constants.
    --  Bit means only 0 or 1.
    --  Log means 0/1/Z/X.  Parameters 2N are aval, 2N+1 are bval.
@@ -114,29 +103,14 @@ package Netlists.Builders is
    function Build_Concatn (Ctxt : Context_Acc; W : Width; Nbr_Inputs : Uns32)
                           return Net;
 
-   --  Concatenate nets of ELS in reverse order.  So if ELS(L .. R), then
-   --  ELS(L) will be at offset 0.
-   function Build2_Concat (Ctxt : Context_Acc; Els : Net_Array) return Net;
-
    function Build_Trunc
      (Ctxt : Context_Acc; Id : Module_Id; I : Net; W : Width) return Net;
    function Build_Extend
      (Ctxt : Context_Acc; Id : Module_Id; I : Net; W : Width) return Net;
 
-   --  Zero extend, noop or truncate I so that its width is W.
-   function Build2_Uresize (Ctxt : Context_Acc;
-                            I : Net;
-                            W : Width;
-                            Loc : Location_Type := No_Location)
-                           return Net;
-
    function Build_Extract
      (Ctxt : Context_Acc; I : Net; Off, W : Width) return Net;
 
-   --  Same as Build_Extract, but return I iff extract all the bits.
-   function Build2_Extract
-     (Ctxt : Context_Acc; I : Net; Off, W : Width) return Net;
-
    function Build_Extract_Bit
      (Ctxt : Context_Acc; I : Net; Off : Width) return Net;
    function Build_Dyn_Extract
diff --git a/src/synth/netlists-concats.adb b/src/synth/netlists-concats.adb
index 0aacd9ec6..d8df7bbc3 100644
--- a/src/synth/netlists-concats.adb
+++ b/src/synth/netlists-concats.adb
@@ -18,6 +18,8 @@
 --  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
 --  MA 02110-1301, USA.
 
+with Netlists.Folds; use Netlists.Folds;
+
 package body Netlists.Concats is
    procedure Append (C : in out Concat_Type; N : Net) is
    begin
diff --git a/src/synth/netlists-expands.adb b/src/synth/netlists-expands.adb
index a34302ef8..37b00d64e 100644
--- a/src/synth/netlists-expands.adb
+++ b/src/synth/netlists-expands.adb
@@ -26,6 +26,7 @@ with Netlists.Butils; use Netlists.Butils;
 with Netlists.Locations; use Netlists.Locations;
 with Netlists.Memories; use Netlists.Memories;
 with Netlists.Concats; use Netlists.Concats;
+with Netlists.Folds; use Netlists.Folds;
 
 package body Netlists.Expands is
    type Memidx_Array_Type is array (Natural range <>) of Instance;
diff --git a/src/synth/netlists-folds.adb b/src/synth/netlists-folds.adb
new file mode 100644
index 000000000..a360c2a49
--- /dev/null
+++ b/src/synth/netlists-folds.adb
@@ -0,0 +1,159 @@
+--  Highler level API to build a netlist - do some optimizations.
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program; if not, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+--  MA 02110-1301, USA.
+
+with Types_Utils; use Types_Utils;
+
+with Netlists.Gates; use Netlists.Gates;
+with Netlists.Locations;
+
+package body Netlists.Folds is
+
+   function Build2_Const_Uns (Ctxt : Context_Acc; Val : Uns64; W : Width)
+                             return Net is
+   begin
+      if Val < 2**32 then
+         return Build_Const_UB32 (Ctxt, Uns32 (Val), W);
+      else
+         pragma Assert (W > 32);
+         declare
+            Inst : Instance;
+         begin
+            Inst := Build_Const_Bit (Ctxt, W);
+            Set_Param_Uns32 (Inst, 0, Uns32 (Val and 16#ffff_ffff#));
+            Set_Param_Uns32 (Inst, 1, Uns32 (Shift_Right (Val, 32)));
+            for I in 2 .. (W + 31) / 32 loop
+               Set_Param_Uns32 (Inst, Param_Idx (I), 0);
+            end loop;
+            return Get_Output (Inst, 0);
+         end;
+      end if;
+   end Build2_Const_Uns;
+
+   function Build2_Const_Vec (Ctxt : Context_Acc; W : Width; V : Uns32_Arr)
+                             return Net is
+   begin
+      if W <= 32 then
+         return Build_Const_UB32 (Ctxt, V (V'First), W);
+      else
+         declare
+            Inst : Instance;
+         begin
+            Inst := Build_Const_Bit (Ctxt, W);
+            for I in V'Range loop
+               Set_Param_Uns32 (Inst, Param_Idx (I - V'First), V (I));
+            end loop;
+            return Get_Output (Inst, 0);
+         end;
+      end if;
+   end Build2_Const_Vec;
+
+   function Build2_Const_Int (Ctxt : Context_Acc; Val : Int64; W : Width)
+                             return Net is
+   begin
+      if Val in -2**31 .. 2**31 - 1 then
+         return Build_Const_SB32 (Ctxt, Int32 (Val), W);
+      else
+         pragma Assert (W > 32);
+         declare
+            V : constant Uns64 := To_Uns64 (Val);
+            S : constant Uns32 :=
+              Uns32 (Shift_Right_Arithmetic (V, 63) and 16#ffff_ffff#);
+            Inst : Instance;
+         begin
+            Inst := Build_Const_Bit (Ctxt, W);
+            Set_Param_Uns32 (Inst, 0, Uns32 (V and 16#ffff_ffff#));
+            Set_Param_Uns32 (Inst, 1, Uns32 (Shift_Right (V, 32)));
+            for I in 2 .. (W + 31) / 32 loop
+               Set_Param_Uns32 (Inst, Param_Idx (I), S);
+            end loop;
+            return Get_Output (Inst, 0);
+         end;
+      end if;
+   end Build2_Const_Int;
+
+   function Build2_Concat (Ctxt : Context_Acc; Els : Net_Array) return Net
+   is
+      F : constant Int32 := Els'First;
+      Len : constant Natural := Els'Length;
+      Wd : Width;
+      Inst : Instance;
+      N : Net;
+   begin
+      case Len is
+         when 0 =>
+            raise Internal_Error;
+         when 1 =>
+            N := Els (F);
+         when 2 =>
+            N := Build_Concat2 (Ctxt, Els (F + 1), Els (F));
+         when 3 =>
+            N := Build_Concat3 (Ctxt, Els (F + 2), Els (F + 1), Els (F));
+         when 4 =>
+            N := Build_Concat4
+              (Ctxt, Els (F + 3), Els (F + 2), Els (F + 1), Els (F));
+         when 5 .. Natural'Last =>
+            --  Compute length.
+            Wd := 0;
+            for I in Els'Range loop
+               Wd := Wd + Get_Width (Els (I));
+            end loop;
+
+            N := Build_Concatn (Ctxt, Wd, Uns32 (Len));
+            Inst := Get_Net_Parent (N);
+            for I in Els'Range loop
+               Connect (Get_Input (Inst, Port_Idx (Els'Last - I)), Els (I));
+            end loop;
+      end case;
+      return N;
+   end Build2_Concat;
+
+   function Build2_Uresize (Ctxt : Context_Acc;
+                            I : Net;
+                            W : Width;
+                            Loc : Location_Type := No_Location)
+                           return Net
+   is
+      Wn : constant Width := Get_Width (I);
+      Res : Net;
+   begin
+      if Wn = W then
+         return I;
+      else
+         if Wn > W then
+            Res := Build_Trunc (Ctxt, Id_Utrunc, I, W);
+         else
+            pragma Assert (Wn < W);
+            Res := Build_Extend (Ctxt, Id_Uextend, I, W);
+         end if;
+         Locations.Set_Location (Res, Loc);
+         return Res;
+      end if;
+   end Build2_Uresize;
+
+   function Build2_Extract
+     (Ctxt : Context_Acc; I : Net; Off, W : Width) return Net is
+   begin
+      if Off = 0 and then W = Get_Width (I) then
+         return I;
+      else
+         return Build_Extract (Ctxt, I, Off, W);
+      end if;
+   end Build2_Extract;
+end Netlists.Folds;
diff --git a/src/synth/netlists-folds.ads b/src/synth/netlists-folds.ads
new file mode 100644
index 000000000..bd417162f
--- /dev/null
+++ b/src/synth/netlists-folds.ads
@@ -0,0 +1,48 @@
+--  Highler level API to build a netlist - do some optimizations.
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program is free software; you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation; either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program; if not, write to the Free Software
+--  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+--  MA 02110-1301, USA.
+
+with Netlists.Builders; use Netlists.Builders;
+
+package Netlists.Folds is
+   --  Build a const from VAL.  Result is either a Const_UB32 or a Const_Bit.
+   function Build2_Const_Uns (Ctxt : Context_Acc; Val : Uns64; W : Width)
+                             return Net;
+
+   --  Build a const from VAL.  Result is either a Const_SB32 or a Const_Bit.
+   function Build2_Const_Int (Ctxt : Context_Acc; Val : Int64; W : Width)
+                             return Net;
+
+   function Build2_Const_Vec (Ctxt : Context_Acc; W : Width; V : Uns32_Arr)
+                             return Net;
+
+   --  Concatenate nets of ELS in reverse order.  So if ELS(L .. R), then
+   --  ELS(L) will be at offset 0.
+   function Build2_Concat (Ctxt : Context_Acc; Els : Net_Array) return Net;
+
+   --  Zero extend, noop or truncate I so that its width is W.
+   function Build2_Uresize (Ctxt : Context_Acc;
+                            I : Net;
+                            W : Width;
+                            Loc : Location_Type := No_Location)
+                           return Net;
+   --  Same as Build_Extract, but return I iff extract all the bits.
+   function Build2_Extract
+     (Ctxt : Context_Acc; I : Net; Off, W : Width) return Net;
+end Netlists.Folds;
diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb
index 63661a82e..a0a904795 100644
--- a/src/synth/synth-decls.adb
+++ b/src/synth/synth-decls.adb
@@ -22,6 +22,7 @@ with Types; use Types;
 with Mutils; use Mutils;
 with Netlists; use Netlists;
 with Netlists.Builders; use Netlists.Builders;
+with Netlists.Folds; use Netlists.Folds;
 
 with Vhdl.Errors; use Vhdl.Errors;
 with Vhdl.Utils; use Vhdl.Utils;
diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb
index 42676f896..d1b14cc64 100644
--- a/src/synth/synth-environment.adb
+++ b/src/synth/synth-environment.adb
@@ -23,6 +23,7 @@ with Netlists.Concats;
 with Netlists.Gates;
 with Netlists.Gates_Ports;
 with Netlists.Utils; use Netlists.Utils;
+with Netlists.Folds; use Netlists.Folds;
 
 with Errorout; use Errorout;
 
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb
index c34616d14..f1bdeeead 100644
--- a/src/synth/synth-expr.adb
+++ b/src/synth/synth-expr.adb
@@ -23,16 +23,17 @@ with Types_Utils; use Types_Utils;
 with Std_Names;
 with Str_Table;
 with Mutils; use Mutils;
+
 with Vhdl.Ieee.Std_Logic_1164; use Vhdl.Ieee.Std_Logic_1164;
 with Vhdl.Std_Package;
 with Vhdl.Errors; use Vhdl.Errors;
 with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Evaluation; use Vhdl.Evaluation;
-
 with Vhdl.Annotations; use Vhdl.Annotations;
 
 with Netlists.Gates; use Netlists.Gates;
 with Netlists.Builders; use Netlists.Builders;
+with Netlists.Folds; use Netlists.Folds;
 
 with Synth.Errors; use Synth.Errors;
 with Synth.Environment;
diff --git a/src/synth/synth-inference.adb b/src/synth/synth-inference.adb
index e66a8a386..30aa7ac21 100644
--- a/src/synth/synth-inference.adb
+++ b/src/synth/synth-inference.adb
@@ -24,6 +24,7 @@ with Netlists.Gates_Ports; use Netlists.Gates_Ports;
 with Netlists.Locations; use Netlists.Locations;
 with Netlists.Errors; use Netlists.Errors;
 with Netlists.Internings;
+with Netlists.Folds; use Netlists.Folds;
 
 with Synth.Flags;
 with Synth.Source; use Synth.Source;
diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb
index c394df158..19e376444 100644
--- a/src/synth/synth-oper.adb
+++ b/src/synth/synth-oper.adb
@@ -31,6 +31,7 @@ with Areapools;
 with Netlists; use Netlists;
 with Netlists.Gates; use Netlists.Gates;
 with Netlists.Builders; use Netlists.Builders;
+with Netlists.Folds; use Netlists.Folds;
 
 with Synth.Errors; use Synth.Errors;
 with Synth.Stmts; use Synth.Stmts;