File: display_source.adb

package info (click to toggle)
asis 2007-4
  • links: PTS
  • area: main
  • in suites: lenny
  • size: 7,832 kB
  • ctags: 34
  • sloc: ada: 93,665; makefile: 225
file content (381 lines) | stat: -rw-r--r-- 14,230 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
------------------------------------------------------------------------------
--                                                                          --
--                      DISPLAY_SOURCE COMPONENTS                           --
--                                                                          --
--                    D I S P L A Y _ S O U R C E                           --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (c) 1995-2000, Free Software Foundation, Inc.       --
--                                                                          --
-- Display_Source is free software; you can redistribute it and/or modify it--
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. Display_Source is distributed in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General  --
-- Public License for more details. You should have received a copy of the  --
-- GNU General Public License distributed with GNAT; see file COPYING. If   --
-- not, write to the Free Software Foundation, 59 Temple Place Suite 330,   --
-- Boston, MA 02111-1307, USA.                                              --
--                                                                          --
-- Display_Source is distributed as a part of the ASIS implementation for   --
-- GNAT (ASIS-for-GNAT).                                                     --
--                                                                          --
-- The   original   version   of  Display_Source  has  been  developed  by  --
-- Jean-Charles  Marteau and Serge Reboul,  ENSIMAG  High School Graduates  --
-- (Computer sciences)  Grenoble,  France  in  Sema Group Grenoble, France. --
--                                                                          --
-- Display_Source is now maintained by Ada Core Technologies Inc            --
-- (http://www.gnat.com).                                                   --
------------------------------------------------------------------------------

--------------------------------------------------
-- This procedure is the main procedure of the  --
--  ASIS application display_source             --
--------------------------------------------------
--
--  Authors of the original version (April 1996):
--            Jean-Charles Marteau (marteau@sema-grenoble.fr)
--            Serge Reboul         ( reboul@sema-grenoble.fr)
--
--
--  More explanations are writen in the functionality packages.
--
--  YHSTAH means that You Have Something To Add Here
--  when you want to create a new application, see
--  new_application.txt in ./Docs for more information
--
with Ada;
with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;

with Ada.Characters.Handling;

with Asis;
with Asis.Iterator;
with Asis.Elements;
with Asis.Exceptions;
with Asis.Compilation_Units;
with Asis.Ada_Environments;
with Asis.Implementation;

--  definitions of the working modes and
--  declaration of the global variable The_Mode.
with Global_Info; use Global_Info;

--  functionality packages
with Node_Trav; use Node_Trav;
with Source_Trav; use Source_Trav;
with Image_Trav; use Image_Trav;

procedure Display_Source is

   --  Instanciations of traverse_element
   --  There is, for now, 3 kinds of applications, so there is 3
   --  instanciations. There is more than 3 modes, but in fact
   --  the modes are grouped under more general modes and
   --  the differing modes of a same group are used only in
   --  the application type.
   procedure Traverse_Node is new Asis.Iterator.Traverse_Element
     (Info_Node, Pre_Procedure, Post_Procedure);

   procedure Traverse_Source is new Asis.Iterator.Traverse_Element
     (Info_Source, Pre_Source, Post_Source);

   procedure Traverse_Image is new Asis.Iterator.Traverse_Element
     (Info_Image, Pre_Image, Post_Image);

   function Is_Ads (File : String) return Boolean;
   --  ???

   procedure Process
     (Element :      in     Asis.Element;
      Control :      in out Asis.Traverse_Control;
      State_Source : in out Info_Source;
      State_Node :   in out Info_Node;
      State_Image :  in out Info_Image); --  YHSTAH
   --  ???

   function Main_Name (File : String) return Wide_String;
   --  ???

   --  YHSTAH

   --  Silly functions, just to help ...
   function Is_Ads (File : String) return Boolean is
   begin
      return File (File'Last - 3 .. File'Last) = ".ads" or else
             File (File'Last - 3 .. File'Last) = ".ADS";
   end Is_Ads;

   function Main_Name (File : String) return Wide_String is  --  ???
   begin
      return Ada.Characters.Handling.To_Wide_String
              (File (File'First .. File'Last - 4));
   end Main_Name;

   procedure Process (Element : in     Asis.Element;
                      Control : in out Asis.Traverse_Control;
                      State_Source : in out Info_Source;
                      State_Node : in out Info_Node;
                      State_Image : in out Info_Image --  YHSTAH
                   ) is
   begin
      case The_Mode is
         when Node_Modes =>
            Traverse_Node (Element, Control, State_Node);
         when Source_Modes =>
            Traverse_Source (Element, Control, State_Source);
         when Image_Modes =>
            Traverse_Image (Element, Control, State_Image);
            --  YHSTAH
      end case;
   end Process;

   --  Some global variables.
   The_DS_Context : Asis.Context;
   The_Unit : Asis.Compilation_Unit;
   The_Declaration : Asis.Declaration;
   The_Control : Asis.Traverse_Control := Asis.Continue;
   Command_File : Positive := 2;
   --  index of the command parameter where the filename is.

   The_Source_Information : Info_Source;
   The_Node_Information : Info_Node;
   The_Image_Information : Info_Image;
   --  YHSTAH

   --  display_source body --
begin

   --  First we analysis the command line
   --  Is there enough parameters ?
   if Ada.Command_Line.Argument_Count not in 1 .. 2 then
      Put_Line
        ("USAGE: " &
          Ada.Command_Line.Command_Name & " [-n|-s|-i|-e] Unit[.ads|.adb]");
      Put_Line ("     : " & Ada.Command_Line.Command_Name & " -h");
      return;
   end if;

   --  What parameters ?
   if Ada.Command_Line.Argument (1) = "-n" then
      The_Mode := Node;
   elsif Ada.Command_Line.Argument (1) = "-l" then
      The_Mode := Node_And_Lines;
   elsif Ada.Command_Line.Argument (1) = "-s" then
      The_Mode := Source;
   elsif Ada.Command_Line.Argument (1) = "-e" then
      The_Mode := Image_And_Example;
   elsif Ada.Command_Line.Argument (1) = "-t" then
      The_Mode := Test_Control;
   elsif Ada.Command_Line.Argument (1) = "-i" then
      The_Mode := Image;
      --  YHSTAH
   elsif Ada.Command_Line.Argument (1) = "-h" then
      Put_Line ("Functionalities available in display_source :");
      Put_Line ("---------------------------------------------");
      New_Line;
      Put_Line ("USAGE: " &
                Ada.Command_Line.Command_Name &
                " [-n|-s|-i|-e] Unit[.ads|.adb]");
      Put_Line ("     : " & Ada.Command_Line.Command_Name & " -h");
      New_Line;
      Put_Line ("  -n   displays all the node of the source in their");
      Put_Line ("       order of appearance.");
      Put_Line ("  -s   re-displays the source, after having been");
      Put_Line ("       completely processed by Asis. This functionality");
      Put_Line ("       tends to be a code formatter, but for now, just");
      Put_Line ("       keeps your sources the way you typed them ...");
      Put_Line ("       This is the default option.");
      Put_Line ("  -i   re-displays the source, and processes all elements.");
      Put_Line ("       like '-s' option, but the re-displaying is based on");
      Put_Line ("       Asis.Text features, so you have the same aspect than");
      Put_Line ("       the original source.");
      Put_Line ("  -e   is like '-i' option but it is a sample application");
      Put_Line ("       that works on pragmas.");
      Put_Line ("       (see image_trav.ads|b for mode details");
      --  YHSTAH
      Put_Line ("  -h   displays this help text");
      New_Line;
      return;
   elsif Ada.Command_Line.Argument (1)(1) = '-' or
     Ada.Command_Line.Argument (1)'Length <= 4
   then
      --  if the filename is not appropriate
      --  this will raise an error after ...
      Command_File := Positive'Last;
   else
      --  This is the default mode ...
      The_Mode := Source;
      Command_File := 1;
   end if;

   if Command_File > Ada.Command_Line.Argument_Count or else
     Ada.Command_Line.Argument (Command_File)'Length <= 4
   then
      --  Indeed there is a problem, so we exit
      Put_Line
        ("USAGE: " &
          Ada.Command_Line.Command_Name & " [-n|-s|-i|-e] Unit[.ads|.adb]");
      Put_Line ("     : " & Ada.Command_Line.Command_Name & " -h");
      return;
   end if;

   --  Initialization of Asis environment.
   Asis.Implementation.Initialize;
   Asis.Ada_Environments.Associate
     (The_Context => The_DS_Context,
      Name        => "The_DS_Context",
      Parameters  => "-FS");
   Asis.Ada_Environments.Open (The_DS_Context);
   ------------------------------
   declare
      Unite : String := Ada.Command_Line.Argument (Command_File);
   begin
      --  Converting file name in Ada Unit Name
      --  first let's change the '-' in '.' in the filename
      for Index in Unite'Range
      loop
         if Unite (Index) = '-' then
            Unite (Index) := '.';
         end if;
      end loop;

      --  let's load and compile the unit...

      if Is_Ads (Unite) then

         The_Unit :=  Asis.Compilation_Units.Library_Unit_Declaration
           (Main_Name (Unite), The_DS_Context);
      else
         The_Unit :=  Asis.Compilation_Units.Compilation_Unit_Body
           (Main_Name (Unite), The_DS_Context);
      end if;

      --  If it's null, continuing makes no sense ...
      if (Asis.Compilation_Units.Is_Nil (The_Unit)) then
         Put_Line ("Unit " & Unite & " is Nil...");

         Asis.Ada_Environments.Close (The_DS_Context);

         raise Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit;
      end if;


      --  Now we'll process the context clauses and pragmas
      The_Control := Asis.Continue;

      declare
         Clause_List : Asis.Context_Clause_List :=
           Asis.Elements.Context_Clause_Elements (The_Unit, True);
      begin
         for Each_Clause in Clause_List'Range loop
            Process (Clause_List (Each_Clause),
                     The_Control,
                     The_Source_Information,
                     The_Node_Information,
                     The_Image_Information
                     --  YHSTAH
                    );
         end loop;
      end;

      --  and now the main unit declaration
      The_Declaration := Asis.Elements.Unit_Declaration (The_Unit);

      --  Initialization, depending on the application
      case The_Mode is
         when Node_Modes =>
            Initiate_Node (The_Unit, The_Control, The_Node_Information);
         when Source_Modes =>
            Initiate_Source
              (The_Unit, Unite, The_Control, The_Source_Information);
         when Image_Modes =>
            Initiate_Image
              (The_Declaration, The_Control, The_Image_Information);
            --  YHSTAH
      end case;
   end;  --  we don't need unit anymore ...

   --  Now we traverse the declaration ...
   Process (The_Declaration,
            The_Control,
            The_Source_Information,
            The_Node_Information,
            The_Image_Information
            --  YHSTAH
           );

   --  Termination, depending on the application
   case The_Mode is
      when Node_Modes =>
         Terminate_Node (The_Control, The_Node_Information);
      when Source_Modes =>
         Terminate_Source (The_Control, The_Source_Information);
      when Image_Modes =>
         Terminate_Image (The_Control, The_Image_Information);
         --  YHSTAH
   end case;

   ------------------------------
   --  Closing Asis ....
   Asis.Ada_Environments.Close (The_DS_Context);
   Asis.Ada_Environments.Dissociate (The_DS_Context);
   Asis.Implementation.Finalize ("");

   --  let's delete the *.at? and *.ali files
   declare
      To_Erase : String := Ada.Command_Line.Argument (Command_File);
      File : File_Type;
   begin
      if To_Erase (To_Erase'Last - 3 .. To_Erase'Last - 1) = ".ad" or else
         To_Erase (To_Erase'Last - 3 .. To_Erase'Last - 1) = ".AD"
      then
         --  tree file
         To_Erase (To_Erase'Last) := 't';
         Open (File, Out_File, To_Erase);
         Delete (File);

         --  ali file
         To_Erase (To_Erase'Last - 2 .. To_Erase'Last) := "ali";
         Open (File, Out_File, To_Erase);
         Delete (File);

      end if;
   end;

exception

   when Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit =>
      Put_Line ("The file " & Ada.Command_Line.Argument (Command_File) &
                 " does not contain any Ada Unit.");
      New_Line;
      Put_Line
        ("USAGE: " &
          Ada.Command_Line.Command_Name &
          " [-n|-s] Unit[.ads|.adb]");
      Put_Line ("     : " & Ada.Command_Line.Command_Name & " -h");

      raise;

   when Asis.Exceptions.ASIS_Failed |
        Asis.Exceptions.ASIS_Inappropriate_Element |
        Asis.Exceptions.ASIS_Inappropriate_Context =>
         Put_Line (Ada.Characters.Handling.To_String
           (Asis.Implementation.Diagnosis));   --  ???
      raise;

   when Node_Stack.Stack_Error =>
      raise;

   when The_Error : others =>
      Put_Line ("The exception received : " &
                 Ada.Exceptions.Exception_Name (The_Error));
      Put_Line (Ada.Characters.Handling.To_String
         (Asis.Implementation.Diagnosis));
      raise;

end Display_Source;