Skip various cmp-mem-const tests on lp64 hppa*-*-*
[official-gcc.git] / gcc / ada / gen_il.adb
blob4fed1d1ecd1973a059f2aacd8c3e29421aa322ce
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 ------------------------------------------------------------------------------
26 with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
28 package body Gen_IL is
30 procedure Put (F : File_Type; S : String);
31 -- The output primitive
33 -----------
34 -- Image --
35 -----------
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;
47 ----------------
48 -- Capitalize --
49 ----------------
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;
64 Cap := not (Is_Letter (Old) or else Is_Digit (Old));
65 end;
66 end loop;
67 end Capitalize;
69 ----------------
70 -- Capitalize --
71 ----------------
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;
80 -----------------
81 -- Create_File --
82 -----------------
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;
91 ---------------------
92 -- Increase_Indent --
93 ---------------------
95 procedure Increase_Indent (Buffer : in out Sink; Amount : Natural) is
96 begin
97 Buffer.Indent := Buffer.Indent + Amount;
98 end Increase_Indent;
100 ---------------------
101 -- Decrease_Indent --
102 ---------------------
104 procedure Decrease_Indent (Buffer : in out Sink; Amount : Natural) is
105 begin
106 Buffer.Indent := Buffer.Indent - Amount;
107 end Decrease_Indent;
109 ---------
110 -- Put --
111 ---------
113 procedure Put (F : File_Type; S : String) is
114 begin
115 String'Write (Stream (F), S);
116 end Put;
118 procedure Put (Buffer : in out Sink; Item : String) is
119 begin
120 -- If the first character is LF, indent after it only
122 if Item (Item'First) = ASCII.LF then
123 Put (Buffer.File, LF);
124 Buffer.New_Line := True;
126 if Item'Length > 1 then
127 Put (Buffer, Item (Item'First + 1 .. Item'Last));
128 end if;
130 return;
131 end if;
133 -- If this is a new line, indent
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;
143 Put (Buffer.File, Item);
145 Buffer.New_Line := Item (Item'Last) = ASCII.LF;
146 end Put;
148 end Gen_IL;