"Поток сознания" о тестировании и программировании: 2017

четверг, 28 декабря 2017 г.

Ссылка. Ещё одна книжка по паттернам с примерами кода

DESIGN PATTERNS INTRODUCTION

Реппозитарий с примерами

вторник, 28 ноября 2017 г.

Ссылка. Видеокурс по Haskell

http://www.intuit.ru/studies/courses/3652/894/info

воскресенье, 19 ноября 2017 г.

четверг, 16 ноября 2017 г.

Реализация ADT на моих скриптах

Собственно определение аксиоматики ADT:

UNIT ADT.ms.dict

USES
 axiom:CompiledWordWorkerWord
 axiom:TtfwSuppressNextImmediate
 axiom:Capture
;

 //BOOLEAN CompileTime-VAR g_NeedLog true
 BOOLEAN CompileTime-VAR g_NeedLog false
 STRING CompileTime-VAR g_Indent ''
 
 : :Log
  ToPrintable 
  if g_NeedLog then
   ( ToPrintable 'Log: ' SWAP Cat g_Indent SWAP Cat . )
  else 
   DROP
 ; // :Log
 
 : :Log:
   ^@ IN aName
   ^ IN aLambda
  if g_NeedLog then
  begin 
   STRING VAR l_Name
   aName DO >>> l_Name 
   l_Name ' Enter' Cat :Log
   TF g_Indent (
    g_Indent ' ' Cat >>> g_Indent
    aLambda DO
   ) // TF g_Indent
   l_Name ' Leave' Cat :Log
  end // g_NeedLog
  else
  begin
   aLambda DO
  end // g_NeedLog
 ; // :Log:
 
 : OutDelim
  '----------' .
 ; // OutDelim
 
 : .
  ToPrintable 
  if g_NeedLog then
   ( 'Value: ' SWAP Cat )
  .
 ; // .
 
 PROCEDURE :Dump
   WordOrBox IN aValue
   
  PROCEDURE :DoDump
    WordOrBox IN aValue
   RULES
    ( aValue pop:Word:IsCapture )
     ( aValue Capture:Lambda CodeIterator ==> DumpCodeCall )
     //( aValue Capture:Lambda DumpElement )
     //()
     //( aValue DumpElement )
    DEFAULT
     ()
   ; // RULES
  ; // :DoDump
  
  RULES
   ( g_NeedLog ! )
    ()
   ( aValue IsWordBox )
    ( aValue pop:WordBox:Boxed :DoDump )
   DEFAULT
    ( aValue :DoDump )
  ; // RULES 
 ; // :Dump
 
 : :ValueDo
   WordOrBox 
    IN aValue
  aValue :Log
  //aValue :Dump
  aValue DO 
  DUP :Log
 ; // :ValueDo
 
 : DerefParam
   IN aValue
   
  : DoDeref
   'DerefParam' :Log: 
    ( aValue :ValueDo )
  ; // DoDeref
  
  if ( aValue IsWordBox ) then
   ( aValue pop:WordBox:Boxed >>> aValue ) 
  RULES
   ( aValue IsWord )
    (
     RULES
      ( aValue pop:Word:IsWordPusher )
       DoDeref
      ( aValue pop:Word:IsBeginLike )
       DoDeref
      ( aValue pop:Word:IsConst )
       DoDeref
      DEFAULT 
       aValue
     ; // RULES  
    )
   DEFAULT
    aValue
  ; // RULES
 ; // DerefParam
 
 //MACRO
 STACK_CHANGING_MACRO 
 codePusher
   IN aCode
  aCode pop:Word:CodeIterator .for> DO
  aCode pop:Word:DecRef
 ; // codePusher
 
 STRING CompileTime-VAR g_CurrentDataName ''
 
 TkwCompiledTypedKeyValues ARRAY ItfwWordBox TYPE ADT
 
 STACK_CHANGING_MACRO data
   ^L IN aName
   ^ IN aCode
/*{  @SELF Ctx:SetWordProducerForCompiledClass 
  class::TkwCompiledKeyValues Ctx:SetCompiledClassForCompilingWord
  'axiom:operator' Ctx:Parser:PushSymbol
  aName |N Ctx:Parser:PushSymbol
  ';' Ctx:Parser:PushSymbol}*/
  VAR l_Name
  aName |N >>> l_Name
  l_Name >>> g_CurrentDataName
  //'ANY' Ctx:Parser:PushSymbol
  'ADT' Ctx:Parser:PushSymbol
  //'TkwCompiledTypedKeyValues' Ctx:Parser:PushSymbol
  //'ARRAY' Ctx:Parser:PushSymbol
  'TYPE' Ctx:Parser:PushSymbol
  l_Name Ctx:Parser:PushSymbol
  aCode pop:Word:IncRef
  aCode
  'codePusher' Ctx:Parser:PushSymbol
 ; // data
 
 INTEGER CompileTime-VAR g_UnnamedCount 0
 
 IMMEDIATE VOID OPERATOR unnamed
  'field' g_UnnamedCount IntToStr + @SELF axiom:DefineVar
  INC g_UnnamedCount
 ; // unnamed
 
 IMMEDIATE VOID OPERATOR unnamedleft
  'field' g_UnnamedCount IntToStr + @SELF axiom:DefineVar
  INC g_UnnamedCount
 ; // unnamedleft
 
 /*{IMMEDIATE VOID OPERATOR VAR
  ^L IN aName
  aName |N @SELF axiom:DefineVar
 ; // VAR}*/
 
 STACK_CHANGING_MACRO constructorPusher
   IN aSelf
   IN aCode
   IN aName
   
  VAR l_Members 
  aCode pop:Word:MembersIterator >>> l_Members
  VAR l_IsAtomic
  l_Members .IsEmpty >>> l_IsAtomic
  
  aSelf Ctx:SetWordProducerForCompiledClass 
  if l_IsAtomic then
  begin
   //class::TkwCompiledKeyValues Ctx:SetCompiledClassForCompilingWord
   class::TkwCompiledTypedKeyValues Ctx:SetCompiledClassForCompilingWord
   //class::TkwCompiledKeyValuesWithWordInfo Ctx:SetCompiledClassForCompilingWord
   g_CurrentDataName Ctx:Parser:PushSymbol
  end // l_IsAtomic
  else
  begin 
   g_CurrentDataName Ctx:Parser:PushSymbol
  end // l_IsAtomic
   //( 'INTERFACE' Ctx:Parser:PushSymbol )
  'axiom:operator' Ctx:Parser:PushSymbol
  aName Ctx:Parser:PushSymbol
  
  if ( l_IsAtomic ! ) then
  begin
   VAR l_Count
   0 >>> l_Count
   ARRAY VAR l_FieldNames
   
   [
    l_Members
    .for> (
      IN anItem
     if ( anItem pop:Word:Producer @ unnamedleft == ) then
     begin
      '^@' Ctx:Parser:PushSymbol
     end // ( anItem pop:Word:Producer @ unnamedleft )
     else
     begin
      '^' Ctx:Parser:PushSymbol
     end // ( anItem pop:Word:Producer @ unnamedleft )
     'IN' Ctx:Parser:PushSymbol
     VAR l_FieldName
     'aField' l_Count IntToStr Cat >>> l_FieldName
     l_FieldName Ctx:Parser:PushSymbol
     INC l_Count
     l_FieldName
    ) // .for>
   ] >>> l_FieldNames
   
   '[' Ctx:Parser:PushSymbol
   
   l_FieldNames
   .for> (
     IN anItem
    anItem Ctx:Parser:PushSymbol
    'DerefParam' Ctx:Parser:PushSymbol
    'nil' Ctx:Parser:PushSymbol
    '>>>' Ctx:Parser:PushSymbol
    anItem Ctx:Parser:PushSymbol
   ) // .for>
   
   ']' Ctx:Parser:PushSymbol
   
