a text parser

[arthurprs]

Arthurps's code also doesnt parse properly if you use several separators to separate values (think grid space / tab aligned values): it produces empty values in the array.

can you give me an example?

are you talking about
'lol,,great,xD' => ['lol', '', 'great', 'xD']

i think this is the right way, or not?

[JernejL]

An example directly from my game config files:

debr debr null          %1     0     0  0  0 100 8 0.02 0.07  1 0.3 0.3  5 null  0 0 0.1 2 10 null null 10
sprk sprk null        %00011     0     0  0  0 100 8 0.02 0.07  1 0.1 0.1  3 null  0 0 0.1 0 0 null null 10
bomb bomb flam   %000011001110101     0     0 100 100 3800 8 0.15 0.07  1 0.15 0.15 15 boom  0 1 0.1 0 0 laun null 20
blod blod null          %1     0     0  0  0 300 8 0.001  0.3 0.1 0.5 0.5  0 null  0 0 0.1 0 0 null null 10
bult bult muzl     %00011000111     0     0 40.4  5 1000 8 0.159 -0.03  1 0.2 0.2  3 syse  0 1 0.1 0 0 uzif null 20

[User137]

Sometimes using TIniFile but yeah my 3D model format is still ascii however it's mostly readable with readln() with multiple params. But there's sometimes those special cases when even string parser comes to use... That is 1 of the reason i made mine so "customizable" way, the most common use is something unnormal or for backwards compatibility.

My config files look usually this

