Избавление от "алгоритма маляра" при парсинге строк

Про вызов локальных функций читаем тут - http://18delphi.blogspot.com/2013/03/blog-post_5929.html
Про "алгоритм маляра" читаем тут - http://18delphi.blogspot.com/2013/03/rx.html

Рецепт избавления состоит в применении итераторов.

Функция разбивающая строку на "токены":

type
 Tl3WString = packed object
  {* Строка с кодировкой и с длиной. }
 public
   S : PAnsiChar; // Собственно строка.
   SLen : Integer; // Длина.
   SCodePage : SmallInt; // Кодовая страница.
 end;//Tl3WString
 
  Tl3WordAction = function(const aStr : Tl3PCharLen;
                           IsLast     : Boolean): Boolean;
 
  TCharSet = set of AnsiChar;
 
const
 cc_WordDelimANSISet = [#9,#13,#10,#32,'!','&','(',')','*','+',',','-','.','/',':',';','<','=','>',
                        '?','@','[','',']','^','`','{','|','}','~','''',
                        cc_Ellipsis, cc_ParagraphSign, cc_BrokenBar, cc_LargeDash,
                        cc_SingleQuote, cc_DoubleQuote, cc_RSingleQuote, cc_LSingleQuote,
                        cc_LDoubleQuote, cc_RDoubleQuote, cc_DoubleLowQuote,
                        cc_LTSingleQuote, cc_RTSingleQuote,
                        cc_LTDoubleQuote, cc_RTDoubleQuote,
                        cc_SoftSpace];
 
 cc_WordDelimOEMSet  = [#9,#13,#10,#32,'!','&','(',')','*','+',',','-','.','/',':',';','<','=','>',
                        '?','@','[','',']','^','`','{','|','}','~','''',#179,
                        cc_SingleQuote, cc_DoubleQuote,
                        cc_OEMSoftSpace,
                        cc_OEMParagraphSign] + cc_Graph_Criteria;
 
function l3IsWordDelim(Ch             : AnsiChar;
                       CodePage       : Longint = CP_ANSI) : Boolean;
  {-Return True if Ch is a word delimiter}
const
  cWordDelim : array [false..true] of TCharSet =
   (
    [#0..#31] + cc_WordDelimANSISet,
    [#0..#31] + cc_WordDelimOEMSet
   );
begin
 Result := Ch in cWordDelim[(CodePage = CP_OEM) OR (CodePage = CP_OEMLite)];
end;
 
function l3IsWordDelim(Ch             : AnsiChar;
                       CodePage       : Longint;
                       const anExcept : TCharSet) : Boolean;
  {-Return True if Ch is a word delimiter}
begin
 if (Ch in anExcept) then
  Result := false
 else
  Result := l3IsWordDelim(Ch, CodePage);
end;
 
type
  Tl3PCharLen = object(Tl3WString)
    public
    // public methods
      procedure Init(aSt: PAnsiChar = nil; aLen: Longint = -1; aCodePage: Long = CP_ANSI);
        {-}
  end;//Tl3PCharLen
 
procedure Tl3PCharLen.Init(aSt: PAnsiChar = nil; aLen: Longint = -1; aCodePage: Longint = CP_ANSI);
  {-}
begin
 S := aSt;
 if (aLen < 0) then
 begin
  if (aCodePage = CP_Unicode) then
   SLen := StrLen(PWideChar(S))
  else
   SLen := StrLen(S);
 end//aLen < 0
 else
  SLen := aLen;
 SCodePage := aCodePage;
end;
 
function l3PCharLen(const S: AnsiString; aCodePage: Longint = CP_ANSI): Tl3PCharLen; overload;
  {-}
begin
 Result.Init(PAnsiChar(S), Length(S), aCodePage);
end;
 
function l3PCharLen(S: PAnsiChar = nil; Len: Longint = -1; aCodePage: Longint = CP_ANSI): Tl3PCharLen; overload;
  {-}
begin
 Result.Init(S, Len, aCodePage);
end;
 
function  l3L2WA(Action: Pointer): Tl3WordAction;
  {-}
  register;
  {-}
asm
          jmp  l3LocalStub
end;{asm}
 
procedure l3FreeWA(var Stub: Tl3WordAction);
  {-}
  register;
  {-}
asm
          jmp  l3FreeLocalStub
end;{asm}
 
procedure l3ParseWords(const aStr     : Tl3WString;
                       anAction       : Tl3WordAction;
                       const anExcept : TCharSet = []);
  {* - разбирает строку на слова. }
var
 l_Offset      : Longint;
 l_WordFinish  : Longint;
begin
 if not l3IsNil(aStr) then
 begin
  l_Offset := 0;
  while (l_Offset < aStr.SLen) do
  begin
   while (l_Offset < aStr.SLen) AND
         l3IsWordDelim(aStr.S[l_Offset], aStr.SCodePage, anExcept) do
     Inc(l_Offset);
   l_WordFinish := l_Offset;
   while (l_WordFinish < aStr.SLen) AND
         not l3IsWordDelim(aStr.S[l_WordFinish], aStr.SCodePage, anExcept) do
     Inc(l_WordFinish);
   // - здесь добавляем слово
   if (l_WordFinish > l_Offset) then
   begin
    if not anAction(l3PCharLen(aStr.S + l_Offset, l_WordFinish - l_Offset, aStr.SCodePage),
                    l_WordFinish = aStr.SLen) then
     break;
    l_Offset := l_WordFinish;
    // - смещаемся на следующее слово
   end;//l_WordFinish > l_Offset
  end;//l_Offset < l_S.SLen
 end;//not l3IsNil(aStr)
end;
 
procedure l3ParseWordsF(const aStr     : Tl3WString;
                        anAction       : Tl3WordAction;
                        const anExcept : TCharSet = []);
  {* - разбирает строку на слова. }
begin
 try
  l3ParseWords(aStr, anAction, anExcept);
 finally
  l3FreeWA(anAction);
 end;//try..finally
end;

------------------------------------------------------------

Вызов:

procedure Test;

 function DoWord(const aStr: Tl3PCharLen; IsLast: Boolean): Boolean;
 begin
  .. тут обрабатываем aStr
  Result := true;
  // - продолжаем итерацию
 end;
 
begin
 l3ParseWordsF(l3PCharLen(AnsiString('мама мыла раму')), l3L2WA(@DoWord));
end;

---------------------------------------------------------------

Понятно, что тут приведён не компилируемый код, а только лишь идея.

И понятно, что это можно переписать через Event'ы и родные лямбды (reference to function). И избавиться от "хоккея" с "заглушками" и asm. asm - ВООБЩЕ - надо ИЗЖИВАТЬ. Тем более, что есть родные лямбды.

Про заглушки и "хоккей" читаем ещё тут - http://18delphi.blogspot.com/2013/04/blog-post_8.html