Boyer-Moore String Search Algorithm

boyer_moore_search.adb

package body Boyer_Moore_Search is

	function Table (Pattern : Array_Type) return Table_Type is
	begin
		return Result : Table_Type (Pattern'Length - 1) do
			-- Table 1
			for I in Element_Type loop
				Result.Occurrence (I) := -1;
			end loop;
			for I in Pattern'Range loop
				Result.Occurrence (Pattern (I)) := Pattern'Last - I + 1;
			end loop;
			-- Table 2
			for I in 0 .. Index_Type'Base'(Pattern'Length - 1) loop
				Result.Shifts (I) := 2 * Pattern'Length - I + 1;
			end loop;
			--for I in Result.Shifts'Range loop Text_IO.Put (Result.Shifts (I)'Img);end loop;Text_IO.New_Line;
			declare
				G : Shift_Table (0 .. Pattern'Length - 1);
				J : Index_Type'Base := Pattern'Length;
				S : Index_Type'Base;
			begin
				for K in reverse 0 .. Index_Type'Base'(Pattern'Length - 1) loop
					G (K) := J;
					while J /= Pattern'Length and then Pattern (Pattern'First + J) /= Pattern (Pattern'First + K) loop
						if Result.Shifts (J) > Pattern'Length - K then
							Result.Shifts (J) := Pattern'Length - K;
						end if;
						J := G (J);
					end loop;
					J := J - 1;
				end loop;
				S := J;
				for I in 0 .. Index_Type'Base'(Pattern'Length - 1) loop
					if Result.Shifts (I) > Pattern'Length + S - I + 1 then
						Result.Shifts (I) := Pattern'Length + S - I + 1;
					end if;
					if I >= S then
						S := G (S);
					end if;
				end loop;
			end;
			--for I in Result.Shifts'Range loop Text_IO.Put (Result.Shifts (I)'Img);end loop;Text_IO.New_Line;
		end return;
	end Table;

	function Index (Source, Pattern : Array_Type; Table : Table_Type) return Index_Type'Base is
		H : Index_Type'Base := Pattern'Length;
	begin
		loop
			exit when H > Source'Length;
			declare
				N : Index_Type'Base := Pattern'Length;
			begin
				--Text_IO.Put_Line (H'Img & N'Img);
				loop
					if N <= 0 then
						return Source'First + H;
					end if;
					N := N - 1;
					H := H - 1;
					exit when Pattern (Pattern'First + N) /= Source (Source'First + H);
					--Text_IO.Put_Line (H'Img & N'Img);
				end loop;
				H := H + Index_Type'Base'Max (Table.Shifts (N), Table.Occurrence (Source (Source'First + H)));
			end;
		end loop;
		return Source'First - 1;
	end Index;

	function Index (Source, Pattern : Array_Type) return Index_Type'Base is
	begin
		return Index (Source, Pattern, Table (Pattern));
	end Index;

end Boyer_Moore_Search;

boyer_moore_search.ads

generic
	type Index_Type is range <>;
	type Element_Type is (<>);
	type Array_Type is array (Index_Type range <>) of Element_Type;
package Boyer_Moore_Search is
	pragma Pure;

	type Occurrence_Table is array (Element_Type) of Index_Type'Base;
	type Shift_Table is array (Index_Type'Base range <>) of Index_Type'Base;

	type Table_Type (Pattern_Length_Minus_1 : Index_Type'Base) is limited record
		Occurrence : Occurrence_Table;
		Shifts : Shift_Table (0 .. Pattern_Length_Minus_1);
	end record;
	
	function Table (Pattern : Array_Type) return Table_Type;
	function Index (Source, Pattern : Array_Type; Table : Table_Type) return Index_Type'Base;
	function Index (Source, Pattern : Array_Type) return Index_Type'Base;

end Boyer_Moore_Search;