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: 4524 (0x11ac) Types: TextFile Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11 └─ ⟦129cab021⟧ »DATA« └─⟦this⟧
with Lex; with Object; with Bounded_String; with String_Utilities; with Bloc_Class; with Error_Broadcaster; with Unparser; package body More2_List is type Node_Structure is record Rule : Natural range 0 .. 1 := 0; Ident : Object.Message; Keyword : Object.Message; More2 : More2_List.Node := More2_List.Empty_Node; end record; procedure Parse (N : in out Node; Error : out Boolean) is Failed : Boolean := False; begin N := new Node_Structure; case Lex.Get_Token is when Lex.Key_Word => Bounded_String.Copy (N.Keyword, Lex.Get_Value); Lex.Next_Token; if Lex.Token'Pos (Lex.Get_Token) /= Lex.Token'Pos (Lex.Identifier) then Error := Failed; else Bounded_String.Copy (N.Ident, Lex.Get_Value); Bloc_Class.Local_Put (N.Ident); Lex.Next_Token; end if; if not Failed and Lex.Token'Pos (Lex.Get_Token) = Lex.Token'Pos (Lex.Key_Word) then N.Rule := 1; More2_List.Parse (N.More2, Failed); end if; when others => null; end case; Error := Failed; end Parse; procedure Unparse (N : in out Node) is begin case N.Rule is when 0 => Unparser.Put (" "); Unparser.Put (Bounded_String.Image (N.Keyword)); Unparser.Put (" "); Unparser.Put (Bounded_String.Image (N.Ident)); when 1 => Unparser.Put (" "); Unparser.Put (Bounded_String.Image (N.Keyword)); Unparser.Put (" "); Unparser.Put (Bounded_String.Image (N.Ident)); Unparser.Put (" "); More2_List.Unparse (N.More2); end case; end Unparse; function Interpret (N : Node; Inherited : Object.Reference := Object.Void_Reference) return Object.Reference is Result : Object.Reference; begin case N.Rule is when 0 => Result := Inherited; when 1 => Result := Inherited; Result := More2_List.Interpret (N.More2, Result); end case; return Result; end Interpret; procedure Make_Selector (N : Node; Selector : in out Object.Message; Cardinality : in out Natural) is begin case N.Rule is when 0 => Bounded_String.Append (Selector, N.Keyword); Cardinality := Cardinality + 1; when 1 => Bounded_String.Append (Selector, N.Keyword); Cardinality := Cardinality + 1; Make_Selector (N.More2, Selector, Cardinality); end case; end Make_Selector; procedure Set_More (N : Node; The_Argument : in out Object.Parameters.List) is Obj : Object.Reference; begin case N.Rule is when 0 => Object.Parameters.Get (The_Argument, Obj); Bloc_Class.Set (N.Ident, Obj); when 1 => Object.Parameters.Get (The_Argument, Obj); Bloc_Class.Set (N.Ident, Obj); Set_More (N.More2, The_Argument); end case; end Set_More; procedure Set (N : Node; The_Argument : in out Object.Parameters.List) is Obj : Object.Reference; Selector : Object.Message; Cardinality : Integer := 0; begin Make_Selector (N, Selector, Cardinality); if String_Utilities.Equal (Bounded_String.Image (Object.Parameters.Selector (The_Argument)), Bounded_String.Image (Selector), True) then case N.Rule is when 0 => Object.Parameters.Get (The_Argument, Obj); Bloc_Class.Set (N.Ident, Obj); when 1 => Object.Parameters.Get (The_Argument, Obj); Bloc_Class.Set (N.Ident, Obj); Set_More (N.More2, The_Argument); end case; else raise Error_Broadcaster.Unknown_Keyword_Message; end if; end Set; end More2_List;