Add initial prototype.

1-base/lace/source/containers/lace-containers-shuffle_vector.adb

@@ -0,0 +1,24 @@
+with
+     ada.Numerics.discrete_Random;
+
+
+procedure lace.Containers.shuffle_Vector (the_Vector : in out vectors.Vector)
+is
+   use type vectors.Index_type;
+begin
+   for i in reverse 2 .. vectors.Index_type (the_Vector.Length)    -- Start from 2, since swapping the
+   loop                                                            -- first element with itself is useless.
+      declare
+         subtype Index is vectors.Index_type range vectors.Index_type'First
+                                                .. vectors.Index_type'First + i - 1;
+
+         package random_Index is new ada.Numerics.discrete_Random (Index);
+         use     random_Index;
+
+         the_Generator : random_Index.Generator;
+      begin
+         the_Vector.swap (Random (the_Generator),
+                          Index'Last);
+      end;
+   end loop;
+end lace.Containers.shuffle_Vector;

1-base/lace/source/containers/lace-containers-shuffle_vector.ads

@@ -0,0 +1,8 @@
+with
+     ada.Containers.Vectors;
+
+
+generic
+   with package Vectors is new ada.Containers.Vectors (<>);
+
+procedure lace.Containers.shuffle_Vector (the_Vector : in out vectors.Vector);

1-base/lace/source/containers/lace-containers.ads

@@ -0,0 +1,12 @@
+with
+     ada.Containers;
+
+
+package lace.Containers
+is
+   pragma Pure;
+
+   subtype Hash_Type  is ada.Containers.Hash_type;
+   subtype Count_Type is ada.Containers.Count_type;
+
+end lace.Containers;

1-base/lace/source/dice/lace-dice-any.adb

@@ -0,0 +1,69 @@
+with
+     ada.Numerics.float_Random;
+
+
+package body lace.Dice.any
+is
+   the_float_Generator : ada.Numerics.float_Random.Generator;
+
+
+
+   procedure Seed_is (Now : Integer)
+   is
+   begin
+      ada.Numerics.float_Random.reset (the_float_Generator,
+                                       Initiator => Now);
+   end Seed_is;
+
+
+
+   --------
+   -- Forge
+   --
+   function to_Dice (Sides    : in Positive := 6;
+                     Rolls    : in Positive := 3;
+                     Modifier : in Integer  := 0) return Dice.any.item
+   is
+   begin
+      return (side_Count => Sides,
+              roll_Count => Rolls,
+              Modifier   => Modifier);
+   end to_Dice;
+
+
+
+   -------------
+   -- Attributes
+   --
+
+   overriding
+   function side_Count (Self : in Item) return Positive
+   is
+   begin
+      return Self.Side_Count;
+   end side_Count;
+
+
+
+   overriding
+   function Roll (Self : in Item) return Natural
+   is
+      use ada.Numerics.float_Random;
+
+      the_Roll : Integer := 0;
+   begin
+      for Each in 1 .. Self.roll_Count
+      loop
+         the_Roll :=   the_Roll
+                     + Integer (  Random (the_float_Generator)
+                                * Float  (Self.side_Count)
+                                + 0.5);
+      end loop;
+
+      return the_Roll + self.Modifier;
+   end Roll;
+
+
+begin
+   ada.Numerics.float_Random.reset (the_float_Generator);
+end lace.Dice.any;

1-base/lace/source/dice/lace-dice-any.ads

@@ -0,0 +1,44 @@
+package lace.Dice.any
+--
+-- provide a model of many sided dice.
+--
+is
+   type Item is new Dice.item with private;
+
+
+
+   procedure Seed_is (Now : Integer);
+   --
+   -- If the seed is not set, a random seed will be used.
+
+
+
+   --------
+   -- Forge
+   --
+   function to_Dice (Sides    : in Positive := 6;
+                     Rolls    : in Positive := 3;
+                     Modifier : in Integer  := 0) return Dice.any.item;
+
+
+
+   -------------
+   -- Attributes
+   --
+   overriding
+   function side_Count (Self : in Item) return Positive;
+
+   overriding
+   function Roll       (Self : in Item) return Natural;
+
+
+
+private
+
+   type Item is new Dice.item with
+      record
+         side_Count : Positive;
+      end record;
+
+end lace.Dice.any;
+

1-base/lace/source/dice/lace-dice-d6.adb

@@ -0,0 +1,70 @@
+
+with
+     ada.Numerics.discrete_Random;
+
+
+package body lace.Dice.d6
+is
+
+   subtype d6_Range  is Positive range 1 .. 6;
+   package d6_Random is new ada.Numerics.discrete_Random (d6_Range);
+
+   the_d6_Generator : d6_Random.Generator;
+
+
+
+   procedure Seed_is (Now : Integer)
+   is
+   begin
+      d6_Random.reset (the_d6_Generator, Initiator => Now);
+   end Seed_is;
+
+
+
+   --------
+   -- Forge
+   --
+
+   function to_Dice (Rolls    : in Positive := 3;
+                     Modifier : in Integer  := 0) return Dice.d6.item
+   is
+   begin
+      return (roll_count => Rolls,
+              modifier   => Modifier);
+   end to_Dice;
+
+
+
+   -------------
+   -- Attributes
+   --
+
+   overriding
+   function  side_Count (Self : in Item) return Positive
+   is
+   begin
+      return 6;
+   end side_Count;
+
+
+
+   overriding
+   function  Roll (Self : in Item) return Natural
+   is
+      use d6_Random;
+
+      the_Roll : Integer := 0;
+   begin
+      for Each in 1 .. self.roll_Count loop
+         the_Roll := the_Roll + Random (the_d6_Generator);
+      end loop;
+
+      return Natural'Max (the_Roll + self.Modifier,
+                          0);
+   end Roll;
+
+
+
+begin
+   d6_Random.reset (the_d6_Generator);
+end lace.Dice.d6;

1-base/lace/source/dice/lace-dice-d6.ads

@@ -0,0 +1,137 @@
+package lace.Dice.d6
+--
+-- Models 6 sided dice.
+--
+is
+   type Item is new Dice.item with private;
+
+
+
+   procedure Seed_is (Now : Integer);
+   --
+   -- If the seed is not set, a random seed will be used.
+
+
+
+   -- Forge
+   --
+
+   function to_Dice (Rolls    : in Positive := 3;
+                     Modifier : in Integer  := 0) return Dice.d6.item;
+
+
+
+   -- Attributes
+   --
+
+   overriding
+   function  side_Count (Self : in Item) return Positive;
+
+   overriding
+   function  Roll       (Self : in Item) return Natural;
+
+
+
+   -- Stock Dice
+   --
+
+   d6x1_less5 : aliased constant d6.Item;
+   d6x1_less4 : aliased constant d6.Item;
+   d6x1_less3 : aliased constant d6.Item;
+   d6x1_less2 : aliased constant d6.Item;
+   d6x1_less1 : aliased constant d6.Item;
+   d6x1       : aliased constant d6.Item;
+   d6x1_plus1 : aliased constant d6.Item;
+   d6x1_plus2 : aliased constant d6.Item;
+
+   d6x2_less1 : aliased constant d6.Item;
+   d6x2       : aliased constant d6.Item;
+   d6x2_plus1 : aliased constant d6.Item;
+   d6x2_plus2 : aliased constant d6.Item;
+
+   d6x3_less1 : aliased constant d6.Item;
+   d6x3       : aliased constant d6.Item;
+   d6x3_plus1 : aliased constant d6.Item;
+   d6x3_plus2 : aliased constant d6.Item;
+
+   d6x4_less1 : aliased constant d6.Item;
+   d6x4       : aliased constant d6.Item;
+   d6x4_plus1 : aliased constant d6.Item;
+   d6x4_plus2 : aliased constant d6.Item;
+
+   d6x5_less1 : aliased constant d6.Item;
+   d6x5       : aliased constant d6.Item;
+   d6x5_plus1 : aliased constant d6.Item;
+   d6x5_plus2 : aliased constant d6.Item;
+
+   d6x6_less1 : aliased constant d6.Item;
+   d6x6       : aliased constant d6.Item;
+   d6x6_plus1 : aliased constant d6.Item;
+   d6x6_plus2 : aliased constant d6.Item;
+
+   d6x7_less1 : aliased constant d6.Item;
+   d6x7       : aliased constant d6.Item;
+   d6x7_plus1 : aliased constant d6.Item;
+   d6x7_plus2 : aliased constant d6.Item;
+
+   d6x8_less1 : aliased constant d6.Item;
+   d6x8       : aliased constant d6.Item;
+   d6x8_plus1 : aliased constant d6.Item;
+   d6x8_plus2 : aliased constant d6.Item;
+
+
+
+private
+
+   type Item is new Dice.item with
+      record
+         null;
+      end record;
+
+
+   d6x1_less5 : aliased constant d6.Item := (roll_count => 1,   modifier => -5);
+   d6x1_less4 : aliased constant d6.Item := (roll_count => 1,   modifier => -4);
+   d6x1_less3 : aliased constant d6.Item := (roll_count => 1,   modifier => -3);
+   d6x1_less2 : aliased constant d6.Item := (roll_count => 1,   modifier => -2);
+   d6x1_less1 : aliased constant d6.Item := (roll_count => 1,   modifier => -1);
+   d6x1       : aliased constant d6.Item := (roll_count => 1,   modifier =>  0);
+   d6x1_plus1 : aliased constant d6.Item := (roll_count => 1,   modifier =>  1);
+   d6x1_plus2 : aliased constant d6.Item := (roll_count => 1,   modifier =>  2);
+
+   d6x2_less1 : aliased constant d6.Item := (roll_count => 2,   modifier => -1);
+   d6x2       : aliased constant d6.Item := (roll_count => 2,   modifier =>  0);
+   d6x2_plus1 : aliased constant d6.Item := (roll_count => 2,   modifier =>  1);
+   d6x2_plus2 : aliased constant d6.Item := (roll_count => 2,   modifier =>  2);
+
+   d6x3_less1 : aliased constant d6.Item := (roll_count => 3,   modifier => -1);
+   d6x3       : aliased constant d6.Item := (roll_count => 3,   modifier =>  0);
+   d6x3_plus1 : aliased constant d6.Item := (roll_count => 3,   modifier =>  1);
+   d6x3_plus2 : aliased constant d6.Item := (roll_count => 3,   modifier =>  2);
+
+   d6x4_less1 : aliased constant d6.Item := (roll_count => 4,   modifier => -1);
+   d6x4       : aliased constant d6.Item := (roll_count => 4,   modifier =>  0);
+   d6x4_plus1 : aliased constant d6.Item := (roll_count => 4,   modifier =>  1);
+   d6x4_plus2 : aliased constant d6.Item := (roll_count => 4,   modifier =>  2);
+
+   d6x5_less1 : aliased constant d6.Item := (roll_count => 5,   modifier => -1);
+   d6x5       : aliased constant d6.Item := (roll_count => 5,   modifier =>  0);
+   d6x5_plus1 : aliased constant d6.Item := (roll_count => 5,   modifier =>  1);
+   d6x5_plus2 : aliased constant d6.Item := (roll_count => 5,   modifier =>  2);
+
+   d6x6_less1 : aliased constant d6.Item := (roll_count => 6,   modifier => -1);
+   d6x6       : aliased constant d6.Item := (roll_count => 6,   modifier =>  0);
+   d6x6_plus1 : aliased constant d6.Item := (roll_count => 6,   modifier =>  1);
+   d6x6_plus2 : aliased constant d6.Item := (roll_count => 6,   modifier =>  2);
+
+   d6x7_less1 : aliased constant d6.Item := (roll_count => 7,   modifier => -1);
+   d6x7       : aliased constant d6.Item := (roll_count => 7,   modifier =>  0);
+   d6x7_plus1 : aliased constant d6.Item := (roll_count => 7,   modifier =>  1);
+   d6x7_plus2 : aliased constant d6.Item := (roll_count => 7,   modifier =>  2);
+
+   d6x8_less1 : aliased constant d6.Item := (roll_count => 8,   modifier => -1);
+   d6x8       : aliased constant d6.Item := (roll_count => 8,   modifier =>  0);
+   d6x8_plus1 : aliased constant d6.Item := (roll_count => 8,   modifier =>  1);
+   d6x8_plus2 : aliased constant d6.Item := (roll_count => 8,   modifier =>  2);
+
+end lace.Dice.d6;
+

1-base/lace/source/dice/lace-dice.adb

