Clone wiki

MindStream / Articles in English / Script engine organisation / A real example of code generation using the model. Mere code

A real example of code generation using the model. Mere code

Original in Russian

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 GEN_PROPERTY_PREFIX 'gp'
%REMARK 'Prefix of the generator property name'

MACRO %GEN_PROPERTY
 Literal IN aName
 %SUMMARY 'Generator property' ;
 this.method.addr Ctx:SetWordProducerForCompiledClass
 axiom:PushSymbol CONST
 GEN_PROPERTY_PREFIX (+) ( aName |N ) Ctx:Parser:PushSymbol
; // %GEN_PROPERTY

USES
 RefDeepest.ms.dict
 FieldByNameDeepest.ms.dict
;

MACRO %GP
 Literal IN aName
 %SUMMARY 'Method of getting the generator property' ;
 axiom:PushSymbol FieldByNameDeepest
 GEN_PROPERTY_PREFIX (+) ( aName |N ) Ctx:Parser:PushSymbol
; // %GP

CONST cPathSep '\'

FILE CompileTime-VAR g_OutFile nil
%REMARK 'Current file'

INTEGER CompileTime-VAR g_Indent 0
%REMARK 'Current indent'

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

STRING FUNCTION ValueToStringOrName
  OUTABLE IN aValue

 if ( aValue .IsWord ) then
 begin
  aValue .Name >>> Result
  if ( Result = '' ) then
  begin
   aValue pop:Word:Name >>> Result
  end
 end
 else
 begin
  aValue ValueToString >>> Result
 end
; // ValueToStringOrName

CONST \n #13#10

BOOLEAN FUNCTION .Out?

  OUTABLE IN aValue

  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 g_OutFile File:WriteStr
    false >>> l_NeedIndent
   end // l_WasOut !

   if ( l_NeedIndent ) then
   begin
    false >>> l_NeedIndent
    IndentStr g_OutFile File:WriteStr
   end // l_NeedIndent

   if ( l_Value \n == ) then
   begin
    l_Value g_OutFile File:WriteStr
    true >>> l_NeedIndent
   end // ( l_Value \n == )
   else
   begin
    l_Value g_OutFile File:WriteStr
   end // ( l_Value \n == )
  end // aValue IsArray
 ; // .OutValue

 false >>> l_WasOut
 false >>> l_NeedIndent
 aValue .OutValue

 if l_WasOut then
 begin
  \n g_OutFile File:WriteStr
 end // l_WasOut
 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 'Previously generated files'

TtfwWord VAR g_CurrentGenerator
%REMARK 'Current generator'

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 .GenerateWordToFile
 ModelElement IN Self
 ^ 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 [ 'Failed to create directory ' l_TempPath ]

  STRING VAR l_RealPath
  'W:\common\GenScripts\' >>> l_RealPath
  l_RealPath sysutils:ForceDirectories ?ASSURE [ 'Failed to create directory ' l_RealPath ]

  STRING VAR l_TempFileName

  [ l_TempPath l_FileName ] cPathSep strings:CatSep >>> l_TempFileName

  STRING VAR l_RealFileName

  [ l_RealPath l_FileName ] cPathSep strings:CatSep >>> l_RealFileName

  if ( g_GeneratedFiles l_TempFileName array:HasText ! ) then
  begin
   l_TempFileName array:AddTo g_GeneratedFiles
   TF g_OutFile (
    l_TempFileName File:OpenWrite >>> g_OutFile
    Self aLambda DO
   )

   if (
       ( l_RealFileName sysutils:FileExists ! )
       OR ( '' l_RealFileName l_TempFileName CompareFiles ! )
      ) then
   begin
    $20 l_RealFileName l_TempFileName CopyFile
   end
  end // g_GeneratedFiles l_TempFileName array:HasText !
 )
; // .GenerateWordToFile

