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: 5563 (0x15bb) Types: TextFile Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11 └─ ⟦129cab021⟧ »DATA« └─⟦this⟧
with Bounded_String; with Block; with Integer_Class; with Msg_Report; with Object; with Scanner; with String_Class; with String_Utilities; with Symbol_Table; with Unparse_Report; with Value; package body Primary is procedure Bs_Copy (A_String : in out Scanner.B_String; A_Value : String) renames Bounded_String.Copy; function Bs_Image (A_String : Scanner.B_String) return String renames Bounded_String.Image; function Su_Capitalize (A_String : String) return String renames String_Utilities.Capitalize; function Su_Strip (From : String; Filler : Character := ' ') return String renames String_Utilities.Strip; type Node_Structure is record Rule : Natural range 0 .. 4 := 0; Valu : Value.Node := Value.Empty_Node; Bloc : Block.Node := Block.Empty_Node; Iden : Scanner.B_String; Inte : Integer; Stri : Scanner.B_String; 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 primary's parse"); N := new Node_Structure; N.Lign := Scanner.Line_Number; if Scanner.Symbol = L_Identifier then Bs_Copy (N.Iden, Scanner.Value); N.Rule := 2; Scanner.Next; else if Scanner.Symbol = L_Integer then N.Inte := Integer'Value (Scanner.Value); N.Rule := 3; Scanner.Next; else if Scanner.Symbol = L_String then Bs_Copy (N.Stri, Scanner.Value); N.Rule := 4; Scanner.Next; else if Scanner.Symbol = L_Open_Parenthesis then Scanner.Next; if Value.Is_First (Scanner.Symbol) then Value.Parse (N.Valu, Failed); if Scanner.Symbol /= L_Close_Parenthesis then Failed := True; Msg_Report.Syntax_Error (") expected, not "); else Scanner.Next; end if; else Failed := True; Msg_Report.Syntax_Error ("incorrect follow of ( :"); end if; else N.Rule := 1; if Block.Is_First (Scanner.Symbol) then Block.Parse (N.Bloc, Failed); else Failed := True; Msg_Report.Syntax_Error ("incorrect primary : "); end if; end if; end if; end if; end if; Msg_Report.Information ("I leave primary's parse with failed = " & Boolean'Image (Failed)); Error := Failed; end Parse; procedure Unparse (N : Node) is begin case N.Rule is when 0 => Unparse_Report.Write ("( "); Value.Unparse (N.Valu); Unparse_Report.Write (") "); when 1 => Block.Unparse (N.Bloc); when 2 => Unparse_Report.Write (Su_Capitalize (Bs_Image (N.Iden)) & " "); when 3 => Unparse_Report.Write (Su_Strip (Integer'Image (N.Inte)) & " "); when 4 => Unparse_Report.Write (""""); Unparse_Report.Write (Bs_Image (N.Stri)); Unparse_Report.Write (""" "); end case; end Unparse; function Is_First (T : Scanner.Token) return Boolean is use Scanner; begin return T = L_Identifier or else T = L_Integer or else T = L_String or else T = L_Open_Parenthesis or else Block.Is_First (Scanner.Symbol); end Is_First; function Interpret (N : Node; Inherited : Object.Reference := Object.Void_Reference) return Object.Reference is Result : Object.Reference; use Object; begin Msg_Report.Information ("I enter in primary's interpret"); Msg_Report.Set_Line_Number (N.Lign); case N.Rule is when 0 => Result := Value.Interpret (N.Valu); when 1 => Result := Block.Interpret (N.Bloc); when 2 => if Symbol_Table.Is_Found (N.Iden) then Result := Symbol_Table.Get_Info (N.Iden); else Msg_Report.Interpret_Error ("variable " & Bs_Image (N.Iden) & " is undefined"); raise Undefined_Variable; end if; when 3 => Result := Integer_Class.Create (N.Inte); when 4 => Result := String_Class.Create (Bs_Image (N.Stri)); end case; Msg_Report.Information ("I leave primary'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 Primary;