@@ -0,0 +1,65 @@
+
+
+
+package body lace.Dice
+is
+
+
+   function Image (Self : in Item'Class) return String
+   is
+      roll_count_Image : constant String := Integer'Image (self.roll_Count);
+
+
+      function side_count_Image  return String
+      is
+      begin
+         if Self.side_Count = 6 then
+            return "";
+         else
+            declare
+               the_Image : constant String := Integer'Image (Self.side_Count);
+            begin
+               return the_Image (the_Image'First + 1 .. the_Image'Last);
+            end;
+         end if;
+      end side_count_Image;
+
+
+      function modifier_Image  return String
+      is
+      begin
+         if self.Modifier = 0 then
+            return "";
+         else
+            declare
+               the_Image : String := integer'Image (self.Modifier);
+            begin
+               if self.Modifier > 0 then
+                  the_Image (the_Image'First) := '+';
+               end if;
+
+               return the_Image;
+            end;
+         end if;
+      end modifier_Image;
+
+
+   begin
+      return   roll_count_Image (roll_count_Image'First + 1 .. roll_count_Image'Last)
+             & "d"
+             & side_count_Image
+             & modifier_Image;
+   end Image;
+
+
+
+   function Extent (Self : in Item'Class) return an_Extent
+   is
+   begin
+      return (min => self.roll_Count                   + self.Modifier,
+              max => self.roll_Count * self.side_Count + self.Modifier);
+   end Extent;
+
+
+end lace.Dice;
+

1-base/lace/source/dice/lace-dice.ads

@@ -0,0 +1,34 @@
+package lace.Dice with Pure
+--
+-- Provides an abstract model of any sided dice.
+--
+is
+   type Item is abstract tagged private;
+
+
+   type an_Extent is
+      record
+         Min, Max : Integer;
+      end record;
+
+
+
+   -- Attributes
+   --
+   function side_Count (Self : in Item)       return Positive is abstract;
+   function Roll       (Self : in Item)       return Natural  is abstract;
+   function Extent     (Self : in Item'Class) return an_Extent;
+   function Image      (Self : in Item'Class) return String;
+
+
+
+private
+
+   type Item is abstract tagged
+      record
+         roll_Count : Positive;
+         Modifier   : Integer;
+      end record;
+
+end lace.Dice;
+

1-base/lace/source/environ/lace-environ-os_commands.adb

@@ -0,0 +1,98 @@
+with
+     shell.Commands,
+
+     gnat.OS_Lib,
+
+     ada.Strings.fixed,
+     ada.Strings.Maps,
+     ada.Characters.latin_1,
+     ada.Exceptions;
+
+package body lace.Environ.OS_Commands
+is
+   use ada.Exceptions;
+
+
+   function Path_to (Command : in String) return Paths.Folder
+   is
+      use Paths;
+   begin
+      return to_Folder (run_OS ("which " & Command));
+   end Path_to;
+
+
+   procedure run_OS (command_Line : in String;
+                     Input        : in String := "")
+   is
+      use Shell;
+   begin
+      Commands.run (command_Line, +Input);
+   exception
+      when E : Commands.command_Error =>
+         raise Error with Exception_Message (E);
+   end run_OS;
+
+
+   function run_OS (command_Line : in String;
+                    Input        : in String  := "";
+                    add_Errors   : in Boolean := True) return String
+   is
+      use Shell,
+          Shell.Commands;
+
+      function trim_LF (Source : in String) return String
+      is
+         use ada.Strings.fixed,
+             ada.Strings.Maps,
+             ada.Characters;
+
+         LF_Set : constant Character_Set := to_Set (Latin_1.LF);
+      begin
+         return trim (Source, LF_Set, LF_Set);
+      end trim_LF;
+
+      Results : constant Command_Results := run (command_Line, +Input);
+      Output  : constant String          := +Output_of (Results);
+   begin
+      if add_Errors
+      then
+         return trim_LF (Output & (+Errors_of (Results)));
+      else
+         return trim_LF (Output);
+      end if;
+
+   exception
+      when E : command_Error =>
+         raise Error with Exception_Message (E);
+   end run_OS;
+
+
+   function run_OS (command_Line : in String;
+                    Input        : in String := "") return Data
+   is
+      use Shell,
+          Shell.Commands;
+      the_Command : Command := Forge.to_Command (command_Line);
+   begin
+      return Output_of (run (The_Command, +Input));
+   exception
+      when E : command_Error =>
+         raise Error with Exception_Message (E);
+   end run_OS;
+
+
+
+   function Executable_on_Path (Executable : Paths.File) return Boolean
+   is
+      use Paths,
+          gnat.OS_Lib;
+
+      File_Path :          String_Access := Locate_Exec_On_Path (+Executable);
+      Found     : constant Boolean       := File_Path /= null;
+   begin
+      free (File_Path);
+      return Found;
+   end Executable_on_Path;
+
+
+end lace.Environ.OS_Commands;

1-base/lace/source/environ/lace-environ-os_commands.ads

@@ -0,0 +1,33 @@
+with
+     lace.Environ.Paths;
+
+package lace.Environ.OS_Commands
+--
+-- Allows running of operating system commands.
+--
+is
+
+   function  Path_to (Command : in String) return Paths.Folder;
+
+   procedure run_OS  (command_Line : in String;
+                      Input        : in String := "");
+   --
+   -- Discards any output. Error is raised when the command fails.
+
+   function  run_OS  (command_Line : in String;
+                      Input        : in String := "") return Data;
+   --
+   -- Returns any output. Error is raised when the command fails.
+
+   function  run_OS  (command_Line : in String;
+                      Input        : in String  := "";
+                      add_Errors   : in Boolean := True) return String;
+   --
+   -- Returns any output. Error output is appended if add_Errors is true.
+
+
+   function Executable_on_Path (Executable : Paths.File) return Boolean;
+   --
+   -- Returns True if the Executable exists on the environment PATH variable.
+
+end lace.Environ.OS_Commands;

1-base/lace/source/environ/lace-environ-paths.ads

@@ -0,0 +1,194 @@
+with
+     ada.Calendar;
+
+private
+with
+     ada.Strings.unbounded,
+     ada.Containers.indefinite_Vectors;
+
+package lace.Environ.Paths
+--
+-- A singleton which models an operating system environment.
+--
+is
+
+   function expand_GLOB (GLOB : in String) return String;
+
+
+   ---------
+   --- Paths
+   --
+   type Path is abstract tagged private;
+
+
+   function  to_String    (Self : in Path'Class) return String;
+   function  "+"          (Self : in Path'Class) return String renames to_String;
+
+   procedure change_Mode  (Self : in Path;   To : in String);
+   procedure change_Owner (Self : in Path;   To : in String);
+   procedure link         (Self : in Path;   To : in Path);
+
+   function  Exists       (Self : in Path) return Boolean;
+   function  modify_Time  (Self : in Path) return ada.Calendar.Time;
+   function  Name         (Self : in Path) return String;
+   function  Simple       (Self : in Path) return String;
+
+   function  is_Folder    (Self : in Path) return Boolean;
+   function  is_File      (Self : in Path) return Boolean;
+   function  is_Special   (Self : in Path) return Boolean;
+
+   function  is_Absolute  (Self : in Path) return Boolean;
+   function  is_Relative  (Self : in Path) return Boolean;
+
+
+   -----------
+   --- Folders
+   --
+   type Folder is new Path with private;
+
+   no_Folder : constant Folder;
+
+   function to_Folder (Name : in String) return Folder;
+   function "+"       (Name : in String) return Folder renames to_Folder;
+
+   function "+" (Left  : in Folder;
+                 Right : in Folder) return Folder;
+
+   function current_Folder return Folder;
+
+
+   procedure  go_to_Folder (Self : in Folder;
+                            Lock : in Boolean := False);                       -- When true, blocks further folder changes until 'unlock_Folder' is called.
+   procedure unlock_Folder;
+
+
+   procedure    rid_Folder (Self : in Folder);
+   procedure   copy_Folder (Self : in Folder;   To : in Folder);
+   procedure   move_Folder (Self : in Folder;   To : in Folder);
+   procedure rename_Folder (Self : in Folder;   To : in Folder);
+   procedure ensure_Folder (Self : in Folder);                                 -- Ensure that the folder exists.
+
+   function  is_Empty       (Self    : in Folder)           return Boolean;
+   function  contents_Count (Self    : in Folder;                              -- Does not include the "." and ".." folders.
+                             Recurse : in Boolean := False) return Natural;
+
+   function  Parent   (Self : in Path'Class)                     return Folder;     -- Returns 'no_Folder' if 'Self' has no parent.
+   function  Relative (Self : in Folder;   To : in Folder'Class) return Folder;
+
+
+   -------------------
+   --- Folder Contexts
+   --
+   type folder_Context is limited private;
+
+   procedure push_Folder (Context     : in out folder_Context;
+                          goto_Folder : in     Folder'Class);
+   --
+   -- Store the current folder and move to the 'goto_Folder'.
+
+   procedure pop_Folder  (Context     : in out folder_Context);
+   --
+   -- Return to the previously pushed folder.
+
+   procedure pop_All     (Context     : in out folder_Context);
+   --
+   -- Return to the initial current folder.
+
+
+   ---------
+   --- Files
+   --
+   type File           is new Path with private;
+   type File_Extension is new String;
+
+   function  to_File (Name : in String) return File;
+   function  "+"     (Name : in String) return File renames to_File;
+
+   function  "+" (Left  : in Folder'Class;
+                  Right : in File  'Class) return File;
+
+   function  "+" (Left  : in File'Class;
+                  Right : in File_Extension) return File;
+
+   function  Extension (Self : in File) return File_Extension;
+
+   procedure save (Self     : in File;
+                   Text     : in String;
+                   Binary   : in Boolean := False);
+
+   procedure save (Self : in File;
+                   Data : in environ.Data);
+
+   function  load (Self : in File) return String;
+   function  load (Self : in File) return Data;
+
+   procedure copy_File  (Self : in File;     To : in File);
+   procedure copy_Files (Named : in String;   To : in Folder);
+   --
+   -- 'Named' can contain an asterix GLOB such as "*" or "*.txt".
+
+   procedure move_File  (Self : in File;     To : in File);
+   procedure move_Files (Named : in String;   To : in Folder);
+   --
+   -- 'Named' can contain an asterix GLOB such as "*" or "*.txt".
+
+   procedure  rid_File  (Self  : in File);
+   procedure  rid_Files (Named : in String);
+   --
+   -- 'Named' can contain an asterix GLOB such as "*" or "*.txt".
+
+   procedure append      (Self : in File;   Text : in String);
+   procedure append_File (Self : in File;   To   : in File);
+   procedure touch       (Self : in File);
+
+   function  Relative      (Self : in File;   To : in Folder'Class) return File;
+   function  rid_Extension (Self : in File)                         return File;
+
+
+   --- Compression
+   --
+   type           compress_Format is (Tar, Tar_Bz2, Tar_Gz, Tar_Xz, Bz2, Gz, Xz);
+   subtype folder_compress_Format is compress_Format range Tar .. Tar_Xz;
+
+   type compress_Level is range 1 .. 9;     -- Higher levels result in higher compression.
+
+   procedure   compress (the_Path   : in Path'Class;
+                         the_Format : in compress_Format := Tar_Xz;
+                         the_Level  : in compress_Level  := 6);
+
+   procedure decompress (Name       : in File);
+
+   function  format_Suffix (Format  : in compress_Format) return String;
+
+
+
+private
+
+   use ada.Strings.unbounded;
+
+   type Path is abstract tagged
+      record
+         Name : unbounded_String;
+      end record;
+
+   type Folder is new Path with null record;
+   type File   is new Path with null record;
+
+
+   no_Folder : constant Folder := (Name => null_unbounded_String);
+
+
+   --- Folder Contexts
+   --
+   use ada.Containers;
+
+   package Folder_Vectors is new indefinite_Vectors (Positive, Folder);
+   subtype Folder_Vector  is     Folder_Vectors.Vector;
+
+   type folder_Context is limited
+      record
+         folder_Stack : Folder_Vector;
+      end record;
+
+
+end lace.Environ.Paths;

1-base/lace/source/environ/lace-environ-users.adb

@@ -0,0 +1,102 @@
+with
+     lace.Environ.OS_Commands,
+
+     posix.user_Database,
+     posix.process_Identification;
+
+package body lace.Environ.Users
+is
+   function "+" (Source : in unbounded_String) return String
+                 renames to_String;
+
+
+
+   function to_User (Name : in String) return User
+   is
+   begin
+      return (Name => to_unbounded_String (Name));
+   end to_User;
+
+
+   function Name (Self : in User) return String
+   is
+   begin
+      return to_String (Self.Name);
+   end Name;
+
+
+   procedure add_User (Self  : in User;
+                       Super : in Boolean := False)
+   is
+      use lace.Environ.OS_Commands;
+   begin
+      if Super
+      then
+         declare
+            Output : constant String := run_OS ("useradd " & (+Self.Name) & " -m -G sudo -G root");
+         begin
+            if Output /= ""
+            then
+               raise Error with Output;
+            end if;
+         end;
+      else
+         declare
+            Output : constant String := run_OS ("useradd " & (+Self.Name) & " -m");
+         begin
+            if Output /= ""
+            then
+               raise Error with Output;
+            end if;
+         end;
+      end if;
+   end add_User;
+
+
+   procedure rid_User (Self : in User)
+   is
+      use lace.Environ.OS_Commands;
+      Output : constant String := run_OS ("userdel -r " & (+Self.Name));
+   begin
+      if Output /= ""
+      then
+         raise Error with Output;
+      end if;
+   end rid_User;
+
+
+   procedure switch_to (Self : in User)
+   is
+      use Posix,
+          posix.User_Database,
+          posix.Process_Identification;
+
+      User_in_DB : constant User_Database_Item := get_User_Database_Item (to_Posix_String (+Self.Name));
+      ID         : constant User_ID            := User_ID_of (User_in_DB);
+   begin
+      set_User_ID (ID);
+   end switch_to;
+
+
+   function current_User return User
+   is
+      use Posix,
+          posix.process_Identification;
+   begin
+      return to_User (to_String (get_Login_Name));
+   end current_User;
+
+
+   function home_Folder (Self : in User := current_User) return Paths.Folder
+   is
+      use Paths,
+          Posix,
+          posix.User_Database;
+
+      User_in_DB : constant User_Database_Item := get_User_Database_Item (to_Posix_String (+Self.Name));
+   begin
+      return to_Folder (to_String (initial_Directory_of (User_in_DB)));
+   end home_Folder;
+
+
+end lace.Environ.Users;

1-base/lace/source/environ/lace-environ-users.ads

@@ -0,0 +1,38 @@
+with
+    lace.Environ.Paths;
+
+private
+with
+     ada.Strings.unbounded;
+
+package lace.Environ.Users
+--
+-- Models operating system users.
+--
+is
+   type User is private;
+
+   function  to_User      (Name : in String) return User;
+   function  "+"          (Name : in String) return User renames to_User;
+
+   function  Name         (Self : in User)                 return String;
+   function  current_User                                  return User;
+   function  home_Folder  (Self : in User := current_User) return Paths.Folder;
+
+   procedure add_User     (Self  : in User;
+                           Super : in Boolean := False);
+   procedure rid_User     (Self  : in User);
+   procedure switch_to    (Self  : in User);
+
+
+
+private
+
+   use ada.Strings.unbounded;
+
+   type User is
+      record
+         Name : unbounded_String;
+      end record;
+
+end lace.Environ.Users;

1-base/lace/source/environ/lace-environ.adb

@@ -0,0 +1,40 @@
+package body lace.Environ
+is
+
+   function to_octal_Mode (Permissions : in permission_Set) return String
+   is
+      function octal_Permissions (Bit_3, Bit_2, Bit_1 : in Boolean) return String
+      is
+      begin
+         if Bit_3 then
+            if Bit_2 then
+               if Bit_1 then   return "7";
+               else            return "6";
+               end if;
+            else
+               if Bit_1 then   return "5";
+               else            return "4";
+               end if;
+            end if;
+         else
+            if Bit_2 then
+               if Bit_1 then   return "3";
+               else            return "2";
+               end if;
+            else
+               if Bit_1 then   return "1";
+               else            return "0";
+               end if;
+            end if;
+         end if;
+      end octal_Permissions;
+
+   begin
+      return
+          octal_Permissions (Permissions (set_User_ID), Permissions (set_Group_ID), False)
+        & octal_Permissions (Permissions (owner_Read),  Permissions (owner_Write),  Permissions (owner_Execute))
+        & octal_Permissions (Permissions (group_Read),  Permissions (group_Write),  Permissions (group_Execute))
+        & octal_Permissions (Permissions (others_Read), Permissions (others_Write), Permissions (others_Execute));
+   end to_octal_Mode;
+
+end lace.Environ;

1-base/lace/source/environ/lace-environ.ads

@@ -0,0 +1,17 @@
+with
+     posix.Permissions,
+     ada.Streams;
+
+package lace.Environ
+--
+-- Models an operating system environment.
+--
+is
+   use posix.Permissions;
+   function to_octal_Mode (Permissions : in Permission_Set) return String;
+
+   subtype Data is ada.Streams.Stream_Element_Array;
+
+   Error : exception;
+
+end lace.Environ;

1-base/lace/source/events/concrete/lace-observer-deferred.adb

@@ -0,0 +1,34 @@
+package body lace.Observer.deferred
+is
+
+   package body Forge
+   is
+      function to_Observer (Name : in Event.observer_Name) return Item
+      is
+      begin
+         return Self : constant Item := (Deferred.item
+                                         with name => to_unbounded_String (Name))
+         do
+            null;
+         end return;
+      end to_Observer;
+
+
+      function new_Observer (Name : in Event.observer_Name) return View
+      is
+         Self : constant View := new Item' (to_Observer (Name));
+      begin
+         return Self;
+      end new_Observer;
+
+   end Forge;
+
+
+   overriding
+   function Name (Self : in Item) return Event.observer_Name
+   is
+   begin
+      return to_String (Self.Name);
+   end Name;
+
+end lace.Observer.deferred;

1-base/lace/source/events/concrete/lace-observer-deferred.ads

@@ -0,0 +1,44 @@
+with
+     lace.make_Observer.deferred,
+     lace.Any;
+
+private
+with
+     ada.Strings.unbounded;
+
+
+package lace.Observer.deferred
+--
+--  Provides a concrete deferred event observer.
+--
+is
+   type Item is limited new Any.limited_item
+                        and Observer   .item with private;
+
+   type View is access all Item'Class;
+
+
+   package Forge
+   is
+      function  to_Observer (Name : in Event.observer_Name) return Item;
+      function new_Observer (Name : in Event.observer_Name) return View;
+   end Forge;
+
+
+   overriding
+   function Name (Self : in Item) return Event.observer_Name;
+
+
+
+private
+   use ada.Strings.unbounded;
+
+   package Observer is new lace.make_Observer (Any.limited_item);
+   package Deferred is new Observer.deferred  (Observer.item);
+
+   type Item is limited new Deferred.item with
+      record
+         Name : unbounded_String;
+      end record;
+
+end lace.Observer.deferred;

1-base/lace/source/events/concrete/lace-observer-instant.adb

@@ -0,0 +1,23 @@
+package body lace.Observer.instant
+is
+   package body Forge
+   is
+      function new_Observer (Name : in Event.observer_Name) return View
+      is
+         Self : constant View := new Item;
+      begin
+         Self.Name := to_unbounded_String (Name);
+         return Self;
+      end new_Observer;
+
+   end Forge;
+
+
+   overriding
+   function Name (Self : in Item) return Event.observer_Name
+   is
+   begin
+      return to_String (Self.Name);
+   end Name;
+
+end lace.Observer.instant;

1-base/lace/source/events/concrete/lace-observer-instant.ads

@@ -0,0 +1,42 @@
+with
+     lace.make_Observer,
+     lace.Any;
+
+private
+with
+     ada.Strings.unbounded;
+
+
+package lace.Observer.instant
+--
+--  Provides a concrete instant event observer.
+--
+is
+   type Item is limited new Any.limited_item
+                        and Observer   .item with private;
+
+   type View is access all Item'Class;
+
+
+   package Forge
+   is
+      function new_Observer (Name : in Event.observer_Name) return View;
+   end Forge;
+
+
+   overriding
+   function Name (Self : in Item) return Event.observer_Name;
+
+
+
+private
+   use ada.Strings.unbounded;
+
+   package Observer is new make_Observer (Any.limited_item);
+
+   type Item is limited new Observer.item with
+      record
+         Name : unbounded_String;
+      end record;
+
+end lace.Observer.instant;

1-base/lace/source/events/concrete/lace-subject-local.adb

@@ -0,0 +1,39 @@
+package body lace.Subject.local
+is
+   package body Forge
+   is
+      function to_Subject (Name : in Event.subject_Name) return Item
+      is
+      begin
+         return Self : Item
+         do
+            Self.Name := to_unbounded_String (Name);
+         end return;
+      end to_Subject;
+
+
+      function new_Subject (Name : in Event.subject_Name) return View
+      is
+         Self : constant View := new Item' (to_Subject (Name));
+      begin
+         return Self;
+      end new_Subject;
+   end Forge;
+
+
+   overriding
+   procedure destroy (Self : in out Item)
+   is
+   begin
+      Subject.destroy (Subject.item (Self));   -- Destroy base class.
+   end destroy;
+
+
+   overriding
+   function Name (Self : in Item) return Event.subject_Name
+   is
+   begin
+      return to_String (Self.Name);
+   end Name;
+
+end lace.Subject.local;

1-base/lace/source/events/concrete/lace-subject-local.ads

@@ -0,0 +1,46 @@
+with
+     lace.make_Subject,
+     lace.Any;
+
+private
+with
+     ada.Strings.unbounded;
+
+
+package lace.Subject.local
+--
+--  Provides a concrete local event Subject.
+--
+is
+   type Item is limited new Any.limited_item
+                        and Subject    .item with private;
+
+   type View is access all Item'Class;
+
+
+   package Forge
+   is
+      function  to_Subject (Name : in Event.subject_Name) return Item;
+      function new_Subject (Name : in Event.subject_Name) return View;
+   end Forge;
+
+   procedure destroy (Self : in out Item);
+
+
+   overriding
+   function Name (Self : in Item) return Event.subject_Name;
+
+
+
+private
+
+   use ada.Strings.unbounded;
+
+   package Subject is new make_Subject (Any.limited_item);
+
+   type Item is limited new Subject.item with
+      record
+         Name : unbounded_String;
+      end record;
+
+end lace.Subject.local;

1-base/lace/source/events/concrete/lace-subject_and_deferred_observer.adb

@@ -0,0 +1,53 @@
+with
+     ada.unchecked_Deallocation;
+
+
+package body lace.Subject_and_deferred_Observer
+is
+   package body Forge
+   is
+      function to_Subject_and_Observer (Name : in String) return Item
+      is
+      begin
+         return Self : Item
+         do
+            Self.Name := to_unbounded_String (Name);
+         end return;
+      end to_Subject_and_Observer;
+
+
+      function new_Subject_and_Observer (Name : in String) return View
+      is
+      begin
+         return new Item' (to_Subject_and_Observer (Name));
+      end new_Subject_and_Observer;
+
+   end Forge;
+
+
+   overriding
+   procedure destroy (Self : in out Item)
+   is
+   begin
+      Deferred.destroy (Deferred.item (Self));   -- Destroy base classes.
+      Subject .destroy (Subject .item (Self));
+   end destroy;
+
+
+   procedure free (Self : in out View)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
+   begin
+      Self.destroy;
+      deallocate (Self);
+   end free;
+
+
+   overriding
+   function Name (Self : in Item) return String
+   is
+   begin
+      return to_String (Self.Name);
+   end Name;
+
+end lace.Subject_and_deferred_Observer;

1-base/lace/source/events/concrete/lace-subject_and_deferred_observer.ads

@@ -0,0 +1,51 @@
+with
+     lace.Subject,
+     lace.Observer,
+     lace.make_Subject,
+     lace.make_Observer.deferred,
+     lace.Any;
+
+private
+with
+     ada.Strings.unbounded;
+
+
+package lace.Subject_and_deferred_Observer
+--
+--  Provides a concrete type for a combined event subject and a deferred observer.
+--
+is
+   type Item is limited new lace.Any.limited_item
+                        and lace.Subject    .item
+                        and lace.Observer   .item with private;
+
+   type View is access all Item'Class;
+
+
+   package Forge
+   is
+      function  to_Subject_and_Observer (Name : in String) return Item;
+      function new_Subject_and_Observer (Name : in String) return View;
+   end Forge;
+
+   procedure destroy (Self : in out Item);
+   procedure free    (Self : in out View);
+
+   overriding
+   function Name (Self : in Item) return String;
+
+
+
+private
+   use ada.Strings.unbounded;
+
+   package Subject  is new make_Subject      (Any.limited_item);
+   package Observer is new make_Observer     (Subject    .item);
+   package Deferred is new Observer.deferred (Observer   .item);
+
+   type Item is limited new Deferred.item with
+      record
+         Name : unbounded_String;
+      end record;
+
+end lace.Subject_and_deferred_Observer;

1-base/lace/source/events/concrete/lace-subject_and_instant_observer.adb

@@ -0,0 +1,24 @@
+package body lace.Subject_and_instant_Observer
+is
+
+   package body Forge
+   is
+      function to_Subject_and_Observer (Name : in String) return Item
+      is
+      begin
+         return Self : Item
+         do
+            Self.Name := to_unbounded_String (Name);
+         end return;
+      end to_Subject_and_Observer;
+   end Forge;
+
+
+   overriding
+   function Name (Self : in Item) return String
+   is
+   begin
+      return to_String (Self.Name);
+   end Name;
+
+end lace.Subject_and_instant_Observer;

1-base/lace/source/events/concrete/lace-subject_and_instant_observer.ads

@@ -0,0 +1,47 @@
+with
+     lace.make_Subject,
+     lace.make_Observer,
+     lace.Any,
+     lace.Subject,
+     lace.Observer;
+
+private
+with
+     ada.Strings.unbounded;
+
+
+package lace.Subject_and_instant_Observer
+--
+--  Provides a concrete type for a combined event subject and an instant observer.
+--
+is
+   type Item is limited new lace.Any.limited_item
+                        and lace.Subject    .item
+                        and lace.Observer   .item with private;
+
+   type View is access all Item'Class;
+
+
+   package Forge
+   is
+      function to_Subject_and_Observer (Name : in String) return Item;
+   end Forge;
+
+
+   overriding
+   function Name (Self : in Item) return String;
+
+
+
+private
+   use ada.Strings.unbounded;
+
+   package Subject  is new make_Subject  (Any.limited_item);
+   package Observer is new make_Observer (Subject    .item);
+
+   type Item is limited new Observer.item with
+      record
+         Name : unbounded_String;
+      end record;
+
+end lace.Subject_and_instant_Observer;

1-base/lace/source/events/interface/lace-observer.adb

@@ -0,0 +1,23 @@
+with
+     lace.Event.Logger;
+
+
+package body lace.Observer
+is
+   the_Logger : Event.Logger.view;
+
+
+   procedure Logger_is (Now : in Event.Logger.view)
+   is
+   begin
+      the_Logger := Now;
+   end Logger_is;
+
+
+   function Logger return Event.Logger.view
+   is
+   begin
+      return the_Logger;
+   end Logger;
+
+end lace.Observer;

1-base/lace/source/events/interface/lace-observer.ads

@@ -0,0 +1,69 @@
+with
+     lace.Event,
+     lace.Response;
+
+limited
+with
+     lace.Event.Logger;
+
+
+package lace.Observer
+--
+--  Provides an interface for an event Observer.
+--
+is
+   pragma remote_Types;
+
+   type Item  is limited interface;
+   type View  is access all Item'Class;
+   type Views is array (Positive range <>) of View;
+
+   type fast_View  is access all Item'Class with Asynchronous;
+   type fast_Views is array (Positive range <>) of fast_View;
+
+
+   -------------
+   -- Attributes
+   --
+
+   function Name (Self : in Item) return event.observer_Name is abstract;
+
+
+   ------------
+   -- Responses
+   --
+
+   procedure add (Self : access Item;   the_Response : in Response.view;
+                                        to_Kind      : in event.Kind;
+                                        from_Subject : in event.subject_Name) is abstract;
+
+   procedure rid (Self : access Item;   the_Response : in Response.view;
+                                        to_Kind      : in event.Kind;
+                                        from_Subject : in event.subject_Name) is abstract;
+
+   procedure relay_responseless_Events
+                 (Self : in out Item;   To : in Observer.view) is abstract;
+
+
+   -------------
+   -- Operations
+   --
+
+   procedure receive (Self : access Item;   the_Event    : in Event.item'Class := event.null_Event;
+                                            from_Subject : in event.subject_Name) is abstract;
+   --
+   -- Accepts an Event from a Subject.
+
+   procedure respond (Self : access Item) is abstract;
+   --
+   -- Performs the Response for (and then removes) each pending Event.
+
+
+   ----------
+   -- Logging
+   --
+
+   procedure Logger_is (Now : in Event.Logger.view);
+   function  Logger    return    Event.Logger.view;
+
+end lace.Observer;

1-base/lace/source/events/interface/lace-response.adb

@@ -0,0 +1,14 @@
+with
+     ada.Tags;
+
+
+package body lace.Response
+is
+
+   function Name (Self : in Item) return String
+   is
+   begin
+      return ada.Tags.expanded_Name (Item'Class (Self)'Tag);
+   end Name;
+
+end lace.Response;

1-base/lace/source/events/interface/lace-response.ads

@@ -0,0 +1,35 @@
+with
+     lace.Event;
+
+
+package lace.Response
+--
+--  Provides a base class for all derived event 'response' classes.
+--
+is
+   pragma remote_Types;
+
+   type Item is abstract tagged limited private;
+   type View is access all Item'class;
+
+
+   -------------
+   -- Attributes
+   --
+
+   function Name (Self : in Item) return String;
+
+
+   -------------
+   -- Operations
+   --
+
+   procedure respond (Self : in out Item;   to_Event : in Event.item'Class) is abstract;
+
+
+
+private
+
+   type Item is abstract tagged limited null record;
+
+end lace.Response;

1-base/lace/source/events/interface/lace-subject.adb

@@ -0,0 +1,23 @@
+with
+     lace.Event.Logger;
+
+
+package body lace.Subject
+is
+   the_Logger : Event.Logger.view;
+
+
+   procedure Logger_is (Now : in Event.Logger.view)
+   is
+   begin
+      the_Logger := Now;
+   end Logger_is;
+
+
+   function Logger return Event.Logger.view
+   is
+   begin
+      return the_Logger;
+   end Logger;
+
+end lace.Subject;

1-base/lace/source/events/interface/lace-subject.ads

@@ -0,0 +1,74 @@
+with
+     lace.Event,
+     lace.Observer;
+
+limited
+with
+     lace.Event.Logger;
+
+
+package lace.Subject
+--
+--  Provides an interface for an event subject.
+--
+is
+   pragma remote_Types;
+
+   type Item  is limited interface;
+   type View  is access all Item'Class;
+   type Views is array (Positive range <>) of View;
+
+   type fast_View  is access all Item'Class with Asynchronous;
+   type fast_Views is array (Positive range <>) of fast_View;
+
+
+   -------------
+   -- Containers
+   --
+
+   type Observer_views is array (Positive range <>) of Observer.view;
+
+
+   -------------
+   -- Attributes
+   --
+
+   function Name (Self : in Item) return Event.subject_Name is abstract;
+
+
+   ------------
+   -- Observers
+   --
+
+   procedure register   (Self : access Item;   the_Observer : in Observer.view;
+                                               of_Kind      : in Event.Kind) is abstract;
+
+   procedure deregister (Self : in out Item;   the_Observer : in Observer.view;
+                                               of_Kind      : in Event.Kind) is abstract;
+
+   function  Observers      (Self : in Item;   of_Kind : in Event.Kind) return Observer_views is abstract;
+   function  observer_Count (Self : in Item)                            return Natural        is abstract;
+
+
+   -------------
+   -- Operations
+   --
+
+   procedure emit (Self : access Item;   the_Event : in Event.item'Class := Event.null_Event) is abstract;
+   --
+   -- Communication errors are ignored.
+
+   function  emit (Self : access Item;   the_Event : in Event.item'Class := Event.null_Event)
+                   return Observer_views is abstract;
+   --
+   -- Observers who cannot be communicated with are returned.
+
+
+   ----------
+   -- Logging
+   --
+
+   procedure Logger_is (Now : in Event.Logger.view);
+   function  Logger       return Event.Logger.view;
+
+end lace.Subject;

1-base/lace/source/events/lace-event.adb

@@ -0,0 +1,13 @@
+with
+     ada.Strings.Hash;
+
+
+package body lace.Event
+is
+   function Hash (the_Kind : in Kind) return ada.Containers.Hash_type
+   is
+   begin
+      return ada.Strings.Hash (String (the_Kind));
+   end Hash;
+
+end lace.Event;

1-base/lace/source/events/lace-event.ads

@@ -0,0 +1,39 @@
+with
+     ada.Containers;
+
+
+package lace.Event
+--
+--  The base class for all derived event types.
+--
+is
+   pragma Pure;
+
+   type Item is tagged null record;
+
+   null_Event : constant Event.item;
+
+
+   subtype  subject_Name is String;
+   subtype observer_Name is String;
+
+
+   procedure destruct (Self : in out Item) is null;
+
+
+   type Kind is new String;
+   --
+   --  Uniquely identifies each derived event class.
+   --
+   --  Each derived event class will have its own Kind.
+   --
+   --  Maps to the extended name of 'ada.Tags.Tag_type' value of each derived
+   --  event class (see 'Conversions' section in 'lace.Event.utility').
+
+   function Hash (the_Kind : in Kind) return ada.Containers.Hash_type;
+
+
+
+private
+   null_Event : constant Event.item := (others => <>);
+end lace.Event;

1-base/lace/source/events/mixin/lace-make_observer.adb

@@ -0,0 +1,243 @@
+with
+     lace.Event.Logger,
+     lace.Event.utility,
+
+     ada.unchecked_Conversion,
+     ada.unchecked_Deallocation;
+
+
+package body lace.make_Observer
+is
+   use type Event.Logger.view;
+
+
+   procedure destroy (Self : in out Item)
+   is
+   begin
+      Self.Responses.destroy;
+   end destroy;
+
+
+   ------------
+   -- Responses
+   --
+
+   overriding
+   procedure add (Self : access Item;   the_Response : in Response.view;
+                                        to_Kind      : in Event.Kind;
+                                        from_Subject : in Event.subject_Name)
+   is
+   begin
+      Self.Responses.add (Self, the_Response, to_Kind, from_Subject);
+   end add;
+
+
+   overriding
+   procedure rid (Self : access Item;   the_Response : in Response.view;
+                                        to_Kind      : in Event.Kind;
+                                        from_Subject : in Event.subject_Name)
+   is
+   begin
+      Self.Responses.rid (Self, the_Response, to_Kind, from_Subject);
+   end rid;
+
+
+   overriding
+   procedure relay_responseless_Events (Self : in out Item;   To : in Observer.view)
+   is
+   begin
+      Self.Responses.relay_responseless_Events (To);
+   end relay_responseless_Events;
+
+
+   -------------
+   -- Operations
+   --
+
+   overriding
+   procedure receive (Self : access Item;   the_Event    : in Event.item'Class := Event.null_Event;
+                                            from_Subject : in Event.subject_Name)
+   is
+   begin
+      Self.Responses.receive (Self, the_Event, from_Subject);
+   end receive;
+
+
+   overriding
+   procedure respond (Self : access Item)
+   is
+   begin
+      null;   -- This is a null operation since there can never be any deferred events for an 'instant' observer.
+   end respond;
+
+
+   -----------------
+   -- Safe Responses
+   --
+   protected
+   body safe_Responses
+   is
+      procedure destroy
+      is
+         use subject_Maps_of_event_responses;
+
+         procedure free is new ada.unchecked_Deallocation (event_response_Map,
+                                                           event_response_Map_view);
+
+         Cursor  : subject_Maps_of_event_responses.Cursor := my_Responses.First;
+         the_Map : event_response_Map_view;
+      begin
+         while has_Element (Cursor)
+         loop
+            the_Map := Element (Cursor);
+            free (the_Map);
+
+            next (Cursor);
+         end loop;
+      end destroy;
+
+
+      ------------
+      -- Responses
+      --
+
+      procedure add (Self         : access Item'Class;
+                     the_Response : in     Response.view;
+                     to_Kind      : in     Event.Kind;
+                     from_Subject : in     Event.subject_Name)
+      is
+      begin
+         if not my_Responses.contains (from_Subject)
+         then
+            my_Responses.insert (from_Subject,
+                                 new event_response_Map);
+         end if;
+
+         my_Responses.Element (from_Subject).insert (to_Kind,
+                                                     the_Response);
+         if Observer.Logger /= null
+         then
+            Observer.Logger.log_new_Response (the_Response,
+                                              Observer.item'Class (Self.all),
+                                              to_Kind,
+                                              from_Subject);
+         end if;
+      end add;
+
+
+      procedure rid (Self         : access Item'Class;
+                     the_Response : in     Response.view;
+                     to_Kind      : in     Event.Kind;
+                     from_Subject : in     Event.subject_Name)
+      is
+      begin
+         my_Responses.Element (from_Subject).delete (to_Kind);
+
+         if Observer.Logger /= null
+         then
+            Observer.Logger.log_rid_Response (the_Response,
+                                              Observer.item'Class (Self.all),
+                                              to_Kind,
+                                              from_Subject);
+         end if;
+      end rid;
+
+
+      procedure relay_responseless_Events (To : in Observer.view)
+      is
+      begin
+         my_relay_Target := To;
+      end relay_responseless_Events;
+
+
+      function relay_Target return Observer.view
+      is
+      begin
+         return my_relay_Target;
+      end relay_Target;
+
+
+      function Contains (Subject : in Event.subject_Name) return Boolean
+      is
+      begin
+         return my_Responses.Contains (Subject);
+      end Contains;
+
+
+      function Element (Subject : in Event.subject_Name) return event_response_Map
+      is
+      begin
+         return my_Responses.Element (Subject).all;
+      end Element;
+
+
+      -------------
+      -- Operations
+      --
+
+      procedure receive (Self         : access Item'Class;
+                         the_Event    : in     Event.item'Class := Event.null_Event;
+                         from_Subject : in     Event.subject_Name)
+      is
+         use event_response_Maps,
+             subject_Maps_of_event_responses,
+             lace.Event.utility,
+             ada.Containers;
+
+         use type lace.Observer.view;
+
+         the_Responses :          event_response_Map    renames my_Responses.Element (from_Subject).all;
+         the_Response  : constant event_response_Maps.Cursor := the_Responses.find (to_Kind (the_Event'Tag));
+
+         my_Name : constant String := Observer.item'Class (Self.all).Name;
+
+      begin
+         if has_Element (the_Response)
+         then
+            Element (the_Response).respond (the_Event);
+
+            if Observer.Logger /= null
+            then
+               Observer.Logger.log_Response (Element (the_Response),
+                                             Observer.view (Self),
+                                             the_Event,
+                                             from_Subject);
+            end if;
+
+         elsif relay_Target /= null
+         then
+            --  Self.relay_Target.notify (the_Event, from_Subject_Name);   -- todo: Re-enable event relays.
+
+            if Observer.Logger /= null
+            then
+               Observer.Logger.log ("[Warning] ~ Relayed events are currently disabled.");
+            else
+               raise program_Error with "Event relaying is currently disabled.";
+            end if;
+
+         else
+            if Observer.Logger /= null
+            then
+               Observer.Logger.log ("[Warning] ~ Observer " & my_Name & " has no response to " & Name_of (the_Event)
+                                    & " from " & from_Subject & ".");
+               Observer.Logger.log ("            count of responses =>" & the_Responses.Length'Image);
+            else
+               raise program_Error with "Observer " & my_Name & " has no response to " & Name_of (the_Event)
+                                      & " from " & from_Subject & ".";
+            end if;
+         end if;
+
+      exception
+         when constraint_Error =>
+            if Observer.Logger /= null
+            then
+               Observer.Logger.log (my_Name & " has no responses for events from " & from_Subject & ".");
+            else
+               raise Program_Error with my_Name & " has no responses for events from " & from_Subject & ".";
+            end if;
+      end receive;
+
+   end safe_Responses;
+
+
+end lace.make_Observer;

1-base/lace/source/events/mixin/lace-make_observer.ads

@@ -0,0 +1,138 @@
+with
+     lace.Event,
+     lace.Response,
+     lace.Observer;
+
+private
+with
+     ada.Containers.indefinite_hashed_Maps,
+     ada.Strings.Hash;
+
+
+generic
+   type T is abstract tagged limited private;
+
+package lace.make_Observer
+--
+--  Makes a user class T into an event Observer.
+--
+is
+   pragma remote_Types;
+
+   type Item is abstract limited new T
+                                 and Observer.item with private;
+   type View is access all Item'Class;
+
+
+   procedure destroy (Self : in out Item);
+
+
+   ------------
+   -- Responses
+   --
+
+   overriding
+   procedure add (Self : access Item;   the_Response : in Response.view;
+                                        to_Kind      : in Event.Kind;
+                                        from_Subject : in Event.subject_Name);
+   overriding
+   procedure rid (Self : access Item;   the_Response : in Response.view;
+                                        to_Kind      : in Event.Kind;
+                                        from_Subject : in Event.subject_Name);
+   overriding
+   procedure relay_responseless_Events (Self : in out Item;   To : in Observer.view);
+
+
+   -------------
+   -- Operations
+   --
+
+   overriding
+   procedure receive (Self : access Item;   the_Event    : in Event.item'Class := event.null_Event;
+                                            from_Subject : in Event.subject_Name);
+   overriding
+   procedure respond (Self : access Item);
+
+
+
+private
+   ----------------------
+   -- Event response maps
+   --
+   use type event.Kind;
+   use type Response.view;
+
+   package event_response_Maps     is new ada.Containers.indefinite_hashed_Maps (key_type        => Event.Kind,
+                                                                                 element_type    => Response.view,
+                                                                                 hash            => Event.Hash,
+                                                                                 equivalent_keys => "=");
+   subtype event_response_Map      is event_response_Maps.Map;
+   type    event_response_Map_view is access all event_response_Map;
+
+
+   ----------------------------------
+   -- Subject maps of event responses
+   --
+
+   package subject_Maps_of_event_responses
+   is new ada.Containers.indefinite_hashed_Maps (key_type        => Event.subject_Name,
+                                                 element_type    => event_response_Map_view,
+                                                 hash            => ada.Strings.Hash,
+                                                 equivalent_keys => "=");
+   subtype subject_Map_of_event_responses is subject_Maps_of_event_responses.Map;
+
+
+   -----------------
+   -- Safe Responses
+   --
+   protected
+   type safe_Responses
+   is
+      procedure destroy;
+
+      ------------
+      -- Responses
+      --
+
+      procedure add (Self         : access Item'Class;
+                     the_Response : in     Response.view;
+                     to_Kind      : in     Event.Kind;
+                     from_Subject : in     Event.subject_Name);
+
+      procedure rid (Self         : access Item'Class;
+                     the_Response : in     Response.view;
+                     to_Kind      : in     Event.Kind;
+                     from_Subject : in     Event.subject_Name);
+
+      procedure relay_responseless_Events (To : in Observer.view);
+
+      function  relay_Target return Observer.view;
+
+      function  Contains (Subject : in Event.subject_Name) return Boolean;
+      function  Element  (Subject : in Event.subject_Name) return event_response_Map;
+
+      -------------
+      -- Operations
+      --
+
+      procedure receive (Self         : access Item'Class;
+                         the_Event    : in     Event.item'Class := Event.null_Event;
+                         from_Subject : in     Event.subject_Name);
+
+   private
+      my_Responses    : subject_Map_of_event_responses;
+      my_relay_Target : Observer.view;
+   end safe_Responses;
+
+
+   ----------------
+   -- Observer Item
+   --
+   type Item is abstract limited new T
+                                 and Observer.item
+   with
+      record
+         Responses : safe_Responses;
+      end record;
+
+end lace.make_Observer;

1-base/lace/source/events/mixin/lace-make_subject.adb

@@ -0,0 +1,240 @@
+with
+     lace.Event.Logger,
+     lace.Event.utility,
+     system.RPC,
+     ada.unchecked_Deallocation;
+
+
+package body lace.make_Subject
+is
+   use type Event.Logger.view;
+
+
+   procedure destroy (Self : in out Item)
+   is
+   begin
+      Self.safe_Observers.destruct;
+   end destroy;
+
+
+   -------------
+   -- Attributes
+   --
+
+   overriding
+   function Observers (Self : in Item;   of_Kind : in Event.Kind) return subject.Observer_views
+   is
+   begin
+      return Self.safe_Observers.fetch_Observers (of_Kind);
+   end Observers;
+
+
+   overriding
+   function observer_Count (Self : in Item) return Natural
+   is
+   begin
+      return Self.safe_Observers.observer_Count;
+   end observer_Count;
+
+
+   -------------
+   -- Operations
+   --
+
+   overriding
+   procedure register (Self : access Item;   the_Observer : in Observer.view;
+                                             of_Kind      : in Event.Kind)
+   is
+   begin
+      Self.safe_Observers.add (the_Observer, of_Kind);
+
+      if Subject.Logger /= null
+      then
+         Subject.Logger.log_Connection (the_Observer,
+                                        Subject.view (Self),
+                                        of_Kind);
+      end if;
+   end register;
+
+
+   overriding
+   procedure deregister (Self : in out Item;   the_Observer : in Observer.view;
+                                               of_Kind      : in Event.Kind)
+   is
+   begin
+      Self.safe_Observers.rid (the_Observer, of_Kind);
+
+      if Subject.Logger /= null
+      then
+         Subject.Logger.log_disconnection (the_Observer,
+                                           Self'unchecked_Access,
+                                           of_Kind);
+      end if;
+   end deregister;
+
+
+   overriding
+   procedure emit (Self : access Item;   the_Event : in Event.item'Class := Event.null_Event)
+   is
+      use lace.Event.utility;
+      my_Observers : constant Subject.Observer_views := Self.Observers (to_Kind (the_Event'Tag));
+   begin
+      for i in my_Observers'Range
+      loop
+         begin
+            my_Observers (i).receive (the_Event,
+                                      from_Subject => Subject.item'Class (Self.all).Name);
+            if Subject.Logger /= null
+            then
+               Subject.Logger.log_Emit (Subject.view (Self),
+                                        my_Observers (i),
+                                        the_Event);
+            end if;
+
+         exception
+            when system.RPC.communication_Error
+               | storage_Error =>
+               if Subject.Logger /= null
+               then
+                  Subject.Logger.log_Emit (Subject.view (Self),
+                                           my_Observers (i),
+                                           the_Event);
+               end if;
+         end;
+      end loop;
+   end emit;
+
+
+   overriding
+   function emit (Self : access Item;   the_Event : in Event.item'Class := Event.null_Event)
+                  return subject.Observer_views
+   is
+      use lace.Event.utility;
+      my_Observers  : constant Subject.Observer_views := Self.Observers (to_Kind (the_Event'Tag));
+      bad_Observers :          Subject.Observer_views (my_Observers'Range);
+      bad_Count     :          Natural := 0;
+   begin
+      for i in my_Observers'Range
+      loop
+         begin
+            my_Observers (i).receive (the_Event,
+                                      from_Subject => Subject.item'Class (Self.all).Name);
+            if Subject.Logger /= null
+            then
+               Subject.Logger.log_Emit (Subject.view (Self),
+                                        my_Observers (i),
+                                        the_Event);
+            end if;
+
+         exception
+            when system.RPC.communication_Error
+               | storage_Error =>
+               bad_Count                 := bad_Count + 1;
+               bad_Observers (bad_Count) := my_Observers (i);
+         end;
+      end loop;
+
+      return bad_Observers (1 .. bad_Count);
+   end emit;
+
+
+   -----------------
+   -- Safe Observers
+   --
+
+   protected
+   body safe_Observers
+   is
+      procedure destruct
+      is
+         use event_kind_Maps_of_event_observers;
+
+         procedure deallocate is new ada.unchecked_Deallocation (event_Observer_Vector,
+                                                                 event_Observer_Vector_view);
+
+         Cursor                    : event_kind_Maps_of_event_observers.Cursor := the_Observers.First;
+         the_event_Observer_Vector : event_Observer_Vector_view;
+      begin
+         while has_Element (Cursor)
+         loop
+            the_event_Observer_Vector := Element (Cursor);
+            deallocate (the_event_Observer_Vector);
+
+            next (Cursor);
+         end loop;
+      end destruct;
+
+
+      procedure add (the_Observer : in Observer.view;
+                     of_Kind      : in Event.Kind)
+      is
+         use event_Observer_Vectors,
+             event_kind_Maps_of_event_observers;
+
+         Cursor              : constant event_kind_Maps_of_event_observers.Cursor := the_Observers.find (of_Kind);
+         the_event_Observers :          event_Observer_Vector_view;
+      begin
+         if has_Element (Cursor)
+         then
+            the_event_Observers := Element (Cursor);
+         else
+            the_event_Observers := new event_Observer_Vector;
+            the_Observers.insert (of_Kind,
+                                  the_event_Observers);
+         end if;
+
+         the_event_Observers.append (the_Observer);
+      end add;
+
+
+      procedure rid (the_Observer : in Observer.view;
+                     of_Kind      : in Event.Kind)
+      is
+         the_event_Observers : event_Observer_Vector renames the_Observers.Element (of_Kind).all;
+      begin
+         the_event_Observers.delete (the_event_Observers.find_Index (the_Observer));
+      end rid;
+
+
+      function fetch_Observers (of_Kind : in Event.Kind) return subject.Observer_views
+      is
+      begin
+         if the_Observers.Contains (of_Kind)
+         then
+            declare
+               the_event_Observers : constant event_Observer_Vector_view := the_Observers.Element (of_Kind);
+               my_Observers        :          Subject.Observer_views (1 .. Natural (the_event_Observers.Length));
+            begin
+               for i in my_Observers'Range
+               loop
+                  my_Observers (i) := the_event_Observers.Element (i);
+               end loop;
+
+               return my_Observers;
+            end;
+         else
+            return [1 .. 0 => <>];
+         end if;
+      end fetch_Observers;
+
+
+      function observer_Count return Natural
+      is
+         use event_kind_Maps_of_event_observers;
+
+         Cursor : event_kind_Maps_of_event_observers.Cursor := the_Observers.First;
+         Count  : Natural := 0;
+      begin
+         while has_Element (Cursor)
+         loop
+            Count := Count + Natural (Element (Cursor).Length);
+            next (Cursor);
+         end loop;
+
+         return Count;
+      end observer_Count;
+
+   end safe_Observers;
+
+
+end lace.make_Subject;

1-base/lace/source/events/mixin/lace-make_subject.ads

@@ -0,0 +1,114 @@
+with
+     lace.Event,
+     lace.Subject,
+     lace.Observer;
+
+private
+with
+     ada.Containers.Vectors,
+     ada.Containers.indefinite_hashed_Maps;
+
+
+generic
+   type T is abstract tagged limited private;
+
+package lace.make_Subject
+--
+--  Makes a user class T into an event Subject.
+--
+is
+   pragma remote_Types;
+
+   type Item is abstract limited new T
+                                 and Subject.item with private;
+   type View is access all Item'Class;
+
+   procedure destroy (Self : in out Item);
+
+
+   -------------
+   -- Attributes
+   --
+
+   overriding
+   function Observers      (Self : in Item;   of_Kind : in Event.Kind) return Subject.Observer_views;
+   overriding
+   function observer_Count (Self : in Item) return Natural;
+
+
+   -------------
+   -- Operations
+   --
+
+   overriding
+   procedure   register (Self : access Item;   the_Observer : in Observer.view;
+                                               of_Kind      : in Event.Kind);
+   overriding
+   procedure deregister (Self : in out Item;   the_Observer : in Observer.view;
+                                               of_Kind      : in Event.Kind);
+
+   overriding
+   procedure emit (Self : access Item;   the_Event : in Event.item'Class := Event.null_Event);
+
+   overriding
+   function  emit (Self : access Item;   the_Event : in Event.item'Class := Event.null_Event)
+                   return subject.Observer_views;
+
+
+
+private
+
+   -------------------------
+   -- Event observer vectors
+   --
+   use type Observer.view;
+
+   package event_Observer_Vectors     is new ada.Containers.Vectors (Positive, Observer.view);
+   subtype event_Observer_Vector      is event_Observer_Vectors.Vector;
+   type    event_Observer_Vector_view is access all event_Observer_Vector;
+
+
+   -------------------------------------
+   -- Event kind Maps of event observers
+   --
+   use type Event.Kind;
+   package event_kind_Maps_of_event_observers is new ada.Containers.indefinite_hashed_Maps (Event.Kind,
+                                                                                            event_Observer_Vector_view,
+                                                                                            Event.Hash,
+                                                                                            "=");
+   subtype event_kind_Map_of_event_observers  is event_kind_Maps_of_event_observers.Map;
+
+
+   -----------------
+   -- Safe observers
+   --
+   protected
+   type safe_Observers
+   is
+      procedure destruct;
+
+      procedure add (the_Observer : in Observer.view;
+                     of_Kind      : in Event.Kind);
+
+      procedure rid (the_Observer : in Observer.view;
+                     of_Kind      : in Event.Kind);
+
+      function  fetch_Observers (of_Kind : in Event.Kind) return Subject.Observer_views;
+      function  observer_Count return Natural;
+
+   private
+      the_Observers : event_kind_Map_of_event_observers;
+   end safe_Observers;
+
+
+   ---------------
+   -- Subject Item
+   --
+   type Item is abstract limited new T
+                                 and Subject.item
+   with
+      record
+         safe_Observers : make_Subject.safe_Observers;
+      end record;
+
+end lace.make_Subject;

1-base/lace/source/events/mixin/ravenscar/lace-make_observer-deferred.adb

@@ -0,0 +1,137 @@
+with lace.event.Logger,
+     lace.event_Conversions,
+
+     gnat.task_Lock;
+
+
+
+package body lace.make_Observer.deferred
+is
+
+
+
+   procedure receive (Self : access Item;   the_Event    : in Event.item'Class := event.null_Event;
+                                            from_Subject : in String)
+   is
+      use event_Vectors;
+   begin
+      gnat.task_Lock.lock;
+
+      if not Self.pending_Events.contains (from_Subject) then
+         Self.pending_Events.insert (from_Subject,
+                                     new event_Vector);
+      end if;
+
+      Self.pending_Events.Element (from_Subject).append (the_Event);
+
+      gnat.task_Lock.unlock;
+   end receive;
+
+
+
+
+
+   procedure respond (Self : access Item)
+   is
+      use event_Vectors;
+
+      my_Name : String := Observer.Item'Class (Self.all).Name;
+
+
+      --- actuate
+      --
+      procedure actuate (the_Responses     : in     event_response_Map;
+                         for_Events        : in out event_Vector;
+                         from_Subject_Name : in     String)
+      is
+         the_Events : event_Vector         renames for_Events;
+         Cursor     : event_Vectors.Cursor;
+
+      begin
+         Cursor := the_Events.First;
+
+         while has_Element (Cursor) loop
+            declare
+               use event_response_Maps,  event_Conversions,  ada.Containers;
+               use type Observer.view;
+
+               the_Event : Event.item'Class           := Element (Cursor);
+               Response  : event_response_Maps.Cursor := the_Responses.find (to_event_Kind (the_Event'tag));
+
+            begin
+
+               if has_Element (Response) then
+                  Element (Response).respond (the_Event);
+
+                  if Observer.Logger /= null then
+                     Observer.Logger.log_Response (Element (Response),  Observer.view (Self),  the_Event,  from_Subject_Name);
+                  end if;
+
+
+               elsif Self.relay_Target /= null then
+                  -- Self.relay_Target.notify (the_Event, from_Subject_Name);
+
+                  if Observer.Logger /= null then
+                     Observer.Logger.log ("[Warning] ~ Relayed events are currently disabled.");
+                  else
+                     raise program_Error with   "Event relaying is currently disabled";
+                  end if;
+
+
+               else
+                  if Observer.Logger /= null then
+                     Observer.Logger.log ("[Warning] ~ Observer "             & my_Name & " has no response !");
+                     Observer.Logger.log ("            count of responses =>" & Count_type'Image (the_Responses.Length));
+                  else
+                     raise program_Error with   "Observer " & my_Name & " has no response !";
+                  end if;
+               end if;
+
+            end;
+
+
+            next (Cursor);
+         end loop;
+
+      end actuate;
+
+
+
+      use subject_Maps_of_safe_events;
+      subject_Cursor : subject_Maps_of_safe_events.Cursor := Self.pending_Events.First;
+
+
+   begin
+
+      while has_Element (subject_Cursor)
+      loop
+         declare
+            use subject_Maps_of_event_responses;
+            subject_Name : String := Key (subject_Cursor);
+
+         begin
+            actuate (Self.subject_Responses.Element (subject_Name).all,
+                     Self.pending_Events   .Element (subject_Name).all,
+                     subject_Name);
+
+            Self.pending_Events.Element (subject_Name).clear;
+
+         exception
+            when constraint_Error =>
+               if Observer.Logger /= null then
+                  Observer.Logger.log (my_Name & " has no responses for events from " & subject_Name);
+               else
+                  raise program_Error with    my_Name & " has no responses for events from " & subject_Name;
+               end if;
+         end;
+
+
+         next (subject_Cursor);
+      end loop;
+
+   end respond;
+
+
+
+
+end lace.make_Observer.deferred;

1-base/lace/source/events/mixin/ravenscar/lace-make_observer-deferred.ads

@@ -0,0 +1,94 @@
+pragma Profile (Ravenscar);
+
+
+with lace.Event,
+     lace.Response,
+     lace.Subject,
+     lace.Observer;
+
+private
+with ada.Containers.indefinite_Vectors,
+     ada.Containers.indefinite_hashed_Maps,
+     ada.Strings.hash;
+
+
+
+generic
+   type T is abstract new lace.make_Observer.item with private;
+
+package lace.make_Observer.deferred
+--
+-- Makes a user class T into a deferred event Observer.
+--
+is
+--     pragma remote_Types;
+
+
+   ------------------
+   --- Observer Item
+   --
+
+   type Item is abstract limited new T with private;
+
+   type View is access all Item'Class;
+
+   --   pragma Asynchronous (View);        -- tbd: Needed for lossy events.
+
+
+
+
+
+   ---------------
+   --- Operations
+   --
+
+
+   overriding
+   procedure receive (Self : access Item;   the_Event    : in Event.item'Class := event.null_Event;
+                                            from_Subject : in String);
+
+   overriding
+   procedure respond (Self : access Item);
+
+
+
+
+
+
+private
+
+   --- event_Vectors
+   --
+
+   use type Event.item;
+
+   package event_Vectors     is new ada.containers.indefinite_Vectors (Positive,  Event.item'Class);
+   subtype event_Vector      is event_vectors.Vector;
+   type    event_Vector_view is access all event_Vector;
+
+
+
+   --- subject_Maps_of_safe_events
+   --
+
+   use type event_Vector;
+   package subject_Maps_of_safe_events is new ada.containers.indefinite_hashed_Maps (key_type        => String,             -- Subject Name,
+                                                                                     element_type    => event_Vector_view,
+                                                                                     hash            => Ada.Strings.Hash,
+                                                                                     equivalent_keys => "=");
+   subtype subject_Map_of_safe_events  is subject_Maps_of_safe_events.Map;
+
+
+
+
+   ------------------
+   --- Observer Item
+   --
+
+   type Item is abstract limited new T with
+      record
+         pending_Events : subject_Map_of_safe_events;
+      end record;
+
+
+end lace.make_Observer.deferred;

1-base/lace/source/events/mixin/xgc/lace-make_observer-deferred.adb

@@ -0,0 +1,231 @@
+with
+     lace.Event.Logger,
+     lace.Event.utility,
+     ada.unchecked_Deallocation;
+
+
+package body lace.make_Observer.deferred
+is
+   use type Event.Logger.view;
+
+
+   overriding
+   procedure destroy (Self : in out Item)
+   is
+   begin
+      make_Observer.destroy (make_Observer.item (Self));   -- Destroy base class.
+      Self.pending_Events.free;
+   end destroy;
+
+
+   -------------
+   -- Operations
+   --
+
+   overriding
+   procedure receive (Self : access Item;   the_Event    : in Event.item'Class := Event.null_Event;
+                                            from_Subject : in Event.subject_Name)
+   is
+   begin
+      Self.pending_Events.add (the_Event, from_Subject);
+   end receive;
+
+
+   overriding
+   procedure respond (Self : access Item)
+   is
+      use Event_Vectors;
+
+      my_Name : constant String := Observer.item'Class (Self.all).Name;
+
+      procedure actuate (the_Responses     : in event_response_Map;
+                         the_Events        : in Event_Vector;
+                         from_subject_Name : in Event.subject_Name)
+      is
+         Cursor : Event_Vectors.Cursor := the_Events.First;
+      begin
+         while has_Element (Cursor)
+         loop
+            declare
+               use event_response_Maps,
+                   Event.utility,
+                   ada.Containers;
+               use type Observer.view;
+
+               the_Event : constant Event.item'Class           := Element (Cursor);
+               Response  : constant event_response_Maps.Cursor := the_Responses.find (to_Kind (the_Event'Tag));
+            begin
+               if has_Element (Response)
+               then
+                  Element (Response).respond (the_Event);
+
+                  if Observer.Logger /= null
+                  then
+                     Observer.Logger.log_Response (Element (Response),
+                                                   Observer.view (Self),
+                                                   the_Event,
+                                                   from_subject_Name);
+                  end if;
+
+               elsif Self.Responses.relay_Target /= null
+               then
+                  --  Self.relay_Target.notify (the_Event, from_Subject_Name);   -- todo: Re-enable relayed events.
+
+                  if Observer.Logger /= null
+                  then
+                     Observer.Logger.log ("[Warning] ~ Relayed events are currently disabled.");
+                  else
+                     raise program_Error with "Event relaying is currently disabled.";
+                  end if;
+
+               else
+                  if Observer.Logger /= null
+                  then
+                     Observer.Logger.log ("[Warning] ~ Observer "
+                                          & my_Name
+                                          & " has no response to " & Name_of (the_Event)
+                                          & " from " & from_subject_Name & ".");
+                     Observer.Logger.log ("            Count of responses =>"
+                                          & the_Responses.Length'Image);
+                  else
+                     raise program_Error with "Observer " & my_Name & " has no response to " & Name_of (the_Event)
+                                            & " from " & from_subject_Name & ".";
+                  end if;
+               end if;
+            end;
+
+            next (Cursor);
+         end loop;
+      end actuate;
+
+      the_subject_Events : subject_events_Pairs (1 .. 5_000);
+      Count              : Natural;
+
+   begin
+      Self.pending_Events.fetch (the_subject_Events, Count);
+
+      for i in 1 .. Count
+      loop
+         declare
+            procedure deallocate is new ada.unchecked_Deallocation (String, String_view);
+
+            subject_Name : String_view       := the_subject_Events (i).Subject;
+            the_Events   : Event_vector renames the_subject_Events (i).Events;
+         begin
+            if Self.Responses.Contains (subject_Name.all)
+            then
+               actuate (Self.Responses.Element (subject_Name.all),
+                        the_Events,
+                        subject_Name.all);
+            else
+               declare
+                  Message : constant String := my_Name & " has no responses for events from " & subject_Name.all & ".";
+               begin
+                  if Observer.Logger /= null
+                  then
+                     Observer.Logger.log (Message);
+                  else
+                     raise program_Error with Message;
+                  end if;
+               end;
+            end if;
+
+            deallocate (subject_Name);
+         end;
+      end loop;
+
+   end respond;
+
+
+   --------------
+   -- Safe Events
+   --
+   protected
+   body safe_Events
+   is
+      procedure add (the_Event : in Event.item'Class)
+      is
+      begin
+         the_Events.append (the_Event);
+      end add;
+
+
+      procedure fetch (all_Events : out Event_Vector)
+      is
+      begin
+         all_Events := the_Events;
+         the_Events.clear;
+      end fetch;
+   end safe_Events;
+
+
+   ----------------------------------
+   -- safe Subject Map of safe Events
+   --
+   protected
+   body safe_subject_Map_of_safe_events
+   is
+      procedure add (the_Event    : in Event.item'Class;
+                     from_Subject : in String)
+      is
+      begin
+         if not the_Map.contains (from_Subject)
+         then
+            the_Map.insert (from_Subject,
+                            new safe_Events);
+         end if;
+
+         the_Map.Element (from_Subject).add (the_Event);
+      end add;
+
+
+      procedure fetch (all_Events : out subject_events_Pairs;
+                       Count      : out Natural)
+      is
+         use subject_Maps_of_safe_events;
+
+         Cursor : subject_Maps_of_safe_events.Cursor := the_Map.First;
+         Index  : Natural := 0;
+      begin
+         while has_Element (Cursor)
+         loop
+            declare
+               the_Events : Event_vector;
+            begin
+               Element (Cursor).fetch (the_Events);
+
+               Index              := Index + 1;
+               all_Events (Index) := (subject => new String' (Key (Cursor)),
+                                      events  => the_Events);
+            end;
+
+            next (Cursor);
+         end loop;
+
+         Count := Index;
+      end fetch;
+
+
+      procedure free
+      is
+         use subject_Maps_of_safe_events;
+
+         procedure deallocate is new ada.unchecked_Deallocation (safe_Events,
+                                                                 safe_Events_view);
+
+         Cursor     : subject_Maps_of_safe_events.Cursor := the_Map.First;
+         the_Events : safe_Events_view;
+      begin
+         while has_Element (Cursor)
+         loop
+            the_Events := Element (Cursor);
+            deallocate (the_Events);
+
+            next (Cursor);
+         end loop;
+      end free;
+
+   end safe_subject_Map_of_safe_events;
+
+
+end lace.make_Observer.deferred;

1-base/lace/source/events/mixin/xgc/lace-make_observer-deferred.ads

@@ -0,0 +1,119 @@
+with
+     lace.Event;
+
+private
+with
+     ada.Containers.indefinite_Vectors,
+     ada.Containers.indefinite_hashed_Maps,
+     ada.Strings.Hash;
+
+
+generic
+   type T is abstract new lace.make_Observer.item with private;
+
+package lace.make_Observer.deferred
+--
+--  Makes a user class T into a deferred event Observer.
+--
+is
+   pragma remote_Types;
+
+   type Item is abstract limited new T with private;
+   type View is access all Item'Class;
+
+
+   overriding
+   procedure destroy (Self : in out Item);
+
+
+   -------------
+   -- Operations
+   --
+
+   overriding
+   procedure receive (Self : access Item;   the_Event    : in Event.item'Class := Event.null_Event;
+                                            from_Subject : in Event.subject_Name);
+   overriding
+   procedure respond (Self : access Item);
+
+
+
+private
+
+   ----------------
+   -- Event Vectors
+   --
+   use type Event.item;
+
+   package event_Vectors     is new ada.Containers.indefinite_Vectors (Positive, Event.item'Class);
+   subtype event_Vector      is event_Vectors.Vector;
+   type    event_Vector_view is access all event_Vector;
+
+
+   --------------
+   -- Safe Events
+   --
+   protected
+   type safe_Events
+   is
+      procedure add   (the_Event  : in     Event.item'Class);
+      procedure fetch (all_Events :    out event_Vector);
+   private
+      the_Events : event_Vector;
+   end safe_Events;
+
+   type safe_Events_view is access all safe_Events;
+
+
+   ------------------------------
+   -- Subject Maps of safe Events
+   --
+   use type event_Vector;
+   package subject_Maps_of_safe_events is new ada.Containers.indefinite_hashed_Maps (Key_type        => Event.subject_Name,
+                                                                                     Element_type    => safe_Events_view,
+                                                                                     Hash            => ada.Strings.Hash,
+                                                                                     equivalent_Keys => "=");
+   subtype subject_Map_of_safe_events  is subject_Maps_of_safe_events.Map;
+
+
+   -----------------------
+   -- Subject Events Pairs
+   --
+   type String_view is access all String;
+
+   type subject_events_Pair is
+      record
+         Subject : String_view;
+         Events  : event_Vector;
+      end record;
+
+   type subject_events_Pairs is array (Positive range <>) of subject_events_Pair;
+
+
+   ----------------------------------
+   -- safe Subject Map of safe Events
+   --
+   protected
+   type safe_subject_Map_of_safe_events
+   is
+      procedure add   (the_Event    : in Event.item'Class;
+                       from_Subject : in String);
+
+      procedure fetch (all_Events : out subject_events_Pairs;
+                       Count      : out Natural);
+      procedure free;
+
+   private
+      the_Map : subject_Map_of_safe_events;
+   end safe_subject_Map_of_safe_events;
+
+
+   ----------------
+   -- Observer Item
+   --
+   type Item is abstract limited new T with
+      record
+         pending_Events : safe_subject_Map_of_safe_events;
+      end record;
+
+end lace.make_Observer.deferred;

1-base/lace/source/events/utility/lace-event-logger-text.adb

@@ -0,0 +1,183 @@
+with
+     lace.Event.utility,
+     system.RPC,
+     ada.unchecked_Conversion;
+
+
+package body lace.Event.Logger.text
+is
+   use lace.Event.utility,
+       ada.Text_IO;
+
+   --------
+   -- Forge
+   --
+
+   function to_Logger (Name : in String) return Item
+   is
+   begin
+      return Self : Item
+      do
+         create (Self.File, out_File, Name & ".log");
+      end return;
+   end to_Logger;
+
+
+   overriding
+   procedure destruct (Self : in out Item)
+   is
+   begin
+      close (Self.File);
+   end destruct;
+
+
+   -------------
+   -- Operations
+   --
+
+   overriding
+   procedure log_Connection (Self : in out Item;   From     : in Observer.view;
+                                                   To       : in Subject .view;
+                                                   for_Kind : in Event.Kind)
+   is
+   begin
+      put_Line (Self.File,   "log Connection => "
+                           & From.Name & " observes " & To.Name
+                           & " for event kind " & Name_of (for_Kind) & ".");
+   end log_Connection;
+
+
+   overriding
+   procedure log_Disconnection (Self : in out Item;   From     : in Observer.view;
+                                                      To       : in Subject .view;
+                                                      for_Kind : in Event.Kind)
+   is
+
+      function from_Name return String
+      is
+         function to_Integer is new ada.unchecked_Conversion (Observer.view,
+                                                              long_Integer);
+      begin
+         return From.Name;
+      exception
+         when system.RPC.communication_Error
+            | storage_Error =>
+            return "dead Observer (" & to_Integer (From)'Image & ")";
+      end from_Name;
+
+   begin
+      put_Line (Self.File,   "log Disconnection => "
+                           & from_Name
+                           & " no longer observes "
+                           & To.Name
+                           & " for event kind " & Name_of (for_Kind) & ".");
+   end log_Disconnection;
+
+
+   overriding
+   procedure log_Emit (Self : in out Item;   From      : in Subject .view;
+                                             To        : in Observer.view;
+                                             the_Event : in Event.item'Class)
+   is
+      function to_Name return String
+      is
+         function to_Integer is new ada.unchecked_Conversion (lace.Observer.view,
+                                                              long_Integer);
+      begin
+         return To.Name;
+      exception
+            when system.RPC.communication_Error
+               | storage_Error =>
+            return "dead Observer (" & to_Integer (To)'Image & ")";
+      end to_Name;
+
+   begin
+      if Self.Ignored.contains (to_Kind (the_Event'Tag))
+      then
+         return;
+      end if;
+
+      put_Line (Self.File,   "log Emit => "
+                           & From.Name & " sends " & Name_of (Kind_of (the_Event))
+                           & " to "    & to_Name & ".");
+   end log_Emit;
+
+
+   overriding
+   procedure log_Relay (Self : in out Item;   From      : in Observer.view;
+                                              To        : in Observer.view;
+                                              the_Event : in Event.item'Class)
+   is
+   begin
+      put_Line (Self.File,  "log Relay => "
+                           & From.Name & " relays " & Name_of (Kind_of (the_Event))
+                           & " to "    & To.Name & ".");
+   end log_Relay;
+
+
+   overriding
+   procedure log_new_Response (Self : in out Item;   the_Response : in Response.view;
+                                                     of_Observer  : in Observer.item'Class;
+                                                     to_Kind      : in Event.Kind;
+                                                     from_Subject : in subject_Name)
+   is
+   begin
+      put_Line (Self.File,   "log new Response => "
+                           & of_Observer.Name
+                           & " responds to " & Name_of (to_Kind)
+                           & " from "        & from_Subject
+                           & " with "        & the_Response.Name);
+   end log_new_Response;
+
+
+   overriding
+   procedure log_rid_Response (Self : in out Item;   the_Response : in Response.view;
+                                                     of_Observer  : in Observer.item'Class;
+                                                     to_Kind      : in Event.Kind;
+                                                     from_Subject : in subject_Name)
+   is
+   begin
+      put_Line (Self.File,   "log rid Response => "
+                           & of_Observer.Name
+                           & " no longer responds to " & Name_of (to_Kind)
+                           & " from "                  & from_Subject
+                           & " with "                  & the_Response.Name & ".");
+   end log_rid_Response;
+
+
+   overriding
+   procedure log_Response (Self : in out Item;   the_Response : in Response.view;
+                                                 of_Observer  : in Observer.view;
+                                                 to_Event     : in Event.item'Class;
+                                                 from_Subject : in subject_Name)
+   is
+   begin
+      if Self.Ignored.contains (to_Kind (to_Event'Tag))
+      then
+         return;
+      end if;
+
+      put_Line (Self.File,   "log Response => "
+                           & of_Observer.Name
+                           & " responds to " & Name_of (to_Kind (to_Event'Tag))
+                           & " from "        & from_Subject
+                           & " with "        & the_Response.Name & ".");
+   end log_Response;
+
+
+   overriding
+   procedure log (Self : in out Item;   Message : in String)
+   is
+   begin
+      put_Line (Self.File, Message);
+   end log;
+
+
+   overriding
+   procedure ignore (Self : in out Item;   Kind : in Event.Kind)
+   is
+   begin
+      Self.Ignored.insert (Kind);
+   end ignore;
+
+end lace.event.Logger.text;

1-base/lace/source/events/utility/lace-event-logger-text.ads

@@ -0,0 +1,98 @@
+with
+     lace.Observer,
+     lace.Subject,
+     lace.Response;
+
+private
+with
+     ada.Text_IO,
+     ada.Containers.indefinite_hashed_Sets;
+
+
+package lace.event.Logger.text
+--
+--  Provides a logger which logs to a text file.
+--
+is
+   type Item is limited new Logger.item with private;
+   type View is access all Item'Class;
+
+
+   --------
+   -- Forge
+   --
+
+   function  to_Logger (Name : in String) return Item;
+
+   overriding
+   procedure destruct  (Self : in out Item);
+
+
+   -------------
+   -- Operations
+   --
+
+   -- Logging of event consfiguration.
+   --
+
+   overriding
+   procedure log_Connection    (Self : in out Item;   From         : in Observer.view;
+                                                      To           : in Subject .view;
+                                                      for_Kind     : in Event.Kind);
+   overriding
+   procedure log_Disconnection (Self : in out Item;   From         : in Observer.view;
+                                                      To           : in Subject .view;
+                                                      for_Kind     : in Event.Kind);
+   overriding
+   procedure log_new_Response  (Self : in out Item;   the_Response : in Response.view;
+                                                      of_Observer  : in Observer.item'Class;
+                                                      to_Kind      : in Event.Kind;
+                                                      from_Subject : in subject_Name);
+   overriding
+   procedure log_rid_Response  (Self : in out Item;   the_Response : in Response.view;
+                                                      of_Observer  : in Observer.item'Class;
+                                                      to_Kind      : in Event.Kind;
+                                                      from_Subject : in subject_Name);
+   -- Logging of event transmission.
+   --
+
+   overriding
+   procedure log_Emit     (Self : in out Item;   From         : in Subject .view;
+                                                 To           : in Observer.view;
+                                                 the_Event    : in Event.item'Class);
+   overriding
+   procedure log_Relay    (Self : in out Item;   From         : in Observer.view;
+                                                 To           : in Observer.view;
+                                                 the_Event    : in Event.item'Class);
+   overriding
+   procedure log_Response (Self : in out Item;   the_Response : in Response.view;
+                                                 of_Observer  : in Observer.view;
+                                                 to_Event     : in Event.item'Class;
+                                                 from_Subject : in subject_Name);
+   -- Logging of miscellaneous messages.
+   --
+   overriding
+   procedure log (Self : in out Item;   Message : in String);
+
+   -- Log filtering
+   --
+   overriding
+   procedure ignore (Self : in out Item;   Kind : in Event.Kind);
+
+
+
+private
+
+   package event_kind_Sets is new ada.Containers.indefinite_hashed_Sets (Event.Kind,
+                                                                         Event.Hash,
+                                                                         "=");
+   subtype event_kind_Set  is event_kind_Sets.Set;
+
+
+   type Item is limited new Logger.item with
+      record
+         File    : ada.Text_IO.File_type;
+         Ignored : event_kind_Set;
+      end record;
+
+end lace.event.Logger.text;

1-base/lace/source/events/utility/lace-event-logger.ads

@@ -0,0 +1,74 @@
+with
+     lace.Observer,
+     lace.Subject,
+     lace.Response;
+
+
+package lace.Event.Logger
+--
+--  Provides an event logging interface.
+--
+is
+   type Item is limited interface;
+   type View is access all Item'Class;
+
+
+   --------
+   -- Forge
+   --
+   procedure destruct (Self : in out Item) is null;
+
+
+   -------------
+   -- Operations
+   --
+
+   -- Logging of event configuration.
+   --
+
+   procedure log_Connection    (Self : in out Item;   From     : in Observer.view;
+                                                      To       : in Subject .view;
+                                                      for_Kind : in Event.Kind) is abstract;
+
+   procedure log_Disconnection (Self : in out Item;   From     : in Observer.view;
+                                                      To       : in Subject .view;
+                                                      for_Kind : in Event.Kind) is abstract;
+
+
+   procedure log_new_Response  (Self : in out Item;   the_Response : in Response.view;
+                                                      of_Observer  : in Observer.item'Class;
+                                                      to_Kind      : in Event.Kind;
+                                                      from_Subject : in subject_Name) is abstract;
+
+   procedure log_rid_Response  (Self : in out Item;   the_Response : in Response.view;
+                                                      of_Observer  : in Observer.item'Class;
+                                                      to_Kind      : in Event.Kind;
+                                                      from_Subject : in subject_Name) is abstract;
+   -- Logging of event transmission.
+   --
+
+   procedure log_Emit     (Self : in out Item;   From         : in Subject .view;
+                                                 To           : in Observer.view;
+                                                 the_Event    : in Event.item'Class) is abstract;
+
+   procedure log_Relay    (Self : in out Item;   From         : in Observer.view;
+                                                 To           : in Observer.view;
+                                                 the_Event    : in Event.item'Class) is abstract;
+
+   procedure log_Response (Self : in out Item;   the_Response : in Response.view;
+                                                 of_Observer  : in Observer.view;
+                                                 to_Event     : in Event.item'Class;
+                                                 from_Subject : in subject_Name) is abstract;
+   -- Logging of miscellaneous messages.
+   --
+
+   procedure log (Self : in out Item;   Message : in String) is abstract;
+
+
+   -- Log filtering.
+   --
+
+   procedure ignore (Self : in out Item;   Kind : in Event.Kind) is abstract;
+
+
+end lace.Event.Logger;

1-base/lace/source/events/utility/lace-event-utility.adb

@@ -0,0 +1,136 @@
+with
+     lace.Event.Logger.text,
+     ada.unchecked_Deallocation,
+     system.RPC;
+
+
+package body lace.Event.utility
+is
+   --------------
+   -- Event Kinds
+   --
+
+   function to_Kind (From : in ada.Tags.Tag) return lace.Event.Kind
+   is
+   begin
+      return event.Kind (ada.Tags.external_Tag (From));
+   end to_Kind;
+
+
+   function Name_of (Kind : in Event.Kind) return String
+   is
+   begin
+      return String (Kind);
+   end Name_of;
+
+
+   ---------
+   -- Events
+   --
+
+   function Kind_of (the_Event : in Event.item'Class) return Event.Kind
+   is
+   begin
+      return to_Kind (the_Event'Tag);
+   end Kind_of;
+
+
+   function Name_of (the_Event : in Event.item'Class) return String
+   is
+   begin
+      return Name_of (Kind_of (the_Event));
+   end Name_of;
+
+
+   --------------
+   -- Connections
+   --
+
+   procedure connect (the_Observer  : in Observer.view;
+                      to_Subject    : in Subject .view;
+                      with_Response : in Response.view;
+                      to_Event_Kind : in Event.Kind)
+   is
+   begin
+      the_Observer.add (with_Response,
+                        to_Event_Kind,
+                        to_Subject.Name);
+
+      to_Subject.register (the_Observer,
+                           to_Event_Kind);
+   end connect;
+
+
+   procedure disconnect (the_Observer  : in Observer.view;
+                         from_Subject  : in Subject .view;
+                         for_Response  : in Response.view;
+                         to_Event_Kind : in Event.Kind;
+                         Subject_Name  : in String)
+   is
+   begin
+      begin
+         the_Observer.rid (for_Response,
+                           to_Event_Kind,
+                           Subject_Name);
+      exception
+         when storage_Error =>
+            null;   -- The observer is dead.
+      end;
+
+      begin
+         from_Subject.deregister (the_Observer,
+                                  to_Event_Kind);
+      exception
+            when system.RPC.communication_Error
+               | storage_Error =>
+            null;   -- The subject is dead.
+      end;
+   end disconnect;
+
+
+   ----------
+   -- Logging
+   --
+
+   the_Logger : Event.Logger.text.view;
+
+
+   procedure use_text_Logger (log_Filename : in String)
+   is
+   begin
+      the_Logger := new Event.Logger.text.item' (Event.Logger.text.to_Logger (log_Filename));
+
+      lace.Subject .Logger_is (the_Logger.all'Access);
+      lace.Observer.Logger_is (the_Logger.all'Access);
+   end use_text_Logger;
+
+
+   function Logger return lace.event.Logger.view
+   is
+   begin
+      return the_Logger.all'Access;
+   end Logger;
+
+
+   --------------
+   -- Termination
+   --
+
+   procedure close
+   is
+      use type Event.Logger.text.view;
+   begin
+      if the_Logger /= null
+      then
+         declare
+            procedure deallocate is new ada.unchecked_Deallocation (Event.Logger.text.item'Class,
+                                                                    Event.Logger.text.view);
+         begin
+            the_Logger.destruct;
+            deallocate (the_Logger);
+         end;
+      end if;
+   end close;
+
+
+end lace.Event.utility;

1-base/lace/source/events/utility/lace-event-utility.ads

@@ -0,0 +1,71 @@
+with
+     lace.Observer,
+     lace.Subject,
+     lace.Response,
+     lace.Event.Logger,
+
+     ada.Tags;
+
+
+package lace.Event.utility
+--
+--  Provides convenience subprograms for working with events.
+--
+is
+   --------------
+   -- Event Kinds
+   --
+
+   function Name_of (Kind : in Event.Kind)   return String;
+
+   function to_Kind (From : in ada.Tags.Tag) return Event.Kind;
+   function "+"     (From : in ada.Tags.Tag) return Event.Kind
+                     renames to_Kind;
+
+   ---------
+   -- Events
+   --
+
+   function Name_of (the_Event : in Event.item'Class) return String;
+   function Kind_of (the_Event : in Event.item'Class) return Event.Kind;
+
+
+   --------------
+   -- Connections
+   --
+
+   procedure connect    (the_Observer  : in Observer.view;
+                         to_Subject    : in Subject .view;
+                         with_Response : in Response.view;
+                         to_Event_Kind : in Event.Kind);
+
+   procedure disconnect (the_Observer  : in Observer.view;
+                         from_Subject  : in Subject .view;
+                         for_Response  : in Response.view;
+                         to_Event_Kind : in Event.Kind;
+                         subject_Name  : in String);
+
+   ----------
+   -- Logging
+   --
+
+   procedure use_text_Logger (log_Filename : in String);
+   --
+   --  Requests activation of the default text file logger.
+
+
+   function Logger return lace.Event.Logger.view;
+   --
+   --  Returns the Logger currently in use.
+   --  Returns null, if no Logger is in use.
+
+
+   --------------
+   -- Termination
+   --
+
+   procedure close;
+   --
+   --  Ensures any registered event logger is destroyed.
+
+end lace.Event.utility;

1-base/lace/source/lace-any.ads

@@ -0,0 +1,12 @@
+package lace.Any
+--
+--  Provides a base class for 'any' other class.
+--  Allows for heteroegenous containers.
+--  Similar, in intent, to the 'void*' of C (for Ada tagged types).
+--
+is
+   pragma Pure;
+
+   type         Item is         interface;
+   type limited_Item is limited interface;
+end lace.Any;

1-base/lace/source/lace-fast_pool.adb

@@ -0,0 +1,61 @@
+package body lace.fast_Pool
+is
+
+   type Views is array (1 .. pool_Size) of View;
+
+
+   protected Pool
+   is
+      entry new_Item (the_Item :    out View);
+      entry free     (the_Item : in     View);
+   private
+      Available : Views;
+      Count     : Natural := 0;
+   end Pool;
+
+
+   protected body Pool
+   is
+      entry new_Item (the_Item : out View)
+        when True
+      is
+      begin
+         if Count = 0
+         then
+            the_Item := new Item;
+         else
+            the_Item := Available (Count);
+            Count     := Count - 1;
+         end if;
+      end new_Item;
+
+
+      entry free (the_Item : in View)
+        when True
+      is
+      begin
+         Count             := Count + 1;
+         Available (Count) := the_Item;
+      end free;
+   end Pool;
+
+
+
+   function new_Item return View
+   is
+      Self : View;
+   begin
+      Pool.new_Item (Self);
+      return Self;
+   end new_Item;
+
+
+
+   procedure free (Self : in out View)
+   is
+   begin
+      Pool.free (Self);
+      Self := null;
+   end free;
+
+end lace.fast_Pool;

1-base/lace/source/lace-fast_pool.ads

@@ -0,0 +1,13 @@
+generic
+   type Item is private;
+   type View is access all Item;
+
+   pool_Size : Positive := 5_000;
+
+package lace.fast_Pool
+is
+
+   function  new_Item     return View;
+   procedure free (Self : in out View);
+
+end lace.fast_Pool;

1-base/lace/source/lace-time.adb

@@ -0,0 +1,168 @@
+with
+     gnat.formatted_String,
+     ada.Strings.fixed;
+
+
+package body lace.Time
+is
+
+   function to_milliSeconds (From : microSeconds) return milliSeconds
+   is
+      Round_Up : constant Boolean      := From rem 1_000 >= 500;
+      Result   :          milliSeconds := milliSeconds (From / 1_000);
+   begin
+      if    Round_Up
+        and Result /= 999
+      then
+         Result := Result + 1;
+      end if;
+
+      return Result;
+   end to_milliSeconds;
+
+
+
+   function to_microSeconds (From : milliSeconds) return microSeconds
+   is
+   begin
+      return microSeconds (From) * 1_000;
+   end to_microSeconds;
+
+
+
+   function to_Duration (From : in lace.Time.item) return Duration
+   is
+   begin
+      return
+          Duration (From.Hours   * 60 * 60)
+        + Duration (From.Minutes * 60)
+        + Duration (From.Seconds)
+        + Duration (From.microSeconds) / 1_000_000.0;
+   end to_Duration;
+
+
+
+   function to_Time (From : in Duration) return Time.item
+   is
+      Pad    : Duration := From;
+      Result : Time.item;
+   begin
+      Result.Hours        := Hours (Float'Floor (Float (Pad / (60.0 * 60.0))));
+      Pad                 := Pad - 60.0 * 60.0 * Duration (Result.Hours);
+
+      Result.Minutes      := Minutes (Float'Floor (Float (Pad / 60.0)));
+      Pad                 := Pad - 60.0 * Duration (Result.Minutes);
+
+      Result.Seconds      := Seconds (Float'Floor (Float (Pad)));
+      Pad                 := Duration'Max (Pad - Duration (Result.Seconds),
+                                           0.0);
+
+      Result.microSeconds := microSeconds (Float'Floor (Float (Pad * 1_000_000.0)));
+
+      return Result;
+   end to_Time;
+
+
+
+   function to_Time (Hours        : in Time.Hours        := 0;
+                     Minutes      : in Time.Minutes      := 0;
+                     Seconds      : in Time.Seconds      := 0;
+                     microSeconds : in Time.microSeconds := 0) return Time.item
+   is
+   begin
+      return (Hours, Minutes, Seconds, microSeconds);
+   end to_Time;
+
+
+
+   function Image (Time : lace.Time.item) return String
+   is
+      use gnat.formatted_String;
+
+      Format : constant formatted_String := +"%02d:%02d:%02d.%06d";
+   begin
+      return -(Format
+               & Natural (Time.Hours)
+               & Natural (Time.Minutes)
+               & Natural (Time.Seconds)
+               & Natural (Time.microSeconds));
+   end Image;
+
+
+
+   function Value (Image : in String) return Time.item
+   is
+      use ada.Strings.fixed;
+
+      Result : Time.item;
+
+      First  : Positive := Image'First;
+      Last   : Positive := Index (Image, ":") - 1;
+   begin
+      Result.Hours := Hours'Value (Image (First .. Last));
+
+      First := Last + 2;
+      Last  := Index (Image, ":", From => First) - 1;
+
+      Result.Minutes := Minutes'Value (Image (First .. Last));
+
+      First := Last + 2;
+      Last  := Index (Image, ".", From => First) - 1;
+
+      Result.Seconds := Seconds'Value (Image (First .. Last));
+
+      First := Last + 2;
+      Last  := Image'Last;
+
+      Result.microSeconds := microSeconds'Value (Image (First .. Last));
+
+      return Result;
+   end Value;
+
+
+
+   function "+" (Left, Right : in Item) return Item
+   is
+   begin
+      return to_Time (to_Duration (Left) + to_Duration (Right));
+   exception
+      when constraint_Error =>
+         raise Overflow;
+   end "+";
+
+
+
+   function "-" (Left, Right : in Item) return Item
+   is
+   begin
+      return to_Time (to_Duration (Left) - to_Duration (Right));
+   exception
+      when constraint_Error =>
+         raise Underflow;
+   end "-";
+
+
+
+   function "+" (Left  : in Time.item;   Right : in Duration) return Time.item
+   is
+   begin
+      return to_Time (to_Duration (Left) + Right);
+   exception
+      when constraint_Error =>
+         raise Overflow;
+   end "+";
+
+
+
+   function "-" (Left  : in Time.item;   Right : in Duration) return Time.item
+   is
+   begin
+      return to_Time (to_Duration (Left) - Right);
+   exception
+      when constraint_Error =>
+         raise Underflow;
+   end "-";
+
+
+
+end lace.Time;

1-base/lace/source/lace-time.ads

@@ -0,0 +1,57 @@
+package lace.Time
+--
+-- Time of day.
+--
+is
+   type Hours        is range 0 ..      23;
+   type Minutes      is range 0 ..      59;
+   type Seconds      is range 0 ..      59;
+   type milliSeconds is range 0 ..     999;
+   type microSeconds is range 0 .. 999_999;
+
+
+   function to_milliSeconds (From : microSeconds) return milliSeconds;
+   function to_microSeconds (From : milliSeconds) return microSeconds;
+
+
+   type Item is
+      record
+         Hours        : Time.Hours;
+         Minutes      : Time.Minutes;
+         Seconds      : Time.Seconds;
+         microSeconds : Time.microSeconds;
+      end record;
+
+   zero_Time : constant Time.item;
+
+
+   function to_Duration (From  : in Time.item)         return Duration;
+   function to_Time     (From  : in standard.Duration) return Time.item;
+
+   function to_Time     (Hours        : in Time.Hours        := 0;
+                         Minutes      : in Time.Minutes      := 0;
+                         Seconds      : in Time.Seconds      := 0;
+                         microSeconds : in Time.microSeconds := 0) return Time.item;
+
+   function Image (Time  : in Item)   return String;     -- Format: HH:MM:SS.mmmmmm
+   function Value (Image : in String) return Time.item;
+
+
+   Overflow  : exception;
+   Underflow : exception;
+
+   function "+" (Left, Right : in Time.item) return Time.item;
+   function "-" (Left, Right : in Time.item) return Time.item;
+
+   function "+" (Left  : in Time.item;   Right : in Duration) return Time.item;
+   function "-" (Left  : in Time.item;   Right : in Duration) return Time.item;
+
+
+
+private
+   zero_Time : constant Time.item := (Hours        => 0,
+                                      Minutes      => 0,
+                                      Seconds      => 0,
+                                      microSeconds => 0);
+
+end lace.Time;

1-base/lace/source/lace.ads

@@ -0,0 +1,9 @@
+package Lace
+--
+--  A namespace to contain the 'Lace' family of packages.
+--
+--  The 'Lace' family provides a base set of utility packages.
+--
+is
+   pragma Pure;
+end Lace;

1-base/lace/source/strings/lace-strings-bounded.adb

@@ -0,0 +1,108 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                  A D A . S T R I N G S . B O U N D E D                   --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+--                                                                          --
+--                                                                          --
+--                                                                          --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body lace.Strings.Bounded
+is
+
+   package body Generic_Bounded_Length
+   is
+      --  The subprograms in this body are those for which there is no
+      --  Bounded_String input, and hence no implicit information on the
+      --  maximum size. This means that the maximum size has to be passed
+      --  explicitly to the routine in Superbounded.
+
+      ---------
+      -- "*" --
+      ---------
+
+      function "*"
+        (Left  : Natural;
+         Right : Character) return Bounded_String
+      is
+      begin
+         return Times (Left, Right, Max_Length);
+      end "*";
+
+      function "*"
+        (Left  : Natural;
+         Right : String) return Bounded_String
+      is
+      begin
+         return Times (Left, Right, Max_Length);
+      end "*";
+
+      -----------------
+      -- From_String --
+      -----------------
+
+      function From_String (Source : String) return Bounded_String
+      is
+      begin
+         return To_Super_String (Source, Max_Length, Error);
+      end From_String;
+
+      ---------------
+      -- Replicate --
+      ---------------
+
+      function Replicate
+        (Count : Natural;
+         Item  : Character;
+         Drop  : ada.Strings.Truncation := ada.Strings.Error) return Bounded_String
+      is
+      begin
+         return Super_Replicate (Count, Item, Drop, Max_Length);
+      end Replicate;
+
+      function Replicate
+        (Count : Natural;
+         Item  : String;
+         Drop  : ada.Strings.Truncation := ada.Strings.Error) return Bounded_String
+      is
+      begin
+         return Super_Replicate (Count, Item, Drop, Max_Length);
+      end Replicate;
+
+      -----------------------
+      -- To_Bounded_String --
+      -----------------------
+
+      function To_Bounded_String
+        (Source : String;
+         Drop   : ada.Strings.Truncation := ada.Strings.Error) return Bounded_String
+      is
+      begin
+         return To_Super_String (Source, Max_Length, Drop);
+      end To_Bounded_String;
+
+   end Generic_Bounded_Length;
+
+end lace.Strings.Bounded;

1-base/lace/source/strings/lace-strings-bounded.ads

@@ -0,0 +1,893 @@
+with
+     ada.Strings.Maps,
+     lace.Strings.Superbounded;
+
+
+package lace.Strings.Bounded
+--
+-- Based on the 'ada.Strings.bounded' package provided by FSF GCC.
+--
+-- Modified to be a Pure package for use with DSA.
+--
+is
+   pragma Pure;
+   pragma Preelaborate;
+
+   use Ada.Strings;
+
+
+   generic
+      Max : Positive;
+      --  Maximum length of a Bounded_String
+
+   package Generic_Bounded_Length
+   is
+      Max_Length : constant Positive := Max;
+
+      type Bounded_String is private;
+      pragma Preelaborable_Initialization (Bounded_String);
+
+      Null_Bounded_String : constant Bounded_String;
+
+      subtype Length_Range is Natural range 0 .. Max_Length;
+
+      function Length (Source : Bounded_String) return Length_Range;
+
+      --------------------------------------------------------
+      -- Conversion, Concatenation, and Selection Functions --
+      --------------------------------------------------------
+
+      function To_Bounded_String
+        (Source : String;
+         Drop   : ada.Strings.Truncation := ada.Strings.Error) return Bounded_String;
+
+      function To_String (Source : Bounded_String) return String;
+
+      procedure Set_Bounded_String
+        (Target : out Bounded_String;
+         Source : String;
+         Drop   : Truncation := Error);
+      pragma Ada_05 (Set_Bounded_String);
+
+      function Append
+        (Left  : Bounded_String;
+         Right : Bounded_String;
+         Drop  : Truncation  := Error) return Bounded_String;
+
+      function Append
+        (Left  : Bounded_String;
+         Right : String;
+         Drop  : Truncation := Error) return Bounded_String;
+
+      function Append
+        (Left  : String;
+         Right : Bounded_String;
+         Drop  : Truncation := Error) return Bounded_String;
+
+      function Append
+        (Left  : Bounded_String;
+         Right : Character;
+         Drop  : Truncation := Error) return Bounded_String;
+
+      function Append
+        (Left  : Character;
+         Right : Bounded_String;
+         Drop  : Truncation := Error) return Bounded_String;
+
+      procedure Append
+        (Source   : in out Bounded_String;
+         New_Item : Bounded_String;
+         Drop     : Truncation  := Error);
+
+      procedure Append
+        (Source   : in out Bounded_String;
+         New_Item : String;
+         Drop     : Truncation  := Error);
+
+      procedure Append
+        (Source   : in out Bounded_String;
+         New_Item : Character;
+         Drop     : Truncation  := Error);
+
+      function "&"
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Bounded_String;
+
+      function "&"
+        (Left  : Bounded_String;
+         Right : String) return Bounded_String;
+
+      function "&"
+        (Left  : String;
+         Right : Bounded_String) return Bounded_String;
+
+      function "&"
+        (Left  : Bounded_String;
+         Right : Character) return Bounded_String;
+
+      function "&"
+        (Left  : Character;
+         Right : Bounded_String) return Bounded_String;
+
+      function Element
+        (Source : Bounded_String;
+         Index  : Positive) return Character;
+
+      procedure Replace_Element
+        (Source : in out Bounded_String;
+         Index  : Positive;
+         By     : Character);
+
+      function Slice
+        (Source : Bounded_String;
+         Low    : Positive;
+         High   : Natural) return String;
+
+      function Bounded_Slice
+        (Source : Bounded_String;
+         Low    : Positive;
+         High   : Natural) return Bounded_String;
+      pragma Ada_05 (Bounded_Slice);
+
+      procedure Bounded_Slice
+        (Source : Bounded_String;
+         Target : out Bounded_String;
+         Low    : Positive;
+         High   : Natural);
+      pragma Ada_05 (Bounded_Slice);
+
+      overriding
+      function "="
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean;
+
+      function "="
+        (Left  : Bounded_String;
+         Right : String) return Boolean;
+
+      function "="
+        (Left  : String;
+         Right : Bounded_String) return Boolean;
+
+      function "<"
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean;
+
+      function "<"
+        (Left  : Bounded_String;
+         Right : String) return Boolean;
+
+      function "<"
+        (Left  : String;
+         Right : Bounded_String) return Boolean;
+
+      function "<="
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean;
+
+      function "<="
+        (Left  : Bounded_String;
+         Right : String) return Boolean;
+
+      function "<="
+        (Left  : String;
+         Right : Bounded_String) return Boolean;
+
+      function ">"
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean;
+
+      function ">"
+        (Left  : Bounded_String;
+         Right : String) return Boolean;
+
+      function ">"
+        (Left  : String;
+         Right : Bounded_String) return Boolean;
+
+      function ">="
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean;
+
+      function ">="
+        (Left  : Bounded_String;
+         Right : String) return Boolean;
+
+      function ">="
+        (Left  : String;
+         Right : Bounded_String) return Boolean;
+
+      ----------------------
+      -- Search Functions --
+      ----------------------
+
+      function Index
+        (Source  : Bounded_String;
+         Pattern : String;
+         Going   : Direction := Forward;
+         Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
+
+      function Index
+        (Source  : Bounded_String;
+         Pattern : String;
+         Going   : Direction := Forward;
+         Mapping : Maps.Character_Mapping_Function) return Natural;
+
+      function Index
+        (Source : Bounded_String;
+         Set    : Maps.Character_Set;
+         Test   : Membership := Inside;
+         Going  : Direction  := Forward) return Natural;
+
+      function Index
+        (Source  : Bounded_String;
+         Pattern : String;
+         From    : Positive;
+         Going   : Direction := Forward;
+         Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
+      pragma Ada_05 (Index);
+
+      function Index
+        (Source  : Bounded_String;
+         Pattern : String;
+         From    : Positive;
+         Going   : Direction := Forward;
+         Mapping : Maps.Character_Mapping_Function) return Natural;
+      pragma Ada_05 (Index);
+
+      function Index
+        (Source  : Bounded_String;
+         Set     : Maps.Character_Set;
+         From    : Positive;
+         Test    : Membership := Inside;
+         Going   : Direction := Forward) return Natural;
+      pragma Ada_05 (Index);
+
+      function Index_Non_Blank
+        (Source : Bounded_String;
+         Going  : Direction := Forward) return Natural;
+
+      function Index_Non_Blank
+        (Source : Bounded_String;
+         From   : Positive;
+         Going  : Direction := Forward) return Natural;
+      pragma Ada_05 (Index_Non_Blank);
+
+      function Count
+        (Source  : Bounded_String;
+         Pattern : String;
+         Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
+
+      function Count
+        (Source  : Bounded_String;
+         Pattern : String;
+         Mapping : Maps.Character_Mapping_Function) return Natural;
+
+      function Count
+        (Source : Bounded_String;
+         Set    : Maps.Character_Set) return Natural;
+
+      procedure Find_Token
+        (Source : Bounded_String;
+         Set    : Maps.Character_Set;
+         From   : Positive;
+         Test   : Membership;
+         First  : out Positive;
+         Last   : out Natural);
+      pragma Ada_2012 (Find_Token);
+
+      procedure Find_Token
+        (Source : Bounded_String;
+         Set    : Maps.Character_Set;
+         Test   : Membership;
+         First  : out Positive;
+         Last   : out Natural);
+
+      ------------------------------------
+      -- String Translation Subprograms --
+      ------------------------------------
+
+      function Translate
+        (Source  : Bounded_String;
+         Mapping : Maps.Character_Mapping) return Bounded_String;
+
+      procedure Translate
+        (Source   : in out Bounded_String;
+         Mapping  : Maps.Character_Mapping);
+
+      function Translate
+        (Source  : Bounded_String;
+         Mapping : Maps.Character_Mapping_Function) return Bounded_String;
+
+      procedure Translate
+        (Source  : in out Bounded_String;
+         Mapping : Maps.Character_Mapping_Function);
+
+      ---------------------------------------
+      -- String Transformation Subprograms --
+      ---------------------------------------
+
+      function Replace_Slice
+        (Source : Bounded_String;
+         Low    : Positive;
+         High   : Natural;
+         By     : String;
+         Drop   : Truncation := Error) return Bounded_String;
+
+      procedure Replace_Slice
+        (Source   : in out Bounded_String;
+         Low      : Positive;
+         High     : Natural;
+         By       : String;
+         Drop     : Truncation := Error);
+
+      function Insert
+        (Source   : Bounded_String;
+         Before   : Positive;
+         New_Item : String;
+         Drop     : Truncation := Error) return Bounded_String;
+
+      procedure Insert
+        (Source   : in out Bounded_String;
+         Before   : Positive;
+         New_Item : String;
+         Drop     : Truncation := Error);
+
+      function Overwrite
+        (Source   : Bounded_String;
+         Position : Positive;
+         New_Item : String;
+         Drop     : Truncation := Error) return Bounded_String;
+
+      procedure Overwrite
+        (Source    : in out Bounded_String;
+         Position  : Positive;
+         New_Item  : String;
+         Drop      : Truncation := Error);
+
+      function Delete
+        (Source  : Bounded_String;
+         From    : Positive;
+         Through : Natural) return Bounded_String;
+
+      procedure Delete
+        (Source  : in out Bounded_String;
+         From    : Positive;
+         Through : Natural);
+
+      ---------------------------------
+      -- String Selector Subprograms --
+      ---------------------------------
+
+      function Trim
+        (Source : Bounded_String;
+         Side   : Trim_End) return Bounded_String;
+
+      procedure Trim
+        (Source : in out Bounded_String;
+         Side   : Trim_End);
+
+      function Trim
+        (Source : Bounded_String;
+          Left  : Maps.Character_Set;
+          Right : Maps.Character_Set) return Bounded_String;
+
+      procedure Trim
+        (Source : in out Bounded_String;
+         Left   : Maps.Character_Set;
+         Right  : Maps.Character_Set);
+
+      function Head
+        (Source : Bounded_String;
+         Count  : Natural;
+         Pad    : Character := Space;
+         Drop   : Truncation := Error) return Bounded_String;
+
+      procedure Head
+        (Source : in out Bounded_String;
+         Count  : Natural;
+         Pad    : Character  := Space;
+         Drop   : Truncation := Error);
+
+      function Tail
+        (Source : Bounded_String;
+         Count  : Natural;
+         Pad    : Character  := Space;
+         Drop   : Truncation := Error) return Bounded_String;
+
+      procedure Tail
+        (Source : in out Bounded_String;
+         Count  : Natural;
+         Pad    : Character  := Space;
+         Drop   : Truncation := Error);
+
+      ------------------------------------
+      -- String Constructor Subprograms --
+      ------------------------------------
+
+      function "*"
+        (Left  : Natural;
+         Right : Character) return Bounded_String;
+
+      function "*"
+        (Left  : Natural;
+         Right : String) return Bounded_String;
+
+      function "*"
+        (Left  : Natural;
+         Right : Bounded_String) return Bounded_String;
+
+      function Replicate
+        (Count : Natural;
+         Item  : Character;
+         Drop  : ada.Strings.Truncation := ada.Strings.Error) return Bounded_String;
+
+      function Replicate
+        (Count : Natural;
+         Item  : String;
+         Drop  : Truncation := Error) return Bounded_String;
+
+      function Replicate
+        (Count : Natural;
+         Item  : Bounded_String;
+         Drop  : Truncation := Error) return Bounded_String;
+
+   private
+      --  Most of the implementation is in the separate non generic package
+      --  Ada.Strings.Superbounded. Type Bounded_String is derived from type
+      --  Superbounded.Super_String with the maximum length constraint. In
+      --  almost all cases, the routines in Superbounded can be called with
+      --  no requirement to pass the maximum length explicitly, since there
+      --  is at least one Bounded_String argument from which the maximum
+      --  length can be obtained. For all such routines, the implementation
+      --  in this private part is simply a renaming of the corresponding
+      --  routine in the superbounded package.
+
+      --  The five exceptions are the * and Replicate routines operating on
+      --  character values. For these cases, we have a routine in the body
+      --  that calls the superbounded routine passing the maximum length
+      --  explicitly as an extra parameter.
+
+      type Bounded_String is new Superbounded.Super_String (Max_Length);
+      --  Deriving Bounded_String from Superbounded.Super_String is the
+      --  real trick, it ensures that the type Bounded_String declared in
+      --  the generic instantiation is compatible with the Super_String
+      --  type declared in the Superbounded package.
+
+      function From_String (Source : String) return Bounded_String;
+      --  Private routine used only by Stream_Convert
+
+      pragma Stream_Convert (Bounded_String, From_String, To_String);
+      --  Provide stream routines without dragging in Ada.Streams
+
+      Null_Bounded_String : constant Bounded_String :=
+                              (Max_Length     => Max_Length,
+                               Current_Length => 0,
+                               Data           =>
+                                 [1 .. Max_Length => ASCII.NUL]);
+
+      pragma Inline (To_Bounded_String);
+
+      procedure Set_Bounded_String
+        (Target : out Bounded_String;
+         Source : String;
+         Drop   : Truncation := Error)
+         renames Set_Super_String;
+
+      function Length
+        (Source : Bounded_String) return Length_Range
+         renames Super_Length;
+
+      function To_String
+        (Source : Bounded_String) return String
+         renames Super_To_String;
+
+      function Append
+        (Left  : Bounded_String;
+         Right : Bounded_String;
+         Drop  : Truncation  := Error) return Bounded_String
+         renames Super_Append;
+
+      function Append
+        (Left  : Bounded_String;
+         Right : String;
+         Drop  : Truncation := Error) return Bounded_String
+         renames Super_Append;
+
+      function Append
+        (Left  : String;
+         Right : Bounded_String;
+         Drop  : Truncation := Error) return Bounded_String
+         renames Super_Append;
+
+      function Append
+        (Left  : Bounded_String;
+         Right : Character;
+         Drop  : Truncation := Error) return Bounded_String
+         renames Super_Append;
+
+      function Append
+        (Left  : Character;
+         Right : Bounded_String;
+         Drop  : Truncation := Error) return Bounded_String
+         renames Super_Append;
+
+      procedure Append
+        (Source   : in out Bounded_String;
+         New_Item : Bounded_String;
+         Drop     : Truncation  := Error)
+         renames Super_Append;
+
+      procedure Append
+        (Source   : in out Bounded_String;
+         New_Item : String;
+         Drop     : Truncation  := Error)
+         renames Super_Append;
+
+      procedure Append
+        (Source   : in out Bounded_String;
+         New_Item : Character;
+         Drop     : Truncation  := Error)
+         renames Super_Append;
+
+      function "&"
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Bounded_String
+         renames Concat;
+
+      function "&"
+        (Left  : Bounded_String;
+         Right : String) return Bounded_String
+         renames Concat;
+
+      function "&"
+        (Left  : String;
+         Right : Bounded_String) return Bounded_String
+         renames Concat;
+
+      function "&"
+        (Left  : Bounded_String;
+         Right : Character) return Bounded_String
+         renames Concat;
+
+      function "&"
+        (Left  : Character;
+         Right : Bounded_String) return Bounded_String
+         renames Concat;
+
+      function Element
+        (Source : Bounded_String;
+         Index  : Positive) return Character
+         renames Super_Element;
+
+      procedure Replace_Element
+        (Source : in out Bounded_String;
+         Index  : Positive;
+         By     : Character)
+         renames Super_Replace_Element;
+
+      function Slice
+        (Source : Bounded_String;
+         Low    : Positive;
+         High   : Natural) return String
+         renames Super_Slice;
+
+      function Bounded_Slice
+        (Source : Bounded_String;
+         Low    : Positive;
+         High   : Natural) return Bounded_String
+         renames Super_Slice;
+
+      procedure Bounded_Slice
+        (Source : Bounded_String;
+         Target : out Bounded_String;
+         Low    : Positive;
+         High   : Natural)
+         renames Super_Slice;
+
+      overriding
+      function "="
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean
+         renames Equal;
+
+      function "="
+        (Left  : Bounded_String;
+         Right : String) return Boolean
+         renames Equal;
+
+      function "="
+        (Left  : String;
+         Right : Bounded_String) return Boolean
+         renames Equal;
+
+      function "<"
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean
+         renames Less;
+
+      function "<"
+        (Left  : Bounded_String;
+         Right : String) return Boolean
+         renames Less;
+
+      function "<"
+        (Left  : String;
+         Right : Bounded_String) return Boolean
+         renames Less;
+
+      function "<="
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean
+         renames Less_Or_Equal;
+
+      function "<="
+        (Left  : Bounded_String;
+         Right : String) return Boolean
+         renames Less_Or_Equal;
+
+      function "<="
+        (Left  : String;
+         Right : Bounded_String) return Boolean
+         renames Less_Or_Equal;
+
+      function ">"
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean
+         renames Greater;
+
+      function ">"
+        (Left  : Bounded_String;
+         Right : String) return Boolean
+         renames Greater;
+
+      function ">"
+        (Left  : String;
+         Right : Bounded_String) return Boolean
+         renames Greater;
+
+      function ">="
+        (Left  : Bounded_String;
+         Right : Bounded_String) return Boolean
+         renames Greater_Or_Equal;
+
+      function ">="
+        (Left  : Bounded_String;
+         Right : String) return Boolean
+         renames Greater_Or_Equal;
+
+      function ">="
+        (Left  : String;
+         Right : Bounded_String) return Boolean
+         renames Greater_Or_Equal;
+
+      function Index
+        (Source  : Bounded_String;
+         Pattern : String;
+         Going   : Direction := Forward;
+         Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+         renames Super_Index;
+
+      function Index
+        (Source  : Bounded_String;
+         Pattern : String;
+         Going   : Direction := Forward;
+         Mapping : Maps.Character_Mapping_Function) return Natural
+         renames Super_Index;
+
+      function Index
+        (Source : Bounded_String;
+         Set    : Maps.Character_Set;
+         Test   : Membership := Inside;
+         Going  : Direction  := Forward) return Natural
+         renames Super_Index;
+
+      function Index
+        (Source  : Bounded_String;
+         Pattern : String;
+         From    : Positive;
+         Going   : Direction := Forward;
+         Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+         renames Super_Index;
+
+      function Index
+        (Source  : Bounded_String;
+         Pattern : String;
+         From    : Positive;
+         Going   : Direction := Forward;
+         Mapping : Maps.Character_Mapping_Function) return Natural
+      renames Super_Index;
+
+      function Index
+        (Source  : Bounded_String;
+         Set     : Maps.Character_Set;
+         From    : Positive;
+         Test    : Membership := Inside;
+         Going   : Direction := Forward) return Natural
+      renames Super_Index;
+
+      function Index_Non_Blank
+        (Source : Bounded_String;
+         Going  : Direction := Forward) return Natural
+         renames Super_Index_Non_Blank;
+
+      function Index_Non_Blank
+        (Source : Bounded_String;
+         From   : Positive;
+         Going  : Direction := Forward) return Natural
+         renames Super_Index_Non_Blank;
+
+      function Count
+        (Source  : Bounded_String;
+         Pattern : String;
+         Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+         renames Super_Count;
+
+      function Count
+        (Source  : Bounded_String;
+         Pattern : String;
+         Mapping : Maps.Character_Mapping_Function) return Natural
+         renames Super_Count;
+
+      function Count
+        (Source : Bounded_String;
+         Set    : Maps.Character_Set) return Natural
+         renames Super_Count;
+
+      procedure Find_Token
+        (Source : Bounded_String;
+         Set    : Maps.Character_Set;
+         From   : Positive;
+         Test   : Membership;
+         First  : out Positive;
+         Last   : out Natural)
+         renames Super_Find_Token;
+
+      procedure Find_Token
+        (Source : Bounded_String;
+         Set    : Maps.Character_Set;
+         Test   : Membership;
+         First  : out Positive;
+         Last   : out Natural)
+         renames Super_Find_Token;
+
+      function Translate
+        (Source  : Bounded_String;
+         Mapping : Maps.Character_Mapping) return Bounded_String
+         renames Super_Translate;
+
+      procedure Translate
+        (Source   : in out Bounded_String;
+         Mapping  : Maps.Character_Mapping)
+         renames Super_Translate;
+
+      function Translate
+        (Source  : Bounded_String;
+         Mapping : Maps.Character_Mapping_Function) return Bounded_String
+         renames Super_Translate;
+
+      procedure Translate
+        (Source  : in out Bounded_String;
+         Mapping : Maps.Character_Mapping_Function)
+         renames Super_Translate;
+
+      function Replace_Slice
+        (Source : Bounded_String;
+         Low    : Positive;
+         High   : Natural;
+         By     : String;
+         Drop   : Truncation := Error) return Bounded_String
+         renames Super_Replace_Slice;
+
+      procedure Replace_Slice
+        (Source   : in out Bounded_String;
+         Low      : Positive;
+         High     : Natural;
+         By       : String;
+         Drop     : Truncation := Error)
+         renames Super_Replace_Slice;
+
+      function Insert
+        (Source   : Bounded_String;
+         Before   : Positive;
+         New_Item : String;
+         Drop     : Truncation := Error) return Bounded_String
+         renames Super_Insert;
+
+      procedure Insert
+        (Source   : in out Bounded_String;
+         Before   : Positive;
+         New_Item : String;
+         Drop     : Truncation := Error)
+         renames Super_Insert;
+
+      function Overwrite
+        (Source   : Bounded_String;
+         Position : Positive;
+         New_Item : String;
+         Drop     : Truncation := Error) return Bounded_String
+         renames Super_Overwrite;
+
+      procedure Overwrite
+        (Source    : in out Bounded_String;
+         Position  : Positive;
+         New_Item  : String;
+         Drop      : Truncation := Error)
+         renames Super_Overwrite;
+
+      function Delete
+        (Source  : Bounded_String;
+         From    : Positive;
+         Through : Natural) return Bounded_String
+         renames Super_Delete;
+
+      procedure Delete
+        (Source  : in out Bounded_String;
+         From    : Positive;
+         Through : Natural)
+         renames Super_Delete;
+
+      function Trim
+        (Source : Bounded_String;
+         Side   : Trim_End) return Bounded_String
+         renames Super_Trim;
+
+      procedure Trim
+        (Source : in out Bounded_String;
+         Side   : Trim_End)
+         renames Super_Trim;
+
+      function Trim
+        (Source : Bounded_String;
+         Left   : Maps.Character_Set;
+         Right  : Maps.Character_Set) return Bounded_String
+         renames Super_Trim;
+
+      procedure Trim
+        (Source : in out Bounded_String;
+         Left   : Maps.Character_Set;
+         Right  : Maps.Character_Set)
+         renames Super_Trim;
+
+      function Head
+        (Source : Bounded_String;
+         Count  : Natural;
+         Pad    : Character := Space;
+         Drop   : Truncation := Error) return Bounded_String
+         renames Super_Head;
+
+      procedure Head
+        (Source : in out Bounded_String;
+         Count  : Natural;
+         Pad    : Character  := Space;
+         Drop   : Truncation := Error)
+         renames Super_Head;
+
+      function Tail
+        (Source : Bounded_String;
+         Count  : Natural;
+         Pad    : Character  := Space;
+         Drop   : Truncation := Error) return Bounded_String
+         renames Super_Tail;
+
+      procedure Tail
+        (Source : in out Bounded_String;
+         Count  : Natural;
+         Pad    : Character  := Space;
+         Drop   : Truncation := Error)
+         renames Super_Tail;
+
+      function "*"
+        (Left  : Natural;
+         Right : Bounded_String) return Bounded_String
+         renames Times;
+
+      function Replicate
+        (Count : Natural;
+         Item  : Bounded_String;
+         Drop  : Truncation := Error) return Bounded_String
+         renames Super_Replicate;
+
+   end Generic_Bounded_Length;
+
+end lace.Strings.bounded;

1-base/lace/source/strings/lace-strings-fixed.adb

@@ -0,0 +1,727 @@
+
+--  Note: This code is derived from the ADAR.CSH public domain Ada 83 versions
+--  of the Appendix C string handling packages. One change is to avoid the use
+--  of Is_In, so that we are not dependent on inlining. Note that the search
+--  function implementations are to be found in the auxiliary package
+--  Ada.Strings.Search. Also the Move procedure is directly incorporated (ADAR
+--  used a subunit for this procedure). The number of errors having to do with
+--  bounds of function return results were also fixed, and use of & removed for
+--  efficiency reasons.
+
+with
+     lace.Strings.search;
+
+
+package body lace.Strings.fixed
+is
+   use ada.Strings.Maps;
+
+   ------------------------
+   -- Search Subprograms --
+   ------------------------
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+   renames lace.Strings.Search.Index;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural
+   renames lace.Strings.Search.Index;
+
+   function Index
+     (Source : String;
+      Set    : Maps.Character_Set;
+      Test   : Membership := Inside;
+      Going  : Direction  := Forward) return Natural
+   renames lace.Strings.Search.Index;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+   renames lace.Strings.Search.Index;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural
+   renames lace.Strings.Search.Index;
+
+   function Index
+     (Source  : String;
+      Set     : Maps.Character_Set;
+      From    : Positive;
+      Test    : Membership := Inside;
+      Going   : Direction := Forward) return Natural
+   renames lace.Strings.Search.Index;
+
+   function Index_Non_Blank
+     (Source : String;
+      Going  : Direction := Forward) return Natural
+   renames lace.Strings.Search.Index_Non_Blank;
+
+   function Index_Non_Blank
+     (Source : String;
+      From   : Positive;
+      Going  : Direction := Forward) return Natural
+   renames lace.Strings.Search.Index_Non_Blank;
+
+   function Count
+     (Source  : String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+   renames lace.Strings.Search.Count;
+
+   function Count
+     (Source  : String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping_Function) return Natural
+   renames lace.Strings.Search.Count;
+
+   function Count
+     (Source : String;
+      Set    : Maps.Character_Set) return Natural
+   renames lace.Strings.Search.Count;
+
+   procedure Find_Token
+     (Source : String;
+      Set    : Maps.Character_Set;
+      From   : Positive;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural)
+   renames lace.Strings.Search.Find_Token;
+
+   procedure Find_Token
+     (Source : String;
+      Set    : Maps.Character_Set;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural)
+   renames lace.Strings.Search.Find_Token;
+
+   ---------
+   -- "*" --
+   ---------
+
+   function "*"
+     (Left  : Natural;
+      Right : Character) return String
+   is
+      Result : String (1 .. Left);
+
+   begin
+      for J in Result'Range loop
+         Result (J) := Right;
+      end loop;
+
+      return Result;
+   end "*";
+
+   function "*"
+     (Left  : Natural;
+      Right : String) return String
+   is
+      Result : String (1 .. Left * Right'Length);
+      Ptr    : Integer := 1;
+
+   begin
+      for J in 1 .. Left loop
+         Result (Ptr .. Ptr + Right'Length - 1) := Right;
+         Ptr := Ptr + Right'Length;
+      end loop;
+
+      return Result;
+   end "*";
+
+   ------------
+   -- Delete --
+   ------------
+
+   function Delete
+     (Source  : String;
+      From    : Positive;
+      Through : Natural) return String
+   is
+   begin
+      if From > Through then
+         declare
+            subtype Result_Type is String (1 .. Source'Length);
+
+         begin
+            return Result_Type (Source);
+         end;
+
+      elsif From not in Source'Range
+        or else Through > Source'Last
+      then
+         --  In most cases this raises an exception, but the case of deleting
+         --  a null string at the end of the current one is a special-case, and
+         --  reflects the equivalence with Replace_String (RM A.4.3 (86/3)).
+
+         if From = Source'Last + 1 and then From = Through then
+            return Source;
+         else
+            raise Index_Error;
+         end if;
+
+      else
+         declare
+            Front  : constant Integer := From - Source'First;
+            Result : String (1 .. Source'Length - (Through - From + 1));
+
+         begin
+            Result (1 .. Front) :=
+              Source (Source'First .. From - 1);
+            Result (Front + 1 .. Result'Last) :=
+              Source (Through + 1 .. Source'Last);
+
+            return Result;
+         end;
+      end if;
+   end Delete;
+
+   procedure Delete
+     (Source  : in out String;
+      From    : Positive;
+      Through : Natural;
+      Justify : Alignment := Left;
+      Pad     : Character := Space)
+   is
+   begin
+      Move (Source  => Delete (Source, From, Through),
+            Target  => Source,
+            Justify => Justify,
+            Pad     => Pad);
+   end Delete;
+
+   ----------
+   -- Head --
+   ----------
+
+   function Head
+     (Source : String;
+      Count  : Natural;
+      Pad    : Character := Space) return String
+   is
+      subtype Result_Type is String (1 .. Count);
+   begin
+      if Count < Source'Length then
+         return
+           Result_Type (Source (Source'First .. Source'First + Count - 1));
+
+      else
+         declare
+            Result : Result_Type;
+
+         begin
+            Result (1 .. Source'Length) := Source;
+
+            for J in Source'Length + 1 .. Count loop
+               Result (J) := Pad;
+            end loop;
+
+            return Result;
+         end;
+      end if;
+   end Head;
+
+   procedure Head
+     (Source  : in out String;
+      Count   : Natural;
+      Justify : Alignment := Left;
+      Pad     : Character := Space)
+   is
+   begin
+      Move (Source  => Head (Source, Count, Pad),
+            Target  => Source,
+            Drop    => Error,
+            Justify => Justify,
+            Pad     => Pad);
+   end Head;
+
+   ------------
+   -- Insert --
+   ------------
+
+   function Insert
+     (Source   : String;
+      Before   : Positive;
+      New_Item : String) return String
+   is
+      Result : String (1 .. Source'Length + New_Item'Length);
+      Front  : constant Integer := Before - Source'First;
+
+   begin
+      if Before not in Source'First .. Source'Last + 1 then
+         raise Index_Error;
+      end if;
+
+      Result (1 .. Front) :=
+        Source (Source'First .. Before - 1);
+      Result (Front + 1 .. Front + New_Item'Length) :=
+        New_Item;
+      Result (Front + New_Item'Length + 1 .. Result'Last) :=
+        Source (Before .. Source'Last);
+
+      return Result;
+   end Insert;
+
+   procedure Insert
+     (Source   : in out String;
+      Before   : Positive;
+      New_Item : String;
+      Drop     : Truncation := Error)
+   is
+   begin
+      Move (Source => Insert (Source, Before, New_Item),
+            Target => Source,
+            Drop   => Drop);
+   end Insert;
+
+   ----------
+   -- Move --
+   ----------
+
+   procedure Move
+     (Source  : String;
+      Target  : out String;
+      Drop    : Truncation := Error;
+      Justify : Alignment  := Left;
+      Pad     : Character  := Space)
+   is
+      Sfirst  : constant Integer := Source'First;
+      Slast   : constant Integer := Source'Last;
+      Slength : constant Integer := Source'Length;
+
+      Tfirst  : constant Integer := Target'First;
+      Tlast   : constant Integer := Target'Last;
+      Tlength : constant Integer := Target'Length;
+
+      function Is_Padding (Item : String) return Boolean;
+      --  Check if Item is all Pad characters, return True if so, False if not
+
+      function Is_Padding (Item : String) return Boolean is
+      begin
+         for J in Item'Range loop
+            if Item (J) /= Pad then
+               return False;
+            end if;
+         end loop;
+
+         return True;
+      end Is_Padding;
+
+   --  Start of processing for Move
+
+   begin
+      if Slength = Tlength then
+         Target := Source;
+
+      elsif Slength > Tlength then
+         case Drop is
+            when Left =>
+               Target := Source (Slast - Tlength + 1 .. Slast);
+
+            when Right =>
+               Target := Source (Sfirst .. Sfirst + Tlength - 1);
+
+            when Error =>
+               case Justify is
+                  when Left =>
+                     if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
+                        Target :=
+                          Source (Sfirst .. Sfirst + Target'Length - 1);
+                     else
+                        raise Length_Error;
+                     end if;
+
+                  when Right =>
+                     if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
+                        Target := Source (Slast - Tlength + 1 .. Slast);
+                     else
+                        raise Length_Error;
+                     end if;
+
+                  when Center =>
+                     raise Length_Error;
+               end case;
+         end case;
+
+      --  Source'Length < Target'Length
+
+      else
+         case Justify is
+            when Left =>
+               Target (Tfirst .. Tfirst + Slength - 1) := Source;
+
+               for I in Tfirst + Slength .. Tlast loop
+                  Target (I) := Pad;
+               end loop;
+
+            when Right =>
+               for I in Tfirst .. Tlast - Slength loop
+                  Target (I) := Pad;
+               end loop;
+
+               Target (Tlast - Slength + 1 .. Tlast) := Source;
+
+            when Center =>
+               declare
+                  Front_Pad   : constant Integer := (Tlength - Slength) / 2;
+                  Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
+
+               begin
+                  for I in Tfirst .. Tfirst_Fpad - 1 loop
+                     Target (I) := Pad;
+                  end loop;
+
+                  Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
+
+                  for I in Tfirst_Fpad + Slength .. Tlast loop
+                     Target (I) := Pad;
+                  end loop;
+               end;
+         end case;
+      end if;
+   end Move;
+
+   ---------------
+   -- Overwrite --
+   ---------------
+
+   function Overwrite
+     (Source   : String;
+      Position : Positive;
+      New_Item : String) return String
+   is
+   begin
+      if Position not in Source'First .. Source'Last + 1 then
+         raise Index_Error;
+      end if;
+
+      declare
+         Result_Length : constant Natural :=
+           Integer'Max
+             (Source'Length,
+              Position - Source'First + New_Item'Length);
+
+         Result : String (1 .. Result_Length);
+         Front  : constant Integer := Position - Source'First;
+
+      begin
+         Result (1 .. Front) :=
+           Source (Source'First .. Position - 1);
+         Result (Front + 1 .. Front + New_Item'Length) :=
+           New_Item;
+         Result (Front + New_Item'Length + 1 .. Result'Length) :=
+           Source (Position + New_Item'Length .. Source'Last);
+         return Result;
+      end;
+   end Overwrite;
+
+   procedure Overwrite
+     (Source   : in out String;
+      Position : Positive;
+      New_Item : String;
+      Drop     : Truncation := Right)
+   is
+   begin
+      Move (Source => Overwrite (Source, Position, New_Item),
+            Target => Source,
+            Drop   => Drop);
+   end Overwrite;
+
+   -------------------
+   -- Replace_Slice --
+   -------------------
+
+   function Replace_Slice
+     (Source : String;
+      Low    : Positive;
+      High   : Natural;
+      By     : String) return String
+   is
+   begin
+      if Low > Source'Last + 1 or else High < Source'First - 1 then
+         raise Index_Error;
+      end if;
+
+      if High >= Low then
+         declare
+            Front_Len : constant Integer :=
+              Integer'Max (0, Low - Source'First);
+            --  Length of prefix of Source copied to result
+
+            Back_Len : constant Integer :=
+              Integer'Max (0, Source'Last - High);
+            --  Length of suffix of Source copied to result
+
+            Result_Length : constant Integer :=
+              Front_Len + By'Length + Back_Len;
+            --  Length of result
+
+            Result : String (1 .. Result_Length);
+
+         begin
+            Result (1 .. Front_Len) := Source (Source'First .. Low - 1);
+            Result (Front_Len + 1 .. Front_Len + By'Length) := By;
+            Result (Front_Len + By'Length + 1 .. Result'Length) :=
+              Source (High + 1 .. Source'Last);
+            return Result;
+         end;
+
+      else
+         return Insert (Source, Before => Low, New_Item => By);
+      end if;
+   end Replace_Slice;
+
+   procedure Replace_Slice
+     (Source   : in out String;
+      Low      : Positive;
+      High     : Natural;
+      By       : String;
+      Drop     : Truncation := Error;
+      Justify  : Alignment  := Left;
+      Pad      : Character  := Space)
+   is
+   begin
+      Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
+   end Replace_Slice;
+
+   ----------
+   -- Tail --
+   ----------
+
+   function Tail
+     (Source : String;
+      Count  : Natural;
+      Pad    : Character := Space) return String
+   is
+      subtype Result_Type is String (1 .. Count);
+
+   begin
+      if Count < Source'Length then
+         return Result_Type (Source (Source'Last - Count + 1 .. Source'Last));
+
+      --  Pad on left
+
+      else
+         declare
+            Result : Result_Type;
+
+         begin
+            for J in 1 .. Count - Source'Length loop
+               Result (J) := Pad;
+            end loop;
+
+            Result (Count - Source'Length + 1 .. Count) := Source;
+            return Result;
+         end;
+      end if;
+   end Tail;
+
+   procedure Tail
+     (Source  : in out String;
+      Count   : Natural;
+      Justify : Alignment := Left;
+      Pad     : Character := Space)
+   is
+   begin
+      Move (Source  => Tail (Source, Count, Pad),
+            Target  => Source,
+            Drop    => Error,
+            Justify => Justify,
+            Pad     => Pad);
+   end Tail;
+
+   ---------------
+   -- Translate --
+   ---------------
+
+   function Translate
+     (Source  : String;
+      Mapping : Maps.Character_Mapping) return String
+   is
+      Result : String (1 .. Source'Length);
+
+   begin
+      for J in Source'Range loop
+         Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
+      end loop;
+
+      return Result;
+   end Translate;
+
+   procedure Translate
+     (Source  : in out String;
+      Mapping : Maps.Character_Mapping)
+   is
+   begin
+      for J in Source'Range loop
+         Source (J) := Value (Mapping, Source (J));
+      end loop;
+   end Translate;
+
+   function Translate
+     (Source  : String;
+      Mapping : Maps.Character_Mapping_Function) return String
+   is
+      Result : String (1 .. Source'Length);
+      pragma Unsuppress (Access_Check);
+
+   begin
+      for J in Source'Range loop
+         Result (J - (Source'First - 1)) := Mapping.all (Source (J));
+      end loop;
+
+      return Result;
+   end Translate;
+
+   procedure Translate
+     (Source  : in out String;
+      Mapping : Maps.Character_Mapping_Function)
+   is
+      pragma Unsuppress (Access_Check);
+   begin
+      for J in Source'Range loop
+         Source (J) := Mapping.all (Source (J));
+      end loop;
+   end Translate;
+
+   ----------
+   -- Trim --
+   ----------
+
+   function Trim
+     (Source : String;
+      Side   : Trim_End) return String
+   is
+   begin
+      case Side is
+         when ada.Strings.Left =>
+            declare
+               Low : constant Natural := Index_Non_Blank (Source, Forward);
+            begin
+               --  All blanks case
+
+               if Low = 0 then
+                  return "";
+               end if;
+
+               declare
+                  subtype Result_Type is String (1 .. Source'Last - Low + 1);
+               begin
+                  return Result_Type (Source (Low .. Source'Last));
+               end;
+            end;
+
+         when ada.Strings.Right =>
+            declare
+               High : constant Natural := Index_Non_Blank (Source, Backward);
+            begin
+               --  All blanks case
+
+               if High = 0 then
+                  return "";
+               end if;
+
+               declare
+                  subtype Result_Type is String (1 .. High - Source'First + 1);
+               begin
+                  return Result_Type (Source (Source'First .. High));
+               end;
+            end;
+
+         when ada.Strings.Both =>
+            declare
+               Low : constant Natural := Index_Non_Blank (Source, Forward);
+            begin
+               --  All blanks case
+
+               if Low = 0 then
+                  return "";
+               end if;
+
+               declare
+                  High : constant Natural :=
+                    Index_Non_Blank (Source, Backward);
+                  subtype Result_Type is String (1 .. High - Low + 1);
+               begin
+                  return Result_Type (Source (Low .. High));
+               end;
+            end;
+      end case;
+   end Trim;
+
+   procedure Trim
+     (Source  : in out String;
+      Side    : Trim_End;
+      Justify : Alignment := Left;
+      Pad     : Character := Space)
+   is
+   begin
+      Move (Trim (Source, Side),
+            Source,
+            Justify => Justify,
+            Pad => Pad);
+   end Trim;
+
+   function Trim
+     (Source : String;
+      Left   : Maps.Character_Set;
+      Right  : Maps.Character_Set) return String
+   is
+      High, Low : Integer;
+
+   begin
+      Low := Index (Source, Set => Left, Test  => Outside, Going => Forward);
+
+      --  Case where source comprises only characters in Left
+
+      if Low = 0 then
+         return "";
+      end if;
+
+      High :=
+        Index (Source, Set => Right, Test  => Outside, Going => Backward);
+
+      --  Case where source comprises only characters in Right
+
+      if High = 0 then
+         return "";
+      end if;
+
+      declare
+         subtype Result_Type is String (1 .. High - Low + 1);
+
+      begin
+         return Result_Type (Source (Low .. High));
+      end;
+   end Trim;
+
+   procedure Trim
+     (Source  : in out String;
+      Left    : Maps.Character_Set;
+      Right   : Maps.Character_Set;
+      Justify : Alignment := ada.Strings.Left;
+      Pad     : Character := Space)
+   is
+   begin
+      Move (Source  => Trim (Source, Left, Right),
+            Target  => Source,
+            Justify => Justify,
+            Pad     => Pad);
+   end Trim;
+
+end lace.Strings.fixed;

1-base/lace/source/strings/lace-strings-fixed.ads

@@ -0,0 +1,594 @@
+--  Preconditions in this unit are meant for analysis only, not for run-time
+--  checking, so that the expected exceptions are raised. This is enforced by
+--  setting the corresponding assertion policy to Ignore.
+
+pragma Assertion_Policy (Pre => Ignore);
+
+with
+     ada.Strings.Maps;
+
+--  The language-defined package Strings.Fixed provides string-handling
+--  subprograms for fixed-length strings; that is, for values of type
+--  Standard.String. Several of these subprograms are procedures that modify
+--  the contents of a String that is passed as an out or an in out parameter;
+--  each has additional parameters to control the effect when the logical
+--  length of the result differs from the parameter's length.
+--
+--  For each function that returns a String, the lower bound of the returned
+--  value is 1.
+--
+--  The basic model embodied in the package is that a fixed-length string
+--  comprises significant characters and possibly padding (with space
+--  characters) on either or both ends. When a shorter string is copied to a
+--  longer string, padding is inserted, and when a longer string is copied to a
+--  shorter one, padding is stripped. The Move procedure in Strings.Fixed,
+--  which takes a String as an out parameter, allows the programmer to control
+--  these effects. Similar control is provided by the string transformation
+--  procedures.
+
+
+package lace.Strings.fixed with SPARK_Mode
+--
+-- Based on the 'ada.Strings.fixed' package provided by FSF GCC.
+--
+-- Modified to be a Pure package for use with DSA.
+--
+is
+   pragma Pure;
+   pragma Preelaborate;
+
+   use ada.Strings; --,
+--       ada.Strings.Maps;
+
+
+   --------------------------------------------------------------
+   -- Copy Procedure for Strings of Possibly Different Lengths --
+   --------------------------------------------------------------
+
+   procedure Move
+     (Source  : String;
+      Target  : out String;
+      Drop    : Truncation := Error;
+      Justify : Alignment  := Left;
+      Pad     : Character  := Space)
+   with
+
+     --  Incomplete contract
+
+     Global => null;
+   --  The Move procedure copies characters from Source to Target. If Source
+   --  has the same length as Target, then the effect is to assign Source to
+   --  Target. If Source is shorter than Target then:
+   --
+   --  * If Justify=Left, then Source is copied into the first Source'Length
+   --    characters of Target.
+   --
+   --  * If Justify=Right, then Source is copied into the last Source'Length
+   --    characters of Target.
+   --
+   --  * If Justify=Center, then Source is copied into the middle Source'Length
+   --    characters of Target. In this case, if the difference in length
+   --    between Target and Source is odd, then the extra Pad character is on
+   --    the right.
+   --
+   --  * Pad is copied to each Target character not otherwise assigned.
+   --
+   --  If Source is longer than Target, then the effect is based on Drop.
+   --
+   --  * If Drop=Left, then the rightmost Target'Length characters of Source
+   --    are copied into Target.
+   --
+   --  * If Drop=Right, then the leftmost Target'Length characters of Source
+   --    are copied into Target.
+   --
+   --  * If Drop=Error, then the effect depends on the value of the Justify
+   --    parameter and also on whether any characters in Source other than Pad
+   --    would fail to be copied:
+   --
+   --    * If Justify=Left, and if each of the rightmost
+   --      Source'Length-Target'Length characters in Source is Pad, then the
+   --      leftmost Target'Length characters of Source are copied to Target.
+   --
+   --    * If Justify=Right, and if each of the leftmost
+   --      Source'Length-Target'Length characters in Source is Pad, then the
+   --      rightmost Target'Length characters of Source are copied to Target.
+   --
+   --    * Otherwise, Length_Error is propagated.
+
+   ------------------------
+   -- Search Subprograms --
+   ------------------------
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural
+   with
+     Pre    =>
+       Pattern'Length /= 0
+         and then (if Source'Length /= 0 then From in Source'Range),
+     Global => null;
+   pragma Ada_05 (Index);
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+   with
+     Pre    =>
+       Pattern'Length /= 0
+         and then (if Source'Length /= 0 then From in Source'Range),
+     Global => null;
+   pragma Ada_05 (Index);
+
+   --  Each Index function searches, starting from From, for a slice of
+   --  Source, with length Pattern'Length, that matches Pattern with respect to
+   --  Mapping; the parameter Going indicates the direction of the lookup. If
+   --  Source is the null string, Index returns 0; otherwise, if From is not in
+   --  Source'Range, then Index_Error is propagated. If Going = Forward, then
+   --  Index returns the smallest index I which is greater than or equal to
+   --  From such that the slice of Source starting at I matches Pattern. If
+   --  Going = Backward, then Index returns the largest index I such that the
+   --  slice of Source starting at I matches Pattern and has an upper bound
+   --  less than or equal to From. If there is no such slice, then 0 is
+   --  returned. If Pattern is the null string, then Pattern_Error is
+   --  propagated.
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+   with
+     Pre    => Pattern'Length > 0,
+     Global => null;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural
+   with
+     Pre    => Pattern'Length /= 0,
+     Global => null;
+
+   --  If Going = Forward, returns:
+   --
+   --     Index (Source, Pattern, Source'First, Forward, Mapping)
+   --
+   --  otherwise, returns:
+   --
+   --     Index (Source, Pattern, Source'Last, Backward, Mapping).
+
+   function Index
+     (Source : String;
+      Set    : Maps.Character_Set;
+      Test   : Membership := Inside;
+      Going  : Direction  := Forward) return Natural
+   with
+     Global => null;
+
+   function Index
+     (Source  : String;
+      Set     : Maps.Character_Set;
+      From    : Positive;
+      Test    : Membership := Inside;
+      Going   : Direction := Forward) return Natural
+   with
+     Pre    => (if Source'Length /= 0 then From in Source'Range),
+     Global => null;
+   pragma Ada_05 (Index);
+   --  Index searches for the first or last occurrence of any of a set of
+   --  characters (when Test=Inside), or any of the complement of a set of
+   --  characters (when Test=Outside). If Source is the null string, Index
+   --  returns 0; otherwise, if From is not in Source'Range, then Index_Error
+   --  is propagated. Otherwise, it returns the smallest index I >= From (if
+   --  Going=Forward) or the largest index I <= From (if Going=Backward) such
+   --  that Source(I) satisfies the Test condition with respect to Set; it
+   --  returns 0 if there is no such Character in Source.
+
+   function Index_Non_Blank
+     (Source : String;
+      From   : Positive;
+      Going  : Direction := Forward) return Natural
+   with
+     Pre   => (if Source'Length /= 0 then From in Source'Range),
+     Global => null;
+   pragma Ada_05 (Index_Non_Blank);
+   --  Returns Index (Source, Maps.To_Set(Space), From, Outside, Going)
+
+   function Index_Non_Blank
+     (Source : String;
+      Going  : Direction := Forward) return Natural
+   with
+     Global => null;
+   --  Returns Index (Source, Maps.To_Set(Space), Outside, Going)
+
+   function Count
+     (Source  : String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+   with
+     Pre    => Pattern'Length /= 0,
+     Global => null;
+
+   function Count
+     (Source  : String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping_Function) return Natural
+   with
+     Pre    => Pattern'Length /= 0,
+     Global => null;
+
+   --  Returns the maximum number of nonoverlapping slices of Source that match
+   --  Pattern with respect to Mapping. If Pattern is the null string then
+   --  Pattern_Error is propagated.
+
+   function Count
+     (Source : String;
+      Set    : Maps.Character_Set) return Natural
+   with
+     Global => null;
+   --  Returns the number of occurrences in Source of characters that are in
+   --  Set.
+
+   procedure Find_Token
+     (Source : String;
+      Set    : Maps.Character_Set;
+      From   : Positive;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural)
+   with
+     Pre    => (if Source'Length /= 0 then From in Source'Range),
+     Global => null;
+   pragma Ada_2012 (Find_Token);
+   --  If Source is not the null string and From is not in Source'Range, then
+   --  Index_Error is raised. Otherwise, First is set to the index of the first
+   --  character in Source(From .. Source'Last) that satisfies the Test
+   --  condition. Last is set to the largest index such that all characters in
+   --  Source(First .. Last) satisfy the Test condition. If no characters in
+   --  Source(From .. Source'Last) satisfy the Test condition, First is set to
+   --  From, and Last is set to 0.
+
+   procedure Find_Token
+     (Source : String;
+      Set    : Maps.Character_Set;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural)
+   with
+     Global => null;
+   --  Equivalent to Find_Token (Source, Set, Source'First, Test, First, Last)
+
+   ------------------------------------
+   -- String Translation Subprograms --
+   ------------------------------------
+
+   function Translate
+     (Source  : String;
+      Mapping : Maps.Character_Mapping_Function) return String
+   with
+     Post   => Translate'Result'Length = Source'Length,
+     Global => null;
+
+   function Translate
+     (Source  : String;
+      Mapping : Maps.Character_Mapping) return String
+   with
+     Post   => Translate'Result'Length = Source'Length,
+     Global => null;
+
+   --  Returns the string S whose length is Source'Length and such that S (I)
+   --  is the character to which Mapping maps the corresponding element of
+   --  Source, for I in 1 .. Source'Length.
+
+   procedure Translate
+     (Source  : in out String;
+      Mapping : Maps.Character_Mapping_Function)
+   with
+     Global => null;
+
+   procedure Translate
+     (Source  : in out String;
+      Mapping : Maps.Character_Mapping)
+   with
+     Global => null;
+
+   --  Equivalent to Source := Translate(Source, Mapping)
+
+   ---------------------------------------
+   -- String Transformation Subprograms --
+   ---------------------------------------
+
+   procedure Replace_Slice
+     (Source  : in out String;
+      Low     : Positive;
+      High    : Natural;
+      By      : String;
+      Drop    : Truncation := Error;
+      Justify : Alignment  := Left;
+      Pad     : Character  := Space)
+   with
+     Pre    =>
+
+       --  Incomplete contract
+
+       Low - 1 <= Source'Last
+         and then High >= Source'First - 1,
+     Global => null;
+   --  If Low > Source'Last+1, or High < Source'First - 1, then Index_Error is
+   --  propagated. Otherwise:
+   --
+   --  * If High >= Low, then the returned string comprises
+   --    Source (Source'First .. Low - 1)
+   --    & By & Source(High + 1 .. Source'Last), but with lower bound 1.
+   --
+   --  * If High < Low, then the returned string is
+   --    Insert (Source, Before => Low, New_Item => By).
+
+   function Replace_Slice
+     (Source : String;
+      Low    : Positive;
+      High   : Natural;
+      By     : String) return String
+   with
+     Pre            =>
+       Low - 1 <= Source'Last
+         and then High >= Source'First - 1
+         and then (if High >= Low
+                   then Natural'Max (0, Low - Source'First)
+                     <= Natural'Last - By'Length
+                      - Natural'Max (Source'Last - High, 0)
+                   else Source'Length <= Natural'Last - By'Length),
+     Contract_Cases =>
+       (High >= Low =>
+          Replace_Slice'Result'Length
+        = Natural'Max (0, Low - Source'First)
+        + By'Length
+        + Natural'Max (Source'Last - High, 0),
+        others      =>
+          Replace_Slice'Result'Length = Source'Length + By'Length),
+     Global         => null;
+   --  Equivalent to:
+   --
+   --    Move (Replace_Slice (Source, Low, High, By),
+   --          Source, Drop, Justify, Pad).
+
+   function Insert
+     (Source   : String;
+      Before   : Positive;
+      New_Item : String) return String
+   with
+     Pre    =>
+       Before - 1 in Source'First - 1 .. Source'Last
+         and then Source'Length <= Natural'Last - New_Item'Length,
+     Post   => Insert'Result'Length = Source'Length + New_Item'Length,
+     Global => null;
+   --  Propagates Index_Error if Before is not in
+   --  Source'First .. Source'Last+1; otherwise, returns
+   --  Source (Source'First .. Before - 1)
+   --  & New_Item & Source(Before..Source'Last), but with lower bound 1.
+
+   procedure Insert
+     (Source   : in out String;
+      Before   : Positive;
+      New_Item : String;
+      Drop     : Truncation := Error)
+   with
+     Pre    => Before - 1 in Source'First - 1 .. Source'Last,
+
+     --  Incomplete contract
+
+     Global => null;
+   --  Equivalent to Move (Insert (Source, Before, New_Item), Source, Drop)
+
+   function Overwrite
+     (Source   : String;
+      Position : Positive;
+      New_Item : String) return String
+   with
+     Pre    =>
+       Position - 1 in Source'First - 1 .. Source'Last
+         and then
+       (if Position - Source'First >= Source'Length - New_Item'Length
+        then Position - Source'First <= Natural'Last - New_Item'Length),
+     Post   =>
+       Overwrite'Result'Length
+     = Integer'Max (Source'Length,
+                    Position - Source'First + New_Item'Length),
+     Global => null;
+   --  Propagates Index_Error if Position is not in
+   --  Source'First .. Source'Last + 1; otherwise, returns the string obtained
+   --  from Source by consecutively replacing characters starting at Position
+   --  with corresponding characters from New_Item. If the end of Source is
+   --  reached before the characters in New_Item are exhausted, the remaining
+   --  characters from New_Item are appended to the string.
+
+   procedure Overwrite
+     (Source   : in out String;
+      Position : Positive;
+      New_Item : String;
+      Drop     : Truncation := Right)
+   with
+     Pre    => Position - 1 in Source'First - 1 .. Source'Last,
+
+     --  Incomplete contract
+
+     Global => null;
+   --  Equivalent to Move(Overwrite(Source, Position, New_Item), Source, Drop)
+
+   function Delete
+     (Source  : String;
+      From    : Positive;
+      Through : Natural) return String
+   with
+     Pre    => (if From <= Through
+                then (From in Source'Range
+                        and then Through <= Source'Last)),
+     Post   =>
+       Delete'Result'Length
+     = Source'Length - (if From <= Through
+                        then Through - From + 1
+                        else 0),
+     Global => null;
+   --  If From <= Through, the returned string is
+   --  Replace_Slice(Source, From, Through, ""); otherwise, it is Source with
+   --  lower bound 1.
+
+   procedure Delete
+     (Source  : in out String;
+      From    : Positive;
+      Through : Natural;
+      Justify : Alignment := Left;
+      Pad     : Character := Space)
+   with
+     Pre    => (if From <= Through
+                then (From in Source'Range
+                        and then Through <= Source'Last)),
+
+     --  Incomplete contract
+
+     Global => null;
+   --  Equivalent to:
+   --
+   --     Move (Delete (Source, From, Through),
+   --           Source, Justify => Justify, Pad => Pad).
+
+   ---------------------------------
+   -- String Selector Subprograms --
+   ---------------------------------
+
+   function Trim
+     (Source : String;
+      Side   : Trim_End) return String
+   with
+     Post   => Trim'Result'Length <= Source'Length,
+     Global => null;
+   --  Returns the string obtained by removing from Source all leading Space
+   --  characters (if Side = Left), all trailing Space characters (if
+   --  Side = Right), or all leading and trailing Space characters (if
+   --  Side = Both).
+
+   procedure Trim
+     (Source  : in out String;
+      Side    : Trim_End;
+      Justify : Alignment := Left;
+      Pad     : Character := Space)
+   with
+
+     --  Incomplete contract
+
+     Global => null;
+   --  Equivalent to:
+   --
+   --     Move (Trim (Source, Side), Source, Justify=>Justify, Pad=>Pad).
+
+   function Trim
+     (Source : String;
+      Left   : Maps.Character_Set;
+      Right  : Maps.Character_Set) return String
+   with
+     Post   => Trim'Result'Length <= Source'Length,
+     Global => null;
+   --  Returns the string obtained by removing from Source all leading
+   --  characters in Left and all trailing characters in Right.
+
+   procedure Trim
+     (Source  : in out String;
+      Left    : Maps.Character_Set;
+      Right   : Maps.Character_Set;
+      Justify : Alignment := ada.Strings.Left;
+      Pad     : Character := Space)
+   with
+
+     --  Incomplete contract
+
+     Global => null;
+   --  Equivalent to:
+   --
+   --     Move (Trim (Source, Left, Right),
+   --           Source, Justify => Justify, Pad=>Pad).
+
+   function Head
+     (Source : String;
+      Count  : Natural;
+      Pad    : Character := Space) return String
+   with
+     Post   => Head'Result'Length = Count,
+     Global => null;
+   --  Returns a string of length Count. If Count <= Source'Length, the string
+   --  comprises the first Count characters of Source. Otherwise, its contents
+   --  are Source concatenated with Count - Source'Length Pad characters.
+
+   procedure Head
+     (Source  : in out String;
+      Count   : Natural;
+      Justify : Alignment := Left;
+      Pad     : Character := Space)
+   with
+
+     --  Incomplete contract
+
+     Global => null;
+   --  Equivalent to:
+   --
+   --     Move (Head (Source, Count, Pad),
+   --           Source, Drop => Error, Justify => Justify, Pad => Pad).
+
+   function Tail
+     (Source : String;
+      Count  : Natural;
+      Pad    : Character := Space) return String
+   with
+     Post   => Tail'Result'Length = Count,
+     Global => null;
+   --  Returns a string of length Count. If Count <= Source'Length, the string
+   --  comprises the last Count characters of Source. Otherwise, its contents
+   --  are Count-Source'Length Pad characters concatenated with Source.
+
+   procedure Tail
+     (Source  : in out String;
+      Count   : Natural;
+      Justify : Alignment := Left;
+      Pad     : Character := Space)
+   with
+
+     --  Incomplete contract
+
+     Global => null;
+   --  Equivalent to:
+   --
+   --     Move (Tail (Source, Count, Pad),
+   --           Source, Drop => Error, Justify => Justify, Pad => Pad).
+
+   ----------------------------------
+   -- String Constructor Functions --
+   ----------------------------------
+
+   function "*"
+     (Left  : Natural;
+      Right : Character) return String
+   with
+     Post   => "*"'Result'Length = Left,
+     Global => null;
+
+   function "*"
+     (Left  : Natural;
+      Right : String) return String
+   with
+     Pre    => (if Right'Length /= 0 then Left <= Natural'Last / Right'Length),
+     Post   => "*"'Result'Length = Left * Right'Length,
+     Global => null;
+
+   --  These functions replicate a character or string a specified number of
+   --  times. The first function returns a string whose length is Left and each
+   --  of whose elements is Right. The second function returns a string whose
+   --  length is Left * Right'Length and whose value is the null string if
+   --  Left = 0 and otherwise is (Left - 1)*Right & Right with lower bound 1.
+
+end lace.Strings.fixed;

1-base/lace/source/strings/lace-strings-search.adb

@@ -0,0 +1,576 @@
+with
+     System;
+
+
+package body lace.Strings.Search
+is
+
+   use ada.Strings.Maps,
+       System;
+
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   function Belongs
+     (Element : Character;
+      Set     : Maps.Character_Set;
+      Test    : Membership) return Boolean;
+   pragma Inline (Belongs);
+   --  Determines if the given element is in (Test = Inside) or not in
+   --  (Test = Outside) the given character set.
+
+   -------------
+   -- Belongs --
+   -------------
+
+   function Belongs
+     (Element : Character;
+      Set     : Maps.Character_Set;
+      Test    : Membership) return Boolean
+   is
+   begin
+      if Test = Inside then
+         return Is_In (Element, Set);
+      else
+         return not Is_In (Element, Set);
+      end if;
+   end Belongs;
+
+   -----------
+   -- Count --
+   -----------
+
+   function Count
+     (Source  : String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+   is
+      PL1 : constant Integer := Pattern'Length - 1;
+      Num : Natural;
+      Ind : Natural;
+      Cur : Natural;
+
+   begin
+      if Pattern = "" then
+         raise Pattern_Error;
+      end if;
+
+      Num := 0;
+      Ind := Source'First;
+
+      --  Unmapped case
+
+      if Mapping'Address = Maps.Identity'Address then
+         while Ind <= Source'Last - PL1 loop
+            if Pattern = Source (Ind .. Ind + PL1) then
+               Num := Num + 1;
+               Ind := Ind + Pattern'Length;
+            else
+               Ind := Ind + 1;
+            end if;
+         end loop;
+
+      --  Mapped case
+
+      else
+         while Ind <= Source'Last - PL1 loop
+            Cur := Ind;
+            for K in Pattern'Range loop
+               if Pattern (K) /= Value (Mapping, Source (Cur)) then
+                  Ind := Ind + 1;
+                  goto Cont;
+               else
+                  Cur := Cur + 1;
+               end if;
+            end loop;
+
+            Num := Num + 1;
+            Ind := Ind + Pattern'Length;
+
+         <<Cont>>
+            null;
+         end loop;
+      end if;
+
+      --  Return result
+
+      return Num;
+   end Count;
+
+   function Count
+     (Source  : String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping_Function) return Natural
+   is
+      PL1 : constant Integer := Pattern'Length - 1;
+      Num : Natural;
+      Ind : Natural;
+      Cur : Natural;
+
+   begin
+      if Pattern = "" then
+         raise Pattern_Error;
+      end if;
+
+      --  Check for null pointer in case checks are off
+
+      if Mapping = null then
+         raise Constraint_Error;
+      end if;
+
+      Num := 0;
+      Ind := Source'First;
+      while Ind <= Source'Last - PL1 loop
+         Cur := Ind;
+         for K in Pattern'Range loop
+            if Pattern (K) /= Mapping (Source (Cur)) then
+               Ind := Ind + 1;
+               goto Cont;
+            else
+               Cur := Cur + 1;
+            end if;
+         end loop;
+
+         Num := Num + 1;
+         Ind := Ind + Pattern'Length;
+
+      <<Cont>>
+         null;
+      end loop;
+
+      return Num;
+   end Count;
+
+   function Count
+     (Source : String;
+      Set    : Maps.Character_Set) return Natural
+   is
+      N : Natural := 0;
+
+   begin
+      for J in Source'Range loop
+         if Is_In (Source (J), Set) then
+            N := N + 1;
+         end if;
+      end loop;
+
+      return N;
+   end Count;
+
+   ----------------
+   -- Find_Token --
+   ----------------
+
+   procedure Find_Token
+     (Source : String;
+      Set    : Maps.Character_Set;
+      From   : Positive;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural)
+   is
+   begin
+      for J in From .. Source'Last loop
+         if Belongs (Source (J), Set, Test) then
+            First := J;
+
+            for K in J + 1 .. Source'Last loop
+               if not Belongs (Source (K), Set, Test) then
+                  Last := K - 1;
+                  return;
+               end if;
+            end loop;
+
+            --  Here if J indexes first char of token, and all chars after J
+            --  are in the token.
+
+            Last := Source'Last;
+            return;
+         end if;
+      end loop;
+
+      --  Here if no token found
+
+      First := From;
+      Last  := 0;
+   end Find_Token;
+
+   procedure Find_Token
+     (Source : String;
+      Set    : Maps.Character_Set;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural)
+   is
+   begin
+      for J in Source'Range loop
+         if Belongs (Source (J), Set, Test) then
+            First := J;
+
+            for K in J + 1 .. Source'Last loop
+               if not Belongs (Source (K), Set, Test) then
+                  Last := K - 1;
+                  return;
+               end if;
+            end loop;
+
+            --  Here if J indexes first char of token, and all chars after J
+            --  are in the token.
+
+            Last := Source'Last;
+            return;
+         end if;
+      end loop;
+
+      --  Here if no token found
+
+      First := Source'First;
+      Last  := 0;
+   end Find_Token;
+
+   -----------
+   -- Index --
+   -----------
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+   is
+      PL1 : constant Integer := Pattern'Length - 1;
+      Cur : Natural;
+
+      Ind : Integer;
+      --  Index for start of match check. This can be negative if the pattern
+      --  length is greater than the string length, which is why this variable
+      --  is Integer instead of Natural. In this case, the search loops do not
+      --  execute at all, so this Ind value is never used.
+
+   begin
+      if Pattern = "" then
+         raise Pattern_Error;
+      end if;
+
+      --  Forwards case
+
+      if Going = Forward then
+         Ind := Source'First;
+
+         --  Unmapped forward case
+
+         if Mapping'Address = Maps.Identity'Address then
+            for J in 1 .. Source'Length - PL1 loop
+               if Pattern = Source (Ind .. Ind + PL1) then
+                  return Ind;
+               else
+                  Ind := Ind + 1;
+               end if;
+            end loop;
+
+         --  Mapped forward case
+
+         else
+            for J in 1 .. Source'Length - PL1 loop
+               Cur := Ind;
+
+               for K in Pattern'Range loop
+                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
+                     goto Cont1;
+                  else
+                     Cur := Cur + 1;
+                  end if;
+               end loop;
+
+               return Ind;
+
+            <<Cont1>>
+               Ind := Ind + 1;
+            end loop;
+         end if;
+
+      --  Backwards case
+
+      else
+         --  Unmapped backward case
+
+         Ind := Source'Last - PL1;
+
+         if Mapping'Address = Maps.Identity'Address then
+            for J in reverse 1 .. Source'Length - PL1 loop
+               if Pattern = Source (Ind .. Ind + PL1) then
+                  return Ind;
+               else
+                  Ind := Ind - 1;
+               end if;
+            end loop;
+
+         --  Mapped backward case
+
+         else
+            for J in reverse 1 .. Source'Length - PL1 loop
+               Cur := Ind;
+
+               for K in Pattern'Range loop
+                  if Pattern (K) /= Value (Mapping, Source (Cur)) then
+                     goto Cont2;
+                  else
+                     Cur := Cur + 1;
+                  end if;
+               end loop;
+
+               return Ind;
+
+            <<Cont2>>
+               Ind := Ind - 1;
+            end loop;
+         end if;
+      end if;
+
+      --  Fall through if no match found. Note that the loops are skipped
+      --  completely in the case of the pattern being longer than the source.
+
+      return 0;
+   end Index;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural
+   is
+      PL1 : constant Integer := Pattern'Length - 1;
+      Ind : Natural;
+      Cur : Natural;
+
+   begin
+      if Pattern = "" then
+         raise Pattern_Error;
+      end if;
+
+      --  Check for null pointer in case checks are off
+
+      if Mapping = null then
+         raise Constraint_Error;
+      end if;
+
+      --  If Pattern longer than Source it can't be found
+
+      if Pattern'Length > Source'Length then
+         return 0;
+      end if;
+
+      --  Forwards case
+
+      if Going = Forward then
+         Ind := Source'First;
+         for J in 1 .. Source'Length - PL1 loop
+            Cur := Ind;
+
+            for K in Pattern'Range loop
+               if Pattern (K) /= Mapping.all (Source (Cur)) then
+                  goto Cont1;
+               else
+                  Cur := Cur + 1;
+               end if;
+            end loop;
+
+            return Ind;
+
+         <<Cont1>>
+            Ind := Ind + 1;
+         end loop;
+
+      --  Backwards case
+
+      else
+         Ind := Source'Last - PL1;
+         for J in reverse 1 .. Source'Length - PL1 loop
+            Cur := Ind;
+
+            for K in Pattern'Range loop
+               if Pattern (K) /= Mapping.all (Source (Cur)) then
+                  goto Cont2;
+               else
+                  Cur := Cur + 1;
+               end if;
+            end loop;
+
+            return Ind;
+
+         <<Cont2>>
+            Ind := Ind - 1;
+         end loop;
+      end if;
+
+      --  Fall through if no match found. Note that the loops are skipped
+      --  completely in the case of the pattern being longer than the source.
+
+      return 0;
+   end Index;
+
+   function Index
+     (Source : String;
+      Set    : Maps.Character_Set;
+      Test   : Membership := Inside;
+      Going  : Direction  := Forward) return Natural
+   is
+   begin
+      --  Forwards case
+
+      if Going = Forward then
+         for J in Source'Range loop
+            if Belongs (Source (J), Set, Test) then
+               return J;
+            end if;
+         end loop;
+
+      --  Backwards case
+
+      else
+         for J in reverse Source'Range loop
+            if Belongs (Source (J), Set, Test) then
+               return J;
+            end if;
+         end loop;
+      end if;
+
+      --  Fall through if no match
+
+      return 0;
+   end Index;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural
+   is
+   begin
+      if Going = Forward then
+         if From < Source'First then
+            raise Index_Error;
+         end if;
+
+         return
+           Index (Source (From .. Source'Last), Pattern, Forward, Mapping);
+
+      else
+         if From > Source'Last then
+            raise Index_Error;
+         end if;
+
+         return
+           Index (Source (Source'First .. From), Pattern, Backward, Mapping);
+      end if;
+   end Index;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural
+   is
+   begin
+      if Going = Forward then
+         if From < Source'First then
+            raise Index_Error;
+         end if;
+
+         return Index
+           (Source (From .. Source'Last), Pattern, Forward, Mapping);
+
+      else
+         if From > Source'Last then
+            raise Index_Error;
+         end if;
+
+         return Index
+           (Source (Source'First .. From), Pattern, Backward, Mapping);
+      end if;
+   end Index;
+
+   function Index
+     (Source  : String;
+      Set     : Maps.Character_Set;
+      From    : Positive;
+      Test    : Membership := Inside;
+      Going   : Direction := Forward) return Natural
+   is
+   begin
+      if Going = Forward then
+         if From < Source'First then
+            raise Index_Error;
+         end if;
+
+         return
+           Index (Source (From .. Source'Last), Set, Test, Forward);
+
+      else
+         if From > Source'Last then
+            raise Index_Error;
+         end if;
+
+         return
+           Index (Source (Source'First .. From), Set, Test, Backward);
+      end if;
+   end Index;
+
+   ---------------------
+   -- Index_Non_Blank --
+   ---------------------
+
+   function Index_Non_Blank
+     (Source : String;
+      Going  : Direction := Forward) return Natural
+   is
+   begin
+      if Going = Forward then
+         for J in Source'Range loop
+            if Source (J) /= ' ' then
+               return J;
+            end if;
+         end loop;
+
+      else -- Going = Backward
+         for J in reverse Source'Range loop
+            if Source (J) /= ' ' then
+               return J;
+            end if;
+         end loop;
+      end if;
+
+      --  Fall through if no match
+
+      return 0;
+   end Index_Non_Blank;
+
+   function Index_Non_Blank
+     (Source : String;
+      From   : Positive;
+      Going  : Direction := Forward) return Natural
+   is
+   begin
+      if Going = Forward then
+         if From < Source'First then
+            raise Index_Error;
+         end if;
+
+         return
+           Index_Non_Blank (Source (From .. Source'Last), Forward);
+
+      else
+         if From > Source'Last then
+            raise Index_Error;
+         end if;
+
+         return
+           Index_Non_Blank (Source (Source'First .. From), Backward);
+      end if;
+   end Index_Non_Blank;
+
+end lace.Strings.Search;

1-base/lace/source/strings/lace-strings-search.ads

@@ -0,0 +1,95 @@
+with
+     ada.Strings.Maps;
+
+
+private package lace.Strings.search
+--
+-- Based on the 'ada.Strings.search' package provided by FSF GCC.
+--
+-- Modified to be a Pure package for use with DSA.
+--
+is
+   pragma Preelaborate;
+   pragma Pure;
+
+   use ada.Strings;
+
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural;
+
+   function Index
+     (Source : String;
+      Set    : Maps.Character_Set;
+      Test   : Membership := Inside;
+      Going  : Direction  := Forward) return Natural;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
+
+   function Index
+     (Source  : String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural;
+
+   function Index
+     (Source  : String;
+      Set     : Maps.Character_Set;
+      From    : Positive;
+      Test    : Membership := Inside;
+      Going   : Direction := Forward) return Natural;
+
+   function Index_Non_Blank
+     (Source : String;
+      Going  : Direction := Forward) return Natural;
+
+   function Index_Non_Blank
+     (Source : String;
+      From   : Positive;
+      Going  : Direction := Forward) return Natural;
+
+   function Count
+     (Source  : String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
+
+   function Count
+     (Source  : String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping_Function) return Natural;
+
+   function Count
+     (Source : String;
+      Set    : Maps.Character_Set) return Natural;
+
+   procedure Find_Token
+     (Source : String;
+      Set    : Maps.Character_Set;
+      From   : Positive;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural);
+
+   procedure Find_Token
+     (Source : String;
+      Set    : Maps.Character_Set;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural);
+
+end lace.Strings.Search;

1-base/lace/source/strings/lace-strings-superbounded.ads

@@ -0,0 +1,469 @@
+with
+     ada.Strings.Maps;
+
+
+package lace.Strings.superbounded
+--
+-- Based on the 'ada.Strings.superbounded' package provided by FSF GCC.
+--
+-- Modified to be a Pure package for use with DSA.
+--
+is
+   pragma Pure;
+   pragma Preelaborate;
+
+   use ada.Strings;
+
+
+   --  Type Bounded_String in Ada.Strings.Bounded.Generic_Bounded_Length is
+   --  derived from Super_String, with the constraint of the maximum length.
+
+   type Super_String (Max_Length : Positive) is
+      record
+         Current_Length : Natural := 0;
+         Data           : String (1 .. Max_Length);
+         --  A previous version had a default initial value for Data, which is
+         --  no longer necessary, because we now special-case this type in the
+         --  compiler, so "=" composes properly for descendants of this type.
+         --  Leaving it out is more efficient.
+      end record;
+
+   --  The subprograms defined for Super_String are similar to those
+   --  defined for Bounded_String, except that they have different names, so
+   --  that they can be renamed in Ada.Strings.Bounded.Generic_Bounded_Length.
+
+   function Super_Length (Source : Super_String) return Natural;
+
+   --------------------------------------------------------
+   -- Conversion, Concatenation, and Selection Functions --
+   --------------------------------------------------------
+
+   function To_Super_String
+     (Source     : String;
+      Max_Length : Natural;
+      Drop       : Truncation := Error) return Super_String;
+   --  Note the additional parameter Max_Length, which specifies the maximum
+   --  length setting of the resulting Super_String value.
+
+   --  The following procedures have declarations (and semantics) that are
+   --  exactly analogous to those declared in Ada.Strings.Bounded.
+
+   function Super_To_String (Source : Super_String) return String;
+
+   procedure Set_Super_String
+     (Target : out Super_String;
+      Source : String;
+      Drop   : Truncation := Error);
+
+   function Super_Append
+     (Left  : Super_String;
+      Right : Super_String;
+      Drop  : Truncation  := Error) return Super_String;
+
+   function Super_Append
+     (Left  : Super_String;
+      Right : String;
+      Drop  : Truncation := Error) return Super_String;
+
+   function Super_Append
+     (Left  : String;
+      Right : Super_String;
+      Drop  : Truncation := Error) return Super_String;
+
+   function Super_Append
+     (Left  : Super_String;
+      Right : Character;
+      Drop  : Truncation := Error) return Super_String;
+
+   function Super_Append
+     (Left  : Character;
+      Right : Super_String;
+      Drop  : Truncation := Error) return Super_String;
+
+   procedure Super_Append
+     (Source   : in out Super_String;
+      New_Item : Super_String;
+      Drop     : Truncation  := Error);
+
+   procedure Super_Append
+     (Source   : in out Super_String;
+      New_Item : String;
+      Drop     : Truncation  := Error);
+
+   procedure Super_Append
+     (Source   : in out Super_String;
+      New_Item : Character;
+      Drop     : Truncation  := Error);
+
+   function Concat
+     (Left  : Super_String;
+      Right : Super_String) return Super_String;
+
+   function Concat
+     (Left  : Super_String;
+      Right : String) return Super_String;
+
+   function Concat
+     (Left  : String;
+      Right : Super_String) return Super_String;
+
+   function Concat
+     (Left  : Super_String;
+      Right : Character) return Super_String;
+
+   function Concat
+     (Left  : Character;
+      Right : Super_String) return Super_String;
+
+   function Super_Element
+     (Source : Super_String;
+      Index  : Positive) return Character;
+
+   procedure Super_Replace_Element
+     (Source : in out Super_String;
+      Index  : Positive;
+      By     : Character);
+
+   function Super_Slice
+     (Source : Super_String;
+      Low    : Positive;
+      High   : Natural) return String;
+
+   function Super_Slice
+     (Source : Super_String;
+      Low    : Positive;
+      High   : Natural) return Super_String;
+
+   procedure Super_Slice
+     (Source : Super_String;
+      Target : out Super_String;
+      Low    : Positive;
+      High   : Natural);
+
+   overriding
+   function "="
+     (Left  : Super_String;
+      Right : Super_String) return Boolean;
+
+   function Equal
+     (Left  : Super_String;
+      Right : Super_String) return Boolean renames "=";
+
+   function Equal
+     (Left  : Super_String;
+      Right : String) return Boolean;
+
+   function Equal
+     (Left  : String;
+      Right : Super_String) return Boolean;
+
+   function Less
+     (Left  : Super_String;
+      Right : Super_String) return Boolean;
+
+   function Less
+     (Left  : Super_String;
+      Right : String) return Boolean;
+
+   function Less
+     (Left  : String;
+      Right : Super_String) return Boolean;
+
+   function Less_Or_Equal
+     (Left  : Super_String;
+      Right : Super_String) return Boolean;
+
+   function Less_Or_Equal
+     (Left  : Super_String;
+      Right : String) return Boolean;
+
+   function Less_Or_Equal
+     (Left  : String;
+      Right : Super_String) return Boolean;
+
+   function Greater
+     (Left  : Super_String;
+      Right : Super_String) return Boolean;
+
+   function Greater
+     (Left  : Super_String;
+      Right : String) return Boolean;
+
+   function Greater
+     (Left  : String;
+      Right : Super_String) return Boolean;
+
+   function Greater_Or_Equal
+     (Left  : Super_String;
+      Right : Super_String) return Boolean;
+
+   function Greater_Or_Equal
+     (Left  : Super_String;
+      Right : String) return Boolean;
+
+   function Greater_Or_Equal
+     (Left  : String;
+      Right : Super_String) return Boolean;
+
+   ----------------------
+   -- Search Functions --
+   ----------------------
+
+   function Super_Index
+     (Source  : Super_String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
+
+   function Super_Index
+     (Source  : Super_String;
+      Pattern : String;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural;
+
+   function Super_Index
+     (Source : Super_String;
+      Set    : Maps.Character_Set;
+      Test   : Membership := Inside;
+      Going  : Direction  := Forward) return Natural;
+
+   function Super_Index
+     (Source  : Super_String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
+
+   function Super_Index
+     (Source  : Super_String;
+      Pattern : String;
+      From    : Positive;
+      Going   : Direction := Forward;
+      Mapping : Maps.Character_Mapping_Function) return Natural;
+
+   function Super_Index
+     (Source : Super_String;
+      Set    : Maps.Character_Set;
+      From   : Positive;
+      Test   : Membership := Inside;
+      Going  : Direction := Forward) return Natural;
+
+   function Super_Index_Non_Blank
+     (Source : Super_String;
+      Going  : Direction := Forward) return Natural;
+
+   function Super_Index_Non_Blank
+     (Source : Super_String;
+      From   : Positive;
+      Going  : Direction := Forward) return Natural;
+
+   function Super_Count
+     (Source  : Super_String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping := Maps.Identity) return Natural;
+
+   function Super_Count
+     (Source  : Super_String;
+      Pattern : String;
+      Mapping : Maps.Character_Mapping_Function) return Natural;
+
+   function Super_Count
+     (Source : Super_String;
+      Set    : Maps.Character_Set) return Natural;
+
+   procedure Super_Find_Token
+     (Source : Super_String;
+      Set    : Maps.Character_Set;
+      From   : Positive;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural);
+
+   procedure Super_Find_Token
+     (Source : Super_String;
+      Set    : Maps.Character_Set;
+      Test   : Membership;
+      First  : out Positive;
+      Last   : out Natural);
+
+   ------------------------------------
+   -- String Translation Subprograms --
+   ------------------------------------
+
+   function Super_Translate
+     (Source  : Super_String;
+      Mapping : Maps.Character_Mapping) return Super_String;
+
+   procedure Super_Translate
+     (Source   : in out Super_String;
+      Mapping  : Maps.Character_Mapping);
+
+   function Super_Translate
+     (Source  : Super_String;
+      Mapping : Maps.Character_Mapping_Function) return Super_String;
+
+   procedure Super_Translate
+     (Source  : in out Super_String;
+      Mapping : Maps.Character_Mapping_Function);
+
+   ---------------------------------------
+   -- String Transformation Subprograms --
+   ---------------------------------------
+
+   function Super_Replace_Slice
+     (Source : Super_String;
+      Low    : Positive;
+      High   : Natural;
+      By     : String;
+      Drop   : Truncation := Error) return Super_String;
+
+   procedure Super_Replace_Slice
+     (Source  : in out Super_String;
+      Low     : Positive;
+      High    : Natural;
+      By      : String;
+      Drop    : Truncation := Error);
+
+   function Super_Insert
+     (Source   : Super_String;
+      Before   : Positive;
+      New_Item : String;
+      Drop     : Truncation := Error) return Super_String;
+
+   procedure Super_Insert
+     (Source   : in out Super_String;
+      Before   : Positive;
+      New_Item : String;
+      Drop     : Truncation := Error);
+
+   function Super_Overwrite
+     (Source   : Super_String;
+      Position : Positive;
+      New_Item : String;
+      Drop     : Truncation := Error) return Super_String;
+
+   procedure Super_Overwrite
+     (Source    : in out Super_String;
+      Position  : Positive;
+      New_Item  : String;
+      Drop      : Truncation := Error);
+
+   function Super_Delete
+     (Source  : Super_String;
+      From    : Positive;
+      Through : Natural) return Super_String;
+
+   procedure Super_Delete
+     (Source  : in out Super_String;
+      From    : Positive;
+      Through : Natural);
+
+   ---------------------------------
+   -- String Selector Subprograms --
+   ---------------------------------
+
+   function Super_Trim
+     (Source : Super_String;
+      Side   : Trim_End) return Super_String;
+
+   procedure Super_Trim
+     (Source : in out Super_String;
+      Side   : Trim_End);
+
+   function Super_Trim
+     (Source : Super_String;
+      Left   : Maps.Character_Set;
+      Right  : Maps.Character_Set) return Super_String;
+
+   procedure Super_Trim
+     (Source : in out Super_String;
+      Left   : Maps.Character_Set;
+      Right  : Maps.Character_Set);
+
+   function Super_Head
+     (Source : Super_String;
+      Count  : Natural;
+      Pad    : Character := Space;
+      Drop   : Truncation := Error) return Super_String;
+
+   procedure Super_Head
+     (Source : in out Super_String;
+      Count  : Natural;
+      Pad    : Character := Space;
+      Drop   : Truncation := Error);
+
+   function Super_Tail
+     (Source : Super_String;
+      Count  : Natural;
+      Pad    : Character := Space;
+      Drop   : Truncation := Error) return Super_String;
+
+   procedure Super_Tail
+     (Source : in out Super_String;
+      Count  : Natural;
+      Pad    : Character := Space;
+      Drop   : Truncation := Error);
+
+   ------------------------------------
+   -- String Constructor Subprograms --
+   ------------------------------------
+
+   --  Note: in some of the following routines, there is an extra parameter
+   --  Max_Length which specifies the value of the maximum length for the
+   --  resulting Super_String value.
+
+   function Times
+     (Left       : Natural;
+      Right      : Character;
+      Max_Length : Positive) return Super_String;
+   --  Note the additional parameter Max_Length
+
+   function Times
+     (Left       : Natural;
+      Right      : String;
+      Max_Length : Positive) return Super_String;
+   --  Note the additional parameter Max_Length
+
+   function Times
+     (Left  : Natural;
+      Right : Super_String) return Super_String;
+
+   function Super_Replicate
+     (Count      : Natural;
+      Item       : Character;
+      Drop       : Truncation := Error;
+      Max_Length : Positive) return Super_String;
+   --  Note the additional parameter Max_Length
+
+   function Super_Replicate
+     (Count      : Natural;
+      Item       : String;
+      Drop       : Truncation := Error;
+      Max_Length : Positive) return Super_String;
+   --  Note the additional parameter Max_Length
+
+   function Super_Replicate
+     (Count : Natural;
+      Item  : Super_String;
+      Drop  : Truncation := Error) return Super_String;
+
+private
+      --  Pragma Inline declarations
+
+      pragma Inline ("=");
+      pragma Inline (Less);
+      pragma Inline (Less_Or_Equal);
+      pragma Inline (Greater);
+      pragma Inline (Greater_Or_Equal);
+      pragma Inline (Concat);
+      pragma Inline (Super_Count);
+      pragma Inline (Super_Element);
+      pragma Inline (Super_Find_Token);
+      pragma Inline (Super_Index);
+      pragma Inline (Super_Index_Non_Blank);
+      pragma Inline (Super_Length);
+      pragma Inline (Super_Replace_Element);
+      pragma Inline (Super_Slice);
+      pragma Inline (Super_To_String);
+
+end lace.Strings.superbounded;

1-base/lace/source/strings/lace-strings.ads

@@ -0,0 +1,7 @@
+package lace.Strings
+--
+-- DSA friendly packages based on the 'ada.Strings' package family provided by FSF GCC.
+--
+is
+   pragma Pure;
+end lace.Strings;

1-base/lace/source/text/lace-text-all_lines.adb

@@ -0,0 +1,164 @@
+with
+     lace.Text.all_Tokens,
+     ada.Characters.latin_1;
+
+
+package body lace.Text.all_Lines
+is
+   use lace.Text.all_Tokens,
+       ada.Characters.latin_1;
+
+
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 Text.items_512k
+   is
+   begin
+      return Tokens (Self, LF, Trim, max_Lines);
+   end Lines;
+
+
+end lace.Text.all_Lines;

1-base/lace/source/text/lace-text-all_lines.ads

@@ -0,0 +1,45 @@
+package lace.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 Text.items_2;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_4;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_8;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_16;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_32;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_64;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_128;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_256;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_512;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_1k;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_2k;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_4k;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_8k;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_16k;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_32k;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_64k;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_128k;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_256k;
+   function Lines (Self : in Item; Trim      : in Boolean  := False;
+                                   max_Lines : in Positive := default_Max) return Text.items_512k;
+
+end lace.Text.all_Lines;

1-base/lace/source/text/lace-text-all_tokens.adb

@@ -0,0 +1,479 @@
+with
+     lace.Text.Cursor;
+
+
+package body lace.Text.all_Tokens
+is
+   ----------------------
+   -- Character Delimiter
+   --
+
+   function next_Token (Self : in Item;   Delimiter : in     Character;
+                                          From      : in out Positive) return 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 String;   Capacity : in Natural;
+                                                     Trim     : in Boolean := False) return Component;
+
+   function any_Tokens_chr (Self : in Item;   Delimiter  : in Character := ' ';
+                                              Trim       : in Boolean   := False;
+                                              max_Tokens : in Positive  := 8 * 1024) return Array_type;
+
+
+
+   function any_Tokens_chr (Self : in Item;   Delimiter  : in Character := ' ';
+                                              Trim       : in Boolean   := False;
+                                              max_Tokens : in Positive  := 8 * 1024) return Array_type
+   is
+      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 any_Tokens_chr;
+
+
+
+   function Tokens_2 is new any_Tokens_chr (Text_Capacity => 2,
+                                            Component     => Text.item_2,
+                                            Array_type    => Text.items_2,
+                                            any_to_Text   => to_Text);
+
+   function Tokens_4 is new any_Tokens_chr (Text_Capacity => 4,
+                                            Component     => Text.item_4,
+                                            Array_type    => Text.items_4,
+                                            any_to_Text   => to_Text);
+
+   function Tokens_8 is new any_Tokens_chr (Text_Capacity => 8,
+                                            Component     => Text.item_8,
+                                            Array_type    => Text.items_8,
+                                            any_to_Text   => to_Text);
+
+   function Tokens_16 is new any_Tokens_chr (Text_Capacity => 16,
+                                             Component     => Text.item_16,
+                                             Array_type    => Text.items_16,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_32 is new any_Tokens_chr (Text_Capacity => 32,
+                                             Component     => Text.item_32,
+                                             Array_type    => Text.items_32,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_64 is new any_Tokens_chr (Text_Capacity => 64,
+                                             Component     => Text.item_64,
+                                             Array_type    => Text.items_64,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_128 is new any_Tokens_chr (Text_Capacity => 128,
+                                              Component     => Text.item_128,
+                                              Array_type    => Text.items_128,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_256 is new any_Tokens_chr (Text_Capacity => 256,
+                                              Component     => Text.item_256,
+                                              Array_type    => Text.items_256,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_512 is new any_Tokens_chr (Text_Capacity => 512,
+                                              Component     => Text.item_512,
+                                              Array_type    => Text.items_512,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_1k is new any_Tokens_chr (Text_Capacity => 1024,
+                                             Component     => Text.item_1k,
+                                             Array_type    => Text.items_1k,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_2k is new any_Tokens_chr (Text_Capacity => 2 * 1024,
+                                             Component     => Text.item_2k,
+                                             Array_type    => Text.items_2k,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_4k is new any_Tokens_chr (Text_Capacity => 4 * 1024,
+                                             Component     => Text.item_4k,
+                                             Array_type    => Text.items_4k,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_8k is new any_Tokens_chr (Text_Capacity => 8 * 1024,
+                                             Component     => Text.item_8k,
+                                             Array_type    => Text.items_8k,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_16k is new any_Tokens_chr (Text_Capacity => 16 * 1024,
+                                              Component     => Text.item_16k,
+                                              Array_type    => Text.items_16k,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_32k is new any_Tokens_chr (Text_Capacity => 32 * 1024,
+                                              Component     => Text.item_32k,
+                                              Array_type    => Text.items_32k,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_64k is new any_Tokens_chr (Text_Capacity => 64 * 1024,
+                                              Component     => Text.item_64k,
+                                              Array_type    => Text.items_64k,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_256k is new any_Tokens_chr (Text_Capacity => 256 * 1024,
+                                               Component     => Text.item_256k,
+                                               Array_type    => Text.items_256k,
+                                               any_to_Text   => to_Text);
+
+   function Tokens_128k is new any_Tokens_chr (Text_Capacity => 128 * 1024,
+                                               Component     => Text.item_128k,
+                                               Array_type    => Text.items_128k,
+                                               any_to_Text   => to_Text);
+
+   function Tokens_512k is new any_Tokens_chr (Text_Capacity => 512,
+                                               Component     => Text.item_512k,
+                                               Array_type    => Text.items_512k,
+                                               any_to_Text   => to_Text);
+
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_2 renames Tokens_2;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_4 renames Tokens_4;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_8 renames Tokens_8;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_16 renames Tokens_16;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_32 renames Tokens_32;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_64 renames Tokens_64;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_128 renames Tokens_128;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_256 renames Tokens_256;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_512 renames Tokens_512;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_1k renames Tokens_1k;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_2k renames Tokens_2k;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_4k renames Tokens_4k;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_8k renames Tokens_8k;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_16k renames Tokens_16k;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_32k renames Tokens_32k;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_64k renames Tokens_64k;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_128k renames Tokens_128k;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_256k renames Tokens_256k;
+
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return 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 String;   Capacity : in Natural;
+                                                     Trim     : in Boolean := False) return Component;
+
+   function any_Tokens_str (Self : in Item;   Delimiter  : in String;
+                                              Trim       : in Boolean  := False;
+                                              max_Tokens : in Positive := default_Max) return Array_type;
+
+
+
+   function any_Tokens_str (Self : in Item;   Delimiter  : in String;
+                                              Trim       : in Boolean  := False;
+                                              max_Tokens : in Positive := default_Max) return Array_type
+   is
+      use Text.Cursor;
+      mySelf     : aliased Item             := Self;
+      Cursor     :         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_2 is new any_Tokens_str (Text_Capacity => 2,
+                                            Component     => Text.item_2,
+                                            Array_type    => Text.items_2,
+                                            any_to_Text   => to_Text);
+
+   function Tokens_4 is new any_Tokens_str (Text_Capacity => 4,
+                                            Component     => Text.item_4,
+                                            Array_type    => Text.items_4,
+                                            any_to_Text   => to_Text);
+
+   function Tokens_8 is new any_Tokens_str (Text_Capacity => 8,
+                                            Component     => Text.item_8,
+                                            Array_type    => Text.items_8,
+                                            any_to_Text   => to_Text);
+
+   function Tokens_16 is new any_Tokens_str (Text_Capacity => 16,
+                                             Component     => Text.item_16,
+                                             Array_type    => Text.items_16,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_32 is new any_Tokens_str (Text_Capacity => 32,
+                                             Component     => Text.item_32,
+                                             Array_type    => Text.items_32,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_64 is new any_Tokens_str (Text_Capacity => 64,
+                                             Component     => Text.item_64,
+                                             Array_type    => Text.items_64,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_128 is new any_Tokens_str (Text_Capacity => 128,
+                                              Component     => Text.item_128,
+                                              Array_type    => Text.items_128,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_256 is new any_Tokens_str (Text_Capacity => 256,
+                                              Component     => Text.item_256,
+                                              Array_type    => Text.items_256,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_512 is new any_Tokens_str (Text_Capacity => 512,
+                                              Component     => Text.item_512,
+                                              Array_type    => Text.items_512,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_1k is new any_Tokens_str (Text_Capacity => 1024,
+                                             Component     => Text.item_1k,
+                                             Array_type    => Text.items_1k,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_2k is new any_Tokens_str (Text_Capacity => 2 * 1024,
+                                             Component     => Text.item_2k,
+                                             Array_type    => Text.items_2k,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_4k is new any_Tokens_str (Text_Capacity => 4 * 1024,
+                                             Component     => Text.item_4k,
+                                             Array_type    => Text.items_4k,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_8k is new any_Tokens_str (Text_Capacity => 8 * 1024,
+                                             Component     => Text.item_8k,
+                                             Array_type    => Text.items_8k,
+                                             any_to_Text   => to_Text);
+
+   function Tokens_16k is new any_Tokens_str (Text_Capacity => 16 * 1024,
+                                              Component     => Text.item_16k,
+                                              Array_type    => Text.items_16k,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_32k is new any_Tokens_str (Text_Capacity => 32 * 1024,
+                                              Component     => Text.item_32k,
+                                              Array_type    => Text.items_32k,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_64k is new any_Tokens_str (Text_Capacity => 64 * 1024,
+                                              Component     => Text.item_64k,
+                                              Array_type    => Text.items_64k,
+                                              any_to_Text   => to_Text);
+
+   function Tokens_128k is new any_Tokens_str (Text_Capacity => 128 * 1024,
+                                               Component     => Text.item_128k,
+                                               Array_type    => Text.items_128k,
+                                               any_to_Text   => to_Text);
+
+   function Tokens_256k is new any_Tokens_str (Text_Capacity => 256 * 1024,
+                                               Component     => Text.item_256k,
+                                               Array_type    => Text.items_256k,
+                                               any_to_Text   => to_Text);
+
+   function Tokens_512k is new any_Tokens_str (Text_Capacity => 512 * 1024,
+                                               Component     => Text.item_512k,
+                                               Array_type    => Text.items_512k,
+                                               any_to_Text   => to_Text);
+
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_2 renames Tokens_2;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_4 renames Tokens_4;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_8 renames Tokens_8;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_16 renames Tokens_16;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_32 renames Tokens_32;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_64 renames Tokens_64;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_128 renames Tokens_128;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_256 renames Tokens_256;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_512 renames Tokens_512;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_1k renames Tokens_1k;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_2k renames Tokens_2k;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_4k renames Tokens_4k;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_8k renames Tokens_8k;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_16k renames Tokens_16k;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_32k renames Tokens_32k;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_64k renames Tokens_64k;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_128k renames Tokens_128k;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_256k renames Tokens_256k;
+
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_512k renames Tokens_512k;
+
+end lace.Text.all_Tokens;

1-base/lace/source/text/lace-text-all_tokens.ads

@@ -0,0 +1,128 @@
+package lace.Text.all_Tokens
+is
+   default_Max : constant := 8 * 1024;
+
+
+   ----------------------
+   -- Character Delimiter
+   --
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_2;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_4;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_8;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_16;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_32;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_64;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_128;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_256;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_512;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_1k;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_2k;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_4k;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_8k;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_16k;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_32k;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_64k;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_128k;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_256k;
+   function Tokens (Self : in Item;   Delimiter  : in Character := ' ';
+                                      Trim       : in Boolean   := False;
+                                      max_Tokens : in Positive  := default_Max) return Text.items_512k;
+
+   -------------------
+   -- String Delimiter
+   --
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_2;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_4;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_8;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_16;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_32;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_64;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_128;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_256;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_512;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_1k;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_2k;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_4k;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_8k;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_16k;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_32k;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_64k;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_128k;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_256k;
+   function Tokens (Self : in Item;   Delimiter  : in String;
+                                      Trim       : in Boolean  := False;
+                                      max_Tokens : in Positive := default_Max) return Text.items_512k;
+
+end lace.Text.all_Tokens;

1-base/lace/source/text/lace-text-cursor.adb

@@ -0,0 +1,276 @@
+with
+     ada.Characters.latin_1,
+     ada.Characters.handling,
+     ada.Strings.fixed,
+     ada.Strings.Maps;
+
+package body lace.text.Cursor
+is
+   use ada.Strings;
+
+   Integer_Numerals : constant maps.character_Set := maps.to_Set ("+-0123456789");
+   Float_Numerals   : constant maps.character_Set := maps.to_Set ("+-0123456789.");
+
+
+   --------
+   -- Forge
+   --
+
+   function First (of_Text : access constant 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 String  := " ";
+                                            Repeat         : in Natural := 0;
+                                            skip_Delimiter : in Boolean := True;
+                                            Case_sensitive : in Boolean := True)
+   is
+   begin
+      for Count in 1 .. Repeat + 1
+      loop
+         declare
+            use ada.Characters.handling;
+            delimiter_Position : Natural;
+         begin
+            if Case_sensitive
+            then
+               delimiter_Position := fixed.Index (Self.Target.Data (1 .. Self.Target.Length),
+                                                  Delimiter,
+                                                  From => Self.Current);
+            else
+               delimiter_Position := 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 - 1;
+
+               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.Latin_1.CR
+                  or  Self.Target.Data (Self.Current) = ada.Characters.Latin_1.LF
+                  or  Self.Target.Data (Self.Current) = ada.Characters.Latin_1.HT)
+      loop
+         Self.Current := Self.Current + 1;
+      end loop;
+   end skip_White;
+
+
+
+   procedure skip_Line (Self : in out Item)
+   is
+      Line : String := next_Line (Self) with Unreferenced;
+   begin
+      null;
+   end skip_Line;
+
+
+
+   function next_Token (Self      : in out Item;
+                        Delimiter : in     Character := ' ';
+                        Trim      : in     Boolean   := False) return String
+   is
+   begin
+      return next_Token (Self, "" & Delimiter, Trim);
+   end next_Token;
+
+
+   function  next_Token  (Self : in out item;   Delimiter : in String;
+                                                Trim      : in Boolean := False) return String
+   is
+   begin
+      if at_End (Self)
+      then
+         raise at_end_Error;
+      end if;
+
+      declare
+         use ada.Strings.fixed;
+         delimiter_Position : constant Natural := Index (Self.Target.Data, Delimiter, from => Self.Current);
+      begin
+         if delimiter_Position = 0
+         then
+            return the_Token : constant String := (if Trim then 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 String := (if Trim then 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;
+   end next_Token;
+
+
+
+   function next_Line (Self : in out item;   Trim : in Boolean := False) return String
+   is
+      use ada.Characters;
+   begin
+      return next_Token (Self, Delimiter => latin_1.LF,
+                               Trim      => Trim);
+   end next_Line;
+
+
+
+   procedure skip_Token (Self : in out Item;   Delimiter : in String := " ")
+   is
+      ignored_Token : String := Self.next_Token (Delimiter);
+   begin
+      null;
+   end skip_Token;
+
+
+
+   function get_Integer (Self : in out Item) return Integer
+   is
+      use ada.Strings.fixed;
+
+      Text  : 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'Value (Text (First .. Last));
+   end get_Integer;
+
+
+
+   function get_Integer (Self : in out Item) return long_Integer
+   is
+      use ada.Strings.fixed;
+
+      Text  : 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'Value (Text (First .. Last));
+   end get_Integer;
+
+
+
+   function get_Real (Self : in out Item) return long_Float
+   is
+      use ada.Strings.fixed;
+
+      Text  : 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'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 String
+   is
+      Last : constant Natural := (if Length = Natural'Last then Self.Target.Length
+                                                           else Self.Current + Length - 1);
+   begin
+      if at_End (Self)
+      then
+         return "";
+      end if;
+
+      return Self.Target.Data (Self.Current .. Last);
+   end peek;
+
+
+
+   function peek_Line (Self : in Item) return String
+   is
+      C : Cursor.item := Self;
+   begin
+      return next_Line (C);
+   end peek_Line;
+
+
+end lace.text.Cursor;

1-base/lace/source/text/lace-text-cursor.ads

@@ -0,0 +1,78 @@
+package lace.text.Cursor
+--
+-- Provides a cursor for traversing and interrogating text.
+--
+is
+   type Item is tagged private;
+
+
+   -- Forge
+   --
+
+   function First (of_Text : access constant 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 Character := ' ';
+                                                Trim      : in Boolean   := False) return String;
+   function  next_Token  (Self : in out item;   Delimiter : in String;
+                                                Trim      : in Boolean   := False) return String;
+
+   function  next_Line   (Self : in out item;   Trim      : in Boolean   := False) return String;
+
+   procedure skip_Token  (Self : in out Item;   Delimiter : in String := " ");
+   procedure skip_White  (Self : in out Item);
+   procedure skip_Line   (Self : in out Item);
+
+   procedure advance     (Self : in out Item;   Delimiter      : in String  := " ";
+                                                Repeat         : in Natural := 0;
+                                                skip_Delimiter : in Boolean := True;
+                                                Case_sensitive : 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 String;
+   function  peek_Line (Self : in Item)                                     return String;
+
+
+   at_end_Error  : exception;
+   no_data_Error : exception;
+
+
+
+private
+
+   type Item is tagged
+      record
+         Target  : access constant Text.item;
+         Current : Natural  := 0;
+      end record;
+
+   Remaining : constant Natural := Natural'Last;
+
+end lace.text.Cursor;

1-base/lace/source/text/lace-text-forge.adb

@@ -0,0 +1,426 @@
+with
+     ada.Characters.latin_1,
+     ada.Strings.unbounded,
+     ada.Text_IO;
+
+
+package body lace.Text.forge
+is
+   --------
+   -- Files
+   --
+
+   function to_String (Filename : in forge.Filename) return String
+   is
+      use ada.Strings.unbounded,
+          ada.Text_IO;
+
+      the_File : ada.Text_IO.File_type;
+      Pad      : unbounded_String;
+   begin
+      open (the_File, in_File, String (Filename));
+
+      while not end_of_File (the_File)
+      loop
+         append (Pad,   get_Line (the_File)
+                      & ada.Characters.Latin_1.LF);
+      end loop;
+
+      close (the_File);
+
+      return to_String (Pad);
+   end to_String;
+
+
+
+   function to_Text (Filename : in forge.Filename) return Item
+   is
+   begin
+      return to_Text (to_String (Filename));
+   end to_Text;
+
+
+   --------------
+   -- Stock Items
+   --
+
+   function to_Text_2 (From : in String) return Item_2
+   is
+   begin
+      return to_Text (From, capacity => 2);
+   end to_Text_2;
+
+   function to_Text_2 (From : in 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 String) return Item_4
+   is
+   begin
+      return to_Text (From, capacity => 4);
+   end to_Text_4;
+
+   function to_Text_4 (From : in 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 String) return Item_8
+   is
+   begin
+      return to_Text (From, capacity => 8);
+   end to_Text_8;
+
+   function to_Text_8 (From : in 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 String) return Item_16
+   is
+   begin
+      return to_Text (From, capacity => 16);
+   end to_Text_16;
+
+   function to_Text_16 (From : in 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 String) return Item_32
+   is
+   begin
+      return to_Text (From, capacity => 32);
+   end to_Text_32;
+
+   function to_Text_32 (From : in 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 String) return Item_64
+   is
+   begin
+      return to_Text (From, capacity => 64);
+   end to_Text_64;
+
+   function to_Text_64 (From : in 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 String) return Item_128
+   is
+   begin
+      return to_Text (From, capacity => 128);
+   end to_Text_128;
+
+   function to_Text_128 (From : in 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 String) return Item_256
+   is
+   begin
+      return to_Text (From, capacity => 256);
+   end to_Text_256;
+
+   function to_Text_256 (From : in 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 String) return Item_512
+   is
+   begin
+      return to_Text (From, capacity => 512);
+   end to_Text_512;
+
+   function to_Text_512 (From : in 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 String) return Item_1k
+   is
+   begin
+      return to_Text (From, capacity => 1024);
+   end to_Text_1k;
+
+   function to_Text_1k (From : in 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 String) return Item_2k
+   is
+   begin
+      return to_Text (From, capacity => 2 * 1024);
+   end to_Text_2k;
+
+   function to_Text_2k (From : in 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 String) return Item_4k
+   is
+   begin
+      return to_Text (From, capacity => 4 * 1024);
+   end to_Text_4k;
+
+   function to_Text_4k (From : in 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 String) return Item_8k
+   is
+   begin
+      return to_Text (From, capacity => 8 * 1024);
+   end to_Text_8k;
+
+   function to_Text_8k (From : in 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 String) return Item_16k
+   is
+   begin
+      return to_Text (From, capacity => 16 * 1024);
+   end to_Text_16k;
+
+   function to_Text_16k (From : in 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 String) return Item_32k
+   is
+   begin
+      return to_Text (From, capacity => 32 * 1024);
+   end to_Text_32k;
+
+   function to_Text_32k (From : in 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 String) return Item_64k
+   is
+   begin
+      return to_Text (From, capacity => 64 * 1024);
+   end to_Text_64k;
+
+   function to_Text_64k (From : in 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 String) return Item_128k
+   is
+   begin
+      return to_Text (From, capacity => 128 * 1024);
+   end to_Text_128k;
+
+   function to_Text_128k (From : in 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 String) return Item_256k
+   is
+   begin
+      return to_Text (From, capacity => 256 * 1024);
+   end to_Text_256k;
+
+   function to_Text_256k (From : in 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 String) return Item_512k
+   is
+   begin
+      return to_Text (From, capacity => 512 * 1024);
+   end to_Text_512k;
+
+   function to_Text_512k (From : in 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 String) return Item_1m
+   is
+   begin
+      return to_Text (From, capacity => 1024 * 1024);
+   end to_Text_1m;
+
+   function to_Text_1m (From : in 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 String) return Item_2m
+   is
+   begin
+      return to_Text (From, capacity => 2 * 1024 * 1024);
+   end to_Text_2m;
+
+   function to_Text_2m (From : in 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 String) return Item_4m
+   is
+   begin
+      return to_Text (From, capacity => 4 * 1024 * 1024);
+   end to_Text_4m;
+
+   function to_Text_4m (From : in 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 String) return Item_8m
+   is
+   begin
+      return to_Text (From, capacity => 8 * 1024 * 1024);
+   end to_Text_8m;
+
+   function to_Text_8m (From : in 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 String) return Item_16m
+   is
+   begin
+      return to_Text (From, capacity => 16 * 1024 * 1024);
+   end to_Text_16m;
+
+   function to_Text_16m (From : in 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 String) return Item_32m
+   is
+   begin
+      return to_Text (From, capacity => 32 * 1024 * 1024);
+   end to_Text_32m;
+
+   function to_Text_32m (From : in 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 String) return Item_64m
+   is
+   begin
+      return to_Text (From, capacity => 64 * 1024 * 1024);
+   end to_Text_64m;
+
+   function to_Text_64m (From : in 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 String) return Item_128m
+   is
+   begin
+      return to_Text (From, capacity => 128 * 1024 * 1024);
+   end to_Text_128m;
+
+   function to_Text_128m (From : in 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 String) return Item_256m
+   is
+   begin
+      return to_Text (From, capacity => 256 * 1024 * 1024);
+   end to_Text_256m;
+
+   function to_Text_256m (From : in 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 String) return Item_512m
+   is
+   begin
+      return to_Text (From, capacity => 512 * 1024 * 1024);
+   end to_Text_512m;
+
+   function to_Text_512m (From : in Text.item) return Item_512m
+   is
+   begin
+      return to_Text (to_String (From), capacity => 512 * 1024 * 1024);
+   end to_Text_512m;
+
+
+end lace.Text.forge;

1-base/lace/source/text/lace-text-forge.ads

@@ -0,0 +1,108 @@
+
+package lace.Text.forge
+--
+-- Provides constructors for Text.
+--
+is
+   --------
+   -- Files
+   --
+
+   type Filename is new String;
+
+   function to_String (Filename : in forge.Filename) return String;
+   function to_Text   (Filename : in forge.Filename) return Item;
+
+
+   --------------
+   -- Stock Items
+   --
+
+   function to_Text_2 (From : in String)       return Item_2;
+   function to_Text_2 (From : in Text.item)    return Item_2;
+
+   function to_Text_4 (From : in String)       return Item_4;
+   function to_Text_4 (From : in Text.item)    return Item_4;
+
+   function to_Text_8 (From : in String)       return Item_8;
+   function to_Text_8 (From : in Text.item)    return Item_8;
+
+   function to_Text_16 (From : in String)      return Item_16;
+   function to_Text_16 (From : in Text.item)   return Item_16;
+
+   function to_Text_32 (From : in String)      return Item_32;
+   function to_Text_32 (From : in Text.item)   return Item_32;
+
+   function to_Text_64 (From : in String)      return Item_64;
+   function to_Text_64 (From : in Text.item)   return Item_64;
+
+   function to_Text_128 (From : in String)     return Item_128;
+   function to_Text_128 (From : in Text.item)  return Item_128;
+
+   function to_Text_256 (From : in String)     return Item_256;
+   function to_Text_256 (From : in Text.item)  return Item_256;
+
+   function to_Text_512 (From : in String)     return Item_512;
+   function to_Text_512 (From : in Text.item)  return Item_512;
+
+   function to_Text_1k (From : in String)      return Item_1k;
+   function to_Text_1k (From : in Text.item)   return Item_1k;
+
+   function to_Text_2k (From : in String)      return Item_2k;
+   function to_Text_2k (From : in Text.item)   return Item_2k;
+
+   function to_Text_4k (From : in String)      return Item_4k;
+   function to_Text_4k (From : in Text.item)   return Item_4k;
+
+   function to_Text_8k (From : in String)      return Item_8k;
+   function to_Text_8k (From : in Text.item)   return Item_8k;
+
+   function to_Text_16k (From : in String)     return Item_16k;
+   function to_Text_16k (From : in Text.item)  return Item_16k;
+
+   function to_Text_32k (From : in String)     return Item_32k;
+   function to_Text_32k (From : in Text.item)  return Item_32k;
+
+   function to_Text_64k (From : in String)     return Item_64k;
+   function to_Text_64k (From : in Text.item)  return Item_64k;
+
+   function to_Text_128k (From : in String)    return Item_128k;
+   function to_Text_128k (From : in Text.item) return Item_128k;
+
+   function to_Text_256k (From : in String)    return Item_256k;
+   function to_Text_256k (From : in Text.item) return Item_256k;
+
+   function to_Text_512k (From : in String)    return Item_512k;
+   function to_Text_512k (From : in Text.item) return Item_512k;
+
+   function to_Text_1m (From : in String)      return Item_1m;
+   function to_Text_1m (From : in Text.item)   return Item_1m;
+
+   function to_Text_2m (From : in String)      return Item_2m;
+   function to_Text_2m (From : in Text.item)   return Item_2m;
+
+   function to_Text_4m (From : in String)      return Item_4m;
+   function to_Text_4m (From : in Text.item)   return Item_4m;
+
+   function to_Text_8m (From : in String)      return Item_8m;
+   function to_Text_8m (From : in Text.item)   return Item_8m;
+
+   function to_Text_16m (From : in String)     return Item_16m;
+   function to_Text_16m (From : in Text.item)  return Item_16m;
+
+   function to_Text_32m (From : in String)     return Item_32m;
+   function to_Text_32m (From : in Text.item)  return Item_32m;
+
+   function to_Text_64m (From : in String)     return Item_64m;
+   function to_Text_64m (From : in Text.item)  return Item_64m;
+
+   function to_Text_128m (From : in String)    return Item_128m;
+   function to_Text_128m (From : in Text.item) return Item_128m;
+
+   function to_Text_256m (From : in String)    return Item_256m;
+   function to_Text_256m (From : in Text.item) return Item_256m;
+
+   function to_Text_512m (From : in String)    return Item_512m;
+   function to_Text_512m (From : in Text.item) return Item_512m;
+
+end lace.Text.forge;

1-base/lace/source/text/lace-text-utility.adb

@@ -0,0 +1,132 @@
+with
+     lace.Text.all_Tokens,
+     ada.Strings.fixed;
+
+
+package body lace.Text.utility
+is
+
+   function Contains (Self : in Text.item;   Pattern : in String) return Boolean
+   is
+      use ada.Strings.fixed;
+   begin
+      return Index (+Self, Pattern) /= 0;
+   end Contains;
+
+
+
+   function replace (Self : in Text.item;   Pattern : in String;
+                                            By      : in String) return 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 : 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.Text.all_Tokens;
+
+         the_Tokens : constant 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 : 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 String;
+                                            By      : in 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 Text.Error with "'replace' failed ~ insufficient capacity";
+   end replace;
+
+
+end lace.Text.utility;

1-base/lace/source/text/lace-text-utility.ads

@@ -0,0 +1,21 @@
+package lace.Text.utility
+--
+-- Provides utility subprograms.
+--
+is
+   function  Contains (Self : in     Text.item;   Pattern : in String) return Boolean;
+
+
+   function  replace  (Self : in     Text.item;   Pattern : in String;
+                                                  By      : in String) return 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 Text.item;   Pattern : in String;
+                                                  By      : in String);
+   --
+   -- Replaces all occurences of 'Pattern' with 'By'.
+   -- 'Text.Error' will be raised if the replacement exceeds the capacity of 'Self'.
+
+end lace.Text.utility;

1-base/lace/source/text/lace-text.adb

@@ -0,0 +1,267 @@
+with
+     lace.Strings.fixed,
+     ada.Characters.handling,
+     ada.Strings.Hash;
+
+
+package body lace.Text
+is
+   ---------------
+   -- Construction
+   --
+
+   function to_Text (From : in 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 String;
+                     Capacity : in Natural;
+                     Trim     : in Boolean := False) return Item
+   is
+      the_String : constant String := (if Trim then lace.Strings.fixed.Trim (From, ada.Strings.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 String) return Item
+   is
+   begin
+      return to_Text (From);
+   end "+";
+
+
+   -------------
+   -- Attributes
+   --
+
+   procedure String_is (Self : in out Item;
+                        Now  : in     String)
+   is
+   begin
+      Self.Data (1 .. Now'Length) := Now;
+      Self.Length                 := Now'Length;
+   end String_is;
+
+
+
+   function to_String (Self : in Item) return 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 String
+   is
+   begin
+      return
+        "(Capacity =>"  & Self.Capacity'Image  & "," &
+        " Length =>"    & Self.Length  'Image  & "," &
+        " Data => '"    & to_String (Self)     & "')";
+   end Image;
+
+
+
+   function Hashed (Self : in Item) return ada.Containers.Hash_type
+   is
+   begin
+      return ada.strings.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.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  : 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;
+
+
+
+   procedure append (Self : in out Item;   Extra : in 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 & "' to '" & to_String (Self) & "' exceeds capacity of" & Self.Capacity'Image & ".";
+   end append;
+
+
+
+   function delete (Self : in Text.item;   From    : Positive;
+                                           Through : Natural := Natural'Last) return Text.item
+   is
+      Result : Text.item (Self.Capacity);
+   begin
+      delete (Result, From, Through);
+      return Result;
+   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 (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 : String (1 .. Capacity);
+      begin
+         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);
+      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);
+      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);
+      String 'read (Stream, Self.Data (1 .. Self.Length));
+   end Read;
+
+
+end lace.Text;

1-base/lace/source/text/lace-text.ads

@@ -0,0 +1,163 @@
+with
+     ada.Containers,
+     ada.Streams;
+
+
+package lace.Text
+--
+-- Models a string of text characters.
+--
+is
+   pragma Pure;
+
+   type Item (Capacity : Natural) is private;
+
+   function Image (Self : in Item) return String;
+
+   Error : exception;
+
+
+   --------------
+   -- Stock Items
+   --
+
+   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_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 String;
+                     Trim     : in Boolean := False) return Item;
+
+   function to_Text (From     : in String;
+                     Capacity : in Natural;
+                     Trim     : in Boolean := False) return Item;
+
+   function "+"     (From     : in String)           return Item;
+
+
+   -------------
+   -- Attributes
+   --
+
+   procedure String_is (Self : in out Item;   Now : in String);
+   function  to_String (Self : in     Item)     return String;
+   function  "+"       (Self : in     Item)     return 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;
+
+
+   procedure append (Self : in out Item;   Extra : in String);
+   --
+   -- Raises an Error if capacity is exceeded.
+
+
+   function  delete (Self : in     Text.item;   From    : Positive;
+                                                Through : Natural := Natural'Last) return Text.item;
+   procedure delete (Self : in out Text.item;   From    : Positive;
+                                                Through : Natural := Natural'Last);
+
+
+private
+
+   type Item (Capacity : Natural) is
+      record
+         Length : Natural := 0;
+         Data   : 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.Text;