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

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