Skip to content

Commit

Permalink
Improve generics
Browse files Browse the repository at this point in the history
  • Loading branch information
@ollydev
ollydev committed Jan 13, 2024
1 parent b95914c commit e2a4187
Show file tree
Hide file tree
Showing 18 changed files with 617 additions and 355 deletions.
28 changes: 13 additions & 15 deletions Source/algorithms/simba.algo_sort.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@
}
unit simba.algo_sort;

{$DEFINE SIMBA_MAX_OPTIMIZATION}
{$i simba.inc}

interface
Expand All @@ -15,12 +14,11 @@ interface
simba.mufasatypes;

type
generic TCompareFunc<_T> = function(A, B: _T): Integer;
generic TCompareFunc<_T> = function(const A, B: _T): Integer;

generic procedure QuickSortFunc<_T>(var AValues: array of _T; ALeft, ARight: SizeInt; CompareFunc: specialize TCompareFunc<_T>);

generic procedure QuickSort<_T>(var AValues: array of _T; ALeft, ARight: SizeInt);
generic procedure QuickSortWeighted<_T, _W>(var Arr: array of _T; var Weights: array of _W; iLo, iHi: SizeInt; SortUp: Boolean);
generic procedure QuickSort<_T>(var AValues: specialize TArray<_T>; ALeft, ARight: SizeInt; CompareFunc: specialize TCompareFunc<_T>); overload;
generic procedure QuickSort<_T>(var AValues: specialize TArray<_T>; ALeft, ARight: SizeInt); overload;
generic procedure QuickSort<_T, _W>(var Arr: specialize TArray<_T>; var Weights: specialize TArray<_W>; iLo, iHi: SizeInt; SortUp: Boolean); overload;

generic procedure Sort<_T>(var Arr: specialize TArray<_T>); overload;
generic procedure Sort<_T, _W>(var Arr: specialize TArray<_T>; Weights: specialize TArray<_W>; SortUp: Boolean); overload;
Expand All @@ -30,7 +28,7 @@ interface

implementation

generic procedure QuickSortFunc<_T>(var AValues: array of _T; ALeft, ARight: SizeInt; CompareFunc: specialize TCompareFunc<_T>);
generic procedure QuickSort<_T>(var AValues: specialize TArray<_T>; ALeft, ARight: SizeInt; CompareFunc: specialize TCompareFunc<_T>);
var
I, J: SizeInt;
Q, P: _T;
Expand Down Expand Up @@ -65,19 +63,19 @@ implementation
if J - ALeft < ARight - I then
begin
if ALeft < J then
specialize QuickSortFunc<_T>(AValues, ALeft, J, CompareFunc);
specialize QuickSort<_T>(AValues, ALeft, J, CompareFunc);
ALeft := I;
end
else
begin
if I < ARight then
specialize QuickSortFunc<_T>(AValues, I, ARight, CompareFunc);
specialize QuickSort<_T>(AValues, I, ARight, CompareFunc);
ARight := J;
end;
until ALeft >= ARight;
end;

generic procedure QuickSort<_T>(var AValues: array of _T; ALeft, ARight: SizeInt);
generic procedure QuickSort<_T>(var AValues: specialize TArray<_T>; ALeft, ARight: SizeInt);
var
I, J: SizeInt;
Q, P: _T;
Expand Down Expand Up @@ -124,7 +122,7 @@ implementation
until ALeft >= ARight;
end;

generic procedure QuickSortWeighted<_T, _W>(var Arr: array of _T; var Weights: array of _W; iLo, iHi: SizeInt; SortUp: Boolean);
generic procedure QuickSort<_T, _W>(var Arr: specialize TArray<_T>; var Weights: specialize TArray<_W>; iLo, iHi: SizeInt; SortUp: Boolean);
var
Lo, Hi: SizeInt;
Mid, T: _W;
Expand Down Expand Up @@ -169,12 +167,12 @@ implementation
if Hi - iLo < iHi - Lo then
begin
if iLo < Hi then
specialize QuickSortWeighted<_T, _W>(Arr, Weights, iLo, Hi, SortUp);
specialize QuickSort<_T, _W>(Arr, Weights, iLo, Hi, SortUp);
iLo := Lo;
end else
begin
if Lo < iHi then
specialize QuickSortWeighted<_T, _W>(Arr, Weights, Lo, iHi, SortUp);
specialize QuickSort<_T, _W>(Arr, Weights, Lo, iHi, SortUp);
iHi := Hi;
end;
until iLo >= iHi;
Expand All @@ -189,7 +187,7 @@ implementation
begin
Weights := Copy(Weights);

