Показаны сообщения с ярлыком лямбды. Показать все сообщения
Показаны сообщения с ярлыком лямбды. Показать все сообщения

четверг, 20 июня 2013 г.

Замыкание...

http://ru.wikipedia.org/wiki/%D0%97%D0%B0%D0%BC%D1%8B%D0%BA%D0%B0%D0%BD%D0%B8%D0%B5_(%D0%BF%D1%80%D0%BE%D0%B3%D1%80%D0%B0%D0%BC%D0%BC%D0%B8%D1%80%D0%BE%D0%B2%D0%B0%D0%BD%D0%B8%D0%B5) Замыкание- не перестаю удивляться выразительной силе данной конструкции.. Она позволяет "портянки кода" сворачивать во вполне логичные блоки.. Читабельные для людей..

Мы тут когда ехали с конференции в Казани - я "в лицах" и "на пальцах" сидя на вокзале - рассказал коллеге про замыкания. И он - по-моему - понял. Это - СИЛЬНАЯ вещь.

Портянки кода - РЕАЛЬНО СВОРАЧИВАЮТСЯ.

P.S. В "моём" DSL для тестов в замыкание может быть передана ЛЮБАЯ функция. Так язык устроен.

воскресенье, 7 апреля 2013 г.

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

Про вызов локальных функций читаем тут - 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

четверг, 28 марта 2013 г.

Вызов локальных функций для глобального контекста

http://ru.wikipedia.org/wiki/%D0%90%D0%BD%D0%BE%D0%BD%D0%B8%D0%BC%D0%BD%D0%B0%D1%8F_%D1%84%D1%83%D0%BD%D0%BA%D1%86%D0%B8%D1%8F

http://www.delphimaster.ru/cgi-bin/faq.pl?look=1&id=19-988623694


Зравствуете Акжан.
У вас в разделе есть следующий ворос и несколько ответов на него:

Вот всю жизнь в TVision в итераторах нужно было (параметром) передавать указатель на локальную процедуру, а тут задумал сделать свой итератор для обхода некоей древовидной структуры и на тебе - компилятор ругается. Да еще и в хелпе носом тыкают, что так мол в принципе нельзя делать... Гм. И как быть?

- могу предложить собственное решение данной проблемы. Тем более, что мой способ работает с рекурсивными вызовами любого уровня сложности:
type
  Long = LongInt;
  Bool = Boolean; // - так уж у меня в библиотеке сложилось
  Tl3IteratorAction = function(Data: Pointer; Index: Long): Bool;
                      {$IfDef Win32}
                      register;
                      {$EndIf Win32}
var
 l3StubHead : THandle = 0;
 
function l3AllocStub: THandle;
  {-}
(*  register;
asm
          mov   ecx, l3StubHead
          jecxz @Alloc
          mov   eax, ecx
          mov   ecx, [ecx]
          mov   l3StubHead, ecx
          ret
@Alloc:
          xor   eax, eax
          push  16               { SizeOf(TCode) -> stack  }
          push  eax              { GMem_Fixed -> stack     }
          call  GlobalAlloc
@ret:
end;{asm}*)
begin
 if (l3StubHead = 0) then
  Result := Windows{l3System}.GlobalAlloc(GMem_Fixed, 16)
 else begin
  Result := l3StubHead;
  l3StubHead := PHandle(Result)^;
 end;
end;
 
procedure l3FreeLocalStub(Stub: Pointer);
  {-}
begin
 PHandle(Stub)^ := l3StubHead;
 l3StubHead := THandle(Stub);
end;
 
(*procedure l3FreeLocalStub(Stub: Pointer);
                          {eax}
  register;
  {-}
asm
          push eax                               { Handle -> stack         }
          call GlobalFree
end;{asm}*)
 
procedure l3FreeStubs;
var
 Prev : THandle;
 Next : THandle;
begin
 Prev := l3StubHead;
 while (Prev <> 0) do begin
  Next := PHandle(Prev)^;
  Windows{l3System}.GlobalFree(Prev);
  Prev := Next;
 end;{Prev <> 0}
 l3StubHead := 0;
end;
 
(*type
  TCode = array [0..11] of Byte;
const
  Code : TCode = (
    $66, $58,               { pop eax         }
    $68, $FF, $FF,          { push $FFFF      } { OldBP  }
    $66, $50,               { push eax        }
    $EA, $EE, $EE, $FF, $FF { jmp $FFFF:$EEEE } { Action }
  );*)
 
function l3LocalStub(Action: Pointer): Pointer;
                     {eax}
  register;
  {-}