PROCEDURE .DeleteWordFile
 ModelElement IN Self

  STRING VAR l_FileName
  [ Self pop:Word:Name .? Ext ] strings:Cat >>> l_FileName

  STRING VAR l_RealPath
  'W:\common\GenScripts\' >>> l_RealPath

  STRING VAR l_RealFileName

  [ l_RealPath l_FileName ] cPathSep strings:CatSep >>> l_RealFileName

  if ( l_RealFileName sysutils:FileExists ) then
  begin
   l_RealFileName DeleteFile DROP
  end
; // .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 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 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 IsTarget
 Cached:
 (
  RULES
   ( Self .IsStereotype st_ExeTarget )
    true

   ( Self .IsStereotype st_AdapterTarget )
    true

   ( Self .IsStereotype st_TestTarget )
    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

elem_proc dump
 Self .Out
 Bracketed (
  Self MembersIterator .for> (
    OBJECT IN aCode

   STRING VAR l_Out 
   STRING VAR l_Name
   aCode pop:Word:Name >>> l_Name
   [ l_Name ' : ' ] strings:Cat >>> l_Out
   [ aCode DO ] .for> (
     IN anItem

    if ( anItem .IsSequence ) then
     ( anItem .SequenceCode.It >>> anItem )
    if ( anItem IsArray ) then
    begin
     if (
         ( l_Name = 'Children' )
        ) then
     begin
      '' >>> l_Out
      l_Name .Out
      Bracketed (
       ARRAY VAR l_Items
       anItem
        .filter> ( .NeedOwnFile ! )
        >>> l_Items
       l_Items .filter> ( .Visibility = PrivateAccess ) .for> call.me
       l_Items .filter> ( .Visibility = ProtectedAccess ) .for> call.me
       l_Items .filter> ( .Visibility = PublicAccess ) .for> call.me
       l_Items .filter> ( .Visibility = UnknownAccess ) .for> call.me
      ) // Bracketed
     end
     else
     if (
         ( l_Name = 'Attributes' )
         OR ( l_Name = 'Operations' )
         OR ( l_Name = 'Constants' )
         OR ( l_Name = 'Dependencies' )
         OR ( l_Name = 'Parameters' )
        ) then
     begin
      '' >>> l_Out
      l_Name .Out
      Bracketed (
       ARRAY VAR l_Items
       anItem
        // .filter> ( .NeedOwnFile ! )
        >>> l_Items
       l_Items .filter> ( .Visibility = PrivateAccess ) .for> call.me
       l_Items .filter> ( .Visibility = ProtectedAccess ) .for> call.me
       l_Items .filter> ( .Visibility = PublicAccess ) .for> call.me
       l_Items .filter> ( .Visibility = UnknownAccess ) .for> call.me
      ) // Bracketed
     end
     else
     begin
      l_Out [ anItem .for> ValueToStringOrName ] ' ' strings:CatSep Cat >>> l_Out
     end
    end // anItem IsArray
    else
    begin
     l_Out anItem ValueToStringOrName Cat >>> l_Out
    end // anItem IsArray

    if ( l_Out <> '' ) then
    begin
     l_Out .Out
    end // l_Out <> ''
   ) // [ aCode DO ] .for>
  ) // Self MembersIterator
 ) // Bracketed
; // dump

PROCEDURE OutLn
 '' .Out
; // OutLn

elem_proc 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_proc 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 .GetUP 'intf.pas:Path' >>> l_Path
  RULES
   ( l_Path <> '' )
    ( 'w:\'
      // - the reason is the fact that there is no disc in the path and it is required for the ExtractFileName
      l_Path Cat 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

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

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

elem_proc OutUses:
  ^ IN aUsed
  ^ IN aLambda

 ARRAY VAR l_Used
 aUsed DO >>> l_Used

 ARRAY FUNCTION .filterUsed>
   ARRAY IN anArray
  anArray
  .filter> (
    IN 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> ( .WithComma: l_NeedComma .Out )
   ) // Indented:
 ';' .Out
 OutLn
; // OutUses:

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

ARRAY FUNCTION .joinWithLambded>
  ARRAY IN anArrayToJoin
  ^ IN anArrayToIterate
  ^ IN aLambda

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

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

BOOLEAN elem_func IsInterface
 Cached:
 (
  RULES
   ( Self .IsStereotype st_ObjStub )
    false
   ( Self .IsStereotype st_Facet )
    true
   ( Self .IsStereotype st_Interface )
    true
   DEFAULT
    false
  ; // RULES
 ) 
 >>> Result
; // IsInterface

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 .IsEvdSchemaElement )
    false
   ( Self .IsStereotype st_MixInMirror )
    false
   ( Self .IsStereotype st_UseCase )
    false
   ( Self .IsStereotype st_VCMOperations )
    false
   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
 )
 >>> 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

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

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

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

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

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

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

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

