------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- ADA.STRINGS.TEXT_OUTPUT --
-- --
-- S p e c --
-- --
-- Copyright (C) 2020, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception, --
-- version 3.1, as published by the Free Software Foundation. --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
with Ada.Strings.UTF_Encoding;
with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
package Ada.Strings.Text_Output with Pure is
-- This package provides a "Sink" abstraction, to which characters of type
-- Character, Wide_Character, and Wide_Wide_Character can be sent. This
-- type is used by the Put_Image attribute. In particular, T'Put_Image has
-- the following parameter types:
--
-- procedure T'Put_Image (S : in out Sink'Class; V : T);
--
-- The default generated code for Put_Image of a composite type will
-- typically call Put_Image on the components.
--
-- This is not a fully general abstraction that can be arbitrarily
-- extended. It is designed with particular extensions in mind, and these
-- extensions are declared in child packages of this package, because they
-- depend on implementation details in the private part of this
-- package.
--
-- Users are not expected to extend type Sink.
--
-- The primary extensions of Sink are:
--
-- Buffer. The characters sent to a Buffer are stored in memory, and can
-- be retrieved via Get functions. This is intended for the
-- implementation of the 'Image attribute. The compiler will generate a
-- T'Image function that declares a local Buffer, sends characters to
-- it, and then returns a call to Get, Destroying the Buffer on return.
--
-- function T'Image (V : T) return String is
-- Buf : Buffer := New_Buffer (...);
-- begin
-- T'Put_Image (Buf, V);
-- return Result : constant String := Get (Buf) do
-- Destroy (Buf);
-- end return;
-- end T'Image;
-- ????Perhaps Buffer should be controlled; if you don't like
-- controlled types, call Put_Image directly.
--
-- File. The characters are sent to a file, possibly opened by file
-- name, or possibly standard output or standard error. 'Put_Image
-- can be called directly on a File, thus avoiding any heap allocation.
type Sink (<>) is abstract tagged limited private;
type Sink_Access is access all Sink'Class with Storage_Size => 0;
-- Sink is a character sink; you can send characters to a Sink.
-- UTF-8 encoding is used.
procedure Full_Method (S : in out Sink) is abstract;
procedure Flush_Method (S : in out Sink) is abstract;
-- There is an internal buffer to store the characters. Full_Method is
-- called when the buffer is full, and Flush_Method may be called to flush
-- the buffer. For Buffer, Full_Method allocates more space for more
-- characters, and Flush_Method does nothing. For File, Full_Method and
-- Flush_Method do the same thing: write the characters to the file, and
-- empty the internal buffer.
--
-- These are the only dispatching subprograms on Sink. This is for
-- efficiency; we don't dispatch on every write to the Sink, but only when
-- the internal buffer is full (or upon client request).
--
-- Full_Method and Flush_Method must make the current chunk empty.
--
-- Additional operations operating on Sink'Class are declared in the Utils
-- child, including Full and Flush, which call the above.
function To_Wide (C : Character) return Wide_Character is
(Wide_Character'Val (Character'Pos (C)));
function To_Wide_Wide (C : Character) return Wide_Wide_Character is
(Wide_Wide_Character'Val (Character'Pos (C)));
function To_Wide_Wide (C : Wide_Character) return Wide_Wide_Character is
(Wide_Wide_Character'Val (Wide_Character'Pos (C)));
-- Conversions [Wide_]Character --> [Wide_]Wide_Character.
-- These cannot fail.
function From_Wide (C : Wide_Character) return Character is
(Character'Val (Wide_Character'Pos (C)));
function From_Wide_Wide (C : Wide_Wide_Character) return Character is
(Character'Val (Wide_Wide_Character'Pos (C)));
function From_Wide_Wide (C : Wide_Wide_Character) return Wide_Character is
(Wide_Character'Val (Wide_Wide_Character'Pos (C)));
-- Conversions [Wide_]Wide_Character --> [Wide_]Character.
-- These fail if the character is out of range.
function NL return Character is (ASCII.LF) with Inline;
function Wide_NL return Wide_Character is (To_Wide (Character'(NL)))
with Inline;
function Wide_Wide_NL return Wide_Wide_Character is
(To_Wide_Wide (Character'(NL))) with Inline;
-- Character representing new line. There is no support for CR/LF line
-- endings.
-- We have two subtypes of String that are encoded in UTF-8. UTF_8 cannot
-- contain newline characters; UTF_8_Lines can. Sending UTF_8 data to a
-- Sink is more efficient, because end-of-line processing is not needed.
-- Both of these are more efficient than [[Wide_]Wide_]String, because no
-- encoding is needed.
subtype UTF_8_Lines is UTF_Encoding.UTF_8_String with
Predicate =>
UTF_Encoding.Wide_Wide_Strings.Encode
(UTF_Encoding.Wide_Wide_Strings.Decode (UTF_8_Lines)) = UTF_8_Lines;
subtype UTF_8 is UTF_8_Lines with
Predicate => (for all UTF_8_Char of UTF_8 => UTF_8_Char /= NL);
Default_Indent_Amount : constant Natural := 4;
Default_Chunk_Length : constant Positive := 500;
-- Experiment shows this value to be reasonably efficient; decreasing it
-- slows things down, but increasing it doesn't gain much.
private
-- For Buffer, the "internal buffer" mentioned above is implemented as a
-- linked list of chunks. When the current chunk is full, we allocate a new
-- one. For File, there is only one chunk. When it is full, we send the
-- data to the file, and empty it.
type Chunk;
type Chunk_Access is access all Chunk with Storage_Size => 0;
type Chunk (Length : Positive) is limited record
Next : Chunk_Access := null;
Chars : UTF_8_Lines (1 .. Length);
end record;
type Sink (Chunk_Length : Positive) is abstract tagged limited record
Indent_Amount : Natural;
Column : Positive := 1;
Indentation : Natural := 0;
All_7_Bits : Boolean := True;
-- For optimization of Text_Output.Buffers.Get (cf).
-- True if all characters seen so far fit in 7 bits.
-- 7-bit characters are represented the same in Character
-- and in UTF-8, so they don't need translation.
All_8_Bits : Boolean := True;
-- True if all characters seen so far fit in 8 bits.
-- This is needed in Text_Output.Buffers.Get to distinguish
-- the case where all characters are Latin-1 (so it should
-- decode) from the case where some characters are bigger than
-- 8 bits (so the result is implementation defined).
Cur_Chunk : Chunk_Access;
-- Points to the chunk we are currently sending characters to.
-- We want to say:
-- Cur_Chunk : Chunk_Access := Initial_Chunk'Access;
-- but that's illegal, so we have some horsing around to do.
Last : Natural := 0;
-- Last-used character in Cur_Chunk.all.
Initial_Chunk : aliased Chunk (Length => Chunk_Length);
-- For Buffer, this is the first chunk. Subsequent chunks are allocated
-- on the heap. For File, this is the only chunk, and there is no heap
-- allocation.
end record;
end Ada.Strings.Text_Output;