asm
          push edi                               { Save edi                }
          push eax                               { Save Action             }
          call l3AllocStub
          {! --- !}
          {xor  eax, eax                          { 0 -> eax                }
          {push 16                                { SizeOf(TCode) -> stack  }
          {push eax                               { GMem_Fixed -> stack     }
          {call GlobalAlloc}
          {! --- !}
 
          { Создаем новый код: }
          mov  edi, eax                          { Handle -> edi           }
          mov  edx, eax                          { Handle -> edx           }
          cld                                    { Move forward            }
 
          mov  eax, $68
          stosb
          mov  eax, ebp                          { предыдущий ebp -> eax   }
          stosd                                  { "push OldBP" -> [edi]   }
 
          mov  eax, $B9
          stosb
          pop  eax                               { Action -> eax           }
          stosd                                  { "mov ecx, Action" -> [edi] }
 
          mov  eax, $D1FF
          stosw                                  { "call ecx" -> [edi]     }
 
          mov  eax, $59
          stosb                                  { "pop ecx" -> es:[di]    }
 
          mov  eax, $C3
          stosb                                  { "ret" -> [edi]          }
 
          mov  eax, edx                          { Handle -> eax           }
          pop  edi                               { Restore edi             }
end;{asm}
 
function  l3L2IA(Action: Pointer): Tl3IteratorAction;
                {eax}
  register;
  {-}
asm
          jmp  l3LocalStub
end;{asm}
 
procedure l3FreeIA(Stub: Tl3IteratorAction);
                  {eax}
  register;
  {-}
asm
          jmp  l3FreeLocalStub
end;{asm}
 
теперь простейшая реализация итератора:
 
procedure Tl3VList.Iterate(aLo, aHi: Tl3Index; Action: Tl3IteratorAction);
  {virtual;{!v19}         {edx, ecx}
  register;
  {-}
(*asm
         push ebx
         mov  ebx, eax
         mov  eax, [eax].Tl3VList.f_Count
         or   eax, eax
         jle  @@ret // список пуст
 
         dec  eax
         cmp  ecx, eax
         jle  @@aHiLECount
         mov  ecx, eax
@@aHiLECount:
 
         mov  eax, [ebx].Tl3VList.f_List
         or   eax, eax
         jz   @@ret // список пуст
 
         or   edx, edx
         jge  @@aLoGE0
         xor  edx, edx
@@aLoGE0:
         sub  ecx, edx
         jl   @@ret // верхний индекс меньше нижнего
 
         mov  ebx, edx
         shl  ebx, 2
         add  eax, ebx
 
         pop  ebx
         inc  ecx
 
@@loop:
         push eax
         push edx
         push ecx
 
         call Action
 
         pop  ecx
         pop  edx
 
         or   al, al
         jz   @@loopend
 
         pop  eax
         add  eax, 4
         inc  edx
 
         loop @@loop
 
         jmp  @@ex
@@loopend:
         pop  eax
         jmp  @@ex
@@ret:
         pop  ebx
@@ex:
end;//asm*)
var
 i, j, k : Long;
 l_TmpItem : Pointer;
begin
 if (f_List <> nil) then begin
  j := Max(0, aLo);
  k := Min(Pred(Count), aHi);
  if IsMultiThread then
   for i := j to k do begin
    l_TmpItem := Items[i];
    if not Action(@l_TmpItem, i) then break;
   end
  else
   for i := j to k do
    if not Action(PChar(f_List) + i * SizeOf(Pointer), i) then break;
 end;{f_List <> nil}
end;
 
procedure Tl3VStorage.IterateF(I1, I2: Tl3Index; Action: Tl3IteratorAction);
  {-}
begin
 try
  Iterate(I1, I2, Action);
 finally
  l3FreeIA(Action);
 end;{try..finally}
end;
 
и его вызов:
 
function Tl3VList.IndexOf(Item: Pointer): LongInt;
 
 function FindItem(P: PPointer; Index: Long): Bool; far;
 begin
  if (P^ = Item) then begin
   IndexOf := Index;
   Result := false;
  end else
   Result := true;
 end;
 
begin
 Result := -1;
 IterateAllF(l3L2IA(@FindItem));
end;


- забавно, что метод Iterate можно вызывать как для глобального, так и для локального метода (естественно с предшествующим вызовом l3L2IA).
в секции finalization модуля где живет l3L2IA надо не забыть вызвать метод: l3FreeStubs.
- это схематично идеи, просто выдирать все целиком из своей библиотеки - тяжело да и некогда.

-- Прислал: Alex W. Lulin lulin@garant.ru http://lulinalex.chat.ru --