Wiki
Clone wikiMindStream / 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
#!delphi 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