DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦3dc9537d2⟧ TextFile

    Length: 3609 (0xe19)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Scanner, Object, Value, Message, Block, Block_Class, Symbol,
     Bounded_String, Printer, String_Class, Integer_Class, Bug, Table;
package body Primary is

    type Node_Structure is
        record
            Rule : Natural range 0 .. 4 := 0;
            Iden : Message.Tiny_String;
            Obj : Object.Reference := Object.Void_Reference;
            Val : Value.Node := Value.Empty_Node;
            Line : Natural;
        end record;

    procedure Parse (N : in out Node) is
        A_Block : Block.Node := Block.Empty_Node;
        A_Object : Object.Reference := Object.Void_Reference;
        Current_Table : Table.Symbol_Kind;
        In_Table : Boolean := False;
        use Scanner;
    begin
        N := new Node_Structure;
        N.Line := Scanner.Get_Line_Number;
        case Scanner.Get_Token is
            when Scanner.T_Integer =>
                N.Rule := 0;  
                N.Obj := Scanner.Get_Value;
            when Scanner.T_Identifier =>
                N.Rule := 1;
                N.Iden := Scanner.Get_Value;  
                A_Object := Symbol.Eval (N.Iden);
--              verification de l'existance.
            when Scanner.T_Parenthese_Open =>
                N.Rule := 2;
                Scanner.Next;
                Value.Parse (N.Val);
                if Scanner.Get_Token /= Scanner.T_Parenthese_End then  
                    raise Bug.Missing_Right_Parentheses;
                end if;
            when Scanner.T_Block_Open =>
                N.Rule := 3;
                Block.Parse (A_Block);
                N.Obj := Block_Class.Create (A_Block);
            when Scanner.T_String =>
                N.Rule := 4;
                N.Iden := Scanner.Get_Value;
            when others =>
                raise Bug.Unexpected_Token;
        end case;
    end Parse;

    procedure Unparse (N : in Node) is  
        A_Block : Block.Node;
        Void_Object : Object.Reference;
        A_Tiny_String, A_Message : Message.Tiny_String;
    begin  
        Scanner.Set_Line_Number (N.Line);
        case N.Rule is
            when 0 =>
                Bounded_String.Copy (A_Message, "Image");
                Void_Object := Integer_Class.Send (N.Obj, A_Message);
                A_Tiny_String := String_Class.Get_String (Void_Object);
                Printer.Write (A_Tiny_String);
                String_Class.Remove (Void_Object);
            when 1 =>
                Printer.Write (N.Iden);
            when 2 =>
                Printer.Write ("(");
                Value.Unparse (N.Val);
                Printer.Write (")");
            when 3 =>
                Printer.Write ("{");
                Printer.Forward (4);
                A_Block := Block_Class.Search (N.Obj);
                Block.Unparse (A_Block);
                Printer.Backward (4);
                Printer.New_Line;
                Printer.Write_St ("}");
            when 4 =>
                Printer.Write_St ((' ', '"'));
                Printer.Write_St (N.Iden);
                Printer.Write (('"', ' '));
        end case;
    end Unparse;

    function Interpret (N : Node) return Object.Reference is
        Result : Object.Reference;
    begin  
        Scanner.Set_Line_Number (N.Line);
        case N.Rule is
            when 0 | 3 =>
                Result := N.Obj;  
            when 1 =>
                Result := Symbol.Eval (N.Iden);
            when 2 =>
                Result := Value.Interpret (N.Val);
            when 4 =>
                Result := String_Class.Create (N.Iden);
        end case;
        return Result;
    end Interpret;
end Primary;