Hosted by
 |
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
use Ada;
with Integer_Strings;
use Integer_Strings;
with Gnat.IO_Aux;
use Gnat;
package body Parsers is
function "-"
(A : in String)
return Unbounded_String
renames To_Unbounded_String;
function "-"
(A : in Unbounded_String)
return String
renames To_String;
function Current_Input
return Parser is
begin
return new Parser_Record;
end Current_Input;
function Open
(File_Name : in String)
return Parser
is
Result : Parser := new Parser_Record;
begin
Result.File_Name := -File_Name;
Text_IO.Open(Result.File, Text_IO.In_File, File_Name);
return Result;
end Open;
procedure Free is new Unchecked_Deallocation(Parser_Record, Parsers.Parser);
procedure Close
(Parser : in out Parsers.Parser) is
begin
if Length(Parser.File_Name) /= 0 then
Text_IO.Close(Parser.File);
end if;
Free(Parser);
Parser := null;
end Close;
procedure Set_Auto_Read
(Parser : in Parsers.Parser;
Auto_Read : in Boolean) is
begin
Parser.Auto_Read := Auto_Read;
end Set_Auto_Read;
function Next_Line
(Parser : in Parsers.Parser)
return Boolean is
begin
if Length(Parser.File_Name) = 0 then
Parser.Line := -IO_Aux.Get_Line;
else
if Text_IO.End_Of_File(Parser.File) then
return False;
end if;
Parser.Line := -IO_Aux.Get_Line(Parser.File);
end if;
Parser.Cursor := 1;
Parser.Line_Number := Parser.Line_Number + 1;
return True;
end Next_Line;
function End_Of_Line
(Parser : in Parsers.Parser)
return Boolean is
begin
return Parser.Cursor > Length(Parser.Line);
end End_Of_Line;
pragma Inline(End_Of_Line);
function End_Of_File
(Parser : in Parsers.Parser)
return Boolean is
begin
return Text_IO.End_Of_File(Parser.File);
end End_Of_File;
pragma Inline(End_Of_File);
procedure Skip
(Parser : in Parsers.Parser;
Count : in Positive := 1)
is
begin
Parser.Cursor := Parser.Cursor + Count;
end Skip;
function Skip
(Parser : in Parsers.Parser)
return Character
is
Result : Character := Element(Parser.Line, Parser.Cursor);
begin
Parser.Cursor := Parser.Cursor + 1;
return Result;
end Skip;
function Skip
(Parser : in Parsers.Parser;
Count : in Positive)
return String
is
Result : String := Slice(Parser.Line,
Parser.Cursor , Parser.Cursor + Count - 1);
begin
Parser.Cursor := Parser.Cursor + Count;
return Result;
end Skip;
function Char
(Parser : in Parsers.Parser)
return Character is
begin
return Element(Parser.Line, Parser.Cursor);
end Char;
pragma Inline(Char);
function Found
(Parser : in Parsers.Parser;
Char : in Character)
return Boolean is
begin
if End_Of_Line(Parser) then return False; end if;
return Parsers.Char(Parser) = Char;
end Found;
pragma Inline(Found);
function Found
(Parser : in Parsers.Parser;
Text : in String)
return Boolean
is
First : Positive := Parser.Cursor;
Last : Positive := Parser.Cursor + Text'Length - 1;
begin
return Length(Parser.Line) >= Last and then
Slice(Parser.Line, First, Last) = Text;
end Found;
function Found_Any
(Parser : in Parsers.Parser;
Chars : in String)
return Boolean
is
Found : Boolean := False;
begin
if End_Of_Line(Parser) then return False; end if;
for Index in Chars'Range loop
if Parsers.Found(Parser, Chars(Index)) then
Found := True;
end if;
exit when Found;
end loop;
return Found;
end Found_Any;
function Skip
(Parser : in Parsers.Parser;
Char : in Character)
return Boolean
is
Result : Boolean := Found(Parser, Char);
begin
if Result then Skip(Parser); end if;
return Result;
end Skip;
function Skip
(Parser : in Parsers.Parser;
Text : in String)
return Boolean
is
Result : Boolean := Found(Parser, Text);
begin
if Result then Skip(Parser, Text'Length); end if;
return Result;
end Skip;
procedure Skip
(Parser : in Parsers.Parser;
Char : in Character)
is
Dummy : Boolean;
begin
Dummy := Skip(Parser, Char);
end Skip;
function Skip_Any
(Parser : in Parsers.Parser;
Chars : in String)
return Boolean
is
Result : Boolean := False;
begin
loop
if End_Of_Line(Parser) or else
not Found_Any(Parser, Chars)
then return Result;
end if;
Skip(Parser);
Result := True;
end loop;
end Skip_Any;
procedure Skip_Any
(Parser : in Parsers.Parser;
Chars : in String)
is
Result : Boolean;
begin
Result := Skip_Any(Parser, Chars);
end Skip_Any;
function Scan_Any
(Parser : in Parsers.Parser;
Chars : in String)
return Boolean
is
Result : Boolean := False;
begin
loop
if End_Of_Line(Parser) or else
Found_Any(Parser, Chars)
then return Result;
end if;
Result := True;
Skip(Parser);
end loop;
end Scan_Any;
procedure Scan_Any
(Parser : in Parsers.Parser;
Chars : in String)
is
Result : Boolean;
begin
Result := Scan_Any(Parser, Chars);
end Scan_Any;
procedure Skip
(Parser : in Parsers.Parser;
Text : in String)
is
Dummy : Boolean;
begin
Dummy := Skip(Parser, Text);
end Skip;
function Scan
(Parser : in Parsers.Parser;
Char : in Character)
return Boolean
is
Cursor : Positive := Parser.Cursor;
begin
loop
if Cursor > Length(Parser.Line) then
return False;
elsif Element(Parser.Line, Parser.Cursor) = Char then
Parser.Cursor := Cursor;
return True;
end if;
Cursor := Cursor + 1;
end loop;
end Scan;
procedure Scan
(Parser : in Parsers.Parser;
Char : in Character)
is
Result : Boolean := Scan(Parser, Char);
begin
null;
end Scan;
function Scan
(Parser : in Parsers.Parser;
Text : in String)
return Boolean
is
Old_Cursor : Positive := Parser.Cursor;
First_Char : Character := Text(Text'First);
Last_Char_Offset : Natural := Text'Length - 1;
begin
loop
if not Scan(Parser, First_Char) then
Parser.Cursor := Old_Cursor;
return False;
else
if Parsers.Found(Parser, Text) then
return True;
else
Skip(Parser);
end if;
end if;
end loop;
end Scan;
procedure Scan
(Parser : in Parsers.Parser;
Text : in String)
is
Result : Boolean := Scan(Parser, Text);
begin
null;
end Scan;
function Read_Natural
(Parser : in Parsers.Parser)
return Natural
is
C : Character;
Result : Natural := 0;
begin
loop
exit when End_Of_Line(Parser);
C := Char(Parser);
exit when not (C in '0' .. '9');
Result := Result * 10 +
Character'Pos(C) - Character'Pos('0');
Skip(Parser);
end loop;
return Result;
end Read_Natural;
function Read_Positive
(Parser : in Parsers.Parser)
return Positive
is
Expected_Positive : exception;
Result : Natural := Read_Natural(Parser);
begin
if Result = 0 then
Error(Parser, "expected positive number");
end if;
return Result;
end Read_Positive;
function Read_Integer
(Parser : in Parsers.Parser)
return Integer
is
begin
if Skip(Parser, '-') then
return -Read_Natural(Parser);
else
return Read_Natural(Parser);
end if;
end Read_Integer;
function Read_Float
(Parser : in Parsers.Parser)
return Float
is
C : Character;
Result : Float := 0.0;
Digit_Value : Float := 1.0;
begin
loop
C := Char(Parser);
exit when not (C in '0' .. '9');
Result := Result * 10.0 +
Float(Character'Pos(C) - Character'Pos('0'));
Skip(Parser);
end loop;
if not Skip(Parser, '.') then
return Result;
end if;
loop
C := Char(Parser);
exit when not (C in '0' .. '9');
Digit_Value := Digit_Value / 10.0;
Result := Result + Digit_Value *
Float(Character'Pos(C) - Character'Pos('0'));
Skip(Parser);
end loop;
return Result;
end Read_Float;
function Read_Word
(Parser : in Parsers.Parser;
Delimiter_Chars : in String := Whitespace)
return String
is
Start : Positive := Parser.Cursor;
begin
Scan_Any(Parser, Delimiter_Chars);
return Slice(Parser.Line, Start, Parser.Cursor - 1);
end Read_Word;
function Rest_Of_Line
(Parser : in Parsers.Parser)
return String
is
begin
return Slice(Parser.Line, Parser.Cursor, Length(Parser.Line));
end Rest_Of_Line;
function Position
(Parser : in Parsers.Parser)
return String
is
begin
if Parser.File_Name = "" then
return "Current_Input:" &
To_String(Parser.Line_Number) & ":" &
To_String(Parser.Cursor) & ": ";
else
return -Parser.File_Name & ":" &
To_String(Parser.Line_Number) & ":" &
To_String(Parser.Cursor) & ": ";
end if;
end Position;
procedure Warning
(Parser : in Parsers.Parser;
Message : in String) is
begin
Text_IO.Put_Line(Text_IO.Current_Error, Position(Parser) & Message);
end Warning;
procedure Error
(Parser : in Parsers.Parser;
Message : in String) is
begin
Warning(Parser, Message);
raise Parse_Error;
end Error;
end Parsers;
|