flists is now a generic package, add vhdl-flists

4 files changed, 22 insertions, 213 deletions

diff --git a/src/vhdl/flists.adb b/src/vhdl/flists.adb
deleted file mode 100644
index 4c8067542..000000000
--- a/src/vhdl/flists.adb
+++ /dev/null
@@ -1,161 +0,0 @@
---  Fixed-length lists.
---  Copyright (C) 2017 Tristan Gingold
---
---  GHDL 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, or (at your option) any later
---  version.
---
---  GHDL 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 GHDL; see the file COPYING.  If not, write to the Free
---  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
---  02111-1307, USA.
-
-with Tables;
-
-package body Flists is
-   --  Index of elements.
-   type El_Index_Type is new Int32;
-
-   --  Describe an flist.
-   type Entry_Type is record
-      --  Index of the first element (in the element table).
-      Els : El_Index_Type;
-
-      --  Length of the list.
-      Len : Nat32;
-   end record;
-
-   --  Flists descriptors.
-   package Flistt is new Tables
-     (Table_Component_Type => Entry_Type,
-      Table_Index_Type => Flist_Type,
-      Table_Low_Bound => 4,
-      Table_Initial => 32);
-
-   --  Table of all elements.
-   package Els is new Tables
-     (Table_Component_Type => Node_Type,
-      Table_Index_Type => El_Index_Type,
-      Table_Low_Bound => 0,
-      Table_Initial => 128);
-
-   type Flist_Array is array (Natural range <>) of Flist_Type;
-
-   --  Linked list of free flist.  For length less than the last index, the
-   --  index corresponds to the length.  All free lists whose length is equal
-   --  or greater than the last index are grouped to the last index.
-   Free_Flists : Flist_Array (0 .. 16) := (others => Null_Flist);
-
-   --  Get the chain for a free flist for large length.  It is stored at the
-   --  first element of the list.
-   function Free_Next (Flist : Flist_Type) return Flist_Type is
-   begin
-      return Flist_Type (Els.Table (Flistt.Table (Flist).Els));
-   end Free_Next;
-
-   function Create_Flist (Len : Natural) return Flist_Type
-   is
-      Res : Flist_Type;
-      Prev : Flist_Type;
-      Next : Flist_Type;
-   begin
-      if Len >= Free_Flists'Last then
-         --  Large length.
-         Res := Free_Flists (Free_Flists'Last);
-         Prev := Null_Flist;
-         while Res /= Null_Flist and then Length (Res) /= Len loop
-            Prev := Res;
-            Res := Free_Next (Res);
-         end loop;
-         if Res /= Null_Flist then
-            Next := Free_Next (Res);
-            if Prev = Null_Flist then
-               Free_Flists (Free_Flists'Last) := Next;
-            else
-               Els.Table (Flistt.Table (Prev).Els) := Node_Type (Next);
-            end if;
-         end if;
-      else
-         --  Small length.  The Len field contains the next free list.
-         Res := Free_Flists (Len);
-         if Res /= Null_Flist then
-            Free_Flists (Len) := Flist_Type (Flistt.Table (Res).Len);
-            Flistt.Table (Res).Len := Nat32 (Len);
-         elsif Len = 0 then
-            --  Quick case for len = 0.
-            Res := Flistt.Allocate (1);
-            Flistt.Table (Res) := (Els => 0, Len => 0);
-            return Res;
-         end if;
-      end if;
-
-      if Res = Null_Flist then
-         Res := Flistt.Allocate (1);
-         Flistt.Table (Res) := (Els => Els.Allocate (Len),
-                                Len => Nat32 (Len));
-      end if;
-
-      --  Clear the list.
-      declare
-         Idx : constant El_Index_Type := Flistt.Table (Res).Els;
-      begin
-         Els.Table (Idx .. Idx + El_Index_Type (Len) - 1) :=
-           (others => Null_Node);
-      end;
-
-      return Res;
-   end Create_Flist;
-
-   procedure Destroy_Flist (Flist : in out Flist_Type)
-   is
-      Len : constant Natural := Length (Flist);
-      Prev : Flist_Type;
-   begin
-      --  Prepend to the array of free flists.
-      if Len >= Free_Flists'Last then
-         Prev := Free_Flists (Free_Flists'Last);
-         Free_Flists (Free_Flists'Last) := Flist;
-
-         Els.Table (Flistt.Table (Flist).Els) := Node_Type (Prev);
-      else
-         Prev := Free_Flists (Len);
-         Free_Flists (Len) := Flist;
-
-         Flistt.Table (Flist).Len := Nat32 (Prev);
-      end if;
-
-      Flist := Null_Flist;
-   end Destroy_Flist;
-
-   function Flast (Flist : Flist_Type) return Integer is
-   begin
-      return Integer (Flistt.Table (Flist).Len - 1);
-   end Flast;
-
-   function Length (Flist : Flist_Type) return Natural is
-   begin
-      return Natural (Flistt.Table (Flist).Len);
-   end Length;
-
-   function Get_Nth_Element (Flist : Flist_Type; N : Natural) return Node_Type
-   is
-      E : Entry_Type renames Flistt.Table (Flist);
-   begin
-      pragma Assert (N < Natural (E.Len));
-      return Els.Table (E.Els + El_Index_Type (N));
-   end Get_Nth_Element;
-
-   procedure Set_Nth_Element (Flist : Flist_Type; N : Natural; V : Node_Type)
-   is
-      E : Entry_Type renames Flistt.Table (Flist);
-   begin
-      pragma Assert (N < Natural (E.Len));
-      Els.Table (E.Els + El_Index_Type (N)) := V;
-   end Set_Nth_Element;
-end Flists;
diff --git a/src/vhdl/flists.ads b/src/vhdl/flists.ads
deleted file mode 100644
index 3d43c0f74..000000000
--- a/src/vhdl/flists.ads
+++ /dev/null
@@ -1,51 +0,0 @@
---  Fixed-length lists.
---  Copyright (C) 2017 Tristan Gingold
---
---  GHDL 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, or (at your option) any later
---  version.
---
---  GHDL 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 GHDL; see the file COPYING.  If not, write to the Free
---  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
---  02111-1307, USA.
-with Types; use Types;
-with Vhdl.Nodes_Priv; use Vhdl.Nodes_Priv;
-
-package Flists is
-   type Flist_Type is new Int32;
-   for Flist_Type'Size use 32;
-
-   --  Non-existing flist.
-   Null_Flist : constant Flist_Type := 0;
-
-   --  Predefined special flist that could be used as a marker.
-   Flist_Others : constant Flist_Type := 1;
-   Flist_All : constant Flist_Type := 2;
-
-   --  Create a new flist of length LEN.  All the elements are initialized to
-   --  Null_Node.
-   function Create_Flist (Len : Natural) return Flist_Type;
-
-   --  Deallocate FLIST.  Set to Null_Flist.
-   procedure Destroy_Flist (Flist : in out Flist_Type);
-
-   --  First and last index of FLIST.  Could be used to iterate.
-   Ffirst : constant Natural := 0;
-   function Flast (Flist : Flist_Type) return Integer;
-
-   --  Return the length of FLIST.
-   function Length (Flist : Flist_Type) return Natural;
-
-   --  Get the N-th element of FLIST.  First element has index 0.
-   function Get_Nth_Element (Flist : Flist_Type; N : Natural) return Node_Type;
-
-   --  Set the N-th element of FLIST to V.
-   procedure Set_Nth_Element (Flist : Flist_Type; N : Natural; V : Node_Type);
-end Flists;
diff --git a/src/vhdl/vhdl-flists.ads b/src/vhdl/vhdl-flists.ads
new file mode 100644
index 000000000..ae92345ad
--- /dev/null
+++ b/src/vhdl/vhdl-flists.ads
@@ -0,0 +1,21 @@
+--  Fixed-length lists.
+--  Copyright (C) 2019 Tristan Gingold
+--
+--  GHDL 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, or (at your option) any later
+--  version.
+--
+--  GHDL 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 GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Vhdl.Types;
+with Flists;
+
+package Vhdl.Flists is new Standard.Flists (El_Type => Vhdl.Types.Node);
diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads
index 7ffa117d6..80c0c80e3 100644
--- a/src/vhdl/vhdl-nodes.ads
+++ b/src/vhdl/vhdl-nodes.ads
@@ -20,7 +20,7 @@ with Types; use Types;
 with Vhdl.Tokens; use Vhdl.Tokens;
 with Vhdl.Nodes_Priv;
 with Lists;
-with Flists;
+with Vhdl.Flists;
 
 package Vhdl.Nodes is
    --  This package defines the semantic tree and functions to handle it.