#841. Code generation. More cosmetics

Original in Russian: http://programmingmindstream.blogspot.ru/2015/08/blog-post_90.html
The previous series was here – Code generation. Cease to use Addr.

Now here is what we get:

commits.comments.txt

CodeGen65.ms.script

USES
 metaMACRO.ms.dict
 classRelations.ms.dict
 EngineTypes.ms.dict
 Object.ms.dict
;
 
Test CodeGen
 %REMARK
  '
  CodeGen - function to test functionality
  '
 
 %REMARK
  '
  %SUMMARY is meta information that allows binding the documentation to the code elements. Consequently, the documentation is available from the script engine.
  '
 %SUMMARY '
 'That is where we test meta-model building, model building and then code generation.
 '
 ; // %SUMMARY
 
// ---------------------------------------------------------------------------
 
meta-meta-model-begin
 'That is where we determine axiomatic of meta-meta model and extract it in a separate dictionary later.
 '
 
StereotypeStereotypeProducer meta
 %SUMMARY '
 Base element of meta-model determined
 This is the element that allows us to pull the rest “by hair out of the swamp”
 Other primitives are derived from this one
 '
 ; // %SUMMARY 
; // meta
 
meta-meta-model-end
 
// ---------------------------------------------------------------------------
 
// ---------------------------------------------------------------------------
 
meta-model-begin
 'That is where we determine axiomatic of meta model and then separate it
  in a dictionary.
 
  Next we will determine the UML concepts –
  https://en.wikipedia.org/wiki/Unified_Modeling_Language
 
  There are CATEGORIES and CLASSES in it
 
  Actually, they merely differ from each other, however, let it be so 
  for it was so decided by some wise men
 
Let’s start with them:
  '
<<@meta>> UMLCategory
 %SUMMARY '
 Category on UML
 ' 
 ; // %SUMMARY 
; // UMLCategory
 
<<@meta>> UMLClass
 %SUMMARY '
 Class on UML
 ' 
 ; // %SUMMARY 
; // UMLClass
 
meta-model-end
 
// ---------------------------------------------------------------------------
 
// ---------------------------------------------------------------------------
 
concrete-model-begin 'Templates model'
 ' This is where we determine axiomatic of the specific model.
  For now let’s determine axiomatic of “templates model”
  We will separate it in a dictionary later.
 '
 
<<UMLCategory>> Project
 %SUMMARY '
 We probably bump into projects here and there when developing.
 The Project is a stereotype describing our projects.
 '
 ; // %SUMMARY
; // Project
 
<<UMLCategory>> Library
 %SUMMARY '
 We probably bump into design libraries here and there when developing.
 The Library is a stereotype describing our libraries.
 '
 ; // %SUMMARY
; // Library
 
<<UMLCategory>> Program
 %SUMMARY '
 We probably bump into programs here and there when developing.
 The Program is a stereotype describing our programs.
 '
 ; // %SUMMARY
; // Program
 
<<UMLClass>> Class
 %SUMMARY '
 We probably bump into design classes here and there when developing.
 The Class is a stereotype describing our design classes.
 '
 ; // %SUMMARY
; // Class
 
<<UMLClass>> Interface
 %SUMMARY '
 We probably bump into interfaces here and there when developing.
 The Interface is a stereotype describing our interfaces.
 '
 ; // %SUMMARY
; // Interface
 
%REMARK
 '
 Some time later, when we start to use these we will find out whether
 the Library can be embedded in Project and, vise versa, the Project embedded
 in the Library or whether the Program can be embedded in the Class and, vise
 versa, the Class embedded in the Library as well as other relations between stereotypes.
 '
 
model-end
 
// ---------------------------------------------------------------------------
 
// ---------------------------------------------------------------------------
 
concrete-model-begin 'Model of the specific project Project1'
 ' This is where we determine axiomatic of the specific model of the specific project.
  We will separate it in a dictionary later.
 '
