with Ada.Command_Line; use Ada.Command_Line;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;
with Ada.Text_IO; use Ada.Text_IO;
with GNAT.Spitbol; use GNAT.Spitbol;
with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns;
procedure XSinfo is
Done : exception;
Err : exception;
A : VString := Nul;
Arg : VString := Nul;
Comment : VString := Nul;
Line : VString := Nul;
N : VString := Nul;
N1, N2 : VString := Nul;
Nam : VString := Nul;
Rtn : VString := Nul;
Term : VString := Nul;
InS : File_Type;
Ofile : File_Type;
wsp : Pattern := Span (' ' & ASCII.HT);
Wsp_For : Pattern := wsp & "for";
Is_Cmnt : Pattern := wsp & "--";
Typ_Nod : Pattern := wsp * A & "type Node_Kind is";
Get_Nam : Pattern := wsp * A & "N_" & Break (",)") * Nam
& Len (1) * Term;
Sub_Typ : Pattern := wsp * A & "subtype " & Break (' ') * N;
No_Cont : Pattern := wsp & Break (' ') * N1 & " .. " & Break (';') * N2;
Cont_N1 : Pattern := wsp & Break (' ') * N1 & " .." & Rpos (0);
Cont_N2 : Pattern := Span (' ') & Break (';') * N2;
Is_Func : Pattern := wsp * A & "function " & Rest * Nam;
Get_Arg : Pattern := wsp & "(N : " & Break (')') * Arg
& ") return " & Break (';') * Rtn
& ';' & wsp & "--" & wsp & Rest * Comment;
NKV : Natural;
M : Match_Result;
procedure Getline;
procedure Getline is
begin
loop
Line := Get_Line (InS);
if Line /= ""
and then not Match (Line, Wsp_For)
and then not Match (Line, Is_Cmnt)
then
return;
elsif Match (Line, " -- End functions (note") then
raise Done;
end if;
end loop;
end Getline;
begin
Set_Exit_Status (1);
Anchored_Mode := True;
if Argument_Count > 0 then
Create (Ofile, Out_File, Argument (1));
else
Create (Ofile, Out_File, "sinfo.h");
end if;
Open (InS, In_File, "sinfo.ads");
loop
Line := Get_Line (InS);
exit when Line = "";
Match
(Line,
"-- S p e c ",
"-- C Header File ");
Match (Line, "--", "/*");
Match (Line, Rtab (2) * A & "--", M);
Replace (M, A & "*/");
Put_Line (Ofile, Line);
end loop;
loop
Getline;
exit when Match (Line, "package");
end loop;
loop
Getline;
exit when Match (Line, Typ_Nod);
Put_Line (Ofile, Line);
end loop;
Put_Line (Ofile, "");
NKV := 0;
loop
Getline;
if Match (Line, Get_Nam) then
Put_Line (Ofile, A & "#define N_" & Nam & ' ' & NKV);
NKV := NKV + 1;
exit when not Match (Term, ",");
else
Put_Line (Ofile, Line);
end if;
end loop;
Put_Line (Ofile, "");
Put_Line (Ofile, A & "#define Number_Node_Kinds " & NKV);
loop
Getline;
if not Match (Line, Sub_Typ) then
exit when Match (Line, " function");
Put_Line (Ofile, Line);
else
Put_Line (Ofile, A & "SUBTYPE (" & N & ", Node_Kind, ");
Getline;
if Match (Line, No_Cont) then
Put_Line (Ofile, A & " " & N1 & ", " & N2 & ')');
else
if not Match (Line, Cont_N1) then
raise Err;
end if;
Getline;
if not Match (Line, Cont_N2) then
raise Err;
end if;
Put_Line (Ofile, A & " " & N1 & ',');
Put_Line (Ofile, A & " " & N2 & ')');
end if;
end if;
end loop;
loop
if Match (Line, Is_Func) then
Getline;
if not Match (Line, Get_Arg) then
raise Err;
end if;
Put_Line
(Ofile,
A & "INLINE " & Rpad (Rtn, 9)
& ' ' & Rpad (Nam, 30) & " (" & Arg & " N)");
Put_Line (Ofile, A & " { return " & Comment & " (N); }");
else
Put_Line (Ofile, Line);
end if;
Getline;
end loop;
exception
when Done =>
Put_Line (Ofile, "");
Set_Exit_Status (0);
end XSinfo;