#1178. Пример реальной генерации кода по модели. Только код

UNIT Generation.ms.dict

USES
 axiom_push.ms.dict
;

USES
 core.ms.dict
;

USES
 WordsRTTI.ms.dict
;

USES 
 ElementsRTTI.ms.dict
;

USES
 CompileTimeVar.ms.dict
;

USES
 SaveVarAndDo.ms.dict
;

CONST cPathSep '\'

FILE CompileTime-VAR g_OutFile nil
%REMARK 'Текущий файл'

INTEGER CompileTime-VAR g_Indent 0
%REMARK 'Текущий отступ'

CONST cIndentChar ' '

STRING FUNCTION IndentStr
 g_Indent cIndentChar char:Dupe >>> Result
; // IndentStr

OBJECT STRING INTEGER ARRAY BOOLEAN TYPE OUTABLE

STRING FUNCTION ValueToString
  OUTABLE IN aValue

 if ( aValue IsArray ) then
 begin
  [ aValue .for> call.me ] strings:Cat >>> Result
 end 
 else
 if ( aValue .IsWord ) then
 begin
  aValue |N >>> Result
 end
 else
 begin
  aValue ToPrintable >>> Result
 end 
; // ValueToString

CONST \n #13#10

BOOLEAN CompileTime-VAR g_EnableAutoEOL true
BOOLEAN CompileTime-VAR g_NeedOutLn false

PROCEDURE OutLnToFile
 \n g_OutFile File:WriteStr
; // OutLnToFile

BOOLEAN FUNCTION .Out?

  OUTABLE IN aValue
  
 : .OutToFile
  if g_NeedOutLn then
  begin
   false >>> g_NeedOutLn
   OutLnToFile
  end // g_NeedOutLn
  g_OutFile File:WriteStr  
 ; // .OutToFile 
  
 VAR l_WasOut
 VAR l_NeedIndent

 PROCEDURE .OutValue
   OUTABLE IN aValue
  if ( aValue IsArray ) then
  begin
   aValue .for> call.me
  end // aValue IsArray
  else
  begin
   STRING VAR l_Value 
   aValue ToPrintable >>> l_Value
   if ( l_WasOut ! ) then
   begin
    true >>> l_WasOut
    IndentStr .OutToFile
    false >>> l_NeedIndent
   end // l_WasOut !
   
   if ( l_NeedIndent ) then
   begin
    false >>> l_NeedIndent
    IndentStr .OutToFile
   end // l_NeedIndent

   if ( l_Value \n == ) then
   begin
    l_Value .OutToFile
    true >>> l_NeedIndent
   end // ( l_Value \n == )
   else
   begin
    l_Value .OutToFile
   end // ( l_Value \n == )
  end // aValue IsArray
 ; // .OutValue
 
 false >>> l_WasOut
 false >>> l_NeedIndent
 aValue .OutValue
 
 if l_WasOut then
  if g_EnableAutoEOL then
   OutLnToFile
  
 l_WasOut >>> Result
; // .Out?

: .Out
 .Out? DROP
; // .Out

PROCEDURE Indented:
  ^ IN aLambda
  
 TF g_Indent (
  INC g_Indent
  aLambda DO
 ) 
; // Indented:

PROCEDURE Bracketed
  ^ IN aLambda
  
 '{' .Out
 Indented: ( aLambda DO ) 
 '}' .Out
; // Bracketed

USES
 axiom:SysUtils
;

USES
 arrays.ms.dict
;

TtfwWord FUNCTION .FindMemberRecur
  STRING IN aName
  TtfwWord IN aGen

 TtfwKeyWord VAR l_Member
 aName aGen pop:Word:FindMember >>> l_Member

 if ( l_Member IsNil ) then
  ( nil >>> Result )
 else
  ( l_Member pop:KeyWord:Word >>> Result )

 if ( Result IsNil ) then
  ( 
   aGen .Inherited.Words .for> ( 
    IN anItem 
    VAR l_Found 
    aName anItem call.me >>> l_Found
    ( Result IsNil ) 
    OR ( l_Found IsNil ) 
    OR ( Result = l_Found ) 
     ?ASSURE [ 'Multiply inheritance. Word: ' aName ' generator ' aGen pop:Word:Name ' parent generator ' anItem pop:Word:Name ]
    l_Found >>> Result
   ) 
  )

; // .FindMemberRecur

ARRAY CompileTime-VAR g_GeneratedFiles []
%REMARK 'Ранее сгенерированные файлы'

TtfwWord VAR g_CurrentGenerator
%REMARK 'Текущий генератор'

: WithGen:
  ^ IN aGen
  ^ IN aLambda
 TF g_CurrentGenerator (
  aGen >>> g_CurrentGenerator
  aLambda DO
 ) // TF g_CurrentGenerator
; // WithGen:

WordAlias Cached: CacheMethod
WordAlias GenCached: CacheMethod

: .?
  ^ IN aWord

 VAR l_Word

 aWord |N g_CurrentGenerator .FindMemberRecur >>> l_Word

 if ( l_Word IsNil ) then
  ( aWord DO )
 else
  ( l_Word DO )
; // .?

STRING FUNCTION Ext
 '.dump' >>> Result
; // Ext

PROCEDURE CopyChangedFile
  STRING IN aTo
  STRING IN aFrom
 if (
     ( aTo sysutils:FileExists ! )
     OR ( '' aTo aFrom CompareFiles ! ) 
    ) then
 begin
  $20 aTo aFrom CopyFile
 end 
; // CopyChangedFile

STRING elem_func FinalFileNamePrim
 '' >>> Result 
; // FinalFileNamePrim

