diff gcc/ada/libgnat/g-forstr.ads @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/libgnat/g-forstr.ads	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,311 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                G N A T . F O R M A T T E D _ S T R I N G                 --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--           Copyright (C) 2014-2017, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package add support for formatted string as supported by C printf()
+
+--  A simple usage is:
+--
+--     Put_Line (-(+"%s" & "a string"));
+--
+--  or with a constant for the format:
+--
+--     declare
+--       Format : constant Formatted_String := +"%s";
+--     begin
+--       Put_Line (-(Format & "a string"));
+--     end;
+--
+--  Finally a more complex example:
+--
+--     declare
+--        F : Formatted_String := +"['%c' ; %10d]";
+--        C : Character := 'v';
+--        I : Integer := 98;
+--     begin
+--        F := F & C & I;
+--        Put_Line (-F);
+--     end;
+
+--  Which will display:
+
+--     ['v' ;         98]
+
+--  Each format specifier is: %[flags][width][.precision][length]specifier
+
+--  Specifiers:
+--    d or i    Signed decimal integer
+--    u         Unsigned decimal integer
+--    o         Unsigned octal
+--    x         Unsigned hexadecimal integer
+--    X         Unsigned hexadecimal integer (uppercase)
+--    f         Decimal floating point, lowercase
+--    F         Decimal floating point, uppercase
+--    e         Scientific notation (mantissa/exponent), lowercase
+--    E         Scientific notation (mantissa/exponent), uppercase
+--    g         Use the shortest representation: %e or %f
+--    G         Use the shortest representation: %E or %F
+--    c         Character
+--    s         String of characters
+--    p         Pointer address
+--    %         A % followed by another % character will write a single %
+
+--  Flags:
+
+--    -         Left-justify within the given field width;
+--              Right justification is the default.
+
+--    +         Forces to preceed the result with a plus or minus sign (+ or -)
+--              even for positive numbers. By default, only negative numbers
+--              are preceded with a - sign.
+
+--    (space)   If no sign is going to be written, a blank space is inserted
+--              before the value.
+
+--    #         Used with o, x or X specifiers the value is preceeded with
+--              0, 0x or 0X respectively for values different than zero.
+--              Used with a, A, e, E, f, F, g or G it forces the written
+--              output to contain a decimal point even if no more digits
+--              follow. By default, if no digits follow, no decimal point is
+--              written.
+
+--    ~         As above, but using Ada style based <base>#<number>#
+
+--    0         Left-pads the number with zeroes (0) instead of spaces when
+--              padding is specified.
+
+--  Width:
+--    number    Minimum number of characters to be printed. If the value to
+--              be printed is shorter than this number, the result is padded
+--              with blank spaces. The value is not truncated even if the
+--              result is larger.
+
+--    *         The width is not specified in the format string, but as an
+--              additional integer value argument preceding the argument that
+--              has to be formatted.
+--  Precision:
+--    number    For integer specifiers (d, i, o, u, x, X): precision specifies
+--              the minimum number of digits to be written. If the value to be
+--              written is shorter than this number, the result is padded with
+--              leading zeros. The value is not truncated even if the result
+--              is longer. A precision of 0 means that no character is written
+--              for the value 0.
+
+--              For e, E, f and F specifiers: this is the number of digits to
+--              be printed after the decimal point (by default, this is 6).
+--              For g and G specifiers: This is the maximum number of
+--              significant digits to be printed.
+
+--              For s: this is the maximum number of characters to be printed.
+--              By default all characters are printed until the ending null
+--              character is encountered.
+
+--              If the period is specified without an explicit value for
+--              precision, 0 is assumed.
+
+--    .*        The precision is not specified in the format string, but as an
+--              additional integer value argument preceding the argument that
+--              has to be formatted.
+
+with Ada.Text_IO;
+with System;
+
+private with Ada.Finalization;
+private with Ada.Strings.Unbounded;
+
+package GNAT.Formatted_String is
+   use Ada;
+
+   type Formatted_String (<>) is private;
+   --  A format string as defined for printf routine. This string is the
+   --  actual format for all the parameters added with the "&" routines below.
+   --  Note that a Formatted_String object can't be reused as it serves as
+   --  recipient for the final result. That is, each use of "&" will build
+   --  incrementally the final result string which can be retrieved with
+   --  the "-" routine below.
+
+   Format_Error : exception;
+   --  Raised for every mismatch between the parameter and the expected format
+   --  and for malformed format.
+
+   function "+" (Format : String) return Formatted_String;
+   --  Create the format string
+
+   function "-" (Format : Formatted_String) return String;
+   --  Get the result of the formatted string corresponding to the current
+   --  rendering (up to the last parameter formated).
+
+   function "&"
+     (Format : Formatted_String;
+      Var    : Character) return Formatted_String;
+   --  A character, expect a %c
+
+   function "&"
+     (Format : Formatted_String;
+      Var    : String) return Formatted_String;
+   --  A string, expect a %s
+
+   function "&"
+     (Format : Formatted_String;
+      Var    : Boolean) return Formatted_String;
+   --  A boolean image, expect a %s
+
+   function "&"
+     (Format : Formatted_String;
+      Var    : Integer) return Formatted_String;
+   --  An integer, expect a %d, %o, %x, %X
+
+   function "&"
+     (Format : Formatted_String;
+      Var    : Long_Integer) return Formatted_String;
+   --  As above
+
+   function "&"
+     (Format : Formatted_String;
+      Var    : System.Address) return Formatted_String;
+   --  An address, expect a %p
+
+   function "&"
+     (Format : Formatted_String;
+      Var    : Float) return Formatted_String;
+   --  A float, expect %f, %e, %F, %E, %g, %G
+
+   function "&"
+     (Format : Formatted_String;
+      Var    : Long_Float) return Formatted_String;
+   --  As above
+
+   function "&"
+     (Format : Formatted_String;
+      Var    : Duration) return Formatted_String;
+   --  As above
+
+   --  Some generics
+
+   generic
+      type Int is range <>;
+
+      with procedure Put
+        (To   : out String;
+         Item : Int;
+         Base : Text_IO.Number_Base);
+   function Int_Format
+     (Format : Formatted_String;
+      Var    : Int) return Formatted_String;
+   --  As for Integer above
+
+   generic
+      type Int is mod <>;
+
+      with procedure Put
+        (To   : out String;
+         Item : Int;
+         Base : Text_IO.Number_Base);
+   function Mod_Format
+     (Format : Formatted_String;
+      Var    : Int) return Formatted_String;
+   --  As for Integer above
+
+   generic
+      type Flt is digits <>;
+
+      with procedure Put
+        (To   : out String;
+         Item : Flt;
+         Aft  : Text_IO.Field;
+         Exp  : Text_IO.Field);
+   function Flt_Format
+     (Format : Formatted_String;
+      Var    : Flt) return Formatted_String;
+   --  As for Float above
+
+   generic
+      type Flt is delta <>;
+
+      with procedure Put
+        (To   : out String;
+         Item : Flt;
+         Aft  : Text_IO.Field;
+         Exp  : Text_IO.Field);
+   function Fixed_Format
+     (Format : Formatted_String;
+      Var    : Flt) return Formatted_String;
+   --  As for Float above
+
+   generic
+      type Flt is delta <> digits <>;
+
+      with procedure Put
+        (To   : out String;
+         Item : Flt;
+         Aft  : Text_IO.Field;
+         Exp  : Text_IO.Field);
+   function Decimal_Format
+     (Format : Formatted_String;
+      Var    : Flt) return Formatted_String;
+   --  As for Float above
+
+   generic
+      type Enum is (<>);
+   function Enum_Format
+     (Format : Formatted_String;
+      Var    : Enum) return Formatted_String;
+   --  As for String above, output the string representation of the enumeration
+
+private
+   use Ada.Strings.Unbounded;
+
+   type I_Vars is array (Positive range 1 .. 2) of Integer;
+   --  Used to keep 2 numbers for the possible * for the width and precision
+
+   type Data (Size : Natural) is record
+      Ref_Count    : Natural := 1;
+      Index        : Positive := 1;      -- format index for next value
+      Result       : Unbounded_String;   -- current value
+      Current      : Natural;            -- the current format number
+      Stored_Value : Natural := 0;       -- number of stored values in Stack
+      Stack        : I_Vars;
+      Format       : String (1 .. Size); -- the format string
+   end record;
+
+   type Data_Access is access Data;
+
+   --  The formatted string record is controlled and do not need an initialize
+   --  as it requires an explit initial value. This is given with "+" and
+   --  properly initialize the record at this point.
+
+   type Formatted_String is new Finalization.Controlled with record
+      D : Data_Access;
+   end record;
+
+   overriding procedure Adjust   (F : in out Formatted_String);
+   overriding procedure Finalize (F : in out Formatted_String);
+
+end GNAT.Formatted_String;