1------------------------------------------------------------------------------ 2-- -- 3-- ASIS-for-GNAT IMPLEMENTATION COMPONENTS -- 4-- -- 5-- A 4 G . U _ C O N V -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (c) 1995-2006, Free Software Foundation, Inc. -- 10-- -- 11-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it -- 12-- under terms of the GNU General Public License as published by the Free -- 13-- Software Foundation; either version 2, or (at your option) any later -- 14-- version. ASIS-for-GNAT is distributed in the hope that it will be use- -- 15-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- -- 16-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- 17-- Public License for more details. You should have received a copy of the -- 18-- GNU General Public License distributed with ASIS-for-GNAT; see file -- 19-- COPYING. If not, write to the Free Software Foundation, 51 Franklin -- 20-- Street, Fifth Floor, Boston, MA 02110-1301, USA. -- 21-- -- 22-- -- 23-- -- 24-- -- 25-- -- 26-- -- 27-- -- 28-- -- 29-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the -- 30-- Software Engineering Laboratory of the Swiss Federal Institute of -- 31-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the -- 32-- Scientific Research Computer Center of Moscow State University (SRCC -- 33-- MSU), Russia, with funding partially provided by grants from the Swiss -- 34-- National Science Foundation and the Swiss Academy of Engineering -- 35-- Sciences. ASIS-for-GNAT is now maintained by AdaCore -- 36-- (http://www.adaccore.com). -- 37-- -- 38------------------------------------------------------------------------------ 39 40with Ada.Characters.Handling; use Ada.Characters.Handling; 41 42with Namet; use Namet; 43with Fname; use Fname; 44with Krunch; 45with Opt; use Opt; 46 47package body A4G.U_Conv is 48 49 --------------------------------- 50 -- Local Types and Subprograms -- 51 --------------------------------- 52 53 -- We use the trivial finite state automata to analyse and to transform 54 -- strings passed as parameters to ASIS interfaces and processed by ASIS 55 -- itself below there are type and routines definitions for various 56 -- versions of this automata 57 58 type State is (Beg_Ident, Mid_Ident, Und_Line); 59 -- The states of the automata. Some versions may use only a part of the 60 -- whole set of states. 61 62 procedure Normalize_Char (In_Char : Character; 63 Curr_State : in out State; 64 Out_Char : out Character; 65 OK : out Boolean); 66 -- One step of the finite-state-automata analyzing the string which is 67 -- supposed to be an Ada unit name and producind the "normalized" 68 -- version of the name. If In_Char under in the state Curr_State may be 69 -- considered as belonging to the Ada unit name, the "low-case version" 70 -- of this character is assigned to Out_Char, and OK is ste True, 71 -- otherwise OK is set false 72 73 function Convert_Char (Ch : Character) return Character; 74 -- performs upper case -> lover case conversion in the GNAT file 75 -- name style (see GNAT Document INTRO and Fnames.ads - only letters 76 -- from the A .. Z range are folded to lower case) 77 78 ------------------ 79 -- Convert_Char -- 80 ------------------ 81 82 function Convert_Char (Ch : Character) return Character is 83 begin 84 85 if Ch = '.' then 86 return '-'; 87 else 88 return To_Lower (Ch); 89 end if; 90 91 end Convert_Char; 92 93 ------------------------ 94 -- Get_Norm_Unit_Name -- 95 ------------------------ 96 97 procedure Get_Norm_Unit_Name 98 (U_Name : String; 99 N_U_Name : out String; 100 Spec : Boolean; 101 May_Be_Unit_Name : out Boolean) 102 is 103 Current_State : State := Beg_Ident; 104 begin 105 106 May_Be_Unit_Name := False; 107 108 for I in U_Name'Range loop 109 110 Normalize_Char (U_Name (I), Current_State, 111 N_U_Name (I), May_Be_Unit_Name); 112 113 exit when not May_Be_Unit_Name; 114 115 end loop; 116 117 if not May_Be_Unit_Name then 118 return; 119 120 elsif N_U_Name (U_Name'Last) = '_' or else 121 N_U_Name (U_Name'Last) = '.' 122 then 123 -- something like "Ab_" -> "ab_" or "Ab_Cd." -> "ab_cd." 124 May_Be_Unit_Name := False; 125 return; 126 end if; 127 128 -- here we have all the content of U_Name parced and 129 -- May_Be_Unit_Name is True. All we have to do is to append 130 -- the "%s" or "%b" suffix 131 132 N_U_Name (N_U_Name'Last - 1) := '%'; 133 134 if Spec then 135 N_U_Name (N_U_Name'Last) := 's'; 136 else 137 N_U_Name (N_U_Name'Last) := 'b'; 138 end if; 139 140 end Get_Norm_Unit_Name; 141 142 ----------------------------- 143 -- Is_Predefined_File_Name -- 144 ----------------------------- 145 146 function Is_Predefined_File_Name (S : String_Access) return Boolean is 147 begin 148 Namet.Name_Len := S'Length - 1; 149 -- "- 1" is for trailing ASCII.NUL in the file name 150 Namet.Name_Buffer (1 .. Namet.Name_Len) := To_String (S); 151 return Fname.Is_Predefined_File_Name (Namet.Name_Enter); 152 end Is_Predefined_File_Name; 153 154 -------------------- 155 -- Normalize_Char -- 156 -------------------- 157 158 procedure Normalize_Char 159 (In_Char : Character; 160 Curr_State : in out State; 161 Out_Char : out Character; 162 OK : out Boolean) 163 is 164 begin 165 166 OK := True; 167 168 case Curr_State is 169 170 when Beg_Ident => 171 172 if Is_Letter (In_Char) then 173 Curr_State := Mid_Ident; 174 else 175 OK := False; 176 end if; 177 178 when Mid_Ident => 179 180 if Is_Letter (In_Char) or else 181 Is_Digit (In_Char) 182 then 183 null; 184 elsif In_Char = '_' then 185 Curr_State := Und_Line; 186 elsif In_Char = '.' then 187 Curr_State := Beg_Ident; 188 else 189 OK := False; 190 end if; 191 192 when Und_Line => 193 if Is_Letter (In_Char) or else 194 Is_Digit (In_Char) 195 then 196 Curr_State := Mid_Ident; 197 else 198 OK := False; 199 end if; 200 201 end case; 202 203 Out_Char := To_Lower (In_Char); 204 205 end Normalize_Char; 206 207 --------------------------- 208 -- Source_From_Unit_Name -- 209 --------------------------- 210 211 function Source_From_Unit_Name 212 (S : String; 213 Spec : Boolean) 214 return String_Access 215 is 216 Result_Prefix : String (1 .. S'Length); 217 Result_Selector : String (1 .. 4) := ".adb"; 218 219 Initial_Length : constant Natural := S'Length; 220 Result_Length : Natural := Initial_Length; 221 -- this is for the name krunching 222 begin 223 for I in S'Range loop 224 Result_Prefix (I) := Convert_Char (S (I)); 225 end loop; 226 227 Krunch 228 (Buffer => Result_Prefix, 229 Len => Result_Length, 230 Maxlen => Integer (Maximum_File_Name_Length), 231 No_Predef => False); 232 233 if Spec then 234 Result_Selector (4) := 's'; 235 end if; 236 237 return new String'(Result_Prefix (1 .. Result_Length) 238 & Result_Selector 239 & ASCII.NUL); 240 241 end Source_From_Unit_Name; 242 243 --------------- 244 -- To_String -- 245 --------------- 246 247 function To_String (S : String_Access) return String is 248 begin 249 return S.all (S'First .. S'Last - 1); 250 end To_String; 251 252 --------------------------- 253 -- Tree_From_Source_Name -- 254 --------------------------- 255 256 function Tree_From_Source_Name (S : String_Access) return String_Access is 257 Return_Val : String_Access; 258 begin 259 Return_Val := new String'(S.all); 260 -- the content of S should be "*.ad?" & ASCII.NUL 261 Return_Val (Return_Val'Last - 1) := 't'; -- ".ad?" -> ".adt" 262 return Return_Val; 263 end Tree_From_Source_Name; 264 265end A4G.U_Conv; 266