Re: URGENT: inserting words into an array

[Craig Carey <research@ijs.co.nz>]

On 07 Jan 2004 20:48:07 +0100, Pascal Obry <p.obry@wanadoo.fr> wrote:

>
>mmq_2002@onetel.net.uk (Qas) writes:
>
>> but my problem is slighlty different, i have a text file with 20 words
>> seperated by either a space or new line and i want to know how i can
>> insert each word into the array. i know that the maximum length a word
>> will go to is 25 characters, this is what the file looks like:
>
>This looks like home work, right ?
>
>You should try at least to post something, we will not do your home work :)
>

I provide an example as asked for.
The following code demonstrates a cut-down version of my Striunli fast
Strings package (URL below).


----------------------------------------------------------------------

with Ada.Command_Line;
with Ada.Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
with W_Strings;

procedure Inserting_Words is

   pragma Style_Checks ("3abcefhiklmnoprst");   --  GNAT
   package Tio renames Ada.Text_IO;
   package AS renames Ada.Strings;
   package AE renames Ada.Exceptions;
   package SM renames Ada.Strings.Maps;
   package SF renames Ada.Strings.Fixed;
   package CL renames Ada.Command_Line;
   package SW renames W_Strings;

   use type SW.W_Str;
   subtype File_Type is Tio.File_Type;
   IW_ERROR       : exception;

   procedure Open_File (
            Inp_File    : in out File_Type;
            File_Name   : String) is
   begin
      Tio.Open (Inp_File, Mode => Tio.In_File, Name => File_Name);
   exception
      when X : others =>
         Tio.Put_Line ("Error opening file: """ & File_Name &
                  """: " & AE.Exception_Information (X));
         raise IW_ERROR;
   end Open_File;

   procedure Get_Line (Inp_File : File_Type; Line_Out : out SW.W_Str)
   is
      Part        : String (1 .. 32 * 1024);
      Last        : Natural;
   begin
      Tio.Get_Line (Inp_File, Part, Last);
      if Last = Part'Last then
         SW.Assign (Line_Out, Part);
         while Last = Part'Last loop
            Tio.Get_Line (Inp_File, Part, Last);
            SW.Assign (Line_Out, +Line_Out & Part);
         end loop;
         return;
      else
         SW.Assign (Line_Out, Part (1 .. Last));
      end if;
   exception
      when X : others =>
         Tio.Put_Line ("Error reading line" &
                  Tio.Positive_Count'Image (Tio.Line (Inp_File)) &
                  " of file """ & Tio.Name (Inp_File) &
                  """: " & AE.Exception_Information (X));
         raise IW_ERROR;
   end Get_Line;

   type Words_Integer is new Integer;
   type Words_Array is array (Words_Integer range <>) of SW.W_Str;
   type Words_Array_Ptr is access Words_Array;
   Words          : Words_Array_Ptr := new Words_Array (1 .. 8);
   Words_Last     : Words_Integer := 0;

   procedure Lengthen_Words_Arr (New_Len : Words_Integer) is
      procedure Free_Words_Array is new Ada.Unchecked_Deallocation (
                     Object => Words_Array, Name => Words_Array_Ptr);
      New_Lines   : Words_Array_Ptr;
   begin
      if New_Len > Words'Last then
         New_Lines := new Words_Array (1 .. 1 + 2 * Words'Last);
         for K in 1 .. Words_Last loop
            SW.Assign_Fast (New_Lines (K), Words (K));
         end loop;
         Free_Words_Array (Words);
         Words := New_Lines;
      end if;
      Words_Last := New_Len;
   end Lengthen_Words_Arr;

   procedure Binary_Search (
            Words       : Words_Array;
            Key         : String;
            First, Last : out Words_Integer) is
      K        : Words_Integer;
   begin
      First := Words'First;
      Last := Words'Last;
      while First <= Last loop
         K := (First + Last) / 2;
         if    Key < +Words (K) then Last  := K - 1;
         elsif +Words (K) < Key then First := K + 1;
         else return; end if;
      end loop;
   end Binary_Search;

   Inp_File       : Tio.File_Type;
   Line_1         : SW.W_Str;
   WhiteSpace     : constant SM.Character_Sequence := (
            1 => ASCII.HT, 2 => ASCII.LF, 3 => ASCII.VT,
            4 => ASCII.FF, 5 => ASCII.CR, 6 => ' ',
            7 => Character'Val (160));       --  160 = No_Break_Space
   WhiteSpace_Set : constant SM.Character_Set :=
                                             SM.To_Set (WhiteSpace);
   Was_Opened     : Boolean := False;
begin
   if CL.Argument_Count < 1 then
      Tio.Put_Line ("Usage: " & CL.Command_Name & " Input_File_Name");
      return;
   end if;
   Open_File (Inp_File => Inp_File, File_Name => CL.Argument (1));
   Was_Opened := True;
   while not Tio.End_Of_File (Inp_File) loop
      Get_Line (Inp_File => Inp_File, Line_Out => Line_1);
      declare
         Line        : String := +Line_1;
         P1, P2      : Natural := 0;
         Low, High   : Words_Integer;
      begin
         loop
            SF.Find_Token (Source => Line (P2 + 1 .. Line'Last),
                     Set => WhiteSpace_Set, Test => AS.Outside,
                     First => P1, Last => P2);
            exit when P1 > P2;
            Binary_Search (Words (1 .. Words_Last),
                     Line (P1 .. P2), Low, High);
            Lengthen_Words_Arr (New_Len => Words_Last + 1);
            if Low = High + 1 then                          --  Insert
               for J in Low .. Words_Last - 1 loop
                  SW.Assign (Words (J + 1), +Words (J));
               end loop;
            else
               Low := Words_Last;
            end if;
            SW.Assign (Words (Low), Line (P1 .. P2));
            P1 := P2 + 1;
         end loop;
      end;
   end loop;
   Tio.Put_Line ("The table of words:");
   for K in 1 .. Words_Last loop
      Tio.Put_Line (SF."*" (8 - Words_Integer'Image (K)'Length, ' ') &
               Words_Integer'Image (K) & ": """ & (+Words (K) & '"'));
   end loop;
   if Was_Opened then Tio.Close (Inp_File); end if;
