home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / stgenerato.tcl < prev    next >
Encoding:
Text File  |  1997-05-05  |  7.5 KB  |  254 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)stgenerato.tcl    /main/hindenburg/4
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)stgenerato.tcl    /main/hindenburg/4   5 May 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12.  
  13. require stgglobal.tcl
  14.  
  15. set globals [STGGlobal new]
  16.  
  17. # End user added include file section
  18.  
  19. require "generator.tcl"
  20.  
  21. # This class is the entry point of the Smalltalk code generator.
  22.  
  23. Class STGenerator : {Generator} {
  24.     constructor
  25.     method destructor
  26.     method generate
  27.     method generateSpecialFiles
  28.     method sortClasses
  29.     method generateImport
  30.     method generateExport
  31.  
  32.     # The file handler for this generator.
  33.     #
  34.     attribute fileHandler
  35. }
  36.  
  37. constructor STGenerator {class this} {
  38.     set this [Generator::constructor $class $this]
  39.     # Start constructor user section
  40.     $this fileHandler [STFileHandler new]
  41.     # End constructor user section
  42.     return $this
  43. }
  44.  
  45. method STGenerator::destructor {this} {
  46.     # Start destructor user section
  47.     # End destructor user section
  48.     $this Generator::destructor
  49. }
  50.  
  51.  
  52. # Generates for <classList>, see description in class Generator.
  53. #
  54. method STGenerator::generate {this classList} {
  55.     # set header variables
  56.     set cc [ClientContext::global]
  57.     set proj [$cc currentProject]
  58.     set configV [$cc currentConfig]
  59.     set phaseV [$cc currentPhase]
  60.     set systemV [$cc currentSystem]
  61.     if {![$proj isNil] } {
  62.         set projName [$proj name]
  63.     }
  64.     if {![$configV isNil] } {
  65.         set configName [[$configV config] name]
  66.     }
  67.     if {![$phaseV isNil] } {
  68.         set phaseName [[$phaseV phase] name]
  69.     }
  70.     if {![$systemV isNil] } {
  71.         set systemName [[$systemV system] name]
  72.     }
  73.     
  74.     # initialize file handler, type and result variables
  75.     set type [[$this fileHandler] stType]
  76.     set typeToClassDictionary [Dictionary new]
  77.     set classToSection [Dictionary new]
  78.     $typeToClassDictionary set [[$this fileHandler] stType] $classToSection
  79.     set regenerator [STRegenerator new]
  80.     
  81.     # start generation
  82.     $classList foreach class {
  83.         set fileObject [STFile new]
  84.         set implementation [$fileObject getImplementation [$class getSTName]]
  85.         $class generate $implementation
  86.  
  87.         # do regeneration
  88.         $regenerator regenerate $class $fileObject
  89.         
  90.         set text [TextSection new]
  91.  
  92.         # do header 
  93.         set fileName [[$this fileHandler] getFileName $class $type]
  94.         expand_file $text [m4_path_name etc $type.hdr] proj $proj \
  95.             configV [$configV versionNumber] \
  96.             phaseV [$phaseV versionNumber] \
  97.             filename $fileName \
  98.             systemV [$systemV versionNumber]\
  99.             projName $projName \
  100.             configName $configName \
  101.             phaseName $phaseName \
  102.             systemName $systemName
  103.  
  104.         $fileObject generate $text
  105.         
  106.         $classToSection set $class $text
  107.     }
  108.     return $typeToClassDictionary
  109. }
  110.  
  111.  
  112. # Generates special files: the import and/or
  113. # the export file.
  114. # Makes a mapping from class to fileName
  115. # and from class to super class and
  116. # generates the file specified in <fileList>.
  117. #
  118. method STGenerator::generateSpecialFiles {this ooplModel fileList} {
  119.     set classList [List new]
  120.     set classToSuper [Dictionary new]
  121.     set classToFile [Dictionary new]
  122.     
  123.     foreach class [$ooplModel ooplClassSet] {
  124.         if [$class isExternal] {
  125.             continue
  126.         }
  127.         set className [$class getSTName]
  128.         $classList append $className
  129.         
  130.         # get superclass
  131.         set gnodeSet [$class genNodeSet]
  132.         
  133.         if { [llength $gnodeSet] == 0 } {
  134.             $classToSuper set $className "Object"
  135.         } else {
  136.             $classToSuper set $className [[[lindex $gnodeSet 0] superClass]\
  137.                                               getSTName]
  138.         }
  139.         
  140.         $classToFile set $className [[$this fileHandler] getFileName $class\
  141.                                          [[$this fileHandler] stType]]
  142.     }
  143.     
  144.     $fileList foreach specialFile {
  145.         if { [[$this fileHandler] getImportFileName] == $specialFile } {
  146.             puts "Generating import script for all classes"
  147.             $this generateImport $classList $classToSuper $classToFile
  148.         }
  149.         if { [[$this fileHandler] getExportFileName] == $specialFile } {
  150.             puts "Generating export script for all classes"
  151.             $this generateExport $classList $classToFile
  152.         }
  153.     }
  154. }
  155.  
  156.  
  157. # Sorts the classes in <classList> in 
  158. # prefix order. <classToSuper> maps classes to
  159. # their super classes and <classToFile> maps
  160. # classes to file names, these are used during
  161. # the sort process. 
  162. #
  163. method STGenerator::sortClasses {this classList classToSuper classToFile} {
  164.     upvar $classList selectedClasses
  165.     # make class to subs and root classes
  166.     set rootClasses [List new]
  167.     set classToSubs [Dictionary new]
  168.     $classToSuper foreach className superName {
  169.         if { ![$classToSubs exists $superName] } {
  170.             $classToSubs set $superName [List new]
  171.         }
  172.         if { [[$classToSubs set $superName] search $className] == -1 } {
  173.             # if super does not have a file it must be external 
  174.             # and thus a root class
  175.             if { ![$classToFile exists $superName] } {
  176.                 # now get the subclass of the external root class
  177.                 if { [$rootClasses search $className] == -1 } {
  178.                     $rootClasses append $className
  179.                 }
  180.             }
  181.             [$classToSubs set $superName] append $className
  182.         }
  183.     }
  184.     
  185.     # little hack: when an class <Object> was present, 
  186.     # an empty import-file was created. This is corrected
  187.     # by setting rootClasses:
  188.     if { [$rootClasses empty] } {
  189.         $rootClasses append "Object"
  190.     }
  191.     
  192.     # walk the inheritance tree till the leaves and 
  193.     # append every selected class visited
  194.     # yielding the classes in prefix order in newSelectedClasses
  195.     set newSelectedClasses [List new]
  196.     while { ![$rootClasses empty] } {
  197.         set currentClass [$rootClasses index 0]
  198.         if { [$selectedClasses search $currentClass] != -1 } { 
  199.             $newSelectedClasses append $currentClass
  200.         }
  201.         if [$classToSubs exists $currentClass] {
  202.             [$classToSubs set $currentClass] foreach subClass {
  203.                 if { [$rootClasses search $subClass] == -1 } {
  204.                     $rootClasses append $subClass
  205.                 }
  206.             }
  207.         }
  208.         $rootClasses removeValue $currentClass
  209.     }
  210.     set selectedClasses $newSelectedClasses
  211. }
  212.  
  213.  
  214. # Generates the import file: sorts the
  215. # classes in <classList> , creates a section with 
  216. # Smalltalk expression to file in these
  217. # classes and writes the import file.
  218. #
  219. method STGenerator::generateImport {this classList classToSuper classToFile} {
  220.     set importSection [TextSection new]
  221.     set clientContext [ClientContext::global]
  222.     set pathName [[$clientContext currentSystem] path]
  223.     
  224.     $this sortClasses classList $classToSuper $classToFile
  225.     $classList foreach className {
  226.         set fileName [path_name concat $pathName [$classToFile set $className]]
  227.         $importSection append "(Filename named: \'$fileName\') fileIn!\n"
  228.     }
  229.     set fileName [[$this fileHandler] getImportFileName]
  230.     [$this fileHandler] writeSectionToNamedFile $importSection $fileName
  231. }
  232.  
  233.  
  234. # Generates the export file: creates a section
  235. # with Smalltalk expressions to file out
  236. # the classes in <classList> and writes
  237. # the export file.
  238. #
  239. method STGenerator::generateExport {this classList classToFile} {
  240.     set exportSection [TextSection new]
  241.     set clientContext [ClientContext::global]
  242.     set pathName [[$clientContext currentSystem] path]
  243.     
  244.     $classList foreach className {
  245.         set fileName [path_name concat $pathName [$classToFile set $className]]
  246.         $exportSection append "(Filename named: \'$fileName\') fileOutChangesFor: $className!\n"
  247.     }
  248.     set fileName [[$this fileHandler] getExportFileName]
  249.     [$this fileHandler] writeSectionToNamedFile $exportSection $fileName
  250. }
  251.  
  252. # Do not delete this line -- regeneration end marker
  253.  
  254.