lace: Add 'wide_Text'.

This commit is contained in:
Rod Kay
2023-07-13 22:05:13 +10:00
parent 4861f54232
commit 6a4f1c148c
13 changed files with 2424 additions and 1 deletions

View File

@@ -29,7 +29,7 @@ is
"../source/events/mixin/" & external ("restrictions", "xgc"), "../source/events/mixin/" & external ("restrictions", "xgc"),
"../source/events/utility", "../source/events/utility",
"../source/strings", "../source/strings",
"../source/text"); "../source/text/**");
package Builder renames Lace_shared.Builder; package Builder renames Lace_shared.Builder;
package Compiler renames Lace_shared.Compiler; package Compiler renames Lace_shared.Compiler;

View File

@@ -0,0 +1,164 @@
with
lace.wide_Text.all_Tokens,
ada.Characters.wide_latin_1;
package body lace.wide_Text.all_Lines
is
use lace.wide_Text.all_Tokens,
ada.Characters.wide_latin_1;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_2
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_4
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_8
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_16
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_32
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_64
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_128
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_256
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_512
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_1k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_2k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_4k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_8k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_16k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_32k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_64k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_128k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_256k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_512k
is
begin
return Tokens (Self, LF, Trim, max_Lines);
end Lines;
end lace.wide_Text.all_Lines;

View File

@@ -0,0 +1,45 @@
package lace.wide_Text.all_Lines
is
default_Max : constant := 8 * 1024;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_2;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_4;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_8;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_16;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_32;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_64;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_128;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_256;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_512;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_1k;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_2k;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_4k;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_8k;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_16k;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_32k;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_64k;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_128k;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_256k;
function Lines (Self : in Item; Trim : in Boolean := False;
max_Lines : in Positive := default_Max) return wide_Text.items_512k;
end lace.wide_Text.all_Lines;

View File

