pastojs: generic function names similar to generic types using $G, ShortRefGlobals: static functions

git-svn-id: trunk@46952 -

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;
+begin
+  aType:=AContext.Resolver.ResolveAliasType(El);
+  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;
-  ShortRefGlobals: Boolean;
 begin
-  aType:=AContext.Resolver.ResolveAliasType(El);
-  Result:=AContext.GetLocalName(aType,[cvkGlobal]);
+  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;

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;
 

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<T>(a: T): T;',
+    '']),
+  LinesToStr([
+    'generic function Run<T>(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<TEagle>(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);