roka/bds.mr.dpg
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
5666f85e9940359ef0ab65608807eeeb2431d385
bds.mr.dpg/src.lib/grammar/dpglib.DpgParser.pas
T
roka 5666f85e99 Initial check in lib
2026-01-03 18:33:48 +01:00

1458 lines
36 KiB
ObjectPascal
Raw Blame History

// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.1.0.0r
// Grammar: dpglib.dpgParser.g
// ============================================================================
unit dpglib.DpgParser;
interface
uses
System.Classes,
dpglib.DpgParserTokens,
dpglib.types,
dpgrtl.llkparser,
dpgrtl.types,
System.SysUtils;
type
// =========================================================================
// Class TDpgParser declaration
// =========================================================================
TDpgParser = class( TLLkParser)
protected
fGrammarMaker : IGrammarBehavior;
fTool : ITool;
fNesting : integer;
fExchangeDir : AnsiString;
fGrammarFile : AnsiString;
fGrammarUnit : AnsiString;
private
function lastInRule : boolean;
procedure checkEndRule( pToken: IToken);
public
constructor Create( pParserState : IParserState;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString); overload;
constructor Create( pTokenBuffer : ITokenBuffer;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString); overload;
constructor Create( pTokenStream : ITokenStream;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString); overload;
destructor Destroy; override;
public // Public grammar rules
procedure grammar ;
function qualifiedId : IToken;
procedure usesDecl ;
procedure constDecl ;
procedure typeDecl ;
procedure classDecl ;
procedure qualifiedUsesName ;
function id : IToken;
procedure classOptions ;
procedure classTokens ;
procedure classMemberDecl ;
procedure rules ;
procedure classMemberDef ;
function optionValue : IToken;
procedure tokenSpecOptions ( t: IToken);
procedure rule ;
procedure ruleExceptionBlock ;
procedure altExceptionBlock ;
procedure ruleOptions ;
procedure block ;
procedure alternative ;
procedure elem ;
procedure element ;
procedure elementOptions ;
procedure range ( pTokenLabel: IToken);
procedure terminal ( pTokenLabel: IToken);
procedure notTerminal ( pTokenLabel: IToken);
procedure ebnf ( pTokenLabel: IToken; pTokenNot: boolean);
procedure tree ;
procedure rootNode ;
function astTypeSpec : integer;
procedure subRuleOptions ;
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// grammar
// ============================================================================
procedure TDpgParser.grammar;
var
unitName: IToken;
begin
match(LT_unit);
unitName := qualifiedId;
fGrammarUnit := unitName.TokenText;
match(TT_SEMI);
if (( LA(1) in [TT_USES])) then
begin
usesDecl;
end;
if (( LA(1) in [LT_const])) then
begin
constDecl;
end;
if (( LA(1) in [LT_type])) then
begin
typeDecl;
end;
classDecl;
fGrammarMaker.endGrammar;
end;
// ============================================================================
// qualifiedId
// ============================================================================
function TDpgParser.qualifiedId: IToken;
var
buf : AnsiString;
a : IToken;
begin
a := id;
buf := a.TokenText;
while(true) do
begin
if (( LA(1) in [TT_WILDCARD])) then
begin
match(TT_WILDCARD);
a := id;
buf := buf + '.' + a.TokenText;
end
else
break;
end;
// -----------------------------------------------------------
// Can either TOKENREF or RULEREF. Should really create QID or
// something else instead.
// -----------------------------------------------------------
result := TToken.Create( TT_TOKENREF, buf);
result.TokenLine := a.TokenLine;
result.TokenColumn := a.TokenColumn;
end;
// ============================================================================
// usesDecl
// ============================================================================
procedure TDpgParser.usesDecl;
begin
match(TT_USES);
while(true) do
begin
if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then
begin
qualifiedUsesName;
match(TT_SEMI);
end
else
break;
end;
match(TT_RCURLY);
end;
// ============================================================================
// constDecl
// ============================================================================
procedure TDpgParser.constDecl;
var
a: IToken;
begin
match(LT_const);
a := LT(1);
match(TT_ACTION);
fGrammarMaker.RefConstAction( a);
end;
// ============================================================================
// typeDecl
// ============================================================================
procedure TDpgParser.typeDecl;
var
a: IToken;
begin
match(LT_type);
a := LT(1);
match(TT_ACTION);
fGrammarMaker.RefTypeAction( a);
end;
// ============================================================================
// classDecl
// ============================================================================
procedure TDpgParser.classDecl;
var
grType : integer;
grObject : IToken;
grSuper : IToken;
begin
grObject := nil;
grSuper := nil;
if (( LA(1) in [LT_lexer])) then
begin
match(LT_lexer);
grType := 0;
end
else if (( LA(1) in [LT_parser])) then
begin
match(LT_parser);
grType := 1;
end
else if (( LA(1) in [LT_treeparser])) then
begin
match(LT_treeparser);
grType := 2;
end
else
Raise EMismatchedToken.Create( LT(1), [LT_lexer..LT_treeparser], InputState.FileName);
grObject := id;
match(TT_SEMI);
// ---------------------------------------------------------
// Now we have enough information to start the grammar.
// ---------------------------------------------------------
case grType of
0: fGrammarMaker.StartLexer( InputState.FileName,
grObject,
grSuper);
1: fGrammarMaker.StartParser( InputState.FileName,
grObject,
grSuper);
2: fGrammarMaker.StartTreeWalker( InputState.FileName,
grObject,
grSuper);
end;
fGrammarMaker.defineGrammarUnit( fGrammarUnit);
if (( LA(1) in [TT_OPTIONS])) then
begin
classOptions;
end;
if ((( LA(1) in [TT_TOKENS])) and (grType=0)) then
begin
classTokens;
end;
if (( LA(1) in [LT_memberdecl])) then
begin
classMemberDecl;
end;
rules;
if (( LA(1) in [LT_memberdef])) then
begin
classMemberDef;
end;
end;
// ============================================================================
// qualifiedUsesName
// ============================================================================
procedure TDpgParser.qualifiedUsesName;
var
r: IToken;
id: AnsiString;
begin
if (( LA(1) in [TT_TOKENREF])) then
begin
r := LT(1);
match(TT_TOKENREF);
end
else if (( LA(1) in [TT_RULEREF])) then
begin
r := LT(1);
match(TT_RULEREF);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName);
id := r.TokenText;
while(true) do
begin
if (( LA(1) in [TT_WILDCARD])) then
begin
match(TT_WILDCARD);
if (( LA(1) in [TT_TOKENREF])) then
begin
r := LT(1);
match(TT_TOKENREF);
end
else if (( LA(1) in [TT_RULEREF])) then
begin
r := LT(1);
match(TT_RULEREF);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName);
id := id +'.'+ r.TokenText;
end
else
break;
end;
fGrammarMaker.defineUses(id);
end;
// ============================================================================
// id
// ============================================================================
function TDpgParser.id: IToken;
begin
if (( LA(1) in [TT_TOKENREF])) then
begin
result := LT(1);
match(TT_TOKENREF);
end
else if (( LA(1) in [TT_RULEREF])) then
begin
result := LT(1);
match(TT_RULEREF);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName);
end;
// ============================================================================
// classOptions
// ============================================================================
procedure TDpgParser.classOptions;
var
optName : IToken;
optValue : IToken;
begin
match(TT_OPTIONS);
while(true) do
begin
if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then
begin
optName := id;
match(TT_ASSIGN);
optValue := optionValue;
match(TT_SEMI);
fGrammarMaker.setGrammarOption( optName, optValue);
end
else
break;
end;
match(TT_RCURLY);
end;
// ============================================================================
// classTokens
// ============================================================================
procedure TDpgParser.classTokens;
var
tokenName: IToken;
tokenString: IToken;
begin
match(TT_TOKENS);
while(true) do
begin
if (( LA(1) in [TT_STRINGLIT,TT_TOKENREF])) then
begin
tokenName := nil;
tokenString := nil;
if (( LA(1) in [TT_TOKENREF])) then
begin
tokenName := LT(1);
match(TT_TOKENREF);
if (( LA(1) in [TT_ASSIGN])) then
begin
match(TT_ASSIGN);
tokenString := LT(1);
match(TT_STRINGLIT);
end;
fGrammarMaker.defineToken( tokenName, tokenString);
if (( LA(1) in [TT_OPEN])) then
begin
tokenSpecOptions(tokenName);
end;
end
else if (( LA(1) in [TT_STRINGLIT])) then
begin
tokenString := LT(1);
match(TT_STRINGLIT);
fGrammarMaker.defineToken( tokenName, tokenString);
if (( LA(1) in [TT_OPEN])) then
begin
tokenSpecOptions(tokenString);
end;
end
else
Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName);
match(TT_SEMI);
end
else
break;
end;
match(TT_RCURLY);
end;
// ============================================================================
// classMemberDecl
// ============================================================================
procedure TDpgParser.classMemberDecl;
var
memberDecl: IToken;
begin
match(LT_memberdecl);
memberDecl := LT(1);
match(TT_ACTION);
fGrammarMaker.refMemberDecl(memberDecl);
end;
// ============================================================================
// rules
// ============================================================================
procedure TDpgParser.rules;
begin
while(true) do
begin
if (( LA(1) in [LT_private..LT_public,TT_TOKENREF..TT_RULEREF])) then
begin
rule;
end
else
break;
end;
end;
// ============================================================================
// classMemberDef
// ============================================================================
procedure TDpgParser.classMemberDef;
var
memberDef: IToken;
begin
match(LT_memberdef);
memberDef := LT(1);
match(TT_ACTION);
fGrammarMaker.refMemberDef(memberDef);
end;
// ============================================================================
// optionValue
// ============================================================================
function TDpgParser.optionValue: IToken;
begin
if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then
begin
result := qualifiedId;
end
else if (( LA(1) in [TT_STRINGLIT])) then
begin
result := LT(1);
match(TT_STRINGLIT);
end
else if (( LA(1) in [TT_CHARLIT])) then
begin
result := LT(1);
match(TT_CHARLIT);
end
else if (( LA(1) in [TT_INTEGER])) then
begin
result := LT(1);
match(TT_INTEGER);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT..TT_INTEGER,TT_TOKENREF..TT_RULEREF], InputState.FileName);
end;
// ============================================================================
// tokenSpecOptions
// ============================================================================
procedure TDpgParser.tokenSpecOptions( t: IToken);
var
name : IToken;
value : IToken;
begin
name := nil;
value := nil;
match(TT_OPEN);
name := id;
match(TT_ASSIGN);
value := optionValue;
fGrammarMaker.refTokenSpecElemOption( t, name, value);
while(true) do
begin
if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then
begin
name := id;
match(TT_ASSIGN);
value := optionValue;
fGrammarMaker.refTokenSpecElemOption( t, name, value);
end
else
break;
end;
match(TT_CLOSE);
end;
// ============================================================================
// rule
// ============================================================================
procedure TDpgParser.rule;
var
args: IToken;
initAction: IToken;
locals: IToken;
ret: IToken;
access : AnsiString;
ag : integer;
returns : IToken;
name : IToken;
begin
access := 'public';
args := nil;
name := nil;
ag := AUTOGEN_NONE;
if (( LA(1) in [LT_public])) then
begin
match(LT_public);
access := 'public';
end
else if (( LA(1) in [LT_protected])) then
begin
match(LT_protected);
access := 'protected';
end
else if (( LA(1) in [LT_private])) then
begin
match(LT_private);
access := 'private';
end;
name := id;
if (( LA(1) in [TT_ARGACTION])) then
begin
args := LT(1);
match(TT_ARGACTION);
end;
if (( LA(1) in [LT_returns])) then
begin
match(LT_returns);
ret := LT(1);
match(TT_ARGACTION);
end;
fGrammarMaker.defineRuleName( name, access, true, '');
if args <> nil then
fGrammarMaker.refArgAction( args);
if ret <> nil then
fGrammarMaker.refReturnAction( ret);
if (( LA(1) in [TT_OPTIONS])) then
begin
ruleOptions;
end;
if (( LA(1) in [LT_local])) then
begin
match(LT_local);
locals := LT(1);
match(TT_ACTION);
fGrammarMaker.refRuleLocals( locals);
end;
if (( LA(1) in [TT_ACTION])) then
begin
initAction := LT(1);
match(TT_ACTION);
fGrammarMaker.refInitAction( initAction);
end;
match(TT_COLON);
block;
match(TT_SEMI);
if (( LA(1) in [LT_except..LT_finally])) then
begin
ruleExceptionBlock;
end;
fGrammarMaker.endRule('');
end;
// ============================================================================
// ruleExceptionBlock
// ============================================================================
procedure TDpgParser.ruleExceptionBlock;
var
a: IToken;
t: IToken;
begin
if (( LA(1) in [LT_except])) then
begin
t := LT(1);
match(LT_except);
a := LT(1);
match(TT_ACTION);
fGrammarMaker.RefRuleExHandler( t, a);
end
else if (( LA(1) in [LT_finally])) then
begin
t := LT(1);
match(LT_finally);
a := LT(1);
match(TT_ACTION);
fGrammarMaker.RefRuleExHandler( t, a);
end
else
Raise EMismatchedToken.Create( LT(1), [LT_except..LT_finally], InputState.FileName);
end;
// ============================================================================
// altExceptionBlock
// ============================================================================
procedure TDpgParser.altExceptionBlock;
var
a: IToken;
t: IToken;
begin
if (( LA(1) in [LT_except])) then
begin
t := LT(1);
match(LT_except);
a := LT(1);
match(TT_ACTION);
fGrammarMaker.RefAltExHandler( t, a);
end
else if (( LA(1) in [LT_finally])) then
begin
t := LT(1);
match(LT_finally);
a := LT(1);
match(TT_ACTION);
fGrammarMaker.RefAltExHandler( t, a);
end
else
Raise EMismatchedToken.Create( LT(1), [LT_except..LT_finally], InputState.FileName);
end;
// ============================================================================
// ruleOptions
// ============================================================================
procedure TDpgParser.ruleOptions;
var
optName : IToken;
optValue : IToken;
begin
match(TT_OPTIONS);
while(true) do
begin
if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then
begin
optName := id;
match(TT_ASSIGN);
optValue := optionValue;
match(TT_SEMI);
fGrammarMaker.setRuleOption( optName, optValue);
end
else
break;
end;
match(TT_RCURLY);
end;
// ============================================================================
// block
// ============================================================================
procedure TDpgParser.block;
begin
INC( fNesting);
alternative;
while(true) do
begin
if (( LA(1) in [TT_OR])) then
begin
match(TT_OR);
alternative;
end
else
break;
end;
DEC(fNesting);
end;
// ============================================================================
// alternative
// ============================================================================
procedure TDpgParser.alternative;
var
autoGen : boolean;
begin
autoGen := true;
fGrammarMaker.beginAlt( autoGen);
while(true) do
begin
if (( LA(1) in [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF])) then
begin
elem;
end
else
break;
end;
if (( LA(1) in [LT_except..LT_finally])) then
begin
altExceptionBlock;
end;
fGrammarMaker.endAlt;
end;
// ============================================================================
// elem
// ============================================================================
procedure TDpgParser.elem;
begin
element;
if (( LA(1) in [TT_OPEN])) then
begin
elementOptions;
end;
end;
// ============================================================================
// element
// ============================================================================
procedure TDpgParser.element;
var
action: IToken;
ag: IToken;
args: IToken;
ruleRef: IToken;
semPred: IToken;
tokenRef: IToken;
assignId : IToken;
assignLabel : IToken;
autoGen : integer;
begin
assignId := nil;
assignLabel := nil;
autoGen := AUTOGEN_NONE;
if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_ASSIGN])) then
begin
assignId := id;
match(TT_ASSIGN);
if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then
begin
assignLabel := id;
match(TT_COLON);
checkEndRule(assignLabel);
end;
if (( LA(1) in [TT_RULEREF])) then
begin
ruleRef := LT(1);
match(TT_RULEREF);
if (( LA(1) in [TT_ARGACTION])) then
begin
args := LT(1);
match(TT_ARGACTION);
end;
if (( LA(1) in [TT_BANG])) then
begin
ag := LT(1);
match(TT_BANG);
autoGen := AUTOGEN_BANG;
end;
fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen);
end
else if (( LA(1) in [TT_TOKENREF])) then
begin
tokenRef := LT(1);
match(TT_TOKENREF);
if (( LA(1) in [TT_ARGACTION])) then
begin
args := LT(1);
match(TT_ARGACTION);
end;
fGrammarMaker.refToken( assignId, tokenRef, assignLabel, args, false, autoGen, lastInRule);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_TOKENREF..TT_RULEREF], InputState.FileName);
end
else if (( LA(1) in [TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF..TT_RULEREF]) and (LA(2) in [LT_except..TT_SEMPRED,TT_OPTIONS,TT_LPAREN..TT_RPAREN,TT_COLON..TT_SEMI,TT_NOT..TT_OPEN,TT_CARET..TT_STRINGLIT,TT_ARGACTION..TT_RULEREF])) then
begin
if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then
begin
assignLabel := id;
match(TT_COLON);
checkEndRule(assignLabel);
end;
if (( LA(1) in [TT_RULEREF])) then
begin
ruleRef := LT(1);
match(TT_RULEREF);
if (( LA(1) in [TT_ARGACTION])) then
begin
args := LT(1);
match(TT_ARGACTION);
end;
if (( LA(1) in [TT_BANG])) then
begin
ag := LT(1);
match(TT_BANG);
autoGen := AUTOGEN_BANG;
end;
fGrammarMaker.refRule( assignId, ruleRef, assignLabel, args, autoGen);
end
else if (( LA(1) in [TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF]) and (LA(2) in [TT_RANGE])) then
begin
range(assignLabel);
end
else if (( LA(1) in [TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF]) and (LA(2) in [LT_except..TT_SEMPRED,TT_LPAREN..TT_RPAREN,TT_SEMI,TT_NOT..TT_WILDCARD,TT_OPEN,TT_CARET..TT_STRINGLIT,TT_ARGACTION..TT_RULEREF])) then
begin
terminal(assignLabel);
end
else if (( LA(1) in [TT_NOT])) then
begin
match(TT_NOT);
if (( LA(1) in [TT_CHARLIT,TT_TOKENREF])) then
begin
notTerminal(assignLabel);
end
else if (( LA(1) in [TT_LPAREN])) then
begin
ebnf( assignLabel, true);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_LPAREN,TT_CHARLIT,TT_TOKENREF], InputState.FileName);
end
else if (( LA(1) in [TT_LPAREN])) then
begin
ebnf( assignLabel, false);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_LPAREN,TT_NOT,TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF..TT_RULEREF], InputState.FileName);
end
else if (( LA(1) in [TT_ACTION])) then
begin
action := LT(1);
match(TT_ACTION);
fGrammarMaker.refAction( action);
end
else if (( LA(1) in [TT_SEMPRED])) then
begin
semPred := LT(1);
match(TT_SEMPRED);
fGrammarMaker.refSemPred( semPred);
end
else if (( LA(1) in [TT_TREE_BEGIN])) then
begin
tree;
end
else
Raise EMismatchedToken.Create( LT(1), [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF], InputState.FileName);
end;
// ============================================================================
// elementOptions
// ============================================================================
procedure TDpgParser.elementOptions;
var
name : IToken;
value : IToken;
begin
match(TT_OPEN);
name := id;
match(TT_ASSIGN);
value := optionValue;
fGrammarMaker.refElemOption(name,value);
while(true) do
begin
if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then
begin
name := id;
match(TT_ASSIGN);
value := optionValue;
fGrammarMaker.refElemOption(name,value);
end
else
break;
end;
match(TT_CLOSE);
end;
// ============================================================================
// range
// ============================================================================
procedure TDpgParser.range( pTokenLabel: IToken);
var
crLeft: IToken;
crRight: IToken;
trLeft: IToken;
trRight: IToken;
autoGen: integer;
begin
autoGen := AUTOGEN_NONE;
if (( LA(1) in [TT_CHARLIT])) then
begin
crLeft := LT(1);
match(TT_CHARLIT);
match(TT_RANGE);
crRight := LT(1);
match(TT_CHARLIT);
if (( LA(1) in [TT_BANG])) then
begin
match(TT_BANG);
autoGen := AUTOGEN_BANG;
end;
fGrammarMaker.refCharRange( crLeft, crRight, pTokenLabel, autoGen, lastInRule);
end
else if (( LA(1) in [TT_STRINGLIT,TT_TOKENREF])) then
begin
if (( LA(1) in [TT_TOKENREF])) then
begin
trLeft := LT(1);
match(TT_TOKENREF);
end
else if (( LA(1) in [TT_STRINGLIT])) then
begin
trLeft := LT(1);
match(TT_STRINGLIT);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName);
match(TT_RANGE);
if (( LA(1) in [TT_TOKENREF])) then
begin
trRight := LT(1);
match(TT_TOKENREF);
end
else if (( LA(1) in [TT_STRINGLIT])) then
begin
trRight := LT(1);
match(TT_STRINGLIT);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_STRINGLIT,TT_TOKENREF], InputState.FileName);
autoGen := astTypeSpec;
fGrammarMaker.refTokenRange( trLeft, trRight, pTokenLabel, autoGen, lastInRule);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF], InputState.FileName);
end;
// ============================================================================
// terminal
// ============================================================================
procedure TDpgParser.terminal( pTokenLabel: IToken);
var
aa: IToken;
cl: IToken;
sl: IToken;
tr: IToken;
wc: IToken;
autoGen : integer;
begin
autoGen := AUTOGEN_NONE;
aa := nil;
if (( LA(1) in [TT_CHARLIT])) then
begin
cl := LT(1);
match(TT_CHARLIT);
if (( LA(1) in [TT_BANG])) then
begin
match(TT_BANG);
autoGen := AUTOGEN_BANG;
end;
fGrammarMaker.refCharLiteral( cl, pTokenLabel, false, autoGen, lastInRule);
end
else if (( LA(1) in [TT_TOKENREF])) then
begin
tr := LT(1);
match(TT_TOKENREF);
autoGen := astTypeSpec;
if (( LA(1) in [TT_ARGACTION])) then
begin
aa := LT(1);
match(TT_ARGACTION);
end;
fGrammarMaker.refToken( nil, tr, pTokenLabel, aa, false, autoGen, lastInRule);
end
else if (( LA(1) in [TT_STRINGLIT])) then
begin
sl := LT(1);
match(TT_STRINGLIT);
autoGen := astTypeSpec;
fGrammarMaker.refStringLiteral( sl, pTokenLabel, autoGen, lastInRule);
end
else if (( LA(1) in [TT_WILDCARD])) then
begin
wc := LT(1);
match(TT_WILDCARD);
autogen := astTypeSpec;
fGrammarMaker.refWildCard( wc, pTokenLabel, autoGen);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_WILDCARD,TT_CHARLIT..TT_STRINGLIT,TT_TOKENREF], InputState.FileName);
end;
// ============================================================================
// notTerminal
// ============================================================================
procedure TDpgParser.notTerminal( pTokenLabel: IToken);
var
cl: IToken;
tr: IToken;
autoGen : integer;
begin
autoGen := AUTOGEN_NONE;
if (( LA(1) in [TT_CHARLIT])) then
begin
cl := LT(1);
match(TT_CHARLIT);
if (( LA(1) in [TT_BANG])) then
begin
match(TT_BANG);
autoGen := AUTOGEN_BANG;
end;
fGrammarMaker.refCharLiteral( cl, pTokenLabel, true, autoGen, lastInRule);
end
else if (( LA(1) in [TT_TOKENREF])) then
begin
tr := LT(1);
match(TT_TOKENREF);
autoGen := astTypeSpec;
fGrammarMaker.refToken( nil, tr, pTokenLabel, nil, true, autoGen, lastInRule);
end
else
Raise EMismatchedToken.Create( LT(1), [TT_CHARLIT,TT_TOKENREF], InputState.FileName);
end;
// ============================================================================
// ebnf
// ============================================================================
procedure TDpgParser.ebnf( pTokenLabel: IToken; pTokenNot: boolean);
var
aa: IToken;
lp: IToken;
m: IToken;
n: IToken;
begin
lp := LT(1);
match(TT_LPAREN);
fGrammarMaker.beginSubrule( pTokenLabel, lp, pTokenNot);
if (( LA(1) in [TT_OPTIONS])) then
begin
subRuleOptions;
if (( LA(1) in [TT_ACTION])) then
begin
aa := LT(1);
match(TT_ACTION);
fGrammarMaker.refInitAction(aa);
end;
match(TT_COLON);
end
else if (( LA(1) in [TT_ACTION]) and (LA(2) in [TT_COLON])) then
begin
aa := LT(1);
match(TT_ACTION);
fGrammarMaker.refInitAction(aa);
match(TT_COLON);
end;
block;
match(TT_RPAREN);
if (( LA(1) in [TT_QUEST])) then
begin
match(TT_QUEST);
fGrammarMaker.optionalSubrule;
end
else if (( LA(1) in [TT_STAR])) then
begin
match(TT_STAR);
fGrammarMaker.zeroOrMoreSubrule;
end
else if (( LA(1) in [TT_PLUS])) then
begin
match(TT_PLUS);
fGrammarMaker.oneOrMoreSubrule;
end
else if (( LA(1) in [TT_AT])) then
begin
match(TT_AT);
fGrammarMaker.nmSubrule;
match(TT_LPAREN);
if (( LA(1) in [TT_INTEGER])) then
begin
m := LT(1);
match(TT_INTEGER);
fGrammarMaker.refRangeLow( StrToInt(m.TokenText));
if (( LA(1) in [TT_COMMA])) then
begin
match(TT_COMMA);
fGrammarMaker.refRangeHigh( maxint);
if (( LA(1) in [TT_INTEGER])) then
begin
n := LT(1);
match(TT_INTEGER);
fGrammarMaker.refRangeHigh(StrToInt(n.TokenText));
end;
end;
end
else if (( LA(1) in [TT_COMMA])) then
begin
match(TT_COMMA);
n := LT(1);
match(TT_INTEGER);
fGrammarMaker.refRangeHigh(StrToInt(n.TokenText));
end
else
Raise EMismatchedToken.Create( LT(1), [TT_COMMA,TT_INTEGER], InputState.FileName);
match(TT_RPAREN);
end
else if (( LA(1) in [TT_IMPLIES])) then
begin
match(TT_IMPLIES);
fGrammarMaker.synPred;
end;
fGrammarMaker.endSubRule;
end;
// ============================================================================
// tree
// ============================================================================
procedure TDpgParser.tree;
var
_cnt_75: integer;
lp: IToken;
begin
lp := LT(1);
match(TT_TREE_BEGIN);
fGrammarMaker.BeginTree(lp);
rootNode;
fGrammarMaker.BeginChildList;
_cnt_75 := 0;
while(true) do
begin
if (( LA(1) in [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF])) then
begin
element;
end
else
begin
if _cnt_75 >= 1 then
break
else
Raise EMismatchedToken.Create( LT(1), [TT_SEMPRED,TT_LPAREN,TT_NOT,TT_WILDCARD,TT_TREE_BEGIN..TT_STRINGLIT,TT_ACTION..TT_RULEREF], InputState.FileName);
end;
INC(_cnt_75);
end;
fGrammarMaker.EndChildList;
match(TT_RPAREN);
fGrammarMaker.EndTree;
end;
// ============================================================================
// rootNode
// ============================================================================
procedure TDpgParser.rootNode;
var
l : IToken;
begin
if (( LA(1) in [TT_TOKENREF..TT_RULEREF]) and (LA(2) in [TT_COLON])) then
begin
l := id;
match(TT_COLON);
CheckEndRule(l);
end;
terminal(l);
end;
// ============================================================================
// astTypeSpec
// ============================================================================
function TDpgParser.astTypeSpec: integer;
begin
result := AUTOGEN_NONE;
if (( LA(1) in [TT_CARET])) then
begin
match(TT_CARET);
result := AUTOGEN_CARET;
end
else if (( LA(1) in [TT_BANG])) then
begin
match(TT_BANG);
result := AUTOGEN_BANG;
end;
end;
// ============================================================================
// subRuleOptions
// ============================================================================
procedure TDpgParser.subRuleOptions;
var
optName : IToken;
optValue : IToken;
begin
match(TT_OPTIONS);
while(true) do
begin
if (( LA(1) in [TT_TOKENREF..TT_RULEREF])) then
begin
optName := id;
match(TT_ASSIGN);
optValue := optionValue;
match(TT_SEMI);
fGrammarMaker.setSubruleOption( optName, optValue);
end
else
break;
end;
match(TT_RCURLY);
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TDpgParser.Create( pParserState : IParserState;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString);
begin
inherited Create( pParserState, 2);
fGrammarMaker := pGrammarMaker;
fExchangeDir := pExchangeDir;
fTool := pTool;
fNesting := 0;
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TDpgParser.Create( pTokenBuffer : ITokenBuffer;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString);
begin
inherited Create( pTokenBuffer, 2);
fGrammarMaker := pGrammarMaker;
fExchangeDir := pExchangeDir;
fTool := pTool;
fNesting := 0;
end;
// ============================================================================
// Constructor
// ============================================================================
constructor TDpgParser.Create( pTokenStream : ITokenStream;
pGrammarMaker : IGrammarBehavior;
pTool : ITool;
pExchangeDir : AnsiString);
begin
inherited Create( pTokenStream, 2);
fGrammarMaker := pGrammarMaker;
fExchangeDir := pExchangeDir;
fTool := pTool;
fNesting := 0;
end;
// ============================================================================
// Destructor
// ============================================================================
destructor TDpgParser.Destroy;
begin
fGrammarMaker := nil;
fTool := nil;
inherited;
end;
// ============================================================================
// lastInRule
// ============================================================================
function TDpgParser.lastInRule: boolean;
begin
if (fNesting = 0) and (LA(1) in [TT_SEMI, TT_OR])
then result := true
else result := false;
end;
// ============================================================================
// checkEndRule
// ============================================================================
procedure TDpgParser.checkEndRule( pToken: IToken);
begin
if pToken <> nil then
if pToken.TokenColumn = 1 then
fTool.Warning('Did you forget to close the previous rule?',
InputState.FileName,
pToken.TokenLine,
pToken.TokenColumn);
end;
end.
Reference in New Issue View Git Blame Copy Permalink