428 lines
15 KiB
ObjectPascal
428 lines
15 KiB
ObjectPascal
unit dpglib.TokenManager;
|
|
|
|
interface
|
|
uses
|
|
System.Classes,
|
|
System.Contnrs,
|
|
Generics.Collections,
|
|
dpgrtl.types,
|
|
dpglib.types,
|
|
dpglib.TokenSymbol;
|
|
|
|
type
|
|
TTokenManager = class( TInterfacedObject, ITokenManager)
|
|
protected
|
|
fName : AnsiString;
|
|
fMaxToken : byte;
|
|
fReadOnly : boolean;
|
|
fTool : ITool;
|
|
|
|
// fVocabulary : TStringList;
|
|
|
|
fVocabulary : TTokenIdMap;
|
|
fHashTable : TStringList;
|
|
|
|
protected
|
|
// ------------------------------------------------------------
|
|
// ITokenManager methods
|
|
// ------------------------------------------------------------
|
|
function GetName : AnsiString;
|
|
function GetReadOnly : boolean;
|
|
function GetMaxTokenType : byte;
|
|
function GetNextTokenType : byte;
|
|
function GetVocabulary : TTokenIdMap;
|
|
|
|
function GetTokenStringAt( i : integer) : AnsiString;
|
|
function GetTokenSymbolByType( t : integer) : ITokenSymbol;
|
|
function GetTokenSymbolAt( i : integer) : ITokenSymbol;
|
|
function GetTokenSymbol( Name : AnsiString) : ITokenSymbol;
|
|
function GetTokenDefined( Name : AnsiString) : boolean;
|
|
|
|
procedure SetName( Name : AnsiString);
|
|
procedure SetReadOnly( ReadOnly : boolean);
|
|
procedure SetMaxTokenType( TokenType : byte);
|
|
|
|
function Clone : ITokenManager;
|
|
|
|
function TokenSymbolKeys : TStringList;
|
|
function TokenSymbolElems : TInterfaceList;
|
|
|
|
procedure MapToTokenSymbol( Name: AnsiString; TS: ITokenSymbol);
|
|
procedure Define( TS: ITokenSymbol);
|
|
|
|
// ----------------------------------------------------------------------
|
|
// Construction/destruction
|
|
// ----------------------------------------------------------------------
|
|
public
|
|
constructor Create( pName: AnsiString; pTool: ITool);
|
|
|
|
procedure AfterConstruction; override;
|
|
procedure BeforeDestruction; override;
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
System.SysUtils;
|
|
|
|
type
|
|
TTokenManagerObject = class
|
|
private
|
|
fTokenSymbol : ITokenSymbol;
|
|
|
|
public
|
|
constructor Create( TS: ITokenSymbol);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
|
|
// @@@: Construction/destruction ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
//
|
|
// Construction/destruction
|
|
//
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ================================================================================================
|
|
// Constructor
|
|
// ================================================================================================
|
|
constructor TTokenManager.Create( pName: AnsiString; pTool: ITool);
|
|
begin
|
|
inherited Create;
|
|
|
|
fName := pName;
|
|
fTool := pTool;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// After Construction
|
|
// ================================================================================================
|
|
procedure TTokenManager.AfterConstruction;
|
|
var
|
|
ts: ITokenSymbol;
|
|
|
|
begin
|
|
inherited;
|
|
|
|
fMaxToken := TT_USER;
|
|
fReadOnly := false;
|
|
|
|
// fVocabulary := TStringList.Create;
|
|
fVocabulary := TTokenIdMap.Create;
|
|
fHashTable := TStringList.Create(true);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Define EOF symbol
|
|
// ---------------------------------------------------------------
|
|
ts := TTokenSymbol.Create('EOF');
|
|
ts.TokenType:= TT_EOF;
|
|
|
|
Define( ts);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Define <null-tree-lookahead> but only in the vocabulary vector.
|
|
// ---------------------------------------------------------------
|
|
// fVocabulary.Add('NULL_TREE_LOOKAHEAD=' + IntToStr(TT_NTLA));
|
|
fVocabulary.Add('NULL_TREE_LOOKAHEAD=', TT_NTLA);
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Before Destruction
|
|
// ================================================================================================
|
|
procedure TTokenManager.BeforeDestruction;
|
|
var
|
|
ts : ITokenSymbol;
|
|
i : integer;
|
|
|
|
begin
|
|
// for i:=0 to fHashTable.Count -1 do
|
|
// begin
|
|
// ts := ITokenSymbol( pointer( fHashTable.Objects[i]));
|
|
// ts := nil;
|
|
// end;
|
|
|
|
FreeAndNil( fVocabulary);
|
|
FreeAndNil( fHashTable);
|
|
|
|
fTool := nil;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
// @@@: ITokenManager implementation ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
//
|
|
// ITokenManager implementation
|
|
//
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ================================================================================================
|
|
// Get Name
|
|
// ================================================================================================
|
|
function TTokenManager.GetName: AnsiString;
|
|
begin
|
|
result := fName;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get ReadOnly
|
|
// ================================================================================================
|
|
function TTokenManager.GetReadOnly: boolean;
|
|
begin
|
|
result := fReadOnly;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Token String at
|
|
// ================================================================================================
|
|
function TTokenManager.GetTokenStringAt(i: integer): AnsiString;
|
|
begin
|
|
if (i>=0) and (i<fHashTable.Count)
|
|
then result := AnsiString(fHashTable.Strings[i])
|
|
else result := '';
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Token Symbol at
|
|
// ================================================================================================
|
|
function TTokenManager.GetTokenSymbolAt(i: integer): ITokenSymbol;
|
|
begin
|
|
if (i>=0) and (i<fHashTable.Count)
|
|
then result := (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol
|
|
else result := nil;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Token Symbol
|
|
// ================================================================================================
|
|
function TTokenManager.GetTokenSymbol(Name: AnsiString): ITokenSymbol;
|
|
var
|
|
i: integer;
|
|
p: pointer;
|
|
|
|
begin
|
|
i := fHashTable.IndexOf( String(Name));
|
|
|
|
if i>=0
|
|
then result := (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol
|
|
else result := nil;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Token Symbol By ID
|
|
// ================================================================================================
|
|
function TTokenManager.GetTokenSymbolByType( t: integer): ITokenSymbol;
|
|
var
|
|
i: integer;
|
|
|
|
begin
|
|
for i:=0 to fHashTable.Count -1 do
|
|
begin
|
|
result := (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol;
|
|
//ITokenSymbol( pointer( fHashTable.Objects[i]));
|
|
|
|
if result.TokenType = t then
|
|
exit;
|
|
end;
|
|
|
|
result := nil;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Token Defined
|
|
// ================================================================================================
|
|
function TTokenManager.GetTokenDefined(Name: AnsiString): boolean;
|
|
begin
|
|
result := fHashTable.IndexOf( String(Name)) >= 0
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Max Token Type
|
|
// ================================================================================================
|
|
function TTokenManager.GetMaxTokenType: byte;
|
|
begin
|
|
result := fMaxToken -1
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Next Token Type
|
|
// ================================================================================================
|
|
function TTokenManager.GetNextTokenType: byte;
|
|
begin
|
|
result := fMaxToken;
|
|
INC( fMaxToken)
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Get Vocabulary
|
|
// ================================================================================================
|
|
function TTokenManager.GetVocabulary: TTokenIdMap;
|
|
begin
|
|
result := fVocabulary
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Set Name
|
|
// ================================================================================================
|
|
procedure TTokenManager.SetName(Name: AnsiString);
|
|
begin
|
|
fName := Name
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Set ReadOnly
|
|
// ================================================================================================
|
|
procedure TTokenManager.SetReadOnly(ReadOnly: boolean);
|
|
begin
|
|
fReadOnly := ReadOnly
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Set Max TokenType
|
|
// ================================================================================================
|
|
procedure TTokenManager.SetMaxTokenType(TokenType: byte);
|
|
begin
|
|
fMaxToken := TokenType
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Clone
|
|
// ================================================================================================
|
|
function TTokenManager.Clone: ITokenManager;
|
|
var
|
|
i : integer;
|
|
ts : ITokenSymbol;
|
|
|
|
begin
|
|
result := TTokenManager.Create( fName, fTool);
|
|
|
|
// ---------------------------------------------------------------
|
|
// Clone hash table (Don't use Assign here!!!!!)
|
|
// ---------------------------------------------------------------
|
|
for i:=0 to fHashTable.Count -1 do
|
|
begin
|
|
ts := (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol;
|
|
|
|
if ts <> nil then
|
|
result.Define( ts.Clone);
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Clone vocabulary
|
|
// ---------------------------------------------------------------
|
|
// for i:=0 to fVocabulary.Count -1 do
|
|
// result.Vocabulary.Add( fVocabulary.Strings[i]);
|
|
Raise Exception.Create('Check this!!!');
|
|
|
|
// ---------------------------------------------------------------
|
|
// Set max token type
|
|
// ---------------------------------------------------------------
|
|
result.MaxTokenType := fMaxToken;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// TokenSymbolKeys
|
|
// ================================================================================================
|
|
function TTokenManager.TokenSymbolKeys: TStringList;
|
|
var
|
|
i: integer;
|
|
|
|
begin
|
|
result := TStringList.Create;
|
|
|
|
for i:=0 to fHashTable.Count -1 do
|
|
result.Add( fHashTable.Strings[i]);
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// TokenSymbolElems
|
|
// ================================================================================================
|
|
function TTokenManager.TokenSymbolElems: TInterfaceList;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := TInterfaceList.Create;
|
|
|
|
for i:=0 to fHashTable.Count-1 do
|
|
result.Add( (fHashTable.Objects[i] as TTokenManagerObject).fTokenSymbol);
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Define
|
|
// ================================================================================================
|
|
procedure TTokenManager.Define(TS: ITokenSymbol);
|
|
begin
|
|
if not fVocabulary.ContainsKey(TS.ID) then
|
|
begin
|
|
fVocabulary.Add( TS.ID, TS.TokenType);
|
|
MapToTokenSymbol( TS.ID, TS);
|
|
|
|
if fMaxToken <= TS.TokenType then
|
|
fMaxToken := TS.TokenType+1;
|
|
end;
|
|
|
|
// ---------------------------------------------------------------
|
|
// Add the symbol to the vocabulary vector and hash table
|
|
// ---------------------------------------------------------------
|
|
// if fVocabulary.IndexOfName( String(TS.ID)) < 0 then
|
|
// begin
|
|
// fVocabulary.Add( String(TS.ID) + '=' + IntToStr( TS.TokenType));
|
|
// MapToTokenSymbol( TS.ID, TS);
|
|
//
|
|
// if fMaxToken <= TS.TokenType then
|
|
// fMaxToken := TS.TokenType+1;
|
|
// end;
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Map to Token Symbol
|
|
//
|
|
// Map a label or a AnsiString to an existing token symbol.
|
|
// ================================================================================================
|
|
procedure TTokenManager.MapToTokenSymbol( Name: AnsiString; TS: ITokenSymbol);
|
|
begin
|
|
TS._AddRef;
|
|
fHashTable.AddObject( String(Name), TTokenManagerObject.Create(TS));
|
|
|
|
//// replace vocabulary item if it does exist.
|
|
// idx := fVocabulary.IndexOfName(String(TS.ID));
|
|
//
|
|
// if idx >= 0 then
|
|
// fVocabulary[idx] := pName +'='+ IntToStr( pTS.TokenType);
|
|
end;
|
|
|
|
{ TTokenManagerObject }
|
|
|
|
// @@@: TTokenManagerObject +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
//
|
|
// TTokenManagerObject
|
|
//
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
|
|
// ================================================================================================
|
|
// Constructor
|
|
// ================================================================================================
|
|
constructor TTokenManagerObject.Create(TS: ITokenSymbol);
|
|
begin
|
|
inherited Create;
|
|
fTokenSymbol := TS
|
|
end;
|
|
|
|
// ================================================================================================
|
|
// Destructor
|
|
// ================================================================================================
|
|
destructor TTokenManagerObject.Destroy;
|
|
begin
|
|
fTokenSymbol := nil;
|
|
inherited;
|
|
end;
|
|
|
|
end.
|
|
|