: .With()
  OUTABLE IN aValue
 if ( aValue IsNil ! ) then
  [ '(' aValue ')' ]
; // .With()

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

ModelElement elem_func MethodType
 Cached:
 (
  RULES
   ( Self .IsControlOverride )
    ( Self .MainAncestor call.me )
   ( Self .IsControlPrim )
    ( Self .MainAncestor )
   ( Self .IsStereotype st_method )
    ( 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

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

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 .Name 'a-string' == )
    cConstPrefix
   ( Self .Name 'a-wstring' == )
    cConstPrefix
   ( Self .Name 'object' == )
    cConstPrefix
   ( Self .Name 'void' == )
    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
 Self .Name >>> Result
; // MethodName

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

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

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

OUTABLE elem_func MethodKeyword
 Cached:
 (
  RULES
   ( 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 .IsStaticMethod )
       'class '
     ; // RULES

     if l_IsFunc then
     begin
      'function'
     end // l_IsFunc
     else
     begin
      'procedure'
     end // l_IsFunc
     ]
   ) // DEFAULT
  ; // RULES
 )
 >>> Result
; // MethodKeyword

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

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

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

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

INTEGER elem_func MethodAbstraction
 Self .OpKind CASE
  opkind_Normal
   (
    RULES
     ( Self .ParentIsInterface )
      at_final
     ( Self .IsFunction )
      at_final
     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
 BOOLEAN IN aGetter
         if aGetter then
         begin
          if ( Self .UPisTrue "pm" ) then
           'pm_Get'
          else
           'Get_'
         end
         else
         begin
          if ( Self .UPisTrue "pm" ) then
           'pm_Set'
          else
           'Set_'
         end
 >>> Result
; // MethodNamePrefix

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

CONST opModifyNone 1
CONST opModifySetter 2

elem_iterator MethodInterfacePrim
 IN aOverload
 IN aOfObject
 IN aOpModify

 : OutOverloadAndCallingConventions
  aOverload DO
  Self .MethodCallingConventions
 ; // OutOverloadAndCallingConventions

 : OutReintroduce
  RULES
   ( Self .IsConstructor )
    ( ' reintroduce;' )
   ( Self .IsFactory )
    ( ' reintroduce;' )
  ; // RULES
 ; // OutReintroduce

 [
  RULES
   (
    ( Self .IsWriteonlyProperty )
    AND ( aOpModify opModifySetter != )
   )
    ()
   DEFAULT
    (
     ModelElement VAR l_Type
     Self .MethodType >>> l_Type

     VAR l_IsFunc

     RULES
      ( aOpModify opModifySetter == )
       (
         false >>> l_IsFunc
         'procedure'
       )
      DEFAULT
       (
         ( l_Type IsNil ! ) AND ( l_Type .TypeName IsNil ! ) >>> l_IsFunc
         Self .MethodKeyword
       )
     ; // RULES 

     if ( Self .IsFunction ! ) then
     begin
      ' '

      RULES
       ( Self .IsProperty )
        (
         Self l_IsFunc .MethodNamePrefix
         Self .MethodName
        )
       DEFAULT
        ( Self .MethodName  )
      ; // RULES

     end // ( Self .IsFunction ! )

     VAR l_WasParam
     false >>> l_WasParam

     RULES
      ( 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_Doc
      aParam .FineDocumentation >>> l_Doc
      if ( l_Doc IsNil ! ) then
      begin
       ' ' l_Doc
      end // ( l_Doc IsNil ! )
     ) // Self .MethodParameters .for>

     if ( aOpModify opModifySetter == ) then
     begin
      if ( l_WasParam ) then
      begin
       ';' ' '
      end
      else
      begin
       '('
       true >>> l_WasParam
      end 
      l_Type .InPrefix
      'aValue' ': ' l_Type .TypeName
     end // ( aOpModify opModifySetter == )

     if ( l_WasParam ) then
      ')'

     if l_IsFunc then
     begin
      ': ' l_Type .TypeName
     end // l_IsFunc

     aOfObject DO
     ';'

     Self .MethodAbstraction CASE
      at_final (
       OutReintroduce
       OutOverloadAndCallingConventions
      )
      at_virtual (
       OutReintroduce
       OutOverloadAndCallingConventions
       ' virtual;'
      )
      at_abstract (
       OutReintroduce
       OutOverloadAndCallingConventions
       ' virtual; abstract;'
      )
      at_override
       ' override;'
     END // CASE
    ) // DEFAULT
  ; // RULES

 ] >>> Result
; // 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_iterator MethodInterfaceEx
 IN aOverload
 IN aOfObject

 [
  : NormalCall
    Self aOverload aOfObject opModifyNone .MethodInterfacePrim
  ; // NormalCall

  : CallAsSetter
   Self aOverload aOfObject opModifySetter .MethodInterfacePrim
  ; // CallAsSetter

  RULES
   ( Self .IsReadonlyProperty )
    if ( Self .ReadsField ! ) then
     NormalCall
   ( Self .IsWriteonlyProperty )
    if ( Self .WritesField ! ) then
     CallAsSetter
   ( Self .IsProperty )
    (
     VAR l_NeedLN
     false >>> l_NeedLN

     if ( Self .ReadsField ! ) then
     begin
      true >>> l_NeedLN
      NormalCall
     end
     if ( Self .WritesField ! ) then
     begin
      if l_NeedLN then
       \n
      CallAsSetter
     end // ( Self .WritesField ! )
    )
   DEFAULT
    NormalCall
  ; // RULES
 ]
 >>> Result
; // MethodInterfaceEx

elem_iterator MethodInterfaceEx:
 ^ IN aOverload
 ^ IN aOfObject
 Self aOverload aOfObject .MethodInterfaceEx >>> Result
; // MethodInterfaceEx:

elem_iterator MethodInterface:
  ^ IN aOverload
 Self .MethodInterfaceEx: (
  if ( Self .UPisTrue "force overload" ) then
  begin
   ' overload;'
  end // ( aMethod .UPisTrue "force overload" )
  else
  begin
   aOverload DO
  end
 ) ()
 >>> Result
; // MethodInterface:

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

elem_iterator OwnOperations
 Self .Operations
 .filter> ( .IsStaticMethod ! )
 >>> 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 AllOperationsForOverload
 Cached:
 (
  RULES
   ( Self .IsPureMixIn )
    ( Self .OwnOperations )
   ( Self .IsInterface )
    ( Self .InterfaceOperationsTotal )
   ( Self .IsClassOrMixIn )
    (
      Self .Operations
      .filter> ( .IsStereotype st_responsibility::Operation ! )
      .filter> ( .IsStereotype st_ini::Operation ! )
      .filter> ( .IsStereotype st_fini::Operation ! )
      .join> ( Self .Implemented )
    )
   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_iterator MethodInterfaceFor:
  ^ IN anOperations
 Self .MethodInterface: (
  ARRAY VAR l_Ops
  anOperations DO >>> l_Ops
  if ( l_Ops
       .filter> ( .IsProperty ! )
       .filter> ( .MethodName Self .MethodName == )
       .CountIt > 1 ) then
  begin
   ' overload;'
  end
 ) // Self .MethodInterface:
 >>> Result
; // MethodInterfaceFor:

elem_proc OutProperty
 [
  '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 true .MethodNamePrefix
   end // ( Self .ReadsField )
   Self .MethodName
  ; // OutRead

  : OutWrite
   \n ' ' 'write' ' '
   if ( Self .WritesField ) then
    'f_'
   else
   begin
    Self false .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" )

  ';'

  if ( Self .UPisTrue "is default" ) then
  begin
   \n
   ' default;'
  end // ( Self .UPisTrue "is default" )
 ] .Out? ?
  ( Self .OutDocumentation )
; // OutProperty

elem_iterator Fields
 Self .Attributes
 .filter> ( .IsProperty ! )
 .filter> ( .IsStereotype st_impurity_value::Attribute ! )
 .filter> ( .IsStereotype st_impurity_param::Attribute ! )
 .filter> ( .IsStereotype st_static::Attribute ! )
 >>> Result
; // Fields

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 .Name
  ': '
  Self .Target .TypeName
  ';'
 ] .Out? ? (
  Self .OutDocumentation
 )
; // 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 OutClass
 Self .MixInValues .for> (
   IN aValue
  [ '_' aValue .Name '_' ' = ' aValue .Target .TypeName ';' ] .Out
 )
 [
  Self .TypeName
  ' = '

  Self .Abstraction CASE
   at_abstract
    ( '{abstract}' ' ' )
   at_final
    ( '{final}' ' ' )
  END // CASE

  'class'
  [ Self .MainAncestor ]
  .join> (
   Self .Implements
   .filter> .IsClassImplementable
  )
  .map> .TypeName
  ', ' strings:CatSep
  .With()
 ] .Out

 Self .OutDocumentation

 Indented: (
  Self .Fields .ByVisibility> .Visibility .OutField

  VAR l_AllOps
  Self .AllOperationsForOverload >>> l_AllOps

  Self .AllOperationsForDefine .ByVisibility> .MethodVisibility (
    IN aMethod
   aMethod .MethodInterfaceFor: l_AllOps .Out? ? (
    aMethod .OutDocumentation
   ) // aMethod .MethodInterfaceFor: l_AllOps .Out? ?
  ) // .for>

  Self .Properties .ByVisibility> .Visibility .OutProperty
 ) // Indented:

 [ '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> (
    IN aMethod
   aMethod .MethodInterfaceFor: l_AllOps .Out? ? (
    aMethod .OutDocumentation
   ) // aMethod .MethodInterfaceFor: l_AllOps .Out? ?
  ) // l_Ops .for>
  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 ' = record' ] .Out
 Self .OutDocumentation
 [ 'end;//' Self .TypeName ] .Out
