1 ------------------------------------------------------------------------------
3 -- GNAT SYSTEM UTILITIES --
9 -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- Program to construct the spec and body of the Nmake package
30 -- sinfo.ads Spec of Sinfo package
31 -- nmake.adt Template for Nmake package
35 -- nmake.ads Spec of Nmake package
36 -- nmake.adb Body of Nmake package
38 -- Note: this program assumes that sinfo.ads has passed the error checks that
39 -- are carried out by the csinfo utility, so it does not duplicate these
40 -- checks and assumes that sinfo.ads has the correct form.
42 -- In the absence of any switches, both the ads and adb files are output.
43 -- The switch -s or /s indicates that only the ads file is to be output.
44 -- The switch -b or /b indicates that only the adb file is to be output.
46 -- If a file name argument is given, then the output is written to this file
47 -- rather than to nmake.ads or nmake.adb. A file name can only be given if
48 -- exactly one of the -s or -b options is present.
50 with Ada.Command_Line; use Ada.Command_Line;
51 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
52 with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
53 with Ada.Strings.Maps; use Ada.Strings.Maps;
54 with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
55 with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
56 with Ada.Text_IO; use Ada.Text_IO;
58 with GNAT.Spitbol; use GNAT.Spitbol;
59 with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
64 -- Raised to terminate execution
66 pragma Warnings (Off);
67 -- The following are modified by * operator
71 Arg_List : VString := Nul;
72 Comment : VString := Nul;
73 Default : VString := Nul;
74 Field : VString := Nul;
75 Line : VString := Nul;
76 Node : VString := Nul;
77 Op_Name : VString := Nul;
78 Prevl : VString := Nul;
79 Synonym : VString := Nul;
84 FileS : VString := V ("nmake.ads");
85 FileB : VString := V ("nmake.adb");
86 -- Set to null if corresponding file not to be generated
88 Given_File : VString := Nul;
89 -- File name given by command line argument
91 subtype Sfile is Ada.Streams.Stream_IO.File_Type;
93 InS, InT : Ada.Text_IO.File_Type;
96 wsp : constant Pattern := Span (' ' & ASCII.HT);
98 Body_Only : constant Pattern := BreakX (' ') * X
99 & Span (' ') & "-- body only";
100 Spec_Only : constant Pattern := BreakX (' ') * X
101 & Span (' ') & "-- spec only";
103 Node_Hdr : constant Pattern := wsp & "-- N_" & Rest * Node;
104 Punc : constant Pattern := BreakX (" .,");
106 Binop : constant Pattern := wsp
107 & "-- plus fields for binary operator";
108 Unop : constant Pattern := wsp
109 & "-- plus fields for unary operator";
110 Syn : constant Pattern := wsp & "-- " & Break (' ') * Synonym
111 & " (" & Break (')') * Field
114 Templ : constant Pattern := BreakX ('T') * A & "T e m p l a t e";
115 Spec : constant Pattern := BreakX ('S') * A & "S p e c";
117 Sem_Field : constant Pattern := BreakX ('-') & "-Sem";
118 Lib_Field : constant Pattern := BreakX ('-') & "-Lib";
120 Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field;
122 Get_Dflt : constant Pattern := BreakX ('(') & "(set to "
123 & Break (" ") * Default & " if";
125 Next_Arg : constant Pattern := Break (',') * Arg & ',';
127 Op_Node : constant Pattern := "Op_" & Rest * Op_Name;
129 Shft_Rot : constant Pattern := "Shift_" or "Rotate_";
131 No_Ent : constant Pattern := "Or_Else" or "And_Then"
136 V_String_Id : constant VString := V ("String_Id");
137 V_Node_Id : constant VString := V ("Node_Id");
138 V_Name_Id : constant VString := V ("Name_Id");
139 V_List_Id : constant VString := V ("List_Id");
140 V_Elist_Id : constant VString := V ("Elist_Id");
141 V_Boolean : constant VString := V ("Boolean");
143 procedure Put_Line (F : Sfile; S : String);
144 procedure Put_Line (F : Sfile; S : VString);
145 -- Local version of Put_Line ensures Unix style line endings
147 procedure WriteS (S : String);
148 procedure WriteB (S : String);
149 procedure WriteBS (S : String);
150 procedure WriteS (S : VString);
151 procedure WriteB (S : VString);
152 procedure WriteBS (S : VString);
153 -- Write given line to spec or body file or both if active
155 procedure WriteB (S : String) is
162 procedure WriteB (S : VString) is
169 procedure WriteBS (S : String) is
180 procedure WriteBS (S : VString) is
191 procedure WriteS (S : String) is
198 procedure WriteS (S : VString) is
205 procedure Put_Line (F : Sfile; S : String) is
207 String'Write (Stream (F), S);
208 Character'Write (Stream (F), ASCII.LF);
211 procedure Put_Line (F : Sfile; S : VString) is
213 Put_Line (F, To_String (S));
216 -- Start of processing for XNmake
220 Anchored_Mode := True;
222 for ArgN in 1 .. Argument_Count loop
224 Arg : constant String := Argument (ArgN);
227 if Arg (1) = '-' then
229 and then (Arg (2) = 'b' or else Arg (2) = 'B')
234 and then (Arg (2) = 's' or else Arg (2) = 'S')
243 if Given_File /= Nul then
246 Given_File := V (Arg);
252 if FileS = Nul and then FileB = Nul then
255 elsif Given_File /= Nul then
259 elsif FileS = Nul then
267 Open (InS, In_File, "sinfo.ads");
268 Open (InT, In_File, "nmake.adt");
271 Create (OutS, Out_File, S (FileS));
275 Create (OutB, Out_File, S (FileB));
278 Anchored_Mode := True;
280 -- Copy initial part of template to spec and body
283 Line := Get_Line (InT);
285 -- Skip lines describing the template
287 if Match (Line, "-- This file is a template") then
289 Line := Get_Line (InT);
294 -- Loop keeps going until "package" keyword written
296 exit when Match (Line, "package");
298 -- Deal with WITH lines, writing to body or spec as appropriate
300 if Match (Line, Body_Only, M) then
304 elsif Match (Line, Spec_Only, M) then
308 -- Change header from Template to Spec and write to spec file
311 if Match (Line, Templ, M) then
312 Replace (M, A & " S p e c ");
317 -- Write header line to body file
319 if Match (Line, Spec, M) then
320 Replace (M, A & "B o d y");
327 -- Package line reached
329 WriteS ("package Nmake is");
330 WriteB ("package body Nmake is");
333 -- Copy rest of lines up to template insert point to spec only
336 Line := Get_Line (InT);
337 exit when Match (Line, "!!TEMPLATE INSERTION POINT");
341 -- Here we are doing the actual insertions, loop through node types
344 Line := Get_Line (InS);
346 if Match (Line, Node_Hdr)
347 and then not Match (Node, Punc)
348 and then Node /= "Unused"
350 exit when Node = "Empty";
351 Prevl := " function Make_" & Node & " (Sloc : Source_Ptr";
354 -- Loop through fields of one node
357 Line := Get_Line (InS);
360 if Match (Line, Binop) then
361 WriteBS (Prevl & ';');
362 Append (Arg_List, "Left_Opnd,Right_Opnd,");
364 " " & Rpad ("Left_Opnd", NWidth) & " : Node_Id;");
366 " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
368 elsif Match (Line, Unop) then
369 WriteBS (Prevl & ';');
370 Append (Arg_List, "Right_Opnd,");
371 Prevl := " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id";
373 elsif Match (Line, Syn) then
374 if Synonym /= "Prev_Ids"
375 and then Synonym /= "More_Ids"
376 and then Synonym /= "Comes_From_Source"
377 and then Synonym /= "Paren_Count"
378 and then not Match (Field, Sem_Field)
379 and then not Match (Field, Lib_Field)
381 Match (Field, Get_Field);
383 if Field = "Str" then
384 Field := V_String_Id;
385 elsif Field = "Node" then
387 elsif Field = "Name" then
389 elsif Field = "List" then
391 elsif Field = "Elist" then
393 elsif Field = "Flag" then
397 if Field = "Boolean" then
398 Default := V ("False");
403 Match (Comment, Get_Dflt);
405 WriteBS (Prevl & ';');
406 Append (Arg_List, Synonym & ',');
407 Rpad (Synonym, NWidth);
410 Prevl := " " & Synonym & " : " & Field;
413 " " & Synonym & " : " & Field & " := " & Default;
419 WriteBS (Prevl & ')');
420 WriteS (" return Node_Id;");
421 WriteS (" pragma Inline (Make_" & Node & ");");
422 WriteB (" return Node_Id");
424 WriteB (" N : constant Node_Id :=");
426 if Match (Node, "Defining_Identifier") or else
427 Match (Node, "Defining_Character") or else
428 Match (Node, "Defining_Operator")
430 WriteB (" New_Entity (N_" & Node & ", Sloc);");
432 WriteB (" New_Node (N_" & Node & ", Sloc);");
437 while Match (Arg_List, Next_Arg, "") loop
438 if Length (Arg) < NWidth then
439 WriteB (" Set_" & Arg & " (N, " & Arg & ");");
441 WriteB (" Set_" & Arg);
442 WriteB (" (N, " & Arg & ");");
446 if Match (Node, Op_Node) then
447 if Node = "Op_Plus" then
448 WriteB (" Set_Chars (N, Name_Op_Add);");
450 elsif Node = "Op_Minus" then
451 WriteB (" Set_Chars (N, Name_Op_Subtract);");
453 elsif Match (Op_Name, Shft_Rot) then
454 WriteB (" Set_Chars (N, Name_" & Op_Name & ");");
457 WriteB (" Set_Chars (N, Name_" & Node & ");");
460 if not Match (Op_Name, No_Ent) then
461 WriteB (" Set_Entity (N, Standard_" & Node & ");");
465 WriteB (" return N;");
466 WriteB (" end Make_" & Node & ';');
471 WriteBS ("end Nmake;");
476 Put_Line (Standard_Error, "usage: xnmake [-b] [-s] [filename]");