⟦48bf02e61⟧

TextFile

with Io;
with Files;
with String_Utilities;
with Low_Level_File_Operations;
package body Maps is

    Key_Field : constant Positive := 1;

    function Create (From_String : in String) return Mapping is
        --
        New_Mapping : Mapping;
        --
    begin
        if (From_String = "") then
            -- No fields in string, so no key field.
            raise Parse_Failure;
        end if;
        New_Mapping := Mapping (Mappings.Iterator'
                                (Mappings.Create (From_String)));
        if (Mappings.Current  
               (Mappings.Iterator (New_Mapping))) = "" then
            -- Key field is null.
            raise Parse_Failure;
        end if;
        return (New_Mapping);
        --
    exception
        when others =>
            raise;
    end Create;

    function Done (This_Mapping : in Mapping) return Boolean is
    begin
        return (Mappings.Done (Mappings.Iterator (This_Mapping)));
        --
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when others =>
            raise;
    end Done;

    procedure Reset (This_Mapping : in out Mapping) is
    begin
        Mappings.Reset (Mappings.Iterator (This_Mapping));
        --
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when others =>
            raise;
    end Reset;

    function Current (This_Mapping : in Mapping) return Field is
    begin
        return (Mappings.Current (Mappings.Iterator (This_Mapping)));
        --
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when Mappings.No_Current_Field =>
            raise No_Current_Field;
        when others =>
            raise;
    end Current;

    procedure Modify (This_Mapping : in out Mapping; New_Field : in Field) is
    begin
        if (Mappings.Position (Mappings.Iterator (This_Mapping)) =
            Key_Field) then
            -- Attempt to modify key field.
            raise Out_Of_Range;
        end if;
        Mappings.Modify (Mappings.Iterator (This_Mapping), New_Field);
        --
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when Mappings.No_Current_Field =>
            raise No_Current_Field;
        when Mappings.Parse_Failure =>
            raise Parse_Failure;
        when others =>
            raise;
    end Modify;

    procedure Next (This_Mapping : in out Mapping) is
    begin
        Mappings.Next (Mappings.Iterator (This_Mapping));
        --
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when Mappings.No_Next_Field =>
            raise No_Next_Field;
        when others =>
            raise;
    end Next;

    function Position (In_Mapping : in Mapping) return Field_Number is
    begin
        return (Mappings.Position (Mappings.Iterator (In_Mapping)));
        --
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when Mappings.No_Current_Field =>
            raise No_Current_Field;
        when others =>
            raise;
    end Position;

    procedure Set (This_Mapping : in out Mapping; To_Field : in Field_Number) is
    begin
        Mappings.Set (Mappings.Iterator (This_Mapping), To_Field);
        --
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when Mappings.Out_Of_Range =>
            raise Out_Of_Range;
        when others =>
            raise;
    end Set;

    function Field_At (This_Position : in Field_Number; In_Mapping : in Mapping)
                      return Field is
    begin
        return (Mappings.Field_At (This_Position,
                                   Mappings.Iterator (In_Mapping)));
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when Mappings.Out_Of_Range =>
            raise Out_Of_Range;
        when others =>
            raise;
    end Field_At;

    function Fields_In (This_Mapping : in Mapping) return Positive is
    begin
        return (Mappings.Fields_In (Mappings.Iterator (This_Mapping)));
        --
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when others =>
            raise;
    end Fields_In;

    function Key_For (This_Mapping : in Mapping) return String is
    begin
        return (Mappings.Field_At (Key_Field,
                                   Mappings.Iterator (This_Mapping)));
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when others =>
            raise Bad_Mapping;
    end Key_For;

    function Create
                (From_Map_File : in String; Ignore_Case : in Boolean := True)
                return Map is
        --
        New_Map : Map;
        --
        Input : Io.File_Type;
        --
    begin  
        New_Map.Contents := Lines.Create;
        New_Map.Ignore_Case := Ignore_Case;
        Low_Level_File_Operations.Open_To_Read (From_Map_File, Input);
        while (not Io.End_Of_File (Input)) loop
            declare
                Current_Line : constant String := Io.Get_Line (Input);
                Current_Mapping : Mapping := Create (Current_Line);
            begin
                declare
                    Current_Key : constant String := Key_For (Current_Mapping);
                begin
                    if (Is_Mapped (Current_Key, New_Map)) then
                        -- Duplicate entry.
                        raise Parse_Failure;
                    end if;  
                    Lines.Add (New_Map.Contents, Lines.Create (Current_Line));
                end;  
            end;  
        end loop;
        Low_Level_File_Operations.Close (Input);
        Lines.Reset (New_Map.Contents);
        return (New_Map);
        --
    exception
        when Low_Level_File_Operations.Io_Failure =>
            Low_Level_File_Operations.Close (Input);
            raise Io_Failure;
        when others =>
            Low_Level_File_Operations.Close (Input);
            raise Parse_Failure;
    end Create;

    procedure Save (To_Map_File : in String; This_Map : in out Map) is
    begin  
        Files.Save (To_Map_File, This_Map.Contents);
        --
    exception
        when Files.Not_Initialized =>
            raise Not_Initialized;
        when Files.Io_Failure =>
            raise Io_Failure;  
        when others =>
            raise;
    end Save;

    function Is_Mapped (This_Key : in String; In_Map : in Map) return Boolean is
        --
        The_Mapping : Mapping;
        --
    begin
        The_Mapping := Mapping_For (This_Key, In_Map);
        return (True);
        --
    exception
        when Not_Initialized =>
            raise Not_Initialized;
        when Bad_Mapping =>
            raise Bad_Mapping;
        when others =>
            return (False);
    end Is_Mapped;

    procedure Locate (This_Key : in String;
                      In_Map : in out Map;
                      The_Mapping : in out Mapping) is
        --
        -- Looks for the specified key in the specified map. If
        -- finds it, the map will be left with Current pointing
        -- to the entry matching the key, and the mapping itself
        -- will be passed to the caller. If not found, raises
        -- "No_Mapping".
        --
        This_Key_Normalized : constant String :=
           String_Utilities.Upper_Case (This_Key);
        --
    begin
        Lines.Reset (In_Map.Contents);
        while (not Lines.Done (In_Map.Contents)) loop
            declare  
                Current_Line : constant String :=
                   Lines.Image (Lines.Current (In_Map.Contents));
                Current_Mapping : Mapping := Create (Current_Line);
                Key_Field : constant String := Key_For (Current_Mapping);
                Key_Field_Normalized : constant String :=
                   String_Utilities.Upper_Case (Key_Field);
            begin  
                The_Mapping := Current_Mapping;
                if (In_Map.Ignore_Case) then
                    if (Key_Field_Normalized = This_Key_Normalized) then
                        -- Found match ignoring casing.
                        exit;
                    end if;
                else
                    if (Key_Field = This_Key) then
                        -- Found match including casing.
                        exit;
                    end if;
                end if;
                -- Didn't find match on this pass.
            end;
            Lines.Next (In_Map.Contents);
        end loop;  
        if (Lines.Done (In_Map.Contents)) then
            -- Never found match.
            raise No_Mapping;
        end if;
        --
    exception
        when Lines.Not_Initialized =>
            raise Not_Initialized;
        when Bad_Mapping | Parse_Failure =>
            raise Bad_Mapping;
        when No_Mapping =>
            raise No_Mapping;
        when others =>
            raise;
    end Locate;

    function Mapping_For
                (This_Key : in String; In_Map : in Map) return Mapping is
        --
        The_Mapping : Mapping;
        --
        The_Map : Map := In_Map;
        --
    begin
        Locate (This_Key, The_Map, The_Mapping);
        return (The_Mapping);
    end Mapping_For;

    procedure Add (This_Mapping : in String; To_Map : in out Map) is
        --
        Old_Mapping : Mapping;  
        New_Mapping : Mapping;
        --
    begin  
        New_Mapping := Create (This_Mapping);
        Locate (This_Key => Key_For (New_Mapping),
                In_Map => To_Map,
                The_Mapping => Old_Mapping);
        -- Found existing mapping with same key: need to overwrite.
        Lines.Modify (To_Map.Contents, Lines.Create (This_Mapping));
        --
    exception
        when No_Mapping =>
            -- No mapping with the given key exists: need to add.
            Lines.Add (To_Map.Contents, Lines.Create (This_Mapping));
        when others =>
            raise;
    end Add;

    function Done (This_Map : in Map) return Boolean is
    begin
        return (Lines.Done (This_Map.Contents));
        --
    exception
        when Lines.Not_Initialized =>
            raise Not_Initialized;
        when others =>
            raise;
    end Done;

    procedure Reset (This_Map : in out Map) is
    begin
        Lines.Reset (This_Map.Contents);
        --
    exception
        when Lines.Not_Initialized =>
            raise Not_Initialized;
        when others =>
            raise;
    end Reset;

    function Current (This_Map : in Map) return Mapping is
    begin
        return (Create (Lines.Image (Lines.Current (This_Map.Contents))));
        --
    exception
        when Lines.Not_Initialized =>
            raise Not_Initialized;
        when Lines.No_Current_Line =>
            raise No_Current_Mapping;
        when Parse_Failure | Bad_Mapping =>
            raise Bad_Mapping;
        when others =>
            raise;
    end Current;

    procedure Next (This_Map : in out Map) is
    begin
        Lines.Next (This_Map.Contents);
        --
    exception
        when Lines.Not_Initialized =>
            raise Not_Initialized;  
        when Lines.No_Next_Line =>
            raise No_Next_Mapping;
        when others =>
            raise;
    end Next;

    function Is_Empty (This_Map : in Map) return Boolean is
    begin
        return (Lines.Is_Empty (This_Map.Contents));
        --
    exception
        when Lines.Not_Initialized =>
            raise Not_Initialized;
        when others =>
            raise;
    end Is_Empty;

    function Mappings_In (This_Map : in Map) return Natural is
    begin
        return (Lines.Lines_In (This_Map.Contents));
        --
    exception
        when Mappings.Not_Initialized =>
            raise Not_Initialized;
        when others =>
            raise;
    end Mappings_In;

end Maps;
DataMuseum.dk

Rational R1000/400 Tapes

⟦48bf02e61⟧ TextFile

Derivation

TextFile