/*{   'KeyValuesCreate:' Ctx:Parser:PushSymbol
   '(' Ctx:Parser:PushSymbol
   'IN' Ctx:Parser:PushSymbol
   'aMade' Ctx:Parser:PushSymbol
   
   l_FieldNames
   .for> (
     IN anItem
    'aMade' Ctx:Parser:PushSymbol 
    '->' Ctx:Parser:PushSymbol 
    anItem 'a' .CutPrefix Ctx:Parser:PushSymbol
    ':=' Ctx:Parser:PushSymbol
    '(' Ctx:Parser:PushSymbol
    anItem Ctx:Parser:PushSymbol
    'DerefParam' Ctx:Parser:PushSymbol
    ')' Ctx:Parser:PushSymbol
   ) // .for>
   
   ')' Ctx:Parser:PushSymbol}*/
   
   '>>>' Ctx:Parser:PushSymbol
   'Result' Ctx:Parser:PushSymbol
  end // ( l_IsAtomic ! )
  
  ';' Ctx:Parser:PushSymbol
  0 >>> g_UnnamedCount
  aCode pop:Word:DecRef
 ; // constructorPusher
  
 //MACRO 
 //PROCEDURE
 :
 constructor 
   ^L IN aName
   ^ IN aCode
  aCode pop:Word:IncRef
  
  'constructorPusher' Ctx:Parser:PushSymbol
  @SELF
  aCode
  aName |N  
 ; // constructor
 
 : .DO?
   IN aValue
   
  : DoDeref
   '.DO?' :Log: 
    ( aValue :ValueDo )
   true
  ; // DoDeref
  
  if ( aValue IsWordBox ) then 
   ( aValue pop:WordBox:Boxed >>> aValue ) 
  RULES
   ( aValue IsWord )
    begin 
     RULES
      // - проверка на то, что это конструктор, чтобы не звать все подряд ссылки на функции
      ( aValue pop:Word:IsConst )
       begin
        // - тут вычисляется ссылка на значение
        DoDeref
       end // ( aValue pop:Word:IsConst )
      ( aValue pop:Word:IsBeginLike )
       begin
        // - чтобы работало ( 1 ) в xs
        DoDeref
       end // ( aValue pop:Word:IsBeginLike )
      ( aValue pop:Word:IsWordPusher )
       begin
        false ?ASSURE 'Ловушка'
        aValue DO 
        DO
        true
       end // ( aValue pop:Word:IsWordPusher )
      ( aValue Is class::TkwCompiledTypedKeyValues )
       begin
        // - тут зовутся нульарные конструкторы
        ( aValue pop:Word:Producer @ constructor == ) ?ASSURE
         [ aValue pop:Word:Name ' : ' aValue pop:Word:Producer pop:Word:Name ]
        //DoDeref 
        aValue
        false
       end // ( aValue Is TkwCompiledTypedKeyValues )
      ( aValue pop:Word:IsRunner )
       begin
        // - тут зовутся все остальные конструкторы
        ( aValue pop:Word:Producer @ constructor == ) ?ASSURE
         [ aValue pop:Word:Name ' : ' aValue pop:Word:Producer pop:Word:Name ]
        DoDeref 
       end // ( aValue pop:Word:IsRunner )
      ( aValue pop:Word:IsCapture ) 
        DoDeref
      DEFAULT
       begin
        //( [ aValue pop:Word:Name ' : ' aValue pop:Word:Producer pop:Word:Name ] strings:Cat Msg )
        aValue
        false
       end // DEFAULT
     ; // RULES 
    end // ( aValue IsWord )
   DEFAULT
    begin
     aValue
     false
    end // DEFAULT
  ; // RULES
 ; // .DO?

 INTEGER CompileTime-VAR g_Guard 0
 
 : .getMembers
   ADT IN aData
   VAR l_Index
   if ( aData IsArray ! ) then
    ( aData DO >>> aData )
   //aData Array:Count >>> l_Index
   0 >>> l_Index
   aData
   //.reverted>
   .for> ( 
    //DEC l_Index
    INC g_Guard 
    TRY
     //if ( g_Guard < 10 ) then
     //if ( g_Guard < 5 ) then
     if ( g_Guard < 4 ) then
     begin
      .DO? ?
      begin
       DUP l_Index aData Array:SetItem
      end // .DO?
     end // ( g_Guard < 10 )
    FINALLY 
     DEC g_Guard
    END 
    INC l_Index
   ) // .for>
