Skip to content

Commit

Permalink
pastojs: faster concat append array:=array+
Browse files Browse the repository at this point in the history
  • Loading branch information
@Felzomah
Felzomah committed Jun 10, 2022
1 parent 34605e9 commit 22926e4
Show file tree
Hide file tree
Showing 2 changed files with 139 additions and 5 deletions.
56 changes: 55 additions & 1 deletion packages/pastojs/src/fppas2js.pp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2226,6 +2226,7 @@ TCreateRefPathData = record
Function ConvertAssignStatement(El: TPasImplAssign; AContext: TConvertContext): TJSElement; virtual;
Function ConvertDirectAssignArrayStatement(El: TPasImplAssign; AssignContext: TAssignContext): TJSElement; virtual;
Function ConvertDirectAssignArrayConcat(El: TPasImplAssign; Params: TParamsExpr; AssignContext: TAssignContext): TJSElement; virtual;
Function ConvertDirectAssignArrayAdd(El: TPasImplAssign; Bin: TBinaryExpr; AssignContext: TAssignContext): TJSElement; virtual;
Function ConvertRaiseStatement(El: TPasImplRaise; AContext: TConvertContext ): TJSElement; virtual;
Function ConvertIfStatement(El: TPasImplIfElse; AContext: TConvertContext ): TJSElement; virtual;
Function ConvertWhileStatement(El: TPasImplWhileDo; AContext: TConvertContext): TJSElement; virtual;
Expand Down Expand Up @@ -23201,7 +23202,9 @@ function TPasToJSConverter.ConvertDirectAssignArrayStatement(

end;
end;
end;
end
else if (RightExpr.Kind=pekBinary) and (RightExpr.OpCode=eopAdd) then
Result:=ConvertDirectAssignArrayAdd(El,TBinaryExpr(RightExpr),AssignContext);
end;

function TPasToJSConverter.ConvertDirectAssignArrayConcat(El: TPasImplAssign;
Expand Down Expand Up @@ -23272,6 +23275,57 @@ function TPasToJSConverter.ConvertDirectAssignArrayConcat(El: TPasImplAssign;
end;
end;

function TPasToJSConverter.ConvertDirectAssignArrayAdd(El: TPasImplAssign;
Bin: TBinaryExpr; AssignContext: TAssignContext): TJSElement;
var
BinLeft, BinRight: TPasExpr;
Ref: TResolvedReference;
Decl: TPasElement;
ParentContext: TConvertContext;
SubParams: TParamsExpr;
Call: TJSCallExpression;
i: Integer;
JS: TJSElement;
begin
Result:=nil;
BinLeft:=Bin.Left;
if not (BinLeft.CustomData is TResolvedReference) then
exit;
Ref:=TResolvedReference(BinLeft.CustomData);
Decl:=Ref.Declaration;
if not (El.Left.CustomData is TResolvedReference) then exit;
if (Decl<>TResolvedReference(El.Left.CustomData).Declaration) then
exit;
// A:=A+...
BinRight:=Bin.Right;
if BinRight.Kind=pekSet then
begin
// A:=A+[b,...] -> A=rtl.arrayPushN(A,b,...);
SubParams:=TParamsExpr(BinRight);
ParentContext:=AssignContext.Parent;
if length(SubParams.Params)=0 then
begin
// A:=Concat(A,[]) -> A;
Result:=ConvertExpression(BinLeft,ParentContext);
exit;
end;
try
Call:=CreateArrayConcat(AssignContext.LeftResolved.LoTypeEl as TPasArrayType,
El,ParentContext,true);
Call.AddArg(ConvertExpression(BinLeft,ParentContext));
for i:=0 to length(SubParams.Params)-1 do
begin
JS:=CreateArrayEl(SubParams.Params[i],ParentContext);
Call.AddArg(JS);
end;
Result:=Call;
finally
if Result=nil then
Call.Free;
end;
end;
end;

function TPasToJSConverter.ConvertIfStatement(El: TPasImplIfElse;
AContext: TConvertContext): TJSElement;
Var
Expand Down
88 changes: 84 additions & 4 deletions packages/pastojs/tests/tcmodules.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -501,6 +501,7 @@ TTestModule = class(TCustomTestModule)
Procedure TestArray_Concat_Append_Var;
Procedure TestArray_Copy;
Procedure TestArray_InsertDelete;
Procedure TestArray_Add_Append;
Procedure TestArray_DynArrayConstObjFPC;
Procedure TestArray_DynArrayConstDelphi;
Procedure TestArray_ArrayLitAsParam;
Expand Down Expand Up @@ -11639,6 +11640,85 @@ ' TRec = record',
'']));
end;

