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: 4933 (0x1345) Types: TextFile Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11 └─ ⟦129cab021⟧ »DATA« └─⟦this⟧
with Arguments; with Binary; with Block_Class; with Boolean_Class; with Integer_Class; with Message; with Msg_Report; with More_Value; with Object; with Pen_Class; with Scanner; with String_Class; with Turtle_Class; with Unparse_Report; package body Value is type Node_Structure is record Info : Natural range 0 .. 1 := 0; Bina : Binary.Node := Binary.Empty_Node; Mova : More_Value.Node := More_Value.Empty_Node; Lign : Integer; end record; procedure Parse (N : in out Node; Error : out Boolean) is Failed : Boolean := False; begin Msg_Report.Information ("I enter in value's parse"); N := new Node_Structure; N.Lign := Scanner.Line_Number; Binary.Parse (N.Bina, Failed); if not Failed then if More_Value.Is_First (Scanner.Symbol) then N.Info := 1; More_Value.Parse (N.Mova, Failed); end if; end if; Msg_Report.Information ("I leave value's parse with failed = " & Boolean'Image (Failed)); Error := Failed; end Parse; procedure Unparse (N : Node) is begin Binary.Unparse (N.Bina); if N.Info = 1 then More_Value.Unparse (N.Mova); end if; end Unparse; function Is_First (T : Scanner.Token) return Boolean is use Scanner; begin return Binary.Is_First (T); end Is_First; function Interpret (N : 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; A_Modify_List : Arguments.List; use Object; begin Msg_Report.Information ("I enter in value's interpret"); Msg_Report.Set_Line_Number (N.Lign); Result := Binary.Interpret (N.Bina); Msg_Report.Information ("value inherited object is :"); Msg_Report.Continue ("class = " & Object.Class'Image (Object.The_Class (Inherited)) & " ident = " & Integer'Image (Object.Identificator (Inherited))); Msg_Report.Information ("Info = " & Integer'Image (N.Info)); if (Inherited = Object.Void_Reference) then if N.Info = 1 then Result := More_Value.Interpret (N.Mova, Result, A_Keyword_Mess, A_List); end if; else A_Modify_List := A_List; Arguments.Write (A_Modify_List, Result); if N.Info = 1 then Result := More_Value.Interpret (N.Mova, Inherited, A_Keyword_Mess, A_Modify_List); else case Object.The_Class (Inherited) is when Object.C_Block => Msg_Report.Information ("I call block interpret"); Result := Block_Class.Send (Inherited, A_Keyword_Mess, A_Modify_List); when Object.C_Integer => Msg_Report.Information ("I call integer send"); Result := Integer_Class.Send (Inherited, A_Keyword_Mess, A_Modify_List); when Object.C_Boolean => Msg_Report.Information ("I call boolean send"); Result := Boolean_Class.Send (Inherited, A_Keyword_Mess, A_Modify_List); when Object.C_String => Msg_Report.Information ("I call boolean send"); Result := String_Class.Send (Inherited, A_Keyword_Mess, A_Modify_List); when Object.C_Turtle => Msg_Report.Information ("I call turtle send"); Result := Turtle_Class.Send (Inherited, A_Keyword_Mess, A_Modify_List); when Object.C_Pen => Msg_Report.Information ("I call pen send"); Result := Pen_Class.Send (Inherited, A_Keyword_Mess, A_Modify_List); when Object.C_Void => null; end case; end if; end if; Msg_Report.Information ("I leave value'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 Value;