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