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