* Re: URGENT: inserting words into an array
2004-01-07 19:48 ` Pascal Obry
@ 2004-01-09 23:34 ` Craig Carey
2004-01-09 23:46 ` Craig Carey
0 siblings, 1 reply; 5+ messages in thread
From: Craig Carey @ 2004-01-09 23:34 UTC (permalink / raw)
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
^ permalink raw reply [flat|nested] 5+ messages in thread