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