From 86c25c678318ced6b42fc17212124327217edc7a Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Fri, 25 Sep 2020 08:54:52 +0000 Subject: [PATCH] pastojs: generic function names similar to generic types using $G, ShortRefGlobals: static functions git-svn-id: trunk@46952 - --- packages/pastojs/src/fppas2js.pp | 74 +++++++++----- packages/pastojs/tests/tcgenerics.pas | 108 ++++++++++----------- packages/pastojs/tests/tcoptimizations.pas | 46 +++++++++ 3 files changed, 151 insertions(+), 77 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index a72963122c..80bcdfd046 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -672,6 +672,7 @@ type pbivnMessageInt, pbivnMessageStr, pbivnLocalModuleRef, + pbivnLocalProcRef, pbivnLocalTypeRef, pbivnLoop, pbivnLoopEnd, @@ -854,6 +855,7 @@ const '$msgint', // pbivnMessageInt '$msgstr', // pbivnMessageStr '$lm', // pbivnLocalModuleRef + '$lp', // pbivnLocalProcRef '$lt', // pbivnLocalTypeRef '$l', // pbivnLoop '$end', // pbivnLoopEnd @@ -2003,6 +2005,8 @@ type Function CreateReferencePathExpr(El: TPasElement; AContext : TConvertContext; Full: boolean = false; Ref: TResolvedReference = nil): TJSElement; virtual; Function CreateGlobalTypePath(El: TPasType; AContext : TConvertContext): string; virtual; + Function CreateStaticProcPath(El: TPasProcedure; AContext : TConvertContext): string; virtual; + Function CreateGlobalElPath(El: TPasElement; AContext : TConvertContext): string; virtual; // section Function CreateImplementationSection(El: TPasModule; IntfContext: TInterfaceSectionContext): TJSFunctionDeclarationStatement; virtual; Procedure CreateInitSection(El: TPasModule; Src: TJSSourceElements; AContext: TConvertContext); virtual; @@ -3676,7 +3680,6 @@ procedure TPas2JSResolver.RenameSpecialized(SpecializedItem: TPRSpecializedItem var GenScope: TPasGenericScope; NewName: String; - ProcScope: TPas2JSProcedureScope; begin if SpecializedItem=nil then exit; NewName:=SpecializedItem.GenericEl.Name+'$G'+IntToStr(SpecializedItem.Index+1); @@ -3690,19 +3693,11 @@ begin else if GenScope is TPas2JSProcTypeScope then TPas2JSProcTypeScope(GenScope).JSName:=NewName else if GenScope is TPas2JSProcedureScope then - begin - ProcScope:=TPas2JSProcedureScope(GenScope); - if ProcScope.OverloadName<>'' then - NewName:=ProcScope.OverloadName - else - NewName:=SpecializedItem.GenericEl.Name; - NewName:=LastDottedIdentifier(NewName); - ProcScope.JSName:=NewName+'$G'+IntToStr(SpecializedItem.Index+1); - end + // handled in GetOverloadName else RaiseNotYetImplemented(20200906203342,SpecializedItem.SpecializedEl,GetObjName(GenScope)); {$IFDEF VerbosePas2JS} - //writeln('TPas2JSResolver.RenameSpecialized GenericEl=',GetObjPath(SpecializedItem.GenericEl),' Spec=',GetObjPath(SpecializedItem.SpecializedEl),' JSName="',NewName,'"'); + writeln('TPas2JSResolver.RenameSpecialized GenericEl=',GetObjPath(SpecializedItem.GenericEl),' Spec=',GetObjPath(SpecializedItem.SpecializedEl),' JSName="',NewName,'"'); {$ENDIF} end; @@ -6824,13 +6819,13 @@ begin ProcScope:=TPas2JSProcedureScope(Data); if ProcScope.SpecializedFromItem<>nil then begin - // specialized proc -> generic name + 's' + index + // specialized proc -> generic name + '$G' + index GenEl:=ProcScope.SpecializedFromItem.GenericEl; GenScope:=TPas2JSProcedureScope(GenEl.CustomData); Result:=GenScope.OverloadName; if Result='' then Result:=GenEl.Name+'$'; - Result:=Result+'s'+IntToStr(ProcScope.SpecializedFromItem.Index); + Result:=Result+'G'+IntToStr(ProcScope.SpecializedFromItem.Index+1); end else Result:=ProcScope.OverloadName; @@ -23752,6 +23747,15 @@ var and not TPasProcedure(Proc).IsStatic; end; + function ProcHasNoSelf(Proc: TPasProcedure): boolean; + begin + if Proc=nil then exit(false); + if not (Proc.Parent is TPasMembersType) then + exit(true); + if Proc.IsStatic then exit(true); + Result:=false; + end; + procedure Append_GetClass(Member: TPasElement); var P: TPasElement; @@ -23928,10 +23932,18 @@ begin if El.Parent=nil then RaiseNotSupported(El,AContext,20170201172141,GetObjName(El)); - if (coShortRefGlobals in Options) and (El is TPasType) and (Kind=rpkPathAndName) then + if (coShortRefGlobals in Options) and (Kind=rpkPathAndName) then begin - Result:=CreateGlobalTypePath(TPasType(El),AContext); - exit; + if (El is TPasType) then + begin + Result:=CreateGlobalTypePath(TPasType(El),AContext); + exit; + end + else if (El is TPasProcedure) and ProcHasNoSelf(TPasProcedure(El)) then + begin + Result:=CreateStaticProcPath(TPasProcedure(El),AContext); + exit; + end; end; El:=ImplToDecl(El); @@ -24126,12 +24138,27 @@ function TPasToJSConverter.CreateGlobalTypePath(El: TPasType; AContext: TConvertContext): string; var aType: TPasType; - Parent: TPasElement; - CurModule: TPasModule; - ShortRefGlobals: Boolean; begin aType:=AContext.Resolver.ResolveAliasType(El); - Result:=AContext.GetLocalName(aType,[cvkGlobal]); + Result:=CreateGlobalElPath(aType,AContext); +end; + +function TPasToJSConverter.CreateStaticProcPath(El: TPasProcedure; + AContext: TConvertContext): string; +begin + if (not El.IsStatic) and (El.Parent is TPasMembersType) then + RaiseNotSupported(El,AContext,20200925104007); + Result:=CreateGlobalElPath(El,AContext); +end; + +function TPasToJSConverter.CreateGlobalElPath(El: TPasElement; + AContext: TConvertContext): string; +var + ShortRefGlobals: Boolean; + Parent: TPasElement; + CurModule: TPasModule; +begin + Result:=AContext.GetLocalName(El,[cvkGlobal]); if Result<>'' then exit; // already exists ShortRefGlobals:=coShortRefGlobals in Options; @@ -24157,8 +24184,8 @@ begin else if Parent is TPasModule then Result:=TransformModuleName(TPasModule(Parent),true,AContext) else - RaiseNotSupported(El,AContext,20200609230526,GetObjName(aType)); - Result:=Result+'.'+TransformElToJSName(aType,AContext); + RaiseNotSupported(El,AContext,20200609230526,GetObjPath(El)); + Result:=Result+'.'+TransformElToJSName(El,AContext); if ShortRefGlobals then Result:=CreateGlobalAlias(El,Result,AContext); end; @@ -25947,12 +25974,13 @@ begin Result:=GetBIName(pbivnLocalModuleRef) else if El is TPasType then Result:=GetBIName(pbivnLocalTypeRef) + else if El is TPasProcedure then + Result:=GetBIName(pbivnLocalProcRef) else RaiseNotSupported(El,AContext,20200608160225); Result:=FuncContext.CreateLocalIdentifier(Result); SectionContext.AddLocalVar(Result,El,cvkGlobal,false); - // ToDo: check if from a unit used by impl uses section if aResolver.ImplementationUsesUnit(ElModule) then begin // insert var $lm = null; diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas index c54ad2dc48..7e299330b5 100644 --- a/packages/pastojs/tests/tcgenerics.pas +++ b/packages/pastojs/tests/tcgenerics.pas @@ -1720,7 +1720,7 @@ begin CheckSource('TestGenProc_Function_ObjFPC', LinesToStr([ // statements 'this.w = 0;', - 'this.Run$s0 = function (a) {', + 'this.Run$G1 = function (a) {', ' var Result = 0;', ' var i = 0;', ' a = i;', @@ -1729,7 +1729,7 @@ begin '};', '']), LinesToStr([ // $mod.$main - '$mod.w = $mod.Run$s0(3);', + '$mod.w = $mod.Run$G1(3);', ''])); end; @@ -1752,7 +1752,7 @@ begin CheckSource('TestGenProc_Function_Delphi', LinesToStr([ // statements 'this.w = 0;', - 'this.Run$s0 = function (a) {', + 'this.Run$G1 = function (a) {', ' var Result = 0;', ' var i = 0;', ' a = i;', @@ -1761,7 +1761,7 @@ begin '};', '']), LinesToStr([ // $mod.$main - '$mod.w = $mod.Run$s0(3);', + '$mod.w = $mod.Run$G1(3);', ''])); end; @@ -1784,20 +1784,20 @@ begin ConvertProgram; CheckSource('TestGenProc_Overload', LinesToStr([ // statements - 'this.DoIt$s0 = function (a, w) {', + 'this.DoIt$G1 = function (a, w) {', '};', - 'this.DoIt$s1 = function (a, w) {', + 'this.DoIt$G2 = function (a, w) {', '};', - 'this.DoIt$1s0 = function (a, b) {', + 'this.DoIt$1G1 = function (a, b) {', '};', - 'this.DoIt$1s1 = function (a, b) {', + 'this.DoIt$1G2 = function (a, b) {', '};', '']), LinesToStr([ // $mod.$main - '$mod.DoIt$s0(3, 4);', - '$mod.DoIt$s1(false, 5);', - '$mod.DoIt$1s0(6, true);', - '$mod.DoIt$1s1(7.3, true);', + '$mod.DoIt$G1(3, 4);', + '$mod.DoIt$G2(false, 5);', + '$mod.DoIt$1G1(6, true);', + '$mod.DoIt$1G2(7.3, true);', ''])); end; @@ -1817,15 +1817,15 @@ begin ConvertProgram; CheckSource('TestGenProc_infer_OverloadForward', LinesToStr([ // statements - 'this.Run$s0 = function (a, b) {', - ' $mod.Run$s0(1, true);', + 'this.Run$G1 = function (a, b) {', + ' $mod.Run$G1(1, true);', '};', - 'this.Run$s1 = function (a, b) {', - ' $mod.Run$s0(1, true);', + 'this.Run$G2 = function (a, b) {', + ' $mod.Run$G1(1, true);', '};', '']), LinesToStr([ // $mod.$main - '$mod.Run$s1(1.3, true);', + '$mod.Run$G2(1.3, true);', ''])); end; @@ -1857,20 +1857,20 @@ begin ConvertProgram; CheckSource('TestGenProc_infer_OverloadForward', LinesToStr([ // statements - 'this.Run$s0 = function (a, b) {', - ' $mod.Run$s0(1, true);', - ' $mod.Run$1s0(2, 3);', - ' $mod.Run$2s0("foo", "bar");', + 'this.Run$G1 = function (a, b) {', + ' $mod.Run$G1(1, true);', + ' $mod.Run$1G1(2, 3);', + ' $mod.Run$2G1("foo", "bar");', '};', - 'this.Run$1s0 = function (a, w) {', + 'this.Run$1G1 = function (a, w) {', '};', - 'this.Run$2s0 = function (a, b) {', + 'this.Run$2G1 = function (a, b) {', '};', '']), LinesToStr([ // $mod.$main - '$mod.Run$s0(1, true);', - '$mod.Run$1s0(2, 3);', - '$mod.Run$2s0("foo", "bar");', + '$mod.Run$G1(1, true);', + '$mod.Run$1G1(2, 3);', + '$mod.Run$2G1("foo", "bar");', ''])); end; @@ -1894,20 +1894,20 @@ begin ConvertProgram; CheckSource('TestGenProc_TypeInfo', LinesToStr([ // statements - 'this.Run$s0 = function (a) {', + 'this.Run$G1 = function (a) {', ' var p = null;', ' p = rtl.word;', ' p = rtl.word;', '};', - 'this.Run$s1 = function (a) {', + 'this.Run$G2 = function (a) {', ' var p = null;', ' p = rtl.string;', ' p = rtl.string;', '};', '']), LinesToStr([ // $mod.$main - '$mod.Run$s0(3);', - '$mod.Run$s1("foo");', + '$mod.Run$G1(3);', + '$mod.Run$G2("foo");', ''])); end; @@ -1931,21 +1931,21 @@ begin ConvertProgram; CheckSource('TestGenProc_Infer_Widen', LinesToStr([ // statements - 'this.Run$s0 = function (a, b) {', + 'this.Run$G1 = function (a, b) {', '};', - 'this.Run$s1 = function (a, b) {', + 'this.Run$G2 = function (a, b) {', '};', - 'this.Run$s2 = function (a, b) {', + 'this.Run$G3 = function (a, b) {', '};', '']), LinesToStr([ // $mod.$main - '$mod.Run$s0(1, 2);', - '$mod.Run$s0(2, 2);', - '$mod.Run$s1(3, 2);', - '$mod.Run$s1(4, 2);', - '$mod.Run$s1(5, 2);', - '$mod.Run$s2("a", "foo");', - '$mod.Run$s2("bar", "c");', + '$mod.Run$G1(1, 2);', + '$mod.Run$G1(2, 2);', + '$mod.Run$G2(3, 2);', + '$mod.Run$G2(4, 2);', + '$mod.Run$G2(5, 2);', + '$mod.Run$G3("a", "foo");', + '$mod.Run$G3("bar", "c");', ''])); end; @@ -1967,17 +1967,17 @@ begin ConvertProgram; CheckSource('TestGenProc_Infer_PassAsArg', LinesToStr([ // statements - 'this.Run$s0 = function (a) {', + 'this.Run$G1 = function (a) {', ' var Result = 0;', ' var b = 0;', - ' $mod.Run$s0($mod.Run$s0(3));', - ' $mod.Run$s0($mod.Run$s0(4));', + ' $mod.Run$G1($mod.Run$G1(3));', + ' $mod.Run$G1($mod.Run$G1(4));', ' return Result;', '};', '']), LinesToStr([ // $mod.$main - '$mod.Run$s0($mod.Run$s0(5));', - '$mod.Run$s0($mod.Run$s0(6));', + '$mod.Run$G1($mod.Run$G1(5));', + '$mod.Run$G1($mod.Run$G1(6));', ''])); end; @@ -2019,22 +2019,22 @@ begin ' };', ' this.$final = function () {', ' };', - ' this.Run$s0 = function (a, b) {', - ' this.Run$s0(1, true);', - ' this.Run$1s0(2, 3);', - ' this.Run$2s0("foo", "bar");', + ' this.Run$G1 = function (a, b) {', + ' this.Run$G1(1, true);', + ' this.Run$1G1(2, 3);', + ' this.Run$2G1("foo", "bar");', ' };', - ' this.Run$1s0 = function (a, w) {', + ' this.Run$1G1 = function (a, w) {', ' };', - ' this.Run$2s0 = function (a, b) {', + ' this.Run$2G1 = function (a, b) {', ' };', '});', 'this.o = null;', '']), LinesToStr([ // $mod.$main - '$mod.o.Run$s0(1, true);', - '$mod.o.Run$1s0(2, 3);', - '$mod.o.Run$2s0("foo", "bar");', + '$mod.o.Run$G1(1, true);', + '$mod.o.Run$1G1(2, 3);', + '$mod.o.Run$2G1("foo", "bar");', ''])); end; diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 5523f2dbcc..1c87d5dc9b 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -60,6 +60,7 @@ type procedure TestOptShortRefGlobals_Program; procedure TestOptShortRefGlobals_Unit_FromIntfImpl_ToIntfImpl; procedure TestOptShortRefGlobals_Property; + procedure TestOptShortRefGlobals_GenericFunction; // Whole Program Optimization procedure TestWPO_OmitLocalVar; @@ -444,6 +445,51 @@ begin ''])); end; +procedure TTestOptimizations.TestOptShortRefGlobals_GenericFunction; +begin + AddModuleWithIntfImplSrc('UnitA.pas', + LinesToStr([ + 'generic function Run(a: T): T;', + '']), + LinesToStr([ + 'generic function Run(a: T): T;', + 'begin', + 'end;', + ''])); + StartUnit(true,[supTObject]); + Add([ + '{$optimization JSShortRefGlobals}', + 'interface', + 'uses unita;', + 'type', + ' TEagle = class', + ' end;', + 'procedure Fly;', + 'implementation', + 'procedure Fly;', + 'begin', + ' specialize Run(nil);', + 'end;', + '']); + ConvertUnit; + CheckSource('TestOptShortRefGlobals_GenericFunction', + LinesToStr([ + 'var $lm = pas.system;', + 'var $lt = $lm.TObject;', + 'var $lm1 = pas.UnitA;', + 'var $lp = $lm1.Run$G1;', + 'rtl.createClass(this, "TEagle", $lt, function () {', + '});', + 'this.Fly = function () {', + ' $lp(null);', + '};', + '']), + LinesToStr([ + '']), + LinesToStr([ + ''])); +end; + procedure TTestOptimizations.TestWPO_OmitLocalVar; begin StartProgram(false);