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

вторник, 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 г.

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

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

Ссылка. Матрица поворота

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

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

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

Offtopic. Байка

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

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

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

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

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

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

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

Ссылка. ADT

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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