@@ -0,0 +1,505 @@
with
lace.wide_Text.Cursor;
package body lace.wide_Text.all_Tokens
is
----------------------
-- Character Delimiter
--
function next_Token (Self : in Item; Delimiter : in wide_Character;
From : in out Positive) return wide_String
is
Cursor : Positive renames From;
begin
if Self.Data (Cursor) = Delimiter
then
Cursor := Cursor + 1;
return "";
elsif Cursor = Self.Length
then
Cursor := Cursor + 1;
return Self.Data (Cursor - 1 .. Cursor - 1);
else
declare
First : constant Positive := Cursor;
begin
loop
Cursor := Cursor + 1;
if Self.Data (Cursor) = Delimiter
then
Cursor := Cursor + 1;
return Self.Data (First .. Cursor - 2);
elsif Cursor = Self.Length
then
Cursor := Cursor + 1;
return Self.Data (First .. Cursor - 1);
end if;
end loop;
end;
end if;
end next_Token;
generic
Text_Capacity : Positive;
type Component is private;
type Array_type is array (Positive range <>) of Component;
with function any_to_Text (From : in wide_String; Capacity : in Natural;
Trim : in Boolean := False) return Component;
function any_Tokens_chr (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := 8 * 1024) return Array_type;
function any_Tokens_chr (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := 8 * 1024) return Array_type
is
begin
declare
the_Tokens : Array_type (1 .. max_Tokens);
Count : Natural := 0;
From : Positive := 1;
begin
while From <= Self.Length
loop
Count := Count + 1;
the_Tokens (Count) := any_to_Text (next_Token (Self,
Delimiter,
From),
capacity => Text_Capacity,
trim => Trim);
end loop;
if Self.Length > 0
and then Self.Data (Self.Length) = Delimiter
then -- Handle case where final character is the delimiter.
Count := Count + 1;
the_Tokens (Count) := any_to_Text ("", capacity => Text_Capacity); -- Add an empty token.
end if;
return the_Tokens (1 .. Count);
end;
exception
when storage_Error =>
raise stack_Error with "Stack size exceeded. Increase stack size via '$ ulimit -s unlimited' or similar.";
end any_Tokens_chr;
function Tokens_1 is new any_Tokens_chr (Text_Capacity => 1,
Component => wide_Text.item_1,
Array_type => wide_Text.items_1,
any_to_Text => to_Text);
function Tokens_2 is new any_Tokens_chr (Text_Capacity => 2,
Component => wide_Text.item_2,
Array_type => wide_Text.items_2,
any_to_Text => to_Text);
function Tokens_4 is new any_Tokens_chr (Text_Capacity => 4,
Component => wide_Text.item_4,
Array_type => wide_Text.items_4,
any_to_Text => to_Text);
function Tokens_8 is new any_Tokens_chr (Text_Capacity => 8,
Component => wide_Text.item_8,
Array_type => wide_Text.items_8,
any_to_Text => to_Text);
function Tokens_16 is new any_Tokens_chr (Text_Capacity => 16,
Component => wide_Text.item_16,
Array_type => wide_Text.items_16,
any_to_Text => to_Text);
function Tokens_32 is new any_Tokens_chr (Text_Capacity => 32,
Component => wide_Text.item_32,
Array_type => wide_Text.items_32,
any_to_Text => to_Text);
function Tokens_64 is new any_Tokens_chr (Text_Capacity => 64,
Component => wide_Text.item_64,
Array_type => wide_Text.items_64,
any_to_Text => to_Text);
function Tokens_128 is new any_Tokens_chr (Text_Capacity => 128,
Component => wide_Text.item_128,
Array_type => wide_Text.items_128,
any_to_Text => to_Text);
function Tokens_256 is new any_Tokens_chr (Text_Capacity => 256,
Component => wide_Text.item_256,
Array_type => wide_Text.items_256,
any_to_Text => to_Text);
function Tokens_512 is new any_Tokens_chr (Text_Capacity => 512,
Component => wide_Text.item_512,
Array_type => wide_Text.items_512,
any_to_Text => to_Text);
function Tokens_1k is new any_Tokens_chr (Text_Capacity => 1024,
Component => wide_Text.item_1k,
Array_type => wide_Text.items_1k,
any_to_Text => to_Text);
function Tokens_2k is new any_Tokens_chr (Text_Capacity => 2 * 1024,
Component => wide_Text.item_2k,
Array_type => wide_Text.items_2k,
any_to_Text => to_Text);
function Tokens_4k is new any_Tokens_chr (Text_Capacity => 4 * 1024,
Component => wide_Text.item_4k,
Array_type => wide_Text.items_4k,
any_to_Text => to_Text);
function Tokens_8k is new any_Tokens_chr (Text_Capacity => 8 * 1024,
Component => wide_Text.item_8k,
Array_type => wide_Text.items_8k,
any_to_Text => to_Text);
function Tokens_16k is new any_Tokens_chr (Text_Capacity => 16 * 1024,
Component => wide_Text.item_16k,
Array_type => wide_Text.items_16k,
any_to_Text => to_Text);
function Tokens_32k is new any_Tokens_chr (Text_Capacity => 32 * 1024,
Component => wide_Text.item_32k,
Array_type => wide_Text.items_32k,
any_to_Text => to_Text);
function Tokens_64k is new any_Tokens_chr (Text_Capacity => 64 * 1024,
Component => wide_Text.item_64k,
Array_type => wide_Text.items_64k,
any_to_Text => to_Text);
function Tokens_256k is new any_Tokens_chr (Text_Capacity => 256 * 1024,
Component => wide_Text.item_256k,
Array_type => wide_Text.items_256k,
any_to_Text => to_Text);
function Tokens_128k is new any_Tokens_chr (Text_Capacity => 128 * 1024,
Component => wide_Text.item_128k,
Array_type => wide_Text.items_128k,
any_to_Text => to_Text);
function Tokens_512k is new any_Tokens_chr (Text_Capacity => 512,
Component => wide_Text.item_512k,
Array_type => wide_Text.items_512k,
any_to_Text => to_Text);
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_1 renames Tokens_1;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_2 renames Tokens_2;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_4 renames Tokens_4;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_8 renames Tokens_8;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_16 renames Tokens_16;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_32 renames Tokens_32;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_64 renames Tokens_64;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_128 renames Tokens_128;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_256 renames Tokens_256;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_512 renames Tokens_512;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_1k renames Tokens_1k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_2k renames Tokens_2k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_4k renames Tokens_4k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_8k renames Tokens_8k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_16k renames Tokens_16k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_32k renames Tokens_32k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_64k renames Tokens_64k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_128k renames Tokens_128k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_256k renames Tokens_256k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_512k renames Tokens_512k;
-------------------
-- String Delimiter
--
generic
Text_Capacity : Positive;
type Component is private;
type Array_type is array (Positive range <>) of Component;
with function any_to_Text (From : in wide_String; Capacity : in Natural;
Trim : in Boolean := False) return Component;
function any_Tokens_str (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Array_type;
function any_Tokens_str (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Array_type
is
use wide_Text.Cursor;
mySelf : aliased Item := Self;
Cursor : wide_Text.Cursor.item := First (mySelf'Access);
Count : Natural := 0;
the_Tokens : Array_type (1 .. max_Tokens);
begin
while Cursor.has_Element
loop
Count := Count + 1;
the_Tokens (Count) := any_to_Text (Cursor.next_Token (Delimiter),
capacity => Text_Capacity,
trim => Trim);
end loop;
return the_Tokens (1 .. Count);
end any_Tokens_Str;
function Tokens_1 is new any_Tokens_str (Text_Capacity => 1,
Component => wide_Text.item_1,
Array_type => wide_Text.items_1,
any_to_Text => to_Text);
function Tokens_2 is new any_Tokens_str (Text_Capacity => 2,
Component => wide_Text.item_2,
Array_type => wide_Text.items_2,
any_to_Text => to_Text);
function Tokens_4 is new any_Tokens_str (Text_Capacity => 4,
Component => wide_Text.item_4,
Array_type => wide_Text.items_4,
any_to_Text => to_Text);
function Tokens_8 is new any_Tokens_str (Text_Capacity => 8,
Component => wide_Text.item_8,
Array_type => wide_Text.items_8,
any_to_Text => to_Text);
function Tokens_16 is new any_Tokens_str (Text_Capacity => 16,
Component => wide_Text.item_16,
Array_type => wide_Text.items_16,
any_to_Text => to_Text);
function Tokens_32 is new any_Tokens_str (Text_Capacity => 32,
Component => wide_Text.item_32,
Array_type => wide_Text.items_32,
any_to_Text => to_Text);
function Tokens_64 is new any_Tokens_str (Text_Capacity => 64,
Component => wide_Text.item_64,
Array_type => wide_Text.items_64,
any_to_Text => to_Text);
function Tokens_128 is new any_Tokens_str (Text_Capacity => 128,
Component => wide_Text.item_128,
Array_type => wide_Text.items_128,
any_to_Text => to_Text);
function Tokens_256 is new any_Tokens_str (Text_Capacity => 256,
Component => wide_Text.item_256,
Array_type => wide_Text.items_256,
any_to_Text => to_Text);
function Tokens_512 is new any_Tokens_str (Text_Capacity => 512,
Component => wide_Text.item_512,
Array_type => wide_Text.items_512,
any_to_Text => to_Text);
function Tokens_1k is new any_Tokens_str (Text_Capacity => 1024,
Component => wide_Text.item_1k,
Array_type => wide_Text.items_1k,
any_to_Text => to_Text);
function Tokens_2k is new any_Tokens_str (Text_Capacity => 2 * 1024,
Component => wide_Text.item_2k,
Array_type => wide_Text.items_2k,
any_to_Text => to_Text);
function Tokens_4k is new any_Tokens_str (Text_Capacity => 4 * 1024,
Component => wide_Text.item_4k,
Array_type => wide_Text.items_4k,
any_to_Text => to_Text);
function Tokens_8k is new any_Tokens_str (Text_Capacity => 8 * 1024,
Component => wide_Text.item_8k,
Array_type => wide_Text.items_8k,
any_to_Text => to_Text);
function Tokens_16k is new any_Tokens_str (Text_Capacity => 16 * 1024,
Component => wide_Text.item_16k,
Array_type => wide_Text.items_16k,
any_to_Text => to_Text);
function Tokens_32k is new any_Tokens_str (Text_Capacity => 32 * 1024,
Component => wide_Text.item_32k,
Array_type => wide_Text.items_32k,
any_to_Text => to_Text);
function Tokens_64k is new any_Tokens_str (Text_Capacity => 64 * 1024,
Component => wide_Text.item_64k,
Array_type => wide_Text.items_64k,
any_to_Text => to_Text);
function Tokens_128k is new any_Tokens_str (Text_Capacity => 128 * 1024,
Component => wide_Text.item_128k,
Array_type => wide_Text.items_128k,
any_to_Text => to_Text);
function Tokens_256k is new any_Tokens_str (Text_Capacity => 256 * 1024,
Component => wide_Text.item_256k,
Array_type => wide_Text.items_256k,
any_to_Text => to_Text);
function Tokens_512k is new any_Tokens_str (Text_Capacity => 512 * 1024,
Component => wide_Text.item_512k,
Array_type => wide_Text.items_512k,
any_to_Text => to_Text);
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_1 renames Tokens_1;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_2 renames Tokens_2;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_4 renames Tokens_4;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_8 renames Tokens_8;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_16 renames Tokens_16;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_32 renames Tokens_32;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_64 renames Tokens_64;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_128 renames Tokens_128;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_256 renames Tokens_256;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_512 renames Tokens_512;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_1k renames Tokens_1k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_2k renames Tokens_2k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_4k renames Tokens_4k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_8k renames Tokens_8k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_16k renames Tokens_16k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_32k renames Tokens_32k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_64k renames Tokens_64k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_128k renames Tokens_128k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_256k renames Tokens_256k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_512k renames Tokens_512k;
end lace.wide_Text.all_Tokens;

View File

@@ -0,0 +1,141 @@
package lace.wide_Text.all_Tokens
--
-- Some of these functions require a very large stack size.
-- If a Storage_Error is raised, try setting stack size to 'unlimited'.
--
-- $ ulimit -s unlimited
--
is
default_Max : constant := 8 * 1024;
stack_Error : exception;
----------------------
-- Character Delimiter
--
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_1;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_2;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_4;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_8;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_16;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_32;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_64;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_128;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_256;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_512;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_1k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_2k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_4k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_8k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_16k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_32k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_64k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_128k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_256k;
function Tokens (Self : in Item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_512k;
-------------------
-- String Delimiter
--
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_1;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_2;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_4;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_8;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_16;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_32;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_64;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_128;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_256;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_512;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_1k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_2k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_4k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_8k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_16k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_32k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_64k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_128k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_256k;
function Tokens (Self : in Item; Delimiter : in wide_String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return wide_Text.items_512k;
end lace.wide_Text.all_Tokens;

View File

@@ -0,0 +1,305 @@
with
ada.Characters.wide_latin_1,
ada.wide_Characters.handling,
ada.Strings.wide_fixed,
ada.Strings.wide_Maps.wide_Constants;
-- with ada.text_IO; use ada.Text_IO;
package body lace.wide_Text.Cursor
is
use ada.Strings;
Integer_Numerals : constant wide_Maps.wide_Character_Set := wide_Maps.to_Set ("+-0123456789");
Float_Numerals : constant wide_Maps.wide_Character_Set := wide_Maps.to_Set ("+-0123456789.");
--------
-- Forge
--
function First (of_Text : access constant wide_Text.item) return Cursor.item
is
the_Cursor : constant Cursor.item := (of_Text.all'unchecked_Access, 1);
begin
return the_Cursor;
end First;
-------------
-- Attributes
--
function at_End (Self : in Item) return Boolean
is
begin
return Self.Current = 0;
end at_End;
function has_Element (Self : in Item) return Boolean
is
begin
return not at_End (Self)
and Self.Current <= Self.Target.Length;
end has_Element;
procedure advance (Self : in out Item; Delimiter : in wide_String := " ";
Repeat : in Natural := 0;
skip_Delimiter : in Boolean := True;
match_Case : in Boolean := True)
is
begin
for Count in 1 .. Repeat + 1
loop
declare
use ada.wide_Characters.handling;
delimiter_Position : Natural;
begin
if match_Case
then
delimiter_Position := wide_fixed.Index (Self.Target.Data (1 .. Self.Target.Length),
Delimiter,
From => Self.Current);
else
delimiter_Position := wide_fixed.Index (to_Lower (Self.Target.Data (1 .. Self.Target.Length)),
to_Lower (Delimiter),
From => Self.Current);
end if;
if delimiter_Position = 0
then
Self.Current := 0;
return;
else
if skip_Delimiter
then
Self.Current := delimiter_Position + Delimiter'Length;
elsif Count = Repeat + 1
then
Self.Current := delimiter_Position;
else
Self.Current := delimiter_Position + Delimiter'Length - 1;
end if;
end if;
end;
end loop;
exception
when constraint_Error =>
raise at_end_Error;
end advance;
procedure skip_White (Self : in out Item)
is
begin
while has_Element (Self)
and then ( Self.Target.Data (Self.Current) = ' '
or Self.Target.Data (Self.Current) = ada.Characters.wide_Latin_1.LF
or Self.Target.Data (Self.Current) = ada.Characters.wide_Latin_1.HT)
loop
Self.Current := Self.Current + 1;
end loop;
end skip_White;
procedure skip_Line (Self : in out Item)
is
Line : wide_String := next_Line (Self) with Unreferenced;
begin
null;
end skip_Line;
function next_Token (Self : in out Item;
Delimiter : in wide_Character := ' ';
Trim : in Boolean := False) return wide_String
is
begin
return next_Token (Self, "" & Delimiter, Trim);
end next_Token;
function next_Token (Self : in out item; Delimiter : in wide_String;
match_Case : in Boolean := True;
Trim : in Boolean := False) return wide_String
is
use ada.wide_Characters.handling;
begin
if at_End (Self)
then
raise at_end_Error;
end if;
declare
function get_String return wide_String
is
use ada.Strings.wide_fixed,
ada.Strings.wide_Maps.wide_Constants;
delimiter_Position : constant Natural := (if match_Case then Index (Self.Target.Data (Self.Current .. Self.Target.Length), Delimiter, from => Self.Current)
else Index (Self.Target.Data (Self.Current .. Self.Target.Length), to_Lower (Delimiter), from => Self.Current,
mapping => lower_case_Map));
begin
if delimiter_Position = 0
then
return the_Token : constant wide_String := (if Trim then wide_fixed.Trim (Self.Target.Data (Self.Current .. Self.Target.Length), Both)
else Self.Target.Data (Self.Current .. Self.Target.Length))
do
Self.Current := 0;
end return;
end if;
return the_Token : constant wide_String := (if Trim then wide_fixed.Trim (Self.Target.Data (Self.Current .. delimiter_Position - 1), Both)
else Self.Target.Data (Self.Current .. delimiter_Position - 1))
do
Self.Current := delimiter_Position + Delimiter'Length;
end return;
end get_String;
unslid_String : constant wide_String := get_String;
slid_String : constant wide_String (1 .. unslid_String'Length) := unslid_String;
begin
return slid_String;
end;
end next_Token;
function next_Line (Self : in out Item; Trim : in Boolean := False) return wide_String
is
use ada.Characters;
Token : constant wide_String := next_Token (Self, Delimiter => wide_latin_1.LF,
Trim => Trim);
Pad : constant wide_String := Token; -- (if Token (Token'Last) = latin_1.CR then Token (Token'First .. Token'Last - 1)
-- else Token);
begin
if Trim then return wide_fixed.Trim (Pad, Both);
else return Pad;
end if;
end next_Line;
procedure skip_Token (Self : in out Item; Delimiter : in wide_String := " ";
match_Case : in Boolean := True)
is
ignored_Token : wide_String := Self.next_Token (Delimiter, match_Case);
begin
null; -- No action required.
end skip_Token;
function get_Integer (Self : in out Item) return Integer
is
use ada.Strings.wide_fixed;
Text : wide_String (1 .. Self.Length);
First : Positive;
Last : Natural;
begin
Text := Self.Target.Data (Self.Current .. Self.Target.Length);
find_Token (Text, integer_Numerals, Inside, First, Last);
if Last = 0 then
raise No_Data_Error;
end if;
Self.Current := Self.Current + Last;
return Integer'wide_Value (Text (First .. Last));
end get_Integer;
function get_Integer (Self : in out Item) return long_Integer
is
use ada.Strings.wide_fixed;
Text : wide_String (1 .. Self.Length);
First : Positive;
Last : Natural;
begin
Text := Self.Target.Data (Self.Current .. Self.Target.Length);
find_Token (Text, integer_Numerals, Inside, First, Last);
if Last = 0 then
raise No_Data_Error;
end if;
Self.Current := Self.Current + Last;
return long_Integer'wide_Value (Text (First .. Last));
end get_Integer;
function get_Real (Self : in out Item) return long_Float
is
use ada.Strings.wide_fixed;
Text : wide_String (1 .. Self.Length);
First : Positive;
Last : Natural;
begin
Text := Self.Target.Data (Self.Current .. Self.Target.Length);
find_Token (Text, float_Numerals, Inside, First, Last);
if Last = 0 then
raise No_Data_Error;
end if;
Self.Current := Self.Current + Last;
return long_Float'wide_Value (Text (First .. Last));
end get_Real;
function Length (Self : in Item) return Natural
is
begin
return Self.Target.Length - Self.Current + 1;
end Length;
function peek (Self : in Item; Length : in Natural := Remaining) return wide_String
is
Last : Natural := (if Length = Remaining then Self.Target.Length
else Self.Current + Length - 1);
begin
if at_End (Self)
then
return "";
end if;
Last := Natural'Min (Last,
Self.Target.Length);
return Self.Target.Data (Self.Current .. Last);
end peek;
function peek_Line (Self : in Item) return wide_String
is
C : Cursor.item := Self;
begin
return next_Line (C);
end peek_Line;
end lace.wide_Text.Cursor;

View File

@@ -0,0 +1,81 @@
package lace.wide_Text.Cursor
--
-- Provides a cursor for traversing and interrogating text.
--
is
type Item is tagged private;
-- Forge
--
function First (of_Text : access constant wide_Text.item) return Cursor.item;
-- Attributes
--
function Length (Self : in Item) return Natural;
--
-- Returns the length of the remaining text.
function has_Element (Self : in Item) return Boolean;
function next_Token (Self : in out item; Delimiter : in wide_Character := ' ';
Trim : in Boolean := False) return wide_String;
function next_Token (Self : in out item; Delimiter : in wide_String;
match_Case : in Boolean := True;
Trim : in Boolean := False) return wide_String;
function next_Line (Self : in out item; Trim : in Boolean := False) return wide_String;
procedure skip_Token (Self : in out Item; Delimiter : in wide_String := " ";
match_Case : in Boolean := True);
procedure skip_White (Self : in out Item);
procedure skip_Line (Self : in out Item);
procedure advance (Self : in out Item; Delimiter : in wide_String := " ";
Repeat : in Natural := 0;
skip_Delimiter : in Boolean := True;
match_Case : in Boolean := True);
--
-- Search begins at the cursors current position.
-- Advances to the position immediately after Delimiter.
-- Sets Iterator to 0 if Delimiter is not found.
-- Search is repeated 'Repeat' times.
function get_Integer (Self : in out Item) return Integer;
function get_Integer (Self : in out Item) return long_Integer;
--
-- Skips whitespace and reads the next legal 'integer' value.
-- Cursor is positioned at the next character following the integer.
-- Raises no_data_Error if no legal integer exists.
function get_Real (Self : in out Item) return long_Float;
--
-- Skips whitespace and reads the next legal 'real' value.
-- Cursor is positioned at the next character following the real.
-- Raises no_data_Error if no legal real exists.
Remaining : constant Natural;
function peek (Self : in Item; Length : in Natural := Remaining) return wide_String;
function peek_Line (Self : in Item) return wide_String;
at_end_Error : exception;
no_data_Error : exception;
private
type Item is tagged
record
Target : access constant wide_Text.item;
Current : Natural := 0;
end record;
Remaining : constant Natural := Natural'Last;
end lace.wide_Text.Cursor;

View File

@@ -0,0 +1,466 @@
with
ada.Characters.wide_latin_1,
ada.Directories,
ada.Direct_IO,
ada.wide_Text_IO;
package body lace.wide_Text.forge
is
--------
-- Files
--
function to_String (Filename : in forge.Filename) return wide_String
is
use ada.Characters,
ada.Directories;
Length : constant Natural := Natural (Size (String (Filename)));
subtype sized_String is wide_String (1 .. Length);
package my_IO is new ada.Direct_IO (sized_String);
use my_IO;
the_File : my_IO.File_type;
Pad : sized_String;
Result : sized_String;
i : Natural := 0;
begin
open (the_File, in_File, String (Filename));
read (the_File, Pad);
close (the_File);
for Each of Pad
loop
if Each /= wide_latin_1.CR
then
i := i + 1;
Result (i) := Each;
end if;
end loop;
return Result (1 .. i);
end to_String;
function to_Text (Filename : in forge.Filename) return Item
is
begin
return to_Text (to_String (Filename));
end to_Text;
procedure store (Filename : in forge.Filename; the_String : in wide_String)
is
use ada.wide_Text_IO;
File : File_type;
begin
create (File, out_File, String (Filename));
put (File, the_String);
close (File);
end store;
--------------
-- Stock Items
--
function to_Text_1 (From : in wide_String) return Item_1
is
begin
return to_Text (From, capacity => 1);
end to_Text_1;
function to_Text_1 (From : in wide_Text.item) return Item_1
is
begin
return to_Text (to_String (From), capacity => 1);
end to_Text_1;
function to_Text_2 (From : in wide_String) return Item_2
is
begin
return to_Text (From, capacity => 2);
end to_Text_2;
function to_Text_2 (From : in wide_Text.item) return Item_2
is
begin
return to_Text (to_String (From), capacity => 2);
end to_Text_2;
function to_Text_4 (From : in wide_String) return Item_4
is
begin
return to_Text (From, capacity => 4);
end to_Text_4;
function to_Text_4 (From : in wide_Text.item) return Item_4
is
begin
return to_Text (to_String (From), capacity => 4);
end to_Text_4;
function to_Text_8 (From : in wide_String) return Item_8
is
begin
return to_Text (From, capacity => 8);
end to_Text_8;
function to_Text_8 (From : in wide_Text.item) return Item_8
is
begin
return to_Text (to_String (From), capacity => 8);
end to_Text_8;
function to_Text_16 (From : in wide_String) return Item_16
is
begin
return to_Text (From, capacity => 16);
end to_Text_16;
function to_Text_16 (From : in wide_Text.item) return Item_16
is
begin
return to_Text (to_String (From), capacity => 16);
end to_Text_16;
function to_Text_32 (From : in wide_String) return Item_32
is
begin
return to_Text (From, capacity => 32);
end to_Text_32;
function to_Text_32 (From : in wide_Text.item) return Item_32
is
begin
return to_Text (to_String (From), capacity => 32);
end to_Text_32;
function to_Text_64 (From : in wide_String) return Item_64
is
begin
return to_Text (From, capacity => 64);
end to_Text_64;
function to_Text_64 (From : in wide_Text.item) return Item_64
is
begin
return to_Text (to_String (From), capacity => 64);
end to_Text_64;
function to_Text_128 (From : in wide_String) return Item_128
is
begin
return to_Text (From, capacity => 128);
end to_Text_128;
function to_Text_128 (From : in wide_Text.item) return Item_128
is
begin
return to_Text (to_String (From), capacity => 128);
end to_Text_128;
function to_Text_256 (From : in wide_String) return Item_256
is
begin
return to_Text (From, capacity => 256);
end to_Text_256;
function to_Text_256 (From : in wide_Text.item) return Item_256
is
begin
return to_Text (to_String (From), capacity => 256);
end to_Text_256;
function to_Text_512 (From : in wide_String) return Item_512
is
begin
return to_Text (From, capacity => 512);
end to_Text_512;
function to_Text_512 (From : in wide_Text.item) return Item_512
is
begin
return to_Text (to_String (From), capacity => 512);
end to_Text_512;
function to_Text_1k (From : in wide_String) return Item_1k
is
begin
return to_Text (From, capacity => 1024);
end to_Text_1k;
function to_Text_1k (From : in wide_Text.item) return Item_1k
is
begin
return to_Text (to_String (From), capacity => 1024);
end to_Text_1k;
function to_Text_2k (From : in wide_String) return Item_2k
is
begin
return to_Text (From, capacity => 2 * 1024);
end to_Text_2k;
function to_Text_2k (From : in wide_Text.item) return Item_2k
is
begin
return to_Text (to_String (From), capacity => 2 * 1024);
end to_Text_2k;
function to_Text_4k (From : in wide_String) return Item_4k
is
begin
return to_Text (From, capacity => 4 * 1024);
end to_Text_4k;
function to_Text_4k (From : in wide_Text.item) return Item_4k
is
begin
return to_Text (to_String (From), capacity => 4 * 1024);
end to_Text_4k;
function to_Text_8k (From : in wide_String) return Item_8k
is
begin
return to_Text (From, capacity => 8 * 1024);
end to_Text_8k;
function to_Text_8k (From : in wide_Text.item) return Item_8k
is
begin
return to_Text (to_String (From), capacity => 8 * 1024);
end to_Text_8k;
function to_Text_16k (From : in wide_String) return Item_16k
is
begin
return to_Text (From, capacity => 16 * 1024);
end to_Text_16k;
function to_Text_16k (From : in wide_Text.item) return Item_16k
is
begin
return to_Text (to_String (From), capacity => 16 * 1024);
end to_Text_16k;
function to_Text_32k (From : in wide_String) return Item_32k
is
begin
return to_Text (From, capacity => 32 * 1024);
end to_Text_32k;
function to_Text_32k (From : in wide_Text.item) return Item_32k
is
begin
return to_Text (to_String (From), capacity => 32 * 1024);
end to_Text_32k;
function to_Text_64k (From : in wide_String) return Item_64k
is
begin
return to_Text (From, capacity => 64 * 1024);
end to_Text_64k;
function to_Text_64k (From : in wide_Text.item) return Item_64k
is
begin
return to_Text (to_String (From), capacity => 64 * 1024);
end to_Text_64k;
function to_Text_128k (From : in wide_String) return Item_128k
is
begin
return to_Text (From, capacity => 128 * 1024);
end to_Text_128k;
function to_Text_128k (From : in wide_Text.item) return Item_128k
is
begin
return to_Text (to_String (From), capacity => 128 * 1024);
end to_Text_128k;
function to_Text_256k (From : in wide_String) return Item_256k
is
begin
return to_Text (From, capacity => 256 * 1024);
end to_Text_256k;
function to_Text_256k (From : in wide_Text.item) return Item_256k
is
begin
return to_Text (to_String (From), capacity => 256 * 1024);
end to_Text_256k;
function to_Text_512k (From : in wide_String) return Item_512k
is
begin
return to_Text (From, capacity => 512 * 1024);
end to_Text_512k;
function to_Text_512k (From : in wide_Text.item) return Item_512k
is
begin
return to_Text (to_String (From), capacity => 512 * 1024);
end to_Text_512k;
function to_Text_1m (From : in wide_String) return Item_1m
is
begin
return to_Text (From, capacity => 1024 * 1024);
end to_Text_1m;
function to_Text_1m (From : in wide_Text.item) return Item_1m
is
begin
return to_Text (to_String (From), capacity => 1024 * 1024);
end to_Text_1m;
function to_Text_2m (From : in wide_String) return Item_2m
is
begin
return to_Text (From, capacity => 2 * 1024 * 1024);
end to_Text_2m;
function to_Text_2m (From : in wide_Text.item) return Item_2m
is
begin
return to_Text (to_String (From), capacity => 2 * 1024 * 1024);
end to_Text_2m;
function to_Text_4m (From : in wide_String) return Item_4m
is
begin
return to_Text (From, capacity => 4 * 1024 * 1024);
end to_Text_4m;
function to_Text_4m (From : in wide_Text.item) return Item_4m
is
begin
return to_Text (to_String (From), capacity => 4 * 1024 * 1024);
end to_Text_4m;
function to_Text_8m (From : in wide_String) return Item_8m
is
begin
return to_Text (From, capacity => 8 * 1024 * 1024);
end to_Text_8m;
function to_Text_8m (From : in wide_Text.item) return Item_8m
is
begin
return to_Text (to_String (From), capacity => 8 * 1024 * 1024);
end to_Text_8m;
function to_Text_16m (From : in wide_String) return Item_16m
is
begin
return to_Text (From, capacity => 16 * 1024 * 1024);
end to_Text_16m;
function to_Text_16m (From : in wide_Text.item) return Item_16m
is
begin
return to_Text (to_String (From), capacity => 16 * 1024 * 1024);
end to_Text_16m;
function to_Text_32m (From : in wide_String) return Item_32m
is
begin
return to_Text (From, capacity => 32 * 1024 * 1024);
end to_Text_32m;
function to_Text_32m (From : in wide_Text.item) return Item_32m
is
begin
return to_Text (to_String (From), capacity => 32 * 1024 * 1024);
end to_Text_32m;
function to_Text_64m (From : in wide_String) return Item_64m
is
begin
return to_Text (From, capacity => 64 * 1024 * 1024);
end to_Text_64m;
function to_Text_64m (From : in wide_Text.item) return Item_64m
is
begin
return to_Text (to_String (From), capacity => 64 * 1024 * 1024);
end to_Text_64m;
function to_Text_128m (From : in wide_String) return Item_128m
is
begin
return to_Text (From, capacity => 128 * 1024 * 1024);
end to_Text_128m;
function to_Text_128m (From : in wide_Text.item) return Item_128m
is
begin
return to_Text (to_String (From), capacity => 128 * 1024 * 1024);
end to_Text_128m;
function to_Text_256m (From : in wide_String) return Item_256m
is
begin
return to_Text (From, capacity => 256 * 1024 * 1024);
end to_Text_256m;
function to_Text_256m (From : in wide_Text.item) return Item_256m
is
begin
return to_Text (to_String (From), capacity => 256 * 1024 * 1024);
end to_Text_256m;
function to_Text_512m (From : in wide_String) return Item_512m
is
begin
return to_Text (From, capacity => 512 * 1024 * 1024);
end to_Text_512m;
function to_Text_512m (From : in wide_Text.item) return Item_512m
is
begin
return to_Text (to_String (From), capacity => 512 * 1024 * 1024);
end to_Text_512m;
end lace.wide_Text.forge;

View File

@@ -0,0 +1,113 @@
package lace.wide_Text.forge
--
-- Provides constructors for wide Text.
--
is
--------
-- Files
--
type Filename is new String;
function to_String (Filename : in forge.Filename) return wide_String; -- Converts 'CR & LF' to 'LF' at the end of a line.
function to_Text (Filename : in forge.Filename) return Item; -- Converts 'CR & LF' to 'LF' at the end of a line.
procedure store (Filename : in forge.Filename; the_String : in wide_String); -- TODO: Should this *really* be here ?
--------------
-- Stock Items
--
function to_Text_1 (From : in wide_String) return Item_1;
function to_Text_1 (From : in wide_Text.item) return Item_1;
function to_Text_2 (From : in wide_String) return Item_2;
function to_Text_2 (From : in wide_Text.item) return Item_2;
function to_Text_4 (From : in wide_String) return Item_4;
function to_Text_4 (From : in wide_Text.item) return Item_4;
function to_Text_8 (From : in wide_String) return Item_8;
function to_Text_8 (From : in wide_Text.item) return Item_8;
function to_Text_16 (From : in wide_String) return Item_16;
function to_Text_16 (From : in wide_Text.item) return Item_16;
function to_Text_32 (From : in wide_String) return Item_32;
function to_Text_32 (From : in wide_Text.item) return Item_32;
function to_Text_64 (From : in wide_String) return Item_64;
function to_Text_64 (From : in wide_Text.item) return Item_64;
function to_Text_128 (From : in wide_String) return Item_128;
function to_Text_128 (From : in wide_Text.item) return Item_128;
function to_Text_256 (From : in wide_String) return Item_256;
function to_Text_256 (From : in wide_Text.item) return Item_256;
function to_Text_512 (From : in wide_String) return Item_512;
function to_Text_512 (From : in wide_Text.item) return Item_512;
function to_Text_1k (From : in wide_String) return Item_1k;
function to_Text_1k (From : in wide_Text.item) return Item_1k;
function to_Text_2k (From : in wide_String) return Item_2k;
function to_Text_2k (From : in wide_Text.item) return Item_2k;
function to_Text_4k (From : in wide_String) return Item_4k;
function to_Text_4k (From : in wide_Text.item) return Item_4k;
function to_Text_8k (From : in wide_String) return Item_8k;
function to_Text_8k (From : in wide_Text.item) return Item_8k;
function to_Text_16k (From : in wide_String) return Item_16k;
function to_Text_16k (From : in wide_Text.item) return Item_16k;
function to_Text_32k (From : in wide_String) return Item_32k;
function to_Text_32k (From : in wide_Text.item) return Item_32k;
function to_Text_64k (From : in wide_String) return Item_64k;
function to_Text_64k (From : in wide_Text.item) return Item_64k;
function to_Text_128k (From : in wide_String) return Item_128k;
function to_Text_128k (From : in wide_Text.item) return Item_128k;
function to_Text_256k (From : in wide_String) return Item_256k;
function to_Text_256k (From : in wide_Text.item) return Item_256k;
function to_Text_512k (From : in wide_String) return Item_512k;
function to_Text_512k (From : in wide_Text.item) return Item_512k;
function to_Text_1m (From : in wide_String) return Item_1m;
function to_Text_1m (From : in wide_Text.item) return Item_1m;
function to_Text_2m (From : in wide_String) return Item_2m;
function to_Text_2m (From : in wide_Text.item) return Item_2m;
function to_Text_4m (From : in wide_String) return Item_4m;
function to_Text_4m (From : in wide_Text.item) return Item_4m;
function to_Text_8m (From : in wide_String) return Item_8m;
function to_Text_8m (From : in wide_Text.item) return Item_8m;
function to_Text_16m (From : in wide_String) return Item_16m;
function to_Text_16m (From : in wide_Text.item) return Item_16m;
function to_Text_32m (From : in wide_String) return Item_32m;
function to_Text_32m (From : in wide_Text.item) return Item_32m;
function to_Text_64m (From : in wide_String) return Item_64m;
function to_Text_64m (From : in wide_Text.item) return Item_64m;
function to_Text_128m (From : in wide_String) return Item_128m;
function to_Text_128m (From : in wide_Text.item) return Item_128m;
function to_Text_256m (From : in wide_String) return Item_256m;
function to_Text_256m (From : in wide_Text.item) return Item_256m;
function to_Text_512m (From : in wide_String) return Item_512m;
function to_Text_512m (From : in wide_Text.item) return Item_512m;
end lace.wide_Text.forge;

View File

@@ -0,0 +1,132 @@
with
lace.wide_Text.all_Tokens,
ada.Strings.wide_fixed;
package body lace.wide_Text.utility
is
function contains (Self : in wide_Text.item; Pattern : in wide_String) return Boolean
is
use ada.Strings.wide_fixed;
begin
return Index (+Self, Pattern) /= 0;
end contains;
function replace (Self : in wide_Text.item; Pattern : in wide_String;
By : in wide_String) return wide_Text.item
is
Tail_matches_Pattern : Boolean := False;
begin
-- Corner case: Pattern exactly matches Self.
--
if Self.Data (1 .. Self.Length) = Pattern
then
declare
Result : wide_Text.item (Capacity => Natural'Max (By'Length,
Self.Capacity));
begin
Result.Length := By'Length;
Result.Data (1 .. By'Length) := By;
return Result;
end;
end if;
-- Corner case: Pattern exactly matches tail of Self.
--
if Self.Data (Self.Length - Pattern'Length + 1 .. Self.Length) = Pattern
then
Tail_matches_Pattern := True;
end if;
-- General case.
--
declare
use lace.wide_Text.all_Tokens;
the_Tokens : constant wide_Text.items_1k := Tokens (Self, Delimiter => Pattern);
Size : Natural := 0;
begin
for Each of the_Tokens
loop
Size := Size + Each.Length;
end loop;
Size := Size + (the_Tokens'Length - 1) * By'Length;
if Tail_matches_Pattern
then
Size := Size + By'Length;
end if;
declare
First : Positive := 1;
Last : Natural;
Result : wide_Text.item (Capacity => Natural'Max (Size,
Self.Capacity));
begin
for Each of the_Tokens
loop
Last := First + Each.Length - 1;
Result.Data (First .. Last) := Each.Data (1 .. Each.Length);
exit when Last = Size;
First := Last + 1;
Last := First + By'Length - 1;
Result.Data (First .. Last) := By;
First := Last + 1;
end loop;
Result.Length := Size;
return Result;
end;
end;
end replace;
procedure replace (Self : in out Item; Pattern : in wide_String;
By : in wide_String)
is
Result : Item (Self.Capacity);
Cursor : Positive := 1;
First : Natural := 1;
Last : Natural;
begin
loop
Last := First + Pattern'Length - 1;
if Last > Self.Length
then
Last := Self.Length;
end if;
if Self.Data (First .. Last) = Pattern
then
Result.Data (Cursor .. Cursor + By'Length - 1) := By;
Cursor := Cursor + By'Length;
First := Last + 1;
else
Result.Data (Cursor) := Self.Data (First);
Cursor := Cursor + 1;
First := First + 1;
end if;
exit when First > Self.Length;
end loop;
Self.Length := Cursor - 1;
Self.Data (1 .. Self.Length) := Result.Data (1 .. Self.Length);
exception
when constraint_Error =>
raise wide_Text.Error with "'replace' failed ~ insufficient capacity";
end replace;
end lace.wide_Text.utility;

View File

@@ -0,0 +1,21 @@
package lace.wide_Text.utility
--
-- Provides utility subprograms.
--
is
function contains (Self : in wide_Text.item; Pattern : in wide_String) return Boolean;
function replace (Self : in wide_Text.item; Pattern : in wide_String;
By : in wide_String) return wide_Text.item;
--
-- Replaces all occurences of 'Pattern' with 'By'.
-- If the replacement exceeds the capacity of 'Self', the result will be expanded.
procedure replace (Self : in out wide_Text.item; Pattern : in wide_String;
By : in wide_String);
--
-- Replaces all occurences of 'Pattern' with 'By'.
-- 'Text.Error' will be raised if the replacement exceeds the capacity of 'Self'.
end lace.wide_Text.utility;

View File

@@ -0,0 +1,283 @@
with
-- lace.Strings.fixed,
ada.wide_Characters.handling,
ada.Strings.wide_fixed.wide_Hash;
package body lace.wide_Text
is
---------------
-- Construction
--
function to_Text (From : in wide_String;
Trim : in Boolean := False) return Item
is
begin
return to_Text (From,
Capacity => From'Length,
Trim => Trim);
end to_Text;
function to_Text (From : in wide_String;
Capacity : in Natural;
Trim : in Boolean := False) return Item
is
use ada.Strings;
the_String : constant wide_String := (if Trim then wide_fixed.Trim (From, Both)
else From);
Self : Item (Capacity);
begin
Self.Length := the_String'Length;
Self.Data (1 .. Self.Length) := the_String;
return Self;
end to_Text;
function "+" (From : in wide_String) return Item
is
begin
return to_Text (From);
end "+";
-------------
-- Attributes
--
procedure String_is (Self : in out Item;
Now : in wide_String)
is
begin
Self.Data (1 .. Now'Length) := Now;
Self.Length := Now'Length;
end String_is;
function to_String (Self : in Item) return wide_String
is
begin
return Self.Data (1 .. Self.Length);
end to_String;
function is_Empty (Self : in Item) return Boolean
is
begin
return Self.Length = 0;
end is_Empty;
function Length (Self : in Item) return Natural
is
begin
return Self.Length;
end Length;
function Image (Self : in Item) return wide_String
is
begin
return
"(Capacity =>" & Self.Capacity'wide_Image & "," &
" Length =>" & Self.Length 'wide_Image & "," &
" Data => '" & to_String (Self) & "')";
end Image;
function Hashed (Self : in Item) return ada.Containers.Hash_type
is
begin
return ada.Strings.wide_fixed.wide_Hash (Self.Data (1 .. Self.Length));
end Hashed;
overriding
function "=" (Left, Right : in Item) return Boolean
is
begin
if Left.Length /= Right.Length
then
return False;
end if;
return to_String (Left) = to_String (Right);
end "=";
function to_Lowercase (Self : in Item) return Item
is
use ada.wide_Characters.handling;
Result : Item := Self;
begin
for i in 1 .. Self.Length
loop
Result.Data (i) := to_Lower (Self.Data (i));
end loop;
return Result;
end to_Lowercase;
function mono_Spaced (Self : in Item) return Item
is
Result : Item (Self.Capacity);
Prior : wide_Character := 'a';
Length : Natural := 0;
begin
for i in 1 .. Self.Length
loop
if Self.Data (i) = ' '
and Prior = ' '
then
null;
else
Length := Length + 1;
Result.Data (Length) := Self.Data (i);
Prior := Self.Data (i);
end if;
end loop;
Result.Length := Length;
return Result;
end mono_Spaced;
function Element (Self : in Item; Index : in Positive) return wide_Character
is
begin
if Index > Self.Length
then
raise Error with "Index" & Index'Image & " exceeds length of" & Self.Length'Image;
end if;
return Self.Data (Index);
end Element;
procedure append (Self : in out Item; Extra : in wide_String)
is
First : constant Positive := Self.Length + 1;
Last : constant Positive := First + Extra'Length - 1;
begin
Self.Length := Last;
Self.Data (First .. Last) := Extra;
exception
when constraint_Error =>
raise Error with "Appending 'Extra'" & Extra'Length'Image & " characters to 'Text's" & Self.Length'Image & " characters exceeds capacity of" & Self.Capacity'Image & ".";
-- raise Error with "Appending '" & Extra & "' to '" & to_String (Self) & "' exceeds capacity of" & Self.Capacity'wide_Image & ".";
end append;
function delete (Self : in Item; From : Positive;
Through : Natural := Natural'Last) return Item
is
Result : Item (Self.Capacity);
begin
delete (Result, From, Through);
return Result;
end delete;
procedure delete (Self : in out Item; From : Positive;
Through : Natural := Natural'Last)
is
Thru : constant Natural := Natural'Min (Through, Self.Length);
Tail : constant wide_String := Self.Data (Thru + 1 .. Self.Length);
begin
Self.Data (From .. From + Tail'Length - 1) := Tail;
Self.Length := Self.Length
- (Natural'Min (Thru,
Self.Length) - From + 1);
end delete;
-- procedure delete (Self : in out Text.item; From : Positive;
-- Through : Natural := Natural'Last)
-- is
-- Thru : constant Natural := Natural'Min (Through, Self.Length)
-- Tail : constant String := Self.Data (Through + 1 .. Self.Length);
-- begin
-- Self.Data (From .. From + Tail'Length - 1) := Tail;
-- Self.Length := Self.Length
-- - (Natural'Min (Through,
-- Self.Length) - From + 1);
-- end delete;
----------
-- Streams
--
function Item_input (Stream : access ada.Streams.root_Stream_type'Class) return Item
is
Capacity : Positive;
Length : Natural;
begin
Positive'read (Stream, Capacity);
Natural 'read (Stream, Length);
declare
Data : wide_String (1 .. Capacity);
begin
wide_String'read (Stream, Data (1 .. Length));
return (Capacity => Capacity,
Data => Data,
Length => Length);
end;
end Item_input;
procedure Item_output (Stream : access ada.Streams.root_Stream_type'Class;
the_Item : in Item)
is
begin
Positive 'write (Stream, the_Item.Capacity);
Natural 'write (Stream, the_Item.Length);
wide_String'write (Stream, the_Item.Data (1 .. the_Item.Length));
end Item_output;
procedure Write (Stream : access ada.Streams.root_Stream_type'Class;
Self : in Item)
is
begin
Natural 'write (Stream, Self.Length);
wide_String'write (Stream, Self.Data (1 .. Self.Length));
end Write;
procedure Read (Stream : access ada.Streams.root_Stream_type'Class;
Self : out Item)
is
begin
Natural 'read (Stream, Self.Length);
wide_String'read (Stream, Self.Data (1 .. Self.Length));
end Read;
end lace.wide_Text;

View File

@@ -0,0 +1,167 @@
with
ada.Containers,
ada.Streams;
package lace.wide_Text -- with Pure
--
-- Models a string of wide text characters.
--
is
type Item (Capacity : Natural) is private;
function Image (Self : in Item) return wide_String;
Error : exception;
--------------
-- Stock Items
--
subtype Item_1 is Item (Capacity => 1);
subtype Item_2 is Item (Capacity => 2);
subtype Item_4 is Item (Capacity => 4);
subtype Item_8 is Item (Capacity => 8);
subtype Item_16 is Item (Capacity => 16);
subtype Item_32 is Item (Capacity => 32);
subtype Item_64 is Item (Capacity => 64);
subtype Item_128 is Item (Capacity => 128);
subtype Item_256 is Item (Capacity => 256);
subtype Item_512 is Item (Capacity => 512);
subtype Item_1k is Item (Capacity => 1024);
subtype Item_2k is Item (Capacity => 2 * 1024);
subtype Item_4k is Item (Capacity => 4 * 1024);
subtype Item_8k is Item (Capacity => 8 * 1024);
subtype Item_16k is Item (Capacity => 16 * 1024);
subtype Item_32k is Item (Capacity => 32 * 1024);
subtype Item_64k is Item (Capacity => 64 * 1024);
subtype Item_128k is Item (Capacity => 128 * 1024);
subtype Item_256k is Item (Capacity => 256 * 1024);
subtype Item_512k is Item (Capacity => 512 * 1024);
subtype Item_1m is Item (Capacity => 1024 * 1024);
subtype Item_2m is Item (Capacity => 2 * 1024 * 1024);
subtype Item_4m is Item (Capacity => 4 * 1024 * 1024);
subtype Item_8m is Item (Capacity => 8 * 1024 * 1024);
subtype Item_16m is Item (Capacity => 16 * 1024 * 1024);
subtype Item_32m is Item (Capacity => 32 * 1024 * 1024);
subtype Item_64m is Item (Capacity => 64 * 1024 * 1024);
subtype Item_128m is Item (Capacity => 128 * 1024 * 1024);
subtype Item_256m is Item (Capacity => 256 * 1024 * 1024);
subtype Item_512m is Item (Capacity => 512 * 1024 * 1024);
---------------
-- Stock Arrays
--
type Items_1 is array (Positive range <>) of aliased Item_1;
type Items_2 is array (Positive range <>) of aliased Item_2;
type Items_4 is array (Positive range <>) of aliased Item_4;
type Items_8 is array (Positive range <>) of aliased Item_8;
type Items_16 is array (Positive range <>) of aliased Item_16;
type Items_32 is array (Positive range <>) of aliased Item_32;
type Items_64 is array (Positive range <>) of aliased Item_64;
type Items_128 is array (Positive range <>) of aliased Item_128;
type Items_256 is array (Positive range <>) of aliased Item_256;
type Items_512 is array (Positive range <>) of aliased Item_512;
type Items_1k is array (Positive range <>) of aliased Item_1k;
type Items_2k is array (Positive range <>) of aliased Item_2k;
type Items_4k is array (Positive range <>) of aliased Item_4k;
type Items_8k is array (Positive range <>) of aliased Item_8k;
type Items_16k is array (Positive range <>) of aliased Item_16k;
type Items_32k is array (Positive range <>) of aliased Item_32k;
type Items_64k is array (Positive range <>) of aliased Item_64k;
type Items_128k is array (Positive range <>) of aliased Item_128k;
type Items_256k is array (Positive range <>) of aliased Item_256k;
type Items_512k is array (Positive range <>) of aliased Item_512k;
type Items_1m is array (Positive range <>) of aliased Item_1m;
type Items_2m is array (Positive range <>) of aliased Item_2m;
type Items_4m is array (Positive range <>) of aliased Item_4m;
type Items_8m is array (Positive range <>) of aliased Item_8m;
type Items_16m is array (Positive range <>) of aliased Item_16m;
type Items_32m is array (Positive range <>) of aliased Item_32m;
type Items_64m is array (Positive range <>) of aliased Item_64m;
type Items_128m is array (Positive range <>) of aliased Item_128m;
type Items_256m is array (Positive range <>) of aliased Item_256m;
type Items_512m is array (Positive range <>) of aliased Item_512m;
---------------
-- Construction
--
function to_Text (From : in wide_String;
Trim : in Boolean := False) return Item;
function to_Text (From : in wide_String;
Capacity : in Natural;
Trim : in Boolean := False) return Item;
function "+" (From : in wide_String) return Item;
-------------
-- Attributes
--
procedure String_is (Self : in out Item; Now : in wide_String);
function to_String (Self : in Item) return wide_String;
function "+" (Self : in Item) return wide_String renames to_String;
function is_Empty (Self : in Item) return Boolean;
function Length (Self : in Item) return Natural;
function Hashed (Self : in Item) return ada.Containers.Hash_type;
overriding
function "=" (Left, Right : in Item) return Boolean;
function to_Lowercase (Self : in Item) return Item;
function mono_Spaced (Self : in Item) return Item;
function Element (Self : in Item; Index : in Positive) return wide_Character;
procedure append (Self : in out Item; Extra : in wide_String);
--
-- Raises an Error if capacity is exceeded.
function delete (Self : in Item; From : Positive;
Through : Natural := Natural'Last) return Item;
procedure delete (Self : in out Item; From : Positive;
Through : Natural := Natural'Last);
private
type Item (Capacity : Natural) is
record
Length : Natural := 0;
Data : wide_String (1 .. Capacity);
end record;
----------
-- Streams
--
function Item_input (Stream : access ada.Streams.root_Stream_type'Class) return Item;
procedure Item_output (Stream : access ada.Streams.root_Stream_type'Class; the_Item : in Item);
procedure read (Stream : access ada.Streams.root_Stream_type'Class; Self : out Item);
procedure write (Stream : access ada.Streams.root_Stream_type'Class; Self : in Item);
for Item'input use Item_input;
for Item'output use Item_output;
for Item'write use write;
for Item'read use read;
end lace.wide_Text;