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: 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;