1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
9 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
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)
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;
38 with GNAT.Spitbol; use GNAT.Spitbol;
39 with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
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;
56 Tdigs : Pattern := Any (Decimal_Digit_Set) &
57 Any (Decimal_Digit_Set) &
58 Any (Decimal_Digit_Set);
60 Name_Ref : Pattern := Span (' ') * A & Break (' ') * Name
62 & ": constant Name_Id := N + " & Tdigs
65 Get_Name : Pattern := "Name_" & Rest * Name1;
67 Chk_Low : Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
69 Findu : Pattern := Span ('u') * A;
73 Xlate_U_Und : Character_Mapping := To_Mapping ("u", "_");
78 Open (InB, In_File, "snames.adb");
79 Open (InS, In_File, "snames.ads");
81 Create (OutS, Out_File, "snames.ns");
82 Create (OutB, Out_File, "snames.nb");
84 Anchored_Mode := True;
89 Line := Get_Line (InB);
90 exit when Match (Line, " Preset_Names");
91 Put_Line (OutB, Line);
94 Put_Line (OutB, Line);
96 LoopN : while not End_Of_File (InS) loop
97 Line := Get_Line (InS);
99 if not Match (Line, Name_Ref) then
100 Put_Line (OutS, Line);
103 Oval := Lpad (V (Val), 3, '0');
105 if Match (Name, "Last_") then
106 Oval := Lpad (V (Val - 1), 3, '0');
110 (OutS, A & Name & B & ": constant Name_Id := N + "
111 & Oval & ';' & Restl);
113 if Match (Name, Get_Name) then
117 if Match (Name, Findu, M) then
118 Replace (M, Translate (A, Xlate_U_Und));
119 Translate (Name, Lower_Case_Map);
121 elsif not Match (Name, "Op_", "") then
122 Translate (Name, Lower_Case_Map);
125 Name := 'O' & Translate (Name, Lower_Case_Map);
128 if Name = "error" then
129 Name := V ("<error>");
132 if not Match (Name, Chk_Low) then
133 Put_Line (OutB, " """ & Name & "#"" &");
140 Line := Get_Line (InB);
141 exit when Match (Line, " ""#"";");
144 Put_Line (OutB, Line);
146 while not End_Of_File (InB) loop
147 Put_Line (OutB, Get_Line (InB));