|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 13132 (0x334c)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦631120a6a⟧
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦901a29334⟧
└─⟦this⟧
with Text_Io, Bounded_String;
package Lex_Player is
type Token is (Id, Command, Unk, Toolong, Lexend);
procedure Get_Player (Invite : in String := "");
procedure Init;
function At_End return Boolean;
procedure Next;
function Get_Token return Token;
function Get_Value return String;
Max_Player_String : constant Positive := 80;
end Lex_Player;
with Text_Io, Bounded_String;
package body Lex_Player is
type State is (St_Normal, St_Id, St_2point, St_Command, St_Found);
subtype Minuscule is Character range 'a' .. 'z';
subtype Majuscule is Character range 'A' .. 'Z';
subtype Digit is Character range '0' .. '9';
The_Case_Offset : constant := Character'Pos ( 'a' ) - Character'Pos ( 'A' ) ;
The_String : String (1 .. Max_Player_String);
The_Length : Natural;
The_Index : Natural;
Current_Value : Bounded_String.Variable_String (Max_Player_String);
Current_Token : Token;
Lookahead : Boolean;
procedure Make_Uppercase ( The_Character : in out Character ) is
begin -- Make_Uppercase
The_Character := Character'Val ( Character'Pos ( The_Character ) - The_Case_Offset ) ;
end Make_Uppercase ;
procedure Get_Player (Invite : in String := "") is
Longueur : Natural;
begin
Text_Io.Put_Line (Invite);
Text_Io.Get_Line (The_String, The_Length);
end Get_Player;
procedure Init is
begin
The_Index := The_String'First - 1;
Lookahead := False;
end Init;
function At_End return Boolean is
begin
return (The_Index >= The_Length);
end At_End;
function Get_Value return String is
begin
return (Bounded_String.Image (Current_Value));
end Get_Value;
function Get_Token return Token is
begin
return (Current_Token);
end Get_Token;
procedure Get_State_After_2point
(Astate : in out State; Achar : in Character) is
UpChar:Character;
begin
if (Achar in Minuscule or Achar in Majuscule) then
UpChar:=Achar;
if UpChar in Minuscule then Make_UpperCase(UpChar); end if;
Bounded_String.Append (Current_Value, UpChar);
Astate := St_Command;
else
Bounded_String.Append (Current_Value, Achar);
Current_Token := Unk;
Astate := St_Found;
end if;
end Get_State_After_2point;
procedure Get_Command (Astate : in out State; Achar : in Character) is
UpChar:Character;
begin
if (Achar in Minuscule or Achar in Majuscule) then
UpChar:=Achar;
if UpChar in Minuscule then Make_UpperCase(UpChar); end if;
Bounded_String.Append (Current_Value, UpChar);
else
Lookahead := True;
Astate := St_Found;
Current_Token := Command;
end if;
end Get_Command;
procedure Get_Id (Astate : in out State; Achar : in Character) is
UpChar:Character;
begin
if (Achar in Minuscule or Achar in Majuscule or
Achar in Digit or Achar = '_') then
UpChar:=Achar;
if UpChar in Minuscule then Make_UpperCase(UpChar); end if;
Bounded_String.Append (Current_Value, UpChar);
else
Lookahead := True;
Astate := St_Found;
Current_Token := Id;
end if;
end Get_Id;
procedure Get_State_After_Normal
(Astate : in out State; Achar : in Character) is
UpChar:Character;
begin
UpChar:=aChar;
case Achar is
when Ascii.Cr | Ascii.Ht | ' ' =>
Astate := St_Normal;
when Majuscule | Minuscule =>
if UpChar in Minuscule then Make_UpperCase(UpChar); end if;
Bounded_String.Append (Current_Value, UpChar);
Astate := St_Id;
when ':' =>
Astate := St_2point;
when others =>
Bounded_String.Append (Current_Value, Achar);
Current_Token := Unk;
Astate := St_Found;
end case;
end Get_State_After_Normal;
procedure Next is
Current_State : State;
Current_Char : Character;
begin
if not (At_End) then
Bounded_String.Free (Current_Value);
Current_State := St_Normal;
Search_Token:
loop
if not (Lookahead) then
The_Index := The_Index + 1;
if (The_Index > Max_Player_String) then
Current_Token := Toolong;
exit Search_Token;
end if;
else
Lookahead := False;
end if;
Current_Char := The_String (The_Index);
case Current_State is
when St_Normal =>
Get_State_After_Normal
(Current_State, Current_Char);
when St_2point =>
Get_State_After_2point
(Current_State, Current_Char);
when St_Command =>
Get_Command (Current_State, Current_Char);
when St_Id =>
Get_Id (Current_State, Current_Char);
when others =>
Current_Token := Unk;
Bounded_String.Append (Current_Value, Current_Char);
Current_State := St_Found;
end case;
exit when Current_State = St_Found;
end loop Search_Token;
else
Current_Token := Lexend;
end if;
end Next;
end Lex_Player;
with Bounded_String, Lex_Player;
package Interprete is
Error_Range_Interprete : exception;
type Token is
(Id, Command, End_Entry, Fin,Aide, -- User command
End_Com, Start_Prep,Start_Com,
-- prepositions
De, Avec, Par, Vers, Sur, Pour, Ou, Sous, Dans,
Du, A, La, Le, Les, Des, Un, Une, Se, End_Prep);
subtype Player_Token is Token range Id..Aide;
procedure Print_Player_Entry;
procedure Get_Player_Entry;
procedure Open_Index;
procedure Next_Index;
function Get_Indexed_Token return Token;
function Get_Indexed_Entry return String;
function Index_At_End return Boolean;
end Interprete;
with Text_Io, Bounded_String, Lex_Player;
package body Interprete is
Max_Player_Entry : constant Positive := 3;
subtype Iterator is integer range 1..Max_Player_Entry+1;
type Error_List is (No_Error, Caractere_Invalide,
Trop_De_Parametres, Commande_Erronee,
Commande_Inconnue, Saisie_Trop_Longue);
subtype Preposition is Token range Start_Prep .. End_Prep;
subtype Commande is Token range Start_Com .. End_Com;
type Entry_Element is
record
A_Token : Token;
A_String : Bounded_String.Variable_String
(Lex_Player.Max_Player_String);
end record;
Entry_Table : array (1 .. Max_Player_Entry) of Entry_Element;
The_Index :Iterator;
function Is_Keyword (The_String : in String) return Boolean is
T : Token;
begin
T := Token'Value (The_String);
return True;
exception
when Constraint_Error =>
return False;
end Is_Keyword;
function Keyword_To_Token (Word : in String) return Token is
begin
if Is_Keyword (Word) then
return Token'Value (Word);
else
return Id;
end if;
end Keyword_To_Token;
procedure Init_Entry_Table is
begin
for I in Entry_Table'Range loop
Entry_Table (I).A_Token := End_Entry;
Bounded_String.Free (Entry_Table (I).A_String);
end loop;
end Init_Entry_Table;
procedure Put_Entry_Status (Error_Id : in Error_List) is
begin
if (Error_Id /= No_Error) then
Text_Io.Put_Line (Ascii.bel&"Erreur : " &
Error_List'Image (Error_Id) & " !!!");
end if;
end Put_Entry_Status;
procedure Print_Player_Entry is
begin
Print_Loop:
for I in Entry_Table'Range loop
if not (Entry_Table (I).A_Token = End_Entry) then
Text_Io.Put_Line (Token'Image (Entry_Table (I).A_Token) &
" -> " & Bounded_String.Image
(Entry_Table (I).A_String));
else
Text_Io.Put_Line (Token'Image (Entry_Table (I).A_Token));
exit Print_Loop;
end if;
end loop Print_Loop;
end Print_Player_Entry;
procedure Insert_Player_Token
(Table_Index : in Positive; Token_Found : in Token) is
begin
Entry_Table (Table_Index).A_Token := Token_Found;
end Insert_Player_Token;
procedure Insert_Player_Entry
(Table_Index : in Positive; Str_Found : in String) is
begin
Bounded_String.Copy (Entry_Table (Table_Index).A_String, Str_Found);
end Insert_Player_Entry;
function Analyse_Player_Entry return Error_List is
The_Index : Positive := Entry_Table'First;
T1 : Lex_Player.Token;
T2 : Token;
begin
Lex_Player.Get_Player ("Commande >>");
Lex_Player.Init;
Analyse:
while not (Lex_Player.At_End) loop
Lex_Player.Next;
T1 := Lex_Player.Get_Token;
case T1 is
when Lex_Player.Lexend =>
exit Analyse;
when Lex_Player.Unk =>
Insert_Player_Token (Entry_Table'First, End_Entry);
return (Caractere_Invalide);
when Lex_Player.Toolong =>
Insert_Player_Token (Entry_Table'First, End_Entry);
return (Saisie_Trop_Longue);
when Lex_Player.Id =>
T2 := Keyword_To_Token (Lex_Player.Get_Value);
if (The_Index > Max_Player_Entry) then
Insert_Player_Token (Entry_Table'First, End_Entry);
return (Trop_De_Parametres);
elsif (T2 not in Preposition) then
Insert_Player_Token (The_Index, Id);
Insert_Player_Entry (The_Index,
Lex_Player.Get_Value);
The_Index := The_Index + 1;
end if;
when Lex_Player.Command =>
T2 := Keyword_To_Token (Lex_Player.Get_Value);
if (The_Index /= Entry_Table'First) then
Insert_Player_Token (Entry_Table'First, End_Entry);
return (Commande_Erronee);
elsif (T2 not in Commande) then
Insert_Player_Token (Entry_Table'First, End_Entry);
return (Commande_Inconnue);
else
Insert_Player_Token (The_Index, T2);
Insert_Player_Entry (The_Index,
Lex_Player.Get_Value);
The_Index := The_Index + 1;
end if;
end case;
end loop Analyse;
return No_Error;
end Analyse_Player_Entry;
procedure Get_Player_Entry is
begin
Init_Entry_Table;
Put_Entry_Status (Interprete.Analyse_Player_Entry);
end Get_Player_Entry;
procedure Open_Index is
begin
The_Index:=Iterator'First;
end;
procedure Next_Index is
begin
If The_Index < Iterator'Last
then The_index:=The_Index +1;
else raise Error_Range_Interprete;
end if;
end;
function Get_Indexed_Token return Token is
begin
return (Entry_Table (The_Index).A_Token);
end;
function Get_Indexed_Entry return String is
begin
return Bounded_String.Image(Entry_Table(The_Index).A_String);
end;
function Index_At_End return Boolean is
begin
return(The_Index > Max_Player_Entry);
end;
end Interprete;
with Text_Io, Bounded_String, Interprete;
procedure Main is
begin
Interprete.Get_Player_Entry;
Interprete.Print_Player_Entry;
text_io.new_line;
text_io.put_line("look entry with iterartor");
Interprete.Open_Index;
While not Interprete.Index_At_End loop
text_io.put_line(interprete.Token'image(Interprete.Get_Indexed_Token)
&"->"&Interprete.Get_Indexed_Entry);
Interprete.Next_Index;
end loop;
end Main