1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
9 -- Copyright (C) 1992-2001 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;
88 Line
:= A
& (Natural'Value (S
(Oldrev
)) + 1) & " $";
89 Line
:= Rpad
(Line
, 76) & "--";
90 Put_Line
(OutB
, Line
);
93 Line
:= Get_Line
(InB
);
94 exit when Match
(Line
, " Preset_Names");
95 Put_Line
(OutB
, Line
);
98 Put_Line
(OutB
, Line
);
100 LoopN
: while not End_Of_File
(InS
) loop
101 Line
:= Get_Line
(InS
);
103 if not Match
(Line
, Name_Ref
) then
104 Put_Line
(OutS
, Line
);
107 Oval
:= Lpad
(V
(Val
), 3, '0');
109 if Match
(Name
, "Last_") then
110 Oval
:= Lpad
(V
(Val
- 1), 3, '0');
114 (OutS
, A
& Name
& B
& ": constant Name_Id := N + "
115 & Oval
& ';' & Restl
);
117 if Match
(Name
, Get_Name
) then
121 if Match
(Name
, Findu
, M
) then
122 Replace
(M
, Translate
(A
, Xlate_U_Und
));
123 Translate
(Name
, Lower_Case_Map
);
125 elsif not Match
(Name
, "Op_", "") then
126 Translate
(Name
, Lower_Case_Map
);
129 Name
:= 'O' & Translate
(Name
, Lower_Case_Map
);
132 if Name
= "error" then
133 Name
:= V
("<error>");
136 if not Match
(Name
, Chk_Low
) then
137 Put_Line
(OutB
, " """ & Name
& "#"" &");
144 Line
:= Get_Line
(InB
);
145 exit when Match
(Line
, " ""#"";");
148 Put_Line
(OutB
, Line
);
150 while not End_Of_File
(InB
) loop
151 Put_Line
(OutB
, Get_Line
(InB
));
154 Put_Line
(OutB
, "-- Updated to match snames.ads revision " & Specrev
);