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