specialize QuickSortWeighted<_T, _W>(Arr, Weights, Low(Arr), High(Arr), SortUp);
specialize QuickSort<_T, _W>(Arr, Weights, Low(Arr), High(Arr), SortUp);
end;

generic function Sorted<_T>(const Arr: specialize TArray<_T>): specialize TArray<_T>;
Expand All @@ -204,7 +202,7 @@ implementation
Weights := Copy(Weights);
Result := Copy(Arr);

specialize QuickSortWeighted<_T, _W>(Result, Weights, Low(Result), High(Result), SortUp);
specialize QuickSort<_T, _W>(Result, Weights, Low(Result), High(Result), SortUp);
end;

end.
Expand Down
61 changes: 19 additions & 42 deletions Source/algorithms/simba.algo_unique.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@
}
unit simba.algo_unique;

{$DEFINE SIMBA_MAX_OPTIMIZATION}
{$i simba.inc}

interface
Expand All @@ -14,63 +13,51 @@ interface
Classes, SysUtils, Math,
simba.mufasatypes;

generic function Unique<T>(const Arr: specialize TArray<T>): specialize TArray<T>;
generic function Unique_SameValue<T>(const Arr: specialize TArray<T>): specialize TArray<T>;
generic function Unique<_T>(const Arr: specialize TArray<_T>): specialize TArray<_T>;

function Algo_Unique_Single(const Arr: TSingleArray): TSingleArray;
function Algo_Unique_Double(const Arr: TDoubleArray): TDoubleArray;
function Algo_Unique_Points(const Arr: TPointArray): TPointArray;
function Algo_Unique_Integer(const Arr: TIntegerArray): TIntegerArray;
function Algo_Unique_String(const Arr: TStringArray): TStringArray;

implementation

uses
TypInfo,
simba.tpa, simba.arraybuffer, simba.math;

generic function Unique<T>(const Arr: specialize TArray<T>): specialize TArray<T>;
generic function Unique<_T>(const Arr: specialize TArray<_T>): specialize TArray<_T>;
var
I, J, Last: Integer;
begin
Result := Copy(Arr);
VarType: (OTHER, SINGLE, DOUBLE);

Last := Length(Result);
I := 0;
while (I < Last) do
function IsEquals(constref A, B: _T): Boolean;
begin
J := I + 1;
while (J < last) do
begin
if (Result[I] = Result[J]) then
begin
Result[J] := Result[Last - 1];

Dec(Last);
Dec(J);
end;

Inc(J);
case VarType of
SINGLE: Result := SameValue(PSingle(@A)^, PSingle(@B)^);
DOUBLE: Result := SameValue(PDouble(@A)^, PDouble(@B)^);
OTHER: Result := (A = B);
end;
Inc(I);
end;

SetLength(Result, Last);
end;

generic function Unique_SameValue<T>(const Arr: specialize TArray<T>): specialize TArray<T>;
var
I, J, Last: Integer;
begin
case GetTypeData(TypeInfo(_T))^.FloatType of
ftSingle: VarType := SINGLE;
ftDouble: VarType := DOUBLE;
else
VarType := OTHER;
end;

Result := Copy(Arr);

Last := Length(Result);
I := 0;
while (I < last) do
while (I < Last) do
begin
J := I + 1;
while (J < Last) do
begin
if SameValue(Result[I], Result[J]) then
if IsEquals(Result[I], Result[J]) then
begin
Result[J] := Result[Last - 1];

Expand All @@ -86,16 +73,6 @@ implementation
SetLength(Result, Last);
end;

function Algo_Unique_Single(const Arr: TSingleArray): TSingleArray;
begin
Result := specialize Unique_SameValue<Single>(Arr);
end;

function Algo_Unique_Double(const Arr: TDoubleArray): TDoubleArray;
begin
Result := specialize Unique_SameValue<Double>(Arr);
end;

function Algo_Unique_Points(const Arr: TPointArray): TPointArray;
var
Matrix: TBooleanMatrix;
Expand Down Expand Up @@ -188,7 +165,7 @@ function Algo_Unique_String(const Arr: TStringArray): TStringArray;
begin
Value := Arr[i];