<<Project>> Project1
 %SUMMARY '
 This is our first project - Project1
 '
 ; // %SUMMARY
 
 <<Library>> Library1
  %SUMMARY '
  Probably, there are design libraries in our project.
  The Library1 is our first design library.
  '
  ; // %SUMMARY
 ; // Library1
 
 <<Library>> Library2
  %SUMMARY '
  Our project is probably serious enough and has MORE THAN ONE library.
  The Library2 is our second design library.
  '
  ; // %SUMMARY
 ; // Library2
 
 <<Library>> Library3
  %SUMMARY '
  Our project is probably SO serious that it has even MORE THAN TWO libraries.
  The Library3 is our third design library.
  '
  ; // %SUMMARY
 ; // Library3
 
 <<Program>> Program1
  %SUMMARY '
  Our project probably implements some program.
  Otherwise, why would we need it?
  The Program1 is a program in our Project1.
  '
  ; // %SUMMARY
 
  <<Class>> Class1
   %SUMMARY '
  Our program probably has some implementation classes.
  Otherwise, how would we implement our functionality?
  The Class1 is our FIRST implementation class in our Program1.
   '
   ; // %SUMMARY
  ; // Class1
 
  <<Interface>> Interface1
   %SUMMARY '
  Our program is probably SO serious that implements some interfaces.
  The Interface1 is our FIRST interface.
   '
   ; // %SUMMARY
  ; // Interface1
 
  <<Interface>> Interface2
   %SUMMARY '
   Our program is probably SO serious that it implements MORE THAN ONE interface.
  The Interface2 is our second interface.
   '
   ; // %SUMMARY
  ; // Interface2
 
  <<Class>> Class2
   %SUMMARY '
   Our program is probably serious enough and has MORE THAN ONE implementation class.
  The Class2 is our second implementation class in Program1.
   '
   ; // %SUMMARY
   %INHERITS
    Addr Class1
    %REMARK 'Perhaps the design Class2 is inherited from Class1'
   ; // %INHERITS
   %IMPLEMENTS
    Addr Interface1
    %REMARK 'Perhaps the design Class2 implements Interface1'
    Addr Interface2
    %REMARK 'Perhaps the design Class2 implements Interface2, too'
   ; // %IMPLEMENTS
  ; // Class2
 
  <<Class>> Class3
   %SUMMARY '
   Our program is probably so complex that it has even more than TWO implementation classes.
   The Class3 is the THIRD implementation class within the Program1.
   '
   ; // %SUMMARY
  ; // Class3
 
  <<Class>> Class4
   %SUMMARY '
   We are probably so cool that we have even more than THREE implementation classes.
   The Class4 is the FOURTH implementation class within the Program1.
   '
   ; // %SUMMARY
   %INHERITS
    Addr Class2
    Addr Class3
    %REMARK 
     '
   We are probably cool enough to use MULTIPLE INHERITANCE and, moreover, to UNDERSTAND WHY we need it.
   The Class4 is inherited from Class2 and Class3.
     '
   ; // %INHERITS
  ; // Class4
 
 ; // Program1
 
; // Project1
 
%REMARK
 '
  These words should “probably” be based on requirements specification and UseCase.
  Well, we will talk it over later.
 '  
model-end
 
// ---------------------------------------------------------------------------
 
// ---------------------------------------------------------------------------
 
concrete-model-begin 'Model of the specific project Project2'
 ' This is where we determine axiomatic of the specific model of the specific project.
  We will separate it in a dictionary later.
 '
<<Project>> Project2
 %SUMMARY '
 This is our SECOND project - Project2
 '
 ; // %SUMMARY
; // Project2
model-end
 
// ---------------------------------------------------------------------------
 
// ---------------------------------------------------------------------------
 
concrete-model-begin 'Model of the specific project Project3'
 ' This is where we determine axiomatic of the specific model of the specific project.
  We will separate it in a dictionary later.
 '
<<Project>> Project3
 %SUMMARY '
 This is our THIRD project - Project3
 '
 ; // %SUMMARY
; // Project3
model-end
 
// ---------------------------------------------------------------------------
 
USES
 CodeDump.ms.dict
 // - the CodeDump.ms.dict is loaded so we can “see” the DumpElement word
;
 
this.method.addr DumpElement
%REMARK
 '
 - the CodeGen element and its contents are dumped in a standard output device.
   We only do it to debug what we’ve written.
 '
 
