1717 lines
50 KiB
ObjectPascal
1717 lines
50 KiB
ObjectPascal
unit GOLDParserEngine;
|
|
|
|
{$NullBasedStrings true}
|
|
|
|
//----------------------------------------------------------------------
|
|
// Gold Parser engine for PascalABC.NET, v0.1
|
|
// Project site http://pascalabc.net/
|
|
// See more details on http://www.devincook.com/goldparser/
|
|
//
|
|
// Original code is written in VB by Devin Cook (GOLDParser@DevinCook.com)
|
|
//
|
|
// This translation is done by Tkachuk Aleksander (darkstarta@mail.ru)
|
|
//
|
|
// The translation is based on the other engine translations:
|
|
// C# engine by Vladimir Morozov (vmoroz@hotmail.com)
|
|
// Delphi engine by Alexandre Rai (riccio@gmx.at)
|
|
// C# engine by Marcus Klimstra (klimstra@home.nl)
|
|
//----------------------------------------------------------------------
|
|
|
|
interface
|
|
|
|
uses System,
|
|
System.Text,
|
|
System.IO;
|
|
|
|
const
|
|
//SymbolType enum
|
|
SymbolTypeNonTerminal = 0;
|
|
SymbolTypeTerminal = 1;
|
|
SymbolTypeWhiteSpace = 2;
|
|
SymbolTypeEnd = 3;
|
|
SymbolTypeCommentStart= 4;
|
|
SymbolTypeCommentEnd = 5;
|
|
SymbolTypeCommentLine = 6;
|
|
SymbolTypeError = 7;
|
|
//LRAction enum
|
|
LRActionNone = 0;
|
|
LRActionShift = 1;
|
|
LRActionReduce = 2;
|
|
LRActionGoto = 3;
|
|
LRActionAccept = 4;
|
|
LRActionError = 5;
|
|
//const in ObjectMap
|
|
MAXINDEX = 255;
|
|
GROWTH = 32;
|
|
MINSIZE = 32;
|
|
MAXARRAYCOUNT = 12;
|
|
INVALIDKEY = MaxInt;
|
|
//ParseMessage enum
|
|
ParseMessageEmpty = 0;
|
|
ParseMessageTokenRead = 1;
|
|
ParseMessageReduction = 2;
|
|
ParseMessageAccept = 3;
|
|
ParseMessageNotLoadedError = 4;
|
|
ParseMessageLexicalError = 5;
|
|
ParseMessageSyntaxError = 6;
|
|
ParseMessageCommentError = 7;
|
|
ParseMessageInternalError = 8;
|
|
ParseMessageCommentBlockRead = 9;
|
|
ParseMessageCommentLineRead = 10;
|
|
//enum RecordType
|
|
RecordTypeParameters = 80; //'P'
|
|
RecordTypeTableCounts = 84; //'T'
|
|
RecordTypeInitial = 73; //'I'
|
|
RecordTypeSymbols = 83; //'S'
|
|
RecordTypeCharSets = 67; //'C'
|
|
RecordTypeRules = 82; //'R'
|
|
RecordTypeDfaStates = 68; //'D'
|
|
RecordTypeLRStates = 76; //'L'
|
|
RecordTypeComment = 33; //'!'
|
|
//enum EntryType
|
|
EntryTypeEmpty = 69; //'E'
|
|
EntryTypeInteger = 73; //'I'
|
|
EntryTypeString = 83; //'S'
|
|
EntryTypeBoolean = 66; //'B'
|
|
EntryTypeByte = 98; //'b'
|
|
//enum TokenParseResult
|
|
TokenParseResultEmpty = 0;
|
|
TokenParseResultAccept = 1;
|
|
TokenParseResultShift = 2;
|
|
TokenParseResultReduceNormal = 3;
|
|
TokenParseResultReduceEliminated = 4;
|
|
TokenParseResultSyntaxError = 5;
|
|
TokenParseResultInternalError = 6;
|
|
|
|
charEnter = #13;
|
|
charReset = #10;
|
|
charTab = #9;
|
|
charEndOfFile = #0;
|
|
|
|
|
|
|
|
type
|
|
ParseMessage = integer;
|
|
TokenParseResult = integer;
|
|
|
|
Symbol = class
|
|
Index: integer; // symbol index in symbol table
|
|
Name: string; // name of the symbol
|
|
SymbolType: integer; // type of the symbol
|
|
m_text: string; // printable representation of symbol
|
|
m_quotedChars: string;
|
|
public
|
|
constructor(index:integer; name:string; symType:integer);
|
|
function IsQuotedChar(value:char): boolean;
|
|
function FormatTerminalSymbol(source:string):string;
|
|
function ToString:string; override;
|
|
end;
|
|
|
|
Entry = record //internal in ObjectMap
|
|
Key: integer;
|
|
Value: object;
|
|
end;
|
|
|
|
MapProvider = class
|
|
m_count:integer;
|
|
constructor;begin end;
|
|
function GetIndex(key:integer):object;virtual;
|
|
property Index[i:integer]:object read GetIndex; default;
|
|
function GetEntry(key:integer):Entry;virtual;
|
|
procedure Add(key:integer;value:object);virtual;
|
|
procedure Remove(key:integer);virtual;
|
|
end;
|
|
|
|
SortedMapProvider = class(MapProvider)
|
|
m_entries: array of Entry;
|
|
m_lastKey:integer;
|
|
constructor(capacity:integer);
|
|
function GetIndex(key:integer):object; override;//possible error!
|
|
function GetEntry(key:integer):Entry;override;
|
|
procedure Add(key:integer;value:object);override;
|
|
procedure Remove(key:integer);virtual;
|
|
function FindIndex(key:integer):integer; //possible error!
|
|
function FindInsertIndex(key:integer;var found:boolean):integer;//possible error!
|
|
end;
|
|
|
|
IndexMapProvider = class(MapProvider)
|
|
m_array: array of object;
|
|
constructor;
|
|
function GetIndex(key:integer):object; override;
|
|
function GetEntry(key:integer):Entry;override;
|
|
procedure Add(key:integer;value:object);override;
|
|
end;
|
|
|
|
ArrayMapProvider = class(MapProvider)
|
|
m_entries: array of Entry;
|
|
constructor(capacity:integer);
|
|
function GetIndex(key:integer):object; override;
|
|
function GetEntry(key:integer):Entry;override;
|
|
procedure Add(key:integer;value:object);override;
|
|
end;
|
|
|
|
Unassigned = class
|
|
constructor;begin end;
|
|
end;
|
|
|
|
ObjectMap = class
|
|
m_readonly: boolean;
|
|
m_mapProvider: MapProvider;
|
|
constructor;
|
|
function getCount:integer;
|
|
property Count:integer read GetCount;
|
|
procedure SetReadOnly(value: boolean);
|
|
function GetIndex(key:integer):object;
|
|
procedure SetIndex(key:integer; value:object);
|
|
property ReadOnly:boolean read m_readonly write SetReadOnly;
|
|
public
|
|
property Index[i:integer]:object read GetIndex write SetIndex; default;
|
|
function GetKey(index:integer):integer;
|
|
procedure Remove(key:integer);
|
|
procedure Add(key:integer;value:object);
|
|
procedure SetMapProvider(readOnly:boolean);
|
|
end;
|
|
|
|
DfaState = class
|
|
Index: integer;
|
|
AcceptSymbol: Symbol;
|
|
m_transitionVector: ObjectMap;
|
|
constructor(Index:integer;acceptSymbol:Symbol;transitionVector:ObjectMap);
|
|
end;
|
|
|
|
LRStateAction = class
|
|
Index: integer;
|
|
StateSymbol: Symbol;
|
|
Action: integer;
|
|
Value: integer;
|
|
constructor(Index:integer;StateSymbol:Symbol;Action:integer;Value:integer);
|
|
end;
|
|
|
|
LRState = class
|
|
Index: integer;
|
|
m_actions: array of LRStateAction;
|
|
m_transitionVector: array of LRStateAction;
|
|
constructor(Index:integer; actions: array of LRStateAction; transitionVector: array of LRStateAction);
|
|
function ActionCount: integer;
|
|
function GetAction(index:integer): LRStateAction;
|
|
function GetActionBySymbolIndex(symbolIndex:integer): LRStateAction;
|
|
end;
|
|
|
|
Rule = class
|
|
Index: integer;
|
|
NonTerminal: Symbol;
|
|
m_symbols: array of Symbol;
|
|
ContainsOneNonTerminal: boolean;
|
|
m_hasEmpty: boolean;
|
|
public
|
|
constructor(index:integer; nonTerminal:Symbol; symbols: array of Symbol);
|
|
function GetIndex(key:integer):Symbol;
|
|
property this[i:integer]:Symbol read GetIndex; default;
|
|
function Name:string;
|
|
function Count:integer;
|
|
function Definition:string;
|
|
function ToString:string;override;
|
|
end;
|
|
|
|
DfaEdge = record
|
|
CharSetIndex: integer;
|
|
TargetIndex: integer;
|
|
end;
|
|
|
|
Grammar = class
|
|
Name: string; // Name of the grammar
|
|
Version: string; // Version of the grammar
|
|
Author: string; // Author of the grammar
|
|
About: string; // Grammar description
|
|
m_startSymbolIndex: integer; // Start symbol index
|
|
CaseSensitive: boolean; // Grammar is case sensitive or not
|
|
// Tables read from the binary grammar file
|
|
m_symbolTable: array of Symbol; // Symbol table
|
|
m_charSetTable: array of string; // Charset table
|
|
m_ruleTable: array of Rule; // Rule table
|
|
m_dfaStateTable: array of DfaState; // DFA state table
|
|
m_lrStateTable: array of LRState; // LR state table
|
|
// Initial states
|
|
m_dfaInitialStateIndex: integer; // DFA initial state index
|
|
DfaInitialState: DfaState; // DFA initial state
|
|
m_lrInitialState: integer; // LR initial state
|
|
// Internal state of grammar parser
|
|
m_reader: BinaryReader; // Source of the grammar
|
|
m_entryCount: integer; // Number of entries left
|
|
m_errorSymbol: Symbol;
|
|
EndSymbol: Symbol;
|
|
constructor(reader:BinaryReader);
|
|
function FileHeader:string;
|
|
function StartSymbol:Symbol;
|
|
function InitialLRState:LRState;
|
|
private
|
|
procedure Load;
|
|
function ReadNextRecord:integer;
|
|
procedure ReadHeader;
|
|
procedure ReadTableCounts;
|
|
procedure ReadInitialStates;
|
|
procedure ReadSymbols;
|
|
procedure ReadCharSets;
|
|
procedure ReadRules;
|
|
procedure ReadDfaStates;
|
|
procedure ReadLRStates;
|
|
function CreateDfaTransitionVector(edges: array of DfaEdge):ObjectMap;
|
|
procedure ReadEmptyEntry;
|
|
function ReadStringEntry:string;
|
|
function ReadInt16Entry:integer;
|
|
function ReadByteEntry:byte;
|
|
function ReadBoolEntry:boolean;
|
|
function ReadEntryType:integer;
|
|
function ReadString:string;
|
|
function ReadInt16:integer;
|
|
function ReadByte:byte;
|
|
function ReadBool:boolean;
|
|
procedure OptimizeDfaTransitionVectors;
|
|
end;
|
|
|
|
xParser = object;//class!
|
|
SourceLineReadCallback = procedure(pars: xParser; lineStart,lineLength:integer);
|
|
|
|
//internal in Parser
|
|
Token = record
|
|
m_symbol: Symbol; // Token symbol.
|
|
m_text: string; // Token text.
|
|
m_start: integer; // Token start stream start.
|
|
m_length: integer; // Token length.
|
|
m_lineNumber: integer; // Token source line number. (1-based).
|
|
m_linePosition: integer;// Token position in source line (1-based).
|
|
m_syntaxNode: object; // Syntax node which can be attached to the token.
|
|
end;
|
|
//internal in Parser
|
|
LRStackItem = record
|
|
m_token: Token; // Token in the LR stack item.
|
|
m_state: LRState; // LR state associated with the item.
|
|
m_rule: Rule; // Reference to a grammar rule if the item contains non-terminal.
|
|
end;
|
|
|
|
LALRParser = class
|
|
m_grammar: Grammar; // Grammar of parsed language.
|
|
TrimReductions: boolean; // Allowes to minimize reduction tree.
|
|
m_textReader: System.IO.TextReader;// Data to parse.
|
|
m_buffer: array of char; // Buffer to keep current characters.
|
|
m_bufferSize, // Size of the buffer.
|
|
m_bufferStartIndex, // Absolute position of buffered first character.
|
|
m_charIndex, // Index of character in the buffer.
|
|
m_preserveChars, // Number of characters to preserve when buffer is refilled.
|
|
m_lineStart, // Relative position of line start to the buffer beginning.
|
|
m_lineLength, // Length of current source line.
|
|
m_lineNumber, // Current line number.
|
|
m_commentLevel: integer; // Keeps stack level for embedded comments
|
|
m_commentText: StringBuilder; // Current comment text.
|
|
SourceLineReadWenLineRead: SourceLineReadCallback;// Called when line reading finished.
|
|
m_token: Token; // Current token
|
|
m_inputTokens: array of Token; // Stack of input tokens.
|
|
m_inputTokenCount: integer; // How many tokens in the input.
|
|
m_lrStack: array of LRStackItem;// Stack of LR states used for LR parsing.
|
|
m_lrStackIndex: integer; // Index of current LR state in the LR parsing stack.
|
|
m_lrState: LRState; // Current LR state.
|
|
m_reductionCount: integer; // Number of items in reduction. It is Undefined if no reducton available.
|
|
m_expectedTokens: array of Symbol;// What tokens are expected in case of error?
|
|
const MinimumBufferSize = 4096; // Minimum size of char buffer.
|
|
const EndOfString:char = char(0);// Designates last string terminator.
|
|
const MinimumInputTokenCount = 2;// Minimum input token stack size.
|
|
const MinimumLRStackSize = 256; // Minimum size of reduction stack.
|
|
const Undefined = -1; // Used for undefined int values.
|
|
|
|
|
|
constructor(tr:TextReader;grm:Grammar);
|
|
function LanguageGrammar: Grammar;
|
|
function TextReader: System.IO.TextReader;
|
|
function CharPosition: integer;
|
|
function LineNumber: integer; // Gets current line number. It is 1-based.
|
|
function LinePosition: integer; // Gets current char position in the current source line. It is 1-based.
|
|
function LineText: string; // Gets current source line text. It can be truncated if line is longer than 2048 characters.
|
|
function ReadBuffer: integer; // Reads next characters to the buffer.
|
|
procedure MoveBy(delta:integer);// Increments current char index by delta character positions.
|
|
procedure MoveToLineEnd; // Moves current char pointer to the end of source line.
|
|
procedure SetTokenSymbol(value:Symbol);
|
|
function GetTokenSymbol: Symbol;
|
|
property TokenSymbol:Symbol read GetTokenSymbol write SetTokenSymbol;
|
|
function GetTokenText: string;
|
|
procedure SetTokenText(text:string);
|
|
property TokenText:string read GetTokenText write SetTokenText;// Gets or sets current token text.
|
|
function GetTokenSyntaxNode: object;
|
|
procedure SetTokenSyntaxNode(text:object);
|
|
property TokenSyntaxNode:object read GetTokenSyntaxNode write SetTokenSyntaxNode;// Gets or sets token syntax object associated with the current token or reduction.
|
|
function TokenString: string;// Returns string representation of the token.
|
|
procedure PushInputToken(sym:Symbol; text:string; syntaxNode:object);// Pushes a token to the input token stack.
|
|
function PopInputToken: Symbol; // Pops token from the input token stack.
|
|
function ReadToken: Symbol; // Reads next token from the input stream.
|
|
procedure DiscardInputToken; // Removes current token and pops next token from the input stack.
|
|
function CurrentLRState: LRState;
|
|
function ReductionRule: Rule;
|
|
function ReductionCount: integer;
|
|
function GetReductionSyntaxNode(index:integer):object;
|
|
function GetExpectedTokens:array of Symbol;
|
|
function Parse: ParseMessage;// Executes next step of parser and returns parser state.
|
|
procedure ProcessBlockComment;
|
|
function CommentText: string;// Gets current comment text.
|
|
function ParseToken: TokenParseResult;
|
|
|
|
/// <summary>
|
|
/// Gets or sets current token position relative to input stream beginning.
|
|
/// </summary>
|
|
// public int TokenCharPosition
|
|
// {
|
|
// get { return m_token.m_start; }
|
|
// set { m_token.m_start = value; }
|
|
// }
|
|
|
|
/// <summary>
|
|
/// Gets or sets current token text length.
|
|
/// </summary>
|
|
// public int TokenLength
|
|
// {
|
|
// get { return m_token.m_length; }
|
|
// set { m_token.m_length = value; }
|
|
// }
|
|
|
|
/// <summary>
|
|
/// Gets or sets current token line number. It is 1-based.
|
|
/// </summary>
|
|
// public int TokenLineNumber
|
|
// {
|
|
// get { return m_token.m_lineNumber; }
|
|
// set { m_token.m_lineNumber = value; }
|
|
// }
|
|
|
|
/// <summary>
|
|
/// Gets or sets current token position in current source line. It is 1-based.
|
|
/// </summary>
|
|
// public int TokenLinePosition
|
|
// {
|
|
// get { return m_token.m_linePosition; }
|
|
// set { m_token.m_linePosition = value; }
|
|
// }
|
|
|
|
end;
|
|
|
|
|
|
var UnassignedValue: Unassigned;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//Symbol members
|
|
//------------------------------------------------------------------------------
|
|
constructor Symbol.Create(index:integer; name:string; symType:integer);
|
|
begin
|
|
m_quotedChars := '|-+*?()[]{}<>!';
|
|
self.Index := index;
|
|
self.Name := name;
|
|
self.SymbolType := symType;
|
|
end;
|
|
|
|
function Symbol.IsQuotedChar(value:char): boolean;
|
|
begin
|
|
result := m_quotedChars.IndexOf(value) >= 0;
|
|
end;
|
|
|
|
function Symbol.FormatTerminalSymbol(source:string):string;
|
|
var res: StringBuilder;
|
|
i: integer;
|
|
ch: char;
|
|
begin
|
|
res := new StringBuilder;
|
|
for i:=0 to source.Length-1 do begin//string[0]
|
|
ch := source[i];
|
|
if ch = '''' then
|
|
res.Append('''')
|
|
else
|
|
if IsQuotedChar(ch) or (ch = '"') then
|
|
res.Append('''' + ch + '''')
|
|
else
|
|
res.Append(ch);
|
|
end;
|
|
result := res.ToString;
|
|
end;
|
|
|
|
function Symbol.ToString:string;
|
|
begin
|
|
if m_text=nil then
|
|
case SymbolType of
|
|
SymbolTypeNonTerminal:
|
|
m_text := '<' + Name + '>';
|
|
SymbolTypeTerminal:
|
|
m_text := FormatTerminalSymbol(Name);
|
|
else
|
|
m_text := '(' + Name + ')';
|
|
end;
|
|
result := m_text;
|
|
end;
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//MapProvider members
|
|
//------------------------------------------------------------------------------
|
|
function MapProvider.GetIndex(key:integer):object;
|
|
begin
|
|
result := -1;
|
|
end;
|
|
|
|
function MapProvider.GetEntry(key:integer):Entry;
|
|
begin
|
|
end;
|
|
|
|
procedure MapProvider.Add(key:integer;value:object);
|
|
begin
|
|
end;
|
|
|
|
procedure MapProvider.Remove(key:integer);
|
|
begin
|
|
raise new System.InvalidOperationException();
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
//SortedMapProvider members
|
|
//------------------------------------------------------------------------------
|
|
|
|
constructor SortedMapProvider.Create(capacity:integer);
|
|
begin
|
|
SetLength(m_entries, capacity);
|
|
end;
|
|
|
|
function SortedMapProvider.GetIndex(key:integer):object; //override;//possible error!
|
|
var minIndex,maxIndex,midIndex:integer;
|
|
begin
|
|
minIndex := 0;
|
|
maxIndex := m_count - 1;
|
|
result := nil;
|
|
if (maxIndex >= 0) and (key <= m_lastKey) then begin
|
|
while minIndex < maxIndex do begin
|
|
midIndex := (maxIndex + minIndex) div 2;
|
|
if key <= m_entries[midIndex].Key then
|
|
maxIndex := midIndex
|
|
else
|
|
minIndex := midIndex + 1;
|
|
end;
|
|
if key = m_entries[minIndex].Key then
|
|
result := m_entries[minIndex].Value;
|
|
end;
|
|
end;
|
|
|
|
function SortedMapProvider.GetEntry(key:integer):Entry;//override;
|
|
begin
|
|
result := m_entries[key];
|
|
end;
|
|
|
|
procedure SortedMapProvider.Add(key:integer;value:object);//override;
|
|
var found: boolean;
|
|
index: integer;
|
|
entries: array of Entry;
|
|
begin
|
|
index := FindInsertIndex(key, found);
|
|
if found then begin
|
|
m_entries[index].Value := value;
|
|
exit;
|
|
end;
|
|
if m_count >= m_entries.Length then begin
|
|
SetLength(entries,m_entries.Length + GROWTH);
|
|
System.Array.Copy(m_entries, 0, entries, 0, m_entries.Length);
|
|
m_entries := entries;
|
|
end;
|
|
if index < m_count then
|
|
System.Array.Copy(m_entries, index, m_entries, index + 1, m_count - index)
|
|
else
|
|
m_lastKey := key;
|
|
m_entries[index].Key := key;
|
|
m_entries[index].Value := value;
|
|
m_count := m_count + 1;
|
|
end;
|
|
|
|
procedure SortedMapProvider.Remove(key:integer);//virtual;
|
|
var index,tailSize: integer;
|
|
begin
|
|
index := FindIndex(key);
|
|
if index >= 0 then begin
|
|
tailSize := (m_count - 1) - index;
|
|
if tailSize > 0 then begin
|
|
System.Array.Copy(m_entries, index + 1, m_entries, index, tailSize);
|
|
end else
|
|
if m_count > 1 then begin
|
|
m_lastKey := m_entries[m_count - 2].Key;
|
|
end else begin
|
|
m_lastKey := INVALIDKEY;
|
|
end;
|
|
m_count := m_count - 1;
|
|
m_entries[m_count].Key := INVALIDKEY;
|
|
m_entries[m_count].Value := nil;
|
|
end;
|
|
end;
|
|
|
|
function SortedMapProvider.FindIndex(key:integer):integer; //possible error!
|
|
var minIndex,maxIndex,midIndex: integer;
|
|
begin
|
|
minIndex := 0;
|
|
result := -1;
|
|
if (m_count > 0) and (key <= m_lastKey) then begin
|
|
maxIndex := m_count - 1;
|
|
while minIndex < maxIndex do begin
|
|
midIndex := (maxIndex + minIndex) div 2;
|
|
if key <= m_entries[midIndex].Key then
|
|
maxIndex := midIndex
|
|
else
|
|
minIndex := midIndex + 1;
|
|
end;
|
|
if key = m_entries[minIndex].Key then
|
|
result := minIndex;
|
|
end;
|
|
end;
|
|
|
|
function SortedMapProvider.FindInsertIndex(key:integer;var found:boolean):integer;//possible error!
|
|
var minIndex,maxIndex,midIndex: integer;
|
|
begin
|
|
minIndex := 0;
|
|
found := false;
|
|
result := m_count;
|
|
if (m_count > 0) and (key <= m_lastKey) then begin
|
|
maxIndex := m_count - 1;
|
|
while minIndex < maxIndex do begin
|
|
midIndex := (maxIndex + minIndex) div 2;
|
|
if key <= m_entries[midIndex].Key then
|
|
maxIndex := midIndex
|
|
else
|
|
minIndex := midIndex + 1;
|
|
end;
|
|
found := key = m_entries[minIndex].Key;
|
|
result := minIndex;
|
|
end;
|
|
end;
|
|
|
|
//------------------------------------------------------------------------------
|
|
//IndexMapProvider members
|
|
//------------------------------------------------------------------------------
|
|
constructor IndexMapProvider.Create;
|
|
var i: integer;
|
|
begin
|
|
SetLength(m_array,MAXINDEX + 1);
|
|
for i:=0 to m_array.Length-1 do
|
|
m_array[i] := UnassignedValue;
|
|
end;
|
|
|
|
function IndexMapProvider.GetIndex(key:integer):object; //override;
|
|
begin
|
|
if (key >= m_array.Length) or (key < 0) then
|
|
result := nil
|
|
else
|
|
result := m_array[key];
|
|
end;
|
|
|
|
function IndexMapProvider.GetEntry(key:integer):Entry;//override;
|
|
var idx,i: integer;
|
|
value: object;
|
|
entr: Entry;
|
|
begin
|
|
idx := -1;
|
|
result := entr;
|
|
for i := 0 to m_array.Length-1 do begin
|
|
value := m_array[i];
|
|
if value <> UnassignedValue then
|
|
idx := idx +1;
|
|
if idx = key then begin
|
|
entr.key := i;
|
|
entr.value := value;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure IndexMapProvider.Add(key:integer;value:object);//override;
|
|
begin
|
|
m_array[key] := value;
|
|
m_count := m_count + 1;
|
|
end;
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//ArrayMapProvider members
|
|
//------------------------------------------------------------------------------
|
|
constructor ArrayMapProvider.Create(capacity:integer);
|
|
begin
|
|
SetLength(m_entries,capacity);
|
|
end;
|
|
|
|
function ArrayMapProvider.GetIndex(key:integer):object; //override;
|
|
var i,entryKey:integer;
|
|
entr: Entry;
|
|
begin
|
|
i := m_count;
|
|
result := nil;
|
|
while i>0 do begin
|
|
i := i - 1;
|
|
entr := m_entries[i];
|
|
entryKey := entr.Key;
|
|
if entryKey < key then begin
|
|
continue;
|
|
end else
|
|
if entryKey = key then begin
|
|
result := entr.Value;
|
|
break;
|
|
end else
|
|
if entryKey > key then begin
|
|
result := nil;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ArrayMapProvider.GetEntry(key:integer):Entry;//override;
|
|
begin
|
|
result := m_entries[key];
|
|
end;
|
|
|
|
procedure ArrayMapProvider.Add(key:integer;value:object);//override;
|
|
begin
|
|
m_entries[m_count].Key := key;
|
|
m_entries[m_count].Value := value;
|
|
m_count := m_count +1;
|
|
end;
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//ObjectMap members
|
|
//------------------------------------------------------------------------------
|
|
constructor ObjectMap.Create;
|
|
begin
|
|
m_mapProvider := new SortedMapProvider(MINSIZE);
|
|
end;
|
|
|
|
function ObjectMap.getCount:integer;
|
|
begin
|
|
result := m_mapProvider.m_count;
|
|
end;
|
|
|
|
procedure ObjectMap.SetReadOnly(value: boolean);
|
|
begin
|
|
if m_readonly<>value then
|
|
SetMapProvider(value);
|
|
m_readonly := value;
|
|
end;
|
|
|
|
function ObjectMap.GetIndex(key:integer):object;
|
|
begin
|
|
result := m_mapProvider[key];
|
|
end;
|
|
|
|
procedure ObjectMap.SetIndex(key:integer; value:object);
|
|
begin
|
|
m_mapProvider.Add(key, value);
|
|
end;
|
|
|
|
function ObjectMap.GetKey(index:integer):integer;
|
|
begin
|
|
result := m_mapProvider.GetEntry(index).Key;
|
|
end;
|
|
|
|
procedure ObjectMap.Remove(key:integer);
|
|
begin
|
|
m_mapProvider.Remove(key);
|
|
end;
|
|
|
|
procedure ObjectMap.Add(key:integer;value:object);
|
|
begin
|
|
m_mapProvider.Add(key, Entry(value));
|
|
end;
|
|
|
|
procedure ObjectMap.SetMapProvider(readOnly:boolean);
|
|
var i,count: integer;
|
|
provider: MapProvider;
|
|
pr: SortedMapProvider;
|
|
entr:Entry;
|
|
begin
|
|
count := m_mapProvider.m_count;
|
|
provider := m_mapProvider;
|
|
if readOnly then begin
|
|
pr := m_mapProvider as SortedMapProvider;
|
|
if pr.m_lastKey <= MAXINDEX then begin
|
|
provider := new IndexMapProvider;
|
|
end else
|
|
if (count <= MAXARRAYCOUNT) then begin
|
|
provider := new ArrayMapProvider(m_mapProvider.m_count);
|
|
end;
|
|
end else begin
|
|
if not (provider is SortedMapProvider) then
|
|
provider := new SortedMapProvider(m_mapProvider.m_count);
|
|
end;
|
|
if provider <> m_mapProvider then begin
|
|
for i:=0 to count-1 do begin
|
|
entr := m_mapProvider.GetEntry(i);
|
|
provider.Add(entr.Key, entr.Value);
|
|
end;
|
|
m_mapProvider := provider;
|
|
end;
|
|
end;
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//DFAState members
|
|
//------------------------------------------------------------------------------
|
|
constructor DFAState.Create(Index:integer;acceptSymbol:Symbol;transitionVector:ObjectMap);
|
|
begin
|
|
self.Index := Index;
|
|
self.AcceptSymbol := AcceptSymbol;
|
|
m_transitionVector := transitionVector;
|
|
end;
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//LRStateAction members
|
|
//------------------------------------------------------------------------------
|
|
constructor LRStateAction.Create(Index:integer;StateSymbol:Symbol;Action:integer;Value:integer);
|
|
begin
|
|
self.Index := Index;
|
|
self.StateSymbol := StateSymbol;
|
|
self.Action := Action;
|
|
self.Value := Value;
|
|
end;
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//LRState members
|
|
//------------------------------------------------------------------------------
|
|
constructor LRState.Create(Index:integer; actions: array of LRStateAction; transitionVector: array of LRStateAction);
|
|
begin
|
|
self.Index := index;
|
|
m_actions := actions;
|
|
m_transitionVector := transitionVector;
|
|
end;
|
|
|
|
function LRState.ActionCount: integer;
|
|
begin
|
|
result := m_actions.Length;
|
|
end;
|
|
|
|
function LRState.GetAction(index:integer): LRStateAction;
|
|
begin
|
|
result := m_actions[index];
|
|
end;
|
|
|
|
function LRState.GetActionBySymbolIndex(symbolIndex:integer): LRStateAction;
|
|
begin
|
|
result := m_transitionVector[symbolIndex];
|
|
end;
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//Rule members
|
|
//------------------------------------------------------------------------------
|
|
constructor Rule.Create(index:integer; nonTerminal:Symbol; symbols: array of Symbol);
|
|
begin
|
|
self.Index := Index;
|
|
self.NonTerminal := nonTerminal;
|
|
m_symbols := symbols;
|
|
ContainsOneNonTerminal := (symbols.Length = 1) and (symbols[0].SymbolType = SymbolTypeNonTerminal);
|
|
m_hasEmpty := symbols.Length = 0;// && m_nonTerminal.Name == "empty";
|
|
end;
|
|
|
|
function Rule.Name:string;
|
|
begin
|
|
result := '<' + NonTerminal.Name + '>';
|
|
end;
|
|
|
|
function Rule.Count:integer;
|
|
begin
|
|
result := m_symbols.Length;
|
|
end;
|
|
|
|
function Rule.GetIndex(key:integer):Symbol;
|
|
begin
|
|
result := m_symbols[index];
|
|
end;
|
|
|
|
function Rule.Definition:string;
|
|
var res:StringBuilder;
|
|
i:integer;
|
|
begin
|
|
res := new StringBuilder;
|
|
for i:=0 to m_symbols.Length-1 do begin
|
|
res.Append(m_symbols[i].ToString);
|
|
if i < m_symbols.Length - 1 then
|
|
res.Append(' ');
|
|
end;
|
|
result := res.ToString;
|
|
end;
|
|
|
|
function Rule.ToString:string;
|
|
begin
|
|
result := Name + ' ::= ' + Definition;
|
|
end;
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//Grammar members
|
|
//------------------------------------------------------------------------------
|
|
constructor Grammar.Create(reader:BinaryReader);
|
|
begin
|
|
if reader = nil then
|
|
raise new System.ArgumentNullException('reader');
|
|
m_reader := reader;
|
|
Load;
|
|
end;
|
|
|
|
function Grammar.FileHeader:string;
|
|
begin
|
|
result := 'GOLD Parser Tables/v1.0';
|
|
end;
|
|
function Grammar.StartSymbol:Symbol;
|
|
begin
|
|
result := m_symbolTable[m_startSymbolIndex];
|
|
end;
|
|
function Grammar.InitialLRState:LRState;
|
|
begin
|
|
result := m_lrStateTable[m_lrInitialState];
|
|
end;
|
|
|
|
|
|
procedure Grammar.Load;
|
|
var recordType: integer;
|
|
begin
|
|
if FileHeader<>ReadString then
|
|
raise new FileLoadException('GPBLALRParser.GrammarWrongFileHeader');
|
|
while m_reader.PeekChar <> -1 do begin
|
|
recordType := ReadNextRecord;
|
|
case recordType of
|
|
RecordTypeParameters: ReadHeader;
|
|
RecordTypeTableCounts: ReadTableCounts;
|
|
RecordTypeInitial: ReadInitialStates;
|
|
RecordTypeSymbols: ReadSymbols;
|
|
RecordTypeCharSets: ReadCharSets;
|
|
RecordTypeRules: ReadRules;
|
|
RecordTypeDfaStates: ReadDfaStates;
|
|
RecordTypeLRStates: ReadLRStates;
|
|
else
|
|
raise new FileLoadException('GPBLALRParser.GrammarInvalidRecordType');
|
|
end;
|
|
end;
|
|
DfaInitialState := m_dfaStateTable[m_dfaInitialStateIndex];
|
|
OptimizeDfaTransitionVectors;
|
|
end;
|
|
|
|
function Grammar.ReadNextRecord:integer;
|
|
var recordType:char;
|
|
begin
|
|
recordType := char(m_reader.ReadByte);
|
|
case recordType of
|
|
'M': begin
|
|
m_entryCount := ReadInt16;
|
|
result := ReadByteEntry;
|
|
end;
|
|
else
|
|
raise new FileLoadException('GPBLALRParser.Grammar_InvalidRecordHeader');
|
|
end;
|
|
end;
|
|
|
|
procedure Grammar.ReadHeader;
|
|
begin
|
|
Name := ReadStringEntry;
|
|
Version := ReadStringEntry;
|
|
Author := ReadStringEntry;
|
|
About := ReadStringEntry;
|
|
CaseSensitive := ReadBoolEntry;
|
|
m_startSymbolIndex := ReadInt16Entry;
|
|
end;
|
|
|
|
procedure Grammar.ReadTableCounts;
|
|
begin
|
|
SetLength(m_symbolTable ,ReadInt16Entry);
|
|
SetLength(m_charSetTable ,ReadInt16Entry);
|
|
SetLength(m_ruleTable ,ReadInt16Entry);
|
|
SetLength(m_dfaStateTable ,ReadInt16Entry);
|
|
SetLength(m_lrStateTable ,ReadInt16Entry);
|
|
end;
|
|
|
|
procedure Grammar.ReadInitialStates;
|
|
begin
|
|
m_dfaInitialStateIndex := ReadInt16Entry;
|
|
m_lrInitialState := ReadInt16Entry;
|
|
end;
|
|
|
|
procedure Grammar.ReadSymbols;
|
|
var index: integer;
|
|
name: string;
|
|
symbolType: integer;
|
|
sym: Symbol;
|
|
begin
|
|
index := ReadInt16Entry;
|
|
name := ReadStringEntry;
|
|
symbolType := ReadInt16Entry;
|
|
sym := new Symbol(index, name, symbolType);
|
|
case symbolType of
|
|
SymbolTypeError: m_errorSymbol := sym;
|
|
SymbolTypeEnd: EndSymbol := sym;
|
|
end;
|
|
m_symbolTable[index] := sym;
|
|
end;
|
|
|
|
procedure Grammar.ReadCharSets;
|
|
begin
|
|
m_charSetTable[ReadInt16Entry] := ReadStringEntry;
|
|
end;
|
|
|
|
procedure Grammar.ReadRules;
|
|
var i,index: integer;
|
|
nonTerminal: Symbol;
|
|
symbols: array of Symbol;
|
|
begin
|
|
index := ReadInt16Entry;
|
|
nonTerminal := m_symbolTable[ReadInt16Entry];
|
|
ReadEmptyEntry;
|
|
SetLength(symbols,m_entryCount);
|
|
for i:=0 to symbols.Length-1 do
|
|
symbols[i] := m_symbolTable[ReadInt16Entry];
|
|
m_ruleTable[index] := new Rule(index, nonTerminal, symbols);
|
|
end;
|
|
|
|
procedure Grammar.ReadDfaStates;
|
|
var i,index: integer;
|
|
acceptSymbol: Symbol;
|
|
acceptState: boolean;
|
|
edges: array of DfaEdge;
|
|
transitionVector: ObjectMap;
|
|
begin
|
|
index := ReadInt16Entry;
|
|
acceptSymbol := nil;
|
|
acceptState := ReadBoolEntry;
|
|
if acceptState then
|
|
acceptSymbol := m_symbolTable[ReadInt16Entry]
|
|
else
|
|
ReadInt16Entry;
|
|
ReadEmptyEntry;
|
|
// Read DFA edges
|
|
SetLength(edges,m_entryCount div 3);
|
|
for i:=0 to edges.Length-1 do begin
|
|
edges[i].CharSetIndex := ReadInt16Entry;
|
|
edges[i].TargetIndex := ReadInt16Entry;
|
|
ReadEmptyEntry;
|
|
end;
|
|
// Create DFA state and store it in DFA state table
|
|
transitionVector := CreateDfaTransitionVector(edges);
|
|
m_dfaStateTable[index] := new DfaState(index, acceptSymbol, transitionVector);
|
|
end;
|
|
|
|
procedure Grammar.ReadLRStates;
|
|
var targetIndex,i,index: integer;
|
|
stateTable: array of LRStateAction;
|
|
transitionVector: array of LRStateAction;
|
|
sym: Symbol;
|
|
action: integer;
|
|
begin
|
|
index := ReadInt16Entry;
|
|
ReadEmptyEntry;
|
|
SetLength(stateTable, m_entryCount div 4);
|
|
for i:=0 to stateTable.Length-1 do begin
|
|
sym := m_symbolTable[ReadInt16Entry];
|
|
action := ReadInt16Entry;
|
|
targetIndex := ReadInt16Entry;
|
|
ReadEmptyEntry();
|
|
stateTable[i] := new LRStateAction(i, sym, action, targetIndex);
|
|
end;
|
|
// Create the transition vector
|
|
SetLength(transitionVector,m_symbolTable.Length);
|
|
for i:=0 to transitionVector.Length-1 do
|
|
transitionVector[i] := nil;
|
|
for i:=0 to stateTable.Length-1 do
|
|
transitionVector[stateTable[i].StateSymbol.Index] := stateTable[i];
|
|
m_lrStateTable[index] := new LRState(index, stateTable, transitionVector);
|
|
end;
|
|
|
|
function Grammar.CreateDfaTransitionVector(edges: array of DfaEdge):ObjectMap;
|
|
var i,j: integer;
|
|
charSet: string;
|
|
begin
|
|
result := new ObjectMap;
|
|
i := edges.Length;
|
|
while i > 0 do begin
|
|
i := i - 1;
|
|
charSet := m_charSetTable[edges[i].CharSetIndex];
|
|
for j:=0 to charSet.Length-1 do
|
|
result[integer(charSet[j])] := edges[i].TargetIndex;
|
|
end;
|
|
end;
|
|
|
|
procedure Grammar.ReadEmptyEntry;
|
|
begin
|
|
if ReadEntryType<>EntryTypeEmpty then
|
|
raise new FileLoadException('GPBLALRParser.GrammarEmptyEntryExpected');
|
|
m_entryCount := m_entryCount - 1;
|
|
end;
|
|
|
|
function Grammar.ReadStringEntry:string;
|
|
begin
|
|
if ReadEntryType<>EntryTypeString then
|
|
raise new FileLoadException('GPBLALRParser.GrammarStringEntryExpected');
|
|
m_entryCount := m_entryCount - 1;
|
|
result := ReadString;
|
|
end;
|
|
|
|
function Grammar.ReadInt16Entry:integer;
|
|
begin
|
|
if ReadEntryType<>EntryTypeInteger then
|
|
raise new FileLoadException('GPBLALRParser.GrammarIntegerEntryExpected');
|
|
m_entryCount := m_entryCount - 1;
|
|
result := ReadInt16;
|
|
end;
|
|
|
|
function Grammar.ReadByteEntry:byte;
|
|
begin
|
|
if ReadEntryType<>EntryTypeByte then
|
|
raise new FileLoadException('GPBLALRParser.GrammarByteEntryExpected');
|
|
m_entryCount := m_entryCount - 1;
|
|
result := ReadByte;
|
|
end;
|
|
|
|
function Grammar.ReadBoolEntry:boolean;
|
|
begin
|
|
if ReadEntryType<>EntryTypeBoolean then
|
|
raise new FileLoadException('GPBParser.GrammarBooleanEntryExpected');
|
|
m_entryCount := m_entryCount - 1;
|
|
result := ReadBool;
|
|
end;
|
|
|
|
function Grammar.ReadEntryType:integer;
|
|
begin
|
|
if m_entryCount = 0 then
|
|
raise new FileLoadException('GPBLALRParser.GrammarNoEntry');
|
|
result := ReadByte;
|
|
end;
|
|
|
|
function Grammar.ReadString:string;
|
|
var res: StringBuilder;
|
|
unicodeChar: char;
|
|
begin
|
|
res := new StringBuilder;
|
|
unicodeChar := char(integer(ReadInt16));
|
|
while unicodeChar <> char(0) do begin
|
|
res.Append(unicodeChar);
|
|
unicodeChar := char(integer(ReadInt16));
|
|
end;
|
|
result := res.ToString;
|
|
end;
|
|
|
|
function Grammar.ReadInt16:integer;
|
|
begin
|
|
result := m_reader.ReadUInt16;
|
|
end;
|
|
|
|
function Grammar.ReadByte:byte;
|
|
begin
|
|
result := m_reader.ReadByte;
|
|
end;
|
|
|
|
function Grammar.ReadBool:boolean;
|
|
begin
|
|
result := ReadByte = 1;
|
|
end;
|
|
|
|
procedure Grammar.OptimizeDfaTransitionVectors;
|
|
var dfaStates: array of DfaState;
|
|
state: DfaState;
|
|
transitions: ObjectMap;
|
|
transition: object;
|
|
key,i,j,transitionIndex: integer;
|
|
begin
|
|
dfaStates := m_dfaStateTable;
|
|
for j:=0 to dfaStates.Length-1 do begin
|
|
state := dfaStates[j];
|
|
transitions := state.m_transitionVector;
|
|
for i:=transitions.Count-1 downto 0 do begin
|
|
key := transitions.GetKey(i);
|
|
transition := transitions[key];
|
|
if transition <> nil then begin
|
|
transitionIndex := integer(transition);
|
|
if transitionIndex >= 0 then
|
|
transitions[key] := dfaStates[transitionIndex]
|
|
else
|
|
transitions[key] := nil;
|
|
end;
|
|
end;
|
|
transitions.ReadOnly := true;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
//------------------------------------------------------------------------------
|
|
//Parser members
|
|
//------------------------------------------------------------------------------
|
|
constructor LALRParser.Create(tr:System.IO.TextReader; grm:Grammar);
|
|
var start: LRStackItem;
|
|
begin
|
|
m_lineNumber := 1;
|
|
TrimReductions := true;
|
|
if tr = nil then
|
|
raise new ArgumentNullException('textReader');
|
|
if grm = nil then
|
|
raise new ArgumentNullException('grammar');
|
|
m_textReader := tr;
|
|
m_bufferSize := MinimumBufferSize;
|
|
SetLength(m_buffer,m_bufferSize + 1);
|
|
m_lineLength := Undefined;
|
|
ReadBuffer;
|
|
SetLength(m_inputTokens,MinimumInputTokenCount);
|
|
SetLength(m_lrStack,MinimumLRStackSize);
|
|
m_grammar := grm;
|
|
// Put grammar start symbol into LR parsing stack.
|
|
m_lrState := m_grammar.InitialLRState;
|
|
start.m_token.m_symbol := m_grammar.StartSymbol;
|
|
start.m_state := m_lrState;
|
|
m_lrStack[m_lrStackIndex] := start;
|
|
m_reductionCount := Undefined; // there are no reductions yet.
|
|
end;
|
|
|
|
function LALRParser.LanguageGrammar: Grammar;
|
|
begin
|
|
result := m_grammar;
|
|
end;
|
|
|
|
function LALRParser.TextReader: System.IO.TextReader;
|
|
begin
|
|
result := m_textReader;
|
|
end;
|
|
|
|
function LALRParser.CharPosition: integer;
|
|
begin
|
|
result := m_charIndex + m_bufferStartIndex;
|
|
end;
|
|
|
|
function LALRParser.LineNumber: integer;// Gets current line number. It is 1-based.
|
|
begin
|
|
result := m_lineNumber;
|
|
end;
|
|
|
|
function LALRParser.LinePosition:integer;// Gets current char position in the current source line. It is 1-based.
|
|
begin
|
|
result := CharPosition - m_lineStart + 1;
|
|
end;
|
|
|
|
function LALRParser.LineText: string; // Gets current source line text. It can be truncated if line is longer than 2048 characters.
|
|
var lineStart,lineLength: integer;
|
|
begin
|
|
lineStart := Math.Max(m_lineStart, 0);
|
|
if m_lineLength = Undefined then
|
|
// Line was requested outside of SourceLineReadCallback call
|
|
lineLength := m_charIndex - lineStart
|
|
else
|
|
lineLength := m_lineLength - (lineStart - m_lineStart);
|
|
if lineLength > 0 then
|
|
result := new String(m_buffer, lineStart, lineLength)
|
|
else
|
|
result := string.Empty;
|
|
end;
|
|
|
|
function LALRParser.ReadBuffer: integer; // Reads next characters to the buffer.
|
|
var lineStart,lineCharCount,moveIndex,moveCount,count:integer;
|
|
newBuffer:array of char;
|
|
begin
|
|
// Find out how many bytes to preserve.
|
|
// We truncate long lines.
|
|
lineStart := m_lineStart;
|
|
if m_lineStart < 0 then
|
|
lineStart := 0;
|
|
lineCharCount := m_charIndex - lineStart;
|
|
if lineCharCount > m_bufferSize div 2 then
|
|
lineCharCount := m_bufferSize div 2;
|
|
moveIndex := m_charIndex - lineCharCount;
|
|
moveCount := lineCharCount + m_preserveChars;
|
|
if moveCount > 0 then
|
|
// We need to keep current token characters.
|
|
if m_bufferSize - moveCount < 20 then begin
|
|
// Grow the buffer
|
|
m_bufferSize := m_bufferSize * 2;
|
|
SetLength(newBuffer,m_bufferSize + 1);
|
|
System.Array.Copy(m_buffer, moveIndex, newBuffer, 0, moveCount);
|
|
m_buffer := newBuffer;
|
|
end else begin
|
|
System.Array.Copy(m_buffer, moveIndex, m_buffer, 0, moveCount);
|
|
end;
|
|
// Read as many characters as possible.
|
|
count := m_bufferSize - moveCount;
|
|
result := m_textReader.Read(m_buffer, moveCount, count);
|
|
// Mark character after last read one as End-Of-String
|
|
m_buffer[moveCount + result] := EndOfString;
|
|
// Adjust buffer variables.
|
|
m_bufferStartIndex := m_bufferStartIndex + moveIndex;
|
|
m_charIndex := m_charIndex - moveIndex;
|
|
m_lineStart := m_lineStart - moveIndex;
|
|
end;
|
|
|
|
procedure LALRParser.MoveBy(delta:integer);// Increments current char index by delta character positions.
|
|
var i,lastIndex:integer;
|
|
begin
|
|
for i:=delta-1 downto 0 do begin
|
|
m_charIndex := m_charIndex + 1;
|
|
if m_buffer[m_charIndex-1] = charEnter then begin// '\n'
|
|
if SourceLineReadWenLineRead <> nil then begin
|
|
m_lineLength := m_charIndex - m_lineStart - 1; // Exclude '\n'
|
|
lastIndex := m_lineStart + m_lineLength - 1;
|
|
if (lastIndex >= 0) and (m_buffer[lastIndex] = charReset) then //'\r'
|
|
m_lineLength := m_lineLength - 1;
|
|
if m_lineLength < 0 then
|
|
m_lineLength := 0;
|
|
SourceLineReadWenLineRead(self, m_lineStart + m_bufferStartIndex, m_lineLength);
|
|
end;
|
|
m_lineNumber := m_lineNumber + 1;
|
|
m_lineStart := m_charIndex;
|
|
m_lineLength := Undefined;
|
|
end;
|
|
if m_buffer[m_charIndex] = charEndOfFile then
|
|
if SourceLineReadWenLineRead <> nil then begin
|
|
m_lineLength := m_charIndex - m_lineStart;
|
|
if m_lineLength > 0 then
|
|
SourceLineReadWenLineRead(self, m_lineStart + m_bufferStartIndex, m_lineLength);
|
|
m_lineLength := Undefined;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure LALRParser.MoveToLineEnd; // Moves current char pointer to the end of source line.
|
|
var ch: char;
|
|
begin
|
|
while true do begin
|
|
ch := m_buffer[m_charIndex];
|
|
case ch of
|
|
charEnter,charReset:
|
|
break;
|
|
charEndOfFile:
|
|
if ReadBuffer = 0 then
|
|
break;
|
|
else
|
|
if m_commentText <> nil then
|
|
m_commentText.Append(ch);
|
|
end;
|
|
m_charIndex := m_charIndex + 1;
|
|
end;
|
|
end;
|
|
|
|
procedure LALRParser.SetTokenSymbol(value:Symbol);
|
|
begin
|
|
m_token.m_symbol := value;
|
|
end;
|
|
function LALRParser.GetTokenSymbol: Symbol;
|
|
begin
|
|
result := m_token.m_symbol;
|
|
end;
|
|
|
|
function LALRParser.GetTokenText: string;
|
|
begin
|
|
if m_token.m_text = nil then begin
|
|
if m_token.m_length > 0 then
|
|
m_token.m_text := new string(m_buffer, m_token.m_start - m_bufferStartIndex, m_token.m_length)
|
|
else
|
|
m_token.m_text := string.Empty;
|
|
end;
|
|
result := m_token.m_text;
|
|
end;
|
|
|
|
procedure LALRParser.SetTokenText(text:string);
|
|
begin
|
|
m_token.m_text := text;
|
|
end;
|
|
|
|
function LALRParser.GetTokenSyntaxNode: object;
|
|
begin
|
|
if m_reductionCount = Undefined then
|
|
result := m_token.m_syntaxNode
|
|
else
|
|
result := m_lrStack[m_lrStackIndex].m_token.m_syntaxNode;
|
|
end;
|
|
|
|
procedure LALRParser.SetTokenSyntaxNode(text:object);
|
|
begin
|
|
if m_reductionCount = Undefined then
|
|
m_token.m_syntaxNode := text
|
|
else
|
|
m_lrStack[m_lrStackIndex].m_token.m_syntaxNode := text;
|
|
end;
|
|
|
|
function LALRParser.TokenString: string;// Returns string representation of the token.
|
|
var sb: StringBuilder;
|
|
i: integer;
|
|
ch: char;
|
|
begin
|
|
if m_token.m_symbol.SymbolType <> SymbolTypeTerminal then begin
|
|
result := m_token.m_symbol.ToString;
|
|
exit;
|
|
end;
|
|
sb := new StringBuilder(m_token.m_length);
|
|
for i := 0 to m_token.m_length-1 do begin
|
|
ch := m_buffer[m_token.m_start - m_bufferStartIndex + i];
|
|
if ch < ' ' then
|
|
case ch of
|
|
charEnter: sb.Append('{LF}');
|
|
charReset: sb.Append('{CR}');
|
|
charTab: sb.Append('{HT}');
|
|
end
|
|
else
|
|
sb.Append(ch);
|
|
end;
|
|
result := sb.ToString;{}
|
|
end;
|
|
|
|
procedure LALRParser.PushInputToken(sym:Symbol; text:string; syntaxNode:object);// Pushes a token to the input token stack.
|
|
var newTokenArray: array of Token;
|
|
begin
|
|
if m_token.m_symbol <> nil then begin
|
|
if m_inputTokenCount = m_inputTokens.Length then begin
|
|
SetLength(newTokenArray, m_inputTokenCount*2);
|
|
System.Array.Copy(m_inputTokens, newTokenArray, m_inputTokenCount);
|
|
m_inputTokens := newTokenArray;
|
|
end;
|
|
m_inputTokens[m_inputTokenCount] := m_token;
|
|
m_inputTokenCount := m_inputTokenCount + 1;
|
|
end;
|
|
// m_token := new Token;
|
|
m_token.m_symbol := sym;
|
|
m_token.m_text := text;
|
|
m_token.m_length := 0;
|
|
if text <> nil then
|
|
m_token.m_length := text.Length;
|
|
m_token.m_syntaxNode := syntaxNode;{}
|
|
end;
|
|
|
|
function LALRParser.PopInputToken: Symbol; // Pops token from the input token stack.
|
|
begin
|
|
result := m_token.m_symbol;
|
|
if m_inputTokenCount > 0 then begin
|
|
m_inputTokenCount := m_inputTokenCount - 1;
|
|
m_token := m_inputTokens[m_inputTokenCount];
|
|
end else begin
|
|
m_token.m_symbol := nil;
|
|
m_token.m_text := nil;
|
|
end;{}
|
|
end;
|
|
|
|
|
|
|
|
function LALRParser.ReadToken: Symbol; // Reads next token from the input stream.
|
|
var tokenSymbol: Symbol;
|
|
dfaStateTable: array of DfaState;
|
|
ch: char;
|
|
curDFAState: DfaState;
|
|
lookahead,tokenLength: integer;
|
|
begin
|
|
m_token.m_text := nil;
|
|
m_token.m_start := m_charIndex + m_bufferStartIndex;
|
|
m_token.m_lineNumber := m_lineNumber;
|
|
m_token.m_linePosition := m_charIndex - m_lineStart + 1;
|
|
lookahead := m_charIndex; // Next look ahead char in the input
|
|
tokenLength := 0;
|
|
tokenSymbol := nil;
|
|
dfaStateTable := m_grammar.m_dfaStateTable;
|
|
ch := m_buffer[lookahead];
|
|
if ch = EndOfString then begin
|
|
if ReadBuffer = 0 then begin
|
|
m_token.m_symbol := m_grammar.EndSymbol;
|
|
m_token.m_length := 0;
|
|
result := m_token.m_symbol;
|
|
exit;
|
|
end;
|
|
lookahead := m_charIndex;
|
|
ch := m_buffer[lookahead];
|
|
end;
|
|
curDFAState := m_grammar.DfaInitialState;
|
|
while true do begin
|
|
curDFAState := curDFAState.m_transitionVector[integer(ch)] as DfaState;
|
|
// This block-if statement checks whether an edge was found from the current state.
|
|
// If so, the state and current position advance. Otherwise it is time to exit the main loop
|
|
// and report the token found (if there was it fact one). If the LastAcceptState is -1,
|
|
// then we never found a match and the Error Token is created. Otherwise, a new token
|
|
// is created using the Symbol in the Accept State and all the characters that
|
|
// comprise it.
|
|
if curDFAState <> nil then begin
|
|
// This code checks whether the target state accepts a token. If so, it sets the
|
|
// appropiate variables so when the algorithm in done, it can return the proper
|
|
// token and number of characters.
|
|
lookahead := lookahead + 1;
|
|
if curDFAState.AcceptSymbol <> nil then begin
|
|
tokenSymbol := curDFAState.AcceptSymbol;
|
|
tokenLength := lookahead - m_charIndex;
|
|
end;
|
|
ch := m_buffer[lookahead];
|
|
if ch = EndOfString then begin
|
|
m_preserveChars := lookahead - m_charIndex;
|
|
if ReadBuffer = 0 then
|
|
lookahead := m_charIndex + m_preserveChars
|
|
else begin
|
|
lookahead := m_charIndex + m_preserveChars;
|
|
ch := m_buffer[lookahead];
|
|
end;
|
|
m_preserveChars := 0;
|
|
end;
|
|
end else begin
|
|
if tokenSymbol <> nil then begin
|
|
m_token.m_symbol := tokenSymbol;
|
|
m_token.m_length := tokenLength;
|
|
MoveBy(tokenLength);
|
|
end else begin
|
|
//Tokenizer cannot recognize symbol
|
|
m_token.m_symbol := m_grammar.m_errorSymbol;
|
|
m_token.m_length := 1;
|
|
MoveBy(1);
|
|
end;
|
|
break;
|
|
end;
|
|
end;
|
|
result := m_token.m_symbol;{}
|
|
end;
|
|
|
|
procedure LALRParser.DiscardInputToken; // Removes current token and pops next token from the input stack.
|
|
begin
|
|
if m_inputTokenCount > 0 then begin
|
|
m_inputTokenCount := m_inputTokenCount - 1;
|
|
m_token := m_inputTokens[m_inputTokenCount];
|
|
end else begin
|
|
m_token.m_symbol := nil;
|
|
m_token.m_text := nil;
|
|
end;{}
|
|
end;
|
|
|
|
function LALRParser.CurrentLRState: LRState;
|
|
begin
|
|
result := m_lrState;
|
|
end;
|
|
|
|
function LALRParser.ReductionRule: Rule;
|
|
begin
|
|
result := m_lrStack[m_lrStackIndex].m_rule;
|
|
end;
|
|
|
|
function LALRParser.ReductionCount: integer;
|
|
begin
|
|
result := m_reductionCount;
|
|
end;
|
|
|
|
function LALRParser.GetReductionSyntaxNode(index:integer):object;
|
|
begin
|
|
//DarkStar Changed for Speed!
|
|
//if (index < 0 || index >= m_reductionCount)
|
|
// throw new IndexOutOfRangeException();
|
|
result := m_lrStack[m_lrStackIndex - m_reductionCount + index].m_token.m_syntaxNode;{}
|
|
end;
|
|
|
|
function LALRParser.GetExpectedTokens:array of Symbol;
|
|
begin
|
|
result := m_expectedTokens; {}
|
|
end;
|
|
|
|
function LALRParser.Parse: ParseMessage;// Executes next step of parser and returns parser state.
|
|
var parseResult: TokenParseResult;
|
|
readTokenSymbol: Symbol;
|
|
symType: integer;
|
|
begin
|
|
if m_token.m_symbol <> nil then
|
|
case m_token.m_symbol.SymbolType of
|
|
SymbolTypeCommentLine:begin
|
|
DiscardInputToken; //Remove it
|
|
MoveToLineEnd;
|
|
end;
|
|
SymbolTypeCommentStart:
|
|
ProcessBlockComment;
|
|
end;
|
|
while true do begin
|
|
if m_token.m_symbol = nil then begin
|
|
//We must read a token
|
|
readTokenSymbol := ReadToken;
|
|
symType := readTokenSymbol.SymbolType;
|
|
if (m_commentLevel = 0) and (symType <> SymbolTypeCommentLine) and (symType <> SymbolTypeCommentStart) and (symType <> SymbolTypeWhiteSpace) then begin
|
|
result := ParseMessageTokenRead;
|
|
exit;
|
|
end;
|
|
end else begin
|
|
//==== Normal parse mode - we have a token and we are not in comment mode
|
|
case m_token.m_symbol.SymbolType of
|
|
SymbolTypeWhiteSpace:
|
|
DiscardInputToken; // Discard Whitespace
|
|
SymbolTypeCommentStart:begin
|
|
m_commentLevel := 1; // Switch to block comment mode.
|
|
result := ParseMessageCommentBlockRead;
|
|
exit;
|
|
end;
|
|
SymbolTypeCommentLine:begin
|
|
result := ParseMessageCommentLineRead;
|
|
exit;
|
|
end;
|
|
SymbolTypeError:begin
|
|
result := ParseMessageLexicalError;
|
|
exit;
|
|
end;
|
|
else begin
|
|
//Finally, we can parse the token
|
|
parseResult := ParseToken;
|
|
case parseResult of
|
|
TokenParseResultAccept:begin
|
|
result := ParseMessageAccept;
|
|
exit;
|
|
end;
|
|
TokenParseResultInternalError:begin
|
|
result := ParseMessageInternalError;
|
|
exit;
|
|
end;
|
|
TokenParseResultReduceNormal:begin
|
|
if not m_lrStack[m_lrStackIndex].m_rule.m_hasEmpty then begin
|
|
result := ParseMessageReduction;
|
|
exit;
|
|
end;
|
|
end;
|
|
TokenParseResultShift:
|
|
//A simple shift, we must continue
|
|
DiscardInputToken; // Okay, remove the top token, it is on the stack
|
|
TokenParseResultSyntaxError:begin
|
|
result := ParseMessageSyntaxError;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure LALRParser.ProcessBlockComment;
|
|
var symType: integer;
|
|
begin
|
|
if m_commentLevel > 0 then begin
|
|
if m_commentText <> nil then
|
|
m_commentText.Append(TokenText);
|
|
DiscardInputToken();
|
|
while true do begin
|
|
symType := ReadToken.SymbolType;
|
|
if m_commentText <> nil then
|
|
m_commentText.Append(TokenText);
|
|
DiscardInputToken();
|
|
case symType of
|
|
SymbolTypeCommentStart:
|
|
m_commentLevel := m_commentLevel + 1;
|
|
SymbolTypeCommentEnd:begin
|
|
m_commentLevel := m_commentLevel - 1;
|
|
if m_commentLevel = 0 then
|
|
exit;
|
|
end;
|
|
SymbolTypeEnd:
|
|
raise new Exception('CommentError');
|
|
end;
|
|
end;
|
|
end;{}
|
|
end;
|
|
|
|
function LALRParser.CommentText: string;// Gets current comment text.
|
|
var lineComment,blockComment:string;
|
|
begin
|
|
result := string.Empty;
|
|
if m_token.m_symbol <> nil then
|
|
case m_token.m_symbol.SymbolType of
|
|
SymbolTypeCommentLine:begin
|
|
m_commentText := new StringBuilder;
|
|
m_commentText.Append(TokenText);
|
|
DiscardInputToken; //Remove token
|
|
MoveToLineEnd;
|
|
lineComment := m_commentText.ToString;
|
|
m_commentText := nil;
|
|
result := lineComment;
|
|
end;
|
|
SymbolTypeCommentStart:begin
|
|
m_commentText := new StringBuilder;
|
|
ProcessBlockComment;
|
|
blockComment := m_commentText.ToString;
|
|
m_commentText := nil;
|
|
result := blockComment;
|
|
end;
|
|
end;{}
|
|
end;
|
|
|
|
|
|
function LALRParser.ParseToken: TokenParseResult;
|
|
var stateAction: LRStateAction;
|
|
length,i,newIndex: integer;
|
|
newArray: array of Symbol;
|
|
nextToken:LRStackItem;
|
|
currentRule: Rule;
|
|
head: LRStackItem;
|
|
nextState: LRState;
|
|
begin
|
|
stateAction := m_lrState.m_transitionVector[m_token.m_symbol.Index];
|
|
if stateAction <> nil then begin
|
|
//Work - shift or reduce
|
|
if m_reductionCount > 0 then begin
|
|
newIndex := m_lrStackIndex - m_reductionCount;
|
|
m_lrStack[newIndex] := m_lrStack[m_lrStackIndex];
|
|
m_lrStackIndex := newIndex;
|
|
end;
|
|
m_reductionCount := Undefined;
|
|
case stateAction.Action of
|
|
LRActionAccept:begin
|
|
m_reductionCount := 0;
|
|
result := TokenParseResultAccept;
|
|
exit;
|
|
end;
|
|
LRActionShift:begin
|
|
m_lrState := m_grammar.m_lrStateTable[stateAction.Value];
|
|
//nextToken := new LRStackItem;
|
|
nextToken.m_token := m_token;
|
|
nextToken.m_state := m_lrState;
|
|
m_lrStackIndex := m_lrStackIndex + 1;
|
|
m_lrStack[m_lrStackIndex] := nextToken;
|
|
result := TokenParseResultShift;
|
|
exit;
|
|
end;
|
|
LRActionReduce:begin
|
|
//Produce a reduction - remove as many tokens as members in the rule & push a nonterminal token
|
|
currentRule := m_grammar.m_ruleTable[stateAction.Value];
|
|
if TrimReductions and currentRule.ContainsOneNonTerminal then begin
|
|
head := m_lrStack[m_lrStackIndex];
|
|
head.m_token.m_symbol := currentRule.NonTerminal;
|
|
head.m_token.m_text := nil;
|
|
nextState := m_lrStack[m_lrStackIndex - 1].m_state;
|
|
m_lrState := m_grammar.m_lrStateTable[nextState.m_transitionVector[currentRule.NonTerminal.Index].Value];
|
|
head.m_state := m_lrState;
|
|
m_lrStack[m_lrStackIndex] := head;
|
|
result := TokenParseResultReduceEliminated;
|
|
exit;
|
|
end else begin
|
|
//head := new LRStackItem;
|
|
head.m_rule := currentRule;
|
|
head.m_token.m_symbol := currentRule.NonTerminal;
|
|
head.m_token.m_text := nil;
|
|
m_reductionCount := currentRule.m_symbols.Length;
|
|
nextState := m_lrStack[m_lrStackIndex - m_reductionCount].m_state;
|
|
m_lrState := m_grammar.m_lrStateTable[nextState.m_transitionVector[currentRule.NonTerminal.Index].Value];
|
|
head.m_state := m_lrState;
|
|
m_lrStackIndex := m_lrStackIndex + 1;
|
|
m_lrStack[m_lrStackIndex] := head;
|
|
result := TokenParseResultReduceNormal;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
//=== Syntax Error! Fill Expected Tokens
|
|
SetLength(m_expectedTokens, m_lrState.ActionCount);
|
|
length := 0;
|
|
for i := 0 to m_lrState.ActionCount-1 do
|
|
case m_lrState.GetAction(i).StateSymbol.SymbolType of
|
|
SymbolTypeTerminal,SymbolTypeEnd:begin
|
|
m_expectedTokens[length] := m_lrState.GetAction(i).StateSymbol;
|
|
length := length + 1;
|
|
end;
|
|
end;
|
|
if length < m_expectedTokens.Length then begin
|
|
SetLength(newArray, length);
|
|
System.Array.Copy(m_expectedTokens, newArray, length);
|
|
m_expectedTokens := newArray;
|
|
end;
|
|
result := TokenParseResultSyntaxError;{}
|
|
end;
|
|
{}
|
|
initialization
|
|
UnassignedValue := new Unassigned;
|
|
finalization
|
|
|
|
end. |