1------------------------------------------------------------------------------
2--                                                                          --
3--                           GPR PROJECT MANAGER                            --
4--                                                                          --
5--          Copyright (C) 2015, Free Software Foundation, Inc.              --
6--                                                                          --
7-- This library is free software;  you can redistribute it and/or modify it --
8-- under terms of the  GNU General Public License  as published by the Free --
9-- Software  Foundation;  either version 3,  or (at your  option) any later --
10-- version. This library is distributed in the hope that it will be useful, --
11-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
12-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
13--                                                                          --
14-- As a special exception under Section 7 of GPL version 3, you are granted --
15-- additional permissions described in the GCC Runtime Library Exception,   --
16-- version 3.1, as published by the Free Software Foundation.               --
17--                                                                          --
18-- You should have received a copy of the GNU General Public License and    --
19-- a copy of the GCC Runtime Library Exception along with this program;     --
20-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
21-- <http://www.gnu.org/licenses/>.                                          --
22--                                                                          --
23------------------------------------------------------------------------------
24
25with Ada.Text_IO;    use Ada.Text_IO;
26
27with GNAT.Case_Util; use GNAT.Case_Util;
28
29procedure Xsnames is
30   File_In : File_Type;
31   Line : String (1 .. 100);
32   Last : Natural;
33
34   Spec_Init_Name : constant String := "snames_spec_init.txt";
35   Body_Init_Name : constant String := "snames_body_init.txt";
36   File_Name : constant String := "snames.list";
37
38   Spec_File : File_Type;
39   Spec_File_Name : constant String := "gpr-snames.ads";
40
41   Body_File : File_Type;
42   Body_File_Name : constant String := "gpr-snames.adb";
43
44   Counter : Natural := 0;
45
46   function Image (N : Natural) return String;
47
48   -----------
49   -- Image --
50   -----------
51
52   function Image (N : Natural) return String is
53      Img : constant String := N'Img;
54   begin
55      if N < 10 then
56         return "00" & Img (2);
57      elsif N < 100 then
58         return "0" & Img (2 .. 3);
59      else
60         return Img (2 .. Img'Last);
61      end if;
62   end Image;
63
64begin
65   --  Initialize spec
66   Create (Spec_File, Out_File, Spec_File_Name);
67   Open (File_In, In_File, Spec_Init_Name);
68
69   while not End_Of_File (File_In) loop
70      Get_Line (File_In, Line, Last);
71      Put_Line (Spec_File, Line (1 .. Last));
72   end loop;
73
74   Close (File_In);
75   New_Line (Spec_File);
76
77   --  Initialize body
78   Create (Body_File, Out_File, Body_File_Name);
79   Open (File_In, In_File, Body_Init_Name);
80
81   while not End_Of_File (File_In) loop
82      Get_Line (File_In, Line, Last);
83      Put_Line (Body_File, Line (1 .. Last));
84   end loop;
85
86   Close (File_In);
87   New_Line (Body_File);
88   Put_Line (Body_File, "   Initialized : Boolean := False;");
89   New_Line (Body_File);
90   Put_Line (Body_File, "   ----------------");
91   Put_Line (Body_File, "   -- Initialize --");
92   Put_Line (Body_File, "   ----------------");
93   New_Line (Body_File);
94   Put_Line (Body_File, "   procedure Initialize is");
95   Put_Line (Body_File, "   begin");
96   Put_Line (Body_File, "      if Initialized then");
97   Put_Line (Body_File, "         return;");
98   Put_Line (Body_File, "      end if;");
99   New_Line (Body_File);
100
101   --  First the single characters
102
103   for Ch in Character range 'A' .. 'Z' loop
104      declare
105         Lower_Name : String := (1 => Ch);
106      begin
107         To_Lower (Lower_Name);
108         Counter := Counter + 1;
109         Put (Spec_File, "   Name_" & Ch);
110         Set_Col (Spec_File, 42);
111         Put_Line
112           (Spec_File, ": constant Name_Id := N + " & Image (Counter) & ";");
113
114         Put (Body_File, "      Add_Name (""");
115         Put (Body_File, Lower_Name);
116         Put_Line (Body_File, """);");
117      end;
118   end loop;
119
120   --  Read the names
121   Open (File_In, In_File, File_Name);
122   while not End_Of_File (File_In) loop
123      Get_Line (File_In, Line, Last);
124
125      if Last >= 2 and then Line (1 .. 2) /= "--" then
126         Counter := Counter + 1;
127         Put (Spec_File, "   Name_" & Line (1 .. Last));
128         Set_Col (Spec_File, 42);
129         Put_Line
130           (Spec_File, ": constant Name_Id := N + " & Image (Counter) & ";");
131
132         declare
133            Lower_Name : String := Line (1 .. Last);
134         begin
135            To_Lower (Lower_Name);
136            Put (Body_File, "      Add_Name (""");
137            Put (Body_File, Lower_Name);
138            Put_Line (Body_File, """);");
139         end;
140      end if;
141   end loop;
142
143   Close (File_In);
144
145   --  Finish the spec
146
147   New_Line (Spec_File);
148   Put_Line (Spec_File, "   subtype Reserved_Ada_95 is Name_Id");
149   Put_Line (Spec_File, "      range Name_Abort .. Name_Tagged;");
150   Put_Line (Spec_File, "   subtype Reserved_Ada_Project is Name_Id");
151   Put_Line (Spec_File, "      range Name_Abort .. Name_External_As_List;");
152   Put_Line (Spec_File, "   subtype Reserved_Ada_Other is Name_Id");
153   Put_Line (Spec_File, "      range Name_Interface .. Name_Some;");
154   New_Line (Spec_File);
155   Put_Line (Spec_File, "   procedure Initialize;");
156   New_Line (Spec_File);
157   Put_Line (Spec_File, "end GPR.Snames;");
158   Close (Spec_File);
159
160   --  Finish the body
161
162   New_Line (Body_File);
163   Put_Line (Body_File, "      Initialized := True;");
164   Put_Line (Body_File, "   end Initialize;");
165   New_Line (Body_File);
166   Put_Line (Body_File, "end GPR.Snames;");
167   Close (Body_File);
168end Xsnames;
169