paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 13:29:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: specialize elements

Browse Source 
git-svn-id: trunk@42623 -
This commit is contained in:
Mattias Gaertner 2019-08-09 20:47:50 +00:00
parent 99b1283e2e
commit 7280452ab2
5 changed files with 632 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

647
packages/fcl-passrc/src/pasresolver.pp
View File

@ -1714,26 +1714,73 @@ type
function CreateSpecializedType(El: TPasSpecializeType;
const ParamsResolved: TPasTypeArray): TPSSpecializedItem; virtual;
function InitSpecializeScopes(El: TPasElement): integer; virtual;
procedure SpecializeGenTypeIntf(GenericType: TPasGenericType; SpecializedItem: TPSSpecializedItem); virtual;
procedure SpecializeGenTypeImpl(GenericType: TPasGenericType; SpecializedItem: TPSSpecializedItem); virtual;
procedure SpecializeGenTypeIntf(GenericType: TPasGenericType;
SpecializedItem: TPSSpecializedItem); virtual;
procedure SpecializeGenTypeImpl(GenericType: TPasGenericType;
SpecializedItem: TPSSpecializedItem); virtual;
procedure SpecializeMembers(GenMembersType, SpecMembersType: TPasMembersType); virtual;
procedure SpecializeElement(GenEl, SpecEl: TPasElement);
procedure SpecializePasElementProperties(GenEl, SpecEl: TPasElement);
procedure SpecializeVariable(GenEl, SpecEl: TPasVariable);
procedure SpecializeElType(GenEl, SpecEl: TPasElement; GenElType: TPasType; var SpecElType: TPasType);
procedure SpecializeElExpr(GenEl, SpecEl: TPasElement; GenElExpr: TPasExpr; var SpecElExpr: TPasExpr);
procedure SpecializeVariable(GenEl, SpecEl: TPasVariable; Finish: boolean);
procedure SpecializeConst(GenEl, SpecEl: TPasConst);
procedure SpecializeProperty(GenEl, SpecEl: TPasProperty);
procedure SpecializeElType(GenEl, SpecEl: TPasElement;
GenElType: TPasType; var SpecElType: TPasType);
procedure SpecializeElExpr(GenEl, SpecEl: TPasElement;
GenElExpr: TPasExpr; var SpecElExpr: TPasExpr);
procedure SpecializeElImplEl(GenEl, SpecEl: TPasElement;
GenImplEl: TPasImplElement; var SpecImplEl: TPasImplElement);
procedure SpecializeElImplAlias(GenEl, SpecEl: TPasImplBlock;
GenImplAlias: TPasImplElement; var SpecImplAlias: TPasImplElement
{$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
procedure SpecializeElList(GenEl, SpecEl: TPasElement;
GenList, SpecList: TFPList; AllowReferences: boolean
{$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
procedure SpecializeProcedure(GenEl, SpecEl: TPasProcedure);
procedure SpecializeOperator(GenEl, SpecEl: TPasOperator);
procedure SpecializeProcedureType(GenEl, SpecEl: TPasProcedureType);
procedure SpecializeProcedureBody(GenEl, SpecEl: TProcedureBody);
procedure SpecializeDeclarations(GenEl, SpecEl: TPasDeclarations);
procedure SpecializeSpecializeType(GenEl, SpecEl: TPasSpecializeType);
procedure SpecializeArgument(GenEl, SpecEl: TPasArgument);
procedure SpecializeImplBlock(GenEl, SpecEl: TPasImplBlock);
procedure SpecializeImplAsmStatement(GenEl, SpecEl: TPasImplAsmStatement);
procedure SpecializeImplRepeatUntil(GenEl, SpecEl: TPasImplRepeatUntil);
procedure SpecializeImplIfElse(GenEl, SpecEl: TPasImplIfElse);
procedure SpecializeImplWhileDo(GenEl, SpecEl: TPasImplWhileDo);
procedure SpecializeImplWithDo(GenEl, SpecEl: TPasImplWithDo);
procedure SpecializeImplCaseOf(GenEl, SpecEl: TPasImplCaseOf);
procedure SpecializeImplCaseStatement(GenEl, SpecEl: TPasImplCaseStatement);
procedure SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
procedure SpecializeImplSimple(GenEl, SpecEl: TPasImplSimple);
procedure SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
procedure SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
procedure SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
procedure SpecializeImplRaise(GenEl, SpecEl: TPasImplRaise);
procedure SpecializeExpr(GenEl, SpecEl: TPasExpr);
procedure SpecializeExprArray(GenEl, SpecEl: TPasElement;
GenArray: TPasExprArray; var SpecArray: TPasExprArray);
procedure SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
procedure SpecializeUnaryExpr(GenEl, SpecEl: TUnaryExpr);
procedure SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
procedure SpecializeBoolConstExpr(GenEl, SpecEl: TBoolConstExpr);
procedure SpecializeParamsExpr(GenEl, SpecEl: TParamsExpr);
procedure SpecializeRecordValues(GenEl, SpecEl: TRecordValues);
procedure SpecializeArrayValues(GenEl, SpecEl: TArrayValues);
procedure SpecializeInlineSpecializeExpr(GenEl, SpecEl: TInlineSpecializeExpr);
procedure SpecializeProcedureExpr(GenEl, SpecEl: TProcedureExpr);
procedure SpecializeResString(GenEl, SpecEl: TPasResString);
procedure SpecializeAliasType(GenEl, SpecEl: TPasAliasType);
procedure SpecializePointerType(GenEl, SpecEl: TPasPointerType);
procedure SpecializeRangeType(GenEl, SpecEl: TPasRangeType);
procedure SpecializeArrayType(GenEl, SpecEl: TPasArrayType);
procedure SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
procedure SpecializeEnumType(GenEl, SpecEl: TPasEnumType);
procedure SpecializeSetType(GenEl, SpecEl: TPasSetType);
procedure SpecializeVariant(GenEl, SpecEl: TPasVariant);
procedure SpecializeStringType(GenEl, SpecEl: TPasStringType);
procedure SpecializeAttributes(GenEl, SpecEl: TPasAttributes);
procedure SpecializeMethodResolution(GenEl, SpecEl: TPasMethodResolution);
protected
// custom types (added by descendant resolvers)
function CheckAssignCompatibilityCustom(
@ -8663,9 +8710,10 @@ end;
procedure TPasResolver.CheckConditionExpr(El: TPasExpr;
const ResolvedEl: TPasResolverResult);
begin
if ResolvedEl.BaseType<>btBoolean then
RaiseXExpectedButYFound(20170216152135,
BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType],El);
if ResolvedEl.BaseType=btBoolean then exit;
if IsGenericTemplType(ResolvedEl) then exit;
RaiseXExpectedButYFound(20170216152135,
BaseTypeNames[btBoolean],BaseTypeNames[ResolvedEl.BaseType],El);
end;
procedure TPasResolver.CheckProcSignatureMatch(DeclProc,
@ -9037,8 +9085,11 @@ begin
if (rrfReadable in CaseExprResolved.Flags) then
ok:=CreateValues(CaseExprResolved,ValueSet);
if not ok then
RaiseXExpectedButYFound(20170216151952,'ordinal expression',
GetTypeDescription(CaseExprResolved.LoTypeEl),CaseOf.CaseExpr);
begin
if not IsGenericTemplType(CaseExprResolved) then
RaiseXExpectedButYFound(20170216151952,'ordinal expression',
GetTypeDescription(CaseExprResolved.LoTypeEl),CaseOf.CaseExpr);
end;
for i:=0 to CaseOf.Elements.Count-1 do
begin
@ -9054,6 +9105,8 @@ begin
ComputeElement(OfExpr,OfExprResolved,[rcConstant,rcSetReferenceFlags]);
if OfExprResolved.BaseType=btRange then
ConvertRangeToElement(OfExprResolved);
if not ok then
continue;
CheckEqualResCompatibility(CaseExprResolved,OfExprResolved,OfExpr,true);
Value:=Eval(OfExpr,[refConstExt]);
@ -14781,21 +14834,141 @@ begin
SpecializePasElementProperties(GenEl,SpecEl);
C:=GenEl.ClassType;
// expressions
if C=TPrimitiveExpr then
SpecializePrimitiveExpr(TPrimitiveExpr(GenEl),TPrimitiveExpr(SpecEl))
else if C=TUnaryExpr then
SpecializeUnaryExpr(TUnaryExpr(GenEl),TUnaryExpr(SpecEl))
else if C=TBinaryExpr then
SpecializeBinaryExpr(TBinaryExpr(GenEl),TBinaryExpr(SpecEl))
else if C=TBoolConstExpr then
SpecializeBoolConstExpr(TBoolConstExpr(GenEl),TBoolConstExpr(SpecEl))
else if C=TNilExpr then
SpecializeExpr(TNilExpr(GenEl),TNilExpr(SpecEl))
else if C=TInheritedExpr then
SpecializeExpr(TInheritedExpr(GenEl),TInheritedExpr(SpecEl))
else if C=TParamsExpr then
SpecializeParamsExpr(TParamsExpr(GenEl),TParamsExpr(SpecEl))
else if C=TRecordValues then
SpecializeRecordValues(TRecordValues(GenEl),TRecordValues(SpecEl))
else if C=TArrayValues then
SpecializeArrayValues(TArrayValues(GenEl),TArrayValues(SpecEl))
else if C=TInlineSpecializeExpr then
SpecializeInlineSpecializeExpr(TInlineSpecializeExpr(GenEl),TInlineSpecializeExpr(SpecEl))
else if C=TProcedureExpr then
SpecializeProcedureExpr(TProcedureExpr(GenEl),TProcedureExpr(SpecEl))
// TPasType
else if (C=TPasAliasType)
or (C=TPasTypeAliasType)
or (C=TPasClassOfType) then
begin
AddType(TPasAliasType(SpecEl));
SpecializeAliasType(TPasAliasType(GenEl),TPasAliasType(SpecEl));
end
else if C=TPasPointerType then
begin
AddType(TPasPointerType(SpecEl));
SpecializePointerType(TPasPointerType(GenEl),TPasPointerType(SpecEl));
end
else if C=TPasRangeType then
begin
AddType(TPasRangeType(SpecEl));
SpecializeRangeType(TPasRangeType(GenEl),TPasRangeType(SpecEl));
end
else if C=TPasArrayType then
begin
AddType(TPasArrayType(SpecEl));
SpecializeArrayType(TPasArrayType(GenEl),TPasArrayType(SpecEl));
end
else if C=TPasEnumValue then
begin
AddEnumValue(TPasEnumValue(SpecEl));
SpecializeEnumValue(TPasEnumValue(GenEl),TPasEnumValue(SpecEl));
end
else if C=TPasEnumType then
begin
AddEnumType(TPasEnumType(SpecEl));
SpecializeEnumType(TPasEnumType(GenEl),TPasEnumType(SpecEl));
end
else if C=TPasSetType then
SpecializeSetType(TPasSetType(GenEl),TPasSetType(SpecEl))
else if C=TPasVariant then
SpecializeVariant(TPasVariant(GenEl),TPasVariant(SpecEl))
// ToDo: TPasRecordType
// ToDo: TPasClassType
else if C=TPasStringType then
begin
AddType(TPasStringType(SpecEl));
SpecializeStringType(TPasStringType(GenEl),TPasStringType(SpecEl));
end
else if C=TPasSpecializeType then
begin
AddType(TPasSpecializeType(SpecEl));
SpecializeSpecializeType(TPasSpecializeType(GenEl),TPasSpecializeType(SpecEl));
end
// empty statement
else if C=TPasImplCommand then
// TPasImplBlock
else if C=TPasImplBeginBlock then
SpecializeImplBlock(TPasImplBeginBlock(GenEl),TPasImplBeginBlock(SpecEl))
else if C=TPasImplAsmStatement then
SpecializeImplAsmStatement(TPasImplAsmStatement(GenEl),TPasImplAsmStatement(SpecEl))
else if C=TPasImplRepeatUntil then
SpecializeImplRepeatUntil(TPasImplRepeatUntil(GenEl),TPasImplRepeatUntil(SpecEl))
else if C=TPasImplIfElse then
SpecializeImplIfElse(TPasImplIfElse(GenEl),TPasImplIfElse(SpecEl))
else if C=TPasImplWhileDo then
SpecializeImplWhileDo(TPasImplWhileDo(GenEl),TPasImplWhileDo(SpecEl))
else if C=TPasImplWithDo then
SpecializeImplWithDo(TPasImplWithDo(GenEl),TPasImplWithDo(SpecEl))
else if C=TPasImplCaseOf then
SpecializeImplCaseOf(TPasImplCaseOf(GenEl),TPasImplCaseOf(SpecEl))
else if C=TPasImplCaseStatement then
SpecializeImplCaseStatement(TPasImplCaseStatement(GenEl),TPasImplCaseStatement(SpecEl))
else if C=TPasImplCaseElse then
SpecializeImplBlock(TPasImplCaseElse(GenEl),TPasImplCaseElse(SpecEl))
else if C=TPasImplAssign then
SpecializeImplAssign(TPasImplAssign(GenEl),TPasImplAssign(SpecEl))
else if C=TPasImplSimple then
SpecializeImplSimple(TPasImplSimple(GenEl),TPasImplSimple(SpecEl))
else if C=TPasImplForLoop then
SpecializeImplForLoop(TPasImplForLoop(GenEl),TPasImplForLoop(SpecEl))
else if C=TPasImplTry then
SpecializeImplTry(TPasImplTry(GenEl),TPasImplTry(SpecEl))
else if (C=TPasImplTryFinally)
or (C=TPasImplTryExcept)
or (C=TPasImplTryExceptElse) then
SpecializeImplBlock(TPasImplCaseElse(GenEl),TPasImplCaseElse(SpecEl))
else if C=TPasImplExceptOn then
SpecializeImplExceptOn(TPasImplExceptOn(GenEl),TPasImplExceptOn(SpecEl))
else if C=TPasImplRaise then
SpecializeImplRaise(TPasImplRaise(GenEl),TPasImplRaise(SpecEl))
// declaration
else if C=TPasResString then
begin
AddResourceString(TPasResString(SpecEl));
SpecializeResString(TPasResString(GenEl),TPasResString(SpecEl));
end
else if C=TPasVariable then
begin
AddVariable(TPasVariable(SpecEl));
SpecializeVariable(TPasVariable(GenEl),TPasVariable(SpecEl));
SpecializeVariable(TPasVariable(GenEl),TPasVariable(SpecEl),true);
end
else if C=TPasConst then
begin
AddVariable(TPasConst(SpecEl));
SpecializeConst(TPasConst(GenEl),TPasConst(SpecEl));
end
else if C=TPasProperty then
begin
AddProperty(TPasProperty(SpecEl));
SpecializeProperty(TPasProperty(GenEl),TPasProperty(SpecEl));
end
else if C=TPasAttributes then
SpecializeAttributes(TPasAttributes(GenEl),TPasAttributes(SpecEl))
else if C=TPasMethodResolution then
SpecializeMethodResolution(TPasMethodResolution(GenEl),TPasMethodResolution(SpecEl))
// procedure
else if C=TPasArgument then
begin
AddArgument(TPasArgument(SpecEl));
@ -14806,6 +14979,11 @@ begin
AddProcedureBody(TProcedureBody(SpecEl));
SpecializeProcedureBody(TProcedureBody(GenEl),TProcedureBody(SpecEl));
end
else if C=TPasOperator then
begin
AddProcedure(TPasOperator(SpecEl));
SpecializeOperator(TPasOperator(GenEl),TPasOperator(SpecEl));
end
else if C.InheritsFrom(TPasProcedure) then
begin
AddProcedure(TPasProcedure(SpecEl));
@ -14816,11 +14994,6 @@ begin
AddType(TPasProcedureType(SpecEl));
SpecializeProcedureType(TPasProcedureType(GenEl),TPasProcedureType(SpecEl));
end
else if C=TPasSpecializeType then
begin
AddType(TPasSpecializeType(SpecEl));
SpecializeSpecializeType(TPasSpecializeType(GenEl),TPasSpecializeType(SpecEl));
end
else
RaiseNotYetImplemented(20190728151215,GenEl);
end;
@ -14837,7 +15010,8 @@ begin
SpecEl.DocComment:=GenEl.DocComment;
end;
procedure TPasResolver.SpecializeVariable(GenEl, SpecEl: TPasVariable);
procedure TPasResolver.SpecializeVariable(GenEl, SpecEl: TPasVariable;
Finish: boolean);
begin
SpecializeElType(GenEl,SpecEl,GenEl.VarType,SpecEl.VarType);
SpecEl.VarModifiers:=GenEl.VarModifiers;
@ -14850,7 +15024,32 @@ begin
SpecializeElExpr(GenEl,SpecEl,GenEl.AbsoluteExpr,SpecEl.AbsoluteExpr);
if GenEl.Expr<>nil then
SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
FinishVariable(SpecEl);
if Finish then
FinishVariable(SpecEl);
end;
procedure TPasResolver.SpecializeConst(GenEl, SpecEl: TPasConst);
begin
SpecEl.IsConst:=GenEl.IsConst;
SpecializeVariable(GenEl,SpecEl,true);
end;
procedure TPasResolver.SpecializeProperty(GenEl, SpecEl: TPasProperty);
begin
SpecializeVariable(GenEl,SpecEl,false);
SpecializeElExpr(GenEl,SpecEl,GenEl.IndexExpr,SpecEl.IndexExpr);
SpecializeElExpr(GenEl,SpecEl,GenEl.ReadAccessor,SpecEl.ReadAccessor);
SpecializeElExpr(GenEl,SpecEl,GenEl.WriteAccessor,SpecEl.WriteAccessor);
SpecializeElExpr(GenEl,SpecEl,GenEl.DispIDExpr,SpecEl.DispIDExpr);
SpecializeExprArray(GenEl,SpecEl,GenEl.Implements,SpecEl.Implements);
SpecializeElExpr(GenEl,SpecEl,GenEl.StoredAccessor,SpecEl.StoredAccessor);
SpecializeElExpr(GenEl,SpecEl,GenEl.DefaultExpr,SpecEl.DefaultExpr);
SpecEl.DispIDReadOnly:=GenEl.DispIDReadOnly;
SpecEl.IsDefault:=GenEl.IsDefault;
SpecEl.IsNodefault:=GenEl.IsNodefault;
SpecializeElList(GenEl,SpecEl,GenEl.Args,SpecEl.Args,false
{$IFDEF CheckPasTreeRefCount},'TPasProperty.Args'{$ENDIF});
FinishProperty(SpecEl);
end;
procedure TPasResolver.SpecializeElType(GenEl, SpecEl: TPasElement;
@ -14879,6 +15078,8 @@ begin
exit;
end;
// e.g. anonymous type
if SpecElType<>nil then
RaiseNotYetImplemented(20190808222744,SpecEl,GetObjName(SpecElType));
NewClass:=TPTreeElement(GenElType.ClassType);
SpecElType:=TPasType(NewClass.Create(GenElType.Name,SpecEl));
SpecializeElement(GenElType,SpecElType);
@ -14890,21 +15091,72 @@ var
NewClass: TPTreeElement;
begin
if GenElExpr=nil then exit;
if SpecElExpr<>nil then
RaiseNotYetImplemented(20190803220248,SpecEl,GetObjName(SpecElExpr));
if GenElExpr.Parent<>GenEl then
begin
// reference
if SpecElExpr<>nil then
RaiseNotYetImplemented(20190803220248,SpecEl,GetObjName(SpecElExpr));
SpecElExpr:=GenElExpr;
SpecElExpr.AddRef{$IFDEF CheckPasTreeRefCount}('SpecializeElExpr'){$ENDIF};
exit;
end;
RaiseNotYetImplemented(20190809160834,GenEl);
// normal expression
NewClass:=TPTreeElement(GenElExpr.ClassType);
SpecElExpr:=TPasExpr(NewClass.Create(GenElExpr.Name,SpecEl));
SpecializeElement(GenElExpr,SpecElExpr);
end;
procedure TPasResolver.SpecializeElImplEl(GenEl, SpecEl: TPasElement;
GenImplEl: TPasImplElement; var SpecImplEl: TPasImplElement);
var
NewClass: TPTreeElement;
begin
if GenImplEl=nil then exit;
if GenImplEl.Parent<>GenEl then
RaiseNotYetImplemented(20190808222638,GenEl,GetObjName(GenImplEl.Parent));
NewClass:=TPTreeElement(GenImplEl.ClassType);
SpecImplEl:=TPasImplElement(NewClass.Create(GenImplEl.Name,SpecEl));
SpecializeElement(GenImplEl,SpecImplEl);
end;
procedure TPasResolver.SpecializeElImplAlias(GenEl, SpecEl: TPasImplBlock;
GenImplAlias: TPasImplElement; var SpecImplAlias: TPasImplElement
{$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
var
i: Integer;
begin
if GenImplAlias=nil then exit;
i:=GenEl.Elements.IndexOf(GenImplAlias);
if i<0 then
RaiseNotYetImplemented(20190808225239,GenEl);
SpecImplAlias:=TObject(SpecEl.Elements[i]) as TPasImplElement;
if SpecImplAlias.ClassType<>GenImplAlias.ClassType then
RaiseNotYetImplemented(20190808231616,GenImplAlias,GetObjName(SpecImplAlias));
SpecImplAlias.AddRef{$IFDEF CheckPasTreeRefCount}(RefId){$ENDIF};
end;
procedure TPasResolver.SpecializeElList(GenEl, SpecEl: TPasElement;
GenList, SpecList: TFPList; AllowReferences: boolean
{$IFDEF CheckPasTreeRefCount}; const RefId: string{$ENDIF});
var
i: Integer;
GenListItem, SpecListItem: TPasElement;
NewClass: TPTreeElement;
begin
for i:=0 to GenList.Count-1 do
begin
GenListItem:=TPasElement(GenList[i]);
if GenListItem.Parent<>GenEl then
begin
if not AllowReferences then
RaiseNotYetImplemented(20190808212421,GenEl,IntToStr(i));
// reference
GenListItem.AddRef{$IFDEF CheckPasTreeRefCount}(RefID){$ENDIF};
SpecList.Add(GenListItem);
continue;
end;
NewClass:=TPTreeElement(GenListItem.ClassType);
SpecListItem:=TPasElement(NewClass.Create(GenListItem.Name,SpecEl));
SpecList.Add(SpecListItem);
SpecializeElement(GenListItem,SpecListItem);
end;
end;
procedure TPasResolver.SpecializeProcedure(GenEl, SpecEl: TPasProcedure);
var
GenProcType: TPasProcedureType;
@ -14953,25 +15205,26 @@ begin
FinishProcedure(SpecEl);
end;
procedure TPasResolver.SpecializeOperator(GenEl, SpecEl: TPasOperator);
begin
SpecEl.OperatorType:=GenEl.OperatorType;
SpecEl.TokenBased:=GenEl.TokenBased;
SpecializeProcedure(GenEl,SpecEl);
end;
procedure TPasResolver.SpecializeProcedureType(GenEl, SpecEl: TPasProcedureType
);
var
GenResultEl, NewResultEl: TPasResultElement;
NewClass: TPTreeElement;
i: Integer;
GenArg, NewArg: TPasArgument;
begin
// Args
for i:=0 to GenEl.Args.Count-1 do
begin
GenArg:=TPasArgument(GenEl.Args[i]);
if GenArg.Parent<>GenEl then
RaiseNotYetImplemented(20190803213700,GenArg,GetObjName(GenArg.Parent));
NewClass:=TPTreeElement(GenArg.ClassType);
NewArg:=TPasArgument(NewClass.Create(GenArg.Name,SpecEl));
SpecEl.Args.Add(NewArg);
SpecializeElement(GenArg,NewArg);
end;
SpecializeElList(GenEl,SpecEl,GenEl.Args,SpecEl.Args,false
{$IFDEF CheckPasTreeRefCount},'TPasProcedureType.Args'{$ENDIF});
for i:=0 to SpecEl.Args.Count-1 do
FinishArgument(TPasArgument(SpecEl.Args[i]));
// properties
SpecEl.CallingConvention:=GenEl.CallingConvention;
SpecEl.Modifiers:=GenEl.Modifiers;
@ -14998,6 +15251,7 @@ var
NewClass: TPTreeElement;
begin
SpecializeDeclarations(GenEl,SpecEl);
FinishTypeSection(SpecEl);
if GenEl.Body<>nil then
begin
@ -15052,28 +15306,11 @@ end;
procedure TPasResolver.SpecializeSpecializeType(GenEl,
SpecEl: TPasSpecializeType);
var
i: Integer;
GenParam, SpecParam: TPasElement;
NewClass: TPTreeElement;
begin
SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
for i:=0 to GenEl.Params.Count-1 do
begin
GenParam:=TPasElement(GenEl.Params[i]);
if GenParam.Parent<>GenEl then
begin
// reference
GenParam.AddRef{$IFDEF CheckPasTreeRefCount}('TPasSpecializeType.Params'){$ENDIF};
SpecEl.AddParam(GenParam);
continue;
end;
NewClass:=TPTreeElement(GenParam.ClassType);
SpecParam:=TPasElement(NewClass.Create(GenParam.Name,SpecEl));
SpecEl.Params.Add(SpecParam);
SpecializeElement(GenParam,SpecParam);
end;
SpecializeElList(GenEl,SpecEl,GenEl.Params,SpecEl.Params,true
{$IFDEF CheckPasTreeRefCount},'TPasSpecializeType.Params'{$ENDIF});
FinishSpecializeType(SpecEl);
end;
@ -15085,7 +15322,7 @@ begin
if GenEl.ValueExpr<>nil then
SpecializeElExpr(GenEl,SpecEl,GenEl.ValueExpr,SpecEl.ValueExpr);
FinishArgument(SpecEl);
// FinishArgument is called when all arguments are ready
end;
procedure TPasResolver.SpecializeImplBlock(GenEl, SpecEl: TPasImplBlock);
@ -15106,6 +15343,74 @@ begin
end;
end;
procedure TPasResolver.SpecializeImplAsmStatement(GenEl,
SpecEl: TPasImplAsmStatement);
begin
SpecializeImplBlock(GenEl,SpecEl);
SpecEl.Tokens.Assign(GenEl.Tokens);
end;
procedure TPasResolver.SpecializeImplRepeatUntil(GenEl,
SpecEl: TPasImplRepeatUntil);
begin
SpecializeImplBlock(GenEl,SpecEl);
SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
end;
procedure TPasResolver.SpecializeImplIfElse(GenEl, SpecEl: TPasImplIfElse);
begin
// do not call SpecializeImplBlock(GenEl,SpecEl);
SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
SpecializeElImplEl(GenEl,SpecEl,GenEl.IfBranch,SpecEl.IfBranch);
SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,SpecEl.ElseBranch);
end;
procedure TPasResolver.SpecializeImplWhileDo(GenEl, SpecEl: TPasImplWhileDo);
begin
// do not call SpecializeImplBlock(GenEl,SpecEl);
SpecializeElExpr(GenEl,SpecEl,GenEl.ConditionExpr,SpecEl.ConditionExpr);
SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
end;
procedure TPasResolver.SpecializeImplWithDo(GenEl, SpecEl: TPasImplWithDo);
var
i: Integer;
GenExpr, SpecExpr: TPasExpr;
NewClass: TPTreeElement;
begin
for i:=0 to GenEl.Expressions.Count-1 do
begin
GenExpr:=TPasExpr(GenEl.Expressions[i]);
if GenExpr.Parent<>GenEl then
RaiseNotYetImplemented(20190808224343,GenEl,IntToStr(i));
NewClass:=TPTreeElement(GenExpr.ClassType);
SpecExpr:=TPasExpr(NewClass.Create(GenExpr.Name,SpecEl));
SpecEl.Expressions.Add(SpecExpr);
BeginScope(stWithExpr,SpecExpr);
SpecializeElement(GenExpr,SpecExpr);
end;
SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
FinishWithDo(SpecEl);
end;
procedure TPasResolver.SpecializeImplCaseOf(GenEl, SpecEl: TPasImplCaseOf);
begin
SpecializeElExpr(GenEl,SpecEl,GenEl.CaseExpr,SpecEl.CaseExpr);
SpecializeImplBlock(GenEl,SpecEl); // Elements
if GenEl.ElseBranch<>nil then
SpecializeElImplAlias(GenEl,SpecEl,GenEl.ElseBranch,TPasImplElement(SpecEl.ElseBranch)
{$IFDEF CheckPasTreeRefCount},'TPasImplCaseOf.ElseBranch'{$ENDIF});
end;
procedure TPasResolver.SpecializeImplCaseStatement(GenEl,
SpecEl: TPasImplCaseStatement);
begin
SpecializeElList(GenEl,SpecEl,GenEl.Expressions,SpecEl.Expressions,false
{$IFDEF CheckPasTreeRefCount},'TPasImplCaseStatement.CaseExpr'{$ENDIF});
SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
end;
procedure TPasResolver.SpecializeImplAssign(GenEl, SpecEl: TPasImplAssign);
begin
if GenEl.Elements.Count>0 then
@ -15115,6 +15420,13 @@ begin
SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
end;
procedure TPasResolver.SpecializeImplSimple(GenEl, SpecEl: TPasImplSimple);
begin
if GenEl.Elements.Count>0 then
RaiseNotYetImplemented(20190808142935,GenEl);
SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
end;
procedure TPasResolver.SpecializeImplForLoop(GenEl, SpecEl: TPasImplForLoop);
var
i: Integer;
@ -15128,6 +15440,7 @@ begin
SpecializeElExpr(GenEl,SpecEl,GenEl.StartExpr,SpecEl.StartExpr);
SpecializeElExpr(GenEl,SpecEl,GenEl.EndExpr,SpecEl.EndExpr);
FinishForLoopHeader(SpecEl);
// SpecEl.Body is set via AddElement
for i:=0 to GenEl.Elements.Count-1 do
begin
@ -15141,6 +15454,51 @@ begin
end;
end;
procedure TPasResolver.SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
begin
SpecializeImplBlock(GenEl,SpecEl); // clone elements
if GenEl.FinallyExcept<>nil then
SpecializeElImplAlias(GenEl,SpecEl,GenEl.FinallyExcept,
TPasImplElement(SpecEl.FinallyExcept)
{$IFDEF CheckPasTreeRefCount},'TPasImplTry.FinallyExcept'{$ENDIF});
if GenEl.ElseBranch<>nil then
SpecializeElImplAlias(GenEl,SpecEl,GenEl.ElseBranch,
TPasImplElement(SpecEl.ElseBranch)
{$IFDEF CheckPasTreeRefCount},'TPasImplTry.ElseBranch'{$ENDIF});
end;
procedure TPasResolver.SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
var
GenVar: TPasVariable;
NewClass: TPTreeElement;
begin
GenVar:=GenEl.VarEl;
if GenVar<>nil then
begin
if GenVar.Parent<>GenEl then
RaiseNotYetImplemented(20190808232327,GenEl);
NewClass:=TPTreeElement(GenVar.ClassType);
SpecEl.VarEl:=TPasVariable(NewClass.Create(GenVar.Name,SpecEl));
SpecializeElement(GenVar,SpecEl.VarEl);
if GenVar.VarType<>GenEl.TypeEl then
RaiseNotYetImplemented(20190808232601,GenEl);
SpecEl.TypeEl:=SpecEl.VarEl.VarType;
SpecEl.TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF};
end
else
SpecializeElType(GenEl,SpecEl,GenEl.TypeEl,SpecEl.TypeEl);
FinishExceptOnExpr;
SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
FinishExceptOnStatement;
end;
procedure TPasResolver.SpecializeImplRaise(GenEl, SpecEl: TPasImplRaise);
begin
SpecializeElExpr(GenEl,SpecEl,GenEl.ExceptObject,SpecEl.ExceptObject);
SpecializeElExpr(GenEl,SpecEl,GenEl.ExceptAddr,SpecEl.ExceptAddr);
end;
procedure TPasResolver.SpecializeExpr(GenEl, SpecEl: TPasExpr);
begin
SpecEl.Kind:=GenEl.Kind;
@ -15149,12 +15507,32 @@ begin
SpecializeElExpr(GenEl,SpecEl,GenEl.format2,SpecEl.format2);
end;
procedure TPasResolver.SpecializeExprArray(GenEl, SpecEl: TPasElement;
GenArray: TPasExprArray; var SpecArray: TPasExprArray);
var
i: Integer;
begin
if length(SpecArray)>0 then
RaiseNotYetImplemented(20190808205855,GenEl);
SetLength(SpecArray,length(GenArray));
for i:=0 to length(SpecArray)-1 do
SpecArray[i]:=nil;
for i:=0 to length(GenArray)-1 do
SpecializeElExpr(GenEl,SpecEl,GenArray[i],SpecArray[i]);
end;
procedure TPasResolver.SpecializePrimitiveExpr(GenEl, SpecEl: TPrimitiveExpr);
begin
SpecializeExpr(GenEl,SpecEl);
SpecEl.Value:=GenEl.Value;
end;
procedure TPasResolver.SpecializeUnaryExpr(GenEl, SpecEl: TUnaryExpr);
begin
SpecializeExpr(GenEl,SpecEl);
SpecializeElExpr(GenEl,SpecEl,GenEl.Operand,SpecEl.Operand);
end;
procedure TPasResolver.SpecializeBinaryExpr(GenEl, SpecEl: TBinaryExpr);
begin
SpecializeExpr(GenEl,SpecEl);
@ -15162,6 +15540,155 @@ begin
SpecializeElExpr(GenEl,SpecEl,GenEl.right,SpecEl.right);
end;
procedure TPasResolver.SpecializeBoolConstExpr(GenEl, SpecEl: TBoolConstExpr);
begin
SpecializeExpr(GenEl,SpecEl);
SpecEl.Value:=GenEl.Value;
end;
procedure TPasResolver.SpecializeParamsExpr(GenEl, SpecEl: TParamsExpr);
begin
SpecializeExpr(GenEl,SpecEl);
SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value);
SpecializeExprArray(GenEl,SpecEl,GenEl.Params,SpecEl.Params);
end;
procedure TPasResolver.SpecializeRecordValues(GenEl, SpecEl: TRecordValues);
var
GenField: TRecordValuesItem;
i: Integer;
SpecFieldP: PRecordValuesItem;
begin
SpecializeExpr(GenEl,SpecEl);
// fields
SetLength(SpecEl.Fields,length(GenEl.Fields));
for i:=0 to length(SpecEl.Fields)-1 do
with SpecEl.Fields[i] do
begin
NameExp:=nil;
ValueExp:=nil;
end;
for i:=0 to length(GenEl.Fields)-1 do
begin
GenField:=GenEl.Fields[i];
if GenField.NameExp.Parent<>GenEl then
RaiseNotYetImplemented(20190808205128,GenEl);
if GenField.ValueExp.Parent<>GenEl then
RaiseNotYetImplemented(20190808205138,GenEl);
SpecFieldP:=@SpecEl.Fields[i];
SpecializeElExpr(GenEl,SpecEl,GenField.NameExp,TPasExpr(SpecFieldP^.NameExp));
SpecializeElExpr(GenEl,SpecEl,GenField.ValueExp,SpecFieldP^.ValueExp);
end;
end;
procedure TPasResolver.SpecializeArrayValues(GenEl, SpecEl: TArrayValues);
begin
SpecializeExpr(GenEl,SpecEl);
SpecializeExprArray(GenEl,SpecEl,GenEl.Values,SpecEl.Values);
end;
procedure TPasResolver.SpecializeInlineSpecializeExpr(GenEl,
SpecEl: TInlineSpecializeExpr);
begin
SpecializeExpr(GenEl,SpecEl);
SpecializeElExpr(GenEl,SpecEl,GenEl.NameExpr,SpecEl.NameExpr);
SpecializeElList(GenEl,SpecEl,GenEl.Params,SpecEl.Params,true
{$IFDEF CheckPasTreeRefCount},'TInlineSpecializeExpr.Params'{$ENDIF});
end;
procedure TPasResolver.SpecializeProcedureExpr(GenEl, SpecEl: TProcedureExpr);
begin
SpecializeExpr(GenEl,SpecEl);
if GenEl.Proc=nil then
RaiseNotYetImplemented(20190808221018,GenEl);
RaiseNotYetImplemented(20190808221040,GenEl);
end;
procedure TPasResolver.SpecializeResString(GenEl, SpecEl: TPasResString);
begin
SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
FinishResourcestring(SpecEl);
end;
procedure TPasResolver.SpecializeAliasType(GenEl, SpecEl: TPasAliasType);
begin
SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
SpecializeElExpr(GenEl,SpecEl,GenEl.Expr,SpecEl.Expr);
// not needed by specialize: FinishTypeAlias();
FinishTypeDef(SpecEl);
end;
procedure TPasResolver.SpecializePointerType(GenEl, SpecEl: TPasPointerType);
begin
SpecializeElType(GenEl,SpecEl,GenEl.DestType,SpecEl.DestType);
FinishPointerType(SpecEl);
end;
procedure TPasResolver.SpecializeRangeType(GenEl, SpecEl: TPasRangeType);
begin
SpecializeElExpr(GenEl,SpecEl,GenEl.RangeExpr,TPasExpr(SpecEl.RangeExpr));
FinishRangeType(SpecEl);
end;
procedure TPasResolver.SpecializeArrayType(GenEl, SpecEl: TPasArrayType);
begin
SpecEl.IndexRange:=GenEl.IndexRange;
SpecEl.PackMode:=GenEl.PackMode;
SpecializeExprArray(GenEl,SpecEl,GenEl.Ranges,SpecEl.Ranges);
SpecializeElType(GenEl,SpecEl,GenEl.ElType,SpecEl.ElType);
FinishArrayType(SpecEl);
end;
procedure TPasResolver.SpecializeEnumValue(GenEl, SpecEl: TPasEnumValue);
begin
SpecializeElExpr(GenEl,SpecEl,GenEl.Value,SpecEl.Value);
end;
procedure TPasResolver.SpecializeEnumType(GenEl, SpecEl: TPasEnumType);
begin
SpecializeElList(GenEl,SpecEl,GenEl.Values,SpecEl.Values,false
{$IFDEF CheckPasTreeRefCount},'TPasEnumType.Values'{$ENDIF});
FinishEnumType(SpecEl);
end;
procedure TPasResolver.SpecializeSetType(GenEl, SpecEl: TPasSetType);
begin
SpecEl.IsPacked:=GenEl.IsPacked;
SpecializeElType(GenEl,SpecEl,GenEl.EnumType,SpecEl.EnumType);
FinishSetType(SpecEl);
end;
procedure TPasResolver.SpecializeVariant(GenEl, SpecEl: TPasVariant);
begin
SpecializeElList(GenEl,SpecEl,GenEl.Values,SpecEl.Values,false
{$IFDEF CheckPasTreeRefCount},'TPasVariant.Values'{$ENDIF});
RaiseNotYetImplemented(20190808214218,GenEl)
//ToDo: Members: TPasRecordType;
end;
procedure TPasResolver.SpecializeStringType(GenEl, SpecEl: TPasStringType);
begin
SpecEl.LengthExpr:=GenEl.LengthExpr;
FinishTypeDef(SpecEl);
end;
procedure TPasResolver.SpecializeAttributes(GenEl, SpecEl: TPasAttributes);
begin
SpecializeExprArray(GenEl,SpecEl,GenEl.Calls,SpecEl.Calls);
FinishAttributes(SpecEl);
end;
procedure TPasResolver.SpecializeMethodResolution(GenEl,
SpecEl: TPasMethodResolution);
begin
SpecEl.ProcClass:=GenEl.ProcClass;
SpecializeElExpr(GenEl,SpecEl,GenEl.InterfaceName,SpecEl.InterfaceName);
SpecializeElExpr(GenEl,SpecEl,GenEl.InterfaceProc,SpecEl.InterfaceProc);
SpecializeElExpr(GenEl,SpecEl,GenEl.ImplementationProc,SpecEl.ImplementationProc);
FinishMethodResolution(SpecEl);
end;
function TPasResolver.CheckAssignCompatibilityCustom(const LHS,
RHS: TPasResolverResult; ErrorEl: TPasElement; RaiseOnIncompatible: boolean;
var Handled: boolean): integer;
@ -23511,6 +24038,8 @@ begin
eopAdd, eopSubtract:
if ResolvedEl.BaseType in (btAllInteger+btAllFloats) then
exit
else if IsGenericTemplType(ResolvedEl) then
exit
else
RaiseMsg(20170216152532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf,
[OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El);
@ -23543,7 +24072,9 @@ begin
exit;
end;
eopMemAddress:
if (ResolvedEl.BaseType=btContext) and (ResolvedEl.LoTypeEl is TPasProcedureType) then
if (ResolvedEl.BaseType=btContext)
and ((ResolvedEl.LoTypeEl is TPasProcedureType)
or IsGenericTemplType(ResolvedEl)) then
// @@ProcVar
exit
else

8
packages/fcl-passrc/src/pastree.pp
View File

@ -550,7 +550,7 @@ type
function ElementTypeName: string; override;
end;
{ TPasGenericTemplateType }
{ TPasGenericTemplateType - type param of a generic }
TPasGenericTemplateType = Class(TPasType)
public
@ -564,7 +564,7 @@ type
Constraints: TPasExprArray;
end;
{ TPasGenericType }
{ TPasGenericType - abstract base class for all types which can be generics }
TPasGenericType = class(TPasType)
private
@ -1407,7 +1407,7 @@ type
end;
TPasImplBlockClass = class of TPasImplBlock;
{ TPasImplStatement }
{ TPasImplStatement - base class }
TPasImplStatement = class(TPasImplBlock)
public
@ -1627,7 +1627,7 @@ type
procedure ClearTypeReferences(aType: TPasElement); override;
public
VarEl: TPasVariable; // can be nil
TypeEl : TPasType;
TypeEl : TPasType; // if VarEl<>nil then TypeEl=VarEl.VarType
Body: TPasImplElement;
Function VariableName : String;
Function TypeName: string;

1
packages/fcl-passrc/src/pparser.pp
View File

@ -5837,6 +5837,7 @@ begin
//WriteLn(i,'WHILE Condition="',Condition,'" Token=',CurTokenText);
El:=TPasImplWhileDo(CreateElement(TPasImplWhileDo,'',CurBlock,SrcPos));
TPasImplWhileDo(El).ConditionExpr:=Left;
Left.Parent:=El;
Left:=nil;
CreateBlock(TPasImplWhileDo(El));
El:=nil;

39
packages/fcl-passrc/tests/tcresolvegenerics.pas
View File

@ -74,8 +74,8 @@ type
// generic statements
procedure TestGen_LocalVar;
procedure TestGen_Statements;
procedure TestGen_ForLoop;
// ToDo: for
// ToDo: for-in
// ToDo: if
// ToDo: case
@ -544,6 +544,43 @@ begin
ParseProgram;
end;
procedure TTestResolveGenerics.TestGen_Statements;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'type',
' TObject = class end;',
' generic TBird<{#Templ}T> = class',
' function Fly(p:T): T;',
' end;',
'function TBird.Fly(p:T): T;',
'var',
' v1,v2,v3:T;',
'begin',
' v1:=1;',
' v2:=v1+v1*v1+v1 div p;',
' v3:=-v1;',
' repeat',
' v1:=v1+1;',
' until v1>=5;',
' while v1>=0 do',
' v1:=v1-v2;',
' for v1:=v2 to v3 do v2:=v1;',
' if v1<v2 then v3:=v1 else v3:=v2;',
' if v1<v2 then else ;',
' case v1 of',
' 1: v3:=3;',
' end;',
'end;',
'var',
' b: specialize TBird<word>;',
'begin',
' b.Fly(2);',
'']);
ParseProgram;
end;
procedure TTestResolveGenerics.TestGen_ForLoop;
begin
StartProgram(false);

1
utils/pas2js/dist/rtl.js vendored
View File

@ -1058,7 +1058,6 @@ var rtl = {
s=' '+s;
l++;
};
return s;
};
},