; // OutRecord

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

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

elem_proc OutStaticObject
 [ Self .TypeName ' = object' Self .MainAncestor .TypeName .With() ] .Out
 Self .OutDocumentation
 [ 'end;//' Self .TypeName ] .Out
; // OutStaticObject

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

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 .UnitProducer .UnitName >>> l_OtherUnit
    if ( l_OtherUnit '' != ) then
    begin
     if ( Self .TypeName l_MainAncestor .TypeName == ) then
     begin
      STRING VAR l_OurUnit
      Self .UnitProducer .UnitName >>> 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 .TypeName
  ' = '
  Self .MethodInterfaceEx: () (
   if ( Self .UPisTrue "of object" ) then
   begin
    ' of object'
   end // ( Self .UPisTrue "of object" )
  )
 ] .Out
 Self .OutDocumentation
; // OutFunction

elem_proc OutArray
 if ( Self .GetUP "array type" 'open' != ) 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 .GetUP "array type" 'open' != )
; // 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 .IsStereotype st_ScriptKeywordDocumentation )
   ()
  ( Self .IsStereotype st_ScriptKeywordsDocumentation )
   ()
  ( Self .IsUtilityPack )
   ()
  ( Self .IsInterfaces )
   ()
  ( Self .IsTarget )
   ()
  ( ( Self .IsArray ) AND ( Self .GetUP "array type" 'open' == ) )
   ()
  DEFAULT
   (
    if ( Self g_OutedTypes array:Has ! ) then
    begin
     Self array:AddTo g_OutedTypes
     Self .Forwarded .for> .OutForward
     RULES
      ( Self .IsSetOf )
       ( Self .OutSetOf )
      ( Self .IsArray )
       ( Self .OutArray )
      ( Self .IsEnum )
       ( Self .OutEnum )
      ( 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
    end // ( Self g_OutedTypes array:Has ! )
   ) // DEFAULT
 ; // RULES
; // OutType

BOOLEAN elem_func IsType
 Cached:
 (
  RULES
   ( 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
 [ '//' ' ' Self .Name ] .Out
; // OutConstants

elem_proc OutDefinitionsSection:
  ^ IN aValid

 : Validate aValid DO ;

 Self .OutChildrenRec: Validate (
  .Constants .filter> ( .Visibility PublicAccess == ) .for> .OutConstants
 )

 Self .OutTypes Validate

 Self .OutChildrenRec: Validate (
  .Constants .filter> ( .Visibility ProtectedAccess == ) .for> .OutConstants
 )

; // OutDefinitionsSection:

elem_proc OutInterfaceSection
 Self .OutDefinitionsSection: .IsForInterface
; // OutInterfaceSection

elem_proc OutImplementationSection
 Self .OutDefinitionsSection: .IsForImplementation

 Self .OutChildrenRec: .True (
  .Constants .filter> ( .Visibility PrivateAccess == ) .for> .OutConstants
 )

; // OutImplementationSection

elem_proc OutUnit
 TF g_OutedTypes (
  [ 'unit ' Self .UnitNamePrim ';' ] .Out
  OutLn
  'interface' .Out
  OutLn

  ARRAY VAR l_Used
  [] >>> l_Used

  Self .OutUses: l_Used ( Self .IntfUses )

  Self .OutInterfaceSection

  'implementation' .Out
  OutLn

  Self .OutUses: l_Used ( Self .ImplUses )

  Self .OutImplementationSection

  'end.' .Out
 ) // TF g_OutedTypes
; // OutUnit

elem_proc OutMixIn
 Self .OutUnit
; // OutMixIn

elem_generator pas

 CONST Ext '.pas'

 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 .dump )
 ; // RULES
; // pas

elem_generator res.cmd

 Inherits .pas

 CONST Ext '.res.cmd'

 BOOLEAN FUNCTION NeedOwnFile
   ModelElement IN Self

  Self .UPisTrue "needs script" >>> Result
 ; // NeedOwnFile

 [ 'MakeCo ' Self .Name '.rc.script' ] .Out
 [ 'brcc32 ' Self .Name '.rc' ] .Out
 //call.inherited
; // res.cmd

elem_generator rc

 Inherits .res.cmd

 CONST Ext '.rc'

 [ Self .Name ' RCDATA LOADONCALL MOVEABLE DISCARDABLE ' Self .Name '.rc.script.co' ] .Out
 //call.inherited
; // rc

ARRAY CompileTime-VAR g_GeneratedElements []
%REMARK 'Previously generated elements'

PROCEDURE .GenerateWithChildren
 ModelElement IN Self
 Sequence IN aGenerators

 if ( Self g_GeneratedElements array:Has ! ) then
 begin
  Self array:AddTo g_GeneratedElements
  aGenerators CodeIterator .for> (
  // - cycle on generators for Self
   TtfwWord IN aGenerator
   TF g_CurrentGenerator (
    aGenerator >>> g_CurrentGenerator
    if ( Self .NeedOwnFile ) then
     ( Self .GenerateWordToFile .CurrentGenerator )
    else
     ( Self .DeleteWordFile )
   ) // TF g_CurrentGenerator
  ) // aGenerators CodeIterator .for>

  Self .Children
 //  .filter> ( .NeedOwnFile )
    .for> ( aGenerators call.me )
  // - generates children
 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 The g_GeneratedFiles array not initialized'
 g_GeneratedElements = nil ?FAIL 'The g_GeneratedElements array not initialized'

 Self .call.generators.in.list ( .pas .res.cmd .rc )

; // .Generate

Updated