Files
bds.mr.dpg/src.lib/dpglib.Utils.pas
T
2026-01-03 18:33:48 +01:00

623 lines
21 KiB
ObjectPascal

unit dpglib.utils;
interface
uses
System.Classes,
Generics.Collections,
dpgrtl.types,
dpglib.types;
type
cType = (ctOther, ctNumber, ctAlpha, ctAlnum, ctPrint);
sType = set of cType;
TCharFormater = function ( c: char): AnsiString;
function IsNumber( c: AnsiChar): boolean;
function IsAlpha( c: AnsiChar): boolean;
function IsAlnum( c: AnsiChar): boolean;
function IsPrint( c: AnsiChar): boolean;
function StringToID( s: AnsiString): AnsiString;
function DelphiCharFormater( c : AnsiChar) : AnsiString;
function DelphiTokenFormater( t : integer;
tm : ITokenManager = nil) : AnsiString;
function TokenSetToStr( pBS : TByteSet;
pTM : ITokenManager = nil): AnsiString;
{
function DelphiTokenFormater( t : integer;
v : TStringList = nil) : AnsiString;
function TokenSetToStr( pBS : TByteSet;
pVocab: TStringList = nil): AnsiString;
}
function CharSetToStr( pBS : TCharSet;
pFmt : TCharFormater= nil): AnsiString; overload;
function CharSetToStr( pBS : TByteSet;
pFmt : TCharFormater= nil): AnsiString; overload;
implementation
uses
System.SysUtils,
System.StrUtils;
var
c : AnsiChar;
cTable: array [AnsiChar] of sType;
// ----------------------------------------------------------------------------
// GetStringOfToken
// ----------------------------------------------------------------------------
{
function GetStringOfToken( t: integer; v: TStringList): AnsiString;
var
i : integer;
p : integer;
name : AnsiString;
value : AnsiString;
str : AnsiString;
begin
result := '';
for i:=0 to v.Count-1 do
begin
name := v.Names[i];
value := v.ValueFromIndex[i];
if StrToIntDef( value,-1) = t then
begin
if name[1] = '"' then
begin
name := Copy(name,2,Length(name)-2);
result := 'LT_' + name;
result := AnsiReplaceText( result, '$', '_DOLLAR_');
result := AnsiReplaceText( result, '/', '_SLASH_');
result := AnsiReplaceText( result, ':', '_COLON_');
result := AnsiReplaceText( result, '.', '_DOT_');
result := AnsiReplaceText( result, 'LT__', 'LT_');
break;
end
else
begin
result := 'TT_' + name;
break;
end;
end;
end;
end;
}
// ----------------------------------------------------------------------------
// GetStringOfToken
// ----------------------------------------------------------------------------
function GetStringOfToken( t: integer; tm: ITokenManager): AnsiString;
var
ts : ITokenSymbol;
ss : IStringSymbol;
begin
result := '';
ts := tm.TokenSymbolByType[t];
if Assigned(ts) then
begin
ts.QueryInterface( IStringSymbol, ss);
if Assigned(ss) then
begin
if ss.Lbl <> ''
then result := ss.Lbl
else result := 'LT_'+ss.ID;
result := AnsiString( AnsiReplaceText( String(result), '#', '_SHARP_'));
result := AnsiString( AnsiReplaceText( String(result), '*', '_STAR_'));
result := AnsiString( AnsiReplaceText( String(result), '$', '_DOLLAR_'));
result := AnsiString( AnsiReplaceText( String(result), '/', '_SLASH_'));
result := AnsiString( AnsiReplaceText( String(result), ':', '_COLON_'));
result := AnsiString( AnsiReplaceText( String(result), '.', '_DOT_'));
result := AnsiString( AnsiReplaceText( String(result), 'LT__', 'LT_'));
end
else
result := 'TT_' +ts.ID;
end
end;
// ----------------------------------------------------------------------------
// DelphiCharFormater
// ----------------------------------------------------------------------------
function DelphiCharFormater( c: AnsiChar): AnsiString;
var
tmp: string;
begin
if isPrint( c) then
if c = '''' then
tmp := ''''''''''
else
tmp := '''' + c + ''''
else
tmp := '#' + IntToStr( ord(c));
result := AnsiString( tmp);
end;
// ----------------------------------------------------------------------------
// DelphiTokenFormater
// ----------------------------------------------------------------------------
function DelphiTokenFormater( t: integer; tm: ITokenManager): AnsiString;
begin
if tm <> nil then
result := GetStringOfToken( t, tm);
if result = '' then
result := AnsiString( 'TT_' + Format('%3.3d',[t]));
end;
{
function DelphiTokenFormater( t: integer; v: TStringList): AnsiString;
begin
if v <> nil then
result := GetStringOfToken( t, v);
if result = '' then
result := 'TT_' + Format('%3.3d',[t]);
end;
}
// ----------------------------------------------------------------------------
// TokenSetToStr
// ----------------------------------------------------------------------------
function TokenSetToStr( pBS : TByteSet;
pTM : ITokenManager): AnsiString;
var
t : integer;
firstToken : integer;
lastToken : integer;
begin
result := '';
t := 0;
while t <= 255 do
begin
// ------------------------------------------------------------
// Find the first "bit" of the range
// ------------------------------------------------------------
while (not (t in pBS)) and (t <= 255) do
INC(t);
// ------------------------------------------------------------
// Check that we are reached the end
// ------------------------------------------------------------
if t = 256 then
break;
// ------------------------------------------------------------
// OK, we found the first "bit" of the range
// ------------------------------------------------------------
firstToken := t;
// ------------------------------------------------------------
// Fin the last "bit" of the range
// ------------------------------------------------------------
while (t in pBS) and (t <= 255) do
INC(t);
lastToken := pred(t);
// ------------------------------------------------------------
// Append "," to the result if this founded range is not the
// first in the result.
// ------------------------------------------------------------
if result <> '' then
result := result + ',';
// ------------------------------------------------------------
// Build the first "bit" into the result
// ------------------------------------------------------------
result := result + DelphiTokenFormater( firstToken, pTM);
// ------------------------------------------------------------
// Build range if the firstChar not equals to the lastChar
// ------------------------------------------------------------
if firstToken <> lastToken then
result := result + '..' + DelphiTokenFormater( lastToken, pTM);
end;
end;
{
function TokenSetToStr( pBS : TByteSet;
pVocab: TStringList): AnsiString;
var
t : integer;
firstToken : integer;
lastToken : integer;
begin
result := '';
t := 0;
while t <= 255 do
begin
// ------------------------------------------------------------
// Find the first "bit" of the range
// ------------------------------------------------------------
while (not (t in pBS)) and (t <= 255) do
INC(t);
// ------------------------------------------------------------
// Check that we are reached the end
// ------------------------------------------------------------
if t = 256 then
break;
// ------------------------------------------------------------
// OK, we found the first "bit" of the range
// ------------------------------------------------------------
firstToken := t;
// ------------------------------------------------------------
// Fin the last "bit" of the range
// ------------------------------------------------------------
while (t in pBS) and (t <= 255) do
INC(t);
lastToken := pred(t);
// ------------------------------------------------------------
// Append "," to the result if this founded range is not the
// first in the result.
// ------------------------------------------------------------
if result <> '' then
result := result + ',';
// ------------------------------------------------------------
// Build the first "bit" into the result
// ------------------------------------------------------------
result := result + DelphiTokenFormater( firstToken, pVocab);
// ------------------------------------------------------------
// Build range if the firstChar not equals to the lastChar
// ------------------------------------------------------------
if firstToken <> lastToken then
result := result + '..' + DelphiTokenFormater( lastToken, pVocab);
end;
end;
}
// ----------------------------------------------------------------------------
// CharSetToStr
// ----------------------------------------------------------------------------
function CharSetToStr( pBS : TCharSet;
pFmt : TCharFormater): AnsiString;
var
c : integer;
firstChar: AnsiChar;
lastChar : AnsiChar;
begin
result := '';
c := 0;
while c <= 255 do
begin
// ------------------------------------------------------------
// Find the first "bit" of the range
// ------------------------------------------------------------
while (not (AnsiChar(c) in pBS)) and (c <= 255) do
INC(c);
// ------------------------------------------------------------
// Check that we are reached the end
// ------------------------------------------------------------
if c = 256 then
break;
// ------------------------------------------------------------
// OK, we found the first "bit" of the range
// ------------------------------------------------------------
firstChar := AnsiChar(c);
// ------------------------------------------------------------
// Find the last "bit" of the range
// ------------------------------------------------------------
while (AnsiChar(c) in pBS) and (c <= 255) do
INC(c);
lastChar := pred(AnsiChar(c));
// ------------------------------------------------------------
// Append "," to the result if this founded range is not the
// first in the result.
// ------------------------------------------------------------
if result <> '' then
result := result + ',';
// ------------------------------------------------------------
// Build the first "bit" into the result
// ------------------------------------------------------------
result := result + DelphiCharFormater( firstChar);
// ------------------------------------------------------------
// Build range if the firstChar not equals to the lastChar
// ------------------------------------------------------------
if firstChar <> lastChar then
result := result + '..' + DelphiCharFormater( lastChar);
end;
end;
// ----------------------------------------------------------------------------
// CharSetToStr
// ----------------------------------------------------------------------------
function CharSetToStr( pBS : TByteSet;
pFmt : TCharFormater): AnsiString;
var
c : integer;
firstChar: AnsiChar;
lastChar : AnsiChar;
begin
result := '';
c := 0;
while c <= 255 do
begin
// ------------------------------------------------------------
// Find the first "bit" of the range
// ------------------------------------------------------------
while (not (c in pBS)) and (c <= 255) do
INC(c);
// ------------------------------------------------------------
// Check that we are reached the end
// ------------------------------------------------------------
if c = 256 then
break;
// ------------------------------------------------------------
// OK, we found the first "bit" of the range
// ------------------------------------------------------------
firstChar := AnsiChar(c);
// ------------------------------------------------------------
// Fin the last "bit" of the range
// ------------------------------------------------------------
while (c in pBS) and (c <= 255) do
INC(c);
lastChar := AnsiChar(pred(c));
// ------------------------------------------------------------
// Append "," to the result if this founded range is not the
// first in the result.
// ------------------------------------------------------------
if result <> '' then
result := result + ',';
// ------------------------------------------------------------
// Build the first "bit" into the result
// ------------------------------------------------------------
result := result + DelphiCharFormater( firstChar);
// ------------------------------------------------------------
// Build range if the firstChar not equals to the lastChar
// ------------------------------------------------------------
if firstChar <> lastChar then
result := result + '..' + DelphiCharFormater( lastChar);
end;
end;
// ----------------------------------------------------------------------------
// IsNumber
// ----------------------------------------------------------------------------
function IsNumber( c: AnsiChar): boolean;
begin
result := ctNumber in cTable[c];
end;
// ----------------------------------------------------------------------------
// IsAlpha
// ----------------------------------------------------------------------------
function IsAlpha( c: AnsiChar): boolean;
begin
result := ctAlpha in cTable[c];
end;
// ----------------------------------------------------------------------------
// IsAlnum
// ----------------------------------------------------------------------------
function IsAlnum( c: AnsiChar): boolean;
begin
result := ctAlnum in cTable[c];
end;
// ----------------------------------------------------------------------------
// IsPrint
// ----------------------------------------------------------------------------
function IsPrint( c: AnsiChar): boolean;
begin
result := ctPrint in cTable[c];
end;
// ================================================================================================
// Convert string to a valid identifier name
// ================================================================================================
function StringToID( s: AnsiString): AnsiString;
var
i: integer;
c: AnsiChar;
begin
result := '';
for c in s do
begin
if IsAlnum(c) then
result := result +c
else if IsPrint(c) then
case c of
' ' : result := result + '_SPACE_';
'!' : result := result + '_EXCL_';
'#' : result := result + '_SHARP_';
'$' : result := result + '_DOLLAR_';
'§' : result := result + '_PARA_';
'%' : result := result + '_PERCENT_';
'&' : result := result + '_AND_';
'''' : result := result + '_APOSTROPHE_';
'(' : result := result + '_LPAREN_';
')' : result := result + '_RPAREN_';
'*' : result := result + '_STAR_';
'+' : result := result + '_PLUS_';
',' : result := result + '_COMMA_';
'-' : result := result + '_MINUS_';
'.' : result := result + '_DOT_';
'/' : result := result + '_SLASH_';
':' : result := result + '_COLON_';
';' : result := result + '_SEMI_';
'<' : result := result + '_LT_';
'=' : result := result + '_EQ_';
'>' : result := result + '_GT_';
'?' : result := result + '_QUESTION_';
'@' : result := result + '_AT_';
'[' : result := result + '_LBRACKET_';
'\' : result := result + '_BS_';
']' : result := result + '_RBRACKET_';
'^' : result := result + '_CARET_';
'{' : result := result + '_LCURLY_';
'|' : result := result + '_OR_';
'}' : result := result + '_RCURLY_';
'~' : result := result + '_TILDE_';
else result := result + Format('_0x2.2%x_',[c]);
end;
end;
if (Length(result) > 0) and (RightStr( result, 1) = '_') then
result := Copy( result, 1, Length(result)-1);
end;
// ****************************************************************************
// Initialization/finalization
// ****************************************************************************
initialization
for c:=#0 to #255 do
cTable[c] := [ctOther];
cTable[ ' '] := [ctPrint];
cTable[ '!'] := [ctPrint];
cTable[ '"'] := [ctPrint];
cTable[ '#'] := [ctPrint];
cTable[ '$'] := [ctPrint];
cTable[ '§'] := [ctPrint];
cTable[ '%'] := [ctPrint];
cTable[ '&'] := [ctPrint];
cTable[ ''''] := [ctPrint];
cTable[ '('] := [ctPrint];
cTable[ ')'] := [ctPrint];
cTable[ '*'] := [ctPrint];
cTable[ '+'] := [ctPrint];
cTable[ ','] := [ctPrint];
cTable[ '-'] := [ctPrint];
cTable[ '.'] := [ctPrint];
cTable[ '/'] := [ctPrint];
cTable[ '0'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '1'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '2'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '3'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '4'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '5'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '6'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '7'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '8'] := [ctPrint, ctNumber, ctAlnum];
cTable[ '9'] := [ctPrint, ctNumber, ctAlnum];
cTable[ ':'] := [ctPrint];
cTable[ ';'] := [ctPrint];
cTable[ '<'] := [ctPrint];
cTable[ '='] := [ctPrint];
cTable[ '>'] := [ctPrint];
cTable[ '?'] := [ctPrint];
cTable[ '@'] := [ctPrint];
cTable[ 'A'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'B'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'C'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'D'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'E'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'F'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'G'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'H'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'I'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'J'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'K'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'L'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'M'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'N'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'O'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'P'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'Q'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'R'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'S'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'T'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'U'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'V'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'W'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'X'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'Y'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'Z'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ '['] := [ctPrint];
cTable[ '\'] := [ctPrint];
cTable[ ']'] := [ctPrint];
cTable[ '^'] := [ctPrint];
cTable[ '_'] := [ctPrint];
cTable[ '`'] := [ctPrint];
cTable[ 'a'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'b'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'c'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'd'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'e'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'f'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'g'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'h'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'i'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'j'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'k'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'l'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'm'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'n'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'o'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'p'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'q'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'r'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 's'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 't'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'u'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'v'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'w'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'x'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'y'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ 'z'] := [ctPrint, ctAlpha, ctAlnum];
cTable[ '{'] := [ctPrint];
cTable[ '|'] := [ctPrint];
cTable[ '}'] := [ctPrint];
cTable[ '~'] := [ctPrint];
end.