DataMuseum.dk

top - download

    Length: 5290 (0x14aa)
    Types: TextFile
    Names: »B«

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

TextFile

with Lex;
with Queue_Generic;
package body Error is


-------------------------- Declaration des types --------------------------
---------------------------------------------------------------------------

    type Error_Record is
        record
            Err_No : Natural := 0;
            Line_No : Natural := 0;
            Column_No : Natural := 0;
        end record;

    type Check_Mark_List is array (0 .. 20) of Natural;

    type Error_List is array (0 .. 20) of Natural;

    type Pstring is access String;






-------------------------- Declaration des Paquetages ---------------------
---------------------------------------------------------------------------

    package Error_Queue is new Queue_Generic (Error_Record);


    package Data is
        function Image (Index : Natural) return String;
        function Get_Token (Index : Natural) return Lex.Tokens;
    end Data;


    package Destination is
        procedure Open (Destination_File_Name : String);
        procedure Close;
        procedure Put_Line (S : String);
        procedure Put_Check_Marks (The_Check_Marks : Check_Mark_List);
    end Destination;


    package Source is
        procedure Open (Source_File_Name : String);
        procedure Close;
        procedure Next_Line;
        function Image return String;
        function Line return Natural;
        function End_Of_File return Boolean;
    end Source;





-------------------------- Declaration des variables --------------------------
-------------------------------------------------------------------------------


    The_Object : Error_Queue.Queue;
    The_Iterator : Error_Queue.Iterator;



-------------------------- Iplementation des procedures -----------------------
-------------------------------------------------------------------------------


    procedure Initialize is
    begin
        Error_Queue.Initialize (The_Object);
    end Initialize;


    procedure Panic (The_Rule : Natural) is
    begin
        while not Lex.Current_Token_In (Data.Get_Token (The_Rule)) and then
                 not Lex.At_End loop
            Lex.Next;
        end loop;
    end Panic;


    procedure Append (The_Error : Natural) is
        Current_Error_Record : Error_Record;
    begin
        Current_Error_Record.Err_No := The_Error;
        Current_Error_Record.Line_No := Lex.Get_Line;
        Current_Error_Record.Column_No := Lex.Get_Column;
        Error_Queue.Add (The_Object, Current_Error_Record);  
    end Append;


    function Exist return Boolean is
    begin
        return not Error_Queue.Is_Empty (The_Object);
    end Exist;


    procedure Init_Iterator is
    begin
        Error_Queue.Init (The_Iterator, The_Object);
    end Init_Iterator;


    procedure Next is
    begin
        Error_Queue.Next (The_Iterator);
    end Next;



    function Get return Error_Record is
    begin
        return Error_Queue.Value (The_Iterator);
    end Get;



    function At_End return Boolean is
    begin
        return Error_Queue.Done (The_Iterator);
    end At_End;



    procedure Make_Check_Marks (The_Check_Marks : out Check_Mark_List;
                                The_Error_List : out Error_List;
                                The_Line : Natural) is
        Current_Error_Record : Error_Record;
        Nb_Items : Natural := 0;
    begin
        Current_Error_Record := Get;
        while ((Current_Error_Record.Line_No = The_Line) and (not At_End)) loop
            Nb_Items := Nb_Items + 1;
            The_Check_Marks (Nb_Items) := Current_Error_Record.Column_No;
            The_Error_List (Nb_Items) := Current_Error_Record.Err_No;
            Next;
            if not At_End then
                Current_Error_Record := Get;
            end if;
        end loop;
        The_Check_Marks (0) := Nb_Items;
        The_Error_List (0) := Nb_Items;
    end Make_Check_Marks;


    procedure Display_In_Source (Source_File_Name : String :=
                                    Text_Io.Name (Text_Io.Standard_Input);
                                 Destination_File_Name : String :=
                                    Text_Io.Name (Text_Io.Standard_Output)) is
    begin  
        Init_Iterator;
        Source.Open (Source_File_Name);
        Destination.Open (Destination_File_Name);
        while not Source.End_Of_File loop
            Source.Next_Line;
            declare  
                S : constant String := Source.Image;
                L : constant Natural := Source.Line;
                The_C_M : Check_Mark_List;
                The_Error_List : Error_List;
            begin
                Make_Check_Marks (The_C_M, The_Error_List, L);
                Destination.Put_Line (S);
                Destination.Put_Check_Marks (The_C_M);
                for I in 1 .. The_Error_List (0) loop
                    Destination.Put_Line (Data.Image (The_Error_List (I)));
                end loop;
            end;
        end loop;
        Source.Close;
        Destination.Close;
    end Display_In_Source;




---------------------------- Corps des Paquetages -------------------------
---------------------------------------------------------------------------


    package body Source is separate;
    package body Destination is separate;
    package body Data is separate;


end Error;