paxCompiler/Sources/PaxCompilerExplorer.pas
Dalibor Marković 9d0de424e8
Init
Signed-off-by: Dalibor Marković <dalibor31@gmail.com>
2024-07-06 22:28:12 +02:00

1270 lines
35 KiB
ObjectPascal

////////////////////////////////////////////////////////////////////////////
// PaxCompiler
// Site: http://www.paxcompiler.com
// Author: Alexander Baranovsky (paxscript@gmail.com)
// ========================================================================
// Copyright (c) Alexander Baranovsky, 2006-2014. All rights reserved.
// Code Version: 4.2
// ========================================================================
// Unit: PaxCompilerExplorer.pas
// ========================================================================
////////////////////////////////////////////////////////////////////////////
{$I PaxCompiler.def}
unit PaxCompilerExplorer;
interface
uses {$I uses.def}
TypInfo,
SysUtils,
Classes,
PAXCOMP_CONSTANTS,
PAXCOMP_SYS,
PAXCOMP_TYPES,
PAXCOMP_SYMBOL_REC,
PAXCOMP_BASESYMBOL_TABLE,
PAXCOMP_SYMBOL_TABLE,
PAXCOMP_KERNEL,
PAXCOMP_MAP,
PAXCOMP_BYTECODE,
PAXCOMP_STDLIB,
PaxCompiler;
type
TPaxMemberKind = (pmkNone, pmkNamespace, pmkType, pmkField, pmkProperty, pmkProcedure, pmkFunction,
pmkConstructor, pmkDestructor, pmkEnumMember,
pmkParam, pmkVar, pmkConst);
TExplorerEnumProc = procedure (Id: Integer;
Host: Boolean;
Kind: TPaxMemberKind;
Data: Pointer) of object;
TPaxCompilerExplorer = class(TComponent)
private
compiler: TPaxCompiler;
fUsedNamespaces: TAssocStringInt;
fNotUsedNamespaces: TAssocStringInt;
fExisttNamespaceLists: Boolean;
procedure BuildNamespaceLists;
procedure TestId(Id: Integer);
procedure TestSubId(SubId: Integer);
procedure TestNamespaceId(NamespaceId: Integer);
procedure TestArrayId(ArrayId: Integer);
// procedure TestDynArrayId(DynArrayId: Integer);
function GetName(Id: Integer): String;
function GetFullName(Id: Integer): String;
function GetKind(Id: Integer): TPaxMemberKind;
function GetTypeId(Id: Integer): Integer;
function GetTypeName(Id: Integer): String;
function GetPosition(Id: Integer): Integer;
function GetUsedNamespaces: TStringList;
function GetNotUsedNamespaces: TStringList;
protected
function GetStrKind(Id: Integer): String; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure RegisterCompiler(i_compiler: TPaxCompiler);
function IsExecutableLine(const ModuleName: String;
LineNumber: Integer): Boolean;
function GetParamCount(SubId: Integer): Integer;
function GetParamId(SubId, I: Integer): Integer;
function GetResultId(SubId: Integer): Integer;
function GetLocalCount(SubId: Integer): Integer;
function GetLocalId(SubId, I: Integer): Integer;
function GetGlobalCount(NamespaceId: Integer): Integer;
function GetGlobalId(NamespaceId, I: Integer): Integer;
function HasArrayType(Id: Integer): Boolean;
function HasDynArrayType(Id: Integer): Boolean;
function HasRecordType(Id: Integer): Boolean;
function HasClassType(Id: Integer): Boolean;
function Host(Id: Integer): Boolean;
function GetFieldCount(Id: Integer): Integer;
function GetFieldName(Id, FieldNumber: Integer): String;
function GetFieldId(Id, FieldNumber: Integer): Integer;
function GetPublishedPropCount(Id: Integer): Integer;
function GetPublishedPropName(Id, PropNumber: Integer): String;
function GetArrayLowBound(Id: Integer): Integer;
function GetArrayHighBound(Id: Integer): Integer;
function GetNamespaceId(Id: Integer): Integer;
function GetVisibility(Id: Integer): TClassVisibility;
function GetReadId(PropId: Integer): Integer;
function GetWriteId(PropId: Integer): Integer;
// function GetArrayDef(Id: Integer): String;
function GetLevelId(Id: Integer): Integer;
function GetAncestorId(Id: Integer): Integer;
procedure EnumMembers(OwnerId: Integer;
Host: Boolean;
pmk: TPaxMemberKind;
CallBack: TExplorerEnumProc;
Data: Pointer);
procedure ExtractMembers(const Id: Integer; L: TStrings;
PaxLang: TPaxCompilerLanguage = nil);
function IsConst(LevelId, Id: Integer): Boolean;
function IsVar(LevelId, Id: Integer): Boolean;
function IsProcedure(LevelId, Id: Integer): Boolean;
function IsFunction(LevelId, Id: Integer): Boolean;
function IsNamespace(LevelId, Id: Integer): Boolean;
function IsType(LevelId, Id: Integer): Boolean;
function IsTypeField(TypeId, Id: Integer): Boolean;
function IsProperty(TypeId, Id: Integer): Boolean;
function IsConstructor(TypeId, Id: Integer): Boolean;
function IsDestructor(TypeId, Id: Integer): Boolean;
function IsByRefParam(Id: Integer): Boolean;
function IsConstParam(Id: Integer): Boolean;
function IsMethod(Id: Integer): Boolean;
function IsArrayType(Id: Integer): Boolean;
function IsDynArrayType(Id: Integer): Boolean;
function IsRecordType(Id: Integer): Boolean;
function IsClassType(Id: Integer): Boolean;
function IsInterfaceType(Id: Integer): Boolean;
function IsEnumType(Id: Integer): Boolean;
function IsAliasType(Id: Integer): Boolean;
function IsDeprecated(Id: Integer): Boolean;
function IsUsedNamespaceId(Id: Integer): Boolean;
property Names[Id: Integer]: String read GetName;
property FullNames[Id: Integer]: String read GetFullName;
property Kinds[Id: Integer]: TPaxMemberKind read GetKind;
property StrKinds[Id: Integer]: String read GetStrKind;
property TypeIds[Id: Integer]: Integer read GetTypeId;
property TypeNames[Id: Integer]: String read GetTypeName;
property Positions[Id: Integer]: Integer read GetPosition;
property UsedNamespaces: TStringList read GetUsedNamespaces;
property NotUsedNamespaces: TStringList read GetNotUsedNamespaces;
end;
implementation
/////////////// TPaxCompilerExplorer ///////////////////////////////////////////
procedure RaiseError(const Message: string; params: array of Const);
begin
raise Exception.Create(Format(Message, params))
end;
constructor TPaxCompilerExplorer.Create(AOwner: TComponent);
begin
inherited;
fUsedNamespaces := TAssocStringInt.Create;
fNotUsedNamespaces := TAssocStringInt.Create;
compiler := nil;
end;
destructor TPaxCompilerExplorer.Destroy;
begin
FreeAndNil(fUsedNamespaces);
FreeAndNil(fNotUsedNamespaces);
inherited;
end;
procedure TPaxCompilerExplorer.RegisterCompiler(i_compiler: TPaxCompiler);
begin
compiler := i_compiler;
end;
function TPaxCompilerExplorer.IsExecutableLine(const ModuleName: String;
LineNumber: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).IsExecutableLine(ModuleName,
LineNumber);
end;
procedure TPaxCompilerExplorer.TestId(Id: Integer);
begin
if (Id <= 0) or (Id > TKernel(compiler.GetKernelPtr).SymbolTable.Card) then
RaiseError(errInvalidId, [Id]);
end;
procedure TPaxCompilerExplorer.TestSubId(SubId: Integer);
begin
TestId(SubId);
if not (TKernel(compiler.GetKernelPtr).SymbolTable[SubId].Kind
in [kindSUB, KindPROP,
KindCONSTRUCTOR, KindDESTRUCTOR]) then
RaiseError(errInvalidId, [SubId]);
end;
procedure TPaxCompilerExplorer.TestNamespaceId(NamespaceId: Integer);
begin
if NamespaceId = 0 then
Exit;
TestId(NamespaceId);
if TKernel(compiler.GetKernelPtr).SymbolTable[NamespaceId].Kind <>
kindNAMESPACE then
RaiseError(errInvalidId, [NamespaceId]);
end;
function TPaxCompilerExplorer.GetName(Id: Integer): String;
begin
TestId(Id);
result := TKernel(compiler.GetKernelPtr).SymbolTable[Id].Name;
end;
function TPaxCompilerExplorer.GetFullName(Id: Integer): String;
begin
TestId(Id);
result := TKernel(compiler.GetKernelPtr).SymbolTable[Id].FullName;
end;
function TPaxCompilerExplorer.GetKind(Id: Integer): TPaxMemberKind;
var
K: Integer;
begin
TestId(Id);
K := TKernel(compiler.GetKernelPtr).SymbolTable[Id].Kind;
result := pmkNone;
case K of
KindVAR:
begin
if TKernel(compiler.GetKernelPtr).SymbolTable[Id].Param then
result := pmkParam
else
result := pmkVar;
end;
KindCONST: result := pmkConst;
KindTYPE: result := pmkType;
KindNAMESPACE: result := pmkNamespace;
KindTYPE_FIELD: result := pmkField;
KindPROP: result := pmkProperty;
KindSUB:
if GetTypeId(id) = typeVOID then
result := pmkProcedure
else
result := pmkFunction;
KindCONSTRUCTOR: result := pmkConstructor;
KindDESTRUCTOR: result := pmkDestructor;
end;
end;
function TPaxCompilerExplorer.GetStrKind(Id: Integer): String;
var
K: TPaxMemberKind;
begin
K := GetKind(Id);
case K of
pmkNone: result := '';
pmkNamespace: result := 'namespace';
pmkType: result := 'type';
pmkField: result := 'field';
pmkProperty: result := 'property';
pmkProcedure: result := 'procedure';
pmkFunction: result := 'function';
pmkConstructor: result := 'constructor';
pmkDestructor: result := 'destructor';
pmkParam: result := 'parameter';
pmkVar: result := 'variable';
pmkConst: result := 'constant';
end;
end;
function TPaxCompilerExplorer.GetPosition(Id: Integer): Integer;
begin
TestId(Id);
result := TKernel(compiler.GetKernelPtr).SymbolTable[Id].Position;
end;
function TPaxCompilerExplorer.GetTypeName(Id: Integer): String;
var
TypeId: Integer;
begin
TestId(Id);
TypeId := TKernel(compiler.GetKernelPtr).SymbolTable[Id].TypeId;
if TypeId = 0 then
result := ''
else
result := TKernel(compiler.GetKernelPtr).SymbolTable[TypeId].Name;
end;
function TPaxCompilerExplorer.GetTypeId(Id: Integer): Integer;
begin
TestId(Id);
result := TKernel(compiler.GetKernelPtr).SymbolTable[Id].TypeId;
end;
function TPaxCompilerExplorer.GetParamCount(SubId: Integer): Integer;
begin
TestSubId(SubId);
result := TKernel(compiler.GetKernelPtr).SymbolTable[SubId].Count;
end;
function TPaxCompilerExplorer.GetParamId(SubId, I: Integer): Integer;
begin
TestId(SubId);
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetParamId(SubId, I);
end;
function TPaxCompilerExplorer.GetResultId(SubId: Integer): Integer;
begin
TestId(SubId);
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetResultId(SubId);
end;
function TPaxCompilerExplorer.GetLocalCount(SubId: Integer): Integer;
begin
TestSubId(SubId);
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetLocalCount(SubId);
end;
function TPaxCompilerExplorer.GetLocalId(SubId, I: Integer): Integer;
begin
TestSubId(SubId);
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetLocalId(SubId, I);
end;
function TPaxCompilerExplorer.GetGlobalCount(NamespaceId: Integer): Integer;
begin
TestNamespaceId(NamespaceId);
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetGlobalCount(NamespaceId);
end;
function TPaxCompilerExplorer.GetGlobalId(NamespaceId, I: Integer): Integer;
begin
TestNamespaceId(NamespaceId);
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetGlobalId(NamespaceId, I);
end;
function TPaxCompilerExplorer.GetFieldCount(Id: Integer): Integer;
var
T: Integer;
TypeMapRec: TTypeMapRec;
TypeMap: TTypeMap;
begin
TestId(Id);
T := TKernel(compiler.GetKernelPtr).SymbolTable[Id].FinalTypeId;
if T in [typeRECORD, typeCLASS] then
begin
TypeMap := TKernel(compiler.GetKernelPtr).TypeMap;
T := TKernel(compiler.GetKernelPtr).SymbolTable[Id].TerminalTypeId;
TypeMapRec := TypeMap.Lookup(T);
if TypeMapRec = nil then
TypeMapRec := TypeMap.Add(T)
else
if TypeMapRec.Completed then
begin
result := TypeMapRec.Fields.Count;
Exit;
end;
TypeMapRec.Fields.Clear;
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetFieldCount(Id,
TypeMapRec);
TypeMapRec.Completed := true;
end
else
result := 0;
end;
function TPaxCompilerExplorer.GetFieldName(Id, FieldNumber: Integer): String;
var
FieldId: Integer;
TypeMapRec: TTypeMapRec;
begin
TestId(Id);
TypeMapRec := TKernel(compiler.GetKernelPtr).GetTypeMapRec(Id);
if TypeMapRec <> nil then
begin
FieldId := TypeMapRec.Fields[FieldNumber];
result := TKernel(compiler.GetKernelPtr).SymbolTable[FieldId].Name;
end
else
result := '';
end;
function TPaxCompilerExplorer.GetFieldId(Id, FieldNumber: Integer): Integer;
var
TypeMapRec: TTypeMapRec;
begin
TestId(Id);
TypeMapRec := TKernel(compiler.GetKernelPtr).GetTypeMapRec(Id);
if TypeMapRec <> nil then
result := TypeMapRec.Fields[FieldNumber]
else
result := 0;
end;
function TPaxCompilerExplorer.GetPublishedPropCount(Id: Integer): Integer;
begin
TestId(Id);
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetPublishedPropCount(Id);
end;
function TPaxCompilerExplorer.GetPublishedPropName(Id, PropNumber: Integer): String;
begin
TestId(Id);
result := TKernel(compiler.GetKernelPtr).SymbolTable.GetPublishedPropName(Id,
PropNumber);
end;
procedure TPaxCompilerExplorer.TestArrayId(ArrayId: Integer);
begin
if ArrayId = 0 then
Exit;
TestId(ArrayId);
if TKernel(compiler.GetKernelPtr).SymbolTable[ArrayId].FinalTypeId <>
typeARRAY then
RaiseError(errInvalidId, [ArrayId]);
end;
{
procedure TPaxCompilerExplorer.TestDynArrayId(DynArrayId: Integer);
begin
if DynArrayId = 0 then
Exit;
TestId(DynArrayId);
if TKernel(compiler.GetKernelPtr).SymbolTable[DynArrayId].FinalTypeId <>
typeDYNARRAY then
RaiseError(errInvalidId, [DynArrayId]);
end;
}
function TPaxCompilerExplorer.GetArrayLowBound(Id: Integer): Integer;
var
TypeId, RangeTypeId, ElemTypeId: Integer;
begin
TestArrayId(Id);
TypeId := TKernel(compiler.GetKernelPtr).SymbolTable[Id].TerminalTypeId;
with TKernel(compiler.GetKernelPtr).SymbolTable do
begin
GetArrayTypeInfo(TypeId, RangeTypeId, ElemTypeId);
result := GetLowBoundRec(RangeTypeId).Value;
end;
end;
function TPaxCompilerExplorer.GetArrayHighBound(Id: Integer): Integer;
var
TypeId, RangeTypeId, ElemTypeId: Integer;
begin
TestArrayId(Id);
TypeId := TKernel(compiler.GetKernelPtr).SymbolTable[Id].TerminalTypeId;
with TKernel(compiler.GetKernelPtr).SymbolTable do
begin
GetArrayTypeInfo(TypeId, RangeTypeId, ElemTypeId);
result := GetHighBoundRec(RangeTypeId).Value;
end;
end;
function TPaxCompilerExplorer.HasArrayType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindVAR) and (FinalTypeId = typeARRAY);
end;
function TPaxCompilerExplorer.HasDynArrayType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindVAR) and (FinalTypeId = typeDYNARRAY);
end;
function TPaxCompilerExplorer.HasRecordType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindVAR) and (FinalTypeId = typeRECORD);
end;
function TPaxCompilerExplorer.HasClassType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindVAR) and (FinalTypeId = typeCLASS);
end;
function TPaxCompilerExplorer.IsDeprecated(Id: Integer): Boolean;
begin
TestId(Id);
result := TKernel(compiler.GetKernelPtr).SymbolTable[Id].IsDeprecated;
end;
function TPaxCompilerExplorer.IsArrayType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindTYPE) and (FinalTypeId = typeARRAY);
end;
function TPaxCompilerExplorer.IsDynArrayType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindTYPE) and (FinalTypeId = typeDYNARRAY);
end;
function TPaxCompilerExplorer.IsRecordType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindTYPE) and (FinalTypeId = typeRECORD);
end;
function TPaxCompilerExplorer.IsClassType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindTYPE) and (FinalTypeId = typeCLASS);
end;
function TPaxCompilerExplorer.IsInterfaceType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindTYPE) and (FinalTypeId = typeINTERFACE);
end;
function TPaxCompilerExplorer.Host(Id: Integer): Boolean;
begin
TestId(Id);
result := TKernel(compiler.GetKernelPtr).SymbolTable[Id].Host;
end;
procedure TPaxCompilerExplorer.EnumMembers(OwnerId: Integer;
Host: Boolean;
pmk: TPaxMemberKind;
CallBack: TExplorerEnumProc;
Data: Pointer);
var
SymbolTable: TSymbolTable;
Count, K, I, FinTypeId: Integer;
RI: TSymbolRec;
begin
SymbolTable := TKernel(compiler.GetKernelPtr).SymbolTable;
BuildNamespaceLists;
if not Host then
if OwnerId > 0 then
if SymbolTable[OwnerId].Host then
begin
Host := true;
end;
if OwnerId = 0 then
begin
case pmk of
pmkProcedure:
begin
if Host then
for I:=1 to SymbolTable.CompileCard do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsProcedure(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end
else
for I:=SymbolTable.CompileCard + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsProcedure(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkFunction:
begin
if Host then
for I:=1 to SymbolTable.CompileCard do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsFunction(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end
else
for I:=SymbolTable.CompileCard + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsFunction(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkConst:
begin
if Host then
for I:=1 to SymbolTable.CompileCard do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsConst(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end
else
for I:=SymbolTable.CompileCard + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsConst(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkVar:
begin
if Host then
for I:=1 to SymbolTable.CompileCard do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsVar(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end
else
for I:=SymbolTable.CompileCard + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsVar(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkType:
begin
if Host then
for I:=1 to SymbolTable.CompileCard do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsType(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end
else
for I:=SymbolTable.CompileCard + 1 to SymbolTable.Card do
begin
if SymbolTable.IsType(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkNamespace:
begin
if Host then
begin
for I:=1 to SymbolTable.GlobalST.Card do
if SymbolTable.IsNamespace(OwnerId, I) then
if IsUsedNamespaceId(I) then
CallBack(I, Host, pmk, Data);
for I:=FirstLocalId + 1 to SymbolTable.Card do
if SymbolTable.IsNamespace(OwnerId, I) then
if IsUsedNamespaceId(I) then
CallBack(I, Host, pmk, Data);
end
else
for I:=SymbolTable.CompileCard + 1 to SymbolTable.Card do
begin
if SymbolTable.IsNamespace(OwnerId, I) then
if IsUsedNamespaceId(I) then
CallBack(I, Host, pmk, Data);
end;
end;
end;
Exit;
end;
K := SymbolTable[OwnerId].Kind;
if K in KindSUBS then
begin
case pmk of
pmkParam:
begin
Count := SymbolTable[OwnerId].Count;
if Count = 0 then
Exit;
K := 0;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
if SymbolTable.IsParam(OwnerId, I) then
begin
CallBack(I, Host, pmk, Data);
Inc(K);
if K = Count then
Exit;
end;
end;
RaiseError(errInternalError, []);
end;
pmkVar:
begin
if Host then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
if SymbolTable[I] = SymbolTable.SR0 then
break;
if SymbolTable[I].Kind = kindNAMESPACE then
break;
if SymbolTable.IsVar(OwnerId, I) and (not SymbolTable[I].Param) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkConst:
begin
if Host then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
if SymbolTable[I] = SymbolTable.SR0 then
break;
if SymbolTable[I].Kind = kindNAMESPACE then
break;
if SymbolTable.IsConst(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkType:
begin
if Host then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
if SymbolTable[I] = SymbolTable.SR0 then
break;
if SymbolTable[I].Kind = kindNAMESPACE then
break;
if SymbolTable.IsType(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkProcedure:
begin
if Host then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindSUB then
if RI.Level <> OwnerId then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsProcedure(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkFunction:
begin
if Host then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindSUB then
if RI.Level <> OwnerId then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsFunction(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
end;
end // Owner in kindSUBS
else if K = KindTYPE then
begin
FinTypeId := SymbolTable[OwnerId].FinalTypeId;
case pmk of
pmkEnumMember:
begin
if FinTypeId <> typeENUM then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind in [kindNAMESPACE, KindSUB] then
break;
if SymbolTable.IsEnumMember(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkField:
begin
if not (FinTypeId in [typeCLASS, typeRECORD]) then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsTypeField(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkProperty:
begin
if not (FinTypeId in [typeCLASS, typeRECORD, typeINTERFACE]) then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsProperty(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkProcedure:
begin
if not (FinTypeId in [typeCLASS, typeRECORD, typeINTERFACE]) then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsProcedure(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkFunction:
begin
if not (FinTypeId in [typeCLASS, typeRECORD, typeINTERFACE]) then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsFunction(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkConstructor:
begin
if not (FinTypeId in [typeCLASS, typeRECORD]) then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsConstructor(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
pmkDestructor:
begin
if not (FinTypeId in [typeCLASS, typeRECORD]) then
Exit;
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsDestructor(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
end;
end
else if K = KindNAMESPACE then
begin
case pmk of
pmkProcedure:
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsProcedure(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
pmkFunction:
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsFunction(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
pmkConst:
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsConst(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
pmkVar:
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsVar(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
pmkType:
for I:=OwnerId + 1 to SymbolTable.Card do
begin
RI := SymbolTable[I];
if RI = SymbolTable.SR0 then
break;
if RI.Kind = kindNAMESPACE then
break;
if SymbolTable.IsType(OwnerId, I) then
CallBack(I, Host, pmk, Data);
end;
end;
end;
end;
function TPaxCompilerExplorer.IsConst(LevelId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsConst(LevelId, Id);
end;
function TPaxCompilerExplorer.IsVar(LevelId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsVar(LevelId, Id);
end;
function TPaxCompilerExplorer.IsProcedure(LevelId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsProcedure(LevelId, Id);
end;
function TPaxCompilerExplorer.IsFunction(LevelId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsFunction(LevelId, Id);
end;
function TPaxCompilerExplorer.IsNamespace(LevelId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsNamespace(LevelId, Id);
end;
function TPaxCompilerExplorer.IsType(LevelId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsType(LevelId, Id);
end;
function TPaxCompilerExplorer.IsTypeField(TypeId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsTypeField(TypeId, Id);
end;
function TPaxCompilerExplorer.IsProperty(TypeId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsProperty(TypeId, Id);
end;
function TPaxCompilerExplorer.IsConstructor(TypeId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsConstructor(TypeId, Id);
end;
function TPaxCompilerExplorer.IsDestructor(TypeId, Id: Integer): Boolean;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable.IsDestructor(TypeId, Id);
end;
function TPaxCompilerExplorer.GetNamespaceId(Id: Integer): Integer;
var
R: TSymbolRec;
L: Integer;
begin
L := TKernel(compiler.GetKernelPtr).SymbolTable[Id].Level;
repeat
if L = 0 then
begin
result := 0;
Exit;
end;
R := TKernel(compiler.GetKernelPtr).SymbolTable[L];
if R.Kind = kindNAMESPACE then
begin
result := R.Id;
Exit;
end;
L := R.Level;
until false;
end;
function TPaxCompilerExplorer.GetVisibility(Id: Integer): TClassVisibility;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable[Id].Vis;
if result = cvNone then
result := cvPublic;
end;
function TPaxCompilerExplorer.GetReadId(PropId: Integer): Integer;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable[PropId].ReadId;
end;
function TPaxCompilerExplorer.GetWriteId(PropId: Integer): Integer;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable[PropId].WriteId;
end;
function TPaxCompilerExplorer.GetLevelId(Id: Integer): Integer;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable[Id].Level;
end;
function TPaxCompilerExplorer.GetAncestorId(Id: Integer): Integer;
begin
result := TKernel(compiler.GetKernelPtr).SymbolTable[Id].AncestorId;
end;
function TPaxCompilerExplorer.IsByRefParam(Id: Integer): Boolean;
var
R: TSymbolRec;
begin
R := TKernel(compiler.GetKernelPtr).SymbolTable[Id];
result := R.Param and R.ByRef;
end;
function TPaxCompilerExplorer.IsConstParam(Id: Integer): Boolean;
var
R: TSymbolRec;
begin
R := TKernel(compiler.GetKernelPtr).SymbolTable[Id];
result := R.Param and R.IsConst;
end;
function TPaxCompilerExplorer.IsMethod(Id: Integer): Boolean;
var
L: Integer;
begin
result := false;
L := TKernel(compiler.GetKernelPtr).SymbolTable[Id].Level;
if L = 0 then
Exit;
result := TKernel(compiler.GetKernelPtr).SymbolTable[L].Kind = KindTYPE;
end;
function TPaxCompilerExplorer.IsEnumType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindTYPE) and (FinalTypeId = typeENUM);
end;
function TPaxCompilerExplorer.IsAliasType(Id: Integer): Boolean;
begin
TestId(Id);
with TKernel(compiler.GetKernelPtr).SymbolTable[Id] do
result := (Kind = KindTYPE) and (TypeId = typeALIAS);
end;
procedure TPaxCompilerExplorer.ExtractMembers(const Id: Integer; L: TStrings;
PaxLang: TPaxCompilerLanguage = nil);
begin
TestId(Id);
if PaxLang = nil then
TKernel(compiler.GetKernelPtr).SymbolTable.ExtractMembers(Id, L)
else if PaxLang is TPaxPascalLanguage then
TKernel(compiler.GetKernelPtr).SymbolTable.ExtractMembers(Id, L)
else
TKernel(compiler.GetKernelPtr).SymbolTable.ExtractMembers(Id, L, lngBasic);
end;
procedure TPaxCompilerExplorer.BuildNamespaceLists;
var
I, J, Index, Id: Integer;
Code: TCode;
SymbolTable: TSymbolTable;
S: String;
begin
if compiler = nil then
Exit;
if not fExisttNamespaceLists then
begin
fUsedNamespaces.Clear;
Code := TKernel(compiler.GetKernelPtr).Code;
SymbolTable := TKernel(compiler.GetKernelPtr).SymbolTable;
for I := 1 to Code.Card do
if Code[I].Op = OP_BEGIN_USING then
begin
Id := Code[I].Arg1;
if Id = 0 then
S := 'Noname'
else
S := SymbolTable[Id].FullName;
Index := -1;
for J := 0 to fUsedNamespaces.Count - 1 do
if Id = fUsedNamespaces.Values[J] then
begin
Index := J;
break;
end;
if Index = -1 then
fUsedNamespaces.AddValue(S, Id);
end;
fNotUsedNamespaces.Clear;
I := 0;
repeat
Inc(I);
if I > SymbolTable.Card then
break;
if SymbolTable[I] = SymbolTable.SR0 then
begin
I := FirstLocalId + 1;
if I > SymbolTable.Card then
break;
end;
if SymbolTable[I].Kind = KindNAMESPACE then
begin
Id := I;
Index := -1;
for J := 0 to fUsedNamespaces.Count - 1 do
if Id = fUsedNamespaces.Values[J] then
begin
Index := J;
break;
end;
if Index = -1 then
begin
S := SymbolTable[I].FullName;
fNotUsedNamespaces.AddValue(S, Id);
end;
end;
until false;
fExisttNamespaceLists := true;
end;
end;
function TPaxCompilerExplorer.GetUsedNamespaces: TStringList;
begin
BuildNamespaceLists;
result := fUsedNamespaces.Keys;
end;
function TPaxCompilerExplorer.GetNotUsedNamespaces: TStringList;
begin
BuildNamespaceLists;
result := fNotUsedNamespaces.Keys;
end;
function TPaxCompilerExplorer.IsUsedNamespaceId(Id: Integer): Boolean;
var
J: Integer;
begin
result := false;
for J := 0 to fUsedNamespaces.Count - 1 do
if Id = fUsedNamespaces.Values[J] then
begin
result := true;
Exit;
end;
end;
end.