paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 21:48:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: write generic function without body

Browse Source 
git-svn-id: trunk@43517 -
This commit is contained in:
Mattias Gaertner 2019-11-20 16:59:33 +00:00
parent 7eb0be6127
commit 4ad0d137b1
4 changed files with 135 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
packages/pastojs/src/fppas2js.pp
View File

@ -1453,6 +1453,7 @@ type
function ProcHasImplElements(Proc: TPasProcedure): boolean; override;
function HasAnonymousFunctions(El: TPasImplElement): boolean;
function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope;
function ProcCanBePrecompiled(Proc: TPasProcedure): boolean; virtual;
function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual;
function IsExternalBracketAccessor(El: TPasElement): boolean;
function IsExternalClassConstructor(El: TPasElement): boolean;
@ -5926,6 +5927,37 @@ begin
end;
end;
function TPas2JSResolver.ProcCanBePrecompiled(Proc: TPasProcedure): boolean;
var
El: TPasElement;
TemplTypes: TFPList;
ProcScope: TPas2JSProcedureScope;
GenScope: TPasGenericScope;
begin
if GetProcTemplateTypes(Proc)<>nil then
exit(false); // generic proc
ProcScope:=Proc.CustomData as TPas2JSProcedureScope;
if ProcScope.SpecializedFromItem<>nil then
exit(false); // specialized generic proc
El:=Proc;
repeat
El:=El.Parent;
if El=nil then
exit(true); // ok
if El is TPasProcedure then
exit(false); // Proc is a local proc
if El is TPasGenericType then
begin
TemplTypes:=TPasGenericType(El).GenericTemplateTypes;
if (TemplTypes<>nil) and (TemplTypes.Count>0) then
exit(false); // not fully specialized
GenScope:=El.CustomData as TPasGenericScope;
if GenScope.SpecializedFromItem<>nil then
exit(false); // method of a specialized class/record type
end;
until false;
end;
function TPas2JSResolver.IsTObjectFreeMethod(El: TPasExpr): boolean;
var
Ref: TResolvedReference;
@ -14975,7 +15007,7 @@ begin
if (coStoreImplJS in Options) and (aResolver<>nil) then
begin
if aResolver.GetTopLvlProc(El)=El then
if aResolver.ProcCanBePrecompiled(El) then
begin
ImplProcScope.BodyJS:=CreatePrecompiledJS(Result);
ImplProcScope.EmptyJS:=BodyPas.Body=nil;

103
packages/pastojs/src/pas2jsfiler.pp
View File

