gcc/ada/gen_il.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                G E N _ I L                               --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --           Copyright (C) 2020-2023, Free Software Foundation, Inc.        --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
  27
  28 package body Gen_IL is
  29
  30    procedure Put (F : File_Type; S : String);
  31    --  The output primitive
  32
  33    -----------
  34    -- Image --
  35    -----------
  36
  37    function Image (X : Root_Int) return String is
  38       Result : constant String := X'Img;
  39    begin
  40       if Result (1) = ' ' then
  41          return Result (2 .. Result'Last);
  42       else
  43          return Result;
  44       end if;
  45    end Image;
  46
  47    ----------------
  48    -- Capitalize --
  49    ----------------
  50
  51    procedure Capitalize (S : in out String) is
  52       Cap : Boolean := True;
  53    begin
  54       for X of S loop
  55          declare
  56             Old : constant Character := X;
  57          begin
  58             if Cap then
  59                X := To_Upper (X);
  60             else
  61                X := To_Lower (X);
  62             end if;
  63
  64             Cap := not (Is_Letter (Old) or else Is_Digit (Old));
  65          end;
  66       end loop;
  67    end Capitalize;
  68
  69    ----------------
  70    -- Capitalize --
  71    ----------------
  72
  73    function Capitalize (S : String) return String is
  74    begin
  75       return Result : String (S'Range) := S do
  76          Capitalize (Result);
  77       end return;
  78    end Capitalize;
  79
  80    -----------------
  81    -- Create_File --
  82    -----------------
  83
  84    procedure Create_File (Buffer : in out Sink; Name : String) is
  85    begin
  86       Create (Buffer.File, Out_File, Name);
  87       Buffer.Indent := 0;
  88       Buffer.New_Line := True;
  89    end Create_File;
  90
  91    ---------------------
  92    -- Increase_Indent --
  93    ---------------------
  94
  95    procedure Increase_Indent (Buffer : in out Sink; Amount : Natural) is
  96    begin
  97       Buffer.Indent := Buffer.Indent + Amount;
  98    end Increase_Indent;
  99
 100    ---------------------
 101    -- Decrease_Indent --
 102    ---------------------
 103
 104    procedure Decrease_Indent (Buffer : in out Sink; Amount : Natural) is
 105    begin
 106       Buffer.Indent := Buffer.Indent - Amount;
 107    end Decrease_Indent;
 108
 109    ---------
 110    -- Put --
 111    ---------
 112
 113    procedure Put (F : File_Type; S : String) is
 114    begin
 115       String'Write (Stream (F), S);
 116    end Put;
 117
 118    procedure Put (Buffer : in out Sink; Item : String) is
 119    begin
 120       --  If the first character is LF, indent after it only
 121
 122       if Item (Item'First) = ASCII.LF then
 123          Put (Buffer.File, LF);
 124          Buffer.New_Line := True;
 125
 126          if Item'Length > 1 then
 127             Put (Buffer, Item (Item'First + 1 .. Item'Last));
 128          end if;
 129
 130          return;
 131       end if;
 132
 133       --  If this is a new line, indent
 134
 135       if Buffer.New_Line and then Buffer.Indent > 0 then
 136          declare
 137             S : constant String (1 .. Buffer.Indent) := (others => ' ');
 138          begin
 139             Put (Buffer.File, S);
 140          end;
 141       end if;
 142
 143       Put (Buffer.File, Item);
 144
 145       Buffer.New_Line := Item (Item'Last) = ASCII.LF;
 146    end Put;
 147
 148 end Gen_IL;