procedure TTestModule.TestArray_Add_Append;
begin
StartProgram(false);
Add([
'{$modeswitch arrayoperators}',
'type',
' integer = longint;',
' TFlag = (big,small);',
' TFlags = set of TFlag;',
' TRec = record',
' i: integer;',
' end;',
' TArrInt = array of integer;',
' TArrRec = array of TRec;',
' TArrFlag = array of TFlag;',
' TArrSet = array of TFlags;',
' TArrJSValue = array of jsvalue;',
'var',
' ArrInt: tarrint;',
' ArrRec: tarrrec;',
' ArrFlag: tarrflag;',
' ArrSet: tarrset;',
' ArrJSValue: tarrjsvalue;',
' r: TRec;',
' f: TFlags;',
'begin',
' // append',
' arrint:=arrint+[2];',
' arrint:=arrint+[3,4];',
' arrrec:=arrrec+[r];',
' arrrec:=arrrec+[r,r];',
' arrset:=arrset+[f];',
' arrset:=arrset+[f,f];',
' arrjsvalue:=arrjsvalue+[11];',
' arrjsvalue:=arrjsvalue+[12,13];',
' arrflag:=arrflag+[small];',
' arrflag:=arrflag+[small,big];',
'']);
ConvertProgram;
CheckSource('TestArray_Add_Append',
LinesToStr([ // statements
'this.TFlag = {',
' "0": "big",',
' big: 0,',
' "1": "small",',
' small: 1',
'};',
'rtl.recNewT(this, "TRec", function () {',
' this.i = 0;',
' this.$eq = function (b) {',
' return this.i === b.i;',
' };',
' this.$assign = function (s) {',
' this.i = s.i;',
' return this;',
' };',
'});',
'this.ArrInt = [];',
'this.ArrRec = [];',
'this.ArrFlag = [];',
'this.ArrSet = [];',
'this.ArrJSValue = [];',
'this.r = this.TRec.$new();',
'this.f = {};',
'']),
LinesToStr([ // $mod.$main
'$mod.ArrInt = rtl.arrayPushN($mod.ArrInt, 2);',
'$mod.ArrInt = rtl.arrayPushN($mod.ArrInt, 3, 4);',
'$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.TRec.$clone($mod.r));',
'$mod.ArrRec = rtl.arrayPush($mod.TRec, $mod.ArrRec, $mod.TRec.$clone($mod.r), $mod.TRec.$clone($mod.r));',
'$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, rtl.refSet($mod.f));',
'$mod.ArrSet = rtl.arrayPush("refSet", $mod.ArrSet, rtl.refSet($mod.f), rtl.refSet($mod.f));',
'$mod.ArrJSValue = rtl.arrayPushN($mod.ArrJSValue, 11);',
'$mod.ArrJSValue = rtl.arrayPushN($mod.ArrJSValue, 12, 13);',
'$mod.ArrFlag = rtl.arrayPushN($mod.ArrFlag, $mod.TFlag.small);',
'$mod.ArrFlag = rtl.arrayPushN($mod.ArrFlag, $mod.TFlag.small, $mod.TFlag.big);',
'']));
end;

procedure TTestModule.TestArray_DynArrayConstObjFPC;
begin
Parser.Options:=Parser.Options+[po_cassignments];
Expand Down Expand Up @@ -11688,9 +11768,9 @@ procedure TTestModule.TestArray_DynArrayConstObjFPC;
'$mod.Ints = rtl.arrayConcatN([1], [2]);',
'$mod.Ints = [2];',
'$mod.Ints = rtl.arrayConcatN([], $mod.Ints);',
'$mod.Ints = rtl.arrayConcatN($mod.Ints, []);',
'$mod.Ints = $mod.Ints;',
'$mod.Ints = rtl.arrayConcatN($mod.Ints, $mod.OneInt);',
'$mod.Ints = rtl.arrayConcatN($mod.Ints, [1, 1]);',
'$mod.Ints = rtl.arrayPushN($mod.Ints, 1, 1);',
'$mod.Ints = rtl.arrayConcatN([$mod.i, $mod.i], $mod.Ints);',
'$mod.Ints = rtl.arrayConcatN(rtl.arrayConcatN([1], [$mod.i]), [3]);',
'']));
Expand Down Expand Up @@ -11872,7 +11952,7 @@ procedure TTestModule.TestArray_ArrayLitMultiDimAsParam;
LinesToStr([ // $mod.$main
'$mod.a = [[1]];',
'$mod.a = [$mod.i];',
'$mod.a = rtl.arrayConcatN($mod.a, [$mod.i]);',
'$mod.a = rtl.arrayPushN($mod.a, $mod.i);',
'$mod.a = rtl.arrayConcatN([$mod.i], $mod.a);',
'$mod.a = [rtl.arrayConcatN([1], $mod.i)];',
'$mod.a = [rtl.arrayConcatN([1], [2])];',
Expand Down Expand Up @@ -11924,7 +12004,7 @@ procedure TTestModule.TestArray_ArrayLitStaticAsParam;
LinesToStr([ // $mod.$main
'$mod.a = [[1, 1]];',
'$mod.a = [$mod.i.slice(0)];',
'$mod.a = rtl.arrayConcatN($mod.a, [$mod.i.slice(0)]);',
'$mod.a = rtl.arrayPushN($mod.a, $mod.i.slice(0));',
'$mod.a = rtl.arrayConcatN([$mod.i.slice(0)], $mod.a);',
'$mod.DoInt([[1, 1]]);',
'$mod.DoInt([[1, 2], [3, 4]]);',
Expand Down

0 comments on commit 22926e4

Please sign in to comment.