254 lines
7.5 KiB
Ada
254 lines
7.5 KiB
Ada
-----------------------------------------------------------------------------
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- G N A T . R E W R I T E _ D A T A --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 2014, Free Software Foundation, Inc. --
|
|
-- --
|
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
-- --
|
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
|
-- version 3.1, as published by the Free Software Foundation. --
|
|
-- --
|
|
-- You should have received a copy of the GNU General Public License and --
|
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
-- <http://www.gnu.org/licenses/>. --
|
|
-- --
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Ada.Unchecked_Conversion;
|
|
|
|
package body GNAT.Rewrite_Data is
|
|
|
|
use Ada;
|
|
|
|
subtype SEO is Stream_Element_Offset;
|
|
|
|
procedure Do_Output
|
|
(B : in out Buffer;
|
|
Data : Stream_Element_Array;
|
|
Output : not null access procedure (Data : Stream_Element_Array));
|
|
-- Do the actual output. This ensures that we properly send the data
|
|
-- through linked rewrite buffers if any.
|
|
|
|
------------
|
|
-- Create --
|
|
------------
|
|
|
|
function Create
|
|
(Pattern, Value : String;
|
|
Size : Stream_Element_Offset := 1_024) return Buffer
|
|
is
|
|
|
|
subtype SP is String (1 .. Pattern'Length);
|
|
subtype SEAP is Stream_Element_Array (1 .. Pattern'Length);
|
|
|
|
subtype SV is String (1 .. Value'Length);
|
|
subtype SEAV is Stream_Element_Array (1 .. Value'Length);
|
|
|
|
function To_SEAP is new Unchecked_Conversion (SP, SEAP);
|
|
function To_SEAV is new Unchecked_Conversion (SV, SEAV);
|
|
|
|
begin
|
|
-- Return result (can't be smaller than pattern)
|
|
|
|
return B : Buffer
|
|
(SEO'Max (Size, SEO (Pattern'Length)),
|
|
SEO (Pattern'Length),
|
|
SEO (Value'Length))
|
|
do
|
|
B.Pattern := To_SEAP (Pattern);
|
|
B.Value := To_SEAV (Value);
|
|
B.Pos_C := 0;
|
|
B.Pos_B := 0;
|
|
end return;
|
|
end Create;
|
|
|
|
---------------
|
|
-- Do_Output --
|
|
---------------
|
|
|
|
procedure Do_Output
|
|
(B : in out Buffer;
|
|
Data : Stream_Element_Array;
|
|
Output : not null access procedure (Data : Stream_Element_Array))
|
|
is
|
|
begin
|
|
if B.Next = null then
|
|
Output (Data);
|
|
else
|
|
Write (B.Next.all, Data, Output);
|
|
end if;
|
|
end Do_Output;
|
|
|
|
-----------
|
|
-- Flush --
|
|
-----------
|
|
|
|
procedure Flush
|
|
(B : in out Buffer;
|
|
Output : not null access procedure (Data : Stream_Element_Array))
|
|
is
|
|
begin
|
|
-- Flush output buffer
|
|
|
|
if B.Pos_B > 0 then
|
|
Do_Output (B, B.Buffer (1 .. B.Pos_B), Output);
|
|
end if;
|
|
|
|
-- Flush current buffer
|
|
|
|
if B.Pos_C > 0 then
|
|
Do_Output (B, B.Current (1 .. B.Pos_C), Output);
|
|
end if;
|
|
|
|
-- Flush linked buffer if any
|
|
|
|
if B.Next /= null then
|
|
Flush (B.Next.all, Output);
|
|
end if;
|
|
|
|
Reset (B);
|
|
end Flush;
|
|
|
|
----------
|
|
-- Link --
|
|
----------
|
|
|
|
procedure Link (From : in out Buffer; To : Buffer_Ref) is
|
|
begin
|
|
From.Next := To;
|
|
end Link;
|
|
|
|
-----------
|
|
-- Reset --
|
|
-----------
|
|
|
|
procedure Reset (B : in out Buffer) is
|
|
begin
|
|
B.Pos_B := 0;
|
|
B.Pos_C := 0;
|
|
|
|
if B.Next /= null then
|
|
Reset (B.Next.all);
|
|
end if;
|
|
end Reset;
|
|
|
|
-------------
|
|
-- Rewrite --
|
|
-------------
|
|
|
|
procedure Rewrite
|
|
(B : in out Buffer;
|
|
Input : not null access procedure
|
|
(Buffer : out Stream_Element_Array;
|
|
Last : out Stream_Element_Offset);
|
|
Output : not null access procedure (Data : Stream_Element_Array))
|
|
is
|
|
Buffer : Stream_Element_Array (1 .. B.Size);
|
|
Last : Stream_Element_Offset;
|
|
|
|
begin
|
|
Rewrite_All : loop
|
|
Input (Buffer, Last);
|
|
exit Rewrite_All when Last = 0;
|
|
Write (B, Buffer (1 .. Last), Output);
|
|
end loop Rewrite_All;
|
|
|
|
Flush (B, Output);
|
|
end Rewrite;
|
|
|
|
----------
|
|
-- Size --
|
|
----------
|
|
|
|
function Size (B : Buffer) return Natural is
|
|
begin
|
|
return Natural (B.Pos_B + B.Pos_C);
|
|
end Size;
|
|
|
|
-----------
|
|
-- Write --
|
|
-----------
|
|
|
|
procedure Write
|
|
(B : in out Buffer;
|
|
Data : Stream_Element_Array;
|
|
Output : not null access procedure (Data : Stream_Element_Array))
|
|
is
|
|
procedure Need_Space (Size : Stream_Element_Offset);
|
|
pragma Inline (Need_Space);
|
|
|
|
----------------
|
|
-- Need_Space --
|
|
----------------
|
|
|
|
procedure Need_Space (Size : Stream_Element_Offset) is
|
|
begin
|
|
if B.Pos_B + Size > B.Size then
|
|
Do_Output (B, B.Buffer (1 .. B.Pos_B), Output);
|
|
B.Pos_B := 0;
|
|
end if;
|
|
end Need_Space;
|
|
|
|
-- Start of processing for Write
|
|
|
|
begin
|
|
if B.Size_Pattern = 0 then
|
|
Do_Output (B, Data, Output);
|
|
|
|
else
|
|
for K in Data'Range loop
|
|
if Data (K) = B.Pattern (B.Pos_C + 1) then
|
|
|
|
-- Store possible start of a match
|
|
|
|
B.Pos_C := B.Pos_C + 1;
|
|
B.Current (B.Pos_C) := Data (K);
|
|
|
|
else
|
|
-- Not part of pattern, if a start of a match was found,
|
|
-- remove it.
|
|
|
|
if B.Pos_C /= 0 then
|
|
Need_Space (B.Pos_C);
|
|
|
|
B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Pos_C) :=
|
|
B.Current (1 .. B.Pos_C);
|
|
B.Pos_B := B.Pos_B + B.Pos_C;
|
|
B.Pos_C := 0;
|
|
end if;
|
|
|
|
Need_Space (1);
|
|
B.Pos_B := B.Pos_B + 1;
|
|
B.Buffer (B.Pos_B) := Data (K);
|
|
end if;
|
|
|
|
if B.Pos_C = B.Size_Pattern then
|
|
|
|
-- The pattern is found
|
|
|
|
Need_Space (B.Size_Value);
|
|
|
|
B.Buffer (B.Pos_B + 1 .. B.Pos_B + B.Size_Value) := B.Value;
|
|
B.Pos_C := 0;
|
|
B.Pos_B := B.Pos_B + B.Size_Value;
|
|
end if;
|
|
end loop;
|
|
end if;
|
|
end Write;
|
|
|
|
end GNAT.Rewrite_Data;
|