|
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 - downloadIndex: ┃ B T ┃
Length: 13967 (0x368f)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Bounded_String;
with File;
with Msg_Report;
with String_Utilities;
with Text_Io;
package body Scanner is
function Is_Equal_String
(Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
return Boolean renames String_Utilities.Equal;
type State is (S_Found, S_Start, S_Integer, S_Identifier,
S_String, S_Minus, S_Less, S_Great, S_Comment);
Current_String : B_String;
Current_Token : Token;
Current_Line : Integer := 1;
-- ouverture du fichier
-- ====================
procedure Open (File_Name : String) is
begin
File.Open (File_Name);
exception
-- signaler l'erreur sur ouverture d'un fichier inexistant
when Text_Io.Name_Error =>
Msg_Report.Lexical_Error
("The file """ & File_Name & """ doesn't exist !!!", False);
raise Inexistant_File;
end Open;
-- fermeture du fichier
-- ====================
procedure Close is
begin
File.Close;
end Close;
-- renvoi VRAI si fin de l'analyse lexicale (avec fermeture du fichier)
-- ====================================================================
function Is_At_End return Boolean is
begin
if File.Is_At_End_File then
Close;
return True;
else
return False;
end if;
end Is_At_End;
-- retourne le type "token identificateur" de la chaine courante
-- =============================================================
function Eval_Identifier (Ident : String) return Token is
begin
if Is_Equal_String (Ident, "avec") then
return L_Avec;
elsif Is_Equal_String (Ident, "pour") then
return L_Pour;
elsif Is_Equal_String (Ident, "prendre") then
return L_Prendre;
elsif Is_Equal_String (Ident, "renvoyer") then
return L_Renvoyer;
else
return L_Identifier;
end if;
end Eval_Identifier;
-- analyse lexicale du symbole suivant
-- ===================================
procedure Next is
Current_Char : Character;
Current_State : State;
begin
if Is_At_End then
Current_Token := L_Eof;
else
-- initialiser la chaine a vide
Bounded_String.Free (Current_String);
-- initialiser l'etat de depart
Current_State := S_Start;
while (Current_State /= S_Found) loop
if File.Is_At_End_File then
case Current_State is
when S_Integer =>
Current_Token := L_Integer;
when S_Identifier =>
-- recherche sur l'identificateur (reserve ou non)
Current_Token := Eval_Identifier
(Bounded_String.Image
(Current_String));
when others =>
-- fermeture du fichier
Close;
Current_Token := L_Eof;
end case;
Current_State := S_Found;
else
if File.Is_At_End_Line then
-- caractere = CR, avancer d'une position dans le fichier
Current_Char := File.Get_Cr;
Current_Line := Current_Line + 1;
else
-- avancer dans le fichier et lire le caractere courant
Current_Char := File.Get;
end if;
case Current_State is
when S_Start =>
case Current_Char is
when ' ' | Ascii.Ht | Ascii.Cr =>
null;
when '0' .. '9' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Integer;
when 'A' .. 'Z' | 'a' .. 'z' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Identifier;
when '"' =>
Current_State := S_String;
when '{' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Open_Bracket;
Current_State := S_Found;
when '}' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Close_Bracket;
Current_State := S_Found;
when '.' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Dot;
Current_State := S_Found;
when '(' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Open_Parenthesis;
Current_State := S_Found;
when ')' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Close_Parenthesis;
Current_State := S_Found;
when '-' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Minus;
when '+' | '*' | '/' | '=' | '&' | '|' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Binary_Msg;
Current_State := S_Found;
when '<' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Less;
when '>' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_State := S_Great;
when others =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Unknown;
Current_State := S_Found;
Msg_Report.Lexical_Error
(", undefined character -> ");
end case;
when S_Integer =>
case Current_Char is
when 'A' .. 'Z' | 'a' .. 'z' | '_' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Unknown;
Current_State := S_Found;
Msg_Report.Lexical_Error
(", alphabetic character not allowed in integer -> ");
when '0' .. '9' =>
Bounded_String.Append
(Current_String, Current_Char);
when others =>
File.Unget;
Current_Token := L_Integer;
Current_State := S_Found;
end case;
when S_Identifier =>
case Current_Char is
when 'A' .. 'Z' | 'a' .. 'z' | '_' =>
Bounded_String.Append
(Current_String, Current_Char);
when ':' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Key_Word;
Current_State := S_Found;
when '0' .. '9' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Unknown;
Current_State := S_Found;
Msg_Report.Lexical_Error
(", numeric character not allowed in identifier -> ");
when others =>
File.Unget;
-- recherche sur l'identificateur (reserve ou non)
Current_Token := Eval_Identifier
(Bounded_String.Image
(Current_String));
Current_State := S_Found;
end case;
when S_String =>
if Current_Char = '"' then
Current_Token := L_String;
Current_State := S_Found;
else
Bounded_String.Append
(Current_String, Current_Char);
end if;
when S_Minus =>
if Current_Char = '-' then
Current_State := S_Comment;
else
File.Unget;
Current_Token := L_Binary_Msg;
Current_State := S_Found;
end if;
when S_Less =>
case Current_Char is
when ' ' | Ascii.Ht | Ascii.Cr =>
null;
when '=' | '>' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Binary_Msg;
Current_State := S_Found;
when others =>
File.Unget;
Current_Token := L_Binary_Msg;
Current_State := S_Found;
end case;
when S_Great =>
case Current_Char is
when ' ' | Ascii.Ht | Ascii.Cr =>
null;
when '=' =>
Bounded_String.Append
(Current_String, Current_Char);
Current_Token := L_Binary_Msg;
Current_State := S_Found;
when others =>
File.Unget;
Current_Token := L_Binary_Msg;
Current_State := S_Found;
end case;
when S_Comment =>
if (Current_Char = Ascii.Cr) then
-- fin de commentaire, retour a l'etat initial
Current_State := S_Start;
-- initialiser la chaine a vide
Bounded_String.Free (Current_String);
end if;
when S_Found =>
null;
end case;
end if;
end loop;
-- fermeture du fichier en cas d'erreur lexicale
if Current_Token = L_Unknown and then not Is_At_End then
Close;
end if;
end if;
Msg_Report.Information ("token: " & Token'Image (Current_Token));
end Next;
-- retourne la chaine courante
-- ===========================
function Value return String is
begin
return Bounded_String.Image (Current_String);
end Value;
-- retourne le token courant
-- =========================
function Symbol return Token is
begin
return Current_Token;
end Symbol;
-- retourne la ligne courante du fichier
-- =====================================
function Line_Number return Integer is
begin
return Current_Line;
end Line_Number;
end Scanner;