|
|
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: 3767 (0xeb7)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
with Args;
with Block_Class;
with Msg_Report;
with Object;
with Scanner;
with Statements;
with Symbol_Table;
with Unparse_Report;
package body Block is
type Node_Structure is
record
Info : Natural range 0 .. 1 := 0;
Argu : Args.Node := Args.Empty_Node;
Stat : Statements.Node := Statements.Empty_Node;
Symb : Scanner.B_String;
Obj : Object.Reference;
Lign : Integer;
end record;
procedure Parse (N : in out Node; Error : out Boolean) is
Failed : Boolean := False;
use Scanner;
begin
Msg_Report.Information ("I enter in block's parse");
N := new Node_Structure;
N.Lign := Scanner.Line_Number;
Symbol_Table.New_Enter (N.Symb);
N.Obj := Block_Class.Create (N);
Scanner.Next;
if Args.Is_First (Scanner.Symbol) then
Args.Parse (N.Argu, Failed);
N.Info := 1;
end if;
if not Failed then
if Statements.Is_First (Scanner.Symbol) then
Statements.Parse (N.Stat, Failed);
if Scanner.Symbol = L_Close_Bracket then
Scanner.Next;
Symbol_Table.Leave;
else
Failed := True;
Msg_Report.Syntax_Error ("} expected, incorrect");
end if;
else
Msg_Report.Syntax_Error ("statement expected, incorrect");
Failed := True;
end if;
end if;
Msg_Report.Information ("I leave block's parse with failed = " &
Boolean'Image (Failed));
Error := Failed;
end Parse;
procedure Unparse (N : Node) is
begin
Unparse_Report.Write ("{");
Unparse_Report.Tab;
Unparse_Report.New_Line;
if N.Info = 1 then
Args.Unparse (N.Argu);
Unparse_Report.New_Line;
end if;
Statements.Unparse (N.Stat);
Unparse_Report.Write ("} ");
Unparse_Report.Untab;
end Unparse;
function Is_First (T : Scanner.Token) return Boolean is
use Scanner;
begin
return T = L_Open_Bracket;
end Is_First;
function Interpret
(N : Node := Empty_Node;
Inherited : Object.Reference := Object.Void_Reference;
A_Keyword_Mess : Message.Selector := Message.Void_Selector;
A_List : Arguments.List := Arguments.Void_Arguments
) return Object.Reference is
Result : Object.Reference;
Current_Table : Scanner.B_String;
use Object;
begin
Msg_Report.Information ("I enter in block's interpret");
Msg_Report.Set_Line_Number (N.Lign);
if Inherited = Object.Void_Reference then
-- interpretation du bloc
Result := N.Obj;
else
-- evaluation du bloc
Current_Table := Symbol_Table.Current_Block;
Symbol_Table.Enter (N.Symb);
if N.Info = 1 then
Result := Args.Interpret (N.Argu,
A_Keyword_Mess => A_Keyword_Mess,
A_List => A_List);
end if;
Result := Statements.Interpret (N.Stat);
Symbol_Table.Enter (Current_Table);
end if;
Msg_Report.Information ("I leave block's interpret with result :");
Msg_Report.Continue
("class = " & Object.Class'Image (Object.The_Class (Result)) &
" ident = " & Integer'Image (Object.Identificator (Result)));
return Result;
end Interpret;
end Block;