gcc/ada/xsnames.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                          GNAT SYSTEM UTILITIES                           --
   4 --                                                                          --
   5 --                              X S N A M E S                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                                                                          --
  10 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 --  This utility is used to make a new version of the Snames package when
  29 --  new names are added to the spec, the existing versions of snames.ads and
  30 --  snames.adb are read, and updated to match the set of names in snames.ads.
  31 --  The updated versions are written to snames.ns and snames.nb (new spec/body)
  32
  33 with Ada.Strings.Unbounded;         use Ada.Strings.Unbounded;
  34 with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
  35 with Ada.Strings.Maps;              use Ada.Strings.Maps;
  36 with Ada.Strings.Maps.Constants;    use Ada.Strings.Maps.Constants;
  37 with Ada.Text_IO;                   use Ada.Text_IO;
  38
  39 with GNAT.Spitbol;                  use GNAT.Spitbol;
  40 with GNAT.Spitbol.Patterns;         use GNAT.Spitbol.Patterns;
  41
  42 procedure XSnames is
  43
  44    InB  : File_Type;
  45    InS  : File_Type;
  46    OutS : File_Type;
  47    OutB : File_Type;
  48
  49    A, B    : VString := Nul;
  50    Line    : VString := Nul;
  51    Name    : VString := Nul;
  52    Name1   : VString := Nul;
  53    Oname   : VString := Nul;
  54    Oval    : VString := Nul;
  55    Restl   : VString := Nul;
  56
  57    Tdigs : Pattern := Any (Decimal_Digit_Set) &
  58                       Any (Decimal_Digit_Set) &
  59                       Any (Decimal_Digit_Set);
  60
  61    Name_Ref : Pattern := Span (' ') * A & Break (' ') * Name
  62                            & Span (' ') * B
  63                            & ": constant Name_Id := N + " & Tdigs
  64                            & ';' & Rest * Restl;
  65
  66    Get_Name : Pattern := "Name_" & Rest * Name1;
  67
  68    Chk_Low  : Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
  69
  70    Findu    : Pattern := Span ('u') * A;
  71
  72    Val : Natural;
  73
  74    Xlate_U_Und : Character_Mapping := To_Mapping ("u", "_");
  75
  76    M : Match_Result;
  77
  78 begin
  79    Open (InB, In_File, "snames.adb");
  80    Open (InS, In_File, "snames.ads");
  81
  82    Create (OutS, Out_File, "snames.ns");
  83    Create (OutB, Out_File, "snames.nb");
  84
  85    Anchored_Mode := True;
  86    Oname := Nul;
  87    Val := 0;
  88
  89    Line := A & (Natural'Value (S (Oldrev)) + 1) & " $";
  90    Line := Rpad (Line, 76) & "--";
  91    Put_Line (OutB, Line);
  92
  93    loop
  94       Line := Get_Line (InB);
  95       exit when Match (Line, "   Preset_Names");
  96       Put_Line (OutB, Line);
  97    end loop;
  98
  99    Put_Line (OutB, Line);
 100
 101    LoopN : while not End_Of_File (InS) loop
 102       Line := Get_Line (InS);
 103
 104       if not Match (Line, Name_Ref) then
 105          Put_Line (OutS, Line);
 106
 107       else
 108          Oval := Lpad (V (Val), 3, '0');
 109
 110          if Match (Name, "Last_") then
 111             Oval := Lpad (V (Val - 1), 3, '0');
 112          end if;
 113
 114          Put_Line
 115            (OutS, A & Name & B & ": constant Name_Id := N + "
 116             & Oval & ';' & Restl);
 117
 118          if Match (Name, Get_Name) then
 119             Name := Name1;
 120             Val := Val + 1;
 121
 122             if Match (Name, Findu, M) then
 123                Replace (M, Translate (A, Xlate_U_Und));
 124                Translate (Name, Lower_Case_Map);
 125
 126             elsif not Match (Name, "Op_", "") then
 127                Translate (Name, Lower_Case_Map);
 128
 129             else
 130                Name := 'O' & Translate (Name, Lower_Case_Map);
 131             end if;
 132
 133             if Name = "error" then
 134                Name := V ("<error>");
 135             end if;
 136
 137             if not Match (Name, Chk_Low) then
 138                Put_Line (OutB, "     """ & Name & "#"" &");
 139             end if;
 140          end if;
 141       end if;
 142    end loop LoopN;
 143
 144    loop
 145       Line := Get_Line (InB);
 146       exit when Match (Line, "      ""#"";");
 147    end loop;
 148
 149    Put_Line (OutB, Line);
 150
 151    while not End_Of_File (InB) loop
 152       Put_Line (OutB, Get_Line (InB));
 153    end loop;
 154
 155    Put_Line (OutB, "--  Updated to match snames.ads revision " & Specrev);
 156
 157 end XSnames;