exception
   when X : others =>
      if Was_Opened then Tio.Close (Inp_File); end if;
      if "IW_ERROR" /= AE.Exception_Name (X) then raise; end if;
end Inserting_Words;
----------------------------------------------------------------------

with Ada.Finalization;

package W_Strings is

   --  This is a cut-down version of the Striunli Unbounded Strings
   --  package. URL:
   --    http://www.ijs.co.nz/code/ada95_strings_pkg.zip

   Ws_Error          : exception;

   subtype Ws_String is String;
   type Ws_String_Ptr is access Ws_String;

   Ws_Null_String_Ptr  : aliased constant Ws_String_Ptr :=
                                                new String (1 .. 0);

   type W_Str is new Ada.Finalization.Limited_Controlled with
      record
         Len            : aliased Natural := 0;
         Str            : aliased Ws_String_Ptr := Ws_Null_String_Ptr;
         Valid          : aliased Boolean := True;
      end record;

   procedure Assign (Dest : out W_Str; Source : String);

   procedure Assign_Fast (Dest : out W_Str; Source : in out W_Str);

   function "+" (Source : W_Str) return String;

private
   procedure Finalize (Object : in out W_Str);

   function Bump_Up_Size (Old_High, New_High : Natural)
         return Natural;

end W_Strings;
----------------------------------------------------------------------

with Ada.Unchecked_Deallocation;

package body W_Strings is

   procedure Deallocate_String is
      new Ada.Unchecked_Deallocation (Ws_String, Ws_String_Ptr);

   procedure Assign (
            Dest           : out W_Str;
            Source         : Ws_String)
   is
      New_Len     : Natural := Source'Length;
      Length      : Natural;
      Dest_Str    : Ws_String_Ptr renames Dest.Str;
   begin
      if Dest_Str = Ws_Null_String_Ptr then
         if New_Len = 0 then
            goto DONE_2;      --  Don't call Allocate when New_Len = 0
         end if;
         Dest_Str := new String (1 .. New_Len);
      elsif Dest_Str.all'Last < New_Len then
         Length := Bump_Up_Size (Old_High => Dest_Str.all'Last,
                        New_High => New_Len);
         Deallocate_String (Dest_Str);
         Dest_Str := new String (1 .. Length);
      end if;
      Dest.Str (1 .. New_Len) := Source;
      <<DONE_2>>
      Dest.Len := New_Len;
      Dest.Valid := True;
   end Assign;

   procedure Assign_Fast (Dest : out W_Str; Source : in out W_Str)
   is
      LHS      : W_Str renames Dest;
      RHS      : W_Str renames Source;
      TR       : Ws_String_Ptr;
   begin
      TR := LHS.Str;          --  Swap pointers
      LHS.Str := RHS.Str;
      RHS.Str := TR;
      LHS.Len := RHS.Len;
      RHS.Len := 0;           --  LHS.Len is lost which is convenient
      LHS.Valid := RHS.Valid;
      RHS.Valid := False;     --  Warns on attempt to reuse the string
   end Assign_Fast;

   function Bump_Up_Size (Old_High, New_High : Natural) return Natural
   is
      N           : Natural := Natural'Max (New_High, Natural'Max (64,
                              48 + Natural (17 * (Old_High / 10))));
   begin
      return 32 * ((N + (32 - 1)) / 32);
   end Bump_Up_Size;

   procedure Finalize (Object : in out W_Str) is
   begin
      if Object.Str /= (null) then
         if Object.Str /= Ws_Null_String_Ptr then
            Deallocate_String (Object.Str);
         end if;
      end if;
   end Finalize;

   function "+" (Source : W_Str) return String is
   begin
      if not Source.Valid then
         raise Ws_Error;
      end if;
      return Source.Str.all (1 .. Source.Len);
   end "+";

end W_Strings;
----------------------------------------------------------------------


The above sample code didnt need debugging (i.e. it ran first time and
before the 2nd executable was produced).  Being about 155 lines long,
that is similar to what would be expected.




Craig Carey
Ada 95 mailing lists: http://www.ijs.co.nz/ada_95.htm