|
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: 12379 (0x305b)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
with Text_Io;
with Les_Types;
use Les_Types;
with Char;
use Char;
package body Lex is
type State is (St_Normal, St_Slash, St_Com_St, St_Com_End,
St_Less, St_Great, St_Let, St_Word,
St_Litt, St_Quote, St_Number, St_Found);
type Keyword is
record
Name : Pointeur_Chaine;
Letoken : Token;
end record;
type Tableau_Kewords is array (Positive range <>) of Keyword;
Keywords : constant Tableau_Kewords :=
((new String'("ARCCOS"), L_Arccos), (new String'("ARCCOT"), L_Arccot),
(new String'("ARCCOTH"), L_Arccoth), (new String'("ARCSIN"), L_Arcsin),
(new String'("ARCTAN"), L_Arctan), (new String'("ARCTANH"), L_Arctanh),
(new String'("COS"), L_Cos), (new String'("COTH"), L_Coth),
(new String'("SIN"), L_Sin), (new String'("SINH"), L_Sinh),
(new String'("TAN"), L_Tan), (new String'("TANH"), L_Tanh),
(new String'("a"), L_A), (new String'("acteur"), L_Acteur),
(new String'("activer"), L_Activer), (new String'("alors"), L_Alors),
(new String'("attendre"), L_Attendre), (new String'("aucun"), L_Aucun),
(new String'("bien"), L_Bien), (new String'("binaire"), L_Binaire),
(new String'("changer"), L_Changer),
(new String'("collection"), L_Collection),
(new String'("dans"), L_Dans), (new String'("debut"), L_Debut),
(new String'("discret"), L_Discret), (new String'("effet"), L_Effet),
(new String'("est"), L_Est), (new String'("et"), L_Et),
(new String'("evoluer"), L_Evoluer),
(new String'("executer"), L_Executer),
(new String'("experience"), L_Experience),
(new String'("faire"), L_Faire), (new String'("faux"), L_Faux),
(new String'("fin"), L_Fin), (new String'("fois"), L_Fois),
(new String'("fonction"), L_Funct),
(new String'("flottant"), L_Flottant),
(new String'("fugitif"), L_Fugitif),
(new String'("materiel"), L_Materiel), (new String'("non"), L_Non),
(new String'("ou"), L_Ou), (new String'("oui"), L_Oui),
(new String'("puis"), L_Puis), (new String'("que"), L_Que),
(new String'("registre"), L_Registre),
(new String'("repeter"), L_Repeter),
(new String'("representation"), L_Representation),
(new String'("retourne"), L_Retourne), (new String'("selon"), L_Selon),
(new String'("si"), L_Si), (new String'("sinon"), L_Sinon),
(new String'("spectacle"), L_Spectacle),
(new String'("station"), L_Station), (new String'("tant"), L_Tant),
(new String'("temporel"), L_Temporel),
(new String'("theatre"), L_Theatre), (new String'("vrai"), L_Vrai)
);
The_File : Text_Io.File_Type;
Current_Value : String (1 .. 256);
Long_Current_Value : Integer := 0;
Current_Token : Token;
Eof : constant Character := '$';
Nombre_Flottant : Float;
function Keyword_To_Token (Word : Pointeur_Chaine) return Token is
Low, High, Mid : Integer;
B : Boolean;
begin
Low := 1;
High := Keywords'Last (1);
while (Low <= High) loop
Mid := (Low + High) / 2;
if (Word.all < Keywords (Mid).Name.all) then
High := Mid - 1;
else
if (Word.all = Keywords (Mid).Name.all) then
return Keywords (Mid).Letoken;
else
Low := Mid + 1;
end if;
end if;
end loop;
return L_Reg;
end Keyword_To_Token;
function Lex_Get_Value1 return Pointeur_Chaine is
Chaine : Pointeur_Chaine;
begin
if Long_Current_Value /= 0 then
Chaine := new String'(Current_Value (1 .. Long_Current_Value));
return Chaine;
else
return null;
end if;
end Lex_Get_Value1;
function Lex_Get_Token1 return Token is
begin
return Current_Token;
end Lex_Get_Token1;
function Lex_At_End1 (Afile : Text_Io.File_Type) return Boolean is
begin
return Char_At_End (Afile);
end Lex_At_End1;
function Isalpha (C : Character) return Boolean is
begin
case C is
when 'A' .. 'Z' =>
return True;
when 'a' .. 'z' =>
return True;
when others =>
return False;
end case;
end Isalpha;
function Isdigit (C : Character) return Boolean is
begin
if C in '0' .. '9' or C = '.' then
return True;
else
return False;
end if;
end Isdigit;
procedure Lex_Next_Token1 (Afile : Text_Io.File_Type) is
Crt : String (1 .. 256);
C : Character;
The_State : State;
Long_Chaine : Integer := 0;
begin
if not (Char_At_End (Afile)) then
Crt := Current_Value;
The_State := St_Normal;
while (The_State /= St_Found) loop
if not (Char_At_End (Afile)) then
Char_Next (Afile);
C := Char_Value (Afile);
else
C := Eof;
end if;
case (The_State) is
when St_Normal =>
case C is
when Eof =>
Current_Token := L_Eof;
The_State := St_Found;
when ' ' =>
null;
when Ascii.Nul .. Ascii.Us =>
null;
when '/' =>
The_State := St_Slash;
when '<' =>
The_State := St_Less;
when '>' =>
The_State := St_Great;
when '=' =>
Current_Token := L_Eq;
The_State := St_Found;
when '-' =>
Current_Token := L_Moins;
The_State := St_Found;
when '+' =>
Current_Token := L_Plus;
The_State := St_Found;
when '*' =>
Current_Token := L_Star;
The_State := St_Found;
when ';' =>
Current_Token := L_Separ;
The_State := St_Found;
when ',' =>
Current_Token := L_Virg;
The_State := St_Found;
when '?' =>
Current_Token := L_Prt;
The_State := St_Found;
when '(' =>
Current_Token := L_Open;
The_State := St_Found;
when ')' =>
Current_Token := L_Close;
The_State := St_Found;
when '%' =>
Current_Token := L_Mod;
The_State := St_Found;
when ':' =>
The_State := St_Let;
when '\' =>
The_State := St_Litt;
when others =>
if (Isalpha (C)) then
Long_Chaine := Long_Chaine + 1;
Crt (Long_Chaine) := C;
The_State := St_Word;
else
if Isdigit (C) then
Long_Chaine := Long_Chaine + 1;
Crt (Long_Chaine) := C;
The_State := St_Number;
else
Current_Token := L_Unk;
The_State := St_Found;
end if;
end if;
end case;
when St_Slash =>
if (C = '*') then
The_State := St_Com_St;
else
Char_Unget (Afile);
Current_Token := L_Div;
The_State := St_Found;
end if;
when St_Com_End =>
if (C = '*') then
The_State := St_Com_End;
end if;
when St_Less =>
case C is
when '=' =>
Current_Token := L_Leq;
The_State := St_Found;
when '>' =>
Current_Token := L_Neq;
The_State := St_Found;
when others =>
Char_Unget (Afile);
Current_Token := L_Lt;
The_State := St_Found;
end case;
when St_Great =>
if (C = '=') then
Current_Token := L_Geq;
else
Char_Unget (Afile);
Current_Token := L_Gt;
end if;
The_State := St_Found;
when St_Let =>
if (C = '=') then
Current_Token := L_Affect;
else
Current_Token := L_Dp;
end if;
The_State := St_Found;
when St_Word =>
if (Isalpha (C)) or Isdigit (C) then
Long_Chaine := Long_Chaine + 1;
Crt (Long_Chaine) := C;
else
Char_Unget (Afile);
Current_Token := Keyword_To_Token (Lex_Get_Value1);
The_State := St_Found;
end if;
when St_Litt =>
if (C = '\') then
The_State := St_Quote;
else
Long_Chaine := Long_Chaine + 1;
Crt (Long_Chaine) := C;
end if;
when St_Quote =>
if (C = '\') then
Long_Chaine := Long_Chaine + 1;
Crt (Long_Chaine) := C;
The_State := St_Litt;
else
Current_Token := L_Str;
The_State := St_Found;
end if;
when St_Number =>
if (Isdigit (C)) then
Long_Chaine := Long_Chaine + 1;
Crt (Long_Chaine) := C;
else
Char_Unget (Afile);
Current_Token := L_Digit;
The_State := St_Found;
end if;
when others =>
null;
end case;
Long_Current_Value := Long_Chaine;
Current_Value (1 .. Long_Chaine) := Crt (1 .. Long_Chaine);
end loop;
else
Current_Token := L_Eof;
end if;
--Text_Io.Put_Line ("####### : #" & Current_Value (1 .. Long_Chaine));
end Lex_Next_Token1;
procedure Lex_Open1 (Afile : Text_Io.File_Type) is
begin
Char_Open (Afile);
end Lex_Open1;
end Lex;