Add a python script to automatically generate disp_tree.

5 files changed, 730 insertions, 1347 deletions

diff --git a/xtools/Makefile b/xtools/Makefile
index e1546ec..599e0da 100644
--- a/xtools/Makefile
+++ b/xtools/Makefile
@@ -14,21 +14,22 @@
 #  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.
-all: ../iirs.adb
 
-check_iirs: force
-	gnatmake -g -gnatwa check_iirs
+DEPS=../iirs.ads ../nodes.ads ./pnodes.py
 
-MODE=--generate
+all: ../iirs.adb ../disp_tree.adb ../nodes_gc.adb
 
-../iirs.adb: ../iirs.adb.in ../iirs.ads ../nodes.ads ./check_iirs
+../iirs.adb: ../iirs.adb.in $(DEPS)
 	$(RM) $@
-	./check_iirs $(MODE) > subprg.ada
-	sed -e "/^   --  Subprograms/r subprg.ada" \
-	  < ../iirs.adb.in > $@
+	./pnodes.py body > $@
 	chmod -w $@
 
-force:
+../disp_tree.adb: ../disp_tree.adb.in $(DEPS)
+	$(RM) $@
+	./pnodes.py disp_tree > $@
+	chmod -w $@
 
-clean:
-	$(RM) *.o *.ali *~ check_iirs
+../nodes_gc.adb: ../nodes_gc.adb.in $(DEPS)
+	$(RM) $@
+	./pnodes.py mark_tree > $@
+	chmod -w $@
diff --git a/xtools/check_iirs.adb b/xtools/check_iirs.adb
deleted file mode 100644
index 3b28dfe..0000000
--- a/xtools/check_iirs.adb
+++ /dev/null
@@ -1,64 +0,0 @@
---  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 Check_Iirs_Pkg;
-with Ada.Command_Line; use Ada.Command_Line;
-with Ada.Text_IO; use Ada.Text_IO;
-
-procedure Check_Iirs
-is
-   type Prg_Mode is (Mode_Generate, Mode_Genfast, Mode_Free);
-   Mode : Prg_Mode;
-   procedure Usage is
-   begin
-      Put_Line ("usage: " & Command_Name & " MODE");
-      Put_Line ("MODE is one of:");
-      Put_Line (" --generate");
-      Put_Line (" --genfast");
-      Put_Line (" --list-free-fields");
-   end Usage;
-begin
-   if Argument_Count /= 1 then
-      Usage;
-      Set_Exit_Status (Failure);
-      return;
-   end if;
-   if Argument (1) = "--generate" then
-      Mode := Mode_Generate;
-   elsif Argument (1) = "--genfast" then
-      Mode := Mode_Genfast;
-   elsif Argument (1) = "--list-free-fields" then
-      Mode := Mode_Free;
-   else
-      Usage;
-      Set_Exit_Status (Failure);
-      return;
-   end if;
-
-   Check_Iirs_Pkg.Read_Fields;
-   Check_Iirs_Pkg.Check_Iirs;
-   Check_Iirs_Pkg.Read_Desc;
-   case Mode is
-      when Mode_Generate =>
-         Check_Iirs_Pkg.Gen_Func;
-      when Mode_Genfast =>
-         Check_Iirs_Pkg.Flag_Checks := False;
-         Check_Iirs_Pkg.Gen_Func;
-      when Mode_Free =>
-         Check_Iirs_Pkg.List_Free_Fields;
-   end case;
-end Check_Iirs;
diff --git a/xtools/check_iirs_pkg.adb b/xtools/check_iirs_pkg.adb
deleted file mode 100644
index 219c132..0000000
--- a/xtools/check_iirs_pkg.adb
+++ /dev/null
@@ -1,1234 +0,0 @@
---  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;
diff --git a/xtools/check_iirs_pkg.ads b/xtools/check_iirs_pkg.ads
deleted file mode 100644
index e03abab..0000000
--- a/xtools/check_iirs_pkg.ads
+++ /dev/null
@@ -1,38 +0,0 @@
---  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.
-
-package Check_Iirs_Pkg is
-   --  If set, disp all Iir kind.
-   Flag_Disp_Iir : Boolean := False;
-
-   --  If set, disp Iir_Kinds subtype.
-   Flag_Disp_Subtype : Boolean := False;
-
-   --  If set, generate checks.
-   Flag_Checks : Boolean := True;
-
-   procedure Read_Fields;
-
-   procedure Check_Iirs;
-
-   procedure Read_Desc;
-
-   procedure Gen_Func;
-
-   procedure List_Free_Fields;
-end Check_Iirs_Pkg;
diff --git a/xtools/pnodes.py b/xtools/pnodes.py
new file mode 100755
index 0000000..a9fbc21
--- /dev/null
+++ b/xtools/pnodes.py
@@ -0,0 +1,718 @@
+#!/usr/bin/env python
+
+import re
+import sys
+import argparse
+
+field_file = "../nodes.ads"
+spec_file = "../iirs.ads"
+template_file = "../iirs.adb.in"
+template_disp_file = "../disp_tree.adb.in"
+template_mark_file = "../nodes_gc.adb.in"
+prefix_name = "Iir_Kind_"
+prefix_range_name = "Iir_Kinds_"
+type_name = "Iir_Kind"
+conversions = ['uc', 'pos']
+
+class FuncDesc:
+    def __init__(self, name, field, conv, acc, display,
+                 pname, ptype, rname, rtype):
+        self.name = name
+        self.field = field
+        self.conv = conv
+        self.acc = acc
+        self.display = display # List of display attributes
+        self.pname = pname # Parameter mame
+        self.ptype = ptype # Parameter type
+        self.rname = rname # value name (for procedure)
+        self.rtype = rtype # value type
+
+class NodeDesc:
+    def __init__(self, name, format, fields, attrs):
+        self.name = name
+        self.format = format
+        self.fields = fields # {field: FuncDesc} dict, defined for all fields
+        self.attrs = attrs # A {attr: FuncDesc} dict
+
+class line:
+    def __init__(self, string, no):
+        self.l = string
+        self.n = no
+
+class EndOfFile(Exception):
+    def __init__(self,filename):
+        self.filename = filename
+
+    def __str__(self):
+        return "end of file " + self.filename
+
+class linereader:
+    def __init__(self, filename):
+        self.filename = filename
+        self.f = open (filename)
+        self.lineno = 0
+        self.l = ''
+
+    def get(self):
+        self.l = self.f.readline()
+        if not self.l:
+            raise EndOfFile(self.filename)
+        self.lineno = self.lineno + 1
+        return self.l
+
+class ParseError(Exception):
+    def __init__(self, lr, msg):
+        self.lr = lr;
+        self.msg = msg
+
+    def __str__(self):
+        return 'Error: ' + self.msg
+        return 'Parse error at ' + self.lr.filname + ':' + self.lr.lineno + \
+               ': ' + self.msg
+
+# Return fields description.
+# This is a dictionary.  The keys represent the possible format of a node.
+# The values are dictionnaries representing fields.  Keys are fields name, and
+# values are fields type.
+def read_fields(file):
+    fields = {}
+    formats = []
+    lr = linereader(file)
+
+    #  Search for 'type Format_Type is'
+    while lr.get() != '   type Format_Type is\n':
+        pass
+
+    # Skip '('
+    if lr.get() != '     (\n':
+        raise 'no open parenthesis after Format_Type';
+
+    # Read formats
+    l = lr.get()
+    pat_field_name = re.compile('      Format_(\w+),?\n')
+    while l != '     );\n':
+        m = pat_field_name.match(l)
+        if m == None:
+            print l
+            raise 'bad literal within Format_Type'
+        name = m.group(1)
+        formats.append(name)
+        fields[name] = {}
+        l = lr.get()
+
+    # Read fields
+    l = lr.get()
+    pat_fields = re.compile('   -- Fields of Format_(\w+):\n')
+    pat_field_desc = re.compile('   --   (\w+) : (\w+).*\n')
+    format_name = ''
+    common_desc = {}
+    try:
+        while True:
+            # 1) Search for description
+            while True:
+                # The common one
+                if l == '   -- Common fields are:\n':
+                    format_name = 'Common'
+                    break
+                # One for a format
+                m = pat_fields.match(l)
+                if m != None:
+                    format_name = m.group(1)
+                    if not format_name in fields:
+                        raise ParseError(
+                            lr, 'Format ' + format_name + ' is unknown');
+                    break
+                l = lr.get()
+
+            # 2) Read field description
+            l = lr.get()
+            desc = common_desc
+            while True:
+                m = pat_field_desc.match(l)
+                if m == None:
+                    break
+                desc[m.group(1)] = m.group(2)
+                l = lr.get()
+
+            # 3) Disp
+            if format_name == 'Common':
+                common_desc = desc
+            else:
+                fields[format_name] = desc
+    except EndOfFile:
+        pass
+
+    return (formats, fields)
+
+# Read kinds, kinds ranges and methods
+def read_kinds(filename):
+    lr = linereader(filename)
+    kinds = []
+    #  Search for 'type Iir_Kind is'
+    while lr.get() != '   type ' + type_name + ' is\n':
+        pass
+    # Skip '('
+    if lr.get() != '      (\n':
+        raise ParseError(lr,
+                         'no open parenthesis after "type ' + type_name +'"')
+
+    # Read literals
+    pat_node = re.compile('       ' + prefix_name + '(\w+),?( +-- .*)?\n')
+    pat_comment = re.compile('( +-- .*)?\n')
+    while True:
+        l = lr.get()
+        if l == '      );\n':
+            break
+        m = pat_node.match(l)
+        if m:
+            kinds.append(m.group(1))
+            continue
+        m = pat_comment.match(l)
+        if not m:
+            raise ParseError(lr, 'Unknow line within kind declaration')
+
+    # Check subtypes
+    pat_subtype = re.compile('   subtype ' + prefix_range_name \
+                             + '(\w+) is ' + type_name + ' range\n')
+    pat_first = re.compile('     ' + prefix_name + '(\w+) ..\n')
+    pat_last = re.compile('     ' + prefix_name + '(\w+);\n')
+    pat_middle = re.compile('   --' + prefix_name + '(\w+)\n')
+    kinds_ranges={}
+    while True:
+        l = lr.get()
+        # Start of methods is also end of subtypes.
+        if l == '   -- General methods.\n':
+            break
+        # Found a subtype.
+        m = pat_subtype.match(l)
+        if m:
+            # Check first bound
+            name = m.group(1)
+            l = lr.get()
+            mf = pat_first.match(l)
+            if not mf:
+                raise ParseError(lr, 'badly formated first bound of subtype')
+            first = kinds.index(mf.group(1))
+            idx = first
+            has_middle = None
+            # Read until last bound
+            while True:
+                l = lr.get()
+                ml = pat_middle.match(l)
+                if ml:
+                    # Check element in the middle
+                    if kinds.index(ml.group(1)) != idx + 1:
+                        raise ParseError(lr,
+                            "missing " + kinds[idx] + " in subtype")
+                    has_middle = True
+                    idx = idx + 1
+                else:
+                    # Check last bound
+                    ml = pat_last.match(l)
+                    if ml:
+                        last = kinds.index(ml.group(1))
+                        if last != idx + 1 and has_middle:
+                            raise ParseError(lr,
+                                "missing " + kinds[idx] + " in subtype")
+                        break
+                    raise ParseError(lr,
+                                     "unhandled line in subtype")
+            kinds_ranges[name] = kinds[first:last+1]
+
+    # Read functions
+    funcs = []
+    pat_display = re.compile('   --  Display:(.*)\n')
+    pat_field = re.compile('   --  Field: (\w+)'
+                           + '( Ref| Chain_Next| Chain)?( .*)?\n')
+    pat_conv = re.compile(' \((\w+)\)')
+    pat_func = \
+      re.compile('   function Get_(\w+) \((\w+) : (\w+)\) return (\w+);\n')
+    pat_proc = \
+      re.compile('   procedure Set_(\w+) \((\w+) : (\w+); (\w+) : (\w+)\);\n')
+    while True:
+        l = lr.get()
+        if l == 'end Iirs;\n':
+            break
+        md = pat_display.match(l)
+        if md:
+            display = md.group(1).split()
+            l = lr.get()
+            m = pat_field.match(l)
+            if not m:
+                raise ParseError(lr, 'Field: expected after Display:')
+        else:
+            display = []
+            m = pat_field.match(l)
+        if m:
+            # Extract conversion
+            acc = m.group(2)
+            if acc:
+                acc = acc.strip()
+            conv = m.group(3)
+            if conv:
+                mc = pat_conv.match(conv)
+                if not mc:
+                    raise ParseError(lr, 'conversion ill formed')
+                conv = mc.group(1)
+                if conv not in conversions:
+                    raise ParseError(lr, 'unknown conversion ' + conv)
+            else:
+                conv = None
+
+            # Read function
+            l = lr.get()
+            mf = pat_func.match(l)
+            if not mf:
+                raise ParseError(lr,
+                        'function declaration expected after Field')
+            # Read procedure
+            l = lr.get()
+            mp = pat_proc.match(l)
+            if not mp:
+                raise ParseError(lr,
+                        'procedure declaration expected after function')
+            # Consistency check between function and procedure
+            if mf.group(1) != mp.group(1):
+                raise ParseError(lr, 'function and procedure name mismatch')
+            if mf.group(2) != mp.group(2):
+                raise ParseError(lr, 'parameter name mismatch with function')
+            if mf.group(3) != mp.group(3):
+                raise ParseError(lr, 'parameter type mismatch with function')
+            if mf.group(4) != mp.group(5):
+                raise ParseError(lr, 'result type mismatch with function')
+            funcs.append(FuncDesc(mf.group(1), m.group(1), conv, acc, display,
+                                  mp.group(2), mp.group(3),
+                                  mp.group(4), mp.group(5)))
+
+    return (kinds, kinds_ranges, funcs)
+
+# Read description for one node
+def read_nodes_fields(lr, names, fields, nodes, funcs_dict):
+    pat_only = re.compile('   -- Only for ' + prefix_name + '(\w+):\n')
+    pat_field = re.compile('   --   Get/Set_(\w+) \((Alias )?(\w+)\)\n')
+    pat_comment = re.compile('   --.*\n')
+    pat_start = re.compile ('   --   \w.*\n')
+
+    # Create nodes
+    cur_nodes = []
+    for (nm, fmt) in names:
+        if fmt not in fields:
+            raise ParseError(lr, 'unknown format')
+        n = NodeDesc(nm, fmt, {x: None for x in fields[fmt]}, {})
+        nodes[nm] = n
+        cur_nodes.append(n)
+
+    # Look for fields
+    only_nodes = cur_nodes
+    l = lr.l
+    while l != '\n':
+        # Handle 'Only ...'
+        while True:
+            m = pat_only.match(l)
+            if not m:
+                break
+            name = m.group(1)
+            if name not in [x.name for x in cur_nodes]:
+                raise ParseError(lr, 'node not currently described')
+            if only_nodes == cur_nodes:
+                only_nodes = []
+            only_nodes.append(nodes[name])
+            l = lr.get()
+        # Handle field
+        m = pat_field.match(l)
+        if m:
+            # 1) Check the function exists
+            func = m.group(1)
+            alias = m.group(2)
+            field = m.group(3)
+            if func not in funcs_dict:
+                raise ParseError(lr, 'unknown function')
+            func = funcs_dict[func]
+            if func.field != field:
+                raise ParseError(lr, 'field mismatch')
+            for c in only_nodes:
+                if field not in c.fields:
+                    raise ParseError(lr, 'field does not exist in node')
+                if not alias:
+                    if c.fields[field]:
+                        raise ParseError(lr, 'field already used')
+                    c.fields[field] = func
+                c.attrs[func.name] = func
+            only_nodes = cur_nodes
+        elif pat_start.match(l):
+            raise ParseError(lr, 'bad line in node description')
+        elif not pat_comment.match(l):
+            raise ParseError(lr, 'bad line in node description')
+        l = lr.get()
+
+# Read description for all nodes
+def read_nodes(filename, kinds_ranges, fields, funcs):
+    lr = linereader(filename)
+    funcs_dict = {x.name:x for x in funcs}
+    nodes = {}
+
+    # Skip until start
+    while lr.get() != '   -- Start of ' + type_name + '.\n':
+        pass
+
+    pat_decl = re.compile('   -- ' + prefix_name + '(\w+) \((\w+)\)\n')
+    pat_decls = re.compile('   -- ' + prefix_range_name + '(\w+) \((\w+)\)\n')
+    pat_comment_line = re.compile('   --+\n')
+    pat_comment_box = re.compile('   --(  .*)?\n')
+    while True:
+        l = lr.get()
+        if l == '   -- End of ' + type_name + '.\n':
+            return nodes
+        if l == '\n':
+            continue
+        m = pat_decl.match(l)
+        if m:
+            # List of nodes being described by the current description.
+            names = []
+
+            # Declaration of the first node
+            while True:
+                name=m.group(1)
+                fmt=m.group(2)
+                names.append((name,fmt))
+                # There might be several nodes described at once.
+                l = lr.get()
+                m = pat_decl.match(l)
+                if not m:
+                    break
+            read_nodes_fields(lr, names, fields, nodes, funcs_dict)
+            continue
+        m = pat_decls.match(l)
+        if m:
+            # List of nodes being described by the current description.
+            name=m.group(1)
+            fmt=m.group(2)
+            names = [(k,fmt) for k in kinds_ranges[name]]
+            l = lr.get()
+            read_nodes_fields(lr, names, fields, nodes, funcs_dict)
+            continue
+        if pat_comment_line.match(l) or pat_comment_box.match(l):
+            continue
+        raise ParseError(lr, 'bad line in node description')
+    return nodes
+
+# Generate a choice 'when A | B ... Z =>' using elements of CHOICES.
+def gen_choices(choices):
+    is_first=True
+    for c in choices:
+        if is_first:
+            print '        ',
+            print 'when',
+        else:
+            print
+            print '        ',
+            print '  |',
+        print prefix_name + c,
+        is_first=None
+    print '=>'
+
+# Generate the Get_Format function.
+def gen_get_format(formats, nodes, kinds):
+    print '   function Get_Format (Kind : ' + type_name + ') ' + \
+          'return Format_Type is'
+    print '   begin'
+    print '      case Kind is'
+    for f in formats:
+        choices = [k for k in kinds if nodes[k].format == f]
+        gen_choices(choices)
+        print '            return Format_' + f + ';'
+    print '      end case;'
+    print '   end Get_Format;'
+
+# Generate the Check_Kind_For_XXX function
+def gen_check_kind(func, nodes, kinds):
+    pname = 'Target'
+    ptype = 'Iir'
+    print '   procedure Check_Kind_For_' + func.name + ' (' + pname \
+          + ' : ' + ptype + ') is'
+    print '   begin'
+    print '      case Get_Kind (' + pname + ') is'
+    choices = [k for k in kinds if func.name in nodes[k].attrs]
+    gen_choices(choices)
+    print '            null;'
+    print '         when others =>'
+    print '            Failed ("' + func.name + '", ' + pname + ');'
+    print '      end case;'
+    print '   end Check_Kind_For_' + func.name + ';'
+    print
+
+def gen_subprg_header(decl):
+    if len(decl) < 76:
+        print decl + ' is'
+    else:
+        print decl
+        print '      is'
+    print '   begin'
+
+# Generate Get_XXX/Set_XXX subprograms for FUNC.
+def gen_get_set(func, nodes, fields):
+    g = 'Get_' + func.field + ' (' + func.pname + ')'
+    s = func.rname
+    if func.conv:
+        field_type = None
+        for fld in fields.values():
+            if func.field in fld:
+                field_type = fld[func.field]
+                break
+        if func.conv == 'uc':
+            g = field_type + '_To_' + func.rtype + ' (' + g + ')'
+            s = func.rtype + '_To_' + field_type + ' (' + s + ')'
+        elif func.conv == 'pos':
+            g = func.rtype + "'Val (" + g + ')'
+            s = func.rtype + "'Pos (" + s + ')'
+
+    subprg = '   function Get_' + func.name + ' (' + func.pname \
+          + ' : ' + func.ptype + ') return ' + func.rtype
+    gen_subprg_header(subprg)
+    print '      Check_Kind_For_' + func.name + ' (' + func.pname + ');'
+    print '      return ' + g + ';'
+    print '   end Get_' + func.name + ';'
+    print
+    subprg =  '   procedure Set_' + func.name + ' (' \
+          + func.pname + ' : ' + func.ptype + '; ' \
+          + func.rname + ' : ' + func.rtype + ')'
+    gen_subprg_header(subprg)
+    print '      Check_Kind_For_' + func.name + ' (' + func.pname + ');'
+    print '      Set_' + func.field + ' (' + func.pname + ', ' \
+          + s + ');'
+    print '   end Set_' + func.name + ';'
+    print
+
+def gen_image_field(func, param):
+    getter = 'Get_' + func.name + ' (' + param + ')'
+    if 'Image' in func.display:
+        return func.rtype +  '\'Image (' + getter + ')'
+    else:
+        return 'Image_' + func.rtype + ' (' + getter + ')'
+
+def gen_disp_header(kinds, nodes):
+    print '   procedure Disp_Header (N : Iir) is'
+    print '   begin'
+    print '      if N = Null_Iir then'
+    print '         Put_Line ("*null*");'
+    print '         return;'
+    print '      end if;'
+    print
+    print '      case Get_Kind (N) is'
+    for k in kinds:
+        inlines = [f for f in nodes[k].attrs.values() if 'Inline' in f.display]
+        if len(inlines) > 1:
+            raise Error
+        print '         when ' + prefix_name + k + ' =>'
+        if inlines:
+            print '            Put ("' + k.lower() + ' " &'
+            print '                      ' + \
+                  gen_image_field(inlines[0], 'N') + ');'
+        else:
+            print '            Put ("' + k.lower() + '");'
+    print '      end case;'
+    print '      Put (\' \');'
+    print '      Disp_Iir_Number (N);'
+    print '      New_Line;'
+    print '   end Disp_Header;'
+    print
+
+def funcs_of_node(n):
+    return sorted([fv.name for fv in n.fields.values() if fv])
+
+def gen_disp(kinds, nodes):
+    print '   procedure Disp_Iir (N : Iir;'
+    print '                       Indent : Natural := 1;'
+    print '                       Flat : Boolean := False)'
+    print '   is'
+    print '      Sub_Indent : constant Natural := Indent + 1;'
+    print '   begin'
+    print '      Disp_Header (N);'
+    print
+    print '      if Flat or else N = Null_Iir then'
+    print '         return;'
+    print '      end if;'
+    print
+    print '      Header ("location: ", Indent);'
+    print '      Put_Line (Image_Location_Type (Get_Location (N)));'
+    print
+    print '      --  Protect against infinite recursions.'
+    print '      if Indent > 20 then'
+    print '         Put_Indent (Indent);'
+    print '         Put_Line ("...");'
+    print '         return;'
+    print '      end if;'
+    print
+    print '      case Get_Kind (N) is'
+    done = []
+    for k in kinds:
+        if k in done:
+            continue
+        v = nodes[k]
+        # Find other kinds with the same set of functions.
+        vfuncs = funcs_of_node(v)
+        ks = [k1 for k1 in kinds if \
+              k1 not in done and funcs_of_node(nodes[k1]) == vfuncs]
+        gen_choices(ks)
+        done += ks
+        flds = [fk for fk, fv in v.fields.items() if fv]
+        if flds:
+            for fk in sorted(flds):
+                func = v.fields[fk]
+                if func.acc == 'Chain_Next':
+                    continue
+                print '            ' + \
+                      'Header ("' + func.name.lower() + ': ", Indent);'
+                str = '            '
+                if func.acc == 'Chain':
+                    str += 'Disp_Chain (Get_' + func.name \
+                           + ' (N), Sub_Indent);'
+                    print str
+                elif func.rtype in [ 'Iir', 'Iir_List', 'PSL_Node', 'PSL_NFA' ]:
+                    str += 'Disp_' + func.rtype + \
+                          ' (Get_' + func.name + ' (N), Sub_Indent'
+                    if func.acc == 'Ref':
+                        str += ', True'
+                    str += ');'
+                    print str
+                else:
+                    str += 'Put_Line ('
+                    if len(func.rtype) <= 20:
+                        str += gen_image_field(func, 'N')
+                        print str + ');'
+                    else:
+                        # Inline version due to length
+                        str += 'Image_' + func.rtype
+                        print str
+                        print '                      (' + \
+                              'Get_' + func.name + ' (N)));'
+        else:
+            print '            null;'
+    print '      end case;'
+    print '   end Disp_Iir;'
+    print
+
+def gen_mark(kinds, nodes):
+    print '   procedure Mark_Iir (N : Iir) is'
+    print '   begin'
+    print '      if N = Null_Iir then'
+    print '         return;'
+    print '      elsif Markers (N) then'
+    print '         Already_Marked (N);'
+    print '         return;'
+    print '      else'
+    print '         Markers (N) := True;'
+    print '      end if;'
+    print
+    print '      case Get_Kind (N) is'
+    done = []
+    for k in kinds:
+        if k in done:
+            continue
+        v = nodes[k]
+        # Find other kinds with the same set of functions.
+        vfuncs = funcs_of_node(v)
+        ks = [k1 for k1 in kinds if \
+              k1 not in done and funcs_of_node(nodes[k1]) == vfuncs]
+        gen_choices(ks)
+        done += ks
+        flds = [fk for fk, fv in v.fields.items() if fv]
+        empty = True
+        for fk in sorted(flds):
+            func = v.fields[fk]
+            if func.acc in ['Ref', 'Chain_Next']:
+                continue
+            elif func.acc in [ 'Chain' ]:
+                print '            ' + \
+                      'Mark_Chain (Get_' + func.name + ' (N));'
+                empty = False
+            elif func.rtype in [ 'Iir', 'Iir_List', 'PSL_Node', 'PSL_NFA' ]:
+                print '            ' + \
+                      'Mark_' + func.rtype + ' (Get_' + func.name + ' (N));'
+                empty = False
+        if empty:
+            print '            null;'
+    print '      end case;'
+    print '   end Mark_Iir;'
+    print
+
+parser = argparse.ArgumentParser(description='Meta-grammar processor')
+parser.add_argument('action', choices=['disp-nodes', 'disp-kinds',
+                                       'disp-fields', 'disp-funcs',
+                                       'disp_tree', 'mark_tree',
+                                       'get_format', 'body'],
+                    default='disp-nodes')
+args = parser.parse_args()
+
+try:
+    (formats, fields) = read_fields(field_file)
+    (kinds, kinds_ranges, funcs) = read_kinds(spec_file)
+    nodes = read_nodes(spec_file,kinds_ranges,fields,funcs)
+
+except ParseError as e:
+    print >> sys.stderr, e
+    print >> sys.stderr, \
+          "in {0}:{1}:{2}".format(e.lr.filename, e.lr.lineno, e.lr.l)
+    sys.exit(1)
+
+if args.action == 'disp-fields':
+    for fmt in fields:
+        print "Fields of Format_"+fmt
+        fld=fields[fmt]
+        for k in fld:
+            print '  ' + k + ' (' + fld[k] + ')'
+elif args.action == 'disp-kinds':
+    print "Kinds are:"
+    for k in kinds:
+        print '  ' + prefix_name + k
+elif args.action == 'disp-funcs':
+    print "Functions are:"
+    for f in funcs:
+        s = '{0} ({1}'.format(f.name, f.field)
+        if f.acc:
+            s += ' acc:' + f.acc
+        if f.conv:
+            s += ' conv:' + f.conv
+        s += ')'
+        print s
+elif args.action == 'disp-nodes':
+    for k in kinds:
+        v = nodes[k]
+        print prefix_name + k + ' (' + v.format + ')'
+        flds = [fk for fk, fv in v.fields.items() if fv]
+        for fk in sorted(flds):
+            print '  ' + fk + ': '+ v.fields[fk].name
+elif args.action == 'get_format':
+    gen_get_format(formats, nodes)
+elif args.action == 'body':
+    lr = linereader(template_file)
+    while True:
+        l = lr.get().rstrip()
+        print l
+        if l == '   --  Subprograms':
+            gen_get_format(formats, nodes, kinds)
+            print
+            for f in funcs:
+                gen_check_kind(f, nodes, kinds)
+                gen_get_set(f, nodes, fields)
+        if l[0:3] == 'end':
+            break
+elif args.action == 'disp_tree':
+    lr = linereader(template_disp_file)
+    while True:
+        l = lr.get().rstrip()
+        print l
+        if l == '   --  Subprograms':
+            gen_disp_header(kinds, nodes)
+            gen_disp(kinds, nodes)
+        if l[0:3] == 'end':
+            break
+elif args.action == 'mark_tree':
+    lr = linereader(template_mark_file)
+    while True:
+        l = lr.get().rstrip()
+        print l
+        if l == '   --  Subprograms':
+            gen_mark(kinds,nodes)
+        if l[0:3] == 'end':
+            break