1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
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. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 ------------------------------------------------------------------------------
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)
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
;
39 with GNAT
.Spitbol
; use GNAT
.Spitbol
;
40 with GNAT
.Spitbol
.Patterns
; use GNAT
.Spitbol
.Patterns
;
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
;
57 Tdigs
: Pattern
:= Any
(Decimal_Digit_Set
) &
58 Any
(Decimal_Digit_Set
) &
59 Any
(Decimal_Digit_Set
);
61 Name_Ref
: Pattern
:= Span
(' ') * A
& Break
(' ') * Name
63 & ": constant Name_Id := N + " & Tdigs
66 Get_Name
: Pattern
:= "Name_" & Rest
* Name1
;
68 Chk_Low
: Pattern
:= Pos
(0) & Any
(Lower_Set
) & Rest
& Pos
(1);
70 Findu
: Pattern
:= Span
('u') * A
;
74 Xlate_U_Und
: Character_Mapping
:= To_Mapping
("u", "_");
79 Open
(InB
, In_File
, "snames.adb");
80 Open
(InS
, In_File
, "snames.ads");
82 Create
(OutS
, Out_File
, "snames.ns");
83 Create
(OutB
, Out_File
, "snames.nb");
85 Anchored_Mode
:= True;
89 Line
:= A
& (Natural'Value (S
(Oldrev
)) + 1) & " $";
90 Line
:= Rpad
(Line
, 76) & "--";
91 Put_Line
(OutB
, Line
);
94 Line
:= Get_Line
(InB
);
95 exit when Match
(Line
, " Preset_Names");
96 Put_Line
(OutB
, Line
);
99 Put_Line
(OutB
, Line
);
101 LoopN
: while not End_Of_File
(InS
) loop
102 Line
:= Get_Line
(InS
);
104 if not Match
(Line
, Name_Ref
) then
105 Put_Line
(OutS
, Line
);
108 Oval
:= Lpad
(V
(Val
), 3, '0');
110 if Match
(Name
, "Last_") then
111 Oval
:= Lpad
(V
(Val
- 1), 3, '0');
115 (OutS
, A
& Name
& B
& ": constant Name_Id := N + "
116 & Oval
& ';' & Restl
);
118 if Match
(Name
, Get_Name
) then
122 if Match
(Name
, Findu
, M
) then
123 Replace
(M
, Translate
(A
, Xlate_U_Und
));
124 Translate
(Name
, Lower_Case_Map
);
126 elsif not Match
(Name
, "Op_", "") then
127 Translate
(Name
, Lower_Case_Map
);
130 Name
:= 'O' & Translate
(Name
, Lower_Case_Map
);
133 if Name
= "error" then
134 Name
:= V
("<error>");
137 if not Match
(Name
, Chk_Low
) then
138 Put_Line
(OutB
, " """ & Name
& "#"" &");
145 Line
:= Get_Line
(InB
);
146 exit when Match
(Line
, " ""#"";");
149 Put_Line
(OutB
, Line
);
151 while not End_Of_File
(InB
) loop
152 Put_Line
(OutB
, Get_Line
(InB
));
155 Put_Line
(OutB
, "-- Updated to match snames.ads revision " & Specrev
);