STRING elem_func FinalFileName
 Self .? .FinalFileNamePrim >>> Result
 if ( Result IsNil ! ) then
 begin
  if ( '\' Result StartsStr ) then
  begin
   Result '\' '' string:ReplaceFirst >>> Result
  end // '\' Result StartsStr
  [ 'w:' 
  // - это потому, что в пути нету диска, а для ExtractFileName он нужен
  Result ] cPathSep strings:CatSep >>> Result
 end // ( Result IsNil ! )
; // FinalFileName

STRING CompileTime-VAR g_TempFileName ''
STRING CompileTime-VAR g_RealFileName ''
STRING CompileTime-VAR g_FinalFileName ''
BOOLEAN CompileTime-VAR g_UCRead false

CONST cGenScriptsFolder 'W:\common\GenScripts\'

BOOLEAN elem_func CanCopyToFinalFile
 false >>> Result
; // CanCopyToFinalFile

elem_proc GenerateWordToFileWith:
 ^ IN aLambda
 
 TF g_Indent (
  0 >>> g_Indent
  STRING VAR l_FileName 
  [ Self pop:Word:Name .? Ext ] strings:Cat >>> l_FileName
 
  STRING VAR l_TempPath
  'C:\Temp\GenScripts\' >>> l_TempPath
  l_TempPath sysutils:ForceDirectories ?ASSURE [ 'Не удалось создать директорию ' l_TempPath ]
  
  STRING VAR l_RealPath
  cGenScriptsFolder >>> l_RealPath
  l_RealPath sysutils:ForceDirectories ?ASSURE [ 'Не удалось создать директорию ' l_RealPath ]
  
  TF g_TempFileName (
   [ l_TempPath l_FileName ] cPathSep strings:CatSep >>> g_TempFileName
   
   TF g_RealFileName (
    [ l_RealPath l_FileName ] cPathSep strings:CatSep >>> g_RealFileName
    
    if ( g_GeneratedFiles g_TempFileName array:HasText ! ) then
    begin
     g_TempFileName array:AddTo g_GeneratedFiles
     TF g_FinalFileName (
      Self .FinalFileName >>> g_FinalFileName
      TF g_OutFile (
       g_TempFileName File:OpenWrite >>> g_OutFile
       TF g_UCRead (
        TF g_NeedOutLn (
         Self aLambda DO
        ) // TF g_NeedOutLn
       ) // TF g_UCRead
      ) // TF g_OutFile
      g_RealFileName g_TempFileName CopyChangedFile
      if ( g_FinalFileName IsNil ! ) then
      begin
       if ( Self .? .CanCopyToFinalFile ) then
       begin
        g_FinalFileName g_TempFileName CopyChangedFile
       end // ( Self .? .CanCopyToFinalFile )
      end // ( g_FinalFileName IsNil ! )
     ) // TF g_FinalFileName
    end // g_GeneratedFiles g_TempFileName array:HasText !
   ) // TF g_RealFileName
  ) // TF g_TempFileName
 ) // TF g_Indent 
; // GenerateWordToFileWith:

elem_proc DeleteWordFile
 
  STRING VAR l_FileName 
  [ Self pop:Word:Name .? Ext ] strings:Cat >>> l_FileName
  
  STRING VAR l_RealPath
  cGenScriptsFolder >>> l_RealPath
  
  TF g_RealFileName (
   [ l_RealPath l_FileName ] cPathSep strings:CatSep >>> g_RealFileName
   
   if ( g_RealFileName sysutils:FileExists ) then
   begin
    g_RealFileName DeleteFile DROP
   end // ( g_RealFileName sysutils:FileExists )
  ) // TF g_RealFileName 
; // DeleteWordFile

BOOLEAN elem_func IsScriptKeyword
 Self .IsStereotype st_ScriptKeyword >>> Result
; // IsScriptKeyword

BOOLEAN elem_func IsSimpleClass
 Cached:
 (
  RULES
   ( Self .IsStereotype st_UseCaseControllerImp )
    ( Self .Abstraction at_abstract != )
   ( Self .IsStereotype st_ViewAreaControllerImp )
    ( Self .Abstraction at_abstract != )
   ( Self .IsStereotype st_SimpleClass ) 
    true
   ( Self .IsStereotype st_ObjStub ) 
    true
   ( Self .IsStereotype st_Service ) 
    true
   ( Self .IsStereotype st_ServiceImplementation ) 
    true
   ( Self .IsScriptKeyword ) 
    true
   ( Self .IsStereotype st_TestCase ) 
    true
   ( Self .IsStereotype st_GuiControl ) 
    true
   ( Self .IsStereotype st_VCMForm ) 
    true
   ( Self .IsStereotype st_VCMFinalForm ) 
    true
   ( Self .IsStereotype st_VCMContainer ) 
    true
   ( Self .IsStereotype st_VCMFinalContainer ) 
    true
   DEFAULT
    false 
  ; // RULES
 )  
 >>> Result
; // IsSimpleClass
 
BOOLEAN elem_func IsUtilityPack
 Cached:
 (
  RULES
   ( Self .IsStereotype st_UtilityPack )
    true
   ( Self .IsStereotype st_ScriptKeywordsPack ) 
    true
   DEFAULT
    false
  ; // RULES 
 ) 
 >>> Result
; // IsUtilityPack

BOOLEAN elem_func IsInterfaces
 Cached:
 (
  RULES
   ( Self .IsStereotype st_Interfaces ) 
    true
   ( Self .IsStereotype st_InternalInterfaces )
    true
   DEFAULT
    false
  ; // RULES 
 )
 >>> Result
; // IsInterfaces

BOOLEAN elem_func IsMixIn
 Cached:
 (
  RULES
   ( Self .IsStereotype st_Impurity )
    true
   ( Self .IsStereotype st_TestCaseMixIn )
    true
   ( Self .IsStereotype st_UseCaseControllerImp )
    ( Self .Abstraction at_abstract == )
   ( Self .IsStereotype st_ViewAreaControllerImp )
    ( Self .Abstraction at_abstract == )
   DEFAULT
    false 
  ; // RULES 
 )
 >>> Result
; // IsMixIn

BOOLEAN elem_func IsPureMixIn
 Self .IsStereotype st_PureMixIn >>> Result
; // IsPureMixIn

BOOLEAN elem_func IsTypedef
 Self .IsStereotype st_Typedef >>> Result
; // IsTypedef

BOOLEAN elem_func IsRange
 Self .IsStereotype st_Range >>> Result
; // IsRange

BOOLEAN elem_func IsEnum
 Self .IsStereotype st_Enum >>> Result
; // IsEnum

BOOLEAN elem_func IsFunction
 Self .IsStereotype st_Function >>> Result
; // IsFunction

BOOLEAN elem_func IsRecord
 Self .IsStereotype st_Struct >>> Result
; // IsRecord

BOOLEAN elem_func IsDefine
 Self .IsStereotype st_Define >>> Result
; // IsDefine

BOOLEAN elem_func IsUndef
 Self .IsStereotype st_Undef >>> Result
; // IsUndef

BOOLEAN elem_func IsUnion
 Self .IsStereotype st_Union >>> Result
; // IsUnion

BOOLEAN elem_func IsStaticObject
 Self .IsStereotype st_StaticObject >>> Result
; // IsStaticObject

BOOLEAN elem_func IsArray
 Self .IsStereotype st_Vector >>> Result
; // IsArray

BOOLEAN elem_func IsOpenArray
 Self .IsArray
 AND ( Self .GetUP "array type" 'open' == )
 >>> Result
; // IsOpenArray

BOOLEAN elem_func IsElementProxy
 Self .IsStereotype st_ElementProxy >>> Result
; // IsElementProxy

BOOLEAN elem_func IsSetOf
 Self .IsStereotype st_SetOf >>> Result
; // IsSetOf

BOOLEAN elem_func IsException
 Self .IsStereotype st_Exception >>> Result
; // IsException

BOOLEAN elem_func IsTagTable
 Self .IsStereotype st_TagTable >>> Result
; // IsTagTable

BOOLEAN elem_func IsExe
 RULES
  ( Self .IsStereotype st_ExeTarget )
   true
  ( Self .IsStereotype st_TestTarget )
   true 
  DEFAULT
   false
 ; // RULES 
 >>> Result
; // IsExe

BOOLEAN elem_func IsDLL
 Self .IsStereotype st_AdapterTarget >>> Result
; // IsDLL

BOOLEAN elem_func IsTarget
 Cached:
 (
  RULES
   ( Self .IsExe ) 
    true
   ( Self .IsDLL ) 
    true
   DEFAULT
    false
  ; // RULES
 )
 >>> Result
; // IsTarget

BOOLEAN elem_func IsEvdSchemaElement
 Self .IsStereotype st_Atom >>> Result
; // IsEvdSchemaElement

BOOLEAN elem_func IsClassOrMixIn
 Cached:
 (
  RULES
   ( Self .IsSimpleClass )
    true
   ( Self .IsMixIn )
    true
   DEFAULT
    false
  ; // RULES
 )
 >>> Result
; // IsClassOrMixIn

BOOLEAN FUNCTION NeedOwnFile
 ModelElement IN Self
 Cached:
 (
  RULES
   ( Self .IsStereotype st_ScriptKeywords ) 
    false 
    
   ( Self .IsStereotype st_UserType ) 
    true
    
   ( Self .IsStereotype st_TestClass ) 
    true
    
   ( Self .IsEvdSchemaElement ) 
    true
    
   ( Self .IsTarget ) 
    true
    
   ( Self .IsStereotype st_TestResults ) 
    true
    
   ( Self .IsTagTable ) 
    true
    
   ( Self .IsInterfaces )
    true
   
   ( Self .IsUtilityPack )
    true
   
   ( Self .IsMixIn )
    true
   
   ( Self .IsElementProxy )
    true
   
   ( Self .IsSimpleClass )
   begin
    RULES
     ( Self .Visibility = ProtectedAccess )
      false
     ( Self .Visibility = PrivateAccess )
      false
     DEFAULT
      ( 
       ModelElement VAR l_Parent
       Self .Parent >>> l_Parent
       if (
           ( l_Parent .IsClassOrMixIn ) 
           OR ( l_Parent .IsUtilityPack )
           OR ( l_Parent .IsInterfaces )
          ) then
       begin
        false
       end 
       else
       begin
        true
       end 
      )
    ; // RULES
   end
   
   DEFAULT
    false
  ; // RULES
 )
 >>> Result
; // NeedOwnFile

PROCEDURE .CurrentGenerator
 ModelElement IN Self
 Self g_CurrentGenerator DO
; // .CurrentGenerator

USES
 CallInherited.ms.dict
;

USES
 classRelations.ms.dict
;

BOOLEAN elem_func NeedOwnFile
 Self .? NeedOwnFile >>> Result
; // NeedOwnFile

PROCEDURE OutLn
 if g_NeedOutLn then
  OutLnToFile
 true >>> g_NeedOutLn
; // OutLn

elem: WithDelim
  STRING IN aDelim
  TtfwWord IN aVar
  TtfwWord IN aLambda
 [ 
  if ( aVar DO ! ) then
  begin
   true aVar pop:Word:SetValue
  end
  else
  begin
   aDelim
  end
  Self 
 ] aLambda DO
; // WithDelim

elem: WithComma:
  ^ IN aVar
  ^ IN aLambda
 Self ', ' aVar aLambda .WithDelim
; // WithComma:

STRING FUNCTION .CutT
  STRING IN aName
 aName >>> Result
 if ( 'T' Result StartsStr ) then
 begin
  Result 'T' '' string:ReplaceFirst >>> Result
 end // 'T' Result StartsStr
; // .CutT

STRING elem_func UnitNamePrim
 GenCached:
 (
  STRING VAR l_Path
  Self .FinalFileName >>> l_Path
  RULES
   ( l_Path <> '' )
    ( l_Path sysutils:ExtractFileName '' sysutils:ChangeFileExt )
   ( Self IsNil )
     ''
   ( Self .IsElementProxy )
    ( Self .Name '_Proxy' Cat )
   ( Self .IsTagTable )
    ( Self .Name '_Schema' Cat )
   ( Self .IsScriptKeyword )
    ( Self .Name .CutT )
   ( Self .IsSimpleClass )
    ( Self .Name .CutT )
   DEFAULT
    ( Self .Name )
  ; // RULES
 )
 >>> Result
; // UnitNamePrim

STRING elem_func UnitName
 GenCached:
 (
  Self .UnitNamePrim 'NOT_FINISHED_' '' string:ReplaceFirst
 )
 >>> Result
; // UnitName

ModelElement elem_func UnitProducer
 GenCached:
 (
  RULES
   ( Self IsNil )
    nil
   ( Self IsString )
    Self
   ( Self .NeedOwnFile )
    Self
   DEFAULT 
    ( Self .Parent call.me )
  ; // RULES
 )
 >>> Result
; // UnitProducer

STRING elem_func EffectiveUnitName
 GenCached:
 (
  Self .UnitProducer .UnitName
 )
 >>> Result
; // EffectiveUnitName

ARRAY FUNCTION .filterNil>
  ARRAY IN anArray
 anArray
 .filter> ( IsNil ! ) 
 >>> Result
; // .filterNil>

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

BOOLEAN elem_func IsMethod
 Self .IsStereotype st_method >>> Result
; // IsMethod

: .FirstElement
  ARRAY IN anArray
 ModelElement VAR l_Found
 nil >>> l_Found
 anArray .trunc> ( DROP l_Found IsNil ) .for> ( >>> l_Found )
 l_Found
; // .FirstElement

: .SecondElement
  ARRAY IN anArray
 ModelElement VAR l_Found
 nil >>> l_Found
 INTEGER VAR l_Index
 0 >>> l_Index
 anArray .trunc> ( DROP l_Index < 2 ) .for> (
   IN anItem
  ( l_Index 1 == ) ? 
   ( anItem >>> l_Found ) 
  INC l_Index 
 ) // anArray .trunc> ( DROP l_Index < 2 ) .for>
 l_Found
; // .SecondElement

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

STRING elem_func UIDforUserCode
 RULES
  ( Self .IsMethod )
   ( Self .UID )
//   ( Self .FirstOperation .UID )
  DEFAULT
   ( Self .UID )
 ; // RULES
 >>> Result
; // UIDforUserCode

ARRAY elem_func MethodParameters
 RULES
  ( Self .IsMethod )
   ( Self .FirstOperation .Parameters )
  ( Self .IsFunction )
   ( Self .FirstOperation .Parameters )
  DEFAULT 
   ( Self .Parameters )
 ; // RULES
 >>> Result
; // MethodParameters

: .With()
  OUTABLE IN aValue
 RULES 
  ( aValue IsNil )
   ()
  ( aValue IsArray )
   (
    [
     VAR l_WasBracket
     false >>> l_WasBracket
     aValue .for> (
       IN anItem
      if ( l_WasBracket ! ) then
      begin
       '('
       true >>> l_WasBracket
      end
      anItem
     ) // aValue .for>
     if l_WasBracket then
     begin
      ')'
     end 
    ]
   ) // ( aValue IsArray )
  DEFAULT 
   [ '(' aValue ')' ]
 ; // RULES
; // .With()

ARRAY elem_func ParametersList
 [
  VAR l_WasComma
  false >>> l_WasComma
  Self .MethodParameters .map> .Name .for> ( 
   .WithComma: l_WasComma NOP
  )
 ] .With() >>> Result
; // ParametersList

CONST cUCStart '//#UC START# *'
CONST cUCEnd '//#UC END# *'

elem_proc OutUserCode:
  STRING IN aKey
  ^ IN aOutExisting
  ^ IN aOutNew
  
 BOOLEAN VAR l_Found
 false >>> l_Found
 
 if ( g_UCRead ! ) then
 begin
  true >>> g_UCRead
  if ( g_FinalFileName sysutils:FileExists ) then
  begin
   STRING VAR l_TempFileName
   g_TempFileName '.uc.txt' Cat >>> l_TempFileName 
   STRING VAR l_RealFileName
   g_RealFileName '.uc.txt' Cat >>> l_RealFileName
   
   FILE VAR l_Out
   l_TempFileName File:OpenWrite >>> l_Out
   TRY
    FILE VAR l_In
    g_FinalFileName 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 [ 'Секция кода уже открыта. Файл: ' g_FinalFileName ' строка:' aStr ]
         true >>> l_UCOpened
         aStr string:Trim >>> aStr
         [] >>> l_Accumulated
         
         aStr >>> l_Key
         '*' string:SplitTo! l_Key DROP
         
         //l_Key l_Out File:WriteWStrLn 
         aStr l_Out File:WriteWStrLn 
        )
       ( aStr cUCEnd Has )
        ( 
         l_UCOpened ?ASSURE [ 'Секция кода не открыта. Файл: ' g_FinalFileName ' строка:' aStr  ]
         false >>> l_UCOpened
         
         VAR l_Head
         if ( l_Pos > 0 ) then
         begin
          l_Pos 0 aStr string:Substring >>> l_Head
          l_Head string:TrimLeft >>> l_Head
          if ( l_Head IsNil ! ) then
          begin
           l_Head array:AddTo l_Accumulated
           l_Head l_Out File:WriteWStrLn
           
           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
         
         nil >>> l_Accumulated
         aStr l_Out File:WriteWStrLn 
        )
       DEFAULT
        (
         l_UCOpened ? ( 
          aStr array:AddTo l_Accumulated
          aStr l_Out File:WriteWStrLn 
         ) // l_UCOpened ?
        ) 
      ; // RULES  
     ) // l_In File:ReadLines
    FINALLY
     nil >>> l_Out
    END // TRY..FINALLY
   FINALLY
    nil >>> l_Out
   END // TRY..FINALLY
   l_RealFileName l_TempFileName CopyChangedFile
   
   if ( l_RealFileName FileSize 0 == ) then
   begin
    l_RealFileName DeleteFile DROP
   end // ( l_RealFileName FileSize 0 == )
   
  end // ( g_FinalFileName sysutils:FileExists )
 end //( g_UCRead ! ) 
 
 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 ! ?
; // OutUserCode:

elem_proc DefaultUserCodePrim:
  STRING IN aKey
  ^ IN aOutNew
  
 Self .UIDforUserCode aKey Cat >>> aKey
 
 aKey '*' Cat >>> aKey
 
 Self aKey .OutUserCode: (
   IN aKey
   IN aValue
  [ cUCStart aKey ] .Out
  aValue .for> ( g_OutFile File:WriteWStrLn )
  [ cUCEnd aKey ] .Out
 ) (
  aOutNew DO
 ) // Self aKey .OutUserCode:
; // DefaultUserCodePrim:

elem_proc DefaultUserCode
  STRING IN aKey
  TtfwWord IN aCode
 Self aKey .DefaultUserCodePrim: (
   IN aKey
  [ cUCStart aKey ] .Out
  [ aCode DO ] .Out
  [ cUCEnd aKey ] .Out
 ) // Self aKey .OutUserCode:
; // DefaultUserCode

elem_proc PredefinedUserCode:
  STRING IN aKey
  ^ IN aOutLambda
  ^ IN aCode
 Self aKey .DefaultUserCodePrim: (
   IN aKey
  [ aCode DO ] aOutLambda DO
 ) // Self aKey .OutUserCode:
; // PredefinedUserCode:

CONST cImplementationUserCodeSuffix '_impl'
CONST cVarUserCodeSuffix '_var'
CONST cUserCodePrefix 'uc:'
CONST cEmptyUserCode #1

STRING FUNCTION cImplementationUserCodeName
 cUserCodePrefix cImplementationUserCodeSuffix Cat >>> Result
; // cImplementationUserCodeName

STRING FUNCTION cVarUserCodeName
 cUserCodePrefix cVarUserCodeSuffix Cat >>> Result
; // cVarUserCodeName

elem_proc PredefinedMethodUserCode:
  STRING IN aSuffix
  STRING IN aKey
  TtfwWord IN aCode
  ^ IN aVarCode
  ^ IN aImplCode
 RULES
  ( aSuffix cVarUserCodeSuffix == )
   ( Self aKey .PredefinedUserCode: .Out ( aVarCode DO ) )
  ( aSuffix cImplementationUserCodeSuffix == )
   ( Self aKey .PredefinedUserCode: ( IN aValue Indented: ( aValue .Out ) ) ( aImplCode DO ) )
  DEFAULT 
   ( Self aKey aCode .DefaultUserCode )
 ; // RULES
; // PredefinedMethodUserCode:

elem_proc PredefinedMethodUserCodeWithoutVar:
  STRING IN aSuffix
  STRING IN aKey
  TtfwWord IN aCode
  ^ IN aImplCode
 Self aSuffix aKey aCode .PredefinedMethodUserCode: () ( aImplCode DO ) 
; // PredefinedMethodUserCodeWithoutVar:
  
ModelElement elem_func ImplementorOrParent
 Cached:
 (
  Self .Implementor >>> Result
  
  if ( Result IsNil ) then
  begin
   Self .Parent >>> Result
  end // ( Result IsNil )
  Result
 )
 >>> Result
; // ImplementorOrParent

BOOLEAN elem_func IsWriteonlyProperty
 Self .IsStereotype st_writeonly::Attribute >>> Result
; // IsWriteonlyProperty

CONST opModifyNone 1
CONST opModifySetter 2

INTEGER elem_func OpModify
 Self 'OpModify' opModifyNone .ElemMember >>> Result
; // OpModify