with Table[Hash(Value) and Size] do
with Table[Value.Hash() and Size] do
begin
for J := 0 to Count - 1 do
if (Value = Bucket[J]) then
Expand Down
28 changes: 14 additions & 14 deletions Source/box.inc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ type
function Offset(X, Y: Integer): TBox; overload;
function Offset(P: TPoint): TBox; overload;
function Combine(Other: TBox): TBox;
function Invert(Area: TBox): TBoxArray;
function Invert(AArea: TBox): TBoxArray;
function Partition(Rows, Cols: Integer): TBoxArray;
function Extract(Points: TPointArray): TPointArray;
function Exclude(Points: TPointArray): TPointArray;
Expand Down Expand Up @@ -199,25 +199,25 @@ begin
Result.Y2 := Max(Max(Self.Y1, Other.Y2), Max(Other.Y1, Self.Y2));
end;

function TBoxHelper.Invert(Area: TBox): TBoxArray;
function TBoxHelper.Invert(AArea: TBox): TBoxArray;
var
lowX, maxX, lowY, maxY: Integer;
I: Integer;
begin
lowX := Max(Area.X1, Self.X1-1);
maxX := Min(Area.X2, Self.X2+1);
lowY := Max(Area.Y1, Self.Y1-1);
maxY := Min(Area.Y2, Self.Y2+1);
lowX := Max(AArea.X1, Self.X1-1);
maxX := Min(AArea.X2, Self.X2+1);
lowY := Max(AArea.Y1, Self.Y1-1);
maxY := Min(AArea.Y2, Self.Y2+1);

Result := [
TBox.Create(Area.X1, Area.Y1, lowX, lowY),
TBox.Create(Area.X1, lowY, lowX, maxY),
TBox.Create(Area.X1, lowY, lowX, Area.Y2),
TBox.Create(lowX, Area.Y1, maxX, lowY),
TBox.Create(lowX, maxY, maxX, Area.Y2),
TBox.Create(maxX, Area.Y1, Area.X2, lowY),
TBox.Create(maxX, lowY, Area.X2, maxY),
TBox.Create(maxX, lowY, Area.X2, Area.Y2)
TBox.Create(AArea.X1, AArea.Y1, lowX, lowY),
TBox.Create(AArea.X1, lowY, lowX, maxY),
TBox.Create(AArea.X1, lowY, lowX, AArea.Y2),
TBox.Create(lowX, AArea.Y1, maxX, lowY),
TBox.Create(lowX, maxY, maxX, AArea.Y2),
TBox.Create(maxX, AArea.Y1, AArea.X2, lowY),
TBox.Create(maxX, lowY, AArea.X2, maxY),
TBox.Create(maxX, lowY, AArea.X2, AArea.Y2)
];

for I := High(Result) downto 0 do
Expand Down
6 changes: 3 additions & 3 deletions Source/editor/simba.editor_autocomplete.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -351,7 +351,7 @@ procedure TSimbaAutoComplete.DoCodeCompletion(var Value: String; SourceValue: St
end;
end;

function CompareDeclarations(A, B: TDeclaration): Integer;
function CompareDeclarations(const A, B: TDeclaration): Integer;
begin
Result := CompareText(A.Name, B.Name);
end;
Expand Down Expand Up @@ -379,7 +379,7 @@ procedure TSimbaAutoComplete.DoFiltering(var NewPosition: Integer);
Inc(Count);
end;

specialize QuickSortFunc<TDeclaration>(FFilteredDecls, StartIndex, Count - 1, @CompareDeclarations);
specialize QuickSort<TDeclaration>(FFilteredDecls, StartIndex, Count - 1, @CompareDeclarations);
end;

procedure AddFiltered(Decls: TDeclarationArray; StartIndex: Integer);
Expand All @@ -402,7 +402,7 @@ procedure TSimbaAutoComplete.DoFiltering(var NewPosition: Integer);
end;
end;

specialize QuickSortWeighted<TDeclaration, Integer>(FFilteredDecls, FFilteredWeights, StartIndex, Count - 1, True);
specialize QuickSort<TDeclaration, Integer>(FFilteredDecls, FFilteredWeights, StartIndex, Count - 1, True);
end;

var
Expand Down
2 changes: 1 addition & 1 deletion Source/forms/simba.functionlistform.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,7 +95,7 @@ implementation
{$R *.lfm}

uses
simba.main, simba.ide_mainstatusbar, simba.ide_events, simba.threading,
simba.main, simba.ide_events, simba.threading,
simba.scripttabsform, simba.scripttab, simba.ide_showdeclaration, simba.nativeinterface;

function GetImage(const Decl: TDeclaration): Integer;
Expand Down
Loading

0 comments on commit e2a4187

Please sign in to comment.