[Ada] Generic binary search implementation
Allows binary search in sorted anonymous array (or array-like container). gcc/ada/ * libgnat/g-binsea.ads, libgnat/g-binsea.adb (GNAT.Binary_Search): New package. * Makefile.rtl (GNATRTL_NONTASKING_OBJS): New item in list. * doc/gnat_rm/the_gnat_library.rst (GNAT.Binary_Search): New package record. * gnat_rm.texi: Regenerate.
This commit is contained in:
Dmitriy Anisimkov
Pierre-Marie de Rodat
parent
ca3e565395
commit
a2bcadcef0
@ -416,6 +416,7 @@ GNATRTL_NONTASKING_OBJS= \
|
||||
g-arrspl$(objext) \
|
||||
g-awk$(objext) \
|
||||
g-binenv$(objext) \
|
||||
g-binsea$(objext) \
|
||||
g-brapre$(objext) \
|
||||
g-bubsor$(objext) \
|
||||
g-busora$(objext) \
|
||||
|
||||
@ -721,6 +721,18 @@ Provides AWK-like parsing functions, with an easy interface for parsing one
|
||||
or more files containing formatted data. The file is viewed as a database
|
||||
where each record is a line and a field is a data element in this line.
|
||||
|
||||
.. _`GNAT.Binary_Search_(g-binsea.ads)`:
|
||||
|
||||
``GNAT.Binary_Search`` (:file:`g-binsea.ads`)
|
||||
================================================
|
||||
|
||||
.. index:: GNAT.Binary_Search (g-binsea.ads)
|
||||
|
||||
.. index:: Binary search
|
||||
|
||||
Allow binary search of a sorted array (or of an array-like container;
|
||||
the generic does not reference the array directly).
|
||||
|
||||
.. _`GNAT.Bind_Environment_(g-binenv.ads)`:
|
||||
|
||||
``GNAT.Bind_Environment`` (:file:`g-binenv.ads`)
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
123
gcc/ada/libgnat/g-binsea.adb
Normal file
123
gcc/ada/libgnat/g-binsea.adb
Normal file
@ -0,0 +1,123 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- GNAT.BINARY_SEARCH --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2022, AdaCore --
|
||||
-- --
|
||||
-- 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/>. --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
package body GNAT.Binary_Search is
|
||||
|
||||
function Index
|
||||
(First, Last, Start : Index_Type;
|
||||
Element : Element_Type) return Index_Type'Base is
|
||||
begin
|
||||
if Leftmost then
|
||||
declare
|
||||
function Before
|
||||
(Index : Index_Type; Element : Element_Type) return Boolean
|
||||
is (Before (Get (Index), Element)) with Inline_Always;
|
||||
|
||||
function Find is new Binary_Search.Leftmost
|
||||
(Index_Type, Element_Type, Before);
|
||||
begin
|
||||
return Find (First, Last, Start, Element);
|
||||
end;
|
||||
|
||||
else
|
||||
declare
|
||||
function Before
|
||||
(Element : Element_Type; Index : Index_Type) return Boolean
|
||||
is (Before (Element, Get (Index))) with Inline_Always;
|
||||
|
||||
function Find is new Rightmost (Index_Type, Element_Type, Before);
|
||||
begin
|
||||
return Find (First, Last, Start, Element);
|
||||
end;
|
||||
end if;
|
||||
end Index;
|
||||
|
||||
--------------
|
||||
-- Leftmost --
|
||||
--------------
|
||||
|
||||
function Leftmost
|
||||
(First, Last, Start : Index_Type;
|
||||
Element : Element_Type) return Index_Type'Base
|
||||
is
|
||||
L : Index_Type := First;
|
||||
R : Index_Type := Index_Type'Succ (Last);
|
||||
M : Index_Type := Start;
|
||||
begin
|
||||
if First <= Last then
|
||||
loop
|
||||
if Before (M, Element) then
|
||||
L := Index_Type'Succ (M);
|
||||
else
|
||||
R := M;
|
||||
end if;
|
||||
|
||||
exit when L >= R;
|
||||
|
||||
M := Index_Type'Val
|
||||
(Index_Type'Pos (L) +
|
||||
(Index_Type'Pos (R) - Index_Type'Pos (L)) / 2);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
return L;
|
||||
end Leftmost;
|
||||
|
||||
---------------
|
||||
-- Rightmost --
|
||||
---------------
|
||||
|
||||
function Rightmost
|
||||
(First, Last, Start : Index_Type;
|
||||
Element : Element_Type) return Index_Type'Base
|
||||
is
|
||||
L : Index_Type := First;
|
||||
R : Index_Type := Index_Type'Succ (Last);
|
||||
M : Index_Type := Start;
|
||||
begin
|
||||
if First > Last then
|
||||
return Last;
|
||||
else
|
||||
loop
|
||||
if Before (Element, M) then
|
||||
R := M;
|
||||
else
|
||||
L := Index_Type'Succ (M);
|
||||
end if;
|
||||
|
||||
exit when L >= R;
|
||||
|
||||
M := Index_Type'Val
|
||||
(Index_Type'Pos (L) +
|
||||
(Index_Type'Pos (R) - Index_Type'Pos (L)) / 2);
|
||||
end loop;
|
||||
end if;
|
||||
|
||||
return Index_Type'Pred (R);
|
||||
end Rightmost;
|
||||
|
||||
end GNAT.Binary_Search;
|
||||
93
gcc/ada/libgnat/g-binsea.ads
Normal file
93
gcc/ada/libgnat/g-binsea.ads
Normal file
@ -0,0 +1,93 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- GNAT.BINARY_SEARCH --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2022, AdaCore --
|
||||
-- --
|
||||
-- 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/>. --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- Allow binary search of a sorted array (or of an array-like container;
|
||||
-- the generic does not reference the array directly).
|
||||
|
||||
package GNAT.Binary_Search is
|
||||
|
||||
generic
|
||||
type Index_Type is (<>);
|
||||
type Element_Type (<>) is private;
|
||||
with function Get (Index : Index_Type) return Element_Type;
|
||||
with function Before (Left, Right : Element_Type) return Boolean;
|
||||
Leftmost : Boolean := True;
|
||||
function Index
|
||||
(First, Last, Start : Index_Type;
|
||||
Element : Element_Type) return Index_Type'Base;
|
||||
-- Search for element in sorted container. Function Before should return
|
||||
-- True when Left and Right are in the container's sort order and not
|
||||
-- equal. Function Get returns the container element indexed by Index;
|
||||
-- Index will be in the range First .. Last. If there is at least one index
|
||||
-- value in the range First .. Last for which Get would return Element,
|
||||
-- then the Leftmost generic parameter indicates whether the least (if
|
||||
-- Leftmost is True) or the greatest (if Leftmost is False) such index
|
||||
-- value is returned. If no such index value exists, then Leftmost
|
||||
-- determines whether to return the greater (if Leftmost is True) or the
|
||||
-- smaller (if Leftmost is False) of the two index values between which
|
||||
-- Element could be inserted. If First > Last (so that a null range is
|
||||
-- being searched), some Index_Type'Base value will be returned.
|
||||
-- Start is the index for the first probe of the binary search. It can
|
||||
-- improve speed of many search operations when user can guess the most
|
||||
-- likely values. If you do not know what value should be used there, use
|
||||
-- (First + Last) / 2.
|
||||
|
||||
generic
|
||||
type Index_Type is (<>);
|
||||
type Element_Type (<>) is private;
|
||||
with function Before
|
||||
(Index : Index_Type; Element : Element_Type) return Boolean;
|
||||
function Leftmost
|
||||
(First, Last, Start : Index_Type;
|
||||
Element : Element_Type) return Index_Type'Base
|
||||
with Pre => First > Last -- Empty array
|
||||
or else (Start in First .. Last
|
||||
and then ( -- To prevent overflow in function result
|
||||
Index_Type'Base'Last > Last
|
||||
or else not Before (Last, Element)));
|
||||
-- Leftmost returns the result described for Index in the case where the
|
||||
-- Leftmost parameter is True, with Index_Type values mapped to
|
||||
-- Element_Type values via Get as needed.
|
||||
|
||||
generic
|
||||
type Index_Type is (<>);
|
||||
type Element_Type (<>) is private;
|
||||
with function Before
|
||||
(Element : Element_Type; Index : Index_Type) return Boolean;
|
||||
function Rightmost
|
||||
(First, Last, Start : Index_Type;
|
||||
Element : Element_Type) return Index_Type'Base
|
||||
with Pre => First > Last -- Empty array
|
||||
or else (Start in First .. Last
|
||||
and then ( -- To prevent overflow in function result
|
||||
Index_Type'Base'First < First
|
||||
or else not Before (Element, First)));
|
||||
-- Rightmost returns the result described for Index in the case where the
|
||||
-- Leftmost parameter is False, with Index_Type values mapped to
|
||||
-- Element_Type values via Get as needed.
|
||||
|
||||
end GNAT.Binary_Search;
|
||||
Loading…
Reference in New Issue
Block a user