@ -781,6 +781,7 @@ type
procedure WritePropertyScope(Obj: TJSONObject; Scope: TPasPropertyScope; aContext: TPCUWriterContext); virtual;
procedure WriteProperty(Obj: TJSONObject; El: TPasProperty; aContext: TPCUWriterContext); virtual;
procedure WriteMethodResolution(Obj: TJSONObject; El: TPasMethodResolution; aContext: TPCUWriterContext); virtual;
procedure WriteGenericTemplateType(Obj: TJSONObject; El: TPasGenericTemplateType; aContext: TPCUWriterContext); virtual;
procedure WriteProcedureNameParts(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUWriterContext); virtual;
procedure WriteProcedureModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TProcedureModifiers); virtual;
procedure WriteProcScopeFlags(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TPasProcedureScopeFlags); virtual;
@ -1009,6 +1010,7 @@ type
procedure ReadPropertyScope(Obj: TJSONObject; Scope: TPasPropertyScope; aContext: TPCUReaderContext); virtual;
procedure ReadProperty(Obj: TJSONObject; El: TPasProperty; aContext: TPCUReaderContext); virtual;
procedure ReadMethodResolution(Obj: TJSONObject; El: TPasMethodResolution; aContext: TPCUReaderContext); virtual;
procedure ReadGenericTemplateType(Obj: TJSONObject; El: TPasGenericTemplateType; aContext: TPCUReaderContext); virtual;
procedure ReadProcedureNameParts(Obj: TJSONObject; El: TPasProcedure; aContext: TPCUReaderContext); virtual;
function ReadProcedureModifiers(Obj: TJSONObject; El: TPasElement;
const PropName: string; const DefaultValue: TProcedureModifiers): TProcedureModifiers; virtual;
@ -3812,6 +3814,15 @@ begin
WriteExpr(Obj,El,'ImplementationProc',El.ImplementationProc,aContext);
end;
procedure TPCUWriter.WriteGenericTemplateType(Obj: TJSONObject;
El: TPasGenericTemplateType; aContext: TPCUWriterContext);
begin
WritePasElement(Obj,El,aContext);
if not (El.CustomData is TPasGenericParamsScope) then
RaiseMsg(20191120175118,El,GetObjName(El.CustomData));
WriteElementArray(Obj,El,'Constraints',El.Constraints,aContext,true);
end;
procedure TPCUWriter.WriteProcedureNameParts(Obj: TJSONObject;
El: TPasProcedure; aContext: TPCUWriterContext);
var
@ -3841,8 +3852,7 @@ begin
GenType:=TPasGenericTemplateType(Templates[j]);
TemplObj:=TJSONObject.Create;
TemplArr.Add(TemplObj);
TemplObj.Add('Name',GenType.Name);
WriteElementArray(TemplObj,El,'Constraints',GenType.Constraints,aContext,true);
WriteGenericTemplateType(TemplObj,GenType,aContext);
end;
end;
end;
@ -3905,6 +3915,7 @@ var
i: Integer;
DeclProc: TPasProcedure;
DeclScope: TPas2JsProcedureScope;
TemplTypes: TFPList;
begin
WritePasElement(Obj,El,aContext);
Scope:=El.CustomData as TPas2JSProcedureScope;
@ -3940,27 +3951,42 @@ begin
if (Scope.ImplProc=nil) and (El.Body<>nil) then
begin
// Note: although the References are in the declaration scope,
// they are stored with the implementation scope, so that
// all references can be resolved immediately by the reader
DeclProc:=Scope.DeclarationProc;
if DeclProc=nil then
DeclProc:=El;
DeclScope:=NoNil(DeclProc.CustomData) as TPas2JSProcedureScope;
WriteScopeReferences(Obj,DeclScope.References,'Refs',aContext);
// precompiled body
if Scope.BodyJS<>'' then
TemplTypes:=Resolver.GetProcTemplateTypes(El);
if TemplTypes<>nil then
begin
if Scope.GlobalJS<>nil then
// generic function: store pascal elements
if Scope.BodyJS<>'' then
RaiseMsg(20191120171941,El);
// ToDo
Obj.Add('Body','');
Obj.Add('Empty',true);
end
else
begin
// normal procedure: store references and precompiled JS
// Note: although the References are in the declaration scope,
// they are stored with the implementation scope, so that
// all references can be resolved immediately by the reader
DeclProc:=Scope.DeclarationProc;
if DeclProc=nil then
DeclProc:=El;
DeclScope:=NoNil(DeclProc.CustomData) as TPas2JSProcedureScope;
WriteScopeReferences(Obj,DeclScope.References,'Refs',aContext);
// precompiled body
if Scope.BodyJS<>'' then
begin
Arr:=TJSONArray.Create;
Obj.Add('Globals',Arr);
for i:=0 to Scope.GlobalJS.Count-1 do
Arr.Add(Scope.GlobalJS[i]);
if Scope.GlobalJS<>nil then
begin
Arr:=TJSONArray.Create;
Obj.Add('Globals',Arr);
for i:=0 to Scope.GlobalJS.Count-1 do
Arr.Add(Scope.GlobalJS[i]);
end;
Obj.Add('Body',Scope.BodyJS);
Obj.Add('Empty',Scope.EmptyJS);
end;
Obj.Add('Body',Scope.BodyJS);
Obj.Add('Empty',Scope.EmptyJS);
end;
end;
if (Scope.BodyJS<>'') and (Scope.ImplProc<>nil) then
@ -7598,6 +7624,20 @@ begin
El.ImplementationProc:=ReadExpr(Obj,El,'ImplementationProc',aContext);
end;
procedure TPCUReader.ReadGenericTemplateType(Obj: TJSONObject;
El: TPasGenericTemplateType; aContext: TPCUReaderContext);
var
Scope: TPasGenericParamsScope;
begin
ReadPasElement(Obj,El,aContext);
Scope:=TPasGenericParamsScope(Resolver.CreateScope(El,TPasGenericParamsScope));
El.CustomData:=Scope;
// Scope.GenericType only needed during parsing
ReadElementArray(Obj,El,'Constraints',El.Constraints,
{$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
aContext);
end;
procedure TPCUReader.ReadProcedureNameParts(Obj: TJSONObject;
El: TPasProcedure; aContext: TPCUReaderContext);
var
@ -7624,19 +7664,18 @@ begin
begin
if not ReadString(NamePartObj,'Name',Name,El) then
RaiseMsg(20190718113739,El,IntToStr(i));
if not ReadArray(NamePartObj,'Templates',TemplArr,El) then
continue; // Templates=nil
Templates:=TFPList.Create;
for j:=0 to TemplArr.Count-1 do
if ReadArray(NamePartObj,'Templates',TemplArr,El) then
begin
TemplObj:=CheckJSONObject(TemplArr[j],20190718114058);
if not ReadString(TemplObj,'Name',GenTypeName,El) or (GenTypeName='') then
RaiseMsg(20190718114244,El,IntToStr(i)+','+IntToStr(j));
GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,El));
Templates.Add(GenType);
ReadElementArray(TemplObj,El,'Constraints',GenType.Constraints,
{$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
aContext);
Templates:=TFPList.Create;
for j:=0 to TemplArr.Count-1 do
begin
TemplObj:=CheckJSONObject(TemplArr[j],20190718114058);
if not ReadString(TemplObj,'Name',GenTypeName,El) or (GenTypeName='') then
RaiseMsg(20190718114244,El,IntToStr(i)+','+IntToStr(j));
GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,El));
Templates.Add(GenType);
ReadGenericTemplateType(TemplObj,GenType,aContext);
end;
end;
end;
end;