BOOLEAN elem_func IsSetter
 RULES
  ( Self .IsWriteonlyProperty ) 
   true
  ( Self .OpModify opModifySetter == )
   true 
  DEFAULT
   false
 ; // RULES
 >>> Result
; // IsSetter

BOOLEAN elem_func IsReadonlyProperty
 Self .IsStereotype st_readonly::Attribute >>> Result
; // IsReadonlyProperty

BOOLEAN elem_func IsProperty
 Cached:
 (
  RULES
   ( Self .IsStereotype st_property::Attribute )
    true
   ( Self .IsReadonlyProperty )
    true
   ( Self .IsWriteonlyProperty )
    true
   DEFAULT
    false 
  ; // RULES
 )
 >>> Result
; // IsProperty

STRING elem_func TypeName
 Cached:
 (
  STRING VAR l_ExtName
  Self .GetUP 'extprop:pas:TypeName' >>> l_ExtName
  RULES
   ( l_ExtName <> '' )
    l_ExtName
   DEFAULT
    ( Self .Name )
  ; // RULES
 )
 >>> Result
; // TypeName

ARRAY FUNCTION .joinWithLambded>
  ARRAY IN anArrayToJoin
  ^ IN anArrayToIterate
  ^ IN aLambda
  
 anArrayToJoin 
 anArrayToIterate DO .for> ( IN aChild .join> ( aChild aLambda DO ) )
 >>> Result
; // .joinWithLambded>

USES
 axiom:CompiledProcedure
 axiom:KeyValues
;

INTERFACE FUNCTION MakeParam
  STRING IN aName
  ModelElement IN aType
 VAR l_Param
 
 KeyValues:Create >>> l_Param
 
 l_Param pop:Word:Box >>> Result
 
 l_Param -> Name := aName
 if ( aType IsNil ! ) then
 begin
  l_Param -> Target := aType
 end // ( aType IsNil ! )
 
 l_Param pop:Word:DecRef 
; // MakeParam

WordAlias MakeFunction MakeParam
WordAlias MakeField MakeParam

USES
 axiom:WordBox
;

INTERFACE elem_func InterfaceLinkField
 Cached:
 (
  VAR l_TypeName
  Self .TypeName >>> l_TypeName
  'f_' l_TypeName Cat Self MakeField
  DUP
  VAR l_Boxed
  pop:WordBox:Boxed >>> l_Boxed
  l_Boxed -> %SUM := ( 'Ссылка на интерфейс ' l_TypeName Cat )
  l_Boxed -> Visibility := PrivateAccess
 )
 >>> Result
; // InterfaceLinkField

elem_iterator Fields
 Self .Attributes
 .filter> ( .IsProperty ! )
 .filter> ( .IsStereotype st_impurity_value::Attribute ! )
 .filter> ( .IsStereotype st_impurity_param::Attribute ! )
 .filter> ( .IsStereotype st_static::Attribute ! )
 
 if ( Self .IsStaticObject ) then
 begin
  if ( Self .UPisTrue "IsAutoHelper" ) then
  begin
   .joinWithLambded> ( Self .Implements ) ( IN anItem [ anItem .InterfaceLinkField ] )
  end // ( Self .UPisTrue "IsAutoHelper" )
 end // ( Self .IsStaticObject )

 >>> Result
; // Fields

INTERFACE elem_func InstanceField
 Cached:
 (
  VAR l_TypeName
  Self .TypeName >>> l_TypeName
  'g_' l_TypeName Cat Self MakeFunction
  DUP
  VAR l_Boxed
  pop:WordBox:Boxed >>> l_Boxed
  l_Boxed -> %SUM := ( 'Экземпляр синглетона ' l_TypeName Cat )
  l_Boxed -> Visibility := PrivateAccess
  l_Boxed -> 'extprop:pas:Value' := 'nil'
 )
 >>> Result
; // InstanceField

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

ModelElement elem_func MainAncestor
 Cached:
 (
  Self .Inherits .FirstElement
 )
 >>> Result
; // MainAncestor

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 .UPisTrue "isPointer" )
      false
     DEFAULT
      ( Self .MainAncestor call.me )
    ; // RULES  
   DEFAULT
    false 
  ; // RULES 
 )  
 >>> Result
; // IsInterface

BOOLEAN elem_func IsString
 Cached:
 (
  RULES
   ( Self .Name 'a-string' == )
    true
   ( Self .Name 'a-wstring' == )
    true
   ( Self .IsTypedef )
    RULES
     ( Self .UPisTrue "isPointer" )
      false
     DEFAULT
      ( Self .MainAncestor call.me )
    ; // RULES  
   DEFAULT
    false
  ; // RULES
 )
 >>> Result
; // IsString

BOOLEAN elem_func IsUntyped
 Self .Name 'void' == >>> Result
; // IsUntyped
  
BOOLEAN elem_func IsManaged
 Cached:
 (
  RULES
   ( Self .IsRecord )
    true
   ( Self .IsUnion )
    true
   ( Self .IsArray )
    true
   ( Self .IsInterface )
    true
   ( Self .IsTypedef )
    RULES
     ( Self .UPisTrue "isPointer" )
      false
     DEFAULT
      ( Self .MainAncestor call.me )
    ; // RULES  
   ( Self .IsStereotype st_ImpurityParamType )
    true
   ( Self .IsString )
    true
   ( Self .IsUntyped )
    true
   DEFAULT
    false
  ; // RULES
 )
 >>> Result
; // IsManaged

USES
 string.ms.dict
;

STRING FUNCTION RemoveDuplicatedIfDef
  STRING IN aValue
 '' >>> Result 
 ARRAY VAR l_Outed
 [] >>> l_Outed
 aValue ',' string:Split:for> (
   IN aSubstr
  aSubstr string:Trim >>> aSubstr
  if ( aSubstr IsNil ! ) 
   if ( l_Outed aSubstr array:HasText ! ) then
   begin
    aSubstr array:AddTo l_Outed
    if ( Result IsNil ) then
     ( aSubstr >>> Result )
    else
     ( Result ',' aSubstr Cat Cat >>> Result )
   end // ( l_Outed aSubstr array:HasText ! )
 ) // aValue ',' string:Split:for>
; // RemoveDuplicatedIfDef

STRING elem_func IfDefStr
 Cached:
 (
  Self .GetUP "ifdef" >>> Result
  
  VAR l_Parent
  Self .Parent >>> l_Parent
  if ( l_Parent IsNil ! ) then
  begin
   VAR l_ParentIfDefStr
   l_Parent call.me >>> l_ParentIfDefStr
   if ( l_ParentIfDefStr IsNil ! ) then
   begin
    if ( Result IsNil ) then
    begin
     l_ParentIfDefStr >>> Result
    end // ( Result IsNil )
    else
    begin
     l_ParentIfDefStr ',' Result Cat Cat >>> Result
    end // ( Result IsNil )
   end // ( l_ParentIfDefStr IsNil ! )
  end // ( l_Parent IsNil ! )
  Result RemoveDuplicatedIfDef
 )
 >>> Result 
; // IfDefStr

STRING elem_func IfNDefStr
 Cached:
 (
  Self .GetUP "ifndef" >>> Result
  
  VAR l_Parent
  Self .Parent >>> l_Parent
  if ( l_Parent IsNil ! ) then
  begin
   VAR l_ParentIfDefStr
   l_Parent call.me >>> l_ParentIfDefStr
   if ( l_ParentIfDefStr IsNil ! ) then
   begin
    if ( Result IsNil ) then
    begin
     l_ParentIfDefStr >>> Result
    end // ( Result IsNil )
    else
    begin
     l_ParentIfDefStr ',' Result Cat Cat >>> Result
    end // ( Result IsNil )
   end // ( l_ParentIfDefStr IsNil ! )
  end // ( l_Parent IsNil ! )
  Result RemoveDuplicatedIfDef
 )
 >>> Result 
; // IfNDefStr

STRING CompileTime-VAR g_IfDefStr ''
STRING CompileTime-VAR g_IfNDefStr ''

elem: IfDefPrim:
  ^ IN aOutLambda
  ^ IN aLambda
 
 if ( Self IsString ! ) then
 begin
  TF g_IfDefStr (
   TF g_IfNDefStr (
    VAR l_IfDefStr
    Self .IfDefStr >>> l_IfDefStr
    
    VAR l_IfNDefStr
    Self .IfNDefStr >>> l_IfNDefStr
    
    BOOLEAN VAR l_NeedOut
    false >>> l_NeedOut
    
    : OutIfBody
      STRING IN aPrefix
      STRING IN aSuffix
     VAR l_NeedAND
     false >>> l_NeedAND
     
     : OutItem
       IN anItem
       STRING IN aPrefix
      if ( anItem IsNil ! ) then
      begin
       true >>> l_NeedOut
       ' ' 
       if l_NeedAND then
       begin
        'AND' ' '
       end
       else
       begin
        true >>> l_NeedAND
       end // l_NeedAND
       aPrefix 'Defined(' anItem ')'
      end // ( anItem IsNil ! )
     ; // OutItem
     
     [ 
      aPrefix 
      l_IfDefStr ',' string:Split:for> ( '' OutItem )
      l_IfNDefStr ',' string:Split:for> ( 'NOT ' OutItem )
      aSuffix 
     ] aOutLambda DO
    ; // OutIfBody
    
    if ( ( l_IfDefStr IsNil ! ) OR ( l_IfNDefStr IsNil ! ) ) then
    begin
     if ( ( l_IfDefStr g_IfDefStr != ) OR ( l_IfNDefStr g_IfNDefStr != ) ) then
     begin
      l_IfDefStr >>> g_IfDefStr
      l_IfNDefStr >>> g_IfNDefStr
      
      : IfOut
       '{$If' '}' OutIfBody
      ; // IfOut
      
      if ( g_EnableAutoEOL ! ) then
      begin
       true >>> g_EnableAutoEOL
       IfOut
       false >>> g_EnableAutoEOL
      end // ( g_EnableAutoEOL ! )
      else
       IfOut
     end // ( ( l_IfDefStr g_IfDefStr != ) OR ( l_IfNDefStr g_IfNDefStr != ) )
    end // ( ( l_IfDefStr IsNil ! ) OR ( l_IfNDefStr IsNil ! ) )
    
    aLambda DO 
    
    if l_NeedOut then
    begin
    
     : IfEndOut
      '{$IfEnd} //' '' OutIfBody
     ; // IfEndOut
     
     if g_NeedOutLn then
     begin
      false >>> g_NeedOutLn
      IfEndOut
      OutLnToFile
     end // g_NeedOutLn
     else
      IfEndOut
    end // l_NeedOut
   ) // // TF g_IfNDefStr  
  ) // TF g_IfDefStr 
 end // ( Self IsString ! )
 else
 begin
  aLambda DO
 end // ( Self IsString ! )
; // IfDefPrim:

elem_proc IfDef:
  ^ IN aLambda
 Self .IfDefPrim: .Out ( aLambda DO ) 
; // IfDef:
 
