Initial check in lib

This commit is contained in:
2026-01-03 18:33:48 +01:00
parent b20cd8e688
commit 5666f85e99
89 changed files with 36370 additions and 1 deletions
File diff suppressed because it is too large Load Diff
+72
View File
@@ -0,0 +1,72 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.DpgLexer.g
// ============================================================================
unit dpglib.DpgLexerTokens;
interface
const
TT_EOF = 1;
LT_unit = 4;
LT_uses = 5;
LT_const = 6;
LT_type = 7;
LT_lexer = 8;
LT_parser = 9;
LT_options = 10;
LT_tokens = 11;
LT_memberdecl = 12;
LT_memberdef = 13;
LT_private = 14;
LT_protected = 15;
LT_public = 16;
LT_returns = 17;
LT_local = 18;
LT_except = 19;
LT_finally = 20;
TT_SEMPRED = 21;
TT_USES = 22;
TT_OPTIONS = 23;
TT_TOKENS = 24;
TT_LPAREN = 25;
TT_RPAREN = 26;
TT_RCURLY = 27;
TT_COLON = 28;
TT_SEMI = 29;
TT_COMMA = 30;
TT_ASSIGN = 31;
TT_IMPLIES = 32;
TT_QUEST = 33;
TT_PLUS = 34;
TT_STAR = 35;
TT_AT = 36;
TT_NOT = 37;
TT_OR = 38;
TT_BANG = 39;
TT_WILDCARD = 40;
TT_RANGE = 41;
TT_CHARLIT = 42;
TT_STRINGLIT = 43;
TT_INTEGER = 44;
TT_ARGACTION = 45;
TT_ACTION = 46;
TT_TOKENREF = 47;
TT_RULEREF = 48;
TT_INT_RULEREF = 49;
TT_COMMENT = 50;
TT_SLCOMMENT = 51;
TT_MLCOMMENT1 = 52;
TT_MLCOMMENT2 = 53;
TT_DNUMBER = 54;
TT_XNUMBER = 55;
TT_DDIGIT = 56;
TT_XDIGIT = 57;
TT_WS = 58;
TT_WS_LOOP = 59;
TT_ESC = 60;
implementation
end.
File diff suppressed because it is too large Load Diff
+72
View File
@@ -0,0 +1,72 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.DpgParser.g
// ============================================================================
unit dpglib.DpgParserTokens;
interface
const
TT_EOF = 1;
LT_unit = 4;
LT_uses = 5;
LT_const = 6;
LT_type = 7;
LT_lexer = 8;
LT_parser = 9;
LT_options = 10;
LT_tokens = 11;
LT_memberdecl = 12;
LT_memberdef = 13;
LT_private = 14;
LT_protected = 15;
LT_public = 16;
LT_returns = 17;
LT_local = 18;
LT_except = 19;
LT_finally = 20;
TT_SEMPRED = 21;
TT_USES = 22;
TT_OPTIONS = 23;
TT_TOKENS = 24;
TT_LPAREN = 25;
TT_RPAREN = 26;
TT_RCURLY = 27;
TT_COLON = 28;
TT_SEMI = 29;
TT_COMMA = 30;
TT_ASSIGN = 31;
TT_IMPLIES = 32;
TT_QUEST = 33;
TT_PLUS = 34;
TT_STAR = 35;
TT_AT = 36;
TT_NOT = 37;
TT_OR = 38;
TT_BANG = 39;
TT_WILDCARD = 40;
TT_RANGE = 41;
TT_CHARLIT = 42;
TT_STRINGLIT = 43;
TT_INTEGER = 44;
TT_ARGACTION = 45;
TT_ACTION = 46;
TT_TOKENREF = 47;
TT_RULEREF = 48;
TT_INT_RULEREF = 49;
TT_COMMENT = 50;
TT_SLCOMMENT = 51;
TT_MLCOMMENT1 = 52;
TT_MLCOMMENT2 = 53;
TT_DNUMBER = 54;
TT_XNUMBER = 55;
TT_DDIGIT = 56;
TT_XDIGIT = 57;
TT_WS = 58;
TT_WS_LOOP = 59;
TT_ESC = 60;
implementation
end.
+622
View File
@@ -0,0 +1,622 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.TokenLexer.g
// ============================================================================
unit dpglib.TokenLexer;
interface
uses
Classes,
SysUtils,
dpglib.TokenLexerTokens,
dpgrtl.lexer,
dpgrtl.types;
type
// =========================================================================
// Class TTokenLexer declaration
// =========================================================================
TTokenLexer = class( TLexer)
public // Protected grammar rules
// Must callable from parser too
procedure mDIGIT ( pCreate: boolean);
procedure mXDIGIT ( pCreate: boolean);
public // Public grammar rules
procedure mLPAREN ( pCreate: boolean);
procedure mRPAREN ( pCreate: boolean);
procedure mASSIGN ( pCreate: boolean);
procedure mSTRING ( pCreate: boolean);
procedure mID ( pCreate: boolean);
procedure mINT ( pCreate: boolean);
procedure mWS ( pCreate: boolean);
procedure mSLCOMMENT ( pCreate: boolean);
procedure mMLCOMMENT ( pCreate: boolean);
public
function NextToken: IToken; override;
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// mLPAREN
// ============================================================================
procedure TTokenLexer.mLPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_LPAREN;
match('(');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mRPAREN
// ============================================================================
procedure TTokenLexer.mRPAREN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_RPAREN;
match(')');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mASSIGN
// ============================================================================
procedure TTokenLexer.mASSIGN( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ASSIGN;
match('=');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSTRING
// ============================================================================
procedure TTokenLexer.mSTRING( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_STRING;
match('"');
while(true) do
begin
if (( LA(1) in [#1..'!','#'..#255])) then
begin
matchNot('"');
end
else
break;
end;
match('"');
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mDIGIT
// ============================================================================
procedure TTokenLexer.mDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_DIGIT;
match( ['0'..'9']);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mXDIGIT
// ============================================================================
procedure TTokenLexer.mXDIGIT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_XDIGIT;
if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else if (( LA(1) in ['a'..'f'])) then
begin
match( ['a'..'f']);
end
else if (( LA(1) in ['A'..'F'])) then
begin
match( ['A'..'F']);
end
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9','A'..'F','a'..'f'], InputState.FileName, InputState.Line, InputState.Column);
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mID
// ============================================================================
procedure TTokenLexer.mID( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_ID;
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else
Raise EMismatchedChar.Create( LA(1), ['A'..'Z','a'..'z'], InputState.FileName, InputState.Line, InputState.Column);
while(true) do
begin
if (( LA(1) in ['a'..'z'])) then
begin
match( ['a'..'z']);
end
else if (( LA(1) in ['A'..'Z'])) then
begin
match( ['A'..'Z']);
end
else if (( LA(1) in ['_'])) then
begin
match('_');
end
else if (( LA(1) in ['0'..'9'])) then
begin
match( ['0'..'9']);
end
else
break;
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mINT
// ============================================================================
procedure TTokenLexer.mINT( pCreate: boolean);
var
_begin: integer;
_cnt_15: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_INT;
_cnt_15 := 0;
while(true) do
begin
if (( LA(1) in ['0'..'9'])) then
begin
mDIGIT(false);
end
else
begin
if _cnt_15 >= 1 then
break
else
Raise EMismatchedChar.Create( LA(1), ['0'..'9'], InputState.FileName, InputState.Line, InputState.Column);
end;
INC(_cnt_15);
end;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mWS
// ============================================================================
procedure TTokenLexer.mWS( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_WS;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [' '])) then
begin
match(' ');
end
else if (( LA(1) in [#9])) then
begin
match(#9);
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#9..#10,#13,' '], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mSLCOMMENT
// ============================================================================
procedure TTokenLexer.mSLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_SLCOMMENT;
match('//');
while(true) do
begin
if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else
Raise EMismatchedChar.Create( LA(1), [#10,#13], InputState.FileName, InputState.Line, InputState.Column);
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ============================================================================
// mMLCOMMENT
// ============================================================================
procedure TTokenLexer.mMLCOMMENT( pCreate: boolean);
var
_begin: integer;
_save: integer;
_token: IToken;
_ttype: integer;
begin
_begin := Length( TokenText) +1;
_token := nil;
_ttype := TT_MLCOMMENT;
match('(*');
while(true) do
begin
// non-greedy exit test
if( LA(1) in ['*']) and (LA(2) in [')']) then
break;
if (( LA(1) in [#13]) and (LA(2) in [#10])) then
begin
match(#13);
match(#10);
newLine;
end
else if (( LA(1) in [#13])) then
begin
match(#13);
newLine;
end
else if (( LA(1) in [#10])) then
begin
match(#10);
newLine;
end
else if (( LA(1) in [#1..#9,#11..#12,#14..#255])) then
begin
match( [#1..#9,#11..#12,#14..#255]);
end
else
break;
end;
match('*)');
_ttype := TT_SKIP;
if (_ttype <> TT_SKIP) and (pCreate = true) then
begin
_token := makeToken( _ttype);
_token.TokenText := Copy( TokenText, _begin, Length(TokenText)-_begin+1);
end;
ReturnToken := _token;
end;
// ----------------------------------------------------------------------------
// NextToken
// ----------------------------------------------------------------------------
function TTokenLexer.NextToken : IToken;
var
_first : TCharSet;
begin
_first := [#9..#10,#13,' ','"','('..')','/'..'9','=','A'..'Z','a'..'z'];
while( true) do
begin
ResetText;
try
if (( LA(1) in ['(']) and (LA(2) in ['*'])) then
begin
mMLCOMMENT(true);
result := ReturnToken;
end
else if (( LA(1) in ['('])) then
begin
mLPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in [')'])) then
begin
mRPAREN(true);
result := ReturnToken;
end
else if (( LA(1) in ['='])) then
begin
mASSIGN(true);
result := ReturnToken;
end
else if (( LA(1) in ['"'])) then
begin
mSTRING(true);
result := ReturnToken;
end
else if (( LA(1) in ['A'..'Z','a'..'z'])) then
begin
mID(true);
result := ReturnToken;
end
else if (( LA(1) in ['0'..'9'])) then
begin
mINT(true);
result := ReturnToken;
end
else if (( LA(1) in [#9..#10,#13,' '])) then
begin
mWS(true);
result := ReturnToken;
end
else if (( LA(1) in ['/'])) then
begin
mSLCOMMENT(true);
result := ReturnToken;
end
else
begin
if LA(1) = EOF_CHAR then
begin
uponEof;
result := TToken.Create(TT_EOF);
end
else
Raise EMismatchedChar.Create(LA(1), _first, InputState.FileName, InputState.Line, InputState.Column);
end;
// --------------------------------------------------------------
// If we found a SKIP token, then try again...
// --------------------------------------------------------------
if result = nil then
continue;
// --------------------------------------------------------------
// Now we have a valid token, so exit the function
// --------------------------------------------------------------
break;
except
Raise;
end;
end;
end;
end.
@@ -0,0 +1,26 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.TokenLexer.g
// ============================================================================
unit dpglib.TokenLexerTokens;
interface
const
TT_EOF = 1;
TT_LPAREN = 4;
TT_RPAREN = 5;
TT_ASSIGN = 6;
TT_STRING = 7;
TT_DIGIT = 8;
TT_XDIGIT = 9;
TT_ID = 10;
TT_INT = 11;
TT_WS = 12;
TT_SLCOMMENT = 13;
TT_MLCOMMENT = 14;
implementation
end.
+161
View File
@@ -0,0 +1,161 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.TokenParser.g
// ============================================================================
unit dpglib.TokenParser;
interface
uses
Classes,
SysUtils,
dpglib.StringSymbol,
dpglib.TokenParserTokens,
dpglib.TokenSymbol,
dpglib.Types,
dpgrtl.llkparser,
dpgrtl.types;
type
// =========================================================================
// Class TTokenParser declaration
// =========================================================================
TTokenParser = class( TLLkParser)
public // Public grammar rules
procedure tokenFile ( tm:ITokenManager);
procedure tokenLine ( tm:ITokenManager);
end;
implementation
uses
dpgrtl.exception,
dpgrtl.token;
// ============================================================================
// tokenFile
// ============================================================================
procedure TTokenParser.tokenFile( tm:ITokenManager);
var
name: IToken;
begin
name := LT(1);
match(TT_ID);
while(true) do
begin
if (( LA(1) in [TT_STRING,TT_ID])) then
begin
tokenLine(tm);
end
else
break;
end;
end;
// ============================================================================
// tokenLine
// ============================================================================
procedure TTokenParser.tokenLine( tm:ITokenManager);
var
i: IToken;
id: IToken;
id2: IToken;
lab: IToken;
para: IToken;
s1: IToken;
s2: IToken;
t : IToken;
s : IToken;
v : integer;
sl: IStringSymbol;
ts: ITokenSymbol;
x : AnsiString;
begin
t := nil;
s := nil;
if (( LA(1) in [TT_STRING])) then
begin
s1 := LT(1);
match(TT_STRING);
s := s1;
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_ASSIGN]) and (LA(3) in [TT_STRING])) then
begin
lab := LT(1);
match(TT_ID);
t := lab;
match(TT_ASSIGN);
s2 := LT(1);
match(TT_STRING);
s := s2;
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_LPAREN])) then
begin
id := LT(1);
match(TT_ID);
t := id;
match(TT_LPAREN);
para := LT(1);
match(TT_STRING);
match(TT_RPAREN);
end
else if (( LA(1) in [TT_ID]) and (LA(2) in [TT_ASSIGN]) and (LA(3) in [TT_INT])) then
begin
id2 := LT(1);
match(TT_ID);
t := id2;
end
else
Raise EMismatchedToken.Create( LT(1), [TT_STRING,TT_ID], InputState.FileName);
match(TT_ASSIGN);
i := LT(1);
match(TT_INT);
v := StrToIntDef( i.TokenText, -1);
if s <> nil then
begin
ts := TStringSymbol.Create( s.TokenText);
ts.TokenType := v;
tm.Define(ts);
if t <> nil then
begin
ts := tm.TokenSymbol[s.TokenText];
ts.QueryInterface( IStringSymbol, sl);
sl.Lbl := t.TokenText;
tm.MapToTokenSymbol( t.TokenText, sl);
end;
end
else if t <> nil then
begin
x := Copy( t.TokenText, 4, Length( t.TokenText)-3);
ts := TTokenSymbol.Create( x);
ts.TokenType := v;
tm.Define( ts);
if para <> nil then
begin
ts := tm.TokenSymbol[ t.TokenText];
ts.Paraphrase := para.TokenText;
end;
end;
end;
end.
@@ -0,0 +1,26 @@
// ============================================================================
// This file is generated by the Delphi Parser Generator.
// ----------------------------------------------------------------------------
// DPG version: 2.0.1.0r
// Grammar: dpglib.TokenParser.g
// ============================================================================
unit dpglib.TokenParserTokens;
interface
const
TT_EOF = 1;
TT_LPAREN = 4;
TT_RPAREN = 5;
TT_ASSIGN = 6;
TT_STRING = 7;
TT_DIGIT = 8;
TT_XDIGIT = 9;
TT_ID = 10;
TT_INT = 11;
TT_WS = 12;
TT_SLCOMMENT = 13;
TT_MLCOMMENT = 14;
implementation
end.