31
packages/pastojs/tests/tcfiler.pas
View File

@ -75,6 +75,7 @@ type
procedure CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope); virtual;
procedure CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences); virtual;
procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope); virtual;
procedure CheckRestoredGenericParamScope(const Path: string; Orig, Rest: TPasGenericParamsScope); virtual;
procedure CheckRestoredResolvedReference(const Path: string; Orig, Rest: TResolvedReference); virtual;
procedure CheckRestoredEvalValue(const Path: string; Orig, Rest: TResEvalValue); virtual;
procedure CheckRestoredCustomData(const Path: string; RestoredEl: TPasElement; Orig, Rest: TObject); virtual;
@ -171,6 +172,8 @@ type
procedure TestPC_ClassInterface;
procedure TestPC_Attributes;
procedure TestPC_GenericFunction;
procedure TestPC_UseUnit;
procedure TestPC_UseUnit_Class;
procedure TestPC_UseIndirectUnit;
@ -898,6 +901,15 @@ begin
CheckRestoredIdentifierScope(Path,Orig,Rest);
end;
procedure TCustomTestPrecompile.CheckRestoredGenericParamScope(
const Path: string; Orig, Rest: TPasGenericParamsScope);
begin
// Orig.GenericType only needed during parsing
if Path='' then ;
if Orig<>nil then ;
if Rest<>nil then ;
end;
procedure TCustomTestPrecompile.CheckRestoredResolvedReference(
const Path: string; Orig, Rest: TResolvedReference);
var
@ -1009,6 +1021,8 @@ begin
CheckRestoredProcScope(Path+'[TPas2JSProcedureScope]',TPas2JSProcedureScope(Orig),TPas2JSProcedureScope(Rest))
else if C=TPasPropertyScope then
CheckRestoredPropertyScope(Path+'[TPasPropertyScope]',TPasPropertyScope(Orig),TPasPropertyScope(Rest))
else if C=TPasGenericParamsScope then
CheckRestoredGenericParamScope(Path+'[TPasGenericParamScope]',TPasGenericParamsScope(Orig),TPasGenericParamsScope(Rest))
else if C.InheritsFrom(TResEvalValue) then
CheckRestoredEvalValue(Path+'['+Orig.ClassName+']',TResEvalValue(Orig),TResEvalValue(Rest))
else
@ -2388,7 +2402,22 @@ begin
'[TCustom]',
'constructor TObject.Create; begin end;',
'constructor TCustomAttribute.Create(Id: word); begin end;',
'end.',
'']);
WriteReadUnit;
end;
procedure TTestPrecompile.TestPC_GenericFunction;
begin
StartUnit(false);
Add([
'interface',
'generic function Run<T>(a: T): T;',
'implementation',
'generic function Run<T>(a: T): T;',
'var b: T;',
'begin',
' b:=a; Result:=b;',
'end;',
'']);
WriteReadUnit;
end;

2
utils/fpcm/revision.inc
View File

@ -1 +1 @@
'2019-11-15 rev 43472'
'2019-11-16 rev 43487'