elem_proc MethodUserCode
  STRING IN aKey
  TtfwWord IN aCode
  
 STRING VAR l_Key 
 aKey >>> l_Key
 
 RULES
  ( Self .IsSetter ) then
   ( 'set' l_Key Cat >>> l_Key )
  ( Self .IsProperty ) then
   ( 'get' l_Key Cat >>> l_Key )
 ; // RULES
 
 VAR l_Implementor
 Self .ImplementorOrParent >>> l_Implementor
 
 if ( l_Implementor IsNil ! ) then
 begin
  [ '_' l_Implementor .UID l_Key ] strings:Cat >>> l_Key
 end // ( l_Implementor IsNil ! )
 
 BOOLEAN elem_func IsSingletonExists
  Self .Name 'Exists' ==
  AND ( Self .IsStereotype st_static::Operation )
  AND ( l_Implementor .UPisTrue "singleton" )
  >>> Result
 ; // IsSingletonExists
 
 RULES
  ( Self .IsSingletonExists )
   (
    Self aKey l_Key aCode .PredefinedMethodUserCodeWithoutVar:
    ( 
     'Result := g_' l_Implementor .TypeName ' <> nil;'
    ) 
   ) // ( Self .IsSingletonExists )
  ( 
   Self .Name 'Alien' ==
   AND ( Self .IsSetter ) 
   AND ( l_Implementor .IsStereotype st_Service )
  )
   (
    Self aKey l_Key aCode .PredefinedMethodUserCodeWithoutVar:
    (
     'Assert((f_Alien = nil) OR (aValue = nil));' \n
     'f_Alien := aValue;'
    ) 
   ) // Self .Name 'Alien' ==  
  ( Self .Name 'ClearFields' == )
   (
    Self aKey l_Key aCode .PredefinedMethodUserCodeWithoutVar:
    ( 
     l_Implementor .Fields 
     .filter> ( .LinkType lt_ref == )
     .filter> ( .Target .IsManaged )
     .for> (
       IN aField
      aField .IfDefPrim: \n
      ( 
       VAR l_FieldName
       
       aField .GetUP 'extprop:clearViaProperty' >>> l_FieldName 
       if ( l_FieldName IsNil ) then
       begin
        aField .Name >>> l_FieldName
       end // ( l_FieldName IsNil )
       
       RULES 
        ( aField .Target .IsInterface )
         ( l_FieldName ' := nil' )
        ( aField .Target .IsString )
         ( l_FieldName ' := ''''' )
        ( aField .Target .IsOpenArray )
         ( l_FieldName ' := nil' )
        DEFAULT
         ( 'Finalize(' l_FieldName ')' )
       ; // RULES 
       ';' \n
      ) // aField .IfDef:
     ) // l_Implementor .Fields
     'inherited;'
    ) 
   )
  DEFAULT
   ( Self l_Key aCode .DefaultUserCode )
 ; // RULES 
; // MethodUserCode

BOOLEAN FUNCTION .IsValueValid
  IN aValue
 RULES
  ( aValue IsInt )
   true
  ( aValue IsBool )
   true
  ( aValue IsNil )
   false
  DEFAULT
   true
 ; // RULES
 >>> Result
; // .IsValueValid

BOOLEAN elem_func IsFactory
  RULES
   ( Self .IsStereotype st_factory::Operation )
    true
   ( Self .IsStereotype st_Factory )
    true
   DEFAULT
    false
  ; //RULES   
 >>> Result
; // IsFactory

elem_proc UserCode:
 ^ IN aSuffix
 ^ IN aCode
 
 STRING VAR l_Key
 
 aSuffix DO >>> l_Key
 
 VAR l_Code
 Self cUserCodePrefix l_Key Cat '' .ElemMember >>> l_Code
 
 if ( l_Code .IsValueValid ) then
 begin
  if ( l_Code cEmptyUserCode ?!= ) then
  begin
   l_Code .Out
  end // ( l_Code cEmptyUserCode ?!= )
 end // ( l_Code .IsValueValid )
 else
 begin
  RULES
   ( Self .IsFactory )
    begin
     RULES
      ( l_Key cVarUserCodeSuffix == )
       begin
        'var' .Out
        [ ' l_Inst : ' Self .Parent .TypeName ';' ] .Out
       end // ( l_Key cVarUserCodeSuffix == )
      ( l_Key cImplementationUserCodeSuffix == )
       begin
        Indented: (
         [ 
          'l_Inst := ' 
          
          VAR l_CallTo
          Self .MainAncestor >>> l_CallTo
          if ( l_CallTo IsNil ) then
           'Create' 
          else
          begin
           l_CallTo .Name
          end // ( l_CallTo IsNil )
           
          Self .ParametersList ';' 
         ] .Out
         'try' .Out
         ' Result := l_Inst;' .Out
         'finally' .Out
         ' l_Inst.Free;' .Out
         'end;//try..finally' .Out
        ) // Indented:
       end // ( l_Key cImplementationUserCodeSuffix == )
      DEFAULT
       ( Self l_Key aCode .DefaultUserCode ) 
     ; // RULES
    end // ( Self .IsFactory )
   ( 
    'ResNameGetter' Self .Name EndsStr 
    AND ( l_Key 'impl' == )
    AND ( Self .IsSimpleClass ) 
   )
    ( [ ' {$R ' Self .EffectiveUnitName '.res}' ] .Out )
   ( Self .IsElementProxy )
    ( Self l_Key aCode .DefaultUserCode ) 
   ( Self .IsClassOrMixIn )
    ( Self l_Key aCode .DefaultUserCode ) 
   ( Self .IsRecord )
    ( Self l_Key aCode .DefaultUserCode ) 
   ( Self .IsUtilityPack )
    ( Self l_Key aCode .DefaultUserCode ) 
   DEFAULT
    ( Self l_Key aCode .MethodUserCode )
  ; // RULES 
 end // ( l_Code .IsValueValid ) 
; // UserCode:

elem_proc OutUses:
  STRING IN aUCPrefix
  ^ IN aUsed
  ^ IN aLambda
  
 ARRAY VAR l_Used
 aUsed DO >>> l_Used
  
 ARRAY FUNCTION .filterUsed>
   ARRAY IN anArray
  anArray
  .filter> ( 
    IN anItem 
   anItem .UnitName >>> anItem 
   if ( anItem l_Used array:Has ! ) then
   begin
    anItem array:AddTo 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 .UnitName .WithComma: l_NeedComma .Out )
     ) // .for>
     
    if ( Self .IsElementProxy ) then
    begin
     Self .UserCode: aUCPrefix ()
    end // ( Self .IsElementProxy )
    
   ) // Indented:
 ';' .Out
 OutLn
; // OutUses:

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

ARRAY FUNCTION .mapToTargetAndValueType>
  ARRAY IN anArray
 anArray .mapToTarget>
 .join> ( anArray .map> .ValueType )
 >>> Result
; // .mapToTargetAndValueType>

elem_iterator AttributesAndOperations
 Cached:
 (
  Self .Attributes
  .join> ( Self .Operations )
 )
 >>> Result
; // AttributesAndOperations

elem_iterator ChildrenWithoutOwnFile
 Cached:
 ( 
  Self .Children .filter> ( .NeedOwnFile ! ) 
 )
 >>> Result
; // ChildrenWithoutOwnFile

elem_iterator ConstantsAndChildrenWithoutOwnFile
 Cached:
 ( 
  Self .Constants
  .join> ( Self .ChildrenWithoutOwnFile )
 )
 >>> Result
; // ConstantsAndChildrenWithoutOwnFile

elem_iterator AllOwnChildren
 Cached:
 ( 
  Self .ConstantsAndChildrenWithoutOwnFile
  .join> ( Self .AttributesAndOperations )
 )
 >>> Result
; // AllOwnChildren

ARRAY FUNCTION .OperationsNeededElements
  ARRAY IN anArray
 anArray .mapToTargetAndValueType>
 .joinWithLambded> anArray ( .Parameters .mapToTargetAndValueType> )
 .joinWithLambded> anArray ( .AttributesAndOperations call.me )
 >>> Result 
; // .OperationsNeededElements

elem_iterator NeededElements
 ( Self .Inherits )
 .join> ( Self .Implements )
 .join> ( Self .AttributesAndOperations .OperationsNeededElements )
 
 if ( Self .IsTypedef ! ) then
 begin
 .join> ( Self .Implemented .OperationsNeededElements )
 .join> ( Self .Overridden .OperationsNeededElements )
 end // Self .IsTypedef !
 
 >>> Result
; // NeededElements

elem_iterator NeededElementsTotal
 Self .NeededElements
 .joinWithLambded> ( Self .ConstantsAndChildrenWithoutOwnFile ) call.me
 >>> Result
; // NeededElementsTotal

BOOLEAN elem_func IsForInterface
 Cached:
 (
  RULES
   ( Self .Visibility PublicAccess == )
    true
   ( Self .Visibility ProtectedAccess == )
    true
   DEFAULT
    false 
  ; // RULES
 ) 
 >>> Result
; // IsForInterface

BOOLEAN elem_func IsForImplementation
 Cached:
 (
  Self .IsForInterface ! 
 ) 
 >>> Result
; // IsForImplementation

elem_iterator IntfUses
 [ 'l3IntfUses' ]
 if ( Self .IsForInterface ) then
 begin
  .join> ( Self .NeededElementsTotal )
 end // Self .IsForInterface
 >>> Result
; // IntfUses

elem_iterator InjectedElements
 Self .Injected .filter> ( .IsStereotype st_injects::Dependency ) .map> .Parent
 >>> Result
; // InjectedElements

BOOLEAN elem_func IsClassImplementable
 Cached:
 (
  RULES
   ( Self .IsPureMixIn )
    false
   ( Self .IsMixIn )
    false
   ( Self .IsSimpleClass )
    false
   ( Self .IsEvdSchemaElement )
    false 
   ( Self .IsStereotype st_MixInMirror )
    false 
   ( Self .IsStereotype st_UseCase )
    false 
   ( Self .IsStereotype st_VCMOperations )
    false 
   ( Self .IsInterface )
    true
   ( Self .IsTypedef )
    RULES
     ( Self .UPisTrue "isPointer" )
      false
     DEFAULT
      ( Self .MainAncestor call.me )
    ; // RULES  
   DEFAULT
    true
  ; // RULES
 )
 >>> Result
; // IsClassImplementable

elem_iterator Used
 Cached:
 (
  Self .Dependencies .filter> ( .IsStereotype st_uses::Dependency ) .mapToTarget> 
  if ( Self .IsInterface ! ) then
  begin
   .join> ( Self .InjectedElements )
  end // Self .IsInterface !
  .joinWithLambded> ( Self .Inherits .filter> .IsMixIn ) call.me
  .joinWithLambded> ( Self .Implements .filter> .IsMixIn ) call.me
  
  if ( Self .UPisTrue "singleton" ) then
  begin
   .join> [ 'SysUtils' 'l3Base' ]
  end // ( Self .UPisTrue "singleton" )
 )
 >>> Result
; // Used

elem_iterator UsedTotal
 Self .Used
 .joinWithLambded> ( Self .AllOwnChildren ) call.me
 >>> Result
; // UsedTotal

elem_iterator ImplUses
 [ 'l3ImplUses' ]
 if ( Self .IsForImplementation ) then
 begin
  .join> ( Self .NeededElementsTotal )
 end // Self .IsForImplementation
 .join> ( Self .UsedTotal ) 
 >>> Result
; // ImplUses

BOOLEAN elem_func IsClass
 Self .IsSimpleClass >>> Result
; // IsClass

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

ModelElement elem_func FirstAttribute
 Cached:
 (
  Self .Attributes .FirstElement
 )
 >>> Result
; // FirstAttribute

ModelElement elem_func SecondAttribute
 Cached:
 (
  Self .Attributes .SecondElement
 )
 >>> Result
; // SecondAttribute

INTEGER FUNCTION .CountIt
  ARRAY IN anArray
 0 >>> Result
 anArray .for> ( 
   IN anItem 
  Inc Result 
 ) 
; // .CountIt

STRING elem_func FineDocumentation
 Self .Documentation >>> Result
 if ( Result IsNil ! ) then
 begin
  Result '{' '[' string:Replace >>> Result
  Result '}' ']' string:Replace >>> Result
  [ '{* ' Result ' }' ] strings:Cat >>> Result
 end // Result IsNil !
; // FineDocumentation

elem_proc OutDocumentation
 STRING VAR l_Doc
 Self .FineDocumentation >>> l_Doc
 if ( l_Doc IsNil ! ) then
 begin
  Indented: ( l_Doc .Out )
 end // l_Doc IsNil !
; // OutDocumentation

BOOLEAN elem_func IsControlPrim
 Self .IsStereotype st_ControlPrim >>> Result
; // IsControlPrim

BOOLEAN elem_func IsControlOverride
 Self .IsStereotype st_ControlOverride >>> Result
; // IsControlOverride

BOOLEAN elem_func IsConstructor
  RULES
   ( Self .IsStereotype st_ctor::Operation )
    true
   ( Self .IsStereotype st_Constructor )
    true
   DEFAULT
    false
  ; //RULES   
 >>> Result
; // IsConstructor

BOOLEAN elem_func IsStaticConstructor
  RULES
   ( Self .IsConstructor )
    RULES
     ( Self .Parent .IsRecord )
      true
     DEFAULT
      false
    ; // RULES
   DEFAULT
    false
  ; //RULES   
 >>> Result
; // IsStaticConstructor

BOOLEAN elem_func IsConstructorsHolder
 ( Self .MainAncestor IsNil ! )
 AND ( Self .Attributes .CountIt <= 0 )
 AND ( Self .Operations .filter> ( .IsConstructor ! ) .CountIt <= 0 )
 >>> Result
; // IsConstructorsHolder

ModelElement elem_func MethodType
 Cached:
 (
  RULES
   ( Self .IsStaticConstructor )
    if ( Self .Parent .IsConstructorsHolder ) then
     ( Self .Parent .MainAncestor )
    else
     ( Self .Parent )
   ( Self .IsControlOverride )
    ( Self .MainAncestor call.me ) 
   ( Self .IsControlPrim )
    ( Self .MainAncestor ) 
   ( Self .IsStereotype st_Area )
    ( Self .MainAncestor )
   ( Self .IsMethod )
    ( Self .FirstOperation .Target )
   ( Self .IsFunction )
    ( Self .FirstOperation .Target )
   DEFAULT 
    ( Self .Target )
  ; // RULES
  VAR l_Type
  >>> l_Type
  RULES 
   ( l_Type IsNil )
   begin
    RULES
     ( Self .IsStereotype st_factory::Operation )
      ( Self .Parent .MainImplements )
     ( Self .IsStereotype st_Factory )
      ( Self .MainImplements )
     DEFAULT
      l_Type
    ; // RULES
   end // ( l_Type IsNil )
   DEFAULT
    l_Type
  ; // RULES
  >>> l_Type
  RULES 
   ( l_Type IsNil )
   begin
    RULES
     ( Self .IsStereotype st_factory::Operation )
      ( 'BadFactoryType' )
     ( Self .IsStereotype st_Factory )
      ( Self .Parent .MainImplements )
     DEFAULT
      l_Type
    ; // RULES
   end // ( l_Type IsNil )
   DEFAULT
    l_Type
  ; // RULES
 )
 >>> Result
; // MethodType

STRING elem_func MethodCallingConventions
 RULES
  DEFAULT
   ( Self .GetUP "calling conventions" )
 ; // RULES
 >>> Result
 
 if ( Result 'none' == ) then
 begin
  '' >>> Result
 end // ( Result 'none' == )
 
 if ( Result IsNil ! ) then
 begin
  ' ' Result ';' Cat Cat >>> Result
 end // ( Result IsNil ! )
; // MethodCallingConventions

CONST cConstPrefix 'const '

STRING elem_func InPrefix
 Cached:
 (
  RULES
   ( Self .IsRecord )
    cConstPrefix
   ( Self .IsUnion )
    cConstPrefix
   ( Self .IsArray )
    cConstPrefix
   ( Self .IsInterface )
    cConstPrefix
   ( Self .IsTypedef )
    RULES
     ( Self .UPisTrue "isPointer" )
      ''
     DEFAULT
      ( Self .MainAncestor call.me )
    ; // RULES  
   ( Self .IsStereotype st_ImpurityParamType )
    cConstPrefix
   ( Self .IsString )
    cConstPrefix
   ( Self .IsUntyped )
    cConstPrefix
   DEFAULT
    ''
  ; // RULES
 )
 >>> Result
; // InPrefix

STRING elem_func ParamPrefix
 RULES
  ( Self .IsStereotype st_in )
   ( Self .Target .InPrefix )
  ( Self .IsStereotype st_const )
   cConstPrefix
  ( Self .IsStereotype st_noconst )
   ''
  ( Self .IsStereotype st_out )
   'out '
  ( Self .IsStereotype st_inout )
   'var '
  DEFAULT
   ( Self .Target .InPrefix ) 
 ; // RULES
 >>> Result
; // ParamPrefix

STRING elem_func MethodName
 Cached:
 (
  RULES
   ( Self .IsStaticConstructor )
    if ( Self .Parent .IsConstructorsHolder ) then
     ( [ Self .Parent .MainAncestor .TypeName '_' Self .Name ] strings:Cat )
    else
     ( [ Self .Parent .TypeName '_' Self .Name ] strings:Cat )
   DEFAULT
    ( Self .Name )
  ; // RULES 
 )
 >>> Result
; // MethodName

BOOLEAN elem_func IsDestructor
 Self .MethodName 'Destroy' == >>> Result
; // IsDestructor

BOOLEAN elem_func IsStaticMethod
 RULES
  ( Self .IsStereotype st_static::Operation )
   true
  ( Self .UPisTrue "is static" ) 
   true
  DEFAULT
   false 
 ; // RULES 
 >>> Result
; // IsStaticMethod

BOOLEAN elem_func ParentIsInterface
 Cached:
 (
  Self .Parent .IsInterface
 )
 >>> Result
; // ParentIsInterface

OUTABLE elem_func MethodKeyword
 Cached:
 (
  RULES
   ( Self .IsStaticConstructor )
    'function'
   ( Self .IsConstructor )
    ( 'constructor' )
   ( Self .IsFactory )
    ( 'class function' )
   ( Self .IsDestructor )
    ( 'destructor' )
   DEFAULT
   (
     ModelElement VAR l_Type
     Self .MethodType >>> l_Type
     VAR l_IsFunc
     ( l_Type IsNil ! ) AND ( l_Type .TypeName IsNil ! ) >>> l_IsFunc
     
     [
     RULES
      ( Self .ParentIsInterface )
       ()
      ( Self .IsStaticMethod )
       'class '
     ; // RULES 
  
     if l_IsFunc then
     begin
      'function'
     end // l_IsFunc
     else
     begin
      'procedure'
     end // l_IsFunc
     ]
   ) // DEFAULT
  ; // RULES
 )
 >>> Result
; // MethodKeyword

INTEGER elem_func MethodAbstraction
 Cached:
 (
  Self .OpKind CASE
   opkind_Normal
    ( 
     RULES
      ( Self .IsStaticConstructor )
       at_final
      ( Self .Parent .IsUtilityPack )
       at_final
      ( Self .Parent .IsStaticObject )
       at_final
      ( Self .ParentIsInterface )
       at_final
      ( Self .IsFunction )
       at_final
      ( Self .IsStereotype st_override::Operation )
       at_override
      DEFAULT
       ( Self .Abstraction )
     ; // RULES
    ) // opkind_Normal
   opkind_Implemented
    (
     RULES
      ( Self .ParentIsInterface )
       at_final
      ( Self .IsStereotype st_inline::Operation )
       at_final
      DEFAULT
       at_override 
     ; // RULES
    ) // opkind_Implemented
   opkind_Overridden
    at_override
   DEFAULT
    at_final 
  END // CASE
 ) 
 >>> Result
; // MethodAbstraction

STRING elem_func MethodNamePrefix
 RULES
  ( Self .IsSetter )
   begin
    if ( Self .UPisTrue "pm" ) then
     'pm_Set'
    else 
     'Set_'
   end // ( Self .IsSetter )
  ( Self .IsProperty )
   begin
    if ( Self .UPisTrue "pm" ) then
     'pm_Get'
    else 
     'Get_'
   end // ( Self .IsProperty )
  DEFAULT
   ''
 ; // RULES 
 >>> Result
; // MethodNamePrefix

elem_iterator PropertyKeys
 Self .Attributes
 .filter> ( .IsControlPrim ! )
 >>> Result
; // PropertyKeys

INTERFACE elem_func ValueParam
 Cached:
 (
  'aValue' Self MakeParam
 ) >>> Result
; // ValueParam

STRING CompileTime-VAR g_MethodParentPrefix ''
BOOLEAN CompileTime-VAR g_EnableMethodDirectives true
BOOLEAN CompileTime-VAR g_EnableMethodDocumentation true

ANY elem_func ExtValue
 Self .GetUP 'extprop:pas:Value' >>> Result
 if ( Result .IsValueValid ) then
 begin
  if ( Result IsString ) then
  begin
   if ( '.[]' Result EndsStr ) then
   begin
    '[]' >>> Result
   end // ( '.[]' Result EndsStr )
  end // ( Result IsString )
 end // ( Result .IsValueValid )
; // ExtValue

elem_proc MethodInterfacePrim
 IN aPrefix
 IN aOverload
 IN aOfObject
 IN aBody
 
 : OutOverloadAndCallingConventions
  aOverload DO 
  Self .MethodCallingConventions
 ; // OutOverloadAndCallingConventions

 : OutReintroduce
  RULES
   ( Self .IsStaticConstructor )
    ()
   ( Self .ParentIsInterface )
    ()
   ( Self .IsConstructor )
    ( ' reintroduce;' )
   ( Self .IsFactory )
    ( ' reintroduce;' )
  ; // RULES
 ; // OutReintroduce
 
 Self .IfDef:
 (
  [ 
   aPrefix DO
   
   ModelElement VAR l_Type
   Self .MethodType >>> l_Type
   
   VAR l_IsFunc
 
   RULES
    ( Self .IsSetter ) 
     ( 
       false >>> l_IsFunc
       'procedure' 
     )
    DEFAULT
     ( 
       ( l_Type IsNil ! ) AND ( l_Type .TypeName IsNil ! ) >>> l_IsFunc
       Self .MethodKeyword 
     )
   ; // RULES  
   
   if ( Self .IsFunction ! ) then
   begin
    ' '
    
    g_MethodParentPrefix
    
    RULES
     ( Self .IsProperty )
      (
       Self .MethodNamePrefix 
       Self .MethodName 
      )
     DEFAULT
      ( Self .MethodName  )
    ; // RULES
    
   end // ( Self .IsFunction ! )
   
   VAR l_WasParam
   false >>> l_WasParam
   
   RULES
    ( Self .IsSetter )
     ( 
      Self .PropertyKeys 
      .join> [ l_Type .ValueParam ]
     )
    ( Self .IsProperty )
     ( Self .PropertyKeys )
    DEFAULT
    ( Self .MethodParameters )
   ; // RULES  
   .for> (
     IN aParam
    if ( l_WasParam ) then
    begin
     ';' \n ' '
    end 
    else
    begin
     '('
     true >>> l_WasParam
    end  
    aParam .ParamPrefix
    aParam .Name
    
    VAR l_Type 
    aParam .Target >>> l_Type
    if ( l_Type IsNil ! ) then
    begin
     ': ' l_Type .TypeName
    end // ( l_Type IsNil ! )
    
    VAR l_Value
    aParam .ExtValue >>> l_Value
    if ( l_Value .IsValueValid ) then
    begin
     ' = ' l_Value
    end // ( l_Value .IsValueValid )
    
    VAR l_Doc
    aParam .FineDocumentation >>> l_Doc
    if ( l_Doc IsNil ! ) then
    begin
     ' ' l_Doc
    end // ( l_Doc IsNil ! )
   ) // Self .MethodParameters .for>
 
   if ( l_WasParam ) then
    ')'
   
   if l_IsFunc then
   begin
    ': ' l_Type .TypeName
   end // l_IsFunc
 
   aOfObject DO
   ';'
   
   if g_EnableMethodDirectives then
   begin
    Self .MethodAbstraction CASE
     at_final (
      OutReintroduce
      OutOverloadAndCallingConventions
     ) 
     at_virtual ( 
      OutReintroduce
      OutOverloadAndCallingConventions 
      ' virtual;' 
     )
     at_abstract ( 
      OutReintroduce
      OutOverloadAndCallingConventions 
      ' virtual; abstract;' 
     )
     at_override 
      ' override;'
    END // CASE
   end // g_EnableMethodDirectives
  ] 
  .Out? ? (
   if g_EnableMethodDocumentation then
    if ( Self .IsProperty ! ) then
    begin
     Self .OutDocumentation
    end // ( Self .IsProperty ! )
   Self aBody DO
  ) // .Out? ?
 ) // Self .IfDef: 
; // MethodInterfacePrim

BOOLEAN elem_func NeedPutToDFM
 Self .UPisTrue "put to dfm" >>> Result
 if Result then
 begin
  if ( Self .Parent .IsControlPrim ) then
  begin
   Self .Parent call.me >>> Result
  end // ( Self .Parent .IsControlPrim )
 end // Result
; // NeedPutToDFM

BOOLEAN elem_func ReadsField
 RULES
  ( Self .IsControlPrim )
   ( Self .NeedPutToDFM ! )
  ( Self .UPisTrue "reads field" )
   true
  DEFAULT
   false 
 ; // RULES
 >>> Result
; // elem_func ReadsField

BOOLEAN elem_func WritesField
 Self .UPisTrue "writes field" >>> Result
; // elem_func WritesField

elem: AsSetterDo:
  ^ IN aLambda
 RULES
  ( Self .IsWriteonlyProperty )
   ( Self aLambda DO )
  DEFAULT 
   (
    VAR l_Setter
    KeyValues:Create >>> l_Setter
    TRY
     l_Setter -> Original := Self
     l_Setter -> OpModify := opModifySetter
     l_Setter aLambda DO 
    FINALLY
     l_Setter pop:Word:DecRef 
    END
   ) // DEFAULT
 ; // RULES
; // AsSetterDo:

elem_proc MethodInterfaceEx
 IN aPrefix
 IN aOverload
 IN aOfObject
 IN aBody
 
 : NormalCall 
  Self aPrefix aOverload aOfObject aBody .MethodInterfacePrim
 ; // NormalCall
 
 : CallAsSetter
  Self .AsSetterDo: ( aPrefix aOverload aOfObject aBody .MethodInterfacePrim )
 ; // CallAsSetter
 
 RULES
  ( Self .IsReadonlyProperty )
   if ( Self .ReadsField ! ) then
    NormalCall
  ( Self .IsWriteonlyProperty ) 
   if ( Self .WritesField ! ) then
    CallAsSetter
  ( Self .IsProperty ) 
   ( 
    if ( Self .ReadsField ! ) then
     NormalCall 
    if ( Self .WritesField ! ) then
     CallAsSetter 
   )
  DEFAULT
   NormalCall 
 ; // RULES
; // MethodInterfaceEx
 
elem_proc MethodInterfaceEx:
 ^ IN aPrefix
 ^ IN aOverload
 ^ IN aOfObject
 ^ IN aLambda
 Self aPrefix aOverload aOfObject aLambda .MethodInterfaceEx
; // MethodInterfaceEx:

BOOLEAN elem_func CanBeClassAncestor
 RULES
  ( Self .IsClassOrMixIn )
   true
  ( Self .IsException )
   true
  ( Self .IsEvdSchemaElement ) 
   true
  ( Self .IsTypedef )
   RULES
    ( Self .UPisTrue "isPointer" )
     false
    DEFAULT
     ( Self .MainAncestor call.me )
   ; // RULES  
  DEFAULT
   false
 ; // RULES
 >>> Result
; // CanBeClassAncestor

ModelElement elem_func MainClassAncestor
 Cached:
 (
  Self .Inherits 
  .filter> .CanBeClassAncestor 
  .FirstElement
 )
 >>> Result
; // MainClassAncestor

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

elem_iterator InterfaceForClassImplements
 Self .ForClassImplements 
 >>> Result
; // InterfaceForClassImplements

INTERFACE elem_func CastMethod
 Cached:
 (
  VAR l_TypeName
  Self .TypeName >>> l_TypeName
  'As_' l_TypeName Cat Self MakeFunction
  DUP
  VAR l_Boxed
  pop:WordBox:Boxed >>> l_Boxed
  l_Boxed -> %SUM := ( 'Метод приведения нашего интерфейса к ' l_TypeName Cat )
  l_Boxed -> Visibility := ProtectedAccess
  l_Boxed ->^ cVarUserCodeName ^:= cEmptyUserCode
  l_Boxed ->^ cImplementationUserCodeName ^:= ' Result := Self;'
 )
 >>> Result
; // CastMethod

elem_iterator OwnOperations
 Self .Operations 
 .filter> ( .IsStaticMethod ! )
 .joinWithLambded> ( Self .InterfaceForClassImplements ) (
   IN anItem
   [ anItem .CastMethod ]
 )
 >>> Result
; // OwnOperations

elem_iterator Properties
 Cached:
 (
  Self .Attributes 
  .filter> .IsProperty
  .filter> ( .IsControlOverride ! )
 )
 >>> Result
; // Properties

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

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

elem_iterator InterfaceProperties
 Cached:
 (
  RULES
   ( Self .IsPureMixIn )
    ( Self .Properties )
   DEFAULT
    ( Self .InterfacePropertiesTotal )
  ; // RULES 
 ) 
 >>> Result
; // InterfaceProperties

elem_iterator ClassImplementsPrim
 Self .ForClassImplements 
 >>> Result
; // ClassImplementsPrim

elem_iterator ClassImplements
 Self .ClassImplementsPrim
 .joinWithLambded> ( Self .ClassImplementsPrim ) .InterfaceForClassImplements
 >>> Result
; // ClassImplements

INTERFACE elem_func InstanceFreeMethod
 Cached:
 (
  VAR l_TypeName
  Self .TypeName >>> l_TypeName
  l_TypeName 'Free' Cat nil MakeFunction
  DUP
  VAR l_Boxed
  pop:WordBox:Boxed >>> l_Boxed
  l_Boxed -> %SUM := ( 'Метод освобождения экземпляра синглетона ' l_TypeName Cat )
  l_Boxed -> Visibility := PrivateAccess
  l_Boxed ->^ cVarUserCodeName ^:= cEmptyUserCode
  l_Boxed ->^ cImplementationUserCodeName ^:= [ ' l3Free(' 'g_' l_TypeName ');' ]
 )
 >>> Result
; // InstanceFreeMethod

INTERFACE elem_func InstanceMethod
 Cached:
 (
  VAR l_TypeName
  Self .TypeName >>> l_TypeName
  'Instance' Self MakeFunction
  DUP
  VAR l_Boxed
  pop:WordBox:Boxed >>> l_Boxed
  l_Boxed -> Stereotype := st_static::Operation
  l_Boxed -> %SUM := ( 'Метод получения экземпляра синглетона ' l_TypeName Cat )
  l_Boxed -> Visibility := PublicAccess
  l_Boxed ->^ cVarUserCodeName ^:= cEmptyUserCode
  l_Boxed ->^ cImplementationUserCodeName ^:= [ 
  ' if (' 'g_' l_TypeName ' = nil) then' \n
  ' begin' \n
  '  l3System.AddExitProc(' l_TypeName 'Free' ');' \n
  '  g_' l_TypeName ' := Create;' \n
  ' end;' \n
  ' Result := g_' l_TypeName ';'
  ]
 )
 >>> Result
; // InstanceMethod

elem_iterator AllOperationsForOverload
 Cached:
 (
  RULES
   ( Self .IsPureMixIn )
    ( Self .OwnOperations )
   ( Self .IsInterface )
    ( Self .InterfaceOperationsTotal )
   ( Self .IsStaticObject )
    ( 
      Self .Operations
      .filter> ( .IsStaticConstructor ! )
      .join> ( Self .Implemented )
    )
   ( Self .IsClassOrMixIn )
    ( 
      Self .Operations 
      ( Self .ClassImplementsPrim ) .for> (
        IN anItem
       .joinWithLambded> ( anItem .InterfaceForClassImplements ) (
         IN anItem
        [ anItem .CastMethod ]
       )
      )
      .filter> ( .IsStereotype st_responsibility::Operation ! ) 
      .filter> ( .IsStereotype st_ini::Operation ! )
      .filter> ( .IsStereotype st_fini::Operation ! )
      .join> ( Self .Implemented )
      if ( Self .UPisTrue "singleton" ) then
      begin
       .join> [ Self .InstanceMethod ]
      end // ( Self .UPisTrue "singleton" )
    )
   DEFAULT
    ( Self .Operations )
  ; // RULES
 )
 >>> Result
; // AllOperationsForOverload

elem_iterator AllOperationsForDefine
 Cached:
 (
  RULES
   ( Self .IsPureMixIn )
    ( Self .Properties )
   ( Self .IsInterface )
    ( Self .InterfacePropertiesTotal )
   ( Self .IsClassOrMixIn )
    ( 
     Self .Properties
     .filter> ( IN anItem
      ( anItem .ReadsField ! )
      OR ( anItem .WritesField ! )
     )
    )
   DEFAULT
    [empty]
  ; // RULES
  .join> ( Self .AllOperationsForOverload )
  RULES
   ( Self .IsClassOrMixIn )
    ( 
     .join> 
     ( Self .Overridden )
     .filter> ( .IsStereotype st_inline::Operation ! ) 
    ) 
  ; // RULES
 )
 >>> Result
; // AllOperationsForDefine

elem_proc MethodInterfaceForEx:
  ^ IN anOperations
  ^ IN aLambda
 Self .MethodInterfaceEx: () ( 
  ARRAY VAR l_Ops
  anOperations DO >>> l_Ops
  if ( l_Ops IsNil ! ) then
  begin
   if ( Self .UPisTrue "force overload" ) then
   begin
    ' overload;'
   end // ( Self .UPisTrue "force overload" )
   else
   begin
    if ( l_Ops 
         .filter> ( .IsProperty ! )
         .filter> ( .MethodName Self .MethodName == ) 
         .CountIt > 1 ) then
    begin
     ' overload;'
    end // l_Ops ..
   end // ( Self .UPisTrue "force overload" )
  end // ( l_Ops IsNil ! )
 ) () (
  aLambda DO
 )
; // MethodInterfaceForEx:

elem_proc MethodInterfaceFor:
  ^ IN anOperations
 Self .MethodInterfaceForEx: ( anOperations DO ) DROP
; // MethodInterfaceFor:
  
elem_proc OutProperty
 Self .IfDef:
 (
  [
   'property '
   Self .Name
   
   VAR l_WasParam
   false >>> l_WasParam
 
   Self .PropertyKeys .for> (
     IN aParam
    if l_WasParam then
     '; '
    else
    begin
     true >>> l_WasParam
     '['
    end
    aParam .ParamPrefix
    aParam .Name
    ': '
    aParam .Target .TypeName
   )
 
   if l_WasParam then
    ']'
   ': '
   Self .MethodType .TypeName
 
   : OutRead
    \n ' ' 'read' ' ' 
    if ( Self .ReadsField ) then
     'f_'
    else
    begin
     Self .MethodNamePrefix 
    end // ( Self .ReadsField )
    Self .MethodName
   ; // OutRead
 
   : OutWrite
    \n ' ' 'write' ' ' 
    if ( Self .WritesField ) then
     'f_'
    else
    begin
     Self .AsSetterDo: .MethodNamePrefix
    end // ( Self .WritesField )
    Self .MethodName
   ; // OutWrite
 
   RULES
    ( Self .IsReadonlyProperty )
     OutRead
    ( Self .IsWriteonlyProperty )
     ()
    ( Self .IsProperty )
     OutRead
   ; // RULES
   RULES
    ( Self .IsReadonlyProperty )
     ()
    ( Self .IsWriteonlyProperty )
     OutWrite
    ( Self .IsProperty )
     OutWrite
   ; // RULES
 
   if ( Self .UPisTrue "needs stored directive" ) then
   begin
    \n
    ' stored '
    Self .MethodName
    'Stored'
   end // ( Self .UPisTrue "needs stored directive" )
 
   VAR l_Value
   Self .ExtValue >>> l_Value
   if ( l_Value .IsValueValid ) then
   begin
    \n
    ' default ' l_Value
   end // ( l_Value .IsValueValid )
   
   ';'
 
   if ( Self .UPisTrue "is default" ) then
   begin
    \n
    ' default;'
   end // ( Self .UPisTrue "is default" )
  ] .Out? ?
   ( Self .OutDocumentation )
 ) // Self .IfDef:
; // OutProperty

elem_iterator MixInValues
 Self .Attributes
 .filter> ( .IsStereotype st_impurity_value::Attribute )
 >>> Result
; // MixInValues

PROCEDURE .ByVisibility>
  ARRAY IN anArray
  ^ IN aFilter
  ^ IN aOut
  
  BOOLEAN VAR l_WasOut
  STRING VAR l_Separator
  
  PROCEDURE DoOut
    IN anItem
   if ( l_WasOut ! ) then
   begin
    true >>> l_WasOut
    l_Separator .Out
   end // ( l_WasOut )
   Indented: ( anItem aOut DO )
  ; // DoOut
  
 false >>> l_WasOut 
 'private' >>> l_Separator
 anArray .filter> ( aFilter DO PrivateAccess == ) .for> DoOut
 false >>> l_WasOut 
 'protected' >>> l_Separator
 anArray .filter> ( aFilter DO ProtectedAccess == ) .for> DoOut
 false >>> l_WasOut 
 'public' >>> l_Separator
 anArray .filter> ( aFilter DO PublicAccess == ) .for> DoOut
; // .ByVisibility>

elem_proc OutField
 Self .IfDef:
 (
  [ 
   Self .Name 
   ': '
   Self .Target .TypeName
   ';'
  ] .Out? ? (
   Self .OutDocumentation
  ) // .Out? ?
 ) // Self .IfDef:
; // OutField

INTEGER elem_func MethodVisibility
 Cached:
 (
  RULES
   ( Self .IsProperty )
    ProtectedAccess
   ( Self .OpKind opkind_Implemented == )
    RULES
     ( Self .Parent .IsPureMixIn )
      PublicAccess
     ( Self .ParentIsInterface )
      ProtectedAccess
     ( Self .IsStaticMethod ) 
      PublicAccess
     DEFAULT
      ( Self .Visibility )
    ; // RULES
   ( Self .OpKind opkind_Overridden == )
    RULES
     ( 
      Self .IsStaticMethod 
      AND ( Self .Abstraction at_abstract == )
     )
      PublicAccess
     DEFAULT
      ( Self .Visibility )
    ; // RULES
   DEFAULT
    ( Self .Visibility )
  ; // RULES
 )
 >>> Result
; // MethodVisibility

elem_proc OutClassInner
 Indented: (
  Self .Fields .ByVisibility> .Visibility .OutField
  
  VAR l_AllOps
  Self .AllOperationsForOverload >>> l_AllOps
  
  Self .AllOperationsForDefine 
  .ByVisibility> .MethodVisibility
  .MethodInterfaceFor: l_AllOps

  Self .Properties .ByVisibility> .Visibility .OutProperty
 ) // Indented:
 
// [{%S{need UC}=true}%U[{publ}\n]\n]\
 if ( Self .UPisTrue "need UC" ) then
 begin
  Self .UserCode: 'publ' ()
 end // ( Self .UPisTrue "need UC" )
  
; // OutClassInner

elem_proc OutClass

//      [{%S{need UC}=true}%U[{ci}\n]\n]\
 if ( Self .UPisTrue "need UC" ) then
 begin
  Self .UserCode: 'ci' ()
 end // ( Self .UPisTrue "need UC" ) 

 Self .MixInValues .for> (
   IN aValue
  [ '_' aValue .Name '_' ' = ' aValue .Target .TypeName ';' ] .Out
 )
 
// %f_CalcParentAndInclude(%S)\
// [{%S{need UC}=true}%U[{cit}\n]\n]\
 if ( Self .UPisTrue "need UC" ) then
 begin
  Self .UserCode: 'cit' ()
 end // ( Self .UPisTrue "need UC" ) 
 
 [ 
  Self .TypeName 
  ' = ' 
  
  Self .Abstraction CASE
   at_abstract
    ( '{abstract}' ' ' )
   at_final
    ( '{final}' ' ' )
  END // CASE
  
  'class'

  ARRAY VAR l_Implements 
  [] >>> l_Implements

  [ Self .MainClassAncestor ] 
  .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>
  .map> .TypeName
  ', ' strings:CatSep
  .With() 
 ] .Out
 
 Self .OutDocumentation
 Self .OutClassInner
 
 [ 'end;//' Self .TypeName ] .Out
; // OutClass

elem_proc OutInterfaceBody
 Indented: (
  VAR l_Ops
  Self .AllOperationsForDefine >>> l_Ops
  VAR l_AllOps
  Self .AllOperationsForOverload >>> l_AllOps
  l_Ops .for> .MethodInterfaceFor: l_AllOps
  Self .InterfaceProperties .for> .OutProperty
 ) // Indented:
; // OutInterfaceBody

elem_proc OutInterface
 [ Self .TypeName ' = interface' Self .MainAncestor .TypeName .With() ] .Out
 Self .OutDocumentation
 
 VAR l_GUID
 Self .GUID >>> l_GUID
 if ( l_GUID IsNil ! ) then
 begin
  Indented: ( [ '[''{' l_GUID '}'']' ] .Out )
 end // ( l_GUID IsNil ! )
 
 Self .OutInterfaceBody
 [ 'end;//' Self .TypeName ] .Out
; // OutInterface

elem_proc OutRecord
 [ 
  Self .TypeName ' = ' 

  Self .UPisTrue "packed" ? 'packed '

  'record' 
 ] .Out
 Self .OutDocumentation
 Indented: ( Self .Fields .for> .OutField )
 
// [{%S{need UC}=true}%U[{publ}\n]\n]\
 if ( Self .UPisTrue "need UC" ) then
 begin
  Self .UserCode: 'publ' ()
 end // ( Self .UPisTrue "need UC" ) 
 
 [ 'end;//' Self .TypeName ] .Out
; // OutRecord

elem_proc OutDefine
 [ '{$Define ' Self .Name '}' ] .Out
; // OutDefine

elem_proc OutUndef
 [ '{$Undef ' Self .Name '}' ] .Out
; // OutUndef

elem_proc OutStaticObject
 if ( Self .IsConstructorsHolder ! ) then
 begin
  [ 
   Self .TypeName ' = ' 

   Self .UPisTrue "packed" ? 'packed '

   'object' Self .MainAncestor .TypeName .With() 
  ] .Out
  
  Self .OutDocumentation
  Self .OutClassInner
  
  [ 'end;//' Self .TypeName ] .Out
 end // ( Self .IsConstructorsHolder ! )
; // OutStaticObject

elem_proc OutPureMixIn
 '(*' .Out
 Self .OutInterface
 '*)' .Out
; // OutPureMixIn

ANY elem_func ExtValueOrName
 Self .ExtValue >>> Result
 if ( Result .IsValueValid ! ) then
 begin
  Self .Name >>> Result
 end // ( Result .IsValueValid ! 
; // ExtValueOrName
 
elem_proc OutRange
 [ Self .TypeName 
   ' = ' 
   VAR l_First
   Self .FirstAttribute >>> l_First
   VAR l_Second
   Self .SecondAttribute >>> l_Second
   if ( l_Second IsNil ) then
   begin
    l_First >>> l_Second
   end // ( l_Second IsNil )
   
   l_First .ExtValueOrName
   ' .. '
   l_Second .ExtValueOrName
   ';' 
 ] .Out
 Self .OutDocumentation
; // OutRange

elem_proc OutTypedef
 ModelElement VAR l_MainAncestor
 Self .MainAncestor >>> l_MainAncestor
 [ Self .TypeName 
   ' = ' 
   if ( Self .UPisTrue "newRTTI" ) then
    'type '
   if ( Self .UPisTrue "isPointer" ) then
    '^'
   if ( Self .UPisTrue "isClassRef" ) then
    'class of '
   if ( Self .UPisTrue "isPointer" ! ) then
   begin
    STRING VAR l_OtherUnit
    l_MainAncestor .EffectiveUnitName >>> l_OtherUnit
    if ( l_OtherUnit '' != ) then
    begin
     if ( Self .TypeName l_MainAncestor .TypeName == ) then
     begin
      STRING VAR l_OurUnit
      Self .EffectiveUnitName >>> l_OurUnit
      if ( l_OurUnit l_OtherUnit != ) then
      begin
       l_OtherUnit '.'
      end // l_OurUnit l_OtherUnit !=
     end // Self .TypeName l_MainAncestor .TypeName ==
    end // l_OtherUnit '' !=
   end // Self .UPisTrue "isPointer" !
   l_MainAncestor .TypeName 
   ';' 
 ] .Out
 Self .OutDocumentation
; // OutTypedef

elem_proc OutEnum
 [ Self .TypeName ' = (' ] .Out
 Self .OutDocumentation
  STRING VAR l_Prefix
  Self .GetUP 'extprop:pas:ElementPrefix' >>> l_Prefix
  VAR l_NeedComma
  false >>> l_NeedComma
  Indented: ( 
   Self .Attributes .for> (
     IN aChild
    l_Prefix aChild .Name Cat 
     .WithComma: l_NeedComma .Out
    aChild .OutDocumentation
   ) // Self .Attributes .for>
  ) // Indented:
 [ ');//' Self .TypeName ] .Out
; // OutEnum

elem_proc OutSetOf
 [ Self .TypeName ' = set of ' Self .MainAncestor .TypeName ';' ] .Out
 Self .OutDocumentation
; // OutSetOf

elem_proc OutFunction
 Self .MethodInterfaceEx: (
  Self .TypeName 
  ' = ' 
 ) () (
  if ( Self .UPisTrue "of object" ) then
  begin
   ' of object'
  end // ( Self .UPisTrue "of object" )
 )
 ( IN aMethod )
; // OutFunction

elem_proc OutArray
 if ( Self .IsOpenArray ! ) then
 begin
  [ 
   Self .TypeName ' = array ' 
   if ( Self .MainAncestor IsNil ! ) then
   begin
    '[' Self .MainAncestor .TypeName '] '
   end // ( Self .MainAncestor IsNil ! )
   'of ' 
   Self .FirstAttribute .Target .TypeName ';'
  ] .Out
  Self .OutDocumentation
 end // ( Self .IsOpenArray ! )
; // OutArray

ARRAY CompileTime-VAR g_OutedTypes []

elem_proc OutForward
 if ( Self g_OutedTypes array:Has ! ) then
 begin
  RULES
   ( Self .IsPureMixIn ) 
    ()
   ( Self .IsClass )
    ( [ Self .TypeName ' = class;' ] .Out OutLn )
   ( Self .IsInterface )
    ( [ Self .TypeName ' = interface;' ] .Out OutLn )
  ; // RULES  
 end // ( Self g_OutedTypes array:Has ! )
; // OutForward

elem_proc OutType
 RULES
  ( Self .IsElementProxy )
   ()
  ( Self .IsStereotype st_ScriptKeywordDocumentation )
   ()
  ( Self .IsStereotype st_ScriptKeywordsDocumentation )
   ()
  ( Self .IsUtilityPack )
   ()
  ( Self .IsInterfaces )
   ()
  ( Self .IsTarget )
   ()
  ( Self .IsOpenArray )
   ()
  ( ( Self .IsStaticObject ) AND ( Self .IsConstructorsHolder ) )
   ()
  ( Self .IsStereotype st_UserType )
   ()
  DEFAULT
   (
    if ( Self g_OutedTypes array:Has ! ) then
    begin
     Self array:AddTo g_OutedTypes
     Self .Forwarded .for> .OutForward
     Self .IfDef:
     (
      RULES
       ( Self .IsSetOf )
        ( Self .OutSetOf )
       ( Self .IsArray )
        ( Self .OutArray )
       ( Self .IsEnum )
        ( Self .OutEnum )
       ( Self .IsRange )
        ( Self .OutRange )
       ( Self .IsTypedef )
        ( Self .OutTypedef )
       ( Self .IsException )
        ( Self .OutClass )
       ( Self .IsMixIn )
        ( Self .OutClass )
       ( Self .IsClass )
        ( Self .OutClass )
       ( Self .IsPureMixIn ) 
        ( Self .OutPureMixIn )
       ( Self .IsInterface )
        ( Self .OutInterface )
       ( Self .IsStaticObject )
        ( Self .OutStaticObject )
       ( Self .IsUnion )
        ( Self .OutRecord )
       ( Self .IsRecord )
        ( Self .OutRecord )
       ( Self .IsUndef )
        ( Self .OutUndef )
       ( Self .IsDefine )
        ( Self .OutDefine )
       ( Self .IsFunction )
        ( Self .OutFunction )
       DEFAULT
        ( [ '// ' Self .TypeName ] .Out )
      ; // RULES 
      OutLn
     ) // Self .IfDef:
    end // ( Self g_OutedTypes array:Has ! )
   ) // DEFAULT
 ; // RULES
; // OutType

BOOLEAN elem_func IsType
 Cached:
 (
  RULES
   ( Self .IsElementProxy )
    false
   ( Self .IsStereotype st_UserType ) 
    false
   ( Self .IsStereotype st_ScriptKeywordDocumentation ) 
    false
   ( Self .IsStereotype st_ScriptKeywordsDocumentation ) 
    false
   ( Self .IsUtilityPack )
    false
   ( Self .IsInterfaces )
    false
   ( Self .IsTarget )
    false
   ( Self .IsEvdSchemaElement )
    false
   ( Self .IsPureMixIn )
    false
   ( Self .IsDefine )
    false
   DEFAULT
    true
  ; // RULES
 )
 >>> Result
; // IsType

elem_proc OutChildrenRec
  IN aValid
  IN aOut
  
  elem_proc DoOut
   Self .ChildrenWithoutOwnFile .for> call.me
   if ( Self aValid DO ) then
   begin
    Self aOut DO
   end // ( Self aValid DO )
  ; // DoOut
  
 Self .DoOut 
; // OutChildrenRec

elem_proc OutChildrenRec:
  ^ IN aValid
  ^ IN aOut
 Self aValid aOut .OutChildrenRec
; // OutChildrenRec:
  
elem_proc OutTypes
  ^ IN aValid
  
 VAR l_WasType 
 
 false >>> l_WasType
 
 Self aValid @ (
   IN aChild
  if ( aChild .IsType ) then
  begin
   if ( l_WasType ! ) then
   begin
    'type' .Out
    true >>> l_WasType
   end // l_WasType !
  end // aChild .IsType
  Indented: ( aChild .OutType )
 ) .OutChildrenRec
; // OutTypes

elem_proc OutConstants
 STRING VAR l_Prefix
 Self .GetUP 'extprop:pas:ElementPrefix' >>> l_Prefix
 Self .Attributes .for> (
   IN anItem
  [ 
   l_Prefix anItem .Name

   if ( anItem .UPisTrue "is define" ! ) then
   begin
    VAR l_Type 
    anItem .Target >>> l_Type
    l_Type IsNil ! ? ( ': ' l_Type .TypeName )
   end // ( anItem .UPisTrue "is define" ! )

   BOOLEAN VAR l_NeedSuffix
   false >>> l_NeedSuffix
   VAR l_Value
   anItem .ExtValue >>> l_Value
   if ( l_Value .IsValueValid ! ) then
   begin
    anItem .GetUP 'Value' >>> l_Value
    true >>> l_NeedSuffix
   end

   ' = ' l_Value

   if l_NeedSuffix then
   begin
    VAR l_Suffix
    anItem .GetUP "suffix expr" >>> l_Suffix
    if ( l_Suffix .IsValueValid ) then
    begin
     ' ' l_Suffix 
    end // ( l_Suffix .IsValueValid )
   end // l_NeedSuffix

   ';' 
  ] .Out? ? (
   anItem .OutDocumentation
  ) // ] .Out? ?
 ) // Self .Attributes .for>
; // OutConstants

PROCEDURE .OutConstantsList
  ARRAY IN aList
 BOOLEAN VAR l_WasConst
 false >>> l_WasConst
 aList .for> (
   IN anItem
  RULES
   ( anItem .IsStereotype st_LocalConst )
    ()
   DEFAULT
    (
     if ( l_WasConst ! ) then
     begin
      true >>> l_WasConst
      'const' .Out
     end
     anItem .IfDef: (
      anItem .OutDocumentation
      Indented: ( 
       anItem .OutConstants 
      ) // Indented:
     ) // anItem .IfDef:
    ) // DEFAULT
  ; // RULES 
 )
 if l_WasConst then
  OutLn
; // .OutConstantsList

elem_proc OutDefinitionsSection:
  ^ IN aValid
  
 : Validate aValid DO ; 
  
 Self .OutChildrenRec: Validate (
  .Constants .filter> ( .Visibility PublicAccess == ) .OutConstantsList
 )

 Self .OutTypes Validate
 
 Self .OutChildrenRec: Validate (
  .Constants .filter> ( .Visibility ProtectedAccess == ) .OutConstantsList
 )

; // OutDefinitionsSection:

elem_iterator GlobalOperationsPrim
 Cached:
 (
  RULES
   ( Self .IsInterface )
    ( 
     Self .Operations 
     .filter> .IsStaticMethod
    ) 
   ( Self .IsRecord )
    ( 
     Self .Operations 
     .filter> .IsConstructor
    ) 
   ( Self .IsUtilityPack )
    ( Self .Operations )
   ( Self .IsClassOrMixIn ) 
    (
     if ( Self .UPisTrue "singleton" ) then
     begin
      [ Self .InstanceFreeMethod ]
     end // ( Self .UPisTrue "singleton" )
     else
      [empty]
    )
   DEFAULT
    [empty]
  ; // RULES
 )
 >>> Result
; // GlobalOperationsPrim

elem_iterator GlobalOperations
 Self .GlobalOperationsPrim
 .filter> ( .IsStereotype st_ini::Operation ! )
 .filter> ( .IsStereotype st_fini::Operation ! )
 .filter> ( .IsStereotype st_keyword::Operation ! )
 .filter> ( .IsStereotype st_globalkeyword::Operation ! )
 >>> Result
; // GlobalOperations

elem_iterator GlobalOperationsForOverload
 RULES
  ( ( Self .IsStaticObject ) AND ( Self .IsConstructorsHolder ) )
   ( ( Self .MainAncestor .GlobalOperations ) .join> ( Self .GlobalOperations ) )
  DEFAULT
   ( Self .GlobalOperations )
 ; // RULES
 >>> Result
; // GlobalOperationsForOverload

elem_proc OutVar
 Self .IfDef:
 (
  [
   'var '
   Self .Name
   ': '
   Self .Target .TypeName
   
   VAR l_Value
   Self .ExtValue >>> l_Value
   if ( l_Value .IsValueValid ) then
   begin
    ' = ' l_Value
   end // ( l_Value .IsValueValid )
   
   ';'
  ] .Out
  Self .OutDocumentation
 ) // Self .IfDef:
; // OutVar

elem_proc OutInterfaceSection
 Self .OutDefinitionsSection: .IsForInterface
 
 VAR l_WasOut
 false >>> l_WasOut
 Self .OutChildrenRec: .IsForInterface (
   IN anItem
  VAR l_GlobalOperations
  anItem .GlobalOperations >>> l_GlobalOperations
  VAR l_GlobalOperationsForOverload
  anItem .GlobalOperationsForOverload >>> l_GlobalOperationsForOverload
  l_GlobalOperations 
  .filter> ( .Visibility PrivateAccess != )
  .for> .MethodInterfaceForEx: l_GlobalOperationsForOverload ( IN aMethod true >>> l_WasOut )
 )
 
 l_WasOut ? OutLn
 
 false >>> l_WasOut
 Self .OutChildrenRec: .IsForInterface (
   IN anItem
  anItem .GlobalVars 
  .filter> ( .Visibility PrivateAccess != ) 
  .for> ( .OutVar true >>> l_WasOut )
 ) 
 
 l_WasOut ? OutLn
; // OutInterfaceSection

elem_proc MethodBody
 if ( Self .UPisTrue 'extprop:isAsm' ) then
 begin
  'asm' .Out
  ' jmp l3LocalStub' .Out
 end 
 else 
 begin
  Self .UserCode: cVarUserCodeSuffix ()
  'begin' .Out
  Self .UserCode: cImplementationUserCodeSuffix ( ' !!! Needs to be implemented !!!' )
 end
 [ 'end;//' g_MethodParentPrefix Self .MethodNamePrefix Self .MethodName ] .Out
 OutLn
; // MethodBody

elem_iterator AllInlinedOperations
 Cached:
 (
  Self .Implemented
  .join> ( Self .Overridden )
  .filter> ( .IsStereotype st_inline::Operation ) 
 )
 >>> Result
; // AllInlinedOperations

elem_proc OutClassImplementation
 BOOLEAN VAR l_WasFirst
 false >>> l_WasFirst
 TF g_EnableAutoEOL (
  false >>> g_EnableAutoEOL
  TF g_EnableMethodDocumentation (
   false >>> g_EnableMethodDocumentation
   Self .AllInlinedOperations 
   .filter> (
     IN aMethod
    if l_WasFirst then
     true
    else
    begin
     true >>> l_WasFirst
     false
    end
   ) // .filter>
   .for> .MethodInterfaceForEx: nil (
     IN aMethod
    ' forward;' .Out
    OutLn
    OutLn
   ) // .for> .MethodInterfaceForEx: nil
  ) // TF g_EnableMethodDocumentation
 ) // TF g_EnableAutoEOL 
 Self .AllInlinedOperations .for> .MethodInterfaceForEx: nil .MethodBody
 
 TF g_MethodParentPrefix (
  Self .TypeName >>> g_MethodParentPrefix
  g_MethodParentPrefix '.' Cat >>> g_MethodParentPrefix
  TF g_EnableMethodDirectives (
   false >>> g_EnableMethodDirectives
   Self .AllOperationsForDefine 
   .filter> ( .MethodAbstraction at_abstract != )
   .for> .MethodInterfaceForEx: nil .MethodBody
  ) // TF g_EnableMethodDirectives
 ) // TF g_MethodParentPrefix
 
// %f_clear_list(CAST_METHODS)\
// [{%S{need UC}=true}%f_with_gen_id(intf.pas,\n\n%U[{impl}\n])]\
 if ( Self .UPisTrue "need UC" ) then
 begin
  Self .UserCode: 'impl' ()
  OutLn
 end // ( Self .UPisTrue "need UC" ) 
// [{%Cx=true|%Ox=true|%ox=true|"%S%f_pas_OutOverridesImpl()"!=""|<{}{%G#f_IsMixIn()=true}{C}>!=0|<{}{%R#f_IsMixIn()=true}{C}>!=0}\
//      [\n\n%S%f_close_ifdef()]\

; // OutClassImplementation

elem_proc OutImplementation
 RULES
  ( Self .IsClassOrMixIn )
   ( Self .OutClassImplementation )
  ( Self .IsStaticObject )
   ( Self .OutClassImplementation )
 ; // RULES
; // OutImplementation

elem_proc OutImplementationSection
 Self .OutDefinitionsSection: .IsForImplementation
 
 VAR l_WasOut
 false >>> l_WasOut
 Self .OutChildrenRec: .IsForImplementation (
   IN anItem
  anItem .GlobalVars 
  .filter> ( .Visibility PrivateAccess != ) 
  .for> ( .OutVar true >>> l_WasOut )
 ) 
 Self .OutChildrenRec: .True (
   IN anItem
  anItem .GlobalVars 
  .filter> ( .Visibility PrivateAccess == ) 
  .for> ( .OutVar true >>> l_WasOut )
 ) 
 
 l_WasOut ? OutLn
 
 Self .OutChildrenRec: .True (
  .Constants .filter> ( .Visibility PrivateAccess == ) .OutConstantsList
 )

 Self .OutChildrenRec: .IsForInterface (
   IN anItem
  VAR l_GlobalOperations
  anItem .GlobalOperations >>> l_GlobalOperations
  VAR l_GlobalOperationsForOverload
  anItem .GlobalOperationsForOverload >>> l_GlobalOperationsForOverload
  l_GlobalOperations 
  .filter> ( .Visibility PrivateAccess == )
  .for> .MethodInterfaceForEx: l_GlobalOperationsForOverload .MethodBody
  l_GlobalOperations 
  .filter> ( .Visibility PrivateAccess != )
  .for> .MethodInterfaceForEx: nil .MethodBody
 )
 Self .OutChildrenRec: .IsForImplementation (
   IN anItem
  VAR l_GlobalOperations
  anItem .GlobalOperations >>> l_GlobalOperations
  VAR l_GlobalOperationsForOverload
  anItem .GlobalOperationsForOverload >>> l_GlobalOperationsForOverload
  l_GlobalOperations 
  .for> .MethodInterfaceForEx: l_GlobalOperationsForOverload .MethodBody
 )
 
 Self .OutChildrenRec: .True .OutImplementation
; // OutImplementationSection

STRING elem_func Defines
 Self .GetUP "defines" >>> Result
 if ( Result IsNil ) then
 begin
  VAR l_Parent
  Self .Parent >>> l_Parent
  if ( l_Parent IsNil ! ) then
  begin
   l_Parent call.me >>> Result
  end // ( l_Parent IsNil ! )
 end // ( Result IsNil )
; // Defines

elem_proc OutUnit
 TF g_OutedTypes (
  [ 
   RULES
    ( Self .IsDLL )
     'library'
    ( Self .IsExe )
     'program'
    DEFAULT
     'unit' 
   ; // RULES  
   ' '
   Self .UnitNamePrim ';' 
  ] .Out
  OutLn
  
  [ '// Модуль: "' g_FinalFileName '"' ] .Out
  OutLn
  
  VAR l_Defines
  Self .Defines >>> l_Defines
  if ( l_Defines IsNil ! ) then
  begin
   [ '{$Include ' l_Defines '}' ] .Out
   OutLn
  end // ( l_Defines IsNil ! )
  
  'interface' .Out
  OutLn
  
  ARRAY VAR l_Used
  [] >>> l_Used
  
  Self .IfDef: ( 
   Self 'intf_uses' .OutUses: l_Used ( Self .IntfUses )
  
   Self .OutInterfaceSection
   
   if ( Self .IsElementProxy ) then
   begin
    Self .UserCode: 'intf_code' ()
    OutLn
   end // ( Self .IsElementProxy )
  ) // Self .IfDef:
  
  'implementation' .Out
  OutLn
  
  Self .IfDef: ( 
   Self 'impl_uses' .OutUses: l_Used ( Self .ImplUses )
  
   Self .OutImplementationSection
   
   if ( Self .IsElementProxy ) then
   begin
    Self .UserCode: 'impl_code' ()
    OutLn
   end // ( Self .IsElementProxy )
  ) // Self .IfDef:
  
  'end.' .Out
 ) // TF g_OutedTypes
; // OutUnit

elem_proc OutMixIn
 Self .OutUnit
; // OutMixIn

BOOLEAN elem_func UseNewGen
 RULES
  ( Self .IsElementProxy )
   true
  ( Self .UPisTrue "UseNewGen" )
   true 
  DEFAULT
   false
 ; // RULES
 >>> Result
; // UseNewGen

STRING elem_func PasFinalFileName
 Self .GetUP 'intf.pas:Path' >>> Result
 if ( Result IsNil ) then
 begin
  if ( Self .IsElementProxy ) then
  begin
   Self .Parent .GetUP 'intf.pas:PathOnly' >>> Result
   if ( Result IsNil ! ) then
   begin
    Result '\MDProcess\' '\common\' string:ReplaceFirst >>> Result
    [ Result [ Self .Name '_Proxy' '.pas' ] strings:Cat ] cPathSep strings:CatSep >>> Result
   end // ( Result IsNil ! )
  end // ( Self .IsElementProxy )
 end // ( Result IsNil )
; // PasFinalFileName

elem_generator pas
 
 CONST Ext '.pas'

 BOOLEAN elem_func CanCopyToFinalFile
  Self .UseNewGen >>> Result
 ; // CanCopyToFinalFile
 
 STRING elem_func FinalFileNamePrim
  Self .PasFinalFileName >>> Result 
 ; // FinalFileNamePrim
 
 RULES
  ( Self .IsMixIn )
   ( Self .OutMixIn )
  ( Self .IsStereotype st_UserType ) 
   ( Self .OutUnit )
  ( Self .IsInterfaces )
   ( Self .OutUnit )
  ( Self .IsEvdSchemaElement )
   ( Self .OutUnit )
  ( Self .IsSimpleClass )
   ( Self .OutUnit )
  ( Self .IsElementProxy )
   ( Self .OutUnit )
  ( Self .IsUtilityPack )
   ( Self .OutUnit )
  ( Self .IsStereotype st_TestClass ) 
   ( Self .OutUnit )
  ( Self .IsTarget ) 
   ( Self .OutUnit )
  ( Self .IsTagTable ) 
   ( Self .OutUnit )
  DEFAULT
   ( Self .Name .Out )
 ; // RULES
; // pas

elem_generator pas_dependent
 
 Inherits .pas
 
 STRING elem_func FinalFileNamePrim
  Self .PasFinalFileName >>> Result 
  if ( Result IsNil ! ) then
  begin
   Result .? Ext sysutils:ChangeFileExt >>> Result
  end // ( Result IsNil ! )
 ; // FinalFileNamePrim
 
; // pas_dependent

elem_generator dfm
 
 Inherits .pas_dependent

 CONST Ext '.dfm'

 BOOLEAN FUNCTION NeedOwnFile
   ModelElement IN Self
   
  Self .IsStereotype st_VCMCustomForm
  AND ( Self .Abstraction at_final == )
  >>> Result 
 ; // NeedOwnFile
 
 BOOLEAN elem_func CanCopyToFinalFile
  false >>> Result
 ; // CanCopyToFinalFile
 
 Self .Name .Out
 
; // dfm
 
elem_generator res.cmd
 
 Inherits .pas_dependent

 CONST Ext '.res.cmd'
 
 BOOLEAN FUNCTION NeedOwnFile
   ModelElement IN Self
   
  Self .UPisTrue "needs script" >>> Result 
 ; // NeedOwnFile
  
 BOOLEAN elem_func CanCopyToFinalFile
  true >>> Result
 ; // CanCopyToFinalFile
 
 VAR l_Name
 WithGen: .pas ( Self .EffectiveUnitName >>> l_Name )
 [ 'MakeCo ' l_Name '.rc.script' ] .Out
 [ 'brcc32 ' l_Name '.rc' ] .Out
 //call.inherited
; // res.cmd

elem_generator rc.script
 
 Inherits .res.cmd

 CONST Ext '.rc.script'

 BOOLEAN elem_func CanCopyToFinalFile
  RULES
   (
    ( Self .UPisTrue "no class name" ! )
    AND ( Self .UPisTrue "no_pop" ! )
   )
    true
   DEFAULT
    false
  ; // RULES
  >>> Result
 ; // CanCopyToFinalFile
 
 Self .UserCode: 'impl' ()
 OutLn
 'EXPORTS' .Out
 Self .UserCode: 'exports' ( ' *' )
 OutLn
; // rc.script
 
elem_generator rc
 
 Inherits .res.cmd

 CONST Ext '.rc'
 
 VAR l_Name
 WithGen: .pas ( Self .EffectiveUnitName >>> l_Name )
 [ l_Name ' RCDATA LOADONCALL MOVEABLE DISCARDABLE ' l_Name '.rc.script.co' ] .Out
 //call.inherited
; // rc

ARRAY CompileTime-VAR g_GeneratedElements []
%REMARK 'Ранее сгенерированные элементы'

PROCEDURE .GenerateWithChildren
 ModelElement IN Self
 Sequence IN aGenerators
 
 if ( Self g_GeneratedElements array:Has ! ) then
 begin
  Self array:AddTo g_GeneratedElements
  aGenerators CodeIterator .for> (
  // - цикл по генераторам для Self
   TtfwWord IN aGenerator
   TF g_CurrentGenerator (
    aGenerator >>> g_CurrentGenerator
    if ( Self .NeedOwnFile ) then
     ( Self .GenerateWordToFileWith: .CurrentGenerator )
    else
     ( Self .DeleteWordFile ) 
   ) // TF g_CurrentGenerator
  ) // aGenerators CodeIterator .for>
  
  Self .Children 
 //  .filter> ( .NeedOwnFile )
    .for> ( aGenerators call.me )
  // - тут генерируем детей  
 end // Self g_GeneratedElements array:Has !
; // .GenerateWithChildren

PROCEDURE .call.generators.in.list
 ModelElement IN Self
 Sequence ^ IN aGenerators
 Self aGenerators .GenerateWithChildren
; // .call.generators.in.list

PROCEDURE .Generate
 ModelElement IN Self
 
 g_GeneratedFiles = nil ?FAIL 'Массив g_GeneratedFiles не инициализирован'
 g_GeneratedElements = nil ?FAIL 'Массив g_GeneratedElements не инициализирован'
 
 Self .call.generators.in.list ( .pas .res.cmd .rc .rc.script .dfm )
 
; // .Generate