1-----------------------------------------------------------------------------
2--                         GNAT COMPILER COMPONENTS                         --
3--                                                                          --
4--                     G N A T . R E W R I T E _ D A T A                    --
5--                                                                          --
6--                                 B o d y                                  --
7--                                                                          --
8--            Copyright (C) 2014, Free Software Foundation, Inc.            --
9--                                                                          --
10-- GNAT is free software;  you can  redistribute it  and/or modify it under --
11-- terms of the  GNU General Public License as published  by the Free Soft- --
12-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
13-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
14-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
15-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
16--                                                                          --
17-- As a special exception under Section 7 of GPL version 3, you are granted --
18-- additional permissions described in the GCC Runtime Library Exception,   --
19-- version 3.1, as published by the Free Software Foundation.               --
20--                                                                          --
21-- You should have received a copy of the GNU General Public License and    --
22-- a copy of the GCC Runtime Library Exception along with this program;     --
23-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
24-- <http://www.gnu.org/licenses/>.                                          --
25--                                                                          --
26-- GNAT was originally developed  by the GNAT team at  New York University. --
27-- Extensive contributions were provided by Ada Core Technologies Inc.      --
28--                                                                          --
29------------------------------------------------------------------------------
30
31with Ada.Unchecked_Conversion;
32
33package body GNAT.Rewrite_Data is
34
35   use Ada;
36
37   subtype SEO is Stream_Element_Offset;
38
39   procedure Do_Output
40     (B      : in out Buffer;
41      Data   : Stream_Element_Array;
42      Output : not null access procedure (Data : Stream_Element_Array));
43   --  Do the actual output. This ensures that we properly send the data
44   --  through linked rewrite buffers if any.
45
46   ------------
47   -- Create --
48   ------------
49
50   function Create
51     (Pattern, Value : String;
52      Size           : Stream_Element_Offset := 1_024) return Buffer
53   is
54
55      subtype SP   is String (1 .. Pattern'Length);
56      subtype SEAP is Stream_Element_Array (1 .. Pattern'Length);
57
58      subtype SV   is String (1 .. Value'Length);
59      subtype SEAV is Stream_Element_Array (1 .. Value'Length);
60
61      function To_SEAP is new Unchecked_Conversion (SP, SEAP);
62      function To_SEAV is new Unchecked_Conversion (SV, SEAV);
63
64   begin
65      --  Return result (can't be smaller than pattern)
66
67      return B : Buffer
68                   (SEO'Max (Size, SEO (Pattern'Length)),
69                    SEO (Pattern'Length),
70                    SEO (Value'Length))
71      do
72         B.Pattern := To_SEAP (Pattern);
73         B.Value   := To_SEAV (Value);
74         B.Pos_C   := 0;
75         B.Pos_B   := 0;
76      end return;
77   end Create;
78
79   ---------------
80   -- Do_Output --
81   ---------------
82
83   procedure Do_Output
84     (B      : in out Buffer;
85      Data   : Stream_Element_Array;
86      Output : not null access procedure (Data : Stream_Element_Array))
87   is
88   begin
89      if B.Next = null then
90         Output (Data);
91      else
92         Write (B.Next.all, Data, Output);
93      end if;
94   end Do_Output;
95
96   -----------
97   -- Flush --
98   -----------
99
100   procedure Flush
101     (B      : in out Buffer;
102      Output : not null access procedure (Data : Stream_Element_Array))
103   is
104   begin
105      --  Flush output buffer
106
107      if B.Pos_B > 0 then
108         Do_Output (B, B.Buffer (1 .. B.Pos_B), Output);
109      end if;
110
111      --  Flush current buffer
112
113      if B.Pos_C > 0 then
114         Do_Output (B, B.Current (1 .. B.Pos_C), Output);
115      end if;
116
117      --  Flush linked buffer if any
118
119      if B.Next /= null then
120         Flush (B.Next.all, Output);
121      end if;
122
123      Reset (B);
124   end Flush;
125
126   ----------
127   -- Link --
128   ----------
129
130   procedure Link (From : in out Buffer; To : Buffer_Ref) is
131   begin
132      From.Next := To;
133   end Link;
134
135   -----------
136   -- Reset --
137   -----------
138
139   procedure Reset (B : in out Buffer) is
140   begin
141      B.Pos_B := 0;
142      B.Pos_C := 0;
143
144      if B.Next /= null then
145         Reset (B.Next.all);
146      end if;
147   end Reset;
148
149   -------------
150   -- Rewrite --
151   -------------
152
153   procedure Rewrite
154     (B      : in out Buffer;
155      Input  : not null access procedure
156                 (Buffer : out Stream_Element_Array;
157                  Last   : out Stream_Element_Offset);
158      Output : not null access procedure (Data : Stream_Element_Array))
159   is
160      Buffer : Stream_Element_Array (1 .. B.Size);
161      Last   : Stream_Element_Offset;
162
163   begin
164      Rewrite_All : loop
165         Input (Buffer, Last);
166         exit Rewrite_All when Last = 0;
167         Write (B, Buffer (1 .. Last), Output);
168      end loop Rewrite_All;
169
170      Flush (B, Output);
171   end Rewrite;
172
173   ----------
174   -- Size --
175   ----------
176
177   function Size (B : Buffer) return Natural is
178   begin
179      return Natural (B.Pos_B + B.Pos_C);
180   end Size;
181
182   -----------
183   -- Write --
184   -----------
185
186   procedure Write
187     (B      : in out Buffer;
188      Data   : Stream_Element_Array;
189      Output : not null access procedure (Data : Stream_Element_Array))
190   is
191      procedure Need_Space (Size : Stream_Element_Offset);
192      pragma Inline (Need_Space);
193
194      ----------------
195      -- Need_Space --
196      ----------------
197
198      procedure Need_Space (Size : Stream_Element_Offset) is
199      begin
200         if B.Pos_B + Size > B.Size then
201            Do_Output (B, B.Buffer (1 .. B.Pos_B), Output);
202            B.Pos_B := 0;
203         end if;
204      end Need_Space;
205
206   --  Start of processing for Write
207
208   begin
209      if B.Size_Pattern = 0 then
210         Do_Output (B, Data, Output);
211
212      else
213         for K in Data'Range loop
214            if Data (K) = B.Pattern (B.Pos_C + 1) then
215
216               --  Store possible start of a match
217
218               B.Pos_C := B.Pos_C + 1;
219               B.Current (B.Pos_C) := Data (K);
220
221            else
222               --  Not part of pattern, if a start of a match was found,
223               --  remove it.
224
225               if B.Pos_C /= 0 then
226                  Need_Space (B.Pos_C);
227
228                  B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Pos_C) :=
229                    B.Current (1 .. B.Pos_C);
230                  B.Pos_B := B.Pos_B + B.Pos_C;
231                  B.Pos_C := 0;
232               end if;
233
234               Need_Space (1);
235               B.Pos_B := B.Pos_B + 1;
236               B.Buffer (B.Pos_B) := Data (K);
237            end if;
238
239            if B.Pos_C = B.Size_Pattern then
240
241               --  The pattern is found
242
243               Need_Space (B.Size_Value);
244
245               B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Size_Value) := B.Value;
246               B.Pos_C := 0;
247               B.Pos_B := B.Pos_B + B.Size_Value;
248            end if;
249         end loop;
250      end if;
251   end Write;
252
253end GNAT.Rewrite_Data;
254