среда, 27 апреля 2016 г.

#1236. Ссылка. Первый украинский тв-канал о IT

http://divan.tv/tv/view/brain-tv-750

Всем IT и не только друзьям рекомендую, новичкам конечно будет интересно, но я например совсем не вебщик, и смотрю всего 15 минут.

вторник, 26 апреля 2016 г.

#1235. И ещё про "утилиты" и grep. Только код

gens.cmd - генерация элементов с указанным стереотипом
%1 - имя стереотипа

del %~1.script.list
findstr /M /C:"Stereotype st_%~1" *.pas.ms.script>> %~1.script.list
rem grep -l+ "Stereotype st_%~1" *.pas.ms.script>> %~1.script.list
del run%~1.script.list
for /f %%i in (%~1.script.list) do echo %%i.runner>> run%~1.script.list
call cal.cmd -list:run%~1.script.list

gen.cmd - генерация указанного элемента
%1 - имя элемента подели или его UID или его "целевое проектное имя".

del %~1.script.list
findstr /M /C:"CONST Name '%~1'" *.pas.ms.script>> %~1.script.list
findstr /M /C:"CONST extprop:pas:TypeName '%~1'" *.pas.ms.script>> %~1.script.list
findstr /M /C:"CONST UID '%~1'" *.pas.ms.script>> %~1.script.list
rem grep -l+ "'%~1'" *.pas.ms.script > %~1.script.list
del run%~1.script.list
for /f %%i in (%~1.script.list) do echo %%i.runner>> run%~1.script.list
call cal.cmd -list:run%~1.script.list

genup.cmd - генерация элементов с указанным пользовательским свойством и его значением
%1 - имя свойства - needUC или "need script".
%2 - значение свойства - true, false, число или строка 'Hello' или "'Hello world".

del found.script.list
findstr /M /R /C:"CONST .%~1. %~2" *.pas.ms.script>> found.script.list
rem grep -l+ "Stereotype st_%~1" *.pas.ms.script>> found.script.list
del torun.script.list
for /f %%i in (found.script.list) do echo %%i.runner>> torun.script.list
call cal.cmd -list:torun.script.list

genTargets.cmd - генерация ВСЕХ проектных файлов

del targets.script.list
findstr /M /C:"Stereotype st_ExeTarget" *.pas.ms.script>> targets.script.list
findstr /M /C:"Stereotype st_AdapterTarget" *.pas.ms.script>> targets.script.list
findstr /M /C:"Stereotype st_TestTarget" *.pas.ms.script>> targets.script.list
findstr /M /C:"Stereotype st_VCMTestTarget" *.pas.ms.script>> targets.script.list
findstr /M /C:"Stereotype st_VCMGUI" *.pas.ms.script>> targets.script.list
del targetstorun.script.list
for /f %%i in (targets.script.list) do echo %%i.runner>> targetstorun.script.list
call cal.cmd -list:targetstorun.script.list

genUsed.cmd - генерация элементов использующих указанный
%1 - ИМЯ элемента модели. UID или "проектное имя" - не подходят.

del %~1Used.script.list
findstr /M /C:"CONST Name '%~1'" *.pas.ms.script>> %~1Used.script.list
findstr /M /C:"CONST extprop:pas:TypeName '%~1'" *.pas.ms.script>> %~1Used.script.list
findstr /M /C:"CONST UID '%~1'" *.pas.ms.script>> %~1Used.script.list
findstr /M /C:"// %~1" *.pas.ms.script>> %~1Used.script.list
rem grep -l+ "'%~1'" *.pas.ms.script > %~1Used.script.list
del run%~1Used.script.list
for /f %%i in (%~1Used.script.list) do echo %%i.runner>> run%~1Used.script.list
call cal.cmd -list:run%~1Used.script.list

ca.cmd - генерация ВСЕХ элементов модели

pushd W:\shared\models\NewSchool\Scripts
call clearbackup.cmd
call clear.cmd
W:\common\env\QuickLaunch\callMSS.exe W:\shared\models\NewSchool\Scripts\*.pas.ms.script.runner
rem call clearempty.cmd
popd

Это всё - ЧЕРТОВСКИ НЕЧИТАБЕЛЬНО (тот же REXX или командный интерпретатор RSX-11 - сильно читабельнее). Руки оторвать тем, кто это придумал.

Но зато - работает....

(+) http://programmingmindstream.blogspot.ru/2016/04/1209.html
http://programmingmindstream.blogspot.ru/2016/04/1134.html

#1234. Ни о чём. Про "функциональщину"

Ну и можно написать:

for i := 0 to N do 
 if IsPredicate(Item[i]) then 
  Process(Transform(Item[i]))

а можно:

Items 
.filter> IsPredicate 
.map> Transform 
.for> Process

, по мне второе - читабельнее.

Это к вопросу об SQL и LINQ.

http://programmingmindstream.blogspot.ru/2016/04/1132-2.html

ARRAY FUNCTION .mapToTarget>
  ARRAY IN anArray
 anArray .map> .Target >>> Result
; // .mapToTarget>

BOOLEAN elem_func IsFriend
 Self .IsStereotype st_friend::Dependency 
 >>> Result
; // IsFriend


  Self .Dependencies
  .filter> .IsFriend
  .mapToTarget>
  .for> (
    IN anItem
  ) // .for>

