суббота, 8 октября 2016 г.

#1291. Давно я так не ржал....

Автор: на 5 комментариев:

#1290. "А ваш язык так может?" №11 

ARRAY FUNCTION .fold>
  ARRAY IN anArray
 %SUMMARY
  'Преобразует список списков в один плоский список.'
 ;
 [empty]
 anArray .for> ( SWAP JOIN )
 >>> Result
; // .fold>

ARRAY FUNCTION .transform>
  ARRAY IN anArray
  ^ IN aLambda
 %SUMMARY
  'Применяет aLambda к каждому элементу anArray.'
  'Предполагается, что aLambda возвращает список.'
  'Результатом явлется объединённый список результатов aLambda.'
 ;
 anArray
 .map> ( aLambda DO )
 .fold>
 >>> Result
; // .transform>

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

elem_iterator ImplUses
 Cached:
 (
  GarantModel::l3ImplUses .ToArray
  if ( Self .IsScriptKeywordsPack ) then
  begin
   .join> ( Self .NeededElementsFromInheritsOrImplements )
  end // ( Self .IsScriptKeywordsPack )  
  
  .join> ( Self .NeededElements: .IsForImplementation )
  .join> ( Self .NeededElementsTotal: .IsForImplementation )
  .join> ( Self .UsedTotal )
  
  if ( Self .IsScriptKeywordsPack ) then
  begin
   .join> ( Self .ChildrenWithOwnFile )
   .join> ToArray: GarantModel::SysUtils
   .join> ToArray: GarantModel::TtfwTypeRegistrator(Proxy)
   .join> ToArray: GarantModel::TypeInfoExt
  end // ( Self .IsScriptKeywordsPack )
  
  if ( Self .IsTarget ) then
  begin
   .join> ( Self .ChildrenWithOwnFile )
  end // ( Self .IsTarget )
  
  if ( Self .IsVCMFormsPack ) then
  begin
   .join> ( Self .ChildrenWithOwnFile )

   .join> (
    Self .ChildrenWithOwnFile
    .map> .ImplementsEx
    .fold>
    .filter> .IsVCMFormDefinition
   ) // .join>
  end // ( Self .IsVCMFormsPack )
  
  if ( Self .IsVCMForm ) then
  begin
   if ( Self .Abstraction at_final != ) then
   begin
    .join> ToArray: GarantModel::StdRes
   end // ( Self .Abstraction at_final != )
  end // ( Self .IsVCMForm )
  
  if ( Self .IsVCMFormSetFactory ) then
  begin
   .join> ToArray: GarantModel::SysUtils
   .join> ( Self .ChildrenWithOwnFile )
  end // ( Self .IsVCMFormSetFactory )
  
  if ( Self .IsVCMApplication ) then
  begin
   .join> ( Self .ChildrenWithOwnFile )
   .join> ToArray: GarantModel::evExtFormat
   if ( Self .Abstraction at_final == ) then
   begin
    .join> ToArray: GarantModel::StdRes
   end // ( Self .Abstraction at_final == )
  end // ( Self .IsVCMApplication )
  
  if ( Self .IsVCMUseCaseRealization ) then
  begin
   .join> ( Self .ChildrenWithOwnFile )
  end // ( Self .IsVCMUseCaseRealization )
  
  if ( Self .IsTestLibrary ) then
  begin
   .join> ( Self .ChildrenWithOwnFile .filter> .IsTestUnit )
  end // ( Self .IsTestLibrary )
  
  if ( Self .IsTestUnit ) then
  begin
   .join> ( Self .ChildrenWithOwnFile .filter> .IsTestForTestLibrary )
  end // ( Self .IsTestUnit )
  
  if ( Self .IsClassOrMixIn ) then
  begin
   .join> ( Self .AbstractUses )
  end // ( Self .IsClassOrMixIn )
   
  if ( Self .IsTestClass ) then
  begin
   .join> ToArray: GarantModel::Variants 
   .join> ToArray: GarantModel::ActiveX 
   .join> ToArray: GarantModel::tc5OpenAppClasses 
   .join> ToArray: GarantModel::tc5PublicInfo 
   .join> ToArray: GarantModel::tc6OpenAppClasses 
   .join> ToArray: GarantModel::tc6PublicInfo
  end // ( Self .IsTestClass )
   
  if ( Self .Name 'l3IID' == ) then
  begin
   .join> ToArray: GarantModel::Windows 
   .join> ToArray: GarantModel::SysUtils
  end // ( Self .Name 'l3IID' == )
  
  RULES
   ( Self .IsTestTarget )
    begin
     .join> ToArray: GarantModel::SysUtils
     .join> ToArray: GarantModel::l3Base
     .join> ToArray: GarantModel::TKBridge
     .join> ToArray: GarantModel::KTestRunner
     .join> ToArray: GarantModel::TextTestRunner
     .join> ToArray: GarantModel::GUITestRunner
     if ( Self .UPisTrue "no scripts" ! ) then
     begin
      .join> ToArray: GarantModel::TvcmInsiderTest 
     end // ( Self .UPisTrue "no scripts" ! )
    end // ( Self .IsTestTarget )
  ; // RULES 
  
  RULES
   ( Self .IsVCMTestTarget )
    begin
     RULES
      (
       Self .DependsVCMGUI
       .filter> ( .GetUP "F1Like" false ?== )
       .IsEmpty
      )
       ( .join> ToArray: GarantModel::TF1AutoTestSuite )
      DEFAULT
       ( .join> ToArray: GarantModel::TAutoTestsSuite )
     ; // RULES 
     .join> ToArray: GarantModel::StdRes
    end // ( Self .IsVCMTestTarget )
   ( Self .IsTestTarget )
    begin
     if ( Self .UPisTrue "is insider test" ! ) then
     begin
      if ( Self .UPisTrue "no scripts" ! ) then
      begin
       .join> ToArray: GarantModel::TAutoTestsSuite
       .join> ToArray: GarantModel::TtfwScriptEngineEX
      end // ( Self .UPisTrue "no scripts" ! )
     end // ( Self .UPisTrue "is insider test" ! )
    end // ( Self .IsTestTarget )
   ( Self .IsVCMGUI ) 
    ( .join> ToArray: GarantModel::StdRes )
  ; // RULES
  
  RULES
   ( Self .IsTestLibrary )
    begin
     .join> ( Self .DependsTestLibrary )
          
     RULES
      (
       Self .ChildrenEx 
       .filter> .IsTestUnit 
       .filter> ( 
        .ChildrenEx 
        .filter> .IsTestClass 
        .NotEmpty
       ) // .filter>
       .NotEmpty
      )
      begin
       .join> ToArray: GarantModel::tc5OpenApp 
       .join> ToArray: GarantModel::tc6OpenApp
      end
     ; // RULES
    end // ( Self .IsTestLibrary )
   ( Self .IsTestTarget )
    begin
    
     VAR l_Parent
     Self .Parent >>> l_Parent
     
     // Сначала перебираем чужие тестовые библиотеки:
     .join> (
      Self .DependsTestLibrary
      .filter> ( .Parent l_Parent .IsSameModelElement ! )
      array:Copy
     ) // .join>
     
     // Потом перебираем свои тестовые библиотеки:
     .join> (
      Self .DependsTestLibrary
      .filter> ( .Parent l_Parent .IsSameModelElement )
      array:Copy
     ) // .join>
     
    end // ( Self .IsTestTarget ) 
   ( Self .IsDLL ) 
    begin
     VAR l_Parent
     Self .Parent >>> l_Parent
     
     Self .DependsEx
     .filter> .IsLibrary
     .filter> ( .Parent l_Parent .IsSameModelElement )
     .for> (
       IN aLibrary
      
      aLibrary .ChildrenEx
      .for> (
        IN aChild
       .join> ToArray: aChild
      ) // .for>
       
      aLibrary .ChildrenEx 
      .filter> .IsUnit
      .for> (
        IN aUnit
       aUnit .ChildrenEx 
       .for> (
         IN aClass
        .join> ToArray: aClass
       ) // .for>
      ) // .for>
     ) // .for>
    end // ( Self .IsDLL )
   ( Self .IsVCMGUI )
    begin
     .join> ( Self .DependsTestLibrary )
     
     Self .DependsEx
     .filter> .IsVCMUseCase
     .for> (
       IN aUseCase
      aUseCase .ChildrenEx
      .filter> .IsVCMUseCaseRealization
      .for> (
        IN aUseCaseRealization
       .join> ToArray: aUseCaseRealization
      ) // .for>
     ) // .for>
    end // ( Self .IsVCMGUI )
  ; // RULES
 )
 >>> Result
