|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 11631 (0x2d6f)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
with Errors;
with String_Utilities;
with Text_Io;
with Tiny_File;
with Trace;
package body Scanner is
type State is (St_Normal, St_Minus, St_Comm, St_Str, St_Int,
St_Id, St_Id_More, St_Less, St_Great, St_Found);
Current_Lexeme : Lexeme;
Current_State : State;
Current_Token : Token;
Current_Line : Natural;
Error_Number : Natural;
Current_String_Length : Natural;
Current_Id_Length : Natural;
File_Input : Text_Io.File_Type;
procedure Start (File_Name : String) is
begin
Tiny_File.Open (File_Input, File_Name);
Current_Line := 1;
end Start;
function Get_Token return Token is
begin
return Current_Token;
end Get_Token;
function Get_Value return Lexeme is
begin
return Current_Lexeme;
end Get_Value;
function Get_Line_Number return Natural is
begin
return Current_Line;
end Get_Line_Number;
function Get_Error_Number return Natural is
begin
return Error_Number;
end Get_Error_Number;
procedure Check_For_Int_Error is
Current_Number : Integer;
Ok : Boolean;
begin
String_Utilities.String_To_Number
(Bounded_String.Image (Current_Lexeme), Current_Number, Ok);
if not Ok then
Current_Token := L_Unk;
Error_Number := 5;
end if;
end Check_For_Int_Error;
function Check_If_Reserved (Id : String) return Token is
begin
if Custom.Is_Reserved_Word (Id) then
case Custom.Reserved_Word'Value (Id) is
when Custom.Avec =>
return L_Avec;
when Custom.Pour =>
return L_Pour;
when Custom.Prendre =>
return L_Pren;
when Custom.Renvoyer =>
return L_Renv;
end case;
else
return L_Id;
end if;
end Check_If_Reserved;
procedure Normal_State (Current_Char : in out Character) is
begin
case Current_Char is
when Ascii.Eot =>
Current_Token := L_Eof;
Current_State := St_Found;
when ' ' | Ascii.Cr =>
null;
when '-' =>
Current_State := St_Minus;
Bounded_String.Append (Current_Lexeme, Current_Char);
when '"' =>
Current_State := St_Str;
Current_String_Length := 0;
when '0' .. '9' =>
Current_State := St_Int;
Bounded_String.Append (Current_Lexeme, Current_Char);
when 'a' .. 'z' | 'A' .. 'Z' =>
Current_State := St_Id;
String_Utilities.Upper_Case (Current_Char);
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_Id_Length := 1;
when '{' =>
Current_State := St_Found;
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_Token := L_Obra;
when '}' =>
Current_State := St_Found;
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_Token := L_Cbra;
when '.' =>
Current_State := St_Found;
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_Token := L_Dot;
when '(' =>
Current_State := St_Found;
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_Token := L_Opar;
when ')' =>
Current_State := St_Found;
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_Token := L_Cpar;
when '+' | '*' | '/' | '^' | '=' | '&' | '|' | '%' =>
Current_State := St_Found;
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_Token := L_Binm;
when '<' =>
Current_State := St_Less;
Bounded_String.Append (Current_Lexeme, Current_Char);
when '>' =>
Current_State := St_Great;
Bounded_String.Append (Current_Lexeme, Current_Char);
when others =>
Current_State := St_Found;
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_Token := L_Unk;
Error_Number := 1;
end case;
end Normal_State;
procedure Minus_State (Current_Char : Character) is
begin
case Current_Char is
when '-' =>
Current_State := St_Comm;
when others =>
Tiny_File.Unget (File_Input);
Current_State := St_Found;
Current_Token := L_Binm;
end case;
end Minus_State;
procedure Comm_State (Current_Char : Character) is
begin
case Current_Char is
when Ascii.Cr =>
Current_State := St_Normal;
Bounded_String.Free (Current_Lexeme);
when others =>
null;
end case;
end Comm_State;
procedure Str_State (Current_Char : Character) is
begin
case Current_Char is
when '"' =>
Current_State := St_Found;
Current_Token := L_Str;
when Ascii.Cr =>
null;
when others =>
Current_String_Length := Current_String_Length + 1;
if Current_String_Length > Custom.String_Max_Length then
Current_State := St_Found;
Current_Token := L_Unk;
Error_Number := 3;
else
Bounded_String.Append (Current_Lexeme, Current_Char);
end if;
end case;
end Str_State;
procedure Int_State (Current_Char : Character) is
begin
case Current_Char is
when '0' .. '9' =>
Bounded_String.Append (Current_Lexeme, Current_Char);
when others =>
Tiny_File.Unget (File_Input);
Current_State := St_Found;
Current_Token := L_Int;
Check_For_Int_Error;
end case;
end Int_State;
procedure Id_State (Current_Char : in out Character) is
begin
case Current_Char is
when '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
Current_Id_Length := Current_Id_Length + 1;
if Current_Id_Length > Custom.Id_Max_Length then
Current_State := St_Found;
Current_Token := L_Unk;
Error_Number := 4;
else
String_Utilities.Upper_Case (Current_Char);
Bounded_String.Append (Current_Lexeme, Current_Char);
end if;
when '_' =>
Current_Id_Length := Current_Id_Length + 1;
if Current_Id_Length > Custom.Id_Max_Length then
Current_State := St_Found;
Current_Token := L_Unk;
Error_Number := 4;
else
Current_State := St_Id_More;
Bounded_String.Append (Current_Lexeme, Current_Char);
end if;
when ':' =>
Current_Id_Length := Current_Id_Length + 1;
if Current_Id_Length > Custom.Id_Max_Length then
Current_State := St_Found;
Current_Token := L_Unk;
Error_Number := 4;
else
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_State := St_Found;
Current_Token := L_Keyw;
end if;
when others =>
Tiny_File.Unget (File_Input);
Current_State := St_Found;
Current_Token := Check_If_Reserved
(Bounded_String.Image (Current_Lexeme));
end case;
end Id_State;
procedure Id_More_State (Current_Char : in out Character) is
begin
case Current_Char is
when '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
Current_Id_Length := Current_Id_Length + 1;
if Current_Id_Length > Custom.Id_Max_Length then
Current_State := St_Found;
Current_Token := L_Unk;
Error_Number := 4;
else
Current_State := St_Id;
String_Utilities.Upper_Case (Current_Char);
Bounded_String.Append (Current_Lexeme, Current_Char);
end if;
when others =>
Current_State := St_Found;
Bounded_String.Append (Current_Lexeme, Current_Char);
Current_Token := L_Unk;
Error_Number := 2;
end case;
end Id_More_State;
procedure Less_State (Current_Char : Character) is
begin
case Current_Char is
when '>' | '=' =>
Current_State := St_Found;
Current_Token := L_Binm;
Bounded_String.Append (Current_Lexeme, Current_Char);
when others =>
Tiny_File.Unget (File_Input);
Current_State := St_Found;
Current_Token := L_Binm;
end case;
end Less_State;
procedure Great_State (Current_Char : Character) is
begin
case Current_Char is
when '=' =>
Current_State := St_Found;
Current_Token := L_Binm;
Bounded_String.Append (Current_Lexeme, Current_Char);
when others =>
Tiny_File.Unget (File_Input);
Current_State := St_Found;
Current_Token := L_Binm;
end case;
end Great_State;
procedure Next_Token is
Current_Char : Character;
begin
Bounded_String.Free (Current_Lexeme);
Current_State := St_Normal;
Error_Number := 0;
loop
Current_Char := Tiny_File.Get (File_Input);
if Current_Char = Ascii.Cr then
Current_Line := Current_Line + 1;
end if;
case Current_State is
when St_Normal =>
Normal_State (Current_Char);
when St_Minus =>
Minus_State (Current_Char);
when St_Comm =>
Comm_State (Current_Char);
when St_Str =>
Str_State (Current_Char);
when St_Int =>
Int_State (Current_Char);
when St_Id =>
Id_State (Current_Char);
when St_Id_More =>
Id_More_State (Current_Char);
when St_Less =>
Less_State (Current_Char);
when St_Great =>
Great_State (Current_Char);
when St_Found =>
exit;
end case;
exit when Current_State = St_Found;
end loop;
case Current_Token is
when L_Unk =>
raise Errors.Unknown_Lexeme_Found;
when others =>
null;
end case;
Trace.Display (Current_Token);
Trace.Display (Current_Lexeme);
end Next_Token;
procedure Stop is
begin
Tiny_File.Close (File_Input);
end Stop;
end Scanner;