#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