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

* Refactoring in preparation of extended features (nested type, extended records) support

Browse Source 
git-svn-id: trunk@19662 -
This commit is contained in:
michael 2011-11-20 22:46:54 +00:00
parent 3188916cda
commit d078996f69
3 changed files with 1478 additions and 1682 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -42,6 +42,7 @@ resourcestring
SPasTreeEnumType = 'enumeration type'; SPasTreeEnumType = 'enumeration type';
SPasTreeSetType = 'set type'; SPasTreeSetType = 'set type';
SPasTreeRecordType = 'record type'; SPasTreeRecordType = 'record type';
SPasStringType = 'string type';
SPasTreeObjectType = 'object'; SPasTreeObjectType = 'object';
SPasTreeClassType = 'class'; SPasTreeClassType = 'class';
SPasTreeInterfaceType = 'interface'; SPasTreeInterfaceType = 'interface';
@ -85,6 +86,7 @@ type
visStrictPrivate, visStrictProtected); visStrictPrivate, visStrictProtected);
TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall); TCallingConvention = (ccDefault,ccRegister,ccPascal,ccCDecl,ccStdCall,ccOldFPCCall,ccSafeCall);
TPackMode = (pmNone,pmPacked,pmBitPacked);
TPasMemberVisibilities = set of TPasMemberVisibility; TPasMemberVisibilities = set of TPasMemberVisibility;
TPasMemberHint = (hDeprecated,hLibrary,hPlatform,hExperimental,hUnimplemented); TPasMemberHint = (hDeprecated,hLibrary,hPlatform,hExperimental,hUnimplemented);
@ -240,7 +242,7 @@ type
function ElementTypeName: string; override; function ElementTypeName: string; override;
public public
Declarations, ResStrings, Types, Consts, Classes, Declarations, ResStrings, Types, Consts, Classes,
Functions, Variables, Properties: TList; Functions, Variables, Properties: TFPList;
end; end;
{ TPasSection } { TPasSection }
@ -251,7 +253,7 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure AddUnitToUsesList(const AUnitName: string); procedure AddUnitToUsesList(const AUnitName: string);
public public
UsesList: TList; // TPasUnresolvedTypeRef or TPasModule elements UsesList: TFPList; // TPasUnresolvedTypeRef or TPasModule elements
end; end;
{ TInterfaceSection } { TInterfaceSection }
@ -298,7 +300,7 @@ type
destructor Destroy; override; destructor Destroy; override;
function ElementTypeName: string; override; function ElementTypeName: string; override;
public public
Modules: TList; // List of TPasModule objects Modules: TFPList; // List of TPasModule objects
end; end;
{ TPasResString } { TPasResString }
@ -375,8 +377,9 @@ type
function GetDeclaration(full : boolean) : string; override; function GetDeclaration(full : boolean) : string; override;
public public
IndexRange : string; IndexRange : string;
IsPacked : Boolean; // 12/04/04 - Dave - Added PackMode : TPackMode;
ElType: TPasType; ElType: TPasType;
Function IsPacked : Boolean;
end; end;
{ TPasFileType } { TPasFileType }
@ -411,7 +414,7 @@ type
function GetDeclaration(full : boolean) : string; override; function GetDeclaration(full : boolean) : string; override;
Procedure GetEnumNames(Names : TStrings); Procedure GetEnumNames(Names : TStrings);
public public
Values: TList; // List of TPasEnumValue objects Values: TFPList; // List of TPasEnumValue objects
end; end;
{ TPasSetType } { TPasSetType }
@ -447,12 +450,13 @@ type
function ElementTypeName: string; override; function ElementTypeName: string; override;
function GetDeclaration(full : boolean) : string; override; function GetDeclaration(full : boolean) : string; override;
public public
IsPacked: Boolean; PackMode : TPackMode;
IsBitPacked : Boolean; Members: TFPList; // array of TPasVariable elements
Members: TList; // array of TPasVariable elements
VariantName: string; VariantName: string;
VariantType: TPasType; VariantType: TPasType;
Variants: TList; // array of TPasVariant elements, may be nil! Variants: TFPList; // array of TPasVariant elements, may be nil!
Function IsPacked: Boolean;
Function IsBitPacked : Boolean;
end; end;
TPasGenericTemplateType = Class(TPasElement); TPasGenericTemplateType = Class(TPasElement);
@ -466,18 +470,19 @@ type
destructor Destroy; override; destructor Destroy; override;
function ElementTypeName: string; override; function ElementTypeName: string; override;
public public
PackMode : TPackMode;
ObjKind: TPasObjKind; ObjKind: TPasObjKind;
AncestorType: TPasType; // TPasClassType or TPasUnresolvedTypeRef AncestorType: TPasType; // TPasClassType or TPasUnresolvedTypeRef
IsPacked: Boolean; // 12/04/04 - Dave - Added
IsForward : Boolean; IsForward : Boolean;
IsShortDefinition: Boolean;//class(anchestor); without end IsShortDefinition: Boolean;//class(anchestor); without end
Members: TList; // array of TPasElement objects Members: TFPList; // array of TPasElement objects
InterfaceGUID : string; // 15/06/07 - Inoussa InterfaceGUID : string; // 15/06/07 - Inoussa
ClassVars: TList; // class vars ClassVars: TFPList; // class vars
Modifiers: TStringList; Modifiers: TStringList;
Interfaces : TList; Interfaces : TFPList;
GenericTemplateTypes : TList; GenericTemplateTypes : TFPList;
Function IsPacked : Boolean;
end; end;
@ -510,7 +515,7 @@ type
function CreateArgument(const AName, AUnresolvedTypeName: string):TPasArgument; function CreateArgument(const AName, AUnresolvedTypeName: string):TPasArgument;
public public
IsOfObject: Boolean; IsOfObject: Boolean;
Args: TList; // List of TPasArgument objects Args: TFPList; // List of TPasArgument objects
end; end;
{ TPasResultElement } { TPasResultElement }
@ -542,12 +547,19 @@ type
function ElementTypeName: string; override; function ElementTypeName: string; override;
end; end;
{ TPasStringType }
TPasStringType = class(TPasUnresolvedTypeRef)
public
LengthExpr : String;
function ElementTypeName: string; override;
end;
{ TPasTypeRef } { TPasTypeRef }
TPasTypeRef = class(TPasUnresolvedTypeRef) TPasTypeRef = class(TPasUnresolvedTypeRef)
public public
public public
// function GetDeclaration(full : Boolean): string; override;
RefType: TPasType; RefType: TPasType;
end; end;
@ -583,7 +595,7 @@ type
function ElementTypeName: string; override; function ElementTypeName: string; override;
function GetDeclaration(full : boolean) : string; override; function GetDeclaration(full : boolean) : string; override;
public public
Args: TList; // List of TPasArgument objects Args: TFPList; // List of TPasArgument objects
IndexValue, ReadAccessorName, WriteAccessorName,ImplementsName, IndexValue, ReadAccessorName, WriteAccessorName,ImplementsName,
StoredAccessorName, DefaultValue: string; StoredAccessorName, DefaultValue: string;
IsDefault, IsNodefault: Boolean; IsDefault, IsNodefault: Boolean;
@ -605,7 +617,7 @@ type
function ElementTypeName: string; override; function ElementTypeName: string; override;
function TypeName: string; override; function TypeName: string; override;
public public
Overloads: TList; // List of TPasProcedure nodes Overloads: TFPList; // List of TPasProcedure nodes
end; end;
TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride, TProcedureModifier = (pmVirtual, pmDynamic, pmAbstract, pmOverride,
@ -707,7 +719,7 @@ type
constructor Create(const AName: string; AParent: TPasElement); override; constructor Create(const AName: string; AParent: TPasElement); override;
destructor Destroy; override; destructor Destroy; override;
public public
Labels: TList; Labels: TFPList;
Body: TPasImplBlock; Body: TPasImplBlock;
end; end;
@ -721,7 +733,7 @@ type
function TypeName: string; virtual; function TypeName: string; virtual;
public public
ProcType: TPasProcedureType; ProcType: TPasProcedureType;
Locals: TList; Locals: TFPList;
Body: TPasImplBlock; Body: TPasImplBlock;
end; end;
@ -813,7 +825,7 @@ type
function AddSimple(exp: TPasExpr): TPasImplSimple; function AddSimple(exp: TPasExpr): TPasImplSimple;
function CloseOnSemicolon: boolean; virtual; function CloseOnSemicolon: boolean; virtual;
public public
Elements: TList; // TPasImplElement objects Elements: TFPList; // TPasImplElement objects
end; end;
{ TPasImplStatement } { TPasImplStatement }
@ -1036,6 +1048,9 @@ implementation
uses SysUtils; uses SysUtils;
{ TPasStringType }
{$IFNDEF FPC} {$IFNDEF FPC}
const const
LineEnding = sLineBreak; LineEnding = sLineBreak;
@ -1079,6 +1094,7 @@ function TPasDestructor.ElementTypeName: string; begin Result := SPasTreeDestruc
function TPasProcedureImpl.ElementTypeName: string; begin Result := SPasTreeProcedureImpl end; function TPasProcedureImpl.ElementTypeName: string; begin Result := SPasTreeProcedureImpl end;
function TPasConstructorImpl.ElementTypeName: string; begin Result := SPasTreeConstructorImpl end; function TPasConstructorImpl.ElementTypeName: string; begin Result := SPasTreeConstructorImpl end;
function TPasDestructorImpl.ElementTypeName: string; begin Result := SPasTreeDestructorImpl end; function TPasDestructorImpl.ElementTypeName: string; begin Result := SPasTreeDestructorImpl end;
function TPasStringType.ElementTypeName: string; begin Result:=SPasStringType;end;
function TPasClassType.ElementTypeName: string; function TPasClassType.ElementTypeName: string;
begin begin
@ -1091,6 +1107,11 @@ begin
end; end;
end; end;
function TPasClassType.IsPacked: Boolean;
begin
Result:=PackMode<>pmNone;
end;
{ All other stuff: } { All other stuff: }
@ -1139,7 +1160,7 @@ begin
p := Parent; p := Parent;
while Assigned(p) and not p.InheritsFrom(TPasDeclarations) do while Assigned(p) and not p.InheritsFrom(TPasDeclarations) do
begin begin
if (p.ClassType <> TPasOverloadedProc) and (Length(p.Name) > 0) then if (not (p is TPasOverloadedProc)) and (Length(p.Name) > 0) then
if Length(Result) > 0 then if Length(Result) > 0 then
Result := p.Name + '.' + Result Result := p.Name + '.' + Result
else else
@ -1156,7 +1177,7 @@ begin
p := Parent; p := Parent;
while Assigned(p) do while Assigned(p) do
begin begin
if (p.ClassType <> TPasOverloadedProc) and (Length(p.Name) > 0) then if (Not (p is TPasOverloadedProc)) and (Length(p.Name) > 0) then
if Length(Result) > 0 then if Length(Result) > 0 then
Result := p.Name + '.' + Result Result := p.Name + '.' + Result
else else
@ -1167,12 +1188,12 @@ end;
function TPasElement.GetModule: TPasModule; function TPasElement.GetModule: TPasModule;
begin begin
if ClassType = TPasPackage then if self is TPasPackage then
Result := nil Result := nil
else else
begin begin
Result := TPasModule(Self); Result := TPasModule(Self);
while Assigned(Result) and not (Result.ClassType = TPasModule) do while Assigned(Result) and not (Result is TPasModule) do
Result := TPasModule(Result.Parent); Result := TPasModule(Result.Parent);
end; end;
end; end;
@ -1194,14 +1215,14 @@ end;
constructor TPasDeclarations.Create(const AName: string; AParent: TPasElement); constructor TPasDeclarations.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Declarations := TList.Create; Declarations := TFPList.Create;
ResStrings := TList.Create; ResStrings := TFPList.Create;
Types := TList.Create; Types := TFPList.Create;
Consts := TList.Create; Consts := TFPList.Create;
Classes := TList.Create; Classes := TFPList.Create;
Functions := TList.Create; Functions := TFPList.Create;
Variables := TList.Create; Variables := TFPList.Create;
Properties := TList.Create; Properties := TFPList.Create;
end; end;
destructor TPasDeclarations.Destroy; destructor TPasDeclarations.Destroy;
@ -1238,7 +1259,7 @@ begin
inherited Create('#' + AName, AParent) inherited Create('#' + AName, AParent)
else else
inherited Create(AName, AParent); inherited Create(AName, AParent);
Modules := TList.Create; Modules := TFPList.Create;
end; end;
destructor TPasPackage.Destroy; destructor TPasPackage.Destroy;
@ -1286,7 +1307,7 @@ end;
constructor TPasEnumType.Create(const AName: string; AParent: TPasElement); constructor TPasEnumType.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Values := TList.Create; Values := TFPList.Create;
end; end;
destructor TPasEnumType.Destroy; destructor TPasEnumType.Destroy;
@ -1339,7 +1360,7 @@ end;
constructor TPasRecordType.Create(const AName: string; AParent: TPasElement); constructor TPasRecordType.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Members := TList.Create; Members := TFPList.Create;
end; end;
destructor TPasRecordType.Destroy; destructor TPasRecordType.Destroy;
@ -1367,13 +1388,13 @@ end;
constructor TPasClassType.Create(const AName: string; AParent: TPasElement); constructor TPasClassType.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
IsPacked := False; // 12/04/04 - Dave - Added PackMode:=pmNone; // 12/04/04 - Dave - Added
IsShortDefinition := False; IsShortDefinition := False;
Members := TList.Create; Members := TFPList.Create;
Modifiers := TStringList.Create; Modifiers := TStringList.Create;
ClassVars := TList.Create; ClassVars := TFPList.Create;
Interfaces:= TList.Create; Interfaces:= TFPList.Create;
GenericTemplateTypes:=TList.Create; GenericTemplateTypes:=TFPList.Create;
end; end;
@ -1407,7 +1428,7 @@ end;
constructor TPasProcedureType.Create(const AName: string; AParent: TPasElement); constructor TPasProcedureType.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Args := TList.Create; Args := TFPList.Create;
end; end;
destructor TPasProcedureType.Destroy; destructor TPasProcedureType.Destroy;
@ -1477,7 +1498,7 @@ end;
constructor TPasProperty.Create(const AName: string; AParent: TPasElement); constructor TPasProperty.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Args := TList.Create; Args := TFPList.Create;
end; end;
destructor TPasProperty.Destroy; destructor TPasProperty.Destroy;
@ -1494,7 +1515,7 @@ end;
constructor TPasOverloadedProc.Create(const AName: string; AParent: TPasElement); constructor TPasOverloadedProc.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Overloads := TList.Create; Overloads := TFPList.Create;
end; end;
destructor TPasOverloadedProc.Destroy; destructor TPasOverloadedProc.Destroy;
@ -1533,7 +1554,7 @@ end;
constructor TPasProcedureImpl.Create(const AName: string; AParent: TPasElement); constructor TPasProcedureImpl.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Locals := TList.Create; Locals := TFPList.Create;
end; end;
destructor TPasProcedureImpl.Destroy; destructor TPasProcedureImpl.Destroy;
@ -1629,7 +1650,7 @@ end;
constructor TPasImplBlock.Create(const AName: string; AParent: TPasElement); constructor TPasImplBlock.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Elements := TList.Create; Elements := TFPList.Create;
end; end;
destructor TPasImplBlock.Destroy; destructor TPasImplBlock.Destroy;
@ -1838,6 +1859,11 @@ begin
Result:=Name+' = '+Result; Result:=Name+' = '+Result;
end; end;
function TPasArrayType.IsPacked: Boolean;
begin
Result:=PackMode=pmPacked;
end;
function TPasFileType.GetDeclaration (full : boolean) : string; function TPasFileType.GetDeclaration (full : boolean) : string;
begin begin
Result:='File'; Result:='File';
@ -1968,6 +1994,16 @@ begin
end; end;
end; end;
function TPasRecordType.IsPacked: Boolean;
begin
Result:=(PackMode <> pmNone);
end;
function TPasRecordType.IsBitPacked: Boolean;
begin
Result:=(PackMode=pmBitPacked)
end;
procedure TPasProcedureType.GetArguments(List : TStrings); procedure TPasProcedureType.GetArguments(List : TStrings);
Var Var
@ -2327,7 +2363,7 @@ end;
constructor TPasSection.Create(const AName: string; AParent: TPasElement); constructor TPasSection.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
UsesList := TList.Create; UsesList := TFPList.Create;
end; end;
destructor TPasSection.Destroy; destructor TPasSection.Destroy;
@ -2351,7 +2387,7 @@ end;
constructor TProcedureBody.Create(const AName: string; AParent: TPasElement); constructor TProcedureBody.Create(const AName: string; AParent: TPasElement);
begin begin
inherited Create(AName, AParent); inherited Create(AName, AParent);
Labels:=TList.Create; Labels:=TFPList.Create;
end; end;
destructor TProcedureBody.Destroy; destructor TProcedureBody.Destroy;

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

File diff suppressed because it is too large Load Diff

10
packages/fcl-passrc/src/pscanner.pp
View File

@ -144,6 +144,7 @@ type
tkLineEnding, tkLineEnding,
tkTab tkTab
); );
TTokens = set of TToken;
TLineReader = class TLineReader = class
public public
@ -186,10 +187,10 @@ type
EScannerError = class(Exception); EScannerError = class(Exception);
EFileNotFoundError = class(Exception); EFileNotFoundError = class(Exception);
TPascalScannerPPSkipMode = (ppSkipNone, ppSkipIfBranch, ppSkipElseBranch, TPascalScannerPPSkipMode = (ppSkipNone, ppSkipIfBranch, ppSkipElseBranch, ppSkipAll);
ppSkipAll);
TPOptions = (po_delphi); TPOption = (po_delphi);
TPOptions = set of TPOption;
{ TPascalScanner } { TPascalScanner }
@ -220,7 +221,7 @@ type
function DoFetchTextToken: TToken; function DoFetchTextToken: TToken;
function DoFetchToken: TToken; function DoFetchToken: TToken;
public public
Options : set of TPOptions; Options : TPOptions;
constructor Create(AFileResolver: TFileResolver); constructor Create(AFileResolver: TFileResolver);
destructor Destroy; override; destructor Destroy; override;
procedure OpenFile(const AFilename: string); procedure OpenFile(const AFilename: string);
@ -391,7 +392,6 @@ function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
begin begin
Result:=(TheFilename<>'') and (TheFilename[1]='/'); Result:=(TheFilename<>'') and (TheFilename[1]='/');
end; end;
constructor TFileLineReader.Create(const AFilename: string); constructor TFileLineReader.Create(const AFilename: string);
begin begin
inherited Create; inherited Create;