help
%REMARK
 '
 The available axiomatic is output to a standard output device.
 We only do it to debug what we’ve written.

 '
 
%REMARK
 '
 Now, what can we do with our project?
 To begin with, let us output its name to a standard device.
 '
 
// ---------------------------------------------------------------------------
%REMARK 'All this staff is needed to be separated to a dictionary later'
 
ENGINE_WORD TYPE ModelElement
%REMARK 'Model’s element'
 
PROCEDURE do_elem_func
 STRING IN aName
 ENGINE_WORD IN aSelf
 ENGINE_WORD IN aModifier
 %SUMMARY 'Implementation of do_elem_func, elem_proc and elem_generator' ;
 aSelf Ctx:SetWordProducerForCompiledClass
 axiom:PushSymbol :
 aName Ctx:Parser:PushLeftDottedSymbol
 axiom:PushSymbol ModelElement
 if ( aModifier =/= nil ) then
  ( aModifier .Name Ctx:Parser:PushSymbol )
 axiom:PushSymbol in
 'Self' Ctx:Parser:PushSymbol
; // do_elem_func
 
MACRO elem_func
 Literal IN aName
 %SUMMARY 'Function on model element' ;
 aName .Name this.method.addr nil do_elem_func
; // elem_func
 
PROCEDURE do_elem_proc
 STRING IN aName
 ENGINE_WORD IN aSelf
 ENGINE_WORD IN aModifier
 %SUMMARY 'Implementation of elem_proc and elem_generator' ;
 Ctx:ClearTypeInfo
 axiom:PushSymbol VOID
 aName aSelf aModifier do_elem_func
; // do_elem_proc
 
MACRO elem_proc
 Literal IN aName
 %SUMMARY 'Procedure on model’s element' ;
 aName .Name this.method.addr nil do_elem_proc
; // elem_proc
 
MACRO elem_generator
 Literal IN aName
 %SUMMARY 'Element content generator';
 aName .Name this.method.addr nil do_elem_proc
; // elem_generator
 
MACRO elem_ref_proc
 Literal IN aName
 %SUMMARY 'Procedure on model’s element passed by reference';
 aName .Name this.method.addr Addr LVALUE_MOD do_elem_proc
; // elem_ref_proc
 
BOOLEAN elem_func IsSummary
 %SUMMARY 
 '
  Defines aWord as the documentation for the element
 '
 ; // %SUMMARY
 ( Self .Name ) = '%SUM' =: Result
; // IsSummary
 
BOOLEAN elem_func IsModelElement
 %SUMMARY 
 '
  Defines aWord as the element of the model
 '
 ; // %SUMMARY
 '<<' Self %ST .Name StartsStr 
 AND
 ( '>>' Self %ST .Name EndsStr )
  =: Result
 //NOT ( Self .IsSummary )
  //=: Result
; // IsModelElement
 
ARRAY elem_func Children
 %SUMMARY 
 '
 Returns child iterator aWord in terms of the specific model
 '
 ;
 ( Self MembersIterator ) >filter> .IsModelElement =: Result
; // Children
 
ARRAY elem_func Parents
 %SUMMARY 
 '
 Returns parent iterator aWord in terms of the specific model
 '
 ;
 ( Self LIST %P ) >filter> .IsModelElement =: Result
; // Parents
 
INTEGER VAR g_Indent
%REMARK 'Current indent'
g_Indent := 0
 
BOOLEAN elem_func IsElementNeedIndent
 %SUMMARY 'Defines that the indent is needed' ;
 true =: Result
; // IsElementNeedIndent
 
elem_proc EnterElement
 %SUMMARY 'Begins element output';
 Self .IsElementNeedIndent ? INC g_Indent
; // EnterElement
 
elem_proc LeaveElement
 %SUMMARY 'Ends element output';
 Self .IsElementNeedIndent ? DEC g_Indent
; // LeaveElement
 
FILE VAR g_OutFile
g_OutFile := nil
 
STRING INTEGER ARRAY TYPE PRINTABLE
 
