with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Spitbol; use GNAT.Spitbol;
with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
procedure XSnames is
InB : File_Type;
InS : File_Type;
OutS : File_Type;
OutB : File_Type;
InH : File_Type;
OutH : File_Type;
A, B : VString := Nul;
Line : VString := Nul;
Name : VString := Nul;
Name1 : VString := Nul;
Oname : VString := Nul;
Oval : VString := Nul;
Restl : VString := Nul;
Tdigs : Pattern := Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set) &
Any (Decimal_Digit_Set);
Name_Ref : Pattern := Span (' ') * A & Break (' ') * Name
& Span (' ') * B
& ": constant Name_Id := N + " & Tdigs
& ';' & Rest * Restl;
Get_Name : Pattern := "Name_" & Rest * Name1;
Chk_Low : Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1);
Findu : Pattern := Span ('u') * A;
Val : Natural;
Xlate_U_Und : Character_Mapping := To_Mapping ("u", "_");
M : Match_Result;
type Header_Symbol is (None, Attr, Conv, Prag);
Header_Attr : aliased String := "Attr";
Header_Conv : aliased String := "Convention";
Header_Prag : aliased String := "Pragma";
type String_Ptr is access all String;
Header_Prefix : constant array (Header_Symbol) of String_Ptr :=
(null,
Header_Attr'Access,
Header_Conv'Access,
Header_Prag'Access);
Get_Attr : Pattern := Span (' ') & "Attribute_" & Break (",)") * Name1;
Get_Conv : Pattern := Span (' ') & "Convention_" & Break (",)") * Name1;
Get_Prag : Pattern := Span (' ') & "Pragma_" & Break (",)") * Name1;
type Header_Symbol_Counter is array (Header_Symbol) of Natural;
Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0);
Header_Current_Symbol : Header_Symbol := None;
Header_Pending_Line : VString := Nul;
procedure Output_Header_Line (S : Header_Symbol) is
begin
if Header_Current_Symbol /= S then
declare
Pat : String := "#define " & Header_Prefix (S).all;
In_Pat : Boolean := False;
begin
if Header_Current_Symbol /= None then
Put_Line (OutH, Header_Pending_Line);
end if;
loop
Line := Get_Line (InH);
if Match (Line, Pat) then
In_Pat := true;
elsif In_Pat then
Header_Pending_Line := Line;
exit;
else
Put_Line (OutH, Line);
end if;
end loop;
Header_Current_Symbol := S;
end;
end if;
Put_Line (OutH, "#define " & Header_Prefix (S).all
& "_" & Name1 & (30 - Length (Name1)) * ' '
& Header_Counter (S));
Header_Counter (S) := Header_Counter (S) + 1;
end Output_Header_Line;
begin
Open (InB, In_File, "snames.adb");
Open (InS, In_File, "snames.ads");
Open (InH, In_File, "snames.h");
Create (OutS, Out_File, "snames.ns");
Create (OutB, Out_File, "snames.nb");
Create (OutH, Out_File, "snames.nh");
Anchored_Mode := True;
Oname := Nul;
Val := 0;
loop
Line := Get_Line (InB);
exit when Match (Line, " Preset_Names");
Put_Line (OutB, Line);
end loop;
Put_Line (OutB, Line);
LoopN : while not End_Of_File (InS) loop
Line := Get_Line (InS);
if not Match (Line, Name_Ref) then
Put_Line (OutS, Line);
if Match (Line, Get_Attr) then
Output_Header_Line (Attr);
elsif Match (Line, Get_Conv) then
Output_Header_Line (Conv);
elsif Match (Line, Get_Prag) then
Output_Header_Line (Prag);
end if;
else
Oval := Lpad (V (Val), 3, '0');
if Match (Name, "Last_") then
Oval := Lpad (V (Val - 1), 3, '0');
end if;
Put_Line
(OutS, A & Name & B & ": constant Name_Id := N + "
& Oval & ';' & Restl);
if Match (Name, Get_Name) then
Name := Name1;
Val := Val + 1;
if Match (Name, Findu, M) then
Replace (M, Translate (A, Xlate_U_Und));
Translate (Name, Lower_Case_Map);
elsif not Match (Name, "Op_", "") then
Translate (Name, Lower_Case_Map);
else
Name := 'O' & Translate (Name, Lower_Case_Map);
end if;
if Name = "error" then
Name := V ("<error>");
end if;
if not Match (Name, Chk_Low) then
Put_Line (OutB, " """ & Name & "#"" &");
end if;
end if;
end if;
end loop LoopN;
loop
Line := Get_Line (InB);
exit when Match (Line, " ""#"";");
end loop;
Put_Line (OutB, Line);
while not End_Of_File (InB) loop
Line := Get_Line (InB);
Put_Line (OutB, Line);
end loop;
Put_Line (OutH, Header_Pending_Line);
while not End_Of_File (InH) loop
Line := Get_Line (InH);
Put_Line (OutH, Line);
end loop;
end XSnames;