--  Tree node definitions.
--  Copyright (C) 2002, 2003, 2004, 2005 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 Ada.Unchecked_Conversion;
with Tables;
with Logging; use Logging;
with Vhdl.Lists; use Vhdl.Lists;
with Vhdl.Nodes_Meta; use Vhdl.Nodes_Meta;
with Vhdl.Nodes_Priv; use Vhdl.Nodes_Priv;

package body Vhdl.Nodes is
   --  A simple type that needs only 2 bits.
   type Bit2_Type is range 0 .. 2 ** 2 - 1;

   type Kind_Type is range 0 .. 2 ** 9 - 1;

   --  Format of a node.
   type Format_Type is
     (
      Format_Short,
      Format_Medium
     );

   -- Common fields are:
   --   Flag1 : Boolean
   --   Flag2 : Boolean
   --   Flag3 : Boolean
   --   Flag4 : Boolean
   --   Flag5 : Boolean
   --   Flag6 : Boolean
   --   Flag7 : Boolean
   --   Flag8 : Boolean
   --   Flag9 : Boolean
   --   Flag10 : Boolean
   --   Flag11 : Boolean
   --   Flag12 : Boolean
   --   Flag13 : Boolean
   --   Flag14 : Boolean
   --   Flag15 : Boolean
   --   Nkind : Kind_Type
   --   State1 : Bit2_Type
   --   State2 : Bit2_Type
   --   Location : Location_Type
   --   Field0 : Iir
   --   Field1 : Iir
   --   Field2 : Iir
   --   Field3 : Iir
   --   Field4 : Iir
   --   Field5 : Iir

   -- Fields of Format_Short:

   -- Fields of Format_Medium:
   --   State3 : Bit2_Type
   --   State4 : Bit2_Type
   --   Field6 : Iir (location)
   --   Field7 : Iir (field0)
   --   Field8 : Iir (field1)
   --   Field9 : Iir (field2)
   --   Field10 : Iir (field3)
   --   Field11 : Iir (field4)
   --   Field12 : Iir (field5)

   function Create_Node (Format : Format_Type) return Node_Type;
   procedure Free_Node (N : Node_Type);

   function Get_Nkind (N : Node_Type) return Kind_Type;
   pragma Inline (Get_Nkind);
   procedure Set_Nkind (N : Node_Type; Kind : Kind_Type);
   pragma Inline (Set_Nkind);

   function Get_Field0 (N : Node_Type) return Node_Type;
   pragma Inline (Get_Field0);
   procedure Set_Field0 (N : Node_Type; V : Node_Type);
   pragma Inline (Set_Field0);

   function Get_Field1 (N : Node_Type) return Node_Type;
   pragma Inline (Get_Field1);
   procedure Set_Field1 (N : Node_Type; V : Node_Type);
   pragma Inline (Set_Field1);

   function Get_Field2 (N : Node_Type) return Node_Type;
   pragma Inline (Get_Field2);
   procedure Set_Field2 (N : Node_Type; V : Node_Type);
   pragma Inline (Set_Field2);

   function Get_Field3 (N : Node_Type) return Node_Type;
   pragma Inline (Get_Field3);
   procedure Set_Field3 (N : Node_Type; V : Node_Type);
   pragma Inline (Set_Field3);

   function Get_Field4 (N : Node_Type) return Node_Type;
   pragma Inline (Get_Field4);
   procedure Set_Field4 (N : Node_Type; V : Node_Type);
   pragma Inline (Set_Field4);


   function Get_Field5 (N : Node_Type) return Node_Type;
   pragma Inline (Get_Field5);
   procedure Set_Field5 (N : Node_Type; V : Node_Type);
   pragma Inline (Set_Field5);

   function Get_Field6 (N: Node_Type) return Node_Type;
   pragma Inline (Get_Field6);
   procedure Set_Field6 (N: Node_Type; Val: Node_Type);
   pragma Inline (Set_Field6);

   function Get_Field7 (N: Node_Type) return Node_Type;
   pragma Inline (Get_Field7);
   procedure Set_Field7 (N: Node_Type; Val: Node_Type);
   pragma Inline (Set_Field7);

   function Get_Field8 (N: Node_Type) return Node_Type;
   pragma Inline (Get_Field8);
   procedure Set_Field8 (N: Node_Type; Val: Node_Type);
   pragma Inline (Set_Field8);

   function Get_Field9 (N: Node_Type) return Node_Type;
   pragma Inline (Get_Field9);
   procedure Set_Field9 (N: Node_Type; Val: Node_Type);
   pragma Inline (Set_Field9);

   function Get_Field10 (N: Node_Type) return Node_Type;
   pragma Inline (Get_Field10);
   procedure Set_Field10 (N: Node_Type; Val: Node_Type);
   pragma Inline (Set_Field10);

   function Get_Field11 (N: Node_Type) return Node_Type;
   pragma Inline (Get_Field11);
   procedure Set_Field11 (N: Node_Type; Val: Node_Type);
   pragma Inline (Set_Field11);

   function Get_Field12 (N: Node_Type) return Node_Type;
   pragma Inline (Get_Field12);
   procedure Set_Field12 (N: Node_Type; Val: Node_Type);
   pragma Inline (Set_Field12);


   function Get_Flag1 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag1);
   procedure Set_Flag1 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag1);

   function Get_Flag2 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag2);
   procedure Set_Flag2 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag2);

   function Get_Flag3 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag3);
   procedure Set_Flag3 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag3);

   function Get_Flag4 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag4);
   procedure Set_Flag4 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag4);

   function Get_Flag5 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag5);
   procedure Set_Flag5 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag5);

   function Get_Flag6 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag6);
   procedure Set_Flag6 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag6);

   function Get_Flag7 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag7);
   procedure Set_Flag7 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag7);

   function Get_Flag8 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag8);
   procedure Set_Flag8 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag8);

   function Get_Flag9 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag9);
   procedure Set_Flag9 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag9);

   function Get_Flag10 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag10);
   procedure Set_Flag10 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag10);

   function Get_Flag11 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag11);
   procedure Set_Flag11 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag11);

   function Get_Flag12 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag12);
   procedure Set_Flag12 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag12);

   function Get_Flag13 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag13);
   procedure Set_Flag13 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag13);

   function Get_Flag14 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag14);
   procedure Set_Flag14 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag14);

   function Get_Flag15 (N : Node_Type) return Boolean;
   pragma Inline (Get_Flag15);
   procedure Set_Flag15 (N : Node_Type; V : Boolean);
   pragma Inline (Set_Flag15);


   function Get_State1 (N : Node_Type) return Bit2_Type;
   pragma Inline (Get_State1);
   procedure Set_State1 (N : Node_Type; V : Bit2_Type);
   pragma Inline (Set_State1);

   function Get_State2 (N : Node_Type) return Bit2_Type;
   pragma Inline (Get_State2);
   procedure Set_State2 (N : Node_Type; V : Bit2_Type);
   pragma Inline (Set_State2);

   function Get_State3 (N : Node_Type) return Bit2_Type;
   pragma Inline (Get_State3);
   procedure Set_State3 (N : Node_Type; V : Bit2_Type);
   pragma Inline (Set_State3);

   type Node_Record is record
      --  First byte:
      Format : Format_Type;
      Flag1 : Boolean;
      Flag2 : Boolean;
      Flag3 : Boolean;
      Flag4 : Boolean;
      Flag5 : Boolean;
      Flag6 : Boolean;
      Flag7 : Boolean;

      --  Second byte:
      Flag8 : Boolean;
      Flag9 : Boolean;
      Flag10 : Boolean;
      Flag11 : Boolean;
      Flag12 : Boolean;
      Flag13 : Boolean;
      Flag14 : Boolean;
      Flag15 : Boolean;

      --  Third byte:
      Flag16 : Boolean;
      Flag17 : Boolean;
      Flag18 : Boolean;

      --  2*2 = 4 bits
      State1 : Bit2_Type;
      State2 : Bit2_Type;

      --  9 bits
      Kind : Kind_Type;

      -- Location.
      Location: Location_Type;

      Field0 : Node_Type;
      Field1 : Node_Type;
      Field2 : Node_Type;
      Field3 : Node_Type;
      Field4 : Node_Type;
      Field5 : Node_Type;
   end record;
   pragma Pack (Node_Record);
   for Node_Record'Size use 8*32;
   for Node_Record'Alignment use 4;
   pragma Suppress_Initialization (Node_Record);

   Init_Node : constant Node_Record := Node_Record'
     (Format => Format_Short,
      Kind => 0,
      State1 | State2 => 0,
      Location => Location_Nil,
      Field0 | Field1 | Field2 | Field3 | Field4 | Field5 => Null_Node,
      others => False);

      --  Suppress the access check of the table base.  This is really safe to
   --  suppress this check because the table base cannot be null.
   pragma Suppress (Access_Check);

   --  Suppress the index check on the table.
   --  Could be done during non-debug, since this may catch errors (reading
   --  Null_Node or Error_Node).
   --pragma Suppress (Index_Check);

   package Nodet is new Tables
     (Table_Component_Type => Node_Record,
      Table_Index_Type => Node_Type,
      Table_Low_Bound => 2,
      Table_Initial => 1024);

   function Get_Last_Node return Iir is
   begin
      return Nodet.Last;
   end Get_Last_Node;

   Free_Chain : Node_Type := Null_Node;

   function Create_Node (Format : Format_Type) return Node_Type
   is
      Res : Node_Type;
   begin
      case Format is
         when Format_Medium =>
            --  Allocate a first node.
            Nodet.Increment_Last;
            Res := Nodet.Last;
            --  Check alignment.
            if Res mod 2 = 1 then
               Set_Field1 (Res, Free_Chain);
               Free_Chain := Res;
               Nodet.Increment_Last;
               Res := Nodet.Last;
            end if;
            --  Allocate the second node.
            Nodet.Increment_Last;
            Nodet.Table (Res) := Init_Node;
            Nodet.Table (Res).Format := Format_Medium;
            Nodet.Table (Res + 1) := Init_Node;
         when Format_Short =>
            --  Check from free pool
            if Free_Chain = Null_Node then
               Nodet.Increment_Last;
               Res := Nodet.Last;
            else
               Res := Free_Chain;
               Free_Chain := Get_Field1 (Res);
            end if;
            Nodet.Table (Res) := Init_Node;
      end case;
      return Res;
   end Create_Node;

   type Free_Node_Hook_Array is
     array (Natural range 1 .. 8) of Free_Iir_Hook;
   Nbr_Free_Hooks : Natural := 0;

   Free_Hooks : Free_Node_Hook_Array;

   procedure Register_Free_Hook (Hook : Free_Iir_Hook) is
   begin
      if Nbr_Free_Hooks >= Free_Hooks'Last then
         --  Not enough room in Free_Hooks.
         raise Internal_Error;
      end if;
      Nbr_Free_Hooks := Nbr_Free_Hooks + 1;
      Free_Hooks (Nbr_Free_Hooks) := Hook;
   end Register_Free_Hook;

   procedure Free_Node (N : Node_Type) is
   begin
      if N = Null_Node then
         return;
      end if;

      --  Call hooks.
      for I in Free_Hooks'First .. Nbr_Free_Hooks loop
         Free_Hooks (I).all (N);
      end loop;

      --  Really free the node.
      Set_Nkind (N, 0);
      Set_Field1 (N, Free_Chain);
      Free_Chain := N;
      if Nodet.Table (N).Format = Format_Medium then
         Set_Field1 (N + 1, Free_Chain);
         Free_Chain := N + 1;
      end if;
   end Free_Node;

   procedure Free_Iir (Target : Iir) renames Free_Node;

   function Next_Node (N : Node_Type) return Node_Type is
   begin
      case Nodet.Table (N).Format is
         when Format_Medium =>
            return N + 2;
         when Format_Short =>
            return N + 1;
      end case;
   end Next_Node;

   function Get_Nkind (N : Node_Type) return Kind_Type is
   begin
      return Nodet.Table (N).Kind;
   end Get_Nkind;

   procedure Set_Nkind (N : Node_Type; Kind : Kind_Type) is
   begin
      Nodet.Table (N).Kind := Kind;
   end Set_Nkind;


   procedure Set_Location (N : Iir; Location: Location_Type) is
   begin
      Nodet.Table (N).Location := Location;
   end Set_Location;

   function Get_Location (N: Iir) return Location_Type is
   begin
      return Nodet.Table (N).Location;
   end Get_Location;


   procedure Set_Field0 (N : Node_Type; V : Node_Type) is
   begin
      Nodet.Table (N).Field0 := V;
   end Set_Field0;

   function Get_Field0 (N : Node_Type) return Node_Type is
   begin
      return Nodet.Table (N).Field0;
   end Get_Field0;


   function Get_Field1 (N : Node_Type) return Node_Type is
   begin
      return Nodet.Table (N).Field1;
   end Get_Field1;

   procedure Set_Field1 (N : Node_Type; V : Node_Type) is
   begin
      Nodet.Table (N).Field1 := V;
   end Set_Field1;

   function Get_Field2 (N : Node_Type) return Node_Type is
   begin
      return Nodet.Table (N).Field2;
   end Get_Field2;

   procedure Set_Field2 (N : Node_Type; V : Node_Type) is
   begin
      Nodet.Table (N).Field2 := V;
   end Set_Field2;

   function Get_Field3 (N : Node_Type) return Node_Type is
   begin
      return Nodet.Table (N).Field3;
   end Get_Field3;

   procedure Set_Field3 (N : Node_Type; V : Node_Type) is
   begin
      Nodet.Table (N).Field3 := V;
   end Set_Field3;

   function Get_Field4 (N : Node_Type) return Node_Type is
   begin
      return Nodet.Table (N).Field4;
   end Get_Field4;

   procedure Set_Field4 (N : Node_Type; V : Node_Type) is
   begin
      Nodet.Table (N).Field4 := V;
   end Set_Field4;

   function Get_Field5 (N : Node_Type) return Node_Type is
   begin
      return Nodet.Table (N).Field5;
   end Get_Field5;

   procedure Set_Field5 (N : Node_Type; V : Node_Type) is
   begin
      Nodet.Table (N).Field5 := V;
   end Set_Field5;

   function Get_Field6 (N: Node_Type) return Node_Type is
   begin
      return Node_Type (Nodet.Table (N + 1).Location);
   end Get_Field6;

   procedure Set_Field6 (N: Node_Type; Val: Node_Type) is
   begin
      Nodet.Table (N + 1).Location := Location_Type (Val);
   end Set_Field6;

   function Get_Field7 (N: Node_Type) return Node_Type is
   begin
      return Nodet.Table (N + 1).Field0;
   end Get_Field7;

   procedure Set_Field7 (N: Node_Type; Val: Node_Type) is
   begin
      Nodet.Table (N + 1).Field0 := Val;
   end Set_Field7;

   function Get_Field8 (N: Node_Type) return Node_Type is
   begin
      return Nodet.Table (N + 1).Field1;
   end Get_Field8;

   procedure Set_Field8 (N: Node_Type; Val: Node_Type) is
   begin
      Nodet.Table (N + 1).Field1 := Val;
   end Set_Field8;

   function Get_Field9 (N: Node_Type) return Node_Type is
   begin
      return Nodet.Table (N + 1).Field2;
   end Get_Field9;

   procedure Set_Field9 (N: Node_Type; Val: Node_Type) is
   begin
      Nodet.Table (N + 1).Field2 := Val;
   end Set_Field9;

   function Get_Field10 (N: Node_Type) return Node_Type is
   begin
      return Nodet.Table (N + 1).Field3;
   end Get_Field10;

   procedure Set_Field10 (N: Node_Type; Val: Node_Type) is
   begin
      Nodet.Table (N + 1).Field3 := Val;
   end Set_Field10;

   function Get_Field11 (N: Node_Type) return Node_Type is
   begin
      return Nodet.Table (N + 1).Field4;
   end Get_Field11;

   procedure Set_Field11 (N: Node_Type; Val: Node_Type) is
   begin
      Nodet.Table (N + 1).Field4 := Val;
   end Set_Field11;

   function Get_Field12 (N: Node_Type) return Node_Type is
   begin
      return Nodet.Table (N + 1).Field5;
   end Get_Field12;

   procedure Set_Field12 (N: Node_Type; Val: Node_Type) is
   begin
      Nodet.Table (N + 1).Field5 := Val;
   end Set_Field12;


   function Get_Flag1 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag1;
   end Get_Flag1;

   procedure Set_Flag1 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag1 := V;
   end Set_Flag1;

   function Get_Flag2 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag2;
   end Get_Flag2;

   procedure Set_Flag2 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag2 := V;
   end Set_Flag2;

   function Get_Flag3 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag3;
   end Get_Flag3;

   procedure Set_Flag3 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag3 := V;
   end Set_Flag3;

   function Get_Flag4 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag4;
   end Get_Flag4;

   procedure Set_Flag4 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag4 := V;
   end Set_Flag4;

   function Get_Flag5 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag5;
   end Get_Flag5;

   procedure Set_Flag5 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag5 := V;
   end Set_Flag5;

   function Get_Flag6 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag6;
   end Get_Flag6;

   procedure Set_Flag6 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag6 := V;
   end Set_Flag6;

   function Get_Flag7 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag7;
   end Get_Flag7;

   procedure Set_Flag7 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag7 := V;
   end Set_Flag7;

   function Get_Flag8 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag8;
   end Get_Flag8;

   procedure Set_Flag8 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag8 := V;
   end Set_Flag8;

   function Get_Flag9 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag9;
   end Get_Flag9;

   procedure Set_Flag9 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag9 := V;
   end Set_Flag9;

   function Get_Flag10 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag10;
   end Get_Flag10;

   procedure Set_Flag10 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag10 := V;
   end Set_Flag10;

   function Get_Flag11 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag11;
   end Get_Flag11;

   procedure Set_Flag11 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag11 := V;
   end Set_Flag11;

   function Get_Flag12 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag12;
   end Get_Flag12;

   procedure Set_Flag12 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag12 := V;
   end Set_Flag12;

   function Get_Flag13 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag13;
   end Get_Flag13;

   procedure Set_Flag13 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag13 := V;
   end Set_Flag13;

   function Get_Flag14 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag14;
   end Get_Flag14;

   procedure Set_Flag14 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag14 := V;
   end Set_Flag14;

   function Get_Flag15 (N : Node_Type) return Boolean is
   begin
      return Nodet.Table (N).Flag15;
   end Get_Flag15;

   procedure Set_Flag15 (N : Node_Type; V : Boolean) is
   begin
      Nodet.Table (N).Flag15 := V;
   end Set_Flag15;


   function Get_State1 (N : Node_Type) return Bit2_Type is
   begin
      return Nodet.Table (N).State1;
   end Get_State1;

   procedure Set_State1 (N : Node_Type; V : Bit2_Type) is
   begin
      Nodet.Table (N).State1 := V;
   end Set_State1;

   function Get_State2 (N : Node_Type) return Bit2_Type is
   begin
      return Nodet.Table (N).State2;
   end Get_State2;

   procedure Set_State2 (N : Node_Type; V : Bit2_Type) is
   begin
      Nodet.Table (N).State2 := V;
   end Set_State2;

   function Get_State3 (N : Node_Type) return Bit2_Type is
   begin
      return Nodet.Table (N + 1).State1;
   end Get_State3;

   procedure Set_State3 (N : Node_Type; V : Bit2_Type) is
   begin
      Nodet.Table (N + 1).State1 := V;
   end Set_State3;

   procedure Initialize is
   begin
      Nodet.Free;
      Nodet.Init;
   end Initialize;

   function Is_Null (Node : Iir) return Boolean is
   begin
      return Node = Null_Iir;
   end Is_Null;

   function Is_Null_List (Node : Iir_List) return Boolean is
   begin
      return Node = Null_Iir_List;
   end Is_Null_List;

   function Is_Valid (Node : Iir) return Boolean is
   begin
      return Node /= Null_Iir;
   end Is_Valid;

   ---------------------------------------------------
   -- General subprograms that operate on every iir --
   ---------------------------------------------------

   function Get_Format (Kind : Iir_Kind) return Format_Type;

   function Create_Iir (Kind : Iir_Kind) return Iir
   is
      Res : Iir;
      Format : Format_Type;
   begin
      Format := Get_Format (Kind);
      Res := Create_Node (Format);
      Set_Nkind (Res, Iir_Kind'Pos (Kind));
      return Res;
   end Create_Iir;

   --  Statistics.
   procedure Disp_Stats
   is
      type Num_Array is array (Iir_Kind) of Natural;
      Num : Num_Array := (others => 0);
      type Format_Array is array (Format_Type) of Natural;
      Formats : Format_Array := (others => 0);
      Kind : Iir_Kind;
      I : Iir;
      Last_I : Iir;
      Format : Format_Type;
   begin
      I := Error_Node + 1;
      Last_I := Get_Last_Node;
      while I < Last_I loop
         Kind := Get_Kind (I);
         Num (Kind) := Num (Kind) + 1;
         Format := Get_Format (Kind);
         Formats (Format) := Formats (Format) + 1;
         I := Next_Node (I);
      end loop;

      Log_Line ("Stats per iir_kind:");
      for J in Iir_Kind loop
         if Num (J) /= 0 then
            Log_Line (' ' & Iir_Kind'Image (J) & ':'
                        & Natural'Image (Num (J)));
         end if;
      end loop;
      Log_Line ("Stats per formats:");
      for J in Format_Type loop
         Log_Line (' ' & Format_Type'Image (J) & ':'
                     & Natural'Image (Formats (J)));
      end loop;
   end Disp_Stats;

   function Kind_In (K : Iir_Kind; K1, K2 : Iir_Kind) return Boolean is
   begin
      return K = K1 or K = K2;
   end Kind_In;

   function Iir_Predefined_Shortcut_P (Func : Iir_Predefined_Functions)
     return Boolean is
   begin
      case Func is
         when Iir_Predefined_Bit_And
           | Iir_Predefined_Bit_Or
           | Iir_Predefined_Bit_Nand
           | Iir_Predefined_Bit_Nor
           | Iir_Predefined_Boolean_And
           | Iir_Predefined_Boolean_Or
           | Iir_Predefined_Boolean_Nand
           | Iir_Predefined_Boolean_Nor =>
            return True;
         when others =>
            return False;
      end case;
   end Iir_Predefined_Shortcut_P;

   function Create_Iir_Error return Iir
   is
      Res : Iir;
   begin
      Res := Create_Node (Format_Short);
      Set_Nkind (Res, Iir_Kind'Pos (Iir_Kind_Error));
      return Res;
   end Create_Iir_Error;

   procedure Location_Copy (Target : Iir; Src : Iir) is
   begin
      Set_Location (Target, Get_Location (Src));
   end Location_Copy;

   -- Get kind
   function Get_Kind (N : Iir) return Iir_Kind
   is
      --  Speed up: avoid to check that nkind is in the bounds of Iir_Kind.
      pragma Suppress (Range_Check);
   begin
      pragma Assert (N /= Null_Iir);
      return Iir_Kind'Val (Get_Nkind (N));
   end Get_Kind;

   function Time_Stamp_Id_To_Iir is new Ada.Unchecked_Conversion
     (Source => Time_Stamp_Id, Target => Iir);

   function Iir_To_Time_Stamp_Id is new Ada.Unchecked_Conversion
     (Source => Iir, Target => Time_Stamp_Id);

   function File_Checksum_Id_To_Iir is new Ada.Unchecked_Conversion
     (Source => File_Checksum_Id, Target => Iir);

   function Iir_To_File_Checksum_Id is new Ada.Unchecked_Conversion
     (Source => Iir, Target => File_Checksum_Id);

   function Iir_To_Iir_List is new Ada.Unchecked_Conversion
     (Source => Iir, Target => Iir_List);
   function Iir_List_To_Iir is new Ada.Unchecked_Conversion
     (Source => Iir_List, Target => Iir);

   function Iir_To_Iir_Flist is new Ada.Unchecked_Conversion
     (Source => Iir, Target => Iir_Flist);
   function Iir_Flist_To_Iir is new Ada.Unchecked_Conversion
     (Source => Iir_Flist, Target => Iir);

   function Iir_To_Token_Type (N : Iir) return Token_Type is
   begin
      return Token_Type'Val (N);
   end Iir_To_Token_Type;

   function Token_Type_To_Iir (T : Token_Type) return Iir is
   begin
      return Token_Type'Pos (T);
   end Token_Type_To_Iir;

--     function Iir_To_Iir_Index32 (N : Iir) return Iir_Index32 is
--     begin
--        return Iir_Index32 (N);
--     end Iir_To_Iir_Index32;

--     function Iir_Index32_To_Iir (V : Iir_Index32) return Iir is
--     begin
--        return Iir_Index32'Pos (V);
--     end Iir_Index32_To_Iir;

   function Iir_To_Name_Id (N : Iir) return Name_Id is
   begin
      return Iir'Pos (N);
   end Iir_To_Name_Id;
   pragma Inline (Iir_To_Name_Id);

   function Name_Id_To_Iir (V : Name_Id) return Iir is
   begin
      return Name_Id'Pos (V);
   end Name_Id_To_Iir;

   function Iir_To_Iir_Int32 is new Ada.Unchecked_Conversion
     (Source => Iir, Target => Iir_Int32);

   function Iir_Int32_To_Iir is new Ada.Unchecked_Conversion
     (Source => Iir_Int32, Target => Iir);

   function Iir_To_Source_Ptr (N : Iir) return Source_Ptr is
   begin
      return Source_Ptr (N);
   end Iir_To_Source_Ptr;

   function Source_Ptr_To_Iir (P : Source_Ptr) return Iir is
   begin
      return Iir (P);
   end Source_Ptr_To_Iir;

   function Iir_To_Source_File_Entry is new Ada.Unchecked_Conversion
     (Source => Iir, Target => Source_File_Entry);
   function Source_File_Entry_To_Iir is new Ada.Unchecked_Conversion
     (Source => Source_File_Entry, Target => Iir);

   function Boolean_To_Iir_Delay_Mechanism is new Ada.Unchecked_Conversion
     (Source => Boolean, Target => Iir_Delay_Mechanism);
   function Iir_Delay_Mechanism_To_Boolean is new Ada.Unchecked_Conversion
     (Source => Iir_Delay_Mechanism, Target => Boolean);

   function Boolean_To_Iir_Signal_Kind is new Ada.Unchecked_Conversion
     (Source => Boolean, Target => Iir_Signal_Kind);
   function Iir_Signal_Kind_To_Boolean is new Ada.Unchecked_Conversion
     (Source => Iir_Signal_Kind, Target => Boolean);

   function Boolean_To_Direction_Type is new Ada.Unchecked_Conversion
     (Source => Boolean, Target => Direction_Type);
   function Direction_Type_To_Boolean is new Ada.Unchecked_Conversion
     (Source => Direction_Type, Target => Boolean);

   function Iir_To_String8_Id is new Ada.Unchecked_Conversion
     (Source => Iir, Target => String8_Id);
   function String8_Id_To_Iir is new Ada.Unchecked_Conversion
     (Source => String8_Id, Target => Iir);

   function Iir_To_Int32 is new Ada.Unchecked_Conversion
     (Source => Iir, Target => Int32);
   function Int32_To_Iir is new Ada.Unchecked_Conversion
     (Source => Int32, Target => Iir);

   function Iir_To_PSL_Node is new Ada.Unchecked_Conversion
     (Source => Iir, Target => PSL_Node);

   function PSL_Node_To_Iir is new Ada.Unchecked_Conversion
     (Source => PSL_Node, Target => Iir);

   function Iir_To_PSL_NFA is new Ada.Unchecked_Conversion
     (Source => Iir, Target => PSL_NFA);

   function PSL_NFA_To_Iir is new Ada.Unchecked_Conversion
     (Source => PSL_NFA, Target => Iir);

   --  Subprograms
end Vhdl.Nodes;