; // ImplUses

Автор: на Комментариев нет:

#1289. "А ваш язык так может?" №10 

[ 1 2 ]
.map> ( [ DUP ] )
// - дублируем КАЖДЫЙ ЭЛЕМЕНТ и превращаем пару в массив
.fold>
// - превращаем массив массивов в массив
.equal [ 1 1 2 2 ]
.testAssure

[ 1 2 ]
.map> ( [ DUP DUP ] )
// - ДВА РАЗА дублируем КАЖДЫЙ ЭЛЕМЕНТ и превращаем тройку в массив
.fold>
// - превращаем массив массивов в массив
.equal [ 1 1 1 2 2 2 ]
.testAssure

ARRAY FUNCTION .elementToArray
  IN anElement
  ^ IN aLambda
 [ anElement aLambda DO ]
 // - выполняем лямбду над элементом, и оборачиваем всё это в массив
 >>> Result
; // .elementToArray

[ 1 2 ]
.map> .elementToArray DUP
// - дублируем КАЖДЫЙ ЭЛЕМЕНТ и превращаем пару в массив
.fold>
// - превращаем массив массивов в массив
.equal [ 1 1 2 2 ]
.testAssure

[ 1 2 ]
.map> .elementToArray ( DUP DUP )
// - ДВА РАЗА дублируем КАЖДЫЙ ЭЛЕМЕНТ и превращаем тройку в массив
.fold>
// - превращаем массив массивов в массив
.equal [ 1 1 2 2 ]
.testAssure