PROCEDURE OutToFile
 PRINTABLE IN aValue 
 %SUMMARY 
 '
 Outputs the value to the current output file and returns the carriage.
 '
 ; // %SUMMARY 
 
 STRING VAR l_String
 if ( aValue IsArray ) then
  ( aValue strings:Cat =: l_String )
 else
  ( aValue ToPrintable =: l_String )
 [ g_Indent ' ' char:Dupe l_String ] strings:Cat g_OutFile File:WriteLn
 %REMARK '- outputs model’s elements to file instead of a standard device.'
; //OutToFile
 
FUNCTOR TYPE GENERATOR
%REMARK 'Element content generator'
 
GENERATOR VAR g_CurrentGenerator
%REMARK 'Current generator'
g_CurrentGenerator := nil
 
elem_proc Child.CallCurrentGen
 %SUMMARY 'Calls generator aGen on a CHILD element with indents' ;
 Self .EnterElement 
 TRY
  Self g_CurrentGenerator DO
  %REMARK 'Calls generator g_CurrentGenerator'
 FINALLY
  Self .LeaveElement 
 END // TRY..FINALLY
; // Child.CallCurrentGen
 
elem_proc CallChildrenCurrentGen
 %SUMMARY 'Calls the current generator for all children of the model’s element' ;
 for ( Self .Children ) .Child.CallCurrentGen
; // CallChildrenCurrentGen
 
CONST GEN_PROPERTY_PREFIX 'gp'
%REMARK 'Prefix for generator property name'
 
MACRO %GEN_PROPERTY
 Literal IN aName
 %SUMMARY 'Generator property' ;
 this.method.addr Ctx:SetWordProducerForCompiledClass
 axiom:PushSymbol CONST
 GEN_PROPERTY_PREFIX (+) ( aName .Name ) Ctx:Parser:PushSymbol
; // %GEN_PROPERTY
 
USES
 RefDeepest.ms.dict
;
 
REF operator FieldByNameDeepest
 LVALUE aSelf
 Literal IN aName
 %SUMMARY 'The method of getting the embedded word member by name considering that a reference to the variable can be passed' ;
 
 ENGINE_WORD VAR l_Self
 aSelf GetRefDeepestFromLeft =: l_Self
  
 STRING VAR l_Name
 aName .Name =: l_Name
  
 OBJECT VAR l_Res
 l_Self %% l_Name =: l_Res
  
 ASSURE 
  NOT ( l_Res pop:object:IsNil ) 
  ['No field found: ' l_Self LIST %P Reverted ==> ( .Name '::' ) l_Self .Name '::' l_Name ]
 l_Res =: Result
; // FieldByNameDeepest
 
MACRO %GP
 Literal IN aName
 %SUMMARY 'The method of getting the generator properties' ;
 axiom:PushSymbol FieldByNameDeepest
 GEN_PROPERTY_PREFIX (+) ( aName .Name ) Ctx:Parser:PushSymbol
; // %GP
 
STRING FUNCTION OutFileName
 STRING right aGeneratorName
 %SUMMARY 'File name for output' ;
 STRING VAR l_OutPath
 %REMARK 'Output path'
 sysutils:GetCurrentDir =: l_OutPath
 [ l_OutPath 
  script:FileName 
  %REMARK 'Path to the current script'
  sysutils:ExtractFileName
  %REMARK 'Extracts the file name from the path'
  '' sysutils:ChangeFileExt
  %REMARK Remove .script'
  '' sysutils:ChangeFileExt 
  %REMARK Remove .ms'
 ] '\' strings:CatSep =: l_OutPath
 l_OutPath sysutils:ForceDirectories ?ASSURE ['Failed to create directory' l_OutPath ]
 %REMARK 'Creates directory recursively, if there is none'
 [ l_OutPath aGeneratorName ] '\' strings:CatSep =: Result
; // OutFileName
 
STRING VAR g_CurrentGeneratorName
%REMARK 'Name of the current generator'
g_CurrentGeneratorName := ''
 
