Skip to content

Instantly share code, notes, and snippets.

@ytomino
Created March 6, 2011 07:53
Show Gist options
  • Save ytomino/857129 to your computer and use it in GitHub Desktop.
Save ytomino/857129 to your computer and use it in GitHub Desktop.
diff algorithm
with Ada.Unchecked_Deallocation;
with System.Pool_Local;
package body Difference is
procedure Diff (
Left, Right : in Container_Type;
Notify : not null access procedure (
Left_Low : Index_Type; Left_High : Index_Type'Base;
Right_Low : Index_Type; Right_High : Index_Type'Base))
is
function "+" (Left : Index_Type'Base; Right : Length_Type'Base) return Index_Type'Base is
begin
return Index_Type'Base'Val (Index_Type'Base'Pos (Left) + Right);
end "+";
function "-" (Left : Index_Type'Base; Right : Length_Type'Base) return Index_Type'Base is
begin
return Index_Type'Base'Val (Index_Type'Base'Pos (Left) - Right);
end "-";
Fixed_Pool : Storage_Pool;
Local_Pool : System.Pool_Local.Unbounded_Reclaim_Pool;
type Path;
type Path_Access is access Path;
for Path_Access'Storage_Pool use Fixed_Pool;
type Path is record
Previous : Path_Access;
X : Length_Type;
Y : Length_Type;
Count : Length_Type;
Reference_Count : Natural;
end record;
procedure Release (X : in out Path_Access) is
procedure Free is new Ada.Unchecked_Deallocation (Path, Path_Access);
begin
if X /= null then
X.Reference_Count := X.Reference_Count - 1;
if X.Reference_Count = 0 then
declare
Previous : Path_Access := X.Previous;
begin
Free (X);
Release (Previous);
end;
end if;
end if;
end Release;
type Container_Access is access constant Container_Type;
for Container_Access'Storage_Size use 0;
Left_Length : constant Length_Type := Length (Left);
Right_Length : constant Length_Type := Length (Right);
Larger : Container_Access;
Larger_First : Index_Type;
Larger_Last : Index_Type'Base;
Larger_Length : Length_Type;
Smaller : Container_Access;
Smaller_First : Index_Type;
Smaller_Last : Index_Type'Base;
Smaller_Length : Length_Type'Base;
begin
if Left_Length < Right_Length then
Smaller := Left'Unrestricted_Access;
Smaller_Length := Left_Length;
Larger := Right'Unrestricted_Access;
Larger_Length := Right_Length;
else
Smaller := Right'Unrestricted_Access;
Smaller_Length := Right_Length;
Larger := Left'Unrestricted_Access;
Larger_Length := Left_Length;
end if;
case Direction is
when Forward =>
Smaller_Last := Last_Index (Smaller.all);
Larger_Last := Last_Index (Larger.all);
when Backward =>
Smaller_First := First_Index (Smaller.all);
Larger_First := First_Index (Larger.all);
end case;
declare
Work_Length : constant Length_Type := Smaller_Length + Larger_Length + 3;
type FP_Array is array (Length_Type range 0 .. Work_Length - 1) of Length_Type'Base;
type Path_Array is array (FP_Array'Range) of Path_Access;
type FP_Array_Access is access FP_Array;
for FP_Array_Access'Storage_Pool use Local_Pool;
type Path_Array_Access is access Path_Array;
for Path_Array_Access'Storage_Pool use Local_Pool;
FP : FP_Array_Access := new FP_Array'(others => -1);
Path : Path_Array_Access := new Path_Array'(others => null);
Offset : constant Length_Type := Smaller_Length + 1;
Length_Delta : constant Length_Type := Larger_Length - Smaller_Length;
function Snake (k, fpa, fpb : Length_Type'Base) return Length_Type is
Result : Length_Type;
X : Length_Type'Base;
Y : Length_Type'Base;
Count : Length_Type;
Pre_K : Length_Type'Base;
New_Path : Path_Access;
begin
if fpa > fpb then
Y := fpa;
Pre_K := K - 1;
else
Y := fpb;
Pre_K := K + 1;
end if;
x := y - k;
Count := 0;
case Direction is
when Forward =>
while x < Smaller_Length and then y < Larger_Length
and then Element (Smaller.all, Smaller_Last - x) = Element (Larger.all, Larger_Last - y)
loop
X := X + 1;
Y := Y + 1;
Count := Count + 1;
end loop;
when Backward =>
while x < Smaller_Length and then y < Larger_Length
and then Element (Smaller.all, Smaller_First + x) = Element (Larger.all, Larger_First + y)
loop
X := X + 1;
Y := Y + 1;
Count := Count + 1;
end loop;
end case;
New_Path := new Diff.Path;
New_Path.Previous := Path (Pre_K + Offset);
if K /= Pre_K then
if New_Path.Previous /= null then
New_Path.Previous.Reference_Count := New_Path.Previous.Reference_Count + 1;
end if;
Release (Path (K + Offset));
end if;
New_Path.X := X;
New_Path.Y := Y;
New_Path.Count := Count;
New_Path.Reference_Count := 1;
Path (K + Offset) := New_Path;
Result := y;
return Result;
end Snake;
begin
for P in 0 .. Smaller_Length loop
for K in -P .. Length_Delta - 1 loop
fp (k + offset) := snake (k, fp (k - 1 + offset) + 1, fp (k + 1 + offset));
end loop;
for K in reverse Length_Delta .. Length_Delta + P loop
fp (k + offset) := snake (k, fp (k - 1 + offset) + 1, fp (k + 1 + offset));
end loop;
if FP (Length_Delta + Offset) = Larger_Length then
declare
Tracing_Path : Path_Access := Path (Length_Delta + Offset);
Smaller_Position : Length_Type := Smaller_Length;
Larger_Position : Length_Type := Larger_Length;
begin
while Tracing_Path /= null loop
if Tracing_Path.X < Smaller_Position or else Tracing_Path.Y < Larger_Position then
declare
Smaller_Last_Position : constant Length_Type'Base := Smaller_Position - 1;
Larger_Last_Position : constant Length_Type'Base := Larger_Position - 1;
begin
while Tracing_Path.Previous /= null
and then (Tracing_Path.X = Smaller_Position or else Tracing_Path.Y = Larger_Position)
and then Tracing_Path.Count = 0
loop
Smaller_Position := Tracing_Path.X - Tracing_Path.Count;
Larger_Position := Tracing_Path.Y - Tracing_Path.Count;
Tracing_Path := Tracing_Path.Previous;
end loop;
if Smaller = Left'Unrestricted_Access then
case Direction is
when Forward =>
Notify (Smaller_Last - Smaller_Last_Position, Smaller_Last - Tracing_Path.X,
Larger_Last - Larger_Last_Position, Larger_Last - Tracing_Path.Y);
when Backward =>
Notify (Smaller_First + Tracing_Path.X, Smaller_First + Smaller_Last_Position,
Larger_First + Tracing_Path.Y, Larger_First + Larger_Last_Position);
end case;
else
case Direction is
when Forward =>
Notify (Larger_Last - Larger_Last_Position, Larger_Last - Tracing_Path.Y,
Smaller_Last - Smaller_Last_Position, Smaller_Last - Tracing_Path.X);
when Backward =>
Notify (Larger_First + Tracing_Path.Y, Larger_First + Larger_Last_Position,
Smaller_First + Tracing_Path.X, Smaller_First + Smaller_Last_Position);
end case;
end if;
end;
end if;
Smaller_Position := Tracing_Path.X - Tracing_Path.Count;
Larger_Position := Tracing_Path.Y - Tracing_Path.Count;
Tracing_Path := Tracing_Path.Previous;
end loop;
end;
return;
end if;
end loop;
pragma Assert (False);
end;
end Diff;
end Difference;
with System.Storage_Pools;
package Difference is
type Direction is (Forward, Backward);
generic
type Storage_Pool is new System.Storage_Pools.Root_Storage_Pool with private;
type Index_Type is (<>);
type Element_Type (<>) is limited private;
type Container_Type (<>) is limited private;
type Length_Type is range <>;
Direction : in Difference.Direction := Forward;
with function Length (Container : Container_Type) return Length_Type is <>;
with function Element (Container : Container_Type; Index : Index_Type) return Element_Type is <>;
with function First_Index (Container : Container_Type) return Index_Type is <>;
with function Last_Index (Container : Container_Type) return Index_Type is <>;
with function "="(Left, Right : Element_Type) return Boolean is <>;
procedure Diff (
Left, Right : in Container_Type;
Notify : not null access procedure (
Left_Low : Index_Type;
Left_High : Index_Type'Base;
Right_Low : Index_Type;
Right_High : Index_Type'Base));
end Difference;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment