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