/*{  aData pop:Word:MembersIterator
  .reverted>
  .for> (
    IN anItem
   anItem DO .DO?
  ) // .for>}*/
 ; // .getMembers
 
 ARRAY FUNCTION array:CopyWithoutDuplicatedStrings
   IN anArray
  RULES
   ( anArray .IsNil )
    [nil]
   ( anArray Array:SortKey TtfwSortKey::tfw_skString == ) 
   // - типа и так сортированный - не надо ничего копировать
    anArray
   DEFAULT 
    (
     VAR l_Used
     Array:MakeStringSorted >>> l_Used
     VAR l_Copy
     [] >>> l_Copy
     VAR l_Empty
     true >>> l_Empty
     anArray 
     .filter> .AddToArray?: l_Used
     .for> ( 
       IN anElement
      anElement .AddToArray: l_Copy
      false >>> l_Empty
     ) // anArray .for>
     RULES
      l_Empty
       [nil]
      DEFAULT
       l_Copy 
     ; // RULES
    ) 
  ; // RULES 
  >>> Result
 ; // array:CopyWithoutDuplicatedStrings
 
 ARRAY FUNCTION TotalMembers
  VAR l_It
  nil >>> l_It
  VAR l_W
  Context:rWordCompilingNow >>> l_W
  while ( l_W .NotIsNil )
  begin
   l_W pop:Word:MembersIterator 
   .filter> ( pop:Word:Name 'Result' != )
   .join> l_It
   >>> l_It
   if ( Ctx:WordDefiningNow l_W == ) then
    ( nil >>> l_W )
   else 
    ( l_W pop:Word:Parent >>> l_W )
  end
  
  l_It 
  .filter> pop:Word:IsVarLike
  .filter> ( pop:Word:IsGlobalVar ! )
  .map> pop:Word:Name 
  array:CopyWithoutDuplicatedStrings
  >>> l_It
  l_It >>> Result
 ; // TotalMembers

 MACRO match
  VAR l_Names
  [
   VAR l_Parser
   Ctx:Parser >>> l_Parser
   VAR l_Continue
   true >>> l_Continue
   l_Parser pop:Parser:NextToken
   while l_Continue
   begin
    STRING VAR l_Token
    l_Parser pop:Parser:TokenLongString >>> l_Token
    if ( l_Token ':' == ) then
    begin
     ( false >>> l_Continue )
    end // ( l_Token ':' == )
    else 
    begin
     l_Token
     l_Parser pop:Parser:NextToken
    end // ( l_Token ':' == )
   end // true
  ] >>> l_Names 
  
  VAR l_It
  TotalMembers >>> l_It
  
  l_Names 
  .filter> ( l_It SWAP array:HasString ! )
  .filter> ( '_' != )
  .for> (
    IN anItem
   'VAR' Ctx:Parser:PushSymbol
   anItem Ctx:Parser:PushSymbol
  ) // .for> 
  '.getMembers' Ctx:Parser:PushSymbol
  l_Names 
  .reverted>
  .for> (
    IN anItem
   if ( anItem '_' == ) then
   begin
    'DROP' Ctx:Parser:PushSymbol
   end // ( anItem '_' == )
   else
   begin 
    '>>>' Ctx:Parser:PushSymbol
    anItem Ctx:Parser:PushSymbol
   end // ( anItem '_' == )
  ) // .for> 
 ; // match
 
 WordAliasSafe !( (
 
 : .Check?
   IN aValue
   
  VAR l_Value
  
  : DoDeref
   '.Check?' :Log: 
    ( 
     aValue :ValueDo 
     DUP >>> l_Value
    )
   true 
  ; // DoDeref
  
  aValue >>> l_Value
  RULES
   ( aValue IsWordBox )
    RULES
     ( l_Value pop:Word:IsCapture )
      ( 
       DoDeref
       if (
           ( l_Value IsWordBox )
           AND ( l_Value pop:Word:IsCapture )
          ) then
       begin
        false ?ASSURE 'Ловушка'
        //'got' Msg
        DROP // - снимаем true
        l_Value call.me
       end // ( l_Value pop:Word:IsCapture )
      ) 
     DEFAULT
      ( aValue false )
    ; // RULES
   ( aValue IsWord )
    RULES
     ( aValue pop:Word:IsWordPusher ) 
      ( aValue :ValueDo MakeCaptureScreen true )
      //( aValue :ValueDo MakeCaptureScreen false )
      //( aValue false )
     ( aValue pop:Word:IsConst )
     // Чтобы работало: ^@( aList1 ) :List: ^@( aList2 )
      DoDeref
     ( aValue pop:Word:IsRunner ) 
     // Чтобы работало: ^@( aList1 ) :List: ^@( aList2 )
      begin
       //( aValue pop:Word:Producer @ constructor == ) ?ASSURE
       // [ aValue pop:Word:Name ' : ' aValue pop:Word:Producer pop:Word:Name ]
       DoDeref
      end // ( aValue pop:Word:IsRunner )
     DEFAULT
      ( aValue false )
    ; // RULES 
   DEFAULT 
    ( aValue false )
  ; // aValue  
 ; // .Check?
 
 PROCEDURE .OutCapture
   ARRAY IN anIt
  //if ( anIt .NotEmpty ) then
  begin
   'Capture:' Ctx:Parser:PushSymbol 
   '[' Ctx:Parser:PushSymbol 
    anIt .for> (
      IN anItem
     anItem Ctx:Parser:PushSymbol
    ) // anIt .for>
   ']' Ctx:Parser:PushSymbol 
   '!(' Ctx:Parser:PushSymbol 
    anIt .for> (
      IN anItem
     'IN' Ctx:Parser:PushSymbol
     '_' anItem Cat Ctx:Parser:PushSymbol
    ) // anIt .for>
    anIt .for> (
      IN anItem
     ':' Ctx:Parser:PushSymbol
     anItem Ctx:Parser:PushSymbol
     STRING VAR l_Item
     '_' anItem Cat >>> l_Item
     l_Item Ctx:Parser:PushSymbol
     '.Check?' Ctx:Parser:PushSymbol
     '?' Ctx:Parser:PushSymbol
     '(' Ctx:Parser:PushSymbol
     'DUP' Ctx:Parser:PushSymbol
     '>>>' Ctx:Parser:PushSymbol
     // - типа перезаписываем значение
     l_Item Ctx:Parser:PushSymbol
     ')' Ctx:Parser:PushSymbol
     ';' Ctx:Parser:PushSymbol
    ) // anIt .for>
  end // ( anIt .NotEmpty )
/*{  else
  begin
   '!(' Ctx:Parser:PushSymbol 
  end // ( anIt .NotEmpty )}*/
 ; // .OutCapture
 
 MACRO Cap(
  TotalMembers .OutCapture
 ; // Cap(
 
 MACRO Cap[
  VAR l_Names
  [
   VAR l_Parser
   Ctx:Parser >>> l_Parser
   VAR l_Continue
   true >>> l_Continue
   l_Parser pop:Parser:NextToken
   while l_Continue
   begin
    STRING VAR l_Token
    l_Parser pop:Parser:TokenLongString >>> l_Token
    if ( l_Token '](' == ) then
    begin
     ( false >>> l_Continue )
    end // ( l_Token ':' == )
    else 
    begin
     l_Token
     l_Parser pop:Parser:NextToken
    end // ( l_Token ':' == )
   end // true
  ] >>> l_Names 
  l_Names .OutCapture
 ; // Cap[
 
 WordAlias ^@[ Cap[
 WordAlias ^@( Cap(
 
 IMMEDIATE VOID operator def
   ^L IN aName
  VAR l_Compiler
  VAR l_Name
  aName |N >>> l_Name
  
  @ (
    IN aCode
   'Result' aCode pop:Word:FindMember pop:KeyWord:Word aCode pop:Compiler:AddCodePartRef
   TtfwSuppressNextImmediate::tfw_sniNo @ pop:Word:SetValue aCode pop:Word:AddCodePart
  ) // BeforeFinishDefinitionOfNewWord
  @ (
    IN aCode
   VAR l_KW
   l_Name aCode pop:Word:CheckWord >>> l_KW
   @ call.me l_KW pop:KeyWord:SetWord
  ) // AfterFillCompiledWord
  .TtfwProcedureEx.Create >>> l_Compiler
  TRY
   l_Name Ctx:SetNewWordName
   @SELF Ctx:SetWordProducerForCompiledClass
   l_Compiler DO
  FINALLY
   l_Compiler Word:DecRef
  END // TRY..FINALLY
 ; // def
 
 WordAlias Lambda ^@

/*{ : :Call
   Lambda IN aLambda
  aLambda DO >>> aLambda 
  RULES
   ( aLambda pop:Word:IsWordPusher )
    ( 
     aLambda DO >>> aLambda
     aLambda DO 
    )
   DEFAULT
    ( aLambda DO ) 
  ; // RULES
 ; // :Call}*/
 
 : :CallOn
   IN aParam
   Lambda IN aLambdaToCall
   
   : :CheckParam
     IN aParam
    RULES 
     ( aParam IsWordBox )
      RULES
       ( aParam pop:Word:IsCapture )
        ( aParam DO )
       DEFAULT
        aParam
      ; // RULES
     DEFAULT
      aParam
    ; // RULES
   ; // :CheckParam
   
/*{  if ( aLambdaToCall pop:Word:IsVarLike ! ) then
  begin
   aLambdaToCall pop:Word:Name Msg
   aLambdaToCall pop:Object:ClassName Msg
  end }*/
     
  VAR l_Lambda
  //if ( aLambdaToCall pop:Word:IsVarLike ! ) then
  // ( aLambdaToCall pop:Object:ClassName Msg )
  if ( aLambdaToCall pop:Word:IsVarLike ) then
   ( aLambdaToCall pop:Word:GetValue >>> l_Lambda )
  else 
   ( aLambdaToCall DO >>> l_Lambda )
  //if ( aLambdaToCall pop:Word:IsVarLike ! ) then
  // ( aLambdaToCall pop:Object:ClassName Msg )
  RULES
   ( l_Lambda pop:Word:IsWordPusher )
    (
     l_Lambda DO >>> l_Lambda
     //if ( aLambdaToCall pop:Word:IsVarLike ! ) then
     // ( aLambdaToCall pop:Object:ClassName Msg )
     //aLambdaToCall pop:Word:Name Msg
     //aLambdaToCall pop:Object:ClassName Msg
     if ( aLambdaToCall pop:Word:IsVarLike ) then
     begin
      //l_Lambda Msg
      l_Lambda MakeCaptureScreen >>> l_Lambda
      l_Lambda >>>^ aLambdaToCall 
      //'got' Msg
     end // ( aLambdaToCall pop:Word:IsVarLike )
     aParam :CheckParam l_Lambda DO 
    )
   DEFAULT
    ( aParam :CheckParam l_Lambda DO ) 
  ; // RULES
 ; // :CallOn

Определение типа List и операций над ним:

UNIT ADTList.ms.dict

USES
 ADT.ms.dict
;


 data List (
  //constructor List: ( ANY unnamed List unnamed )
  constructor :List: ( ANY unnamedleft List unnamed )
  constructor List:[] ()
 ) // List

 List def List:
   ^ IN aList1
   ^ IN aList2
  ^@[ aList1 ]( aList1 ) :List: ^@[ aList2 ]( aList2 )
 ; // List:
 
 //PROCEDURE 
 :
 // - чтобы итератор мог на стек значения возвращать, например для преобразования к массиву
  .List:For:
   List IN aList
   ^ IN aLambda
  RULES
   ( aList List:[] == )
    ()
   DEFAULT
    begin
     'List:ForFor:' :Log:
     (
      VAR l_Continue
      true >>> l_Continue
      while l_Continue
      begin
       aList match l_Head aList :
        l_Head aLambda :CallOn
        if ( aList List:[] == ) then
         ( false >>> l_Continue )
      end // l_Continue 
     ) // 'List:ForFor:' :Log:
    end // DEFAULT
  ; // RULES
  nil >>> aList
 ; // .List:For:
 
 List def .List:Map
   List IN aList
   Lambda IN aLambda
  RULES
   ( aList List:[] == )
    List:[]
   DEFAULT
    begin
     'List:Map' :Log:
     (
      aList match l_Head l_Tail :
       ^@[ l_Head aLambda ]( l_Head aLambda :CallOn ) 
       :List:
       ^@[ l_Tail aLambda ]( l_Tail aLambda call.me )
     ) 
    end // DEFAULT
  ; // RULES  
 ; // .List:Map
 
 List def .List:Filter
   List IN aList
   Lambda IN aLambda
  'List:Filter' :Log:
  (
   VAR l_Cont
   true >>> l_Cont
   while l_Cont
   begin
    RULES
     ( aList List:[] == )
      ( 
       List:[]
       false >>> l_Cont
      ) 
     DEFAULT
      begin
       aList match l_Head aList :
        if ( l_Head aLambda :CallOn ) then
        begin
         ^@[ l_Head ]( l_Head ) 
         :List:
         ^@[ aList aLambda ]( aList aLambda .List:Filter )
         false >>> l_Cont
        end // ( l_Head aLambda :CallOn )
      end // DEFAULT
    ; // RULES 
   end // while l_Cont 
  ) // 'List:Filter' :Log:
 ; // .List:Filter
 
 List def .List:Join
   List IN aList1
   List IN aList2
  RULES
   ( aList1 List:[] == )
    aList2
   ( aList2 List:[] == )
    aList1
   DEFAULT
    begin
     'List:Join' :Log:
     (
      aList1 match l_Head l_Tail :
       ^@[ l_Head ]( l_Head )
       :List:
       ^@[ l_Tail aList2 ]( l_Tail aList2 call.me )
     ) 
    end // DEFAULT
  ; // RULES  
 ; // .List:Join
   
 List def .List:Take
   List IN aList
   INTEGER IN aCount
  RULES
   ( aList List:[] == )
    List:[]
   ( aCount <= 0 )
    List:[]
   DEFAULT
    begin
     'List:Take' :Log:
     (
      aList match l_Head l_Tail :
       ^@[ l_Head ]( l_Head ) 
       :List:
       ^@[ l_Tail aCount ]( l_Tail aCount ` - 1 call.me )
     ) 
    end // DEFAULT
  ; // RULES  
  nil >>> aList
 ; // .List:Take
 
 INTEGER def .List:Count
   List IN aList
  RULES
   ( aList List:[] == )
    0
   DEFAULT
    begin
     'List:Count' :Log:
     (
      aList match _ l_Tail :
       1 ` + ( l_Tail call.me )
       //1 l_Tail call.me +
     ) 
    end // DEFAULT
  ; // RULES  
 ; // .List:Count
 
 List def .Any:ToList
   ANY IN anItem
  ^@[ anItem ]( anItem ) :List: List:[]
 ; // .Any:ToList
 
 WordAlias .ItemToList .Any:ToList
 
 List def .List:Add
   List IN aList
   ANY IN aValue
  'List:Add' :Log:
  (
   aList 
   aValue .Any:ToList
   //^@[ aValue ]( aValue ) :List: List:[] 
   .List:Join
  )
 ; // .List:Add
 
 List def xs
  'xs' :Log:
  ( 1 :List: ^@[ ]( xs ( 2 * ) .List:Map ) )
 ; // xs
 
 List def xs1
  'xs1' :Log:
  ( 1 :List: ^@[ ]( xs1 ( 1 + ) .List:Map ) )
 ; // xs1
 
 List def xs2
  List:[]
 ; // xs2
 
 List def xs3
   INTEGER IN aStart
  'xs3' :Log:
  ( ^@[ aStart ]( aStart ) :List: ^@[ aStart ]( aStart ` + 1 xs3 ) )
 ; // xs3 
 
 List def .Array:ToList
   ARRAY IN anArray
  List VAR l_List 
  List:[] >>> l_List 
  anArray .for> (
    IN anItem
   l_List anItem .List:Add >>> l_List
  ) // anArray .for>
  l_List
 ; // .Array:ToList
 
 WordAlias .ArrayToList .Array:ToList
 
 /*{
  qsort []     = []
  qsort (x:xs) = qsort (filter (< x) xs) ++ [x] ++ qsort (filter (>= x) xs)
 }*/
 
 List def .List:Sort
   List IN aList
  RULES
   ( aList List:[] == )
    List:[]
   DEFAULT
    begin
     'List:Sort' :Log:
     (
      aList match l_Head l_Tail :
       l_Tail ^@[ l_Head ]( l_Head LESS ) .List:Filter
       .List:Sort
       l_Head .ItemToList
       .List:Join
       l_Tail ^@[ l_Head ]( l_Head SWAP LESS ) .List:Filter
       //l_Tail ^@[ l_Head ]( l_Head LESS ! ) .List:Filter
       .List:Sort
       .List:Join
     ) 
    end // DEFAULT
  ; // RULES  
 ; // .List:Sort
 
 ARRAY def .List:ToArray
   List IN aList
  Capture: [ aList ] (
   OBJECT IN aLambda
   List IN aList
   aList .List:For: ( aLambda DO )
  ) FunctorToIterator
 ; // .List:ToArray
 
 WordAlias .ListToArray .List:ToArray

Примеры использования типа List:

PROGRAM ADT.ms.script

USES
 ADT.ms.dict
;

USES
 ADTList.ms.dict
;

Test&Dump ADTTest

 data MyEnum (
  constructor One ()
  constructor Two ()
  constructor Three ()
 ) // MyEnum
 
 //MyEnum .
 One .
 Two .
 Three .
 
 One One == .
 Two Two == .
 Three Three == .

 One Two == .
 
 xs2 .
 
 xs 
 10
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
 xs1
 10
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
 xs 
 10
 .List:Take
 xs 
 10
 .List:Take
 .List:Join
 .ListToArray .
 //.List:For: .
 OutDelim
 
 xs 
 10
 .List:Take
 xs 
 .List:Join
 10
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
 xs 
 //10
 //.List:Take
 // - на самом деле - всё равно есть тут Take или нет
 //   ибо объединяются ДВЕ БЕСКОНЕЧНЫЕ последовательности, а выбирается потом из первой из них
 xs 
 .List:Join
 10
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
 xs 
 ( 4 != )
 .List:Filter
 10
 .List:Take
 ( 2 != )
 .List:Filter
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List:[]
 IsOdd
 .List:Filter
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List:[] .
 OutDelim
 
 VAR l_List
 List: 1 List:[] >>> l_List
 l_List
 .ListToArray . 
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List:[] >>> l_List
 l_List
 .ListToArray . 
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List:[] >>> l_List
 l_List
 .ListToArray . 
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List:[] 
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[] 
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List:[]
 IsOdd
 .List:Filter
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[] 
 IsOdd
 .List:Filter
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
 IsEven
 .List:Filter
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
 IsEven
 .List:Filter
 3
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List:[]
 ( 2 * )
 .List:Map
 ( 1 + )
 .List:Map
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List:[]
 ( 2 * )
 .List:Map
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
 ( 2 * )
 .List:Map
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[] >>> l_List
 l_List 
 l_List
 .List:Join
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
 List: 11 List: 12 List: 13 List: 14 List: 15 List: 16 List: 17 List: 18 List: 19 List: 20 List:[]
 .List:Join
 List: 21 List: 22 List: 23 List: 24 List: 25 List: 26 List: 27 List: 28 List: 29 List: 30 List:[]
 .List:Join >>> l_List
 
 l_List
 l_List
 .List:Join >>> l_List
 
 l_List
 l_List
 .List:Join >>> l_List
 
 l_List
 .ListToArray .
 //.List:For: .
 OutDelim
 
 l_List
 5
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List: 1 List: 2 List: 3 List: 4 List: 5 List: 6 List: 7 List: 8 List: 9 List: 10 List:[]
 .List:Count .
 OutDelim
 
 List:[]
 1
 .List:Add
 2
 .List:Add
 3
 .List:Add
 4
 .List:Add
 5
 .List:Add
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List:[]
 'a'
 .List:Add
 'b'
 .List:Add
 'c'
 .List:Add
 'd'
 .List:Add
 'e'
 .List:Add
 .ListToArray .
 //.List:For: .
 OutDelim
 
 List:[]
 @ +
 .List:Add
 @ -
 .List:Add
 @ *
 .List:Add
 @ /
 .List:Add
 .ListToArray .
 //.List:For: .
 OutDelim

 xs 
 1
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 xs 
 20
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 xs 
 ( 2 * ) .List:Map
 20
 .List:Take
 ( 2 * ) .List:Map
 .ListToArray .
 //.List:For: .
 OutDelim
 
 xs1
 200
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
 1
 xs3
 //500
 200
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
 1
 xs3
 200
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
; // ADTTest

ADTTest

DT1.ms.script

USES
 ADT.ms.dict
;

USES
 ADTList.ms.dict
;

Test&Dump ADTTest

 [ 1 2 3 ] 
 .ArrayToList
 .ListToArray .
 OutDelim
 
 1
 xs3
 IsOdd .List:Filter
 //10
 5001
 .List:Take
 IsOdd .List:Filter
 IsOdd .List:Filter
 .ListToArray .
 //.List:For: .
 OutDelim
 
 [ 1 2 3 ] 
 .ArrayToList
 .ListToArray .
 //.List:For: .
 OutDelim
 
 [ 1 2 3 ] 
 .ArrayToList
 ( 1 LESS ) .List:Filter
 .ListToArray .
 //.List:For: .
 OutDelim
 
 [ 1 2 3 ] 
 .ArrayToList
 .List:Sort
 .ListToArray .
 //.List:For: .
 OutDelim
 
 [ 1 2 ] 
 .ArrayToList
 .List:Sort
 .ListToArray .
 //.List:For: .
 OutDelim
 
 [ 2 1 ] 
 .ArrayToList
 .List:Sort
 .ListToArray .
 //.List:For: .
 OutDelim
 
 [ 1 2 3 ] 
 .ArrayToList
 .List:Sort
 .ListToArray .
 //.List:For: .
 OutDelim
 
 [ 3 2 1 ] 
 .ArrayToList
 .List:Sort
 .ListToArray .
 //.List:For: .
 OutDelim
 
 [ 1 2 3 4 5 6 7 8 9 10 ] 
 .ArrayToList
 .List:Sort
 .ListToArray .
 //.List:For: .
 OutDelim
 
 //[ 1 2 3 4 5 6 7 8 9 10 ] 
 [ 8 9 10 2 1 3 20 ] 
 .ArrayToList
 .List:Sort
 .ListToArray .
 //.List:For: .
 OutDelim
 
 10 .ItemToList
 .ListToArray .
 //.List:For: .
 OutDelim
 
 [ 1 2 3 4 5 6 7 8 9 10 ] .ArrayToList
 .ListToArray .
 //.List:For: .
 OutDelim
 
 1
 xs3
 5001
 .List:Take
 .ListToArray .
 //.List:For: .
 OutDelim
 
 1
 xs3
 IsOdd .List:Filter
 5001
 .List:Take
 //IsOdd .List:Filter
 .ListToArray .
 //.List:For: .
 OutDelim
 
; // ADTTest

ADTTest

(+) http://programmingmindstream.blogspot.ru/2017/11/adt.html?m=1

среда, 15 ноября 2017 г.

#байка

Вспомнилось тут...

Езжу с детьми на каникулы в деревню Лосиное Калужской области.

Детям там нравится.

Когда мы первый раз туда приехали, к нам тут же пришли два местных колдыря. С четвертинкой. И стали звать меня третьим. Ну как же - новые люди из Москвы и "всё такое".

Я вообще-то не злоупотребляю. Здоровье не позволяет. А с детьми на каникулах - так вообще не пью.

Но разве колдырям это объяснишь.

Но тут меня прям "озарило". Просто "Бог нашептал".

Я им говорю - "мужики, я бы рад с вами выпить, но я мол запойный и зашился".

Мол, выпью - помру.

Они на меня посмотрели с сочувствием. "Больной человек".

И больше с этим вопросом не приставали...

Железобетонная "отмазка". И "не обидно".

И вроде не отказал "уважаемым людям"...

вторник, 14 ноября 2017 г.

Ещё о ФЯ. Цитата

Цитата:
"
Это - функциональная возможность:

sealed abstract class Either[+A, +B]
final case class Left[+A, +B](value: A) extends Either[A, B]
final case class Right[+A, +B](value: B) extends Either[A, B]

А это - функциональный дух:

data Either a b = Left a | Right b

И добавить нечего...
"

Вот мне тоже Haskell кажется "понятнее", чем Scala.

Хотя я всего "пять минут" с обоими знаком.

О функциональных языках

Познакомился с Haskell.

Многое оказалось знакомо.

До многого оказывается "сам" давно "дошёл".

Для глубины понимания реализовал маленькое подмножество Haskell на своих скриптах.

Чисто в "образовательных целях".

Не для "промышленного применения". По крайней мере пока.

Очень помогают доки собственно по Haskell. Читаю её и делаю "кальку с примеров".

Упоминания тут:
http://programmingmindstream.blogspot.ru/2017/11/blog-post.html?m=1

Чем дальше реализую, тем больше проникаюсь "духом ФЯ".

"Что-то" в этом есть.

Особено в immutable, ленивости и ADT с patternMatching'ом.

Очень полезный ресурс вот:

https://www.ibm.com/developerworks/ru/library/l-haskell4/index.html

Там очень многое подробно объяснется. Дух и буква ФЯ.

Я там много чего полезного почерпнул. И понял как оно "под капотом" устроено.

Ну и про qsort я уже писал:

http://programmingmindstream.blogspot.ru/2017/11/haskell.html?m=1

На Haskell - qsort реально понятнее, чем на C или Pascal.

Ну и:

http://programmingmindstream.blogspot.ru/2017/11/blog-post_22.html?m=1

(+):
http://programmingmindstream.blogspot.ru/2017/11/haskell_1.html?m=1

http://programmingmindstream.blogspot.ru/2017/11/adt.html?m=1

Ссылка. На почитать. #2

https://github.com/leo-yuriev/ioarena/tree/master/src/drivers

Ссылка. На почитать

http://ejdb.org/

четверг, 2 ноября 2017 г.

Просто так. О тестировании

Я вот что писал:

http://18delphi.blogspot.ru/2013/11/gui_9423.html?m=1

Оно не потеряло актуальности.

Что я хотел написать?

Я очень рад тому, что я следую принципам, которые там описаны.

Более того. Я применяю "почти TDD" в "повседневном программировании".

Я пишу код. И если он не слишком тривиален - пишу к нему тест.

Для меня лично - этот подход, более чем оправдывает себя.

У меня уже скопилась немаленькая база тестов. Многие из тестов написаны на скриптах. На скриптах тесты писать в РАЗЫ удобнее, чем на Delphi. На несколько десятичных порядков.

Потому, что в скриптах и инфраструктура развитее и там есть всякие "вкусности" типа лямбд (замыканий), литераторов, "сборки мусора", препроцессинга кода, и "сравнения с образцом", пост- и пред-условий, генерации эталонов, элементов ФЯ, кеширования значений функций, view от array, типа map и filter, а также rules и прочее и прочее и прочее.

Вот я тут начал делать Haskell-подобные вещи:

http://programmingmindstream.blogspot.ru/2017/11/haskell.html?m=1

http://programmingmindstream.blogspot.ru/2017/10/haskell-vs-count.html?m=1

Параллельно пишу тесты. Очень помогает. Ошибки вылазят "практически сразу".

Пишу "минимальный код" к нему тут же пишу "минимальный тест".

И всё срастается.

Собственно тесты и есть "примеры использования кода". Очень всё просто и логично.

Если какие-то ветки кода - не рабочие, то там пишутся assert'ы и они не покрыты тестами.

Как только assert'ы вылазят - дописываются ветки кода и дописываются "тривиальные тесты".

Всё просто и банально. Как 2*2=5.

Код используется - тестируем. Не используется - ставим assert и не тестируем.

Наткнулись на assert - пишем тест и тестируем.

И так "по кругу".

Просто и банально.

Мне лично - нравится.

Никому ничего в то же время не навязываю.

Ну в общем "ни о чём" написал. Хорошо быть "богатым и здоровым".

С коммунистическим приветом. ;)

p.s. Возможно уже стоит опубликовать машинку для тестирования?

Ссылка. ADT

https://ru.m.wikipedia.org/wiki/Алгебраический_тип_данных

Наконец я вроде понял, что это такое...

Там конечно "мудрёно" всё написано. Особенно про pattern-matching.

Всё гораздо проще. Банальное "сравнение кортежей" и сопоставление формальных параметров фактическим.

Я прям готов уже "статью" написать. Типа - "ADT, Haskell, immutable objects и pattern-matching для дебилов из мира императивных языков". Таких как я.

А то блин "морфизм, конструкторы (не такие как в C++), монады/шмонады, хвостовая рекурсия, ленивые вычисления, чанки, функции высшего порядка..."

Всё просто на самом деле объясняется. Для дебилов. Таких как я. Из императивного мира.

Шучу... Куда уж мне сирому...

Даже есть мысли как такое под Delphi устроить.

Не понятно только - надо ли...

Я ведь почему ФЯ "пристально" заинтересовался? А потому, что "понял", что я "двигаюсь в том же направлении". И раз я двигаюсь в том же направлении, то надо посмотреть "как У людей устроено". Посмотрел. Много полезного для себя почерпнул.

Местами даже захотелось попрограммировать на Haskell.

Но это возможно в будущем...

Я уже "очаровывался" языком Objective-C...

Одно могу сказать - "immutable-объекты - это круто!". Даже для императивных языков.

Что интересно... Пока я "въезжал в Haskell" - я нашёл ошибку с "глубокой рекурсией" при освобождении объектов. Которую лет пять не мог найти..

"Американский метод".

"Ищем одну ошибку, находим - другую".

среда, 1 ноября 2017 г.

Повторю ссылку. "О Haskell по-человечески"

https://www.ohaskell.guide/adt.html

ОЧЕНЬ хорошая книга.

И на самом деле не только про Haskell, но и про ADT вообще.

Haskell. Вопрос. Сортировка

А как на Haskell реализуется сортировка списка?

Там же вроде нет "рандомного" доступа к элементу. Учитывая наличие map и filter.

Или я чего-то не понимаю?

Интересует конечно не встроенная функция api, а как это написать самому руками. С указанием собственной функции сравнения элементов.

HaskellВыделить код

quicksort [] = ([]++[])
quicksort (h:t) = 
    let
       left = quicksort [x | x<-(h:t), x<h]
       right = quicksort [x | x<-(h:t), x>h]
    in left++[h]++right

Видимо, вот из этой реалализации очевидно, как передать ф-ю сравнения:

qsort [] = []
qsort (x:xs) = qsort (filter (< x) xs) ++ [x] ++ qsort (filter (>= x) xs)

так?

Кстати при "детальном рассмотрении" - даже понятнее, чем qsort на императивных языках. Влево отбираем элементы < x, вправо > x, а x - "посерединке". ;) Ясно и просто ;)

РЕАЛЬНО ПОНЯТНЕЕ, чем qsort на Pascal. Я НАКОНЕЦ реально ПОНЯЛ, как qsort работает.

Да. Да. Реально понятнее.

Декларатив.

?

А что такое <- ?
И что такое in ?

суббота, 28 октября 2017 г.

Ссылка. Erlang

http://learnyousomeerlang.com/content

пятница, 27 октября 2017 г.

Вопрос. Haskell

По итогам:
http://programmingmindstream.blogspot.ru/2017/10/haskell-vs-count.html?m=1

А как length/count (количество элементов списка) на Haskell реализовано?

Так:

Count [] = 0
Count ( _ : xs ) = 1 + Count xs

?

Или можно как-то эффективнее?

четверг, 26 октября 2017 г.

Haskell vs мои скрипты. Count & Map

Integer def List:Count
List in aList
aList Match (
List:[]
0
( List:Make: _ Tail )
( 1 + Tail call.me )
) // aList Match
; // List:Count

// что тут делать с "длинной рекурсией"
// - пока не очень понятно,
// возможно стоит сделать Count
// "хранимым членом"

Тогда так:

Integer def List:Count
List in aList
aList Match (
List:[]
0
( List:Make: _ Tail Count )
(
If ( Count .IsValid ) then
Count
Else
( 1 + Tail call.me )
)
) // aList Match
; // List:Count

List def List:Map
List in aList
Lambda in aLambda
aList Match (
List:[]
List:[]
( List:Make: Head Tail )
List:Make:
^@( Head aLambda do )
^@( Tail aLambda call.me )
) // aList Match
; // List:Map

Ну и вызов:

List:Make 1 List:Make 2 List:Make 3 List:Make 4 List:Make 5 List:[]
// строим список [ 1 2 3 4 5 ]
IsOdd
// отбираем нечётные
List:Map
( ToString + ' ' )
// тут приводим к строке и добавляем пробел
List:Map
List:For:
// перебирается список
Print
// печатаем каждый элемент

Напечатано:
1 3 5

Ну и вызов:

List:Make 1 List:Make 2 List:Make 3 List:Make 4 List:Make 5 List:[]
// строим список [ 1 2 3 4 5 ]
IsOdd
// отбираем нечётные
List:Map
List:Count
Print
// печатаем List:Count

Напечатано:
3

Пока выглядит вроде некузяво.

Но у меня же скрипты изначально императивные. И ОПЗ (обратная польская запись).

Но идею я вроде понял. Там строится граф/дерево разбора выражений в узлах которого записывается либо значение, либо ссылка на функцию (возможно со связанными параметрами, и не факт, что со всеми).

Если это значение, то выражение - вычислено полностью.

Если ссылка на функцию, то вычислено не полностью.

Тут и проявляется "ленивость".

Когда в узле вычисляется функция, то в узел записывается результат вычисления вместо ссылки на функцию.

Тут проявляется кеширование результатов. Ранее вычисленные функции - больше не вычисляются. А представляются значениями записанными в узлах графа/дерева.

Ну и код на Haskell:

xs = 1 : map (*2) xs

Выглядит так:

List def xs
List:Make:
1
( call.me ( 2 * ) List:Map )
; // List:Map

Я честно скажу - не проверял, но должно сработать.

Завтра проверю.

Бесконечной рекурсии там точно не будет.

При вызове xs.

Она сконструирует список:
1 : reference to expression ( xs ( 2 * ) List:Map )

А вот применится ли Map к правильному значению - вопрос пока открыт.

Возможно Map будет применяться не к xs, а к 1 ВСЕГДА.

Тут вопрос пока открыт. Надо проверить.

Возможно надо написать так:

List def xs
List:Make:
1
( Result ( 2 * ) List:Map )
; // List:Map

Есть и такой вариант. И он (как мне кажется) - ближе к истине.

Ибо call.me - это ссылка на функцю, а Result - это уже вычисленное значение.

Тонкая грань.

Или так:

List def xs
List VAR myResult
List:Make:
1
( myResult ( 2 * ) List:Map )
>>> myResult
myResult
; // List:Map)

Хотя и это можно скрыть за "синтаксическим сахаром".

среда, 25 октября 2017 г.

ToDo. Сделать глобальную writeonly "переменную" _

Сделать глобальную writeonly "переменную" _

WriteOnly _

Туда можно писать, но нельзя читать.

Это аналог devNull.

Это нужно для pattern matching'а.

Update. Сделал.

ToDo. Сделать match вместо RULES

Сделать match:

Чтобы вместо:

VAR head
VAR tail

RULES
( aList Empty == )
Empty
( aList .ConstructedWith: List )
(
aList .getValues ( @ head @ tail )
head : tail
)
DEFAULT
aList
>>> Result
;

Или:

VAR head
VAR tail

RULES
( aList .ConstructedWith: Empty )
Empty
( aList .ConstructedWith: List )
(
aList .getValues ( @ head @ tail )
head : tail
)
DEFAULT
aList
>>> Result
;

Написать:

Match aList
( Empty : Empty )
( matched List ( head tail ) : ( head : tail ) )
( Default : aList )
>>> Result
;

Чтобы можно было pattern matching делать.

И переменные (head и tail в нашем случае) определялись в нужном контексте.

Или даже так:

Match aList
( Empty ? Empty )
( matched List head tail ? ( head : tail ) )
( matched Join head tail ? ( head : tail ) )
( Default ? aList )
>>> Result
;

Или даже так:

Match aList
( Empty ? Empty )
( List head tail ? ( head : tail ) )
( Join head tail ? ( head : tail ) )
( Default ? aList )
>>> Result
;

Haskell. Pattern matching

checkIP :: IPAddress -> String
checkIP (IPv4 address) = "IPv4 is '" ++ address ++ "'."
checkIP IPv4Localhost  = "IPv4, localhost."
checkIP (IPv6 address) = "IPv6 is '" ++ address ++ "'."
checkIP IPv6Localhost  = "IPv6, localhost."

Очень глубоко на самом деле.

Я давно о подобном думал. А решение оказывается "лежало на поверхности".

вторник, 24 октября 2017 г.

Data 1. Haskell vs мои скрипты

data List = List a List | []

Выглядит так:

Data List
Constructor List (
Anonim ANY
Anonim List
) // List

Constructor [] ()
; // List

Или с именами полей:

Data List
Constructor List (
Named ANY Head
Named List Tail
) // List

Constructor [] ()
; // List

Или в операторном виде:

Data List
Constructor List (
Left Anonim ANY // параметр слева
Anonim List // параметр справа
) // List

Constructor [] ()
; // List

Тогда конструктор List вызывается так:

1 List 2 List []

Строит:

[ 1 2 ]

О! Я понял как pattern matching сделать.

В общем я могу сделать head:tail вместо .Split Head Tail.

aList .Split Head Tail

Можно сделать так (под капотом):

MATCH List:Make ( Head Tail )

Тут говорим, что надо применить pattern matching к конструктору List:Make и положить результаты в ( Head Tail )

А потом MATCH можно спрятать в и вычислять его в зависимости от того с какой стороны от знака равно (=) находится List:Make.

Учитывая, что "экземпляр объкта" знает про конструктор, которым он был создан, то выражение:

MATCH List:Make ( Head Tail )

можно переписать:

MATCH ( Head Tail )

Тогда навскидку:

LIST FUNCTION f
LIST IN aList
ANY VAR Head
LIST VAR Tail
aList .Split Head Tail
LIST:Make 1 Map ( 2 * ) Tail
>>> Result
; // f

Можно переписать так:

LIST FUNCTION f
LIST IN aList
ANY VAR Head
LIST VAR Tail
MATCH aList ( Head Tail )
LIST:Make 1 Map ( 2 * ) Tail
>>> Result
; // f

Или даже так:

LIST FUNCTION f
LIST IN aList
ANY VAR Head
LIST VAR Tail
MATCH aList
[]
[]
( Head Tail )
( LIST:Make 1 Map ( 2 * ) Tail )
; // MATCH
>>> Result
; // f

Или так:

LIST FUNCTION f
LIST IN aList
MATCH aList
[]
[]
( ANY VAR Head
LIST VAR Tail
Head Tail )
( LIST:Make 1 Map ( 2 * ) Tail )
; // MATCH
>>> Result
; // f

Data. Haskell vs мои скрипты

data MyEnum = One|Two

One == Two

Выглядит так:

Data MyEnum
Constructor One ()
Constructor Two ()
;

One Two ==

Списки. Haskell vs мои скрипты

f x:xs = 1 : map (*2) xs

Выглядит так:

LIST FUNCTION f
LIST IN aList
ANY VAR Head
LIST VAR Tail
aList .Split Head Tail
LIST:Make 1 Map ( 2 * ) Tail
>>> Result
; // f

У меня нет pattern-matching'а. Поэтому Split.

Ну и да - скрипты у меня конечно императивные. Но с ленивыми вычислениями. И без лишнего копирования списков.

Map ( 2 * ) Tail - не копирует Tail.

LIST:Make - тоже. Там Связный список.

Про замену .Split написано тут - http://programmingmindstream.blogspot.ru/2017/10/data-haskell-vs.html?m=1

aList .Split Head Tail

Можно сделать так (под капотом):

MATCH List:Make ( Head Tail )

Тут говорим, что надо применить pattern matching к конструктору List:Make и положить результаты в ( Head Tail )

А потом MATCH можно спрятать в и вычислять его в зависимости от того с какой стороны от знака равно (=) находится List:Make.

понедельник, 23 октября 2017 г.

Haskell. Цитата

"Применение конструктора типа к существующему типу порождает некий новый тип, и это очень мощная техника, используемая в Haskell почти на каждом шагу. Например, если нам нужно завернуть в опциональное значение уже не String, а ранее упомянутый Text, мы ничего не должны менять в конструкторе Maybe"

Вопрос. Haskell

А есть ли "скриптовые" реализации Haskell?

Ну чтобы можно было использовать Haskell в качестве скриптового языка внутри проекта написанного на Delphi.

Ну примерно так, как обычно используют Python.

воскресенье, 22 октября 2017 г.

Ссылка. Haskell Platform

https://www.haskell.org/platform/windows.html

Ссылка. Haskell

http://eax.me/haskell-first-app/

Вопрос. Haskell

А кстати можно так написать?
h :: Int -> Int
h x + 1 = x

h 3 == 2

Правило вывода сработает?

Ну это я таким извращённым способом операцию декремента реализую. Теоретически.

Понятно, что можно написать напрямую:
h x = x - 1

но мне интересна внутренняя природа устройства правил вывода.

UPDATE. На вопрос я вроде бы нашёл ответ - в pattern matching'е участвуют не функции, а конструкторы. Поправьте, если я не прав.

Ссылка. Take

https://www.haskell.org/hoogle/?hoogle=take

четверг, 19 октября 2017 г.

first:second:tail

first:second:tail

ARRAY VAR A
VAR first
VAR second
VAR tail

A .Split ( first second tail )

first:second:tail

ARRAY VAR A
VAR first
VAR tail

A .Split ( first tail )

first:second:third:tail

ARRAY VAR A
VAR first
VAR second
VAR third
VAR tail

A .Split ( first second third tail )

ToDo. Изменение положения оператора

Обратные тики-кавычки нужны для инфиксной записи бинарной функции. То есть мы располагаем mod между аргументами.

1 2 + =>
1 :` + 2

Или:

1 2 + =>
1 ` + 2

operator `
in ValueLeft
^ in Lambda
^ in ValueRight
ValueLeft // - значение слева
ValueRight DO // - разыменовываем значение справа
Lambda DO // - вызываем "лямбду"/"функтор"
;

Реализация sum на Haskell

sum ( [] ) = 0
sum (x:xs) = x + sum (xs)

Concat на Haskell

Как нить так (это сходу и наверняка не совсем верно):
concat' [] = []
concat' ([]:ys) = concat' ys
concat' ((x:xs):ys) = x : concat' (xs:ys)

Ссылка. Чат про Haskell для новичков

https://gitter.im/ruHaskell/novice

среда, 18 октября 2017 г.

Ссылка. Чат про Haskell

https://gitter.im/ruHaskell/forall

Ссылка. О Haskell по-человечески

https://www.ohaskell.guide/init.html

Отличная книга кстати. Жаль короткая.

Вопрос

[ [ 1 2 ] [ 3 4 ] ] как на Haskell преобразовать к [ 1 2 3 4 ] ?

Ну или на каком-нибудь другом функциональном языке?

У меня так:

[ [ 1 2 ] [ 3 4 ] ] .Fold

Но у меня же - "на коленке". Хочется понимать как "у людей" устроено.

А [ 1 2 ] .Join [ 3 4 ] как?

А [ 1 2 ] .Map .ToString как?

А [ 1 2 ] .Filter .IsOdd как?

А 0 [ 1 2 ] .For + /*сумма элементов*/ как?

Надеюсь, что смысл примеров понятен. Хотя они конечно "на коленке".

Если они всё же понятны, то может быть кто-то откликнется и расскажет как подобное на настоящих языках можно сделать?

ToDo. Сериализация

Похоже, что элементы опубликованные в скрипты автоматом сериализуются. Типа как в json.

Надо эту тему "покурить".

ToDo

Опубликовать конструкторы от tryFinally и tryExcept.

И ещё ко всем конструкторам сделать "пару" - CreateWithClass/XXXCreateWithClass.

Чтобы через эти конструкторы можно было создавать экземпляры по известной ссылке на класс.

Для финальных классов не делать такую пару.

пятница, 13 октября 2017 г.

Массивы

Range: 0 10 // диапазон от 0 до 10
.Filter .IsOdd // отбираем нечётные
.Join ( // объединение
Range: 20 30 // диапазон от 20 до 30
.Filter . IsEven // отбираем чётные
)
.Join // объединение
[ 31 32 33 ] // массив из элементов 31 32 33
.Join // объединение
ProduceArray: 100 Random // генерируем массив из 100 случайных элементов
.Join // объединение
ProduceArray: 200 ReadIntFromFile: File // читаем 200 элементов из файла
.Join // объединение
[ 100 1024 ] // массив из элементов 100 1024
.Map ( + 1 ) // прибавлям 1
.Map ( * 3 ) // умножаем на 3
.Map .ToString // преобразуем к строке
.Slice 2 // разбиваем массив на пары
.Slice 3 // разбиваем массив на тройки
.Trunc 10 // обрезаем массив до 10 элементов

Array Var A // объявляем переменную типа массив

>>> A // кладём результат вычислений в A

A .Copy // делаем копию массива

>>> A // кладём результат вычислений в A

A .Join A // объединяем A с A

>>> A // кладём результат вычислений в A

A .Fold // преобразуем массив массивов обратно к плоскому списку
.Map .ToInt // преобразуем строки обратно к числам
.RemoveDuplicates // удаляем дубликаты
.Sort // сортируем массив
.Invert // инвертируем массив
.Slice 2 // разбиваем на пары
.Map ( 0 .Swap .For + ) // суммируем пары
.Sort // сортируем
.For // перебираем массив
.Print // печатаем элемент массива

Все вычисления - "ленивые".

Кроме Copy, RemoveDuplicates и Sort.

понедельник, 9 октября 2017 г.

Тут подумалось

Прям самопроцитирую: "Я к тому, что "аллегория" это скажем так "некоторое преобразование" одного более сложного объекта к другому, более простому. Как хеш-функция.

Можно сравнивать строки, а можно их хеш-функции. Хеш-функции сравнивать проще. Но их сравнение менее "однозначно". Ибо там есть "потеря полноты картины". Но зачастую полнота картины и не нужна. Собственно это тогда и есть аллегория.
"

четверг, 5 октября 2017 г.

Научился делать "настоящие" immutable объекты

Научился делать "настоящие" immutable объекты.

Через перекрытие NewInstance + VirtualAlloc + VirtualProtect.

Перекрываем NewInstance - там аллоцируем память через VirtualAlloc (там есть тонкости с размером страниц и стратегией выделения памяти).

Потом заполняем поля объекта в конструкторе. И "закрываем" доступ на запись через VirtualProtect + Page_ReadOnly - в AfterCreate.

Потом в FreeInstance (или destroy - тут есть тонкости) опять разрешаем доступ.

Получаем гарантировано неизменяемые объекты.

Например для паттерна flyweight.

Или например для случая:

ConstString = interface
Function S: PChar;
End;

Ничто не мешает сделать так:

Var Cs: ConstString;

Cs := Factory.GetCs('value');
Cs.S^ := 'xxx';

Т.е "кишки" объекта будут испорчены.

А вот virtualProtect + page_readonly - решают эту проблему.

Просто

Крысу поймал, телевизор "починил". Теперь бы на работе с заковыристой ошибкой разделаться бы.

Компонент разрушается, но из списка компонент родителя - не удаляется.

А под отладчиком - вроде всё хорошо.

Только под Delphi Tokyo. Под Berlin и Delphi 7 - всё хорошо.

Уже разные способы ловли испробовал. Вплоть до VirtualProtect...

Меняю способ распределения памяти под компонент - ошибка уходит.

Не помогает...

Завтра тупо начну логировать убитые компоненты с их адресами и адресами родителей. И trhreadId.

Смущает тот факт, что ошибка под Tokyo есть, а под Berlin - её нет. Обязательно напишу, если чего накопаю. Хотя конечно скорее всего это какая-то наша ошибка.

среда, 4 октября 2017 г.

Иногда случаются проезды по памяти при использовании getMem/freeMem

Иногда случаются проезды по памяти при использовании getMem/freeMem.

Как их искать?

VirtualAlloc/VirtualProtect далеко не всегда помогают. В силу их специфики.

Как быть?

Придумал вот что:

Const
Filler : array [0..1] of integer = (high(integer), high(integer) -1);

SafeGetMem: Pointer
Var allocated: pointer;
GetMem(result, SizeOf(pointer) + sizeOf(Filler));
GetMem(allocated, aSize + SizeOf(pointer));

Move(result^, result^, sizeOf(result));
Move(result + SizeOf(result)^, Filler, SizeOf(filler));

Move(allocated^, result^, SizeOf(result));

Result := allocated + SizeOf(result);

А в safeFreeMem - проверяем все инварианты.

ToDo

Сделать newInstance через getMem + offset + high(pointer).

Возможно так можно будет отследить - кто ездит по памяти.

четверг, 28 сентября 2017 г.

Ссылка

http://www.sql.ru/forum/605052-a/kto-chto-dumaet-ob-uml-moda-proshla

Ссылка. HyTech

https://tyvik.ru/blog/48

Ссылка. MySQL

http://www.mysql.ru/docs/man/Counting_rows.html

Интересно послушать

Ну так может кто расскажет чем заменить select count *?

Ещё

Цитата: "uml-модели отдаляют заказчика от понимания реальной сути проблемы, а разработчика от понимания того как это всё устроено на уровне "байтов" (Joel)".

(Неточный перевод с немецкого)

Ещё неплохо сказано

Ещё цитата: "c++ uml-модели не нужны ибо там и так есть сильно развитые средства мета-программирования. Надо лишь уметь грамотно ими пользоваться".

Хорошо так сказано

Цитата: "Я не держусь за uml-модели как за ортодоксальный троцкизм. Я применяю их только когда они реально нужны и реально ускоряют разработку. Я их использую по месту, в соответствии с необходимостью, а не везде и всюду, заради кристальной идеи и чистоты арийской рассы".

Про immutable

Последнее время очень хочется "сказать компилятору", что объект неизменяемый.

Что-то вроде:

type TPoint = class
public
X : Integer;
Y : Integer;
costructor Create(aX, aY: Integer);
end; // TPoint

...

Var [Immutable] p : TPoint;

...

p := TPoint.Create(10, 20);
p.X := 30; // - тут компилятор ругается

Ну и естественно методы хочется метить const/noconst.

Я в своих скриптах такое уже почти сделал.

Почти - потому, что компилятор пока не все случаи отлавливает. Но это специфика реализации компилятора скриптов. Слишком уж он гибок. И местами на duckTyping заточен.

Но хотя бы в runTime - ругается. Если в compileTime не распознал.

среда, 27 сентября 2017 г.

Ещё про скрипты

Можно написать:

TPixel VAR Pixel
Pixel := 100
Pixel := px: 100
Pixel := inch: 1
Pixel := cm: 3
Pixel := mm: 300
Pixel := twips: 10
Pixel := m: 3
Pixel := n: 4
Pixel := (default): 100

Т.е. можно задавать значения в разных единицах измерения. И они будут преобразовыватся к типу переменной.

Понятно, что это на самом деле конструктор + определение оператора :=.

Ссылка. Gui в "функциональном" стиле

https://github.com/edvin/tornadofx/wiki/Type-Safe-CSS

Связи:
http://programmingmindstream.blogspot.ru/2017/09/gui.html?m=1

Задумался о программировании GUI в "функциональном" стиле

Как-то так:

RunApplicationWithForms: (
Form: Main TMainForm (
Prop: Width 400
Prop: Height 500
Event: OnShow ( Message ( 'Show' Name: Sender ) )
Event: OnExit ( Message ( 'Exit' Name: Sender ) )
Control: Edit1 TEdit (
)
Control: Edit2 TEdit (
Prop: Left 100
Prop: Top 200
Event: OnEnter ( Message ( 'Enter' Name: Sender ) )
Control: Button1 TButton (
Event: OnClick ( Message ( 'Click' Name: Sender ) )
)
)
Control: Edit3 TEdit ()
)
)
)

Это на самом деле - цепочка лямбд. Все объекты - Immutable.

Надо обмозговать эту тему.

вторник, 26 сентября 2017 г.

Размышления. В каком порядке изучать языки программирования

Первый - C/C++ даже без вопросов. Потом Pascal. Потом ObjectPascal. Потом FORTH. Потом LISP. Потом Prolog. А потом только Python, Java, Ruby и все остальные.

Не про школьников естественно речь.

Для школьников надо начинать с Pascal (Object) и Python.

Мне так кажется.

Ассемблер надо конечно знать. Но "параллельно" всему остальному.

Ну и "в конце-концов" - функциональщина всё равно замаячит на горизонте.

среда, 20 сентября 2017 г.

Наблюдение

Лучше всего почему-то получаются рабочие задачи, которые записал на бумажке. Потом ещё раз записал. Потом опять записал. Потом выкинул бумажки в урну. Потом вспомнил и записал опять. Потом три раза вернулся. Подумал - "да не, бред". Потом опять записал. А потом тебе ставят "другую задачу" и "совсем не про то". А ты вспоминаешь про бумажки. И думаешь "вот оно"! И делаешь и задачу, которую поставили. И то, что так долго "мусолил". Вылежалось...

Ссылка. Тестирование

https://dou.ua/lenta/articles/dou-projector-testein/?from=comment-digest_post&utm_source=transactional&utm_medium=email&utm_campaign=digest-comments

вторник, 5 сентября 2017 г.

Не перестаю удивляться

Не перестаю удивляться тому, что все операции сравнения могут быть выведены, через < (less), ! (not) и && (и):

bool operator> (A, B) {
return (B < A);
}

bool operator>= (A, B) {
return !(A < B);
}

bool operator<= (A, B) {
return !(B < A);
}

bool operator== (A, B) {
return ((A <= B) && (B >= A));
}

bool operator!= (A, B) {
return !(A == B);
}

https://ru.m.wikipedia.org/wiki/Степанов,_Александр_Александрович_(учёный)

вторник, 29 августа 2017 г.

Ссылка. КОМПОЗИЦИЯ ПРОТИВ МЕХАНИЗМА НАСЛЕДОВАНИЯ

https://abraxabra.ru/react.js/bystryy-start/kompozitsiya-protiv-mekhanizma-nasledovaniya/

Процитировав одного знакомого. Надеюсь, что он не будет против:

"
Экзистенциальненько... :-)
Ну, понимание того, что наследование ненужно, что это тупиковый путь, возникло почти сразу после знакомства с ним.
В принципе, это понятно и из общих соображений: при работе с весьма общими вещами трудно (я бы сказал - невозможно в общем случае) выделить *один* признак, по которому проводить классификацию.
В тех случаях, когда это всё-таки делается, получается негибкое решение, неустойчивое к изменениям в предметной области.
От множественного же наследования больше проблем, чем толку.
В общем, агрегация с композицией то, что следует широко использовать. Наследование же может пригодиться лишь изредка, да и то для вещей, которые меняются очень и очень редко.
Ну ещё вопрос производительности. Решение, основанное на наследовании, вероятнее всего окажется производительнее."

https://plus.google.com/u/0/100903871335644471614/posts/USU25WJA2eh?cfem=1

четверг, 24 августа 2017 г.

Off-topic. Наблюдение

Сегодня на совещании при обсуждении "технических моментов" коллеги "припомнили" (по доброму) мне мои ошибки прошлого. Которые я признал. Я стал говорить "возможно я ошибался" или "возможно я пересмотрел свою позицию" или "возможно я тогда вас не так понял".

На что коллеги с улыбкой мне сказали, что надо говорить - "возможно я с того времени стал умнее".

Хороший вариант. Возможно.

Хотя - я лично сомневаюсь.

Возможно - "спокойнее" и "рассудительнее" (в том смысле, что не тороплюсь принимать решения).

Так - наверное скорее.

Ну и наверное всё же научился "слышать", а не только "слушать".

Возможно.

Но не "умнее". Умнеть в последнее время - что-то не получается.

пятница, 18 августа 2017 г.

ToDo. Сделать Named:

Именованные "анонимные функции":

.filter> Named: n1 ( bla )
.filter> Named: n2 global

Их имя нужно только для отладки и диагностики.

Это можно применять для "именования" post- и pred-условий:

Pre:
( x = 1 ?assure 'bla' )
Named: n1 ( y = 2 ?assure 'bla' )
;

Post:
( z = 1 ?assure 'bla' )
Named: n1 ( i = 2 ?assure 'bla' )
;

Или:

Pre:
( x = 1 ?assure 'bla' )
Условие: n1 ( y1 = 2 ?assure 'bla' )
Условие: n2 ( y2 = 2 ?assure 'bla' )
global1
global2
Условие: n3 ( y3 = 2 ?assure 'bla' )
( x1 = 10 ?assure 'bla' )
;

Или:

До:
( x = 1 ?верно 'bla' )
Условие: n1 ( y1 = 2 ?верно 'bla' )
Условие: n2 ( y2 = 2 ?верно 'bla' )
global1
global2
Условие: n3 ( y3 = 2 ?верно 'bla' )
( x1 = 10 ?верно 'bla' )
;

Или:

Предусловия:
( должно: ( x = 1 ) 'bla' )
Условие: n1 ( должно: ( y1 = 2 ) 'bla' )
Условие: n2 ( должно: ( y2 = 2 ) 'bla' )
"Глобальное условие 1"
"Глобальное условие 2"
Условие: n3 ( должно: ( y3 = 2 ) 'bla' )
( должно: ( x1 = 10 ) 'bla' )
;

До:
"Очищать тестовую базу" // - это ДО
"Очищать таблицу стилей"
"Открыть документ" "Конституция"
;

Параметры:
"Выливать в RTF"
"Восстанавливать позицию мыши"
;

Тест:
"Выделить документ"
"Заменить" 'а' на 'б'
;

Постусловия:
"Drag&Drop завершён"
;

После:
"Закрывать все окна"
"Очищать тестовую базу" // - это ПОСЛЕ
;

В таком порядке и вызывается:
Предусловия, До, Параметры, Тест, Постусловия, После.

Все секции - опциональны.

Для этого сделать TtfwNamedBeginLike с соответствующим конструктором.

И звать его из Named:, который определить на стороне скриптов.

Не забыть про трансляцию resultType и paramTypes, а также innerDictionary etc.

И прочей инфраструктуры для работы с компилированными словами.

Сделать ещё конструкции:

"В диалоге" "Номер 2 или больше" "Удаление конституции" отвечать Всегда
"В диалоге" "Удаление конституции" отвечать Нет
"В диалоге" "Удаление документа" отвечать Да
"В диалоге" "Поиск/замена" выполнять "Выбор метки"
"Для диалога" "Выход из приложения" "Проверять его отсутствие"
"В диалоге" "Любом другом" отвечать Нет

После слова "В диалоге" предполагаются на самом деле две лямбды:
1. Comparator. Туда передаётся DialogInfo, а возвращается Boolean.
2. Executor.

Comparator и Executor - самом деле могут связываться в цепочки, как в примере про диалог #2.

Предикатов на самом деле просто складываются в список и последовательно выполняются для каждого диалога.

По аналогии с RULES.

Никакого "волшебства".

Это некоторым образом похоже на "предикаты" и "машину вывода" Prolog'а.

Порядок предикатов - влияет на порядок вычисления предикатов.

Это вместо wait:XXX/waited?

Т.е. делаем "декларативность", а не "императивность".

Мы НЕ ОЖИДАЕМ, диалога, а говорим, что надо делать, если он появился.

Ну и старый "добрый" (на самом деле - бардачный) механизм пока оставляем. Для обратной совместимости.

Возможно для наглядности стоит ещё ввести секцию Диалоги: перед секцией Тест:.

Ещё надо сделать конструкцию:

"Локальные диалоги":
(
Предикат1
Предикат2
Предикат3
...
ПредикатN
)
( код )

предикатов для диалогов действительны ТОЛЬКО для указанного локального кода.

Там две лямбды:
1. Регистрация обработчиков диалогов.
2. Код, приводящие к диалогу.

Ели один из ожидаемых дипломов не показан, то надо поднимать исключение - 'неожиданный диалог'.

Для совместимости со старым кодом.

Собственно с этого и надо начать.

Это больше похоже на текущий механизм.

И это похоже на механизм TF aVar (). Тоже лямбда, обёрнутая в try..finally.

Ещё надо сделать:
PredicatExecutor.
LambdaExecutor.
Etc.

Для удобства работы со словами на стороне Delphi.

В итоге - убрать wait, waited, answer, modal, etc.

А всё свести к modalService и dialogStack.

И написать что-то вроде:

Function modalService.Execute (aForm): TModalResult;

Result := mrCancel;
if dialogStack.Execute(aForm, Result) then
Exit
else
if TBatchService.IsBatchMode then
raise EBatchMode.Create('нельзя показывать модальный диалог в пакетном режиме')
else
Result := aForm.ShowModal;

Слова wait:XXX временно перенести на сторону скриптов, вывести их через wait:Button. А потом их вообще убить.

Потом переделать всё это на Thread. И убрать hackedVCL/needCancelModal.

А потом подобным образом отрефакторить menu.Popup.

Ещё сделать глобальную функцию/примесь для переделки ShowModal и copyPaste "от Димы".

Переделать регистрацию констант mrXXX на RTTI. Ну как TColor и TCursor.

Вообще подумать о регистрации ВСЕХ констант, через RTTI и RegisterIdent.

http://docwiki.embarcadero.com/RADStudio/Seattle/en/Colors_in_the_VCL

четверг, 28 декабря 2017 г.

вторник, 28 ноября 2017 г.

воскресенье, 19 ноября 2017 г.

четверг, 16 ноября 2017 г.

среда, 15 ноября 2017 г.

вторник, 14 ноября 2017 г.

четверг, 2 ноября 2017 г.

среда, 1 ноября 2017 г.

суббота, 28 октября 2017 г.

пятница, 27 октября 2017 г.

четверг, 26 октября 2017 г.

среда, 25 октября 2017 г.

вторник, 24 октября 2017 г.

понедельник, 23 октября 2017 г.

воскресенье, 22 октября 2017 г.

четверг, 19 октября 2017 г.

среда, 18 октября 2017 г.

пятница, 13 октября 2017 г.

понедельник, 9 октября 2017 г.

четверг, 5 октября 2017 г.

среда, 4 октября 2017 г.

четверг, 28 сентября 2017 г.

среда, 27 сентября 2017 г.

вторник, 26 сентября 2017 г.

среда, 20 сентября 2017 г.

вторник, 5 сентября 2017 г.

вторник, 29 августа 2017 г.

четверг, 24 августа 2017 г.

пятница, 18 августа 2017 г.

четверг, 28 декабря 2017 г.

вторник, 28 ноября 2017 г.

воскресенье, 19 ноября 2017 г.

четверг, 16 ноября 2017 г.

среда, 15 ноября 2017 г.

вторник, 14 ноября 2017 г.

четверг, 2 ноября 2017 г.

среда, 1 ноября 2017 г.

суббота, 28 октября 2017 г.

пятница, 27 октября 2017 г.

четверг, 26 октября 2017 г.

среда, 25 октября 2017 г.

вторник, 24 октября 2017 г.

понедельник, 23 октября 2017 г.

воскресенье, 22 октября 2017 г.

четверг, 19 октября 2017 г.

среда, 18 октября 2017 г.

пятница, 13 октября 2017 г.

понедельник, 9 октября 2017 г.

четверг, 5 октября 2017 г.

среда, 4 октября 2017 г.

четверг, 28 сентября 2017 г.

среда, 27 сентября 2017 г.

вторник, 26 сентября 2017 г.

среда, 20 сентября 2017 г.

вторник, 5 сентября 2017 г.

вторник, 29 августа 2017 г.

четверг, 24 августа 2017 г.

пятница, 18 августа 2017 г.