elem_proc CallGen
 GENERATOR RIGHT IN aGen
 
 %SUMMARY 
 '
 Calls aGen generator on the element and opens the “right files".
 ' 
 ; // %SUMMARY 
 
 aGen %GP Name =: g_CurrentGeneratorName
 g_OutFile := ( OutFileName ( Self .Name (+) '.' (+) g_CurrentGeneratorName ) File:OpenWrite )
 TRY
  g_CurrentGenerator := ( aGen GetRefDeepestFromLeft )
  TRY
   g_CurrentGenerator .Name Print
   Self ( aGen GetRefDeepestFromLeft DO )
   %REMARK  Calls aGen generator on the element'
  FINALLY
   g_CurrentGenerator := nil
  END // TRY..FINALLY
 FINALLY
  g_OutFile := nil
 END // TRY..FINALLY
; // CallGen
 
PROCEDURE CallGens
 ARRAY IN anElements
 ARRAY IN aGenerators
 %SUMMARY 'Calls specific generators on array elements anElements';
 for anElements (
  ModelElement IN anElement
  for aGenerators ( 
   GENERATOR IN aGen 
   anElement .CallGen aGen
   %REMARK 'Calls generator aGen on the element anElement'
  ) // for aGenerators
 ) // for anElements
; // CallGens
 
PROCEDURE CallGensList
 Sequence LVALUE anElements
 Sequence LVALUE aGenerators
 ( anElements CodeIterator )
  ( aGenerators CodeIterator )
   CallGens
; // CallGensList
 
// ---------------------------------------------------------------------------
 
elem_proc DumpAsIs
 %SUMMARY 
 '
 Printing procedure for model element content, recursively.
 '
 ; // %SUMMARY
 
 [
  g_CurrentGeneratorName ':'
   %REMARK 'Outputs the name of the current generator for debugging'
  for ( Self LIST %ST Reverted ) .Name
   %REMARK 'Outputs the stereotype of the element, recursively'
  Self .Name 
   %REMARK 'Outputs the element name'
 ] ' ' strings:CatSep OutToFile
 [
  'Parents of the element '
  for ( Self .Parents >reverted> ) .Name
  %REMARK 'Outputs the parents of the element, recursively'
 ] '::' strings:CatSep OutToFile
 TRY
  Self .CallChildrenCurrentGen
  %REMARK 'Outputs the element’s children with the same generator'
 FINALLY
  [ '; // ' Self .Name ] OutToFile
  %REMARK 'Outputs the closing bracket of the element'
 END
; // DumpAsIs
 
elem_generator dump
 %SUMMARY 'Output generator for of the model’s element’s dump.' ;
 %GEN_PROPERTY Name 'dump'
 %REMARK 'Generator name and file extension for target language. Later, we try to avoid coincidence'
 
 Self .DumpAsIs
 %REMARK 'For now, outputs “as it is” without transformation to target language'
; // dump
 
elem_generator pas
 %SUMMARY 'Generator to output model’s elements to Pascal.' ;
 %GEN_PROPERTY Name 'pas'
 %REMARK 'Generator name and file extension for target language. Later, we try to avoid coincidence'
 
 Self .DumpAsIs
 %REMARK 'For now, outputs “as it is” without transformation to target language'
; // pas
 
elem_generator c++
 %SUMMARY '
'Generator to output model’s elements on c++. 
 Later we will specially talk about *.h files.
 ' ;
 %GEN_PROPERTY Name 'cpp'
 %REMARK 'Generator name and file extension for target language. Later, we try to avoid coincidence'
 
 Self .DumpAsIs
 %REMARK 'For now, outputs “as it is” without transformation to target language'
; // c++
 
elem_generator h
 %SUMMARY '
'Generator to output model’s elements to *.h. 
 Later we will specially talk about *.h files.
 ' ;
 %GEN_PROPERTY Name 'h'
 %REMARK 'Generator name and file extension for target language. Later, we try to avoid coincidence'
 
 Self .DumpAsIs
 %REMARK 'For now, outputs “as it is” without transformation to target language'
; // h
 
( Project1 Project2 Project3 )
%REMARK 'Full list of root elements (projects)'
 ( .dump .pas .c++ .h )
 %REMARK 'Full list of generators'
  CallGensList
  %REMARK '- launches the list of generators on the model’s “root elements” list'
 
; // CodeGen
 
CodeGen