| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT RUN-TIME COMPONENTS -- |
| -- -- |
| -- ADA.STRINGS.TEXT_OUTPUT -- |
| -- -- |
| -- S p e c -- |
| -- -- |
| -- Copyright (C) 2020-2021, 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; |
