|
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: 21173 (0x52b5)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
with Text_Io;
with Bounded_Strings;
with Look_Ahead;
with Error;
package body Lexical is
Current_Token : Token := L_Eof;
Current_Value : Lexeme;
The_File : Text_Io.File_Type;
Line_Nbr : Positive := 1;
Column_Nbr : Natural := 0;
Nbr_Length : Natural := 0;
package Keywords is
function Is_Keyword (The_Lexeme : Lexeme) return Boolean;
function Lexeme_To_Token (From : Lexeme) return Token;
end Keywords;
package body Keywords is
type P_Keyword is access String;
subtype Keyword_Token is Token range L_Activer .. L_Temporel;
type Keywords is array (Keyword_Token) of P_Keyword;
All_Keywords : constant Keywords :=
(new String'("ACTIVER"), new String'("ALORS"),
new String'("ATTENDRE"), new String'("AUTEMPS"),
new String'("AVEC"), new String'("BINAIRE"),
new String'("CATEGORIE"), new String'("DEBUT"),
new String'("DESACTIVER"), new String'("DISCRET"),
new String'("EFFET"), new String'("EN"), new String'("EST"),
new String'("EVOLUER"), new String'("EXPERIENCE"),
new String'("FAIRE"), new String'("FIN"), new String'("FOIS"),
new String'("FUGITIF"), new String'("IMPLANTATION"),
new String'("JUSQUA"), new String'("MATERIEL"), new String'("MOD"),
new String'("MODIFIER"), new String'("REPETER"),
new String'("SCENE"), new String'("SI"), new String'("SINON"),
new String'("SPECTACLE"), new String'("TEMPOREL"));
function Is_Keyword (The_Lexeme : Lexeme) return Boolean is
Word : constant String := Bounded_Strings.Image (The_Lexeme);
begin
for I in Keyword_Token loop
if All_Keywords (I).all = Word then
return True;
end if;
end loop;
return False;
end Is_Keyword;
function Lexeme_To_Token (From : Lexeme) return Token is
Word : constant String := Bounded_Strings.Image (From);
begin
for I in Keyword_Token loop
if All_Keywords (I).all = Word then
return I;
end if;
end loop;
return L_Id;
end Lexeme_To_Token;
end Keywords;
package Simulated_Automaton is
procedure Next;
end Simulated_Automaton;
package body Simulated_Automaton is
type State is (St_Start, St_Let, St_Minus, St_Comm, St_Great,
St_Less, St_Hexa, St_Nbr, St_Minute,
St_Hour, St_Word, St_Second, St_Found);
subtype Low_Alpha is Character range 'a' .. 'z';
subtype Upp_Alpha is Character range 'A' .. 'Z';
subtype Low_Alpha_Hexa is Character range 'a' .. 'f';
subtype Upp_Alpha_Hexa is Character range 'A' .. 'F';
subtype Digit is Character range '0' .. '9';
The_Look_Ahead : Look_Ahead.Object;
Eol_Flag : Boolean := False;
procedure File_Next_Char (C : in out Character) is
begin
if Eol_Flag then
Line_Nbr := Line_Nbr + 1;
Eol_Flag := False;
if not Look_Ahead.Is_Existing (The_Look_Ahead) then
Column_Nbr := 1;
else
Column_Nbr := 0;
end if;
else
Column_Nbr := Column_Nbr + 1;
end if;
if Look_Ahead.Is_Existing (The_Look_Ahead) then
Look_Ahead.Value (The_Look_Ahead, C);
else
if At_End then
C := Ascii.Eot;
else
if Text_Io.End_Of_Line (The_File) then
Text_Io.Skip_Line (The_File);
C := Ascii.Lf;
Eol_Flag := True;
else
Text_Io.Get (The_File, C);
case C is
when Low_Alpha =>
C := Character'Val (Character'Pos (C) - 32);
when others =>
null;
end case;
end if;
end if;
end if;
exception
when others =>
Error.Handle ("lors de la lecture du fichier source !",
Error.Internal);
end File_Next_Char;
procedure Calculate_Nbr
(Hours, Minutes, Seconds, Tenths : in Natural) is
begin
Bounded_Strings.Set
(Current_Value, Integer'Image
(Hours * 3600 * 10 + Minutes * 60 * 10 +
Seconds * 10 + Tenths));
exception
when Numeric_Error =>
Bounded_Strings.Set (Current_Value, Integer'Image (0));
end Calculate_Nbr;
procedure Next is
Current_State : State;
Current_Char : Character;
Number : Integer;
Hours, Minutes, Seconds, Tenths : Natural;
begin
if not At_End then
Bounded_Strings.Free (Current_Value);
Hours := 0;
Minutes := 0;
Seconds := 0;
Tenths := 0;
Nbr_Length := 0;
Current_State := St_Start;
loop
File_Next_Char (Current_Char);
case Current_State is
when St_Start =>
case Current_Char is
when Ascii.Eot =>
Current_Token := L_Eof;
Current_State := St_Found;
when ' ' | Ascii.Lf | Ascii.Ht =>
null;
when '(' =>
Current_Token := L_Open;
Current_State := St_Found;
when ')' =>
Current_Token := L_Close;
Current_State := St_Found;
when ',' =>
Current_Token := L_Comma;
Current_State := St_Found;
when '.' =>
Current_Token := L_Point;
Current_State := St_Found;
when ':' =>
Current_State := St_Let;
when '+' =>
Current_Token := L_Plus;
Current_State := St_Found;
when '-' =>
Current_State := St_Minus;
when '*' =>
Current_Token := L_Star;
Current_State := St_Found;
when '/' =>
Current_Token := L_Slash;
Current_State := St_Found;
when '=' =>
Current_Token := L_Equ;
Current_State := St_Found;
when '>' =>
Current_State := St_Great;
when '<' =>
Current_State := St_Less;
when '#' =>
Current_State := St_Hexa;
when Digit =>
Bounded_Strings.Append
(Current_Value, Current_Char);
Current_State := St_Nbr;
when Upp_Alpha | '_' =>
Bounded_Strings.Append
(Current_Value, Current_Char);
Current_State := St_Word;
when others =>
Current_Token := L_Unk;
Current_State := St_Found;
end case;
when St_Let =>
if Current_Char = '=' then
Current_Token := L_Affect;
Current_State := St_Found;
else
Current_Token := L_Unk;
Current_State := St_Found;
end if;
when St_Minus =>
if Current_Char = '-' then
Current_State := St_Comm;
else
Look_Ahead.Affect
(The_Look_Ahead, Current_Char);
Current_Token := L_Minus;
Current_State := St_Found;
end if;
when St_Comm =>
case Current_Char is
when Ascii.Lf =>
Current_State := St_Start;
when Ascii.Eot =>
Current_Token := L_Eof;
Current_State := St_Found;
when others =>
null;
end case;
when St_Great =>
if Current_Char = '=' then
Current_Token := L_Geq;
Current_State := St_Found;
else
Look_Ahead.Affect
(The_Look_Ahead, Current_Char);
Current_Token := L_Gt;
Current_State := St_Found;
end if;
when St_Less =>
case Current_Char is
when '=' =>
Current_Token := L_Leq;
Current_State := St_Found;
when '>' =>
Current_Token := L_Neq;
Current_State := St_Found;
when others =>
Look_Ahead.Affect
(The_Look_Ahead, Current_Char);
Current_Token := L_Lt;
Current_State := St_Found;
end case;
when St_Hexa =>
case Current_Char is
when Digit | Upp_Alpha_Hexa =>
Bounded_Strings.Append
(Current_Value, Current_Char);
when others =>
Look_Ahead.Affect
(The_Look_Ahead, Current_Char);
Number := Bounded_Strings.To_Number
(Current_Value, 16);
Bounded_Strings.Free (Current_Value);
Bounded_Strings.Set
(Current_Value, Integer'Image (Number));
Current_Token := L_Nbr;
Current_State := St_Found;
end case;
when St_Nbr =>
case Current_Char is
when Digit =>
Nbr_Length := Nbr_Length + 1;
Bounded_Strings.Append
(Current_Value, Current_Char);
when 'S' =>
Nbr_Length := Nbr_Length + 1;
Seconds := Lexical.Number;
Current_State := St_Second;
Bounded_Strings.Free (Current_Value);
when 'M' =>
Nbr_Length := Nbr_Length + 1;
Current_State := St_Minute;
Minutes := Lexical.Number;
Bounded_Strings.Free (Current_Value);
when 'H' =>
Nbr_Length := Nbr_Length + 1;
Current_State := St_Hour;
Hours := Lexical.Number;
Bounded_Strings.Free (Current_Value);
when others =>
if Bounded_Strings.Length (Current_Value) /=
0 then
Tenths := Lexical.Number;
end if;
Calculate_Nbr (Hours, Minutes,
Seconds, Tenths);
Look_Ahead.Affect
(The_Look_Ahead, Current_Char);
Current_Token := L_Nbr;
Current_State := St_Found;
end case;
when St_Second =>
if Current_Char in Digit then
Nbr_Length := Nbr_Length + 1;
Bounded_Strings.Append
(Current_Value, Current_Char);
else
if Bounded_Strings.Length (Current_Value) /=
0 then
Tenths := Lexical.Number;
end if;
Calculate_Nbr (Hours, Minutes, Seconds, Tenths);
Look_Ahead.Affect
(The_Look_Ahead, Current_Char);
Current_Token := L_Nbr;
Current_State := St_Found;
end if;
when St_Minute =>
case Current_Char is
when Digit =>
Nbr_Length := Nbr_Length + 1;
Bounded_Strings.Append
(Current_Value, Current_Char);
when 'S' =>
Nbr_Length := Nbr_Length + 1;
Seconds := Lexical.Number;
Current_State := St_Second;
Bounded_Strings.Free (Current_Value);
when others =>
if Bounded_Strings.Length (Current_Value) /=
0 then
Tenths := Lexical.Number;
end if;
Calculate_Nbr (Hours, Minutes,
Seconds, Tenths);
Look_Ahead.Affect
(The_Look_Ahead, Current_Char);
Current_Token := L_Nbr;
Current_State := St_Found;
end case;
when St_Hour =>
case Current_Char is
when Digit =>
Nbr_Length := Nbr_Length + 1;
Bounded_Strings.Append
(Current_Value, Current_Char);
when 'S' =>
Nbr_Length := Nbr_Length + 1;
Current_State := St_Second;
Seconds := Lexical.Number;
Bounded_Strings.Free (Current_Value);
when 'M' =>
Nbr_Length := Nbr_Length + 1;
Current_State := St_Minute;
Minutes := Lexical.Number;
Bounded_Strings.Free (Current_Value);
when others =>
if Bounded_Strings.Length (Current_Value) /=
0 then
Tenths := Lexical.Number;
end if;
Calculate_Nbr (Hours, Minutes,
Seconds, Tenths);
Look_Ahead.Affect
(The_Look_Ahead, Current_Char);
Current_Token := L_Nbr;
Current_State := St_Found;
end case;
when St_Word =>
case Current_Char is
when Upp_Alpha | '_' | Digit =>
Bounded_Strings.Append
(Current_Value, Current_Char);
when others =>
Look_Ahead.Affect
(The_Look_Ahead, Current_Char);
Current_Token :=
Keywords.Lexeme_To_Token (Lexical.Value);
Current_State := St_Found;
end case;
when St_Found =>
null;
end case;
if Look_Ahead.Is_Existing (The_Look_Ahead) then
Column_Nbr := Column_Nbr - 1;
end if;
exit when Current_State = St_Found;
end loop;
else
Current_Token := L_Eof;
end if;
end Next;
end Simulated_Automaton;
procedure Open (File_Name : in String) is
begin
Text_Io.Open (The_File, Text_Io.In_File, File_Name);
exception
when Text_Io.Name_Error => -- nom de fichier incorrect
Error.Handle (File_Name & " est un nom de fichier incorrect !",
Error.Internal);
when others =>
Error.Handle ("lors de l'ouverture du fichier " & File_Name,
Error.Internal);
end Open;
function At_End return Boolean is
begin
return Text_Io.End_Of_File (The_File);
exception
when others =>
Error.Handle ("lors de l'acces au fichier source !",
Error.Internal);
end At_End;
procedure Next is
begin
Simulated_Automaton.Next;
end Next;
function Get return Token is
begin
return Current_Token;
end Get;
function Value return Lexeme is
begin
return Current_Value;
end Value;
function Number return Integer is
begin
return Integer'Value (Bounded_Strings.Image (Current_Value));
end Number;
function Line_Number return Positive is
begin
return Line_Nbr;
end Line_Number;
function Column_Number return Positive is
begin
case Current_Token is
when L_Open .. L_Equ =>
return (Column_Nbr);
when L_Affect .. L_Leq =>
return (Column_Nbr - 1);
when L_Nbr =>
return (Column_Nbr - Nbr_Length);
when L_Id .. L_Unk =>
return (Column_Nbr -
Bounded_Strings.Length (Current_Value) + 1);
when L_Eof =>
return 1;
end case;
end Column_Number;
procedure Close is
begin
Text_Io.Close (The_File);
exception
when others =>
Error.Handle ("lors de la fermeture du fichier source !",
Error.Internal);
end Close;
end Lexical;