???????¥?????™?ß?§?°?û?õ?ò?ï?í?è?ç?ä?á?Ñ?Ŭø¬º¬?¬?¬¥¬?¬Ø¬?¬´¬®¬¶¬§¬¢ ?æ?ì?°Àú‚Äì‚Ä¢‚Äú‚Äò¬ê¬è¬ç?í‚Ä??†À܂İ‚Ć‚Ć‚Ķ‚Äû?í?í‚Äö‚Äö‚Äö¬Å¬Å¬Å¬Å¬Å¬Å¬Å‚Äö‚Äö‚Äö?í?í‚Äû‚Ķ‚ƂƂİÀÜ?†‚Ä??í¬ç¬è¬ê‚Äò‚Äú‚Ä¢‚ÄìÀú?°?ì?æ ¬¢¬§¬¶¬®¬´¬?¬Ø¬?¬¥¬?¬?¬º¬ø?Å?Ñ?á?ä?ç?è?í?ï?ò?õ?û?°?§?ß?™?????¥?????? ???æ¬ù‚Ä??°‚Ñ¢‚Äî‚Äì‚Äù‚Äú‚Äò¬ê???í?†À܂Ć‚Äû‚Äö‚Ǩ~|zxvtrpomljigfecba`¬° ???æ¬ù‚Ä??°Àú‚Äî‚Ä¢‚Äù‚Äô¬ê???í?†À܂Ć‚Äû‚Äö‚Ǩ~|zxvtrpnlkihfecba`_¬¢¬° ???æ?ì‚Ä?‚Ñ¢Àú‚Äì‚Ä¢‚Äú‚Äò¬è¬ç‚Ä?‚Ä?‚Ä°‚Ķ‚Äö‚Ǩ~{ywusqomkjhgedba`_^¬£¬¢¬° ??¬ù

[arthurprs]

An example directly from my game config files:

debr debr null          %1     0     0  0  0 100 8 0.02 0.07  1 0.3 0.3  5 null  0 0 0.1 2 10 null null 10
sprk sprk null        %00011     0     0  0  0 100 8 0.02 0.07  1 0.1 0.1  3 null  0 0 0.1 0 0 null null 10
bomb bomb flam   %000011001110101     0     0 100 100 3800 8 0.15 0.07  1 0.15 0.15 15 boom  0 1 0.1 0 0 laun null 20
blod blod null          %1     0     0  0  0 300 8 0.001  0.3 0.1 0.5 0.5  0 null  0 0 0.1 0 0 null null 10
bult bult muzl     %00011000111     0     0 40.4  5 1000 8 0.159 -0.03  1 0.2 0.2  3 syse  0 1 0.1 0 0 uzif null 20

uhm, the function definitely does not work for this kind of input

[JernejL]

Arthur: offource it parses that line by line, the problem is it uses single space to create new item in array while it shouldnt. the original and athena's function parse it properly.

[jdarling]

Ok, so I'll admit up front that this is cheating. But here is the lexer I use (as a starting point at least) for just about every compiler, lexer, scripter, etc that I work on. As it stands it pretty much handles everything you put in your requirements. Though, I have to admit that the output array isn't directly accessible

[pascal]unit uLexerBase;

interface

const
ttUnknown = 0;
ttNumber = 1;
ttString = 2;
ttComment = 3;
ttWhite = 32;

type
TOnLexerError = procedure(msg : AnsiString; InFile : AnsiString; line, col : LongInt; var Continue : Boolean; Symbol : Pointer) of object;

PLexerClassifierSymbol = ^TLexerClassifierSymbol;
PLexerClassifierSymbolArray=^TLexerClassifierSymbo lArray;
TLexerClassifierSymbolArray = Array of PLexerClassifierSymbol;
TLexerClassifierSymbol = packed record
c : Char; // What character is this?
eow : boolean; // Is this the last character of a word?
data : LongInt; // Anything
below : TLexerClassifierSymbolArray; // Next characters in words.
end;

{ TLexerClassifier }

TLexerClassifier=class
private
fData : TLexerClassifierSymbol;
fSize: Integer;
function GetData: PLexerClassifierSymbol;
procedure Sort(WhatNode : PLexerClassifierSymbol; Start : Integer = -1; Stop : Integer = -1);
function AddChar(WhatChar : Char; ParentNode : PLexerClassifierSymbol; IsEnd : Boolean) : PLexerClassifierSymbol;
public
constructor Create;
destructor Destroy; override;

procedure Clear;

procedure Add(WhatSymbol : AnsiString; Value : LongInt);
function CharExists(WhatChar : Char; ParentNode : PLexerClassifierSymbol; out IsEnd : Boolean) : Boolean; overload;
function CharExists(WhatChar : Char; ParentNode : PLexerClassifierSymbol) : PLexerClassifierSymbol; overload;
function Exists(WhatSymbol : AnsiString; AllowPartial : Boolean = false) : Boolean;
function SymbolData(WhatSymbol : AnsiString) : LongInt;

property Size : Integer read fSize;
property Data : PLexerClassifierSymbol read GetData;
end;

PLexerToken = ^TLexerToken;
TLexerToken = packed record
line, col, srcpos: longint;
Token: ansistring;
TokenType: integer;
end;
TLexerTokenArray = array of TLexerToken;

{ TLexer }

TLexer=class
private
FFileName: AnsiString;
FOnError: TOnLexerError;
FSource : PChar;
FPos: longint;
FLine: longint;
FCol: longint;
FTokenCount: Longint;
FContinue : Boolean;
FTokens : TLexerTokenArray;
FClassifier : TLexerClassifier;
function GetSource: Pointer;
function GetToken(index: integer): PLexerToken;
function GetTokenCount: longint;
procedure SetFileName(const AValue: AnsiString);
procedure SetOnError(const AValue: TOnLexerError);
procedure SetSource(const AValue: Pointer);
protected
function NewToken: PLexerToken;
function CurrToken : PLexerToken;
function Curr: char;
function Prev: char;
function Next(numCharsToSkip: longint = 1): char;
function Peek: char;
function Match(const str: ansistring; IncIfMatched: boolean = True;
ThrowIfNotMatched: boolean = True): boolean;
procedure Throw(msg : AnsiString); overload;
procedure Throw(const msg : AnsiString; args : array of const); overload;

procedure SkipWhite; virtual;
procedure ScanSymol; virtual;
procedure ScanNumber; virtual;
procedure ScanString(const strDelmChar : Char); virtual;
procedure ScanCommentLine(const CommentStart : AnsiString); virtual;
procedure ScanMultiComment(const CommentClose : AnsiString); virtual;
public
constructor Create; virtual;
destructor Destroy; override;

procedure Reset; virtual;
procedure Step; virtual;
function Process : Boolean; virtual;

function EOF: boolean; virtual;
function BOF: boolean; virtual;

property Source: Pointer Read GetSource Write SetSource;
property OnError : TOnLexerError read FOnError write SetOnError;
property FileName: AnsiString read FFileName write SetFileName;

property Pos : LongInt read FPos;
property Line : LongInt read FLine;
property Col : LongInt read FCol;

property TokenCount: longint Read GetTokenCount;
property Token[index: integer]: PLexerToken Read GetToken; default;
end;

implementation

uses
SysUtils;

const
WHITE_SPACE = [#1..#32, #127, #255];
ALPHA = ['a'..'z', 'A'..'Z'];
NUM = ['0'..'9'];
NUM_EXT = NUM + ['.', 'e', 'E'];
ALPHANUM = ALPHA + NUM;
SYM = ALPHANUM + ['_'];

{ TLexerClassifier }

function TLexerClassifier.GetData: PLexerClassifierSymbol;
begin
result := @FData;
end;

procedure TLexerClassifier.Sort(WhatNode: PLexerClassifierSymbol; Start: Integer;
Stop: Integer);
procedure iSort(var r : TLexerClassifierSymbolArray; lo, up : integer );
var
i, j : Integer;
tempr: PLexerClassifierSymbol;
begin
while up>lo do
begin
i := lo;
j := up;
tempr := r[lo];
{*** Split file in two ***}
while i<j do
begin
while r[j]^.c > tempr^.c do
j := j-1; r[i] := r[j];
while (i<j) and (r[i]^.c<=tempr^.c) do
i := i+1;
r[j] := r[i];
end;
r[i] := tempr;
{*** Sort recursively ***}
iSort(r,lo,i-1);
lo := i+1
end
end;
begin
if Start = -1 then
Start := low(WhatNode^.below);
if Stop = -1 then
Stop := high(WhatNode^.below);
if (Start = Stop) or (Start=-1) or (Stop=-1) then
exit;
iSort(WhatNode^.below, Start, Stop);
end;

function TLexerClassifier.AddChar(WhatChar: Char; ParentNode: PLexerClassifierSymbol;
IsEnd: Boolean): PLexerClassifierSymbol;
begin
WhatChar := UpCase(WhatChar);
result := CharExists(WhatChar, ParentNode);
if assigned(result) then
result^.eow := result^.eow or IsEnd
else
begin
new(result);
result^.c := WhatChar;
result^.eow := IsEnd;
result^.data := ttUnknown;
SetLength(ParentNode^.below, length(ParentNode^.below)+1);
ParentNode^.below[length(ParentNode^.below)-1] := result;
Sort(ParentNode);
end;
end;

function TLexerClassifier.CharExists(WhatChar: Char;
ParentNode: PLexerClassifierSymbol; out IsEnd: Boolean): Boolean;
var
n : PLexerClassifierSymbol;
begin
IsEnd := false;
n := CharExists(WhatChar, ParentNode);
result := assigned(n);
if result then
IsEnd := n^.eow;
end;

function TLexerClassifier.CharExists(WhatChar: Char; ParentNode: PLexerClassifierSymbol
): PLexerClassifierSymbol;
var
f, l, j : Integer;
c : Char;
begin
result := nil;
f := 0;
l := length(ParentNode^.below)-1;
WhatChar := UpCase(WhatChar);
if l = -1 then
begin
result := nil;
exit;
end;
while (l-f) > 1 do
begin
j := (l+f) div 2;
c := ParentNode^.below[j]^.c;
if WhatChar <= c then
l := j
else
f := j;
end;
c := ParentNode^.below[l]^.c;
if c = WhatChar then
result := ParentNode^.below[l]
else if (l <> f) and (f>=0) then
begin
c := ParentNode^.below[f]^.c;
if c = WhatChar then
result := ParentNode^.below[f]
end;
end;

constructor TLexerClassifier.Create;
begin
end;

destructor TLexerClassifier.Destroy;
begin
Clear;
inherited Destroy;
end;

procedure TLexerClassifier.Clear;
var
i : Integer;
procedure ClearNode(WhatNode : PLexerClassifierSymbol);
var
c : Integer;
begin
for c := length(WhatNode^.below)-1 downto 0 do
ClearNode(WhatNode^.below[c]);
SetLength(WhatNode^.below, 0);
Freemem(WhatNode);
end;
begin
if Length(fData.below) = 0 then
exit;
for i := 0 to Length(fData.below)-1 do
ClearNode(fData.below[i]);
SetLength(fData.below, 0);
end;

procedure TLexerClassifier.Add(WhatSymbol: AnsiString; Value: LongInt);
var
n : PLexerClassifierSymbol;
pc : PChar;
begin
pc := PChar(WhatSymbol+#0);
n := @FData;
while pc^<>#0 do
begin
n := AddChar(pc^, n, (pc+1)^=#0);
inc(pc);
end;
n^.data := Value;
end;

function TLexerClassifier.Exists(WhatSymbol: AnsiString; AllowPartial : Boolean): Boolean;
var
n : PLexerClassifierSymbol;
pc : PChar;
begin
n := @FData;
pc := PChar(WhatSymbol+#0);
while (pc^<>#0) and assigned(n) do
begin
n := CharExists(pc^, n);
inc(pc);
end;
result := assigned(n) and (n^.eow or AllowPartial);
end;

function TLexerClassifier.SymbolData(WhatSymbol: AnsiString): LongInt;
var
n : PLexerClassifierSymbol;
pc : PChar;
begin
n := @FData;
pc := PChar(WhatSymbol+#0);
while (pc^<>#0) and assigned(n) do
begin
n := CharExists(pc^, n);
inc(pc);
end;
if assigned(n) and (n^.eow) then
result := n^.data
else
result := 0;
end;

{ TLexer }

function TLexer.GetSource: Pointer;
begin
result := FSource;
end;

function TLexer.Curr: char;
begin
result := (FSource + FPos)^;
end;

function TLexer.GetToken(index: integer): PLexerToken;
begin
Result := @FTokens[index];
end;

function TLexer.GetTokenCount: longint;
begin
Result := FTokenCount;
end;

procedure TLexer.ScanSymol;
var
n: PLexerClassifierSymbol;
c: Char;
begin
CurrToken^.TokenType := ttUnknown;
n := FClassifier.CharExists(Curr, FClassifier.Data);
while (Curr in SYM) do
begin
if (assigned(n)) then
begin
c := Next;
if(c in SYM) then
n := FClassifier.CharExists(c, n);
end
else
Next;
end;
if assigned(n) and (n^.eow) then
CurrToken^.TokenType := n^.Data;
end;

procedure TLexer.ScanNumber;
var
hasDot, hasE: boolean;
begin
hasDot := False;
hasE := False;
if(Curr = '-') then
Next;
while (Curr in NUM_EXT) do
begin
case Next of
'.':
begin
if (hasDot) then
Throw('Unexpected . in source');
hasDot := True;
end;
'e', 'E':
begin
if (hasE) then
Throw('Unexpected E in source');
hasE := True;
end;
end;
end;
CurrToken^.TokenType := ttNumber;
end;

procedure TLexer.ScanString(const strDelmChar : Char);
var
done: boolean;
begin
Match(strDelmChar);
done := False;
while ((not done) and (not EOF)) do
begin
if(Curr = strDelmChar) then
begin
if Peek <> strDelmChar then
begin
done := True;
Next;
end
else
Next(2);
end
else if (Curr in [#13, #10]) then
Throw('Unexpected end of line, expecting end of string')
else
Next;
end;
CurrToken^.TokenType:= ttString;
end;

procedure TLexer.ScanCommentLine(const CommentStart : AnsiString);
begin
Match(CommentStart);
while (not ((FSource + FPos + 1)^ in [#13, #10, #0])) do
Inc(FPos);
Inc(FPos);
CurrToken^.TokenType := ttComment;
end;

procedure TLexer.ScanMultiComment(const CommentClose: AnsiString);
begin
while (not match(CommentClose, false, false)) and (not EOF) do
next;
if match(CommentClose) then
CurrToken^.TokenType := ttComment;
end;

procedure TLexer.SkipWhite;
begin
CurrToken^.TokenType:= ttWhite;
while (Curr in WHITE_SPACE) do
Next;
end;

procedure TLexer.SetFileName(const AValue: AnsiString);
begin
if FFileName=AValue then exit;
FFileName:=AValue;
end;

procedure TLexer.SetOnError(const AValue: TOnLexerError);
begin
if FOnError=AValue then exit;
FOnError:=AValue;
end;

procedure TLexer.SetSource(const AValue: Pointer);
begin
FSource := AValue;
end;

procedure TLexer.Throw(msg: AnsiString);
var
post : AnsiString;
begin
msg := StringReplace(msg, #0, 'End of File', [rfReplaceAll]);
if assigned(FOnError) then
begin
FOnError(msg, FileName, CurrToken^.line, CurrToken^.col, FContinue, CurrToken);
if (not FContinue) then
raise exception.create(msg);
end
else
begin
if(FileName<>'')then
post := ' in file ' + post + '.'
else
post := '.';
raise Exception.CreateFmt('EXCEPTION: "%s" on line %d at col %d'+post, [msg, CurrToken^.line, CurrToken^.col]);
end;
end;

procedure TLexer.Throw(const msg: AnsiString; args: array of const);
begin
Throw(format(msg, args));
end;

function TLexer.Next(numCharsToSkip: longint): char;
var
c: char;
begin
if EOF then
begin
Result := #0;
exit;
end;
while (numCharsToSkip > 0) do
begin
Inc(FPos);
c := Curr;
case (c) of
#10:
begin
Inc(FLine);
FCol := 0;
if (c = #13) then
Inc(FPos);
end;
#13: ;
else
Inc(FCol);
end;
Dec(numCharsToSkip);
end;
Result := Curr;
end;

function TLexer.Peek: char;
begin
Result := (FSource + FPos + 1)^;
end;

function TLexer.Match(const str: ansistring; IncIfMatched: boolean;
ThrowIfNotMatched: boolean): boolean;
var
i: integer;
begin
Result := True;
i := 0;
while (Result and (i < length(str))) do
begin
Result := upcase(str[i + 1]) = upcase((FSource + FPos + i)^);
Inc(i);
end;
if ((not Result) and (ThrowIfNotMatched)) then
Throw('"%s" expected', [str]);
if Result and IncIfMatched then
Inc(FPos, length(str));
end;

constructor TLexer.Create;
begin
FClassifier := TLexerClassifier.Create;
end;

destructor TLexer.Destroy;
begin
FClassifier.Free;
inherited Destroy;
end;

function TLexer.Prev: char;
begin
Result := (FSource + FPos - 1)^;
end;

function TLexer.NewToken: PLexerToken;
begin
if (FTokenCount <= Length(FTokens)) then
SetLength(FTokens, FTokenCount + 1000);
Result := Token[FTokenCount];
Result^.col := FCol;
Result^.line := FLine;
if ((FLine = 1) and (FCol = 0)) then
Result^.srcpos := FPos
else
Result^.srcpos := FPos + 1;
Result^.Token := '';
Result^.TokenType := 0;
Inc(FTokenCount);
end;

function TLexer.CurrToken: PLexerToken;
begin
result := Token[FTokenCount-1];
end;

procedure TLexer.Reset;
begin
FContinue := true;
FLine := 1;
FCol := 0;
FPos := 0;
FTokenCount := 0;
SetLength(FTokens, 0);
end;

procedure TLexer.Step;
var
Start: longint;
tkn: PLexerToken;
begin
Start := FPos;
tkn := NewToken;
case Curr of
'a'..'z',
'A'..'Z',
'_' : ScanSymol;
'0'..'9': ScanNumber;
#1..#32,
#127,
#255 : SkipWhite;
#39,
'"' : ScanString(Curr);
else
tkn^.TokenType := ord(Curr);
Next;
end;
SetString(tkn^.Token, (FSource + Start), FPos - Start);
end;

function TLexer.Process : Boolean;
begin
result := true;
try
Reset;
while (not EOF) and FContinue do
Step;
except
on e:Exception do
begin
result := false;
if (FContinue = true) then
raise e;
end;
end;
end;

function TLexer.EOF: boolean;
begin
Result := Curr = #0;
end;

function TLexer.BOF: boolean;
begin
result := FPos <= 0;
end;

end.
[/pascal]

I can make it do only what you asked, or write a faster routine that does it, but this is just too convenient to keep around. And yes, I did write every line of it LOL.

- Jeremy

[arthurprs]

Arthur: offource it parses that line by line, the problem is it uses single space to create new item in array while it shouldnt. the original and athena's function parse it properly.

when i was modifying eAthena function
i noticed that 'a,,b' becomes ['a', 'b'] when i think the right is ['a', '', 'b'] (same as python and php results) so i modified it

here is the functions,
MyExplode is the reviewed version of the original function
MyExplode2 my version that works like you want
[pascal]function MyExplode(const src: string): TStringArray;
var
idx: Integer;
count: Integer;
CharPtr: PChar;
aChar: Char;
toklen: Integer;
f: Integer;
begin
CharPtr := Pointer(src);
if CharPtr = nil then Exit;
idx := 1;
f := 1;

toklen := 10;
SetLength(Result, toklen);
count := 0;

while (CharPtr^ <> #0) do
begin
aChar := CharPtr^;
Inc(CharPtr);

if (aChar = (' ')) or (aChar = (';')) or
(aChar = (',')) or (aChar = (#09)) then
begin
if (count + 1 > toklen) then
begin
toklen := toklen + (toklen div 2);
SetLength(Result, toklen);
end;
Result[count] := Copy(src, f, idx - f);
f := idx + 1;
Inc(count);
end;
Inc(idx);
end;

if (idx >= f) then
begin
if (count + 1 > toklen) then
begin
Inc(toklen);
SetLength(Result, toklen);
end;
Result[count] := Copy(src, f, MaxInt);
Inc(count);
end;

if (toklen > count) then
SetLength(Result, count);
end;


function MyExplode2(const src: string): TStringArray;
var
idx: Integer;
count: Integer;
CharPtr: PChar;
aChar: Char;
toklen: Integer;
f: Integer;
valid: Integer;
begin
CharPtr := Pointer(src);
if CharPtr = nil then Exit;
idx := 1;
f := 1;
valid := 0;

toklen := 10;
SetLength(Result, toklen);
count := 0;

while (CharPtr^ <> #0) do
begin
aChar := CharPtr^;
Inc(CharPtr);

if (aChar = (' ')) or (aChar = (';')) or
(aChar = (',')) or (aChar = (#09)) then
begin
if (valid <> 0) then
begin
if (count + 1 > toklen) then
begin
toklen := toklen + (toklen div 2);
SetLength(Result, toklen);
end;
Result[count] := Copy(src, f, idx - f);
f := idx + 1;
valid := 0;
Inc(count);
end
else
Inc(f);
end
else
Inc(valid);

Inc(idx);
end;

if (valid <> 0) then
begin
if (count + 1 > toklen) then
begin
Inc(toklen);
SetLength(Result, toklen);
end;
Result[count] := Copy(src, f, MaxInt);
Inc(count);
end;

if (toklen > count) then
SetLength(Result, count);
end;[/pascal]