path: root/xtools/check_iirs_pkg.adb

--  Tool to check the coherence of the iirs package.
--  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 GCC; see the file COPYING.  If not, write to the Free
--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--  02111-1307, USA.
with GNAT.Spitbol; use GNAT.Spitbol;
with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
with GNAT.Spitbol.Table_Integer; use GNAT.Spitbol.Table_Integer;
with GNAT.Table;

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
with Ada.Command_Line; use Ada.Command_Line;

package body Check_Iirs_Pkg is
   --  Exception raise in case of error.
   Err : exception;

   --  Identifier get by getident_pat.
   Ident : VString := Nul;
   Ident_2 : VString := Nul;
   Ident_3 : VString := Nul;
   Ident_4 : VString := Nul;
   Ident_5 : VString := Nul;

   --  Enumel_Pat set this variable to the position of the comma.
   --  Used to detect the absence of a comma.
   Comma_Pos : aliased Natural;

   --  Patterns
   --  Space.
   Wsp : constant Pattern := Span (' ');

   --  "type Iir_Kind is".
   Type_Iir_Kind_Pat : constant Pattern :=
     Wsp & "type" & Wsp & "Iir_Kind" & Wsp & "is" & Rpos (0);

   --  "("
   Lparen_Pat : constant Pattern := Wsp & '(' & Rpos (0);

   --  Comment.
   Comment_Pat : constant Pattern := Wsp & "--";

   --  End of ada line
   Eol_Pat : constant Pattern := Comment_Pat or Rpos (0);

   --  A-Za-z
   Basic_Pat : constant Pattern := Span (Basic_Set);

   --  A-Za-z0-9
   Alnum_Pat : constant Pattern := Span (Alphanumeric_Set);

   --  Ada identifier.
   Ident_Pat : constant Pattern := Basic_Pat & Arbno (('_' or "") & Alnum_Pat);
   -- Basic_Pat & Arbno (Alnum_Pat) & Arbno ('_' & Alnum_Pat);

   --  Eat the ada identifier.
   Getident_Pat : constant Pattern := Ident_Pat * Ident;
   Getident2_Pat : constant Pattern := Ident_Pat * Ident_2;
   Getident3_Pat : constant Pattern := Ident_Pat * Ident_3;
   Getident4_Pat : constant Pattern := Ident_Pat * Ident_4;
   Getident5_Pat : constant Pattern := Ident_Pat * Ident_5;

   --  Get an enumeration elements.
   Enumel_Pat : constant Pattern := Wsp & Getident_Pat
     & ((',' & Setcur (Comma_Pos'Access)) or "") & Eol_Pat;

   --  End of an enumeration declaration.
   End_Enum_Pat : constant Pattern := Wsp & ");" & Eol_Pat;

   Format_Pat : constant Pattern := "      Format_" & Getident_Pat
     & ((',' & Setcur (Comma_Pos'Access)) or "") & Eol_Pat;

   Fields_Of_Format_Pat : constant Pattern :=
     "   -- Fields of Format_" & Getident_Pat & ":" & Rpos (0);

   --  "subtype XX is Iir_Kind range".
   Iir_Kind_Subtype_Pat : constant Pattern :=
     Wsp & "subtype" & Wsp & Getident_Pat & Wsp & "is" & Wsp & "Iir_Kind"
     & Wsp & "range" & Eol_Pat;

   --  Pattern for a range.
   Start_Range_Pat : constant Pattern :=
     Wsp & Getident_Pat & Wsp & ".." & Eol_Pat;
   Comment_Range_Pat : constant Pattern :=
     Wsp & "--" & Getident_Pat & Rpos (0);
   End_Range_Pat : constant Pattern := Wsp & Getident_Pat & ";" & Eol_Pat;

   --  End of public package part.
   End_Pat : constant Pattern := "end Iirs;" & Rpos (0);

   --  Pattern for a function field.
   Func_Decl_Pat : constant Pattern := "   --  Field: " & Getident_Pat
     & ( "" or (" (" & Getident2_Pat & ")")) & Rpos (0);

   --  function Get_XXX.
   Function_Get_Pat : constant Pattern := "   function Get_"  & Getident_Pat
     & " (" & Getident2_Pat & " : " & Getident3_Pat & ") return "
     & Getident4_Pat & ";" & Rpos (0);

   --  procedure Set_XXX.
   Procedure_Set_Pat : constant Pattern := "   procedure Set_"  & Getident_Pat
     & " (" & Getident2_Pat & " : " & Getident3_Pat
     & "; " & Getident4_Pat & " : " & Getident5_Pat & ");" & Rpos (0);

   Field_Decl_Pat : constant Pattern := "   --   " & Getident_Pat & " : ";
   Field_Type_Pat : constant Pattern := "   --   " & Ident_Pat & " : "
     & Getident_Pat & ("" or (" (" & Arb & ")")) & Rpos (0);

   --  Formats of nodes.
   type Format_Type is range 0 .. 7;
   No_Format : constant Format_Type := 0;
   Format_Pos : Format_Type := No_Format;

   Format2pos : GNAT.Spitbol.Table_Integer.Table (8);

   type Format_Info is record
      Name : String_Access;
   end record;

   Formats : array (Format_Type) of Format_Info := (others => (Name => null));

   type Format_Mask_Type is array (Format_Type) of Boolean;
   pragma Pack (Format_Mask_Type);

   --  Type of a IIR name.
   type Iir_Type is new Natural range 0 .. 255;
   No_Iir : constant Iir_Type := 0;

   --  Table to convert an Iir name to its position.
   Iir_Kind2pos : GNAT.Spitbol.Table_Integer.Table (256);
   --  Last iir used during table construction.
   Iir_Pos : Iir_Type := No_Iir;

   --  Table of Get_ functions.
   Function2pos : GNAT.Spitbol.Table_Integer.Table (256);

   --  Table of field.
   Field2pos : GNAT.Spitbol.Table_Integer.Table (32);

   type Range_Type is record
     L : Iir_Type;
     H : Iir_Type;
   end record;

   Null_Range : constant Range_Type := (No_Iir, No_Iir);

   function Img (Rng : Range_Type) return String is
   begin
      return "(" & Iir_Type'Image (Rng.L) & ", "
        & Iir_Type'Image (Rng.H) & ")";
   end Img;

   package Table_Range is new GNAT.Spitbol.Table (Range_Type, Null_Range, Img);
   use Table_Range;

   Iir_Kinds2pos : Table_Range.Table (32);

   --  Field type.  They represent a raw field.
   type Field_Type is new Integer range 0 .. 64;
   No_Field : constant Field_Type := 0;
   --  Position of the last field.
   Field_Pos : Field_Type := No_Field;

   type Field_Info is record
      --  Name of the field.
      Name : String_Access;
      --  Type of the field.
      Ftype : String_Access;
      --  Formats in which the field is valid.
      Formats : Format_Mask_Type;
   end record;

   package Field_Table is new GNAT.Table
     (Table_Component_Type => Field_Info,
      Table_Index_Type => Field_Type,
      Table_Low_Bound => 1,
      Table_Initial => 32,
      Table_Increment => 100);

   --  Function type.  They represent a field name.
   type Func_Type is new Natural;
   No_Func : constant Func_Type := 0;
   --  Last function known; used during the construction of the func_table.
   Function_Pos : Func_Type := No_Func;

   type Field2Func_Array is array (Field_Type) of Func_Type;

   --  Information for each Iir node.
   type Iir_Info is record
      --  Name of the Kind.
      Name : String_Access;

      --  If TRUE, the node was described.
      Described : Boolean;

      --  Format used by the node.
      Format : Format_Type;

      --  Function used to get the value of each field.
      Func : Field2Func_Array;
   end record;

   --  Table of IIr.
   package Iir_Table is new GNAT.Table
     (Table_Component_Type => Iir_Info,
      Table_Index_Type => Iir_Type,
      Table_Low_Bound => 1,
      Table_Initial => 256,
      Table_Increment => 100);

   --  Table of functions.
   type Iir_Bool_Array is array (Iir_Type) of Boolean;
   pragma Pack (Iir_Bool_Array);

   type Conversion_Type is (None, Via_Pos_Attr, Via_Unchecked);

   type Func_Info is record
      --  Name of the function.
      Name : String_Access;
      --  Field get/set by the function.
      Field : Field_Type;
      --  If true, the iir use this function.
      Uses : Iir_Bool_Array;
      --  Name of the target.
      Target_Name : String_Access;
      --  Type of the target.
      Target_Type : String_Access;
      --  Name of the value.
      Value_Name : String_Access;
      --  Type of the value.
      Value_Type : String_Access;
      --  Conversion;
      Conv : Conversion_Type;
   end record;

   package Func_Table is new GNAT.Table
     (Table_Component_Type => Func_Info,
      Table_Index_Type => Func_Type,
      Table_Low_Bound => 1,
      Table_Initial => 256,
      Table_Increment => 100);

   --  Get the position of IIR V.
   function Get_Iir_Pos (V : VString) return Iir_Type
   is
      P : Integer;
   begin
      P := Get (Iir_Kind2pos, V);

      if P < 0 then
         --  Identifier unknown.
         raise Err;
      end if;
      return Iir_Type (P);
   end Get_Iir_Pos;

   Flag_Disp_Format : constant Boolean := False;
   Flag_Disp_Field : constant Boolean := False;

   procedure Read_Fields
   is
      In_Node : File_Type;
      Line : VString := Nul;

      Format_Mask : Format_Mask_Type;

      procedure Parse_Field
      is
         P : Integer;
         Name : constant Vstring := Ident;
      begin
         if not Match (Line, Field_Type_Pat) then
            Put_Line ("**  field declaration without type");
            raise Err;
         end if;

         --  Check if the field is not already known.
         P := Get (Field2pos, Name);
         if P > 0 then
            if Ident /= Field_Table.Table (Field_Type (P)).Ftype.all then
               Put_Line ("*** field type mismatch");
               raise Err;
            end if;
            for I in Format_Mask'Range loop
               if Format_Mask (I) then
                  Field_Table.Table (Field_Type (P)).Formats (I) := True;
               end if;
            end loop;
            return;
         end if;

         Field_Pos := Field_Pos + 1;
         Set (Field2pos, Name, Natural (Field_Pos));
         Field_Table.Set_Last (Field_Pos);
         Field_Table.Table (Field_Pos) :=
           (Name => new String'(To_String (Name)),
            Ftype => new String'(To_String (Ident)),
            Formats => Format_Mask);
         if Flag_Disp_Field then
            Put_Line ("found field '"
                      & Field_Table.Table (Field_Pos).Name.all & "'");
         end if;
      end Parse_Field;
   begin
      Open (In_Node, In_File, "../nodes.ads");

      Anchored_Mode := True;

      --  Read lines until "type format_type is":
      loop
         Line := Get_Line (In_Node);
         exit when Match (Line, "   type Format_Type is" & Rpos (0));
      end loop;
      --  Expect '('.
      Line := Get_Line (In_Node);
      if not Match (Line, "     (" & Rpos (0)) then
         raise Err;
      end if;

      --  Read all formats.
      loop
         Line := Get_Line (In_Node);

         --  Read the identifier.
         Comma_Pos := 0;
         if not Match (Line, Format_Pat) then
            raise Err;
         end if;

         --  Put it into the table.
         Format_Pos := Format_Pos + 1;
         Set (Format2Pos, Ident, Natural (Format_Pos));
         Formats (Format_Pos) := (Name => new String'(To_String (Ident)));
         if Flag_Disp_Format then
            Put_Line ("found format " & S (Ident));
         end if;

         --  If there is no comma, then this is the end of enumeration.
         exit when Comma_Pos = 0;
      end loop;

      --  Read ");"
      Line := Get_Line (In_Node);
      if not Match (Line, "     );" & Rpos (0)) then
         raise Err;
      end if;

      --  Read fields.

      loop
         Line := Get_Line (In_Node);
         exit when Match (Line, "   -- Common fields are:" & Rpos (0));
      end loop;
      Format_Mask := (others => True);
      loop
         Line := Get_Line (In_Node);
         if Match (Line, Field_Decl_Pat) then
            Parse_Field;
         elsif Match (Line, Rpos (0)) then
            Line := Get_Line (In_Node);
            exit when not Match (Line, Fields_Of_Format_Pat);
            declare
               P : Integer;
            begin
               P := Get (Format2pos, Ident);
               if P < 0 then
                  Put_Line ("*** unknown format");
                  raise Err;
               end if;
               Format_Mask := (others => False);
               Format_Mask (Format_Type (P)) := True;
            end;
         else
            Put_Line ("**  bad line in field declarations");
            raise Err;
         end if;
      end loop;
      Close (In_Node);

      if False then
        Put_Line ("Fields:");
        for I in 1 .. Field_Pos loop
           Put (Field_Table.Table (I).Name.all);
           Put (": ");
           Put (Field_Table.Table (I).Ftype.all);
           Put ("  ");
           for J in Format_Mask_Type'Range loop
              if Field_Table.Table (I).Formats (J)
                and then Formats (J).Name /= null
              then
                 Put (" ");
                 Put (Formats (J).Name.all);
              end if;
           end loop;
           New_Line;
        end loop;
      end if;
   end Read_Fields;

   --  Read all Iir_Kind_* names and put them into Iir_Table.
   --  Fill Iir_Kinds2pos
   --  Fill Func_Table.
   procedure Check_Iirs
   is
      --  iirs.ads file.
      In_Iirs : File_Type;

      --  Line read from In_Iirs.
      Line : VString := Nul;
   begin
      --  Open the file.
      Open (In_Iirs, In_File, "../iirs.ads");

      Anchored_Mode := True;

      --  Read lines until "type Iir_Kind is"
      loop
         Line := Get_Line (In_Iirs);
         exit when Match (Line, Type_Iir_Kind_Pat);
      end loop;

      if Flag_Disp_Iir then
         Put_Line ("found iir_kind at line"
                   & Positive_Count'Image (Ada.Text_IO.Line (In_Iirs)));
      end if;

      --Debug_Mode := True;

      --  Read '('
      Line := Get_Line (In_Iirs);
      if not Match (Line, Lparen_Pat) then
         raise Err;
      end if;

      --  Read all kind.
      loop
         Line := Get_Line (In_Iirs);

         --  Skip comments and empty lines.
         if Match (Line, Eol_Pat) then
            goto Continue;
         end if;

         --  Read the identifier.
         Comma_Pos := 0;
         if not Match (Line, Enumel_Pat) then
            raise Err;
         end if;

         --  Put it into the table.
         Iir_Pos := Iir_Pos + 1;
         Set (Iir_Kind2pos, Ident, Natural (Iir_Pos));
         Iir_Table.Set_Last (Iir_Pos);
         Iir_Table.Table (Iir_Pos) := (Name => new String'(To_String (Ident)),
                                       Described => False,
                                       Format => No_Format,
                                       Func => (others => No_Func));
         if Flag_Disp_Iir then
            Put_Line ("found " & S (Ident) & Iir_Type'Image (Iir_Pos));
         end if;

         --  If there is no comma, then this is the end of enumeration.
         exit when Comma_Pos = 0;
         << Continue >> null;
      end loop;

      --  Read ");"
      Line := Get_Line (In_Iirs);
      if not Match (Line, End_Enum_Pat) then
         raise Err;
      end if;

      --  Look for iir_kind subtype.
      loop
         Line := Get_Line (In_Iirs);
         exit when Match (Line, End_Pat);

         Ident_2 := Null_Unbounded_String;

         if Match (Line, Iir_Kind_Subtype_Pat) then
            declare
               Start : Iir_Type;
               Pos : Iir_Type;
               P : Iir_Type;
               Rng_Ident : constant VString := Ident;
            begin
               Line := Get_Line (In_Iirs);
               if not Match (Line, Start_Range_Pat) then
                  --  Bad pattern for left bound.
                  Put_Line (Standard_Error, "bad pattern");
                  raise Err;
               end if;
               Start := Get_Iir_Pos (Ident);
               Pos := Start;
               if Flag_Disp_Subtype then
                  Put_Line ("found subtype " & S (Rng_Ident));
                  Put_Line ("     " & S (Ident) & " .."
                            & Iir_Type'Image (Pos));
               end if;

               loop
                  Line := Get_Line (In_Iirs);
                  if Match (Line, End_Range_Pat) then
                     P := Get_Iir_Pos (Ident);
                     if P /= Pos + 1 and then Flag_Disp_Subtype Then
                        Put_Line (Standard_Error, "** missing comments");
                        for I in Pos + 1 .. P - 1 loop
                           Put_Line ("   --" & Iir_Table.Table (I).Name.all);
                        end loop;
                     end if;
                     Set (Iir_Kinds2pos, Rng_Ident, Range_Type'(Start, P));
                     if Flag_Disp_Subtype then
                        Put_Line ("     " & S (Ident) & Iir_Type'Image (P));
                     end if;
                     exit;
                  elsif Match (Line, Comment_Range_Pat) then
                     P := Get_Iir_Pos (Ident);
                     if P /= Pos + 1 then
                        --  Bad order.
                        Put_Line (Standard_Error, "** missing node in range");
                        raise Err;
                     else
                        Pos := Pos + 1;
                     end if;
                  else
                     --  Comment (with identifier) or end of range expected.
                     raise Err;
                  end if;
               end loop;
            end;
         elsif Match (Line, Func_Decl_Pat) then
            declare
               Field_Pos : Integer;
               F : Func_Type;
               Conv : Conversion_Type;
            begin
               Field_Pos := Get (Field2pos, Ident);
               if Field_Pos < 0 then
                  Put_Line (Standard_Error,
                            "*** field not found: '" & S (Ident) & "'");
                  raise Err;
               end if;

               if Ident_2 /= Null_Unbounded_String then
                  if Ident_2 = "pos" then
                     Conv := Via_Pos_Attr;
                  elsif Ident_2 = "uc" then
                     Conv := Via_Unchecked;
                  else
                     Put_Line (Standard_Error, "*** bad conversion");
                     raise Err;
                  end if;
               else
                  Conv := None;
               end if;

               Line := Get_Line (In_Iirs);
               if not Match (Line, Function_Get_Pat) then
                  Put_Line (Standard_Error, "*** function expected");
                  raise Err;
               end if;

               if False then
                  Put_Line ("found function " & S (Ident));
               end if;
               Function_Pos := Function_Pos + 1;
               F := Function_Pos;
               Set (Function2pos, Ident, Integer (Function_Pos));
               Func_Table.Set_Last (Function_Pos);
               Func_Table.Table (Function_Pos) :=
                 (Name => new String'(To_String (Ident)),
                  Field => Field_Type (Field_Pos),
                  Uses => (others => False),
                  Target_Name => new String'(To_String (Ident_2)),
                  Target_Type => new String'(To_String (Ident_3)),
                  Value_Name => null,
                  Value_Type => new String'(To_String (Ident_4)),
                  Conv => Conv);

               Line := Get_Line (In_Iirs);
               if Match (Line, Procedure_Set_Pat) then
                  if Func_Table.Table (F).Target_Name.all /= Ident_2 then
                     Put_Line (Standard_Error,
                               "*** procedure target name mismatch ("
                               & Func_Table.Table (F).Target_Name.all
                               & " vs " & S (Ident_2) &")");
                     raise Err;
                  end if;
                  if Func_Table.Table (F).Target_Type.all /= Ident_3 then
                     Put_Line (Standard_Error,
                               "*** procedure target type name mismatch");
                     raise Err;
                  end if;
                  if Func_Table.Table (F).Value_Type.all /= Ident_5 then
                     Put_Line (Standard_Error,
                               "*** procedure target type name mismatch");
                     raise Err;
                  end if;
                  Func_Table.Table (F).Value_Name :=
                    new String'(To_String (Ident_4));
               else
                  if not Match (Line, Rpos (0)) then
                     Put_Line (Standard_Error,
                               "*** procedure or empty line expected");
                     raise Err;
                  end if;
               end if;
            end;
         end if;
      end loop;
      Close (In_Iirs);
      Set_Exit_Status (Success);
   exception
      when Err =>
         Put_Line (Standard_Error,
                   "*** Fatal error at line"
                   & Positive_Count'Image (Ada.Text_IO.Line (In_Iirs)));
         Set_Exit_Status (Failure);
         raise;
   end Check_Iirs;

   --  Start of node description.
   Start_Of_Iir_Kind_Pat : constant Pattern :=
     "   -- Start of Iir_Kind." & Rpos (0);
   End_Of_Iir_Kind_Pat : constant Pattern :=
     "   -- End of Iir_Kind." & Rpos (0);

   --  Box ("----------") delimiters.
   Desc_Box_Comment_Pat : constant Pattern := "   --" & Span ('-') & Rpos (0);

   --  A comment ("--  XXXX")
   Desc_Comment_Pat : constant Pattern := "   --  " & Arb & Rpos (0);
   Desc_Empty_Comment_Pat : constant Pattern := "   --" & Rpos (0);

   --  Get a iir_kind identifier.
   Desc_Iir_Kind_Pat : constant Pattern :=
     "   -- " & Getident_Pat
     & ("" or ( " (" & Getident2_Pat & ")"))
     & Rpos (0);

   Subprogram_Pat : constant Pattern :=
     "   --   Get" & ("_" or "/Set_") & Getident_Pat
     & ((" " & Arb) or "") & Rpos (0);

   Desc_Only_For_Pat : constant Pattern :=
     "   -- Only for " & Getident_Pat & ":" & Rpos (0);
   Desc_Subprogram_Pat : constant Pattern :=
     "   --   " & ("function" or "procedure");

   Field_Pat : constant Pattern := Arb & "(" & Getident_Pat & ")";
   Alias_Field_Pat : constant Pattern := Arb & "(Alias " & Getident_Pat & ")";

   Disp_Desc : constant Boolean := False;

   --  Check descriptions.
   procedure Read_Desc
   is
      --  iirs.ads file.
      In_Iirs : File_Type;

      --  Current line.
      Line : VString;

      --  IIR being described.
      type Iir_Array is array (Natural range <>) of Iir_Type;
      Iir_Desc : Iir_Array (1 .. 32);
      Nbr_Desc : Natural := 0;

      Only_For : Iir_Array (1 .. 16) := (others => No_Iir);
      Nbr_Only_For : Natural := 0;

      --  Just say IIR N is being described.
      procedure Add_Desc (N : Iir_Type; Format : Format_Type) is
      begin
         if Iir_Table.Table (N).Described then
            Put_Line ("*** iir already described");
            raise Err;
         end if;

         Iir_Table.Table (N).Described := True;
         Iir_Table.Table (N).Format := Format;
         Nbr_Desc := Nbr_Desc + 1;
         Iir_Desc (Nbr_Desc) := N;
      end Add_Desc;

   begin
      --  Open the file.
      Open (In_Iirs, In_File, "../iirs.ads");

      Anchored_Mode := True;

      if False then
         --  List of fields.
         Set (Field2pos, "Field1", 1);
         Set (Field2pos, "Field2", 2);
         Set (Field2pos, "Field3", 3);
         Set (Field2pos, "Field4", 4);
         Set (Field2pos, "Field5", 5);
         Set (Field2pos, "Field6", 6);
         Set (Field2pos, "Field7", 7);
         Set (Field2pos, "Nbr2", 6);
         Set (Field2pos, "Nbr3", 7);

         Set (Field2pos, "Ident", 8);
         Set (Field2pos, "Field0", 9);
         Set (Field2pos, "Attr", 10);
         Set (Field2pos, "Chain", 11);

         Set (Field2pos, "Flag1", 12);
         Set (Field2pos, "Flag2", 13);
         Set (Field2pos, "Flag3", 14);
         Set (Field2pos, "Flag4", 15);
         Set (Field2pos, "Flag5", 16);
         Set (Field2pos, "Odigit_1", 17);
         Set (Field2pos, "Odigit_2", 18);
         Set (Field2pos, "State1", 19);
         Set (Field2pos, "Staticness_1", 20);
         Set (Field2pos, "Staticness_2", 21);
      end if;

      --  Read lines until "-- Start of Iir_Kind."
      loop
         Line := Get_Line (In_Iirs);
         exit when Match (Line, Start_Of_Iir_Kind_Pat);
      end loop;

      --Debug_Mode := True;

      --  Read descriptions.
      L1 : loop

         --  Look for a description

         loop
            Line := Get_Line (In_Iirs);

            --  The description
            exit when Match (Line, "   -- Iir_Kind");

            --  End of descriptions
            exit L1 when Match (Line, End_Of_Iir_Kind_Pat);

            --  Skip over comments
            if Match (Line, Desc_Box_Comment_Pat)
              or else Match (Line, Desc_Comment_Pat)
            then
               loop
                  Line := Get_Line (In_Iirs);
                  exit when Match (Line, Rpos (0));
                  if Match (Line, Desc_Comment_Pat)
                    or else Match (Line, Desc_Empty_Comment_Pat)
                    or else Match (Line, Desc_Box_Comment_Pat)
                  then
                     null;
                  else
                     raise Err;
                  end if;
               end loop;
            end if;
         end loop;

         --  Get iir_kind.
         declare
            P_Num : Integer;
            Rng : Range_Type;
            Format : Format_Type;
         begin
            --  No iir being described.
            Nbr_Desc := 0;
            loop
               Ident_2 := Nul;
               exit when not Match (Line, Desc_Iir_Kind_Pat);

               --  Check format.
               if Ident_2 = Nul then
                  Put_Line (Standard_Error,
                            "*** no format for " & S (Ident));
                  raise Err;
               end if;
               P_Num := Get (Format2pos, Ident_2);
               if P_Num < 0 then
                  Put_Line (Standard_Error, "*** unknown format");
                  raise Err;
               end if;
               Format := Format_Type (P_Num);

               --  Handle nodes.
               P_Num := Get (Iir_Kind2pos, Ident);
               if P_Num >= 0 then
                  Add_Desc (Iir_Type (P_Num), Format);
               else
                  Rng := Get (Iir_Kinds2pos, Ident);
                  if Rng = Null_Range then
                     Put_Line (Standard_Error, "*** " & S (Ident));
                     raise Err;
                  end if;
                  for I in Rng.L .. Rng.H loop
                     Add_Desc (I, Format);
                  end loop;
               end if;

               if Disp_Desc then
                  Put_Line ("desc for " & S (Ident));
               end if;

               Line := Get_Line (In_Iirs);
            end loop;
         end;

         --Debug_Mode := True;

         --  Read the functions.
         loop
            if not Match (Line, Comment_Pat) then
               if Match (Line, Rpos (0)) then
                  exit;
               else
                  raise Err;
               end if;
            end if;
            declare
               Func : Func_Type;
               Func_Num : Integer;
               Field : Field_Type;
               Field_Num : Integer;
               Is_Alias : Boolean;

               procedure Add_Field (N : Iir_Type) is
               begin
                  if not Field_Table.Table (Field).
                    Formats (Iir_Table.Table (N).Format)
                  then
                     Put_Line (Standard_Error, "** no field for format");
                     raise Err;
                  end if;
                  if Is_Alias then
                     if Iir_Table.Table (N).Func (Field) = No_Func
                     then
                        Put_Line (Standard_Error,
                                  "**  aliased field not yet used");
                        raise Err;
                     end if;
                  else
                     if Iir_Table.Table (N).Func (Field) /= No_Func
                       --and then
                       --Iir_Table.Table (N).Func (Field) /= Func
                        then
                           Put_Line (Standard_Error,
                                     "**  Field already used");
                           raise Err;
                     end if;
                     Iir_Table.Table (N).Func (Field) := Func;
                  end if;
                  Func_Table.Table (Func).Uses (N) := True;
               end Add_Field;
            begin
               if Match (Line, Subprogram_Pat) then
                  if Disp_Desc then
                     Put ("subprg: " & S (Ident));
                  end if;
                  Func_Num := Get (Function2pos, Ident);
                  if Func_Num < 0 then
                     Put_Line (Standard_Error,
                               "*** function not found: " & S (Ident));
                     raise Err;
                  end if;
                  Func := Func_Type (Func_Num);
                  if Match (Line, Field_Pat) then
                     Is_Alias := False;
                  elsif Match (Line, Alias_Field_Pat) then
                     Is_Alias := True;
                  else
                     raise Err;
                  end if;
                  if Disp_Desc then
                     Put_Line ("  (" & S (Ident) & ")");
                  end if;
                  Field_Num := Get (Field2pos, Ident);
                  if Field_Num < 0 then
                     Put_Line (Standard_Error,
                               "*** unknown field: " & S (Ident));
                     raise Err;
                  end if;
                  Field := Field_Type (Field_Num);
                  if Func_Table.Table (Func).Field /= Field then
                     if Func_Table.Table (Func).Field = No_Field then
                        Func_Table.Table (Func).Field := Field;
                     else
                        --  Field redefined for the function.
                        Put_Line (Standard_Error,
                                  "**  field redefined for function "
                                    & Func_Table.Table (Func).Name.all);
                        raise Err;
                     end if;
                  end if;

                  --  Check the field is not already used by another func.
                  if Nbr_Only_For > 0 then
                     for I in 1 .. Nbr_Only_For loop
                        Add_Field (Only_For (I));
                     end loop;
                     Nbr_Only_For := 0;
                  else
                     for I in 1 .. Nbr_Desc loop
                        Add_Field (Iir_Desc (I));
                     end loop;
                  end if;
               elsif Match (Line, Desc_Only_For_Pat) then
                  declare
                     P_Num : Integer;
                     Rng : Range_Type;

                     procedure Add_Only_For (N : Iir_Type) is
                     begin
                        for I in 1 .. Nbr_Desc loop
                           if Iir_Desc (I) = N then
                              Nbr_Only_For := Nbr_Only_For + 1;
                              Only_For (Nbr_Only_For) := N;
                              return;
                           end if;
                        end loop;
                        Put_Line (Standard_Error,
                                  "**  not currently described");
                        raise Err;
                     end Add_Only_For;
                  begin
                     P_Num := Get (Iir_Kind2pos, Ident);
                     if P_Num >= 0 then
                        Add_Only_For (Iir_Type (P_Num));
                     else
                        Rng := Get (Iir_Kinds2pos, Ident);
                        if Rng = Null_Range then
                           Put_Line (Standard_Error, "*** " & S (Ident));
                           raise Err;
                        end if;
                        for I in Rng.L .. Rng.H loop
                           Add_Only_For (I);
                        end loop;
                     end if;
                  end;
               elsif Match (Line, "   -- Only") then
                  Put_Line (Standard_Error, "**  bad 'Only' for line");
                  raise Err;
               elsif Match (Line, Desc_Comment_Pat) then
                  null;
               elsif Match (Line, Desc_Empty_Comment_Pat) then
                  null;
               elsif Match (Line, Desc_Subprogram_Pat) then
                  null;
               else
                  raise Err;
               end if;
            end;
            Line := Get_Line (In_Iirs);
         end loop;
      end loop L1;

      --  Check each Iir was described.
      for I in Iir_Table.First .. Iir_Table.Last loop
         if not Iir_Table.Table (I).Described then
            Put_Line (Standard_Error,
                      "*** not described: " & Iir_Table.Table (I).Name.all);
            raise Err;
         end if;
      end loop;

      Close (In_Iirs);
   exception
      when Err =>
         Put_Line (Standard_Error,
                   "*** Fatal error (2) at line"
                   & Positive_Count'Image (Ada.Text_IO.Line (In_Iirs) - 1));
         Put_Line (Standard_Error, "*** Line is " & S (Line));
         Set_Exit_Status (Failure);
         raise;
   end Read_Desc;

   procedure Gen_Func
   is
      function Is_Used (F : Func_Type) return Boolean
      is
      begin
         for I in Func_Table.Table (F).Uses'Range loop
            if Func_Table.Table (F).Uses (I) then
               return True;
            end if;
         end loop;
         return False;
      end Is_Used;
      Is_First : Boolean;
      Same_Name : Boolean;
   begin
      Put_Line ("   function Get_Format (Kind : Iir_Kind) "
                & "return Format_Type is");
      Put_Line ("   begin");
      Put_Line ("      case Kind is");
      for I in 1 .. Format_Pos loop
         Is_First := True;
         Put      ("         when ");
         for J in Iir_Table.First .. Iir_Table.Last loop
            if Iir_Table.Table (J).Format = I then
               if not Is_First then
                  New_Line;
                  Put ("           | ");
               end if;
               Is_First := False;
               Put (Iir_Table.Table (J).Name.all);
            end if;
         end loop;
         Put_Line (" =>");
         Put      ("            return Format_");
         Put (Formats (I).Name.all);
         Put_Line (";");
      end loop;
      Put_Line ("      end case;");
      Put_Line ("   end Get_Format;");
      New_Line;

      --  Builder.
      Put_Line ("   function Create_Iir (Kind : Iir_Kind) return Iir");
      Put_Line ("   is");
      Put_Line ("      Res : Iir;");
      Put_Line ("      Format : Format_Type;");
      Put_Line ("   begin");
      Put_Line ("      Format := Get_Format (Kind);");
      Put_Line ("      Res := Create_Node (Format);");
      Put_Line ("      Set_Nkind (Res, Iir_Kind'Pos (Kind));");
      Put_Line ("      return Res;");
      Put_Line ("   end Create_Iir;");
      New_Line;

      for I in Func_Table.First .. Func_Table.Last loop
         declare
            F : Func_Info renames Func_Table.Table (I);
         begin
            --  Avoid bug get_parent.
            if Is_Used (I) then
               Same_Name := F.Name.all = Field_Table.Table (F.Field).Name.all;
               if Flag_Checks then
                  Put ("   procedure Check_Kind_For_");
                  Put (F.Name.all);
                  Put (" (Target : Iir) is");
                  New_Line;
                  Put_Line ("   begin");
                  Put_Line ("      case Get_Kind (Target) is");
                  Put ("         when ");
                  Is_First := True;
                  for J in F.Uses'Range loop
                     if F.Uses (J) then
                        if not Is_First then
                           New_Line;
                           Put ("           | ");
                        else
                           Is_First := False;
                        end if;
                        Put (Iir_Table.Table (J).Name.all);
                     end if;
                  end loop;
                  Put_Line (" =>");
                  Put_Line ("            null;");
                  Put_Line ("         when others =>");
                  Put ("            Failed (""");
                  Put (F.Name.all);
                  Put_Line (""", Target);");
                  Put_Line ("      end case;");
                  Put ("   end Check_Kind_For_");
                  Put (F.Name.all);
                  Put_Line (";");
                  New_Line;
               end if;

               Put ("   function Get_");
               Put (F.Name.all);
               Put (" (");
               Put (F.Target_Name.all);
               Put (" : ");
               Put (F.Target_Type.all);
               Put (") return ");
               Put (F.Value_Type.all);
               if Col > 76 then
                  New_Line;
                  Put ("     ");
               end if;
               Put (" is");
               New_Line;
               Put_Line ("   begin");
               if Flag_Checks then
                  Put ("      Check_Kind_For_");
                  Put (F.Name.all);
                  Put (" (");
                  Put (F.Target_Name.all);
                  Put (");");
                  New_Line;
               end if;
               Put ("      return ");
               case F.Conv is
                  when None =>
                     null;
                  when Via_Pos_Attr =>
                     Put (F.Value_Type.all);
                     Put ("'Val (");
                  when Via_Unchecked =>
                     Put (Field_Table.Table (F.Field).Ftype.all);
                     Put ("_To_");
                     Put (F.Value_Type.all);
                     Put (" (");
               end case;
               if Same_Name then
                  Put ("Nodes.");
               end if;
               Put ("Get_");
               Put (Field_Table.Table (F.Field).Name.all);
               Put (" (");
               Put (F.Target_Name.all);
               Put (")");
               case F.Conv is
                  when None =>
                     null;
                  when Via_Pos_Attr
                    | Via_Unchecked =>
                     Put (")");
               end case;
               Put (";");
               New_Line;
               Put ("   end Get_");
               Put (F.Name.all);
               Put (";");
               New_Line;
               New_Line;

               if F.Value_Name /= null then
                  Put ("   procedure Set_");
                  Put (F.Name.all);
                  Put (" (");
                  Put (F.Target_Name.all);
                  Put (" : ");
                  Put (F.Target_Type.all);
                  Put ("; ");
                  Put (F.Value_Name.all);
                  Put (" : ");
                  Put (F.Value_Type.all);
                  Put (")");
                  if Col > 76 then
                     New_Line;
                     Put ("     ");
                  end if;
                  Put (" is");
                  New_Line;
                  Put_Line ("   begin");
                  if Flag_Checks then
                     Put ("      Check_Kind_For_");
                     Put (F.Name.all);
                     Put (" (");
                     Put (F.Target_Name.all);
                     Put (");");
                     New_Line;
                  end if;
                  Put ("      ");
                  if Same_Name then
                     Put ("Nodes.");
                  end if;
                  Put ("Set_");
                  Put (Field_Table.Table (F.Field).Name.all);
                  Put (" (");
                  Put (F.Target_Name.all);
                  Put (", ");
                  case F.Conv is
                     when None =>
                        null;
                     when Via_Pos_Attr =>
                        Put (F.Value_Type.all);
                        Put ("'Pos (");
                     when Via_Unchecked =>
                        Put (F.Value_Type.all);
                        Put ("_To_");
                        Put (Field_Table.Table (F.Field).Ftype.all);
                        Put (" (");
                  end case;
                  Put (F.Value_Name.all);
                  case F.Conv is
                     when None =>
                        null;
                     when Via_Pos_Attr
                       | Via_Unchecked =>
                        Put (")");
                  end case;
                  Put (");");
                  New_Line;
                  Put ("   end Set_");
                  Put (F.Name.all);
                  Put (";");
                  New_Line;
                  New_Line;
               end if;
            end if;
         end;
      end loop;
   end Gen_Func;

   procedure List_Free_Fields
   is
   begin
      for I in Iir_Table.First .. Iir_Table.Last loop
         declare
            Info : Iir_Info renames Iir_Table.Table (I);
         begin
            Put_Line (Info.Name.all);
            for J in 1 .. Field_Pos loop
               if Info.Func (J) = No_Func
                 and then Field_Table.Table (J).Formats (Info.Format)
               then
                  Put (" ");
                  Put_Line (Field_Table.Table (J).Name.all);
               end if;
            end loop;
         end;
      end loop;
   end List_Free_Fields;
end Check_Iirs_Pkg;