ARRAY FUNCTION .process>
  ARRAY IN anArray
  ^ IN aLambda
 anArray
 .map> .elementToArray ( aLambda DO )
 .fold>
 >>> Result
; // .process> 

WordAlias .transform> .process>

[ 1 2 ]
.transform> DUP
.equal [ 1 1 2 2 ]
.testAssure

[ 1 2 ]
.transform> ( DUP DUP )
.equal [ 1 1 1 2 2 2 ]
.testAssure

[ 1 2 ]
.transform> ( DUP DUP DUP )
.equal [ 1 1 1 1 2 2 2 2 ]
.testAssure

[ 1 2 ]
.transform> NOP
.equal [ 1 2 ]
.testAssure

WordAlias .keep NOP

[ 1 2 ]
.transform> .keep
.equal [ 1 2 ]
.testAssure

WordAlias .leaveAsIs .keep

[ 1 2 ]
.transform> .leaveAsIs
.equal [ 1 2 ]
.testAssure

Автор: на Комментариев нет:

#1288. "А ваш язык так может?" №9 

[ 1 2 ]
.join> [ 3 4 ]
.equal [ 1 2 3 4 ]
.assure 'Тест не прошёл'

[ [ 1 2 ] [ 3 4 ] ]
.fold>
.equal [ 1 2 3 4 ]
.assure 'Тест не прошёл'

[ [ 1 2 ] [ 3 [ 4 ] ] ]
.fold>
.equal [ 1 2 3 [ 4 ] ]
.assure 'Тест не прошёл'

[ [ 1 2 ] [ 3 [ 4 ] ] ]
.deepFold>
.equal [ 1 2 3 4 ]
.assure 'Тест не прошёл'

[ [ 1 2 ] [ 3 [ 4 [ 5 ] ] ] ]
.deepFold>
.equal [ 1 2 3 4 5 ]
.assure 'Тест не прошёл'

0
[ [ 1 2 ] [ 3 [ 4 [ 5 ] ] ] ]
.deepFold>
.for> +
.equal 15
.assure 'Тест не прошёл'

PROCEDURE .testAssure
  BOOLEAN IN aCondition
 aCondition .isTrue .assure 'Тест не прошёл'
; // .testAssure

0
[ [ 1 2 ] [ 3 [ 4 [ 5 ] ] ] ]
.deepFold>
.for> +
.equal 15
.testAssure

PROCEDURE .testFail
  BOOLEAN IN aCondition
 aCondition .not .isTrue .fail 'Тест не прошёл'
; // .testFail

0
[ [ 1 2 ] [ 3 [ 4 [ 5 ] ] ] ]
.deepFold>
.for> +
.not .equal 15
.testFail

PROCEDURE .testNotImportant
  BOOLEAN IN aCondition
 // - нам НЕ ВАЖНО значение aCondition - мы его и НЕ ИСПОЛЬЗУЕМ
; // .testNotImportant

0
[ [ 1 2 ] [ 3 [ 4 [ 5 ] ] ] ]
.deepFold>
.for> +
.not .equal 15
.testNotImportant

0
[ [ 1 2 ] [ 3 [ 4 [ 5 ] ] ] ]
.deepFold>
.for> +
.equal 15
.testNotImportant

Автор: на Комментариев нет:

#1287. "А ваш язык так может?" №8 

[ 1 2 3 4 ]
.map> .toArray
.equal [ [ 1 ] [ 2 ] [ 3 ] [ 4 ] ]
.assure 'Тест не прошёл'

[ 1 2 3 4 ]
.slice> 2
.map> .toArray
.equal [ [ [ 1 2 ] ] [ [ 3  4 ] ] ]
.assure 'Тест не прошёл'

0
[ 1 2 3 4 ]
.for> +
.equal 10
.assure 'Тест не прошёл'

