|
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: 13907 (0x3653)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Text_Io;
with Letter_Utilities;
package body Lex is
The_File : Text_Io.File_Type;
Lookahead : Boolean := False;
Current_Token : Token.Object;
Current_Value : Personnal_String.Object;
Current_Char : Character;
type State is (St_Normal, St_Less, St_Great, St_Word, St_Heure,
St_Heure_Number, St_Min, St_Min_Number,
St_Sec, St_Number, St_Commentaire, St_Found);
procedure Lex_Open (Nom_Fichier : String) is
Mode : Text_Io.File_Mode := Text_Io.In_File;
begin
Text_Io.Open
(File => The_File, Mode => Mode, Name => Nom_Fichier, Form => "");
end Lex_Open;
function Lex_Time_Value (Stime : String) return String is
Ptr : Integer := 1;
Valeur : Integer := 0;
begin
for I in 1 .. Stime'Length loop
if Stime (I) in '0' .. '9' then
null;
else
case Stime (I) is
when 'h' =>
Valeur :=
Valeur +
Integer'Value (Stime (Ptr .. I - 1)) * 36000;
Ptr := I + 1;
when 'm' =>
Valeur := Valeur + Integer'Value
(Stime (Ptr .. I - 1)) * 600;
Ptr := I + 1;
when '.' =>
Valeur := Valeur + Integer'Value
(Stime (Ptr .. I - 1)) * 10;
Ptr := I + 1;
if Stime (Ptr) in '0' .. '9' then
Valeur := Valeur + Integer'Value
(Stime (Ptr .. Ptr));
Ptr := Ptr + 1;
end if;
when ' ' =>
Valeur := Valeur + Integer'Value (Stime (Ptr .. I - 1));
Ptr := Ptr + 1;
when others =>
null;
end case;
end if;
end loop;
return Integer'Image (Valeur);
end Lex_Time_Value;
procedure Lex_Close is
begin
Text_Io.Close (The_File);
end Lex_Close;
function Lex_Get_Char return Character is
begin
if Lookahead then
Lookahead := False;
else
if Text_Io.End_Of_Line (The_File) then
Text_Io.Skip_Line (The_File);
Current_Char := Ascii.Cr;
else
Text_Io.Get (The_File, Current_Char);
end if;
end if;
return Current_Char;
end Lex_Get_Char;
procedure Lex_Unget is
begin
Lookahead := True;
end Lex_Unget;
procedure Lex_Next is
The_Char : Character;
Current_State : State;
begin
if not Text_Io.End_Of_File (The_File) then
Personnal_String.Raz (Current_Value);
Current_State := St_Normal;
while Current_State /= St_Found loop
if not Text_Io.End_Of_File (The_File) then
The_Char := Letter_Utilities.Convert_Upper_To_Lower
(Lex_Get_Char);
else
The_Char := Ascii.Eot;
end if;
case Current_State is
when St_Normal =>
case The_Char is
when ' ' | Ascii.Cr =>
null;
when Ascii.Eot =>
Current_State := St_Found;
Current_Token := Token.L_Eof;
when '<' =>
Current_State := St_Less;
when '>' =>
Current_State := St_Great;
when '=' =>
Current_State := St_Found;
Current_Token := Token.L_Egal;
when ':' =>
Current_State := St_Found;
Current_Token := Token.L_Deuxpoints;
when ',' =>
Current_State := St_Found;
Current_Token := Token.L_Virgule;
when '.' =>
Current_State := St_Found;
Current_Token := Token.L_Point;
when '(' =>
Current_State := St_Found;
Current_Token := Token.L_Parentheseg;
when ')' =>
Current_State := St_Found;
Current_Token := Token.L_Parenthesed;
when '+' =>
Current_State := St_Found;
Current_Token := Token.L_Plus;
when '-' =>
Current_State := St_Found;
Current_Token := Token.L_Moins;
when '/' =>
Current_State := St_Found;
Current_Token := Token.L_Slash;
when '*' =>
Current_State := St_Found;
Current_Token := Token.L_Star;
when '[' =>
Current_State := St_Found;
Current_Token := Token.L_Crochetg;
when ']' =>
Current_State := St_Found;
Current_Token := Token.L_Crochetd;
when '{' =>
Current_State := St_Commentaire;
when others =>
if The_Char in 'a' .. 'z' then
Personnal_String.Put
(Current_Value, The_Char);
Current_State := St_Word;
else
if The_Char in '0' .. '9' then
Personnal_String.Put
(Current_Value, The_Char);
Current_State := St_Number;
else
Current_State := St_Found;
Current_Token := Token.L_Unk;
end if;
end if;
end case;
when St_Commentaire =>
if The_Char = '}' then
Current_State := St_Normal;
end if;
when St_Less =>
case The_Char is
when '=' =>
Current_State := St_Found;
Current_Token := Token.L_Inf_Ou_Egal;
when '>' =>
Current_State := St_Found;
Current_Token := Token.L_Different;
when others =>
Current_State := St_Found;
Current_Token := Token.L_Inf;
Lex_Unget;
end case;
when St_Great =>
if The_Char = '=' then
Current_State := St_Found;
Current_Token := Token.L_Sup_Ou_Egal;
else
Current_State := St_Found;
Current_Token := Token.L_Sup;
Lex_Unget;
end if;
when St_Word =>
if The_Char in 'a' .. 'z' or
The_Char in '0' .. '9' or The_Char = '_' then
Personnal_String.Put (Current_Value, The_Char);
else
Current_State := St_Found;
Current_Token := Token.Search_Token
(Personnal_String.Value
(Current_Value));
Lex_Unget;
end if;
when St_Number =>
if The_Char in '0' .. '9' then
Personnal_String.Put (Current_Value, The_Char);
else
case The_Char is
when 'h' =>
Current_State := St_Heure_Number;
Personnal_String.Put
(Current_Value, The_Char);
when 'm' =>
Current_State := St_Min_Number;
Personnal_String.Put
(Current_Value, The_Char);
when '.' =>
Current_State := St_Sec;
Personnal_String.Put
(Current_Value, The_Char);
when others =>
Current_State := St_Found;
Current_Token := Token.L_Int;
Lex_Unget;
end case;
end if;
when St_Heure_Number =>
if The_Char in '0' .. '9' then
Personnal_String.Put (Current_Value, The_Char);
Current_State := St_Heure;
else
Current_State := St_Found;
Current_Token := Token.L_Time;
Lex_Unget;
end if;
when St_Heure =>
if The_Char in '0' .. '9' then
Personnal_String.Put (Current_Value, The_Char);
else
case The_Char is
when 'm' =>
Current_State := St_Min_Number;
Personnal_String.Put
(Current_Value, The_Char);
when '.' =>
Current_State := St_Sec;
Personnal_String.Put
(Current_Value, The_Char);
when others =>
Current_State := St_Found;
Current_Token := Token.L_Unk;
Lex_Unget;
end case;
end if;
when St_Min_Number =>
if The_Char in '0' .. '9' then
Personnal_String.Put (Current_Value, The_Char);
Current_State := St_Min;
else
Current_State := St_Found;
Current_Token := Token.L_Time;
Lex_Unget;
end if;
when St_Min =>
if The_Char in '0' .. '9' then
Personnal_String.Put (Current_Value, The_Char);
else
if The_Char = '.' then
Personnal_String.Put (Current_Value, The_Char);
Current_State := St_Sec;
else
Current_State := St_Found;
Current_Token := Token.L_Unk;
Lex_Unget;
end if;
end if;
when St_Sec =>
if The_Char in '0' .. '9' then
Personnal_String.Put (Current_Value, The_Char);
Current_State := St_Found;
Current_Token := Token.L_Time;
else
Current_State := St_Found;
Current_Token := Token.L_Unk;
end if;
when others =>
null;
end case;
end loop;
else
Current_Token := Token.L_Eof;
end if;
end Lex_Next;
function Lex_Get_Token return Token.Object is
begin
return Current_Token;
end Lex_Get_Token;
function Lex_Get_Value return Personnal_String.Pstring is
Ptr : Personnal_String.Pstring;
begin
case Current_Token is
when Token.L_Time =>
Ptr := new String'(Lex_Time_Value
(Personnal_String.Value (Current_Value)));
when others =>
Ptr := new String'(Personnal_String.Value (Current_Value));
end case;
return Ptr;
end Lex_Get_Value;
function Lex_At_End return Boolean is
begin
return Text_Io.End_Of_File (The_File);
end Lex_At_End;
end Lex;