path: root/src/vhdl/iirs.adb.in

--  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 Ada.Text_IO;
with Nodes; use Nodes;
with Lists; use Lists;
with Nodes_Meta; use Nodes_Meta;

package body Iirs is
   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;

   ---------------------------------------------------
   -- 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
      use Ada.Text_IO;
      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;
         case Format is
            when Format_Medium =>
               I := I + 2;
            when Format_Short
              | Format_Fp
              | Format_Int =>
               I := I + 1;
         end case;
      end loop;

      Put_Line ("Stats per iir_kind:");
      for J in Iir_Kind loop
         if Num (J) /= 0 then
            Put_Line (' ' & Iir_Kind'Image (J) & ':'
                      & Natural'Image (Num (J)));
         end if;
      end loop;
      Put_Line ("Stats per formats:");
      for J in Format_Type loop
         Put_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));
      Set_Base_Type (Res, Res);
      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 (An_Iir: Iir) return Iir_Kind
   is
      --  Speed up: avoid to check that nkind is in the bounds of Iir_Kind.
      pragma Suppress (Range_Check);
   begin
      return Iir_Kind'Val (Get_Nkind (An_Iir));
   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_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_Location_Type (N : Iir) return Location_Type is
   begin
      return Location_Type (N);
   end Iir_To_Location_Type;

   function Location_Type_To_Iir (L : Location_Type) return Iir is
   begin
      return Iir (L);
   end Location_Type_To_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 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 Iirs;