0
[ 1 2 3 4 ]
.for> -
.equal -10
.assure 'Тест не прошёл'

[ 1 2 3 4 ]
.map> .mul 2
.equal [ 2 3 6 8 ]
.assure 'Тест не прошёл'

[ 2 3 6 8 ]
.map> .div 2
.equal [ 1 2 3 4 ]
.assure 'Тест не прошёл'

[ 2 3 6 8 ]
.map> .div 2
.revert>
.equal [ 4 3 2 1 ]
.assure 'Тест не прошёл'

[ 1 2 3 4 ]
.slice> 2
.map> ( 0 .swap .for> + )
.equal [ 3 7 ]
.assure 'Тест не прошёл'

[ 1 2 3 4 ]
.slice> 2
.map> ( 0 .swap .for> - )
.equal [ -3 -7 ]
.assure 'Тест не прошёл'

[ 1 2 3 4 5 6 ]
.slice> 3
.map> ( 0 .swap .for> + )
.equal [ 6 15 ]
.assure 'Тест не прошёл'

[ 1 2 3 4 5 ]
.slice> 3
.map> ( 0 .swap .for> + )
.equal [ 6 void ]
.assure 'Тест не прошёл'

[ 1 2 3 4 5 6 ]
.slice> 3
.map> ( 0 .swap .for> - )
.equal [ -6 -15 ]
.assure 'Тест не прошёл'

[ 1 2 3 4 5 ]
.slice> 3
.map> ( 0 .swap .for> - )
.equal [ -6 void ]
.assure 'Тест не прошёл'

Автор: на Комментариев нет:

#1286. "А ваш язык так может?" №7 

[ 1 2 3 4 ]
.slice> 2
.equal [ [ 1 2 ] [ 3 4 ] ]
.assure 'Тест не прошёл'

[ 1 2 3 4 5 6 ]
.slice> 3
.equal [ [ 1 2 3 ] [ 4 5 6 ] ]
.assure 'Тест не прошёл'

[ 1 2 3 ]
.slice> 2
.equal [ [ 1 2 ] [ 3 void ] ]
.assure 'Тест не прошёл'

[ 1 2 3 4 5 ]
.slice> 3
.equal [ [ 1 2 3 ] [ 4 5 void ] ]
.assure 'Тест не прошёл'

Автор: на Комментариев нет:

пятница, 7 октября 2016 г.

#1285. "А ваш язык так может?" №6 

[ 1 3 2 4 ]
.sort> .greater
.equal [ 1 2 3 4 ]
.assure 'Тест не прошёл'

[ 1 3 2 4 ]
.sort> .less
.equal [ 4 3 2 1 ]
.assure 'Тест не прошёл'

[ 1 2 2 3 4 4 5 6 7 8 8 9 ]
.removeDuplicates>
.equal [ 1 2 3 4 5 6 7 8 9 ]
.assure 'Тест не прошёл'

[ 1 2 3 4 ]
.filter> .isEven
.equal [ 2 4 ]
.assure 'Тест не прошёл'

[ 1 2 3 4 ]
.filter> .isOdd
.equal [ 1 3 ]
.assure 'Тест не прошёл'

[ 1 2 3 4 ]
.filter> .not .isEven
.equal [ 1 3 ]
.assure 'Тест не прошёл'

[ 1 2 3 4 ]
.filter> .not .isOdd
.equal [ 2 4 ]
.assure 'Тест не прошёл'

[ 1 2 ]
.join> [ 3 4 ]
.equal [ 1 2 3 4 ]
.assure 'Тест не прошёл'

[ 1 2 ]
.join> [ 3 4 ]
.revert>
.equal [ 4 3 2 1 ]
.assure 'Тест не прошёл'

[ 1 2 ]
.join> [ 3 4 ]
.filter> .not .equal 2
.equal [ 1 3 4 ]
.assure 'Тест не прошёл'

[ 1 2 ]
.join> [ 3 4 ]
.filter> .not .equal 2
.revert>
.equal [ 4 3 1 ]
.assure 'Тест не прошёл'

[ 1 2 ]
.join> [ 3 4 ]
.filter> .not .equal 2
.map> .add 10
.equal [ 11 13 14 ]
.assure 'Тест не прошёл'

[ 1 2 ]
.join> [ 3 4 ]
.filter> .not .equal 2
.map> .add 10
.revert>
.equal [ 14 13 11 ]
.assure 'Тест не прошёл'

Fluent-интерфейсы кстати:
 http://namerec.blogspot.ru/2013/09/fluent.html
 http://18delphi.blogspot.ru/2013/09/fluent-interface.html
Автор: на Комментариев нет:
Подписаться на: Сообщения (Atom)