elem_iterator ChildrenEx
 Cached:
 (
  VAR l_Children
  Self .Children >>> l_Children
  
  Self .Dependencies
  .filter> .IsFriend
  .mapToTarget>
  .for> (
    IN anItem
    VAR l_Friend
    anItem .FriendClass >>> l_Friend
    l_Children 
    .join> ToArray: l_Friend
    >>> l_Children
  ) // .for>

elem_iterator ChildrenEx
 Cached:
 (
  VAR l_Children
  Self .Children >>> l_Children
  
  Self .Dependencies
  .filter> .IsFriend
  .mapToTarget>
  .for> (
    IN anItem
    VAR l_Friend
    anItem .FriendClass >>> l_Friend
    if ( l_Children l_Friend .Name .HasModelElementWithName ! ) then
    begin
     l_Children 
     .join> ToArray: l_Friend
     array:Copy
     >>> l_Children
    end // ( l_Children l_Friend .Name .HasModelElementWithName ! )
  ) // .for>

elem_iterator ChildrenEx
 Cached:
 (
  VAR l_Children
  Self .Children >>> l_Children
  
  Self .Dependencies
  .filter> .IsFriend
  .mapToTarget>
  .map> .FriendClass
  .for> (
    IN aFriend
    if ( l_Children aFriend .Name .HasModelElementWithName ! ) then
    begin
     l_Children 
     .join> ToArray: aFriend
     array:Copy
     >>> l_Children
    end // ( l_Children aFriend .Name .HasModelElementWithName ! )
  ) // .for>

суббота, 23 апреля 2016 г.

#1233. ToDo. Для метода читать UC из файла родителя

Вот тут:
  l_RealFileName l_CurrentGeneratedElementPrefix ReadUCFromFile
  g_FinalFileNameForUC l_CurrentGeneratedElementPrefix ReadUCFromFile
...
 l_Found ! ? (
  VAR l_Field
  g_CurrentGenerator %% aKey >>> l_Field
  if ( l_Field IsNil ) then
  begin
   aKey aOutNew DO
  end // ( l_Field IsNil )
  else
  begin
   aKey l_Field DO aOutExisting DO
  end // ( l_Field IsNil )
 ) // l_Found ! ?
...

пятница, 22 апреля 2016 г.

#1232. Скрипты. Получение копии массива. №2

[ ] array:Copy . // - получаем nil
[] array:Copy . // - получаем nil
[nil] array:Copy . // - получаем nil
[empty] array:Copy . // - получаем nil

[ ] array:CopyNotNil . // - получаем [ ]
[] array:CopyNotNil . // - получаем [ ]
[nil] array:CopyNotNil . // - получаем [ ]
[empty] array:CopyNotNil . // - получаем [ ]

[ 1 2 3 ] array:Copy . // - получаем [ 1 2 3 ]
[ 1 2 3 ] .filter> ( 2 != ) array:Copy . // - получаем [ 1 3 ]
[ 1 2 3 ] .filter> ( 2 == ) array:Copy . // - получаем [ 2 ]

[ 1 2 3 ] .map> ( 1 + ) array:Copy . // - получаем [ 2 3 4 ]
[ 1 2 3 ] .map> ( 2 + ) array:Copy . // - получаем [ 3 4 5 ]
[ 1 2 3 ] .map> ( 2 * ) array:Copy . // - получаем [ 2 4 6 ]

[ 1 2 3 ] .filter> ( 2 != ) .map> ( 1 + ) array:Copy . // - получаем [ 2 4 ]
[ 1 2 3 ] .filter> ( 2 == ) .map> ( 1 + ) array:Copy . // - получаем [ 3 ]

[ 1 2 3 4 ] .slice> 2 array:Copy . // - получаем [ 1 2 ] [ 3 4 ]
[ 1 2 3 4 5 6 ] .slice> 3 array:Copy . // - получаем [ 1 2 3 ] [ 4 5 6 ]

[ 1 2 3 4 ] .filter> IsOdd .slice> 2 array:Copy . // - получаем [ 1 3 ]
[ 1 2 3 4 ] .filter> IsEven .slice> 2 array:Copy . // - получаем [ 2 4 ]

[ 1 2 3 4 5 6 7 8 9 10 ] .filter> IsOdd array:Copy . // - получаем [ 1 3 5 7 9 ]
[ 1 2 3 4 5 6 7 8 9 10 ] .filter> IsEven array:Copy . // - получаем [ 2 4 6 8 10 ]

[ 1 2 ] .join> [ 3 4 ] array:Copy . // - получаем [ 1 2 3 4 ]
[ 1 2 ] .join> [ 3 4 ] .filter> IsOdd array:Copy . // - получаем [ 1 3 ]
[ 1 2 ] .join> [ 3 4 ] .filter> IsEven array:Copy . // - получаем [ 2 4 ]

[ 1 2 ] .join> [ 3 4 ] .map> ( 1 + ) array:Copy . // - получаем [ 2 3 4 5 ]
[ 1 2 ] .join> [ 3 4 ] .filter> IsOdd .map> ( 1 + ) array:Copy . // - получаем [ 2 4 ]
[ 1 2 ] .join> [ 3 4 ] .filter> IsEven .map> ( 1 + ) array:Copy . // - получаем [ 3 5 ]

[ 1 2 3 4 ] .join> [ 5 6 7 8 ] .filter> IsOdd .map> ( 1 + ) .slice> 2 array:Copy . // - получаем [ 2 4 ] [ 6 8 ]
[ 1 2 3 4 ] .join> [ 5 6 7 8 ] .filter> IsEven .map> ( 1 + ) .slice> 2 array:Copy . // - получаем [ 3 5 ] [ 7 9 ]

[ 1 2 3 4 ] .join> [ 5 6 7 8 ] .map> ( 1 + ) .filter> IsOdd .slice> 2 array:Copy . // - получаем [ 3 5 ] [ 7 9 ]
[ 1 2 3 4 ] .join> [ 5 6 7 8 ] .map> ( 1 + ) .filter> IsEven .slice> 2 array:Copy . // - получаем [ 2 4 ] [ 6 8 ]

[ 1 2 3 4 ] .reverted> array:Copy . // - получаем [ 4 3 2 1 ]
[ 1 2 ] .join> [ 3 4 ] .reverted> array:Copy . // - получаем [ 4 3 2 1 ]
[ 1 2 ] .join> [ 3 4 ] .map> ( 1 + ) .reverted> array:Copy . // - получаем [ 5 4 3 2 ]
[ 1 2 ] .join> [ 3 4 ] .filter> ( 2 != ) .map> ( 1 + ) .reverted> array:Copy . // - получаем [ 5 4 2 ]

Примеры:

BOOLEAN elem_func InheritsFrom
  ModelElement IN anAncestor
 anAncestor :Cached:
 ( 
  RULES
   ( Self IsNil )
    false
   ( Self anAncestor .IsSameType )
    true
   (
    Self .Inherits 
    .filter> ( anAncestor call.me )
    .CountIt > 0
   )
    true
   DEFAULT
    false 
  ; // RULES
 ) 
 >>> Result
; // InheritsFrom
...
ARRAY FUNCTION .filterNil>
  ARRAY IN anArray
 anArray
 .filter> ( IsNil ! ) 
 >>> Result
; // .filterNil>

...

ARRAY FUNCTION .filterMixIns>
  ARRAY IN anArray
 anArray
 .filter> ( .IsMixIn ! ) 
 // .filter> ( .IsPureMixIn ! )
 >>> Result
; // .filterMixIns>

...

ModelElement elem_func FirstOperation
 Cached:
 (
  Self .Operations .filter> ( .IsLocalMethod ! ) .FirstElement
 )
 >>> Result
; // FirstOperation

...

elem_iterator ForClassImplements
 Self .Implements 
 .filter> .IsClassImplementable
 >>> Result
; // ForClassImplements

...

elem_iterator PropertyKeys
 RULES
  ( Self .Parent .IsTestClass )
   (
    [ Self .Parent .EffectiveType .SelfParam ]
    .join>
    ( Self .Attributes )
   )
  DEFAULT 
   ( Self .Attributes )
 ; // RULES  
 .filter> ( .IsControlPrim ! )
 >>> Result
; // PropertyKeys

...
elem_iterator GlobalVars
 RULES
  ( Self .IsClassOrMixIn )
   (
    Self .Attributes
    .filter> ( .IsStereotype st_static::Attribute )
    if ( Self .IsSingleton ) then
    begin
     .join> ToArray: ( Self .InstanceField )
    end // ( Self .IsSingleton )
    .join> ( Self .InnerGlobalVars )
   )
  ( Self .IsUtilityPack ) 
   (
    Self .Attributes
    .filter> ( .IsProperty ! )
    .join> ( Self .InnerGlobalVars )
   )
  DEFAULT
   [empty] 
 ; // RULES
 >>> Result
; // GlobalVars

...

ARRAY FUNCTION .mapToTarget>
  ARRAY IN anArray
 anArray .map> .Target >>> Result
; // .mapToTarget>

...

elem_proc OutUses:
  STRING IN aUCPrefix
  ^ IN aUsed
  ^ IN aLambda
  ^ IN anItemTransform
  
 ARRAY VAR l_Used
 aUsed DO >>> l_Used
  
 ARRAY FUNCTION .filterUsed>
   ARRAY IN anArray
  anArray
  .filter> ( 
    IN anItem 
   anItem .UnitName >>> anItem 
   if ( anItem .NotInArray: l_Used ) then
   begin
    anItem .AddToArray: l_Used
    true
   end
   else
   begin
    false
   end 
  ) >>> Result  
 ; // .filterUsed> 
  
 'uses' .Out
   VAR l_NeedComma
   false >>> l_NeedComma
   Indented: ( 
    aLambda DO 
     .map> .UnitProducer 
     .filterNil> 
     .filterMixIns>
     .filter> ( Self ?!= )
     .filter> ( .UnitName Self .UnitName ?!= )
     .filter> ( .UnitName 'System' ?!= )
     //.map> .UnitName 
     .filterUsed> 
     .for> ( 
       IN anItem
      anItem .IfDef: ( anItem anItemTransform DO .WithComma: l_NeedComma .Out )
     ) // .for>
     
    if (
        ( Self .IsElementProxy )
        OR ( Self .UPisTrue "need UC" )
       ) then
    begin
     Self .UserCode: aUCPrefix ()
    end // ( Self .IsElementProxy )
    
    if (
        ( aUCPrefix 'intf_uses' == )
        AND ( Self .UPisTrue "need UC in project" )
       ) then
    begin
     Self .UserCode: 'manualuses' ()
    end // ( Self .IsElementProxy )
    
   ) // Indented:
 ';' .Out
 OutLn
; // OutUses:


Откуда "ноги растут":

http://programmingmindstream.blogspot.ru/2014/01/todo_24.html

#1231. Скрипты. Получение копии массива

WordAlias .KeepInStack NOP

WordAlias [[ [
%REMARK 'Начинает определение константного массива. Пока просто мапируется на неконстантный.'
WordAlias ]] ]
%REMARK 'Заканчивает определение константного массива. Пока просто мапируется на неконстантный.'

ARRAY FUNCTION array:Copy
  IN anArray
 %SUMMARY 
  'Копирует массив anArray в другой КОНСТАНТНЫЙ массив.'
  'Возвращает [nil] если исходный массив nil или пустой.'
 ; 
 RULES
  ( anArray IsNil )
   [nil]
  DEFAULT 
   (
    VAR l_Empty
    true >>> l_Empty
    [[ 
     anArray .for> ( 
      // .KeepInStack 
      // - это теперь не нужно, непустой функтор и так есть
      false >>> l_Empty
     ) // anArray .for>
    ]] 
    RULES
     l_Empty
      ( DROP [nil] )
    ; // RULES
   ) 
 ; // RULES 
 >>> Result
; // array:Copy

ARRAY FUNCTION array:CopyNotNil
  IN anArray
 %SUMMARY 
  'Копирует массив anArray в другой массив.'
  'ВСЕГДА возвращает НЕ nil.'
 ; 
 [ anArray .for> .KeepInStack ] 
 >>> Result
; // array:CopyNotNil

#1229. Скрипты. Тесты к функциям для работы с массивами. №2

UNIT arrays.ms.dict

USES
 to.ms.dict
 filter.ms.dict
 map.ms.dict
 reverted.ms.dict
;

EXPORTS
 * 

USES
 macro.ms.dict
;

macro IT 
  //ARRAY IN A // - слева должен быть массив
  ^ IN aWhatToDo
 %SUMMARY 'Итерирует массив A вызывая лямбду aWhatToDo' ;
 aWhatToDo CompileRef
 @ SWAP CompileValue
 @ ITERATE CompileValue
 //aWhatToDo A ITERATE
; // IT

WordAlias ==> IT

macro for
  ^ IN aList
  ^ IN aWhatToDo
 %SUMMARY 'Итерирует массив aList вызывая лямбду aWhatToDo' ;
 aList CompileRef
 @ DO CompileValue
 aWhatToDo CompileRef
 @ SWAP CompileValue
 @ ITERATE CompileValue
 //aList DO ==> ( aWhatToDo DO )
; // for

WordAlias >for> ==>
WordAlias .for> ==>

WordAlias array:AddTo >>>[]
WordAlias .AddToArray: >>>[]

PROCEDURE array:?AddTo
  IN aValue
  ^ IN anArray

 ARRAY VAR l_Array
 anArray DO >>> l_Array

 aValue l_Array array:Has ! ? (
  aValue array:AddTo l_Array
 ) // aValue l_Array array:Has ! ?
; // array:?AddTo

USES
 axiom_push.ms.dict
;

MACRO .InArray:
  ^ IN anArray
 anArray CompileValue
 axiom:PushSymbol array:Has
; // .InArray:

MACRO .NotInArray:
  ^ IN anArray
 anArray CompileValue
 axiom:PushSymbol array:Has
 axiom:PushSymbol !
; // .NotInArray:

MACRO .StringInArray:
  ^ IN anArray
 anArray CompileValue
 axiom:PushSymbol SWAP
 axiom:PushSymbol array:HasString
; // .StringInArray:

MACRO .StringNotInArray:
  ^ IN anArray
 anArray CompileValue
 axiom:PushSymbol SWAP
 axiom:PushSymbol array:HasString
 axiom:PushSymbol !
; // .StringNotInArray:

MACRO .TextInArray:
  ^ IN anArray
 anArray CompileValue
 axiom:PushSymbol SWAP
 axiom:PushSymbol array:HasText
; // .TextInArray:

MACRO .TextNotInArray:
  ^ IN anArray
 anArray CompileValue
 axiom:PushSymbol SWAP
 axiom:PushSymbol array:HasText
 axiom:PushSymbol !
; // .TextNotInArray:
...
PROGRAM arrayHas.ms.script

USES
 arrays.ms.dict
;

1 [ 1 2 ] array:Has .
3 [ 1 2 ] array:Has .

1 .InArray: [ 1 2 ] .
3 .InArray: [ 1 2 ] .

: A1 [ 1 2 ] ;

1 .InArray: A1 .
3 .InArray: A1 .

[ 1 2 ] >reverted> .
[ 1 2 ] .reverted> .
[ 1 2 ] REVERTED .
[ 1 2 ] Reverted .
[ 1 2 ] reverted .

1 .NotInArray: [ 1 2 ] .
3 .NotInArray: [ 1 2 ] .
1 .NotInArray: A1 .
3 .NotInArray: A1 .

[ 'a' 'b' ] 'a' array:HasString .
[ 'a' 'b' ] 'c' array:HasString .
[ 'a' 'b' ] 'A' array:HasString .
[ 'a' 'b' ] 'C' array:HasString .

'a' .StringInArray: [ 'a' 'b' ] .
'c' .StringInArray: [ 'a' 'b' ] .
'A' .StringInArray: [ 'a' 'b' ] .
'C' .StringInArray: [ 'a' 'b' ] .

'a' .StringNotInArray: [ 'a' 'b' ] .
'c' .StringNotInArray: [ 'a' 'b' ] .
'A' .StringNotInArray: [ 'a' 'b' ] .
'C' .StringNotInArray: [ 'a' 'b' ] .

[ 'a' 'b' ] 'a' array:HasText .
[ 'a' 'b' ] 'c' array:HasText .
[ 'a' 'b' ] 'A' array:HasText .
[ 'a' 'b' ] 'C' array:HasText .

'a' .TextInArray: [ 'a' 'b' ] .
'c' .TextInArray: [ 'a' 'b' ] .
'A' .TextInArray: [ 'a' 'b' ] .
'C' .TextInArray: [ 'a' 'b' ] .

'a' .TextNotInArray: [ 'a' 'b' ] .
'c' .TextNotInArray: [ 'a' 'b' ] .
'A' .TextNotInArray: [ 'a' 'b' ] .
'C' .TextNotInArray: [ 'a' 'b' ] .


#1228. Скрипты. Тесты к функциям для работы с массивами

PROGRAM arrayHas.ms.script

USES
 arrays.ms.dict
;

1 [ 1 2 ] array:Has .
3 [ 1 2 ] array:Has .

1 .InArray: [ 1 2 ] .
3 .InArray: [ 1 2 ] .

: A1 [ 1 2 ] ;

1 .InArray: A1 .
3 .InArray: A1 .

[ 1 2 ] >reverted> .
[ 1 2 ] .reverted> .
[ 1 2 ] REVERTED .
[ 1 2 ] Reverted .
[ 1 2 ] reverted .

1 .NotInArray: [ 1 2 ] .
3 .NotInArray: [ 1 2 ] .
1 .NotInArray: A1 .
3 .NotInArray: A1 .

[ 'a' 'b' ] 'a' array:HasString .
[ 'a' 'b' ] 'c' array:HasString .
[ 'a' 'b' ] 'A' array:HasString .
[ 'a' 'b' ] 'C' array:HasString .

'a' .StringInArray: [ 'a' 'b' ] .
'c' .StringInArray: [ 'a' 'b' ] .
'A' .StringInArray: [ 'a' 'b' ] .
'C' .StringInArray: [ 'a' 'b' ] .


пятница, 15 апреля 2016 г.

#1227. Скрипты. Реализация кеширования результатов вычисления

: DoCache
  ModelElement IN aCacheWhere
  STRING IN aKey
  IN aDefault
  ^ IN aLambda
  
 if ( aCacheWhere IsNil ) then
 begin
  aLambda DO
 end // aCacheWhere IsNil
 else
 if ( aCacheWhere IsString ) then
 begin
  //ERROR [ aCacheWhere ':' aKey ]
  //[ aCacheWhere ':' aKey ] strings:Cat Msg
  aLambda DO
 end // aCacheWhere IsString
 else
/*(* 
 if ( aCacheWhere IsIntf ) then
 begin
  aLambda DO
 end // aCacheWhere IsIntf
 else
*)*/ 
 begin 
  ModelElement VAR l_CacheWhere
  VAR l_IsIntf
  false >>> l_IsIntf
  if ( aCacheWhere IsIntf ) then
  begin
   aCacheWhere pop:WordBox:Boxed >>> l_CacheWhere
   true >>> l_IsIntf
  end // ( aCacheWhere IsIntf )
  else
  begin
   aCacheWhere >>> l_CacheWhere
  end
  
  'cache:' aKey Cat >>> aKey
  VAR l_FieldVar
  l_CacheWhere %% aKey >>> l_FieldVar
 
  if ( l_FieldVar NotValid ) then    
  begin
   TRY
    aLambda DO
   EXCEPT
    [ 'Ошибка вызова: ' current:exception:Message ' : ' aKey ' на ' l_CacheWhere .WordName ] strings:Cat .
    aDefault
   END
   
   if l_IsIntf then
   begin
    if ( DUP IsIntf ! ) then
    begin
     false >>> l_IsIntf
    end // l_IsIntf
   end // l_IsIntf
   
   if ( l_IsIntf ! ) then
   begin
    VAR l_NewVar
    aKey false l_CacheWhere pop:NewWordDefinitor:CheckVar >>> l_NewVar
    @SELF l_NewVar pop:Word:SetProducer
    l_NewVar pop:Word:SetValue
    l_NewVar DO
   end // ( l_IsIntf ! )
  end // ( l_FieldVar NotValid )
  else 
  begin
   l_FieldVar DO
  end
 end // aCacheWhere IsNil
; // DoCache

: CacheWord
  ModelElement IN aCacheWhere
  TtfwWord IN aWord
  ^ IN aLambda
 aCacheWhere aWord .WordName nil DoCache ( aLambda DO )
; // CacheWord

MACRO Cache
 axiom:PushSymbol @SELF
 axiom:PushSymbol CacheWord
; // Cache

MACRO CacheMethod
 'Self' Ctx:Parser:PushSymbol
 axiom:PushSymbol @SELF
 axiom:PushSymbol CacheWord
; // CacheMethod

WordAlias Cached: CacheMethod

STRING elem_func UIDEx
 Cached:
 (
  VAR l_UID
  Self .UID >>> l_UID
  RULES
   ( l_UID IsNil )
    (
     VAR l_Name
     Self .Name >>> l_Name 
     RULES
      ( l_Name IsNil )
       ( Self .WordName )
      DEFAULT
       ( l_Name '_' Self .WordName Cat )
     ; // RULES
    )
   DEFAULT
    l_UID
  ; // RULES
 )
 >>> Result  
; // UIDEx 

STRING FUNCTION ValueToKey
  ANY IN aValue
 RULES
  ( aValue IsNil )
   ''
  ( aValue IsString )
   aValue
  ( aValue IsArray )
   ( 
    aValue 
    .map> call.me
    strings:Cat
   )
  ( aValue IsBool )
   ( aValue ToPrintable )
  ( aValue IsInt )
   ( aValue ToPrintable )  
  ( aValue IsIntf )
   ERROR 'Невозможно построить ключ для интерфейса'
  ( aValue Is class::TkwCompiledWord )
   ( aValue .UIDEx )
  ( aValue Is class::TtfwWord )
   ( aValue .WordName )
  ( aValue IsObj )
   ERROR 'Невозможно построить ключ для абстрактного объекта'
  ( aValue IsNil )
   ''   
  DEFAULT
   ( aValue ToPrintable )
 ; // RULES
 >>> Result
; // ValueToKey

: CacheWordEx
  ANY IN aKey
  ModelElement IN aCacheWhere
  TtfwWord IN aWord
  ^ IN aLambda
 aCacheWhere 
 aKey ValueToKey aWord .WordName Cat 
 nil DoCache ( aLambda DO )
; // CacheWordEx

MACRO :Cached:
 'Self' Ctx:Parser:PushSymbol
 axiom:PushSymbol @SELF
 axiom:PushSymbol CacheWordEx
; // :Cached:

WordAlias Cached: CacheMethod
WordAlias GenCached: CacheMethod


#1226. Скрипты. Загрузка слова скрипта по требованию. Позднее связывание. Аналог DLL

UNIT LoadOnDemand.ms.dict

USES
 Log.ms.dict
;

: UIDS_LIST
;
// - список загруженных элементов

initialization (
 @ UIDS_LIST DisableForHelp
)

TtfwWord FUNCTION LoadWord
  STRING IN aWordName
  STRING IN aDictName
  
 VAR l_VAR 
 
 @ UIDS_LIST %% aWordName >>> l_VAR
 if ( l_VAR IsNil ! ) then
 begin
  l_VAR DO >>> Result
 end // l_VAR IsNil !
 else
 begin
  //aWordName false @ UIDS_LIST pop:NewWordDefinitor:CheckRefcountVar >>> l_VAR
  aWordName false @ UIDS_LIST pop:NewWordDefinitor:CheckVar >>> l_VAR
  //UIDS_LIST ->^ aWordName >>> l_VAR
  // - добавляем переменную и снимем её со стека
  
  STRING VAR l_Code 
  [ 'INCLUDE ' '''' aDictName '''' ' @ ' aWordName ] strings:Cat >>> l_Code 
  BOOLEAN VAR l_WasException
  false >>> l_WasException
  TRY
   l_Code script:CompileStringAndProcess DO
  EXCEPT
   current:exception:Message .
   [ 'Возможно элемент ' aWordName ' удалён' ] strings:Cat .
   true >>> l_WasException
   nil >>> Result
  END 
  
  if ( l_WasException ! ) then
  begin
   >>> Result
   Result pop:Word:Name aWordName == ?ASSURE [ 'Вернулось неверное слово ' Result pop:Word:Name ' вместо ' aWordName ]
  end // l_WasException !
  l_VAR ^:= Result
  //Log: [ Result pop:Word:Name ' loaded' ]
 end // l_VAR IsNil !
; // LoadWord 

WordAlias LW LoadWord

TtfwWord FUNCTION WordLink
  Literal IN aWordName
  Literal IN aDictName
 aWordName |N aDictName |N LoadWord >>> Result
; // WordLink

WordAlias WL WordLink

#1225. Скрипты. Преобразование константного списка в итератор

ARRAY FUNCTION Seq:
  ^ IN aCode
 %SUMMARY 'Преобразует список компилированных слов в итератор вызывающий каждое из этих слов' ;
 aCode CodeIterator .map> DO >>> Result
; // Seq:

И вызов:

: ME_431348CB3E15
 CONST UID '431348CB3E15'
 CONST Name 'ReleasetoK'
 CONST IsSummoned true
 CONST Class class_Class
 : Stereotype st_TestResults ;
 CONST Kind kind_NormalClass
 %SUMMARY 'Стандартный вывод для ГК (релизный вариант)' ;
 CONST Visibility PublicAccess
 CONST Abstraction at_regular
 : Parent ME_06EF1E6353C7 // ReleaseDaily$Test
 ;
 : Inherits
   Seq: ( WL 'ME_4B7AAC7A031D' '4B2A112B011A.pas.ms.script' // TTestResultsPlace
 )
 ; // Inherits
 : Implemented
   Seq: ( ME_4B7AB0B6016E_ME_431348CB3E15 // CommandLineKey
 ME_4B7C0B43005B_ME_431348CB3E15 // TimesPage
 ME_4B7C0B670215_ME_431348CB3E15 // ResultsPage
 )
 ; // Implemented
 : Overridden
   Seq: ( ME_4BEA9969001B_ME_431348CB3E15 // IsGK
 )
 ; // Overridden
 CONST "needs InstanceR" 'undefined'
 CONST "needs script" 'undefined'
 CONST "needs script keywords documentation" 'undefined'
 CONST "no hands" false
 CONST "register in scripts" 'undefined'
 CONST intf.pas:Path 'common\components\DailyTest\ReleasetoK.pas'
 CONST extprop:pas:TypeName 'TReleasetoK'
 CONST extprop:rc:SelfName 'ReleasetoK'
 CONST extprop:rc:isAcceptableForScripts true

ref; // ME_431348CB3E15 ReleasetoK


#1224. Скрипты. Замеры времени и вывод в лог

    if ( Self .NeedOwnFile ) then
    begin
     VAR l_Name
     Self .Name >>> l_Name
     [ l_Name ' ' g_CurrentGenerator .WordName ] strings:Cat >>> l_Name
     Log: [ l_Name ' generation start' ]
     VAR l_Time
     StartTimer
     TRY
      ( Self .GenerateWordToFileWith: .CurrentGenerator )
     FINALLY
      l_Name StopTimerNoLog >>> l_Time
     END // TRY..FINALLY 
     l_Time 1000 DIV >>> l_Time
     if ( l_Time > 3 ) then
     begin
      Log: [ l_Name ' generation end ' l_Time ' seconds' ]
     end // ( l_Time > 3 )
    end // ( Self .NeedOwnFile )
    else
     ( Self .DeleteWordFile ) 

#1223. Скрипты. Функции тестирующие работу с пустыми (нулевыми) массивами

ARRAY VAR A
nil >>> A

A .join> A .
nil .join> nil .

nil Array:Count .
nil Array:Clear
nil .join> nil .
nil .join> [ ] .
[ ] .join> nil .
[ ] .join> [ ] .
nil .filter> DROP .
nil .map> DROP .
nil .reverted> .
nil .for> .
nil .slice> 2 .

Написание тестов более чем просто.

#1222. Скрипты. Функция преобразующая элемент в константный массив из одного (этого) элемента

Функция преобразующая элемент в константный массив из одного (этого) элемента.

И кеширующая результат выполнения.

ModelElement elem_func WeakRef
 %SUMMARY 
  'Возвращает СЛАБУЮ ссылку на элемент.'
 ;
 RULES
  ( Self IsIntf )
   ( Self pop:WordBox:Boxed )
  DEFAULT
   Self 
 ; // RULES
 >>> Result
; // WeakRef

WordAlias [[ [
%REMARK 'Начинает определение константного массива. Пока просто мапируется на неконстантный.'
WordAlias ]] ]
%REMARK 'Заканчивает определение константного массива. Пока просто мапируется на неконстантный.'

ARRAY elem_func ElementToArray
 Cached:
 (
  [[ Self .WeakRef ]]
 ) 
 >>> Result 
; // ElementToArray

ARRAY elem_func ElementToArray:
  ^ IN aLambda
 Self aLambda DO .ElementToArray
 >>> Result 
; // ElementToArray:

Используется для оптимизации расхода памяти.
Массивы создаются не каждый раз при вызове функции, а один раз на элемент.

И вызов:

elem_proc OutClass

 Self .DefineImplementedMixInValues

 if ( Self .UPisTrue "need UC" ) then
 begin
  Self .UserCode: 'ci' ()
 end // ( Self .UPisTrue "need UC" ) 

 Self .MixInValues .for> (
   IN aValue
  aValue .Name array:AddTo g_MixInValues 
  [ '_' aValue .Name '_' ' = ' aValue .Target .TypeName ';' ] .Out
 )
 
 VAR l_Parent
 Self .CalcParentAndInclude >>> l_Parent
 
 if ( Self .UPisTrue "need UC" ) then
 begin
  Self .UserCode: 'cit' ()
 end // ( Self .UPisTrue "need UC" ) 
 
 [ 
  Self .TypeName 
  ' = ' 
  
  Self .Abstraction CASE
   at_abstract
    [ cOpenComment 'abstract' cCloseComment cSpace ]
   at_final
    [ cOpenComment 'final' cCloseComment cSpace ]
  END // CASE
  
  'class'

  ARRAY VAR l_Implements 
  [] >>> l_Implements

  VAR l_WasComma
  false >>> l_WasComma
  
  l_Parent .ElementToArray
  .join> ( 
   Self .ClassImplements 
   .filter> (
     IN anItem
    if ( anItem l_Implements array:Has ! ) then
    begin
     anItem array:AddTo l_Implements
     true
    end // ( anItem l_Implements array:Has ! )
    else
    begin
     false
    end // ( anItem l_Implements array:Has ! )
   ) // .filter>
  ) // .join>
  .With()> (
    IN anItem
   RULES 
    ( anItem .IsMixIn )
     ( anItem .TypeName .WithComma: l_WasComma .KeepInStack )
    DEFAULT
    begin
     anItem .IfDefBraceLn:
     ( 
      anItem .TypeName .WithComma: l_WasComma .KeepInStack
     ) // anItem .IfDefBraceLn:
    end // DEFAULT
   ; // RULES
  ) // .With()>
 ] .Out
 
 Self .OutDocumentation
 Self .OutClassInner
 
 [ 'end;//' Self .TypeName ] .Out
 
 Self .UndefineImplementedMixInValues
; // OutClass

четверг, 7 апреля 2016 г.

#1220. Последний штрих на сегодня. Определяем, что такого элемента ещё нет

Последний штрих на сегодня.

Определяем, что такого элемента ещё нет:

elem_iterator ConstantsEx
 Cached:
 (
  Self .Constants
  
  RULES
   ( Self .IsTypedef )
    begin
     VAR l_OtherEnum
     Self .MainAncestor >>> l_OtherEnum
     RULES
      ( l_OtherEnum .IsEnum )
       RULES
        ( Self .Name l_OtherEnum .Name == )
         RULES
          ( l_OtherEnum .Attributes .CountIt > 0 )
           begin
            VAR l_ConstantsName
            [ Self .Name '_' l_OtherEnum .Name '_' 'Constants' ] strings:Cat >>> l_ConstantsName
            RULES
             ( 
              Self .Parent call.me 
              .filter> ( .Name l_ConstantsName == )
              .CountIt 0 ==
             )
              begin
               .join>
               [
                l_ConstantsName MakeConstants: (
                  IN aConstants
                 aConstants -> %SUM := ( [ 'Алиасы для значений ' l_OtherEnum .Parent .Name '.' l_OtherEnum .Name ] strings:Cat )
                 aConstants -> Visibility := PublicAccess
                 VAR l_ElementPrefix
                 l_OtherEnum .GetUP 'extprop:pas:ElementPrefix' >>> l_ElementPrefix
                 aConstants -> Attributes := [
                  l_OtherEnum .Attributes .for> (
                    IN anItem
                   VAR l_Name 
                   [ l_ElementPrefix anItem .Name ] strings:Cat >>> l_Name
                   l_Name
                   [ l_OtherEnum .EffectiveUnitName '.' l_Name ] strings:Cat 
                   MakeConstant: (
                     IN aConstant
                    RULES
                     ( anItem .Documentation IsNil ! )
                      ( aConstant -> %SUM := ( anItem .Documentation ) )
                    ; // RULES 
                   ) // MakeConstant:
                  ) // l_OtherEnum .Attributes .for>
                 ] // aConstants -> Attributes
                ) // MakeConstants:
               ] // .join>
              end
            ; // RULES
           end // ( l_OtherEnum .Attributes .CountIt > 0 )
         ; // RULES
       ; // RULES
     ; // RULES
    end // ( Self .IsTypedef )
  ; // RULES
 )
 >>> Result
; // ConstantsEx

#1219. Скрипты. Продолжаем тему

INTERFACE FUNCTION MakeConstants:
  STRING IN aName
  ^ IN aLambda
 aName nil MakeParam: ( 
   IN aMade
  aMade -> Stereotype := st_Constants
  aMade aLambda DO
 )
 >>> Result 
; // MakeConstants:
  
INTERFACE FUNCTION MakeConstant:
  STRING IN aName
  PRINTABLE IN aValue
  ^ IN aLambda
 aName nil MakeParam: ( 
   IN aMade
  aMade -> Class := class_Attribute
  aMade -> 'extprop:pas:Value' := aValue
  aMade aLambda DO
 )
 >>> Result 
; // MakeConstant:

elem_iterator ConstantsEx
 Cached:
 (
  Self .Constants
  
  RULES
   ( Self .IsTypedef )
    begin
     VAR l_OtherEnum
     Self .MainAncestor >>> l_OtherEnum
     RULES
      ( l_OtherEnum .IsEnum )
       RULES
        ( Self .Name l_OtherEnum .Name == )
         RULES
          ( l_OtherEnum .Attributes .CountIt > 0 )
           begin
            VAR l_ConstantsName
            [ Self .Name '_' l_OtherEnum .Name '_' 'Constants' ] strings:Cat >>> l_ConstantsName
            .join>
            [
             l_ConstantsName MakeConstants: (
               IN aConstants
              aConstants -> %SUM := ( [ 'Алиасы для значений ' l_OtherEnum .Parent .Name '.' l_OtherEnum .Name ] strings:Cat )
              aConstants -> Visibility := PublicAccess
              aConstants -> Attributes := [
               l_OtherEnum .Attributes .for> (
                 IN anItem
                anItem .Name 
                [ l_OtherEnum .EffectiveUnitName '.' anItem .Name ] strings:Cat 
                MakeConstant: (
                  IN aConstant
                 RULES
                  ( anItem .Documentation IsNil ! )
                   ( aConstant -> %SUM := ( anItem .Documentation ) )
                 ; // RULES 
                ) // MakeConstant:
               ) // l_OtherEnum .Attributes .for>
              ] // aConstants -> Attributes
             ) // MakeConstants:
            ] // .join>
           end // ( l_OtherEnum .Attributes .CountIt > 0 )
         ; // RULES
       ; // RULES
     ; // RULES
    end // ( Self .IsTypedef )
  ; // RULES
 )
 >>> Result
; // ConstantsEx

К коду нужны комментарии?

#1218. Скрипты. Правила. Итераторы. Лямбды. Списки. Добавление элементов. Продолжение темы

INTERFACE FUNCTION MakeConstants:
  STRING IN aName
  ^ IN aLambda
 aName nil MakeParam: ( 
   IN aMade
  aMade -> Stereotype := st_Constants
  aMade aLambda DO
 )
 >>> Result 
; // MakeConstants:
  
INTERFACE FUNCTION MakeConstant:
  STRING IN aName
  PRINTABLE IN aValue
  ^ IN aLambda
 aName nil MakeParam: ( 
   IN aMade
  aMade -> Class := class_Attribute
  aMade -> 'extprop:pas:Value' := aValue
  aMade aLambda DO
 )
 >>> Result 
; // MakeConstant:

elem_iterator ConstantsEx
 Cached:
 (
  Self .Constants
  
  RULES
   ( Self .IsTypedef )
    begin
     VAR l_OtherEnum
     Self .MainAncestor >>> l_OtherEnum
     RULES
      ( l_OtherEnum .IsEnum )
       RULES
        ( Self .Name l_OtherEnum .Name == )
         RULES
          ( l_OtherEnum .Attributes .CountIt > 0 )
           begin
            VAR l_ConstantsName
            [ Self .Name '_' l_OtherEnum .Name '_' 'Constants' ] strings:Cat >>> l_ConstantsName
            .join>
            [
             l_ConstantsName MakeConstants: (
               IN aConstants
              aConstants -> %SUM := ( [ 'Алиасы для значений ' l_OtherEnum .Parent .Name '.' l_OtherEnum .Name ] strings:Cat )
              aConstants -> Visibility := PublicAccess
              aConstants -> Attributes := [
               l_OtherEnum .Attributes .for> (
                 IN anItem
                anItem .Name 'XXX' MakeConstant: (
                  IN aConstant
                ) // MakeConstant:
               ) // l_OtherEnum .Attributes .for>
              ] // aConstants -> Attributes
             ) // MakeConstants:
            ] // .join>
           end // ( l_OtherEnum .Attributes .CountIt > 0 )
         ; // RULES
       ; // RULES
     ; // RULES
    end // ( Self .IsTypedef )
  ; // RULES
 )
 >>> Result
; // ConstantsEx

#1217. Скрипты. Правила. Продолжение темы

elem_iterator ConstantsEx
 Cached:
 (
  Self .Constants
  
  RULES
   ( Self .IsTypedef )
    begin
     VAR l_OtherEnum
     Self .MainAncestor >>> l_OtherEnum
     RULES
      ( l_OtherEnum .IsEnum )
       RULES
        ( Self .Name l_OtherEnum .Name == )
         RULES
          ( l_OtherEnum .Attributes .CountIt > 0 )
           begin
            .join>
            [
             [ Self .Name '_' l_OtherEnum .Name '_' 'Constants' ] strings:Cat
             MakeConstants: (
               IN aConstants
              aConstants -> %SUM := ( [ 'Алиасы для значений ' l_OtherEnum .Parent .Name '.' l_OtherEnum .Name ] strings:Cat )
              aConstants -> Visibility := PublicAccess
              aConstants .Name Msg 
              aConstants .Documentation Msg 
             ) // MakeConstants:
            ]
           end // ( l_OtherEnum .Attributes .CountIt > 0 )
         ; // RULES
       ; // RULES
     ; // RULES
    end // ( Self .IsTypedef )
  ; // RULES
 )
 >>> Result
; // ConstantsEx

#1216. Скрипты. Правила. Создание новых элементов. Лямбды. Объединение списков

INTERFACE FUNCTION MakeConstants:
  STRING IN aName
  ^ IN aLambda
 aName nil MakeParam: ( 
   IN aMade
  aMade -> Stereotype := st_Constants
  aMade aLambda DO
 )
 >>> Result 
; // MakeConstants:
  
elem_iterator ConstantsEx
 Cached:
 (
  Self .Constants
  
  RULES
   ( Self .IsTypedef )
    RULES
     ( Self .MainAncestor .IsEnum )
      RULES
       ( Self .Name Self .MainAncestor .Name == )
        (
         .join>
         [
          [ Self .Name '_' Self .MainAncestor .Name '_' 'Constants' ] strings:Cat
          MakeConstants: (
            IN aConstants
           aConstants .Name Msg 
          ) // MakeConstants:
         ]
        ) // ( Self .Name Self .MainAncestor .Name == )
      ; // RULES
    ; // RULES
  ; // RULES
 )
 >>> Result
; // ConstantsEx

#1215. Скрипты. Ещё о правилах

elem_iterator ConstantsEx
 Self .Constants
 
 RULES
  ( Self .IsTypedef )
   RULES
    ( Self .MainAncestor .IsEnum )
     RULES
      ( Self .Name Self .MainAncestor .Name == )
       (
        Self .Name Msg // - это просто отладочная печать, что попали в это место
       )
     ; // RULES
   ; // RULES
 ; // RULES
 
 >>> Result
; // ConstantsEx

По-моему - более чем читабельно и понятно.

#1214. Обработка ошибок открытия файлов через лямбды

PROCEDURE ForceDirectories
  STRING IN aPath
 aPath sysutils:ForceDirectories ?ASSURE [ 'Не удалось создать директорию ' aPath ]  
; // ForceDirectories

FILE FUNCTION TryOpen:
  STRING IN aFileName
  ^ IN aOpenLambda
 %SUMMARY 
  'Открывает файл aFileName методом aOpenLambda обрабатывая ошибки открытия' 
  'Пытается открыть файл повторно несколько раз.'
 ;
 VAR l_TryCount
 10 >>> l_TryCount
 
 while ( l_TryCount > 0 )
 begin
  TRY
   aFileName aOpenLambda DO >>> Result 
   0 >>> l_TryCount
  EXCEPT
   Dec l_TryCount
   nil >>> Result
   if ( l_TryCount 0 == ) then
    RAISE
   else
   begin
    [ 'Файл ' aFileName ' был занят. Ожидаем его освобождения. Попытка номер: ' l_TryCount IntToStr ] strings:Cat >>std::out
    500 SLEEP
   end // ( l_TryCount 0 == )
  END // TRY..EXCEPT
 end // ( l_TryCount > 0 )
; // TryOpen: 

FILE FUNCTION MakePathAndOpenWrite
  STRING IN aFileName
 %SUMMARY 
  'Открывает файл aFileName на запись.' 
  'Если надо - создаёт полный путь на файловой системе.'
 ;
 aFileName sysutils:ExtractFilePath ForceDirectories
 aFileName TryOpen: File:OpenWrite >>> Result
; // MakePathAndOpenWrite

...

PROCEDURE ReadUCFromFile
  STRING IN aFileName
  STRING IN aCurrentGeneratedElementPrefix
 if ( aFileName sysutils:FileExists ) then
 begin
  FILE VAR l_In
  aFileName TryOpen: File:OpenRead >>> l_In
  TRY
   VAR l_UCOpened
   ARRAY VAR l_Accumulated
   STRING VAR l_Key
   
   false >>> l_UCOpened
   l_In File:ReadLines (
     IN aStr
     
    VAR l_Pos
    
    : Has
     string:Pos >>> l_Pos
     l_Pos -1 !=
    ; // Has
     
    RULES 
     ( aStr cUCStart Has )
      ( 
       l_UCOpened ! ?ASSURE [ 'Секция кода уже открыта. Файл: ' aFileName ' строка:' aStr ]
       true >>> l_UCOpened
       aStr string:Trim >>> aStr
       [] >>> l_Accumulated
       
       aStr >>> l_Key
       '*' string:SplitTo! l_Key DROP
       
      )
     ( aStr cUCEnd Has )
      ( 
       l_UCOpened ?ASSURE [ 'Секция кода не открыта. Файл: ' aFileName ' строка:' aStr  ]
       false >>> l_UCOpened
       
       VAR l_Head
       if ( l_Pos > 0 ) then
       begin
        l_Pos 0 aStr string:Substring >>> l_Head
        if ( l_Head string:TrimLeft IsNil ! ) then
        begin
         l_Head array:AddTo l_Accumulated
         
         aStr string:Len l_Pos - 
         l_Pos 
         aStr 
         string:Substring >>> aStr
        end // ( l_Head IsNil ! )
       end // ( l_Pos > 0 )
       
       aStr string:Trim >>> aStr
       
       g_CurrentGenerator ->^ l_Key ^:= l_Accumulated
       g_CurrentGenerator ->^ ( aCurrentGeneratedElementPrefix l_Key Cat ) ^:= l_Accumulated
       
       nil >>> l_Accumulated
      )
     DEFAULT
      (
       l_UCOpened ? ( 
        aStr array:AddTo l_Accumulated
       ) // l_UCOpened ?
      ) 
    ; // RULES  
   ) // l_In File:ReadLines
  FINALLY
   nil >>> l_In
  END // TRY..FINALLY
 end // ( aFileName sysutils:FileExists )
; // ReadUCFromFile


среда, 6 апреля 2016 г.

#1213. Скрипты. Правила. Итераторы. Фильтрация

elem_iterator InterfaceOwnOperations
 Self .Operations 
 .filter> ( .IsStaticMethod ! )
 .joinWithLambded> ( Self .InterfaceForClassImplements ) .ElementToArray: .CastMethod
 >>> Result
; // InterfaceOwnOperations

elem_iterator InterfaceOperationsTotal
 Cached:
 (
  Self .InterfaceOwnOperations
  .joinWithLambded> ( Self .Implements .filter> .IsPureMixIn ) (
    IN anItem
   anItem call.me
   .joinWithLambded> ( anItem .Inherits .filter> .IsPureMixIn ) .InterfaceOwnOperations
  ) 
 ) 
 >>> Result
; // InterfaceOperationsTotal

ModelElement elem_func MainImplements
 Cached:
 (
  Self .Implements 
  .FirstElement
 )
 >>> Result
; // MainImplements

BOOLEAN elem_func ImplementsIterator
 Cached:
 (
  RULES
   ( Self .MainImplements IsNil )
    false
   ( Self .MainImplements .IsIterator )
    true 
   DEFAULT
    false
  ; // RULES
 )
 >>> Result
; // ImplementsIterator

BOOLEAN elem_func IsMethodAndImplementsIterator
 RULES
  ( Self .IsMethod ! )
   false
  ( Self .ImplementsIterator )
   true 
  DEFAULT
   false
 ; // RULES
 >>> Result
; // IsMethodAndImplementsIterator

BOOLEAN elem_func SomeMethodImplementsThisIterator
  ModelElement IN anIterator
 RULES
  (
   Self .Operations
   .filter> .IsMethodAndImplementsIterator
   .map> .MainImplements
   .filter> ( anIterator .IsSameModelElement )
   .CountIt > 0
  )
   true
  DEFAULT
   false
 ; // RULES
 >>> Result 
; // SomeMethodImplementsThisIterator

elem_iterator InterfaceOperationsTotalDeep
 Self .InterfaceOperationsTotal
 
 .joinWithLambded> ( Self .Inherits .filter> .IsClassImplementable ) call.me
 
 >>> Result
; // InterfaceOperationsTotalDeep

elem_iterator ImplementedEx
 Cached:
 (
  Self .Implemented
  
  if ( Self .IsClassOrMixIn ) then
  begin
   VAR l_OutedIterators
   [] >>> l_OutedIterators
   
   .joinWithLambded> ( Self .ClassImplements ) ( 
    .InterfaceOperationsTotalDeep 
    .filter> ( .IsFacetIterator ! )
    .filter> ( .IsIterator )
    .filter> ( Self SWAP .SomeMethodImplementsThisIterator ! )
    .filter> ( 
      IN anItem
     if ( anItem l_OutedIterators array:Has ! ) then
     begin
      anItem array:AddTo l_OutedIterators
      true
     end
     else
      false 
    )
    .filter> ( 
      IN anItem 
     Self .MainAncestor call.me .filter> ( anItem .IsSameModelElement ) .CountIt 0 ==
    )
    .map> (
     Self IsVoid ?FAIL 'Self IsVoid'
     Self SWAP .ImplementMethod 
    )
    array:Copy
   )
  end // ( Self .IsClassOrMixIn )
 )
 >>> Result
; // ImplementedEx

#1212. Ещё немножко из скриптов

Циклы, исключения, работа с файлами...

FILE FUNCTION MakePathAndOpenWrite
  STRING IN aFileName
 VAR l_Path 
 aFileName sysutils:ExtractFilePath >>> l_Path
 l_Path ForceDirectories
 
 VAR l_TryCount
 10 >>> l_TryCount
 
 while ( l_TryCount > 0 )
 begin
  TRY
   aFileName File:OpenWrite >>> Result 
   0 >>> l_TryCount
  EXCEPT
   Dec l_TryCount
   if ( l_TryCount 0 == ) then
    RAISE
   else
   begin
    500 SLEEP
   end // ( l_TryCount 0 == )
  END // TRY..EXCEPT
 end // ( l_TryCount > 0 )
; // MakePathAndOpenWrite

#1210. "Продвинутый CASE". Только код

"Продвинутый CASE". Только код.

BOOLEAN elem_func IsUtilityPack
 Cached:
 (
  RULES
   ( Self .IsStereotype st_UtilityPack )
    true
   ( Self .IsScriptKeywordsPack ) 
    true
   DEFAULT
    false
  ; // RULES 
 ) 
 >>> Result
; // IsUtilityPack

...

BOOLEAN elem_func UseNewGenExcluded
 RULES
  ( Self .IsControllerInterfaces )
   true
  ( Self '_vcmData_' .InheritsFrom )
   true
  ( 
   ( Self 'Tl3Tag' .InheritsFrom )
   AND ( Self 'TtfwKeyWordPrim' .InheritsFrom ! )
   AND ( Self .IsUtilityPack ! )
  ) 
   true
  ( Self 'TddComboBoxConfigItem' .InheritsFrom )
   true
  ( Self 'Tl3ProtoObjectForTie' .InheritsFrom )
   true
  ( Self '_evdTagHolder_' .InheritsFrom )
   true
  DEFAULT
  begin
   if ( g_UseNewGenExcluded IsNil ) then
    Init_g_UseNewGenExcluded
    
   g_UseNewGenExcluded IsNil ?FAIL 'Не инициализирован g_UseNewGenExcluded'
   g_UseNewGenExcluded IsVoid ?FAIL 'Не инициализирован g_UseNewGenExcluded'
   
   g_UseNewGenExcluded
   .filter> ( Self .UID == )
   .CountIt > 0
  end // DEFAULT 
 ; // RULES  
 >>> Result
; // UseNewGenExcluded

...

BOOLEAN elem_func IsSimpleClass
 Cached:
 (
  RULES
   ( Self .IsUseCaseControllerImp )
    ( Self .Abstraction at_abstract != )
   ( Self .IsViewAreaControllerImp )
    ( Self .Abstraction at_abstract != )
   ( Self .IsStereotype st_SimpleClass ) 
    true
   ( Self .IsStereotype st_ObjStub ) 
    true
   ( Self .IsService ) 
    true
   ( Self .IsServiceImplementation ) 
    true
   ( Self .IsScriptKeyword ) 
    true
   ( Self .IsTestCase ) 
    true
   ( Self .IsGuiControl ) 
    true
   ( Self .IsVCMForm ) 
    true
   ( Self .IsStereotype st_VCMFinalForm ) 
    true
   ( Self .IsVCMContainer ) 
    true
   ( Self .IsStereotype st_VCMFinalContainer ) 
    true
   DEFAULT
    false 
  ; // RULES
 )  
 >>> Result
; // IsSimpleClass

...

BOOLEAN elem_func IsInterface
 Cached:
 (
  RULES
   ( Self .IsStereotype st_ObjStub ) 
    false
   ( Self .IsStereotype st_Facet )
    true
   ( Self .IsStereotype st_Interface )
    true
   ( Self .Name 'object' == )
    true
   ( Self .IsTypedef )
    RULES
     ( Self .IsPointer )
      false
     DEFAULT
      ( Self .MainAncestorPrim call.me )
    ; // RULES  
   DEFAULT
    false 
  ; // RULES 
 )  
 >>> Result
; // IsInterface

...

ModelElement elem_func DefaultAncestor
 Cached:
 (
  RULES
   ( Self .IsMixIn )
    nil
   ( Self .IsVCMFormSetFactory )
    GarantModel::TvcmFormSetFactory
   ( Self .IsVCMFormsPack )
    GarantModel::TvcmModule 
   ( Self .IsVCMContainer )
    GarantModel::TvcmContainerForm
   ( Self .IsVCMMainForm )
    GarantModel::TvcmMainForm
   ( Self .IsVCMDataModule )
    GarantModel::TDataModule
   ( Self .IsVCMCustomForm )
    GarantModel::TvcmEntityForm
   ( Self .Abstraction at_abstract == )
    nil
   ( Self .IsViewAreaController )
    GarantModel::IvcmViewAreaController
   ( Self .IsUseCaseController )
    GarantModel::IvcmUseCaseController
   DEFAULT
    nil
  ; // RULES
 ) 
 >>> Result
; // DefaultAncestor

...

ModelElement elem_func MainAncestor
 Cached:
 (
  RULES
   ( Self .IsPointer )
    ( Self .MainAncestorPrim )
   ( Self .IsTypedef )
    ( Self .MainAncestorPrim )
   ( Self .IsPureMixIn )
    ( Self .MainAncestorPrim )
   ( Self .IsInterface )
    (
     RULES
      (
       ( g_DefaultInterfaceAncestor IsNil ! )
       AND ( g_DefaultInterfaceAncestor Self != )
       AND ( Self .MainAncestorPrim IsNil )
      )
       g_DefaultInterfaceAncestor
      DEFAULT
       ( Self .MainAncestorPrim )
     ; // RULES 
    ) 
   DEFAULT
    ( Self .MainAncestorPrim )
  ; // RULES
   
  >>> Result
  
  RULES
   ( Result IsNil )
    ( Self .DefaultAncestor )
   DEFAULT
    Result 
  ; // RULES
 )
 >>> Result
; // MainAncestor

...

BOOLEAN elem_func IsRecord
 RULES
  ( Self .IsStereotype st_Struct )
   true
  ( Self .IsTypedef )
   RULES
    ( Self .IsPointer )
     false
    DEFAULT
     ( Self .MainAncestor call.me )
   ; // RULES  
  DEFAULT
   false 
 ; // RULES 
 >>> Result
; // IsRecord

...

BOOLEAN elem_func IsRecordOrUnion
 RULES
  ( Self .IsRecord )
   true
  ( Self .IsUnion )
   true
  DEFAULT
   false
 ; // RULES
 >>> Result
; // IsRecordOrUnion


Позже я напишу про это подробнее.

А также про "разорванные присваивания" и кеширование результатов выполнения.

вторник, 5 апреля 2016 г.

#1209. Идиотство. Узнаём - запущен ли процесс. "На батниках"

Узнаём - запущен ли процесс. "На батниках".

del hasgen.tmp
tasklist /FI "IMAGENAME eq callMSS.exe" /FO TABLE /NH >> hasgen.tmp
for /f %%i in (hasgen.tmp) do if /I %%i==callMSS.exe goto got

echo No gen running

goto exit

:got

echo Has gen running

:exit
del hasgen.tmp

Ну и как "должно быть":

https://msdn.microsoft.com/ru-ru/library/windows/desktop/ms682623(v=vs.85).aspx
 

#include <windows.h>
#include <stdio.h>
#include <tchar.h>
#include <psapi.h>

// To ensure correct resolution of symbols, add Psapi.lib to TARGETLIBS
// and compile with -DPSAPI_VERSION=1

void PrintProcessNameAndID( DWORD processID )
{
    TCHAR szProcessName[MAX_PATH] = TEXT("<unknown>");

    // Get a handle to the process.

    HANDLE hProcess = OpenProcess( PROCESS_QUERY_INFORMATION |
                                   PROCESS_VM_READ,
                                   FALSE, processID );

    // Get the process name.

    if (NULL != hProcess )
    {
        HMODULE hMod;
        DWORD cbNeeded;

        if ( EnumProcessModules( hProcess, &hMod, sizeof(hMod), 
             &cbNeeded) )
        {
            GetModuleBaseName( hProcess, hMod, szProcessName, 
                               sizeof(szProcessName)/sizeof(TCHAR) );
        }
    }

    // Print the process name and identifier.

    _tprintf( TEXT("%s  (PID: %u)\n"), szProcessName, processID );

    // Release the handle to the process.

    CloseHandle( hProcess );
}

int main( void )
{
    // Get the list of process identifiers.

    DWORD aProcesses[1024], cbNeeded, cProcesses;
    unsigned int i;

    if ( !EnumProcesses( aProcesses, sizeof(aProcesses), &cbNeeded ) )
    {
        return 1;
    }


    // Calculate how many process identifiers were returned.

    cProcesses = cbNeeded / sizeof(DWORD);

    // Print the name and process identifier for each process.

    for ( i = 0; i < cProcesses; i++ )
    {
        if( aProcesses[i] != 0 )
        {
            PrintProcessNameAndID( aProcesses[i] );
        }
    }

    return 0;
}