File : g-rewdat.adb
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 -- --
18 -- --
19 -- --
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
31 with Ada.Unchecked_Conversion;
32
33 package 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
253 end GNAT.Rewrite_Data;