'From Squeak3.2alpha of 8 October 2001 [latest update: #4418] on 16 October 2001 at 4:21:09 pm'! "Change Set: Modules core Date: 12 September 2001 Author: Henrik Gedenryd This is the start for a Module system, based on Dan Ingalls' Environments code. The core is in the category System-Modules, it is rather small. Note that this is for now a 'weak' module scheme that allows the standard scheme using #Smalltalk to continue working like before. After filing in all change sets, in the Explorer that opens on the module hierarchy, try: Module convertSystemOrganizationToModules. (Note that this is installs 'weak modules' and is irreversible.) Then FromVersion0p0000to0001 run This applies a first set of refactorings of the system, based on a reusable framework for applying (and contributing!!) refactorings. You can also try Module root declareExternalRefs Now look at the externalModuleRefs of various modules (use the opened Explorer). Then try the messages in the ModuleExplorer on different modules. Use exploreIt or printIt to get the results that are returned from them. "! Object subclass: #Module instanceVariableNames: 'version parentModule neighborModules definedNames exportedNames repository ' classVariableNames: 'OutOfScopeCache RootModule SmalltalkModule ' poolDictionaries: '' category: 'System-Modules'! !Module commentStamp: '' prior: 0! All "neighbor modules"--external modules, submodules, module parameters, delta modules--are held in an OrderedCollection to strictly define the order of lookup for names defined outside this module. "The period between 23 July and 23 August is nicknamed 'RūtmŌnad' - literally 'rotting month', but also referred to as 'dog days', when food rots quicker than usual (...) In damp, warm weather, bacteria thrive. If you hurt yourself, the wound is more likely to become infected than usual. In the old days, this particular month was known as a time when anything could happen. People thought for instance that calves could be born with two heads. Such strange occurences became known as 'rotting-month events'." ! ]style[(715 58 1)f1,f1Rhttp://www.inv.se/svefa/tradition/engtrad/engrotmanad.html;,f1! Object subclass: #ModuleReference instanceVariableNames: 'module name specifiedVersion importNames ' classVariableNames: '' poolDictionaries: '' category: 'System-Modules'! !ModuleReference commentStamp: '' prior: 0! I and my subclasses are used to declare modules' neighbor modules: external modules, parameter modules, submodules and delta modules. module Module or Array -- the other module, or its path name Symbol or nil -- an alias used for the module within the present module specifiedVersion VersionSpecification -- the version specified importNames Boolean -- should the module's defined names be available as if they were defined in the present module, ie. without requiring qualified references? I may declare a module before it has been loaded. Then my module variable holds the path of the Module object until that object has been created. ! ModuleReference subclass: #ModuleParameter instanceVariableNames: 'defaultModule ' classVariableNames: '' poolDictionaries: '' category: 'System-Modules'! !ModuleParameter commentStamp: '' prior: 0! I represent module parameters. If a module takes a module parameter, the parameter can be instantiated to different values, i.e. different external modules can be bound to a name.! ModuleReference subclass: #SubmoduleReference instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Modules'! !SubmoduleReference commentStamp: '' prior: 0! A submodule is considered "part" of its parent module, i.e. as belonging to its parent in a part-whole relation. Every module (except the root module) must be the submodule of another module (its parentModule). This gives all modules a location in the module hierarchy and thereby also a unique identifier, which is its module path. In this way, submodule relations are used to structure the module system. The name instVar of a SubmoduleReference cannot be nil, since it is used to give the submodule its name and thereby its path.! Module subclass: #TransitionalSmalltalkModule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Modules'! Module subclass: #VirtualRootModule instanceVariableNames: 'cachedClassNames ' classVariableNames: '' poolDictionaries: '' category: 'System-Modules'! !VirtualRootModule commentStamp: '' prior: 0! This is the special Module that is the virtual root of the whole Module hierarchy. This is based on the notion of a "virtual module hierarchy". The idea is to use a single, shared "virtual" Module hierarchy for all Squeak modules, so that all Squeak modules will have unique "canonical" names. This does not mean that all modules need to physically reside in the same place (hence a "virtual" hierarchy). For instance, if Company X wants to set up its own private server which no one else can access, they can do so, but the module tree at this server will still have a special place in the virtual hierarchy. They get this place by simply reserving e.g. the Module #(com CompanyX) in the registry for the virtual hierarchy. Thus a top-level ModuleY that they develop will have the "canonical" name #(com CompanyX ModuleY) Hence there will not be a name clash if someone else develops a module having the name ModuleY. This class also has the unrewarding role of superseding Smalltalk in the role of a global namespace. Thus old-style messages to Smalltalk in that role should be rerouted to the Root module. Even when global names haven't been moved into modules, there should be a Root module installed to handle things properly.! !Class methodsFor: 'compiling' stamp: 'hg 8/30/2001 18:23'! definesName: varName lookInSuper: lookInSuper ifTrue: assocBlock "Look up the first argument, varName, in the the receiver. If it is there, pass the association to the second argument, assocBlock, and answer true." | assoc | "First look in classVar dictionary." (assoc _ self classPool associationAt: varName ifAbsent: []) == nil ifFalse: [assocBlock value: assoc. ^ true]. "Next look in shared pools." self sharedPools do: [:pool | assoc _ pool associationAt: varName ifAbsent: [ "String key hack from Hypersqueak now used in Wonderland **Eliminate this**" pool associationAt: varName asString ifAbsent: []]. assoc ifNotNil: [ assocBlock value: assoc. ^true]]. "Finally look higher up the superclass chain if appropriate, and fail at the end." (lookInSuper and: [superclass notNil]) ifTrue: [^ superclass definesName: varName lookInSuper: true ifTrue: assocBlock]. ^false! ! !Class methodsFor: 'compiling' stamp: 'hg 10/1/2001 20:39'! lenientScopeHas: varName ifTrue: assocBlock "the standard mode when working with code for now" (self strongScopeHas: varName ifTrue: assocBlock) ifTrue: [^true]. "Look it up in smalltalk. This is a compatibility patch for now." Module smalltalk associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]. ^false ! ! !Class methodsFor: 'compiling' stamp: 'hg 9/8/2001 21:38'! strongScopeHas: varName ifTrue: assocBlock "Like the regular scopeHas but this one always uses the lookup rules for strong modularity. Use this to e.g. check code from modularity point of view when under weak modules scheme. " self definesName: varName lookInSuper: true ifTrue: [:a | assocBlock value: a. ^ true]. "Next ask home module to look up name." self module associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]. ^false! ! !Class methodsFor: 'compiling' stamp: 'hg 10/3/2001 19:10'! weakScopeHas: varName ifTrue: assocBlock "Like the regular scopeHas but this one always uses the lookup rules for weak modularity. I.e. see all names exported from all external and submodules. " | assoc | self definesName: varName lookInSuper: true ifTrue: [:a | assocBlock value: a. ^ true]. "Next ask home module to look up name. Treat all neighbors as imported. " assoc _ self module localAssocFor: varName ifAbsent: [ "look in all external and submodules." self module neighborModules do: [:mod | mod exportedAssocFor: varName ifPresent: [:a :m | assocBlock value: a. ^ true]]. nil]. assoc ifNotNil: [assocBlock value: assoc. ^true]. "Finally look it up globally. This is a compatibility patch for now. Look it up this way instead of in Smalltalk to test multiple name definitions. " "Module root associationFor: varName ifPresent: [:a :mod | assocBlock value: a. ^ true]. " ^false! ! !Class methodsFor: 'organization' stamp: 'hg 9/30/2001 16:27'! module ^module ifNil: [Module smalltalk]! ! !Class methodsFor: 'organization'! module: mod module _ mod! ! !MethodReference methodsFor: 'queries' stamp: 'hg 9/2/2001 22:05'! printOn: aStream aStream nextPutAll: (self actualClass printString, '>>', self methodSymbol)! ! !Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 18:25'! annotationAt: aString ^self annotations at: aString! ! !Module methodsFor: 'accessing' stamp: 'hg 9/24/2001 18:39'! annotationAt: aString ifAbsent: aBlock ^self annotations at: aString ifAbsent: aBlock! ! !Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 19:29'! annotationAt: aString put: value annotations _ self annotations at: aString put: value; yourself! ! !Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 19:22'! annotations ^annotations ifNil: [Dictionary new]! ! !Module methodsFor: 'accessing' stamp: 'hg 9/21/2001 12:25'! classNames "Answer a SortedCollection of all class names." | names | names _ OrderedCollection new. self allClassesDo: [:class | names add: class name]. ^names asSortedCollection! ! !Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 18:26'! definedNames ^definedNames ifNil: [IdentityDictionary new]! ! !Module methodsFor: 'accessing' stamp: 'hg 9/3/2001 18:52'! exportedNames ^exportedNames ifNil: [IdentityDictionary new]! ! !Module methodsFor: 'accessing' stamp: 'hg 8/20/2001 19:07'! parentModule ^parentModule! ! !Module methodsFor: 'accessing' stamp: 'hg 9/27/2001 23:06'! repository "If I don't have an explicit repository, create an implicit one on request." ^repository ifNil: [Repository implicitOn: self]! ! !Module methodsFor: 'accessing' stamp: 'hg 8/22/2001 21:56'! repository: aRepository repository _ aRepository! ! !Module methodsFor: 'accessing' stamp: 'hg 8/20/2001 17:01'! species ^Module! ! !Module methodsFor: 'accessing' stamp: 'hg 9/28/2001 00:26'! verbatimRepository ^repository! ! !Module methodsFor: 'testing' stamp: 'hg 9/28/2001 15:06'! < other "sort modules in their breadth-first traversal order" | siblings | ^(self parentModule == other parentModule and: [ siblings _ self parentModule submodules. (siblings indexOf: self) < (siblings indexOf: other)]) or: [self parentModule < other parentModule]! ! !Module methodsFor: 'testing' stamp: 'hg 9/28/2001 15:07'! <= other "sort modules in their breadth-first traversal order" ^self == other or: [self < other]! ! !Module methodsFor: 'testing' stamp: 'hg 9/27/2001 19:14'! conflictsWith: otherModule "can this module not be active at the same time as otherModule?" ^false! ! !Module methodsFor: 'testing' stamp: 'hg 9/25/2001 14:41'! exportsName: aString ^self exportedNames includesKey: aString asSymbol! ! !Module methodsFor: 'testing' stamp: 'hg 9/25/2001 15:17'! hasNeighborModule: module ^self neighborModules includes: module! ! !Module methodsFor: 'testing' stamp: 'hg 9/25/2001 15:15'! importCreatesCircularity: module ^module = self or: [ module importedModules anySatisfy: [:mod | self importCreatesCircularity: mod]]! ! !Module methodsFor: 'testing' stamp: 'hg 10/10/2001 15:19'! isActive "for now, regular modules are always active" ^true! ! !Module methodsFor: 'testing' stamp: 'hg 10/10/2001 18:15'! shouldExportDeltaModules "should delta modules be exported by default?" ^false! ! !Module methodsFor: 'testing' stamp: 'hg 9/10/2001 10:22'! shouldExportExternalModules "should external modules be exported by default?" ^false! ! !Module methodsFor: 'testing' stamp: 'hg 9/10/2001 10:23'! shouldExportSubmodules "should submodules be exported by default?" ^false! ! !Module methodsFor: 'initializing' stamp: 'hg 9/3/2001 18:21'! initialize ! ! !Module methodsFor: 'initializing' stamp: 'hg 9/25/2001 12:55'! version: versionFloatOrNil version _ versionFloatOrNil. ! ! !Module methodsFor: 'initializing' stamp: 'hg 9/25/2001 12:50'! version: versionFloatOrNil parentModule: parent parentModule _ parent. version _ versionFloatOrNil. ! ! !Module methodsFor: 'module name and path' stamp: 'hg 9/25/2001 17:48'! longName "concatenate all the local names of the path" ^self pathAsMessages copyWithoutAll: ' '! ! !Module methodsFor: 'module name and path' stamp: 'hg 9/25/2001 14:52'! name | name | name _ parentModule ifNotNil: [ (parentModule refForNeighborModule: self) doIfNotNil: [:refToMe | refToMe name]]. ^name ifNil: ['bad parent, #' , self hash printString] ! ! !Module methodsFor: 'module name and path' stamp: 'hg 9/25/2001 16:46'! path "Return my full path in the virtual Module hierarchy, without version. Note that this is an Array of symbols. " | path | path _ parentModule ifNotNil: [parentModule pathTo: self]. ^path ifNil: [#('stray-Module') copyWith: self name] ! ! !Module methodsFor: 'module name and path' stamp: 'hg 9/10/2001 19:29'! pathAndVersion "Return my full path in the virtual Module hierarchy, with the version last as a float. Note that this is an Array of literals. " ^self path copyWith: self version! ! !Module methodsFor: 'module name and path' stamp: 'hg 9/25/2001 15:05'! pathAsMessages "return the path as the source code for a sequence of messages to refer to me. eg. #(Morphic Cat1) --> 'Morphic Cat1'" ^(self privateSimplifiedPath inject: '' into: [:messages :sym | messages, sym, ' ']) allButLast. ! ! !Module methodsFor: 'module name and path' stamp: 'hg 9/25/2001 16:30'! pathTo: module ^(self refForNeighborModule: module) doIfNotNil: [:refToModule | self path copyWith: refToModule name]! ! !Module methodsFor: 'module name and path' stamp: 'hg 9/23/2001 16:18'! simulatedCategory "build a category from the simplified path" | cat | cat _ self privateSimplifiedPath inject: '' into: [:catString : localName | catString, localName, '-']. ^cat isEmpty ifTrue: [cat] ifFalse: [cat allButLast asString]! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 9/30/2001 16:25'! allClassesDo: aBlock "Evaluate the argument, aBlock, for each class in this module." self definedNames valuesDo: [:value | (value isBehavior) ifTrue: [aBlock value: value]] ! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 8/31/2001 13:02'! associationFor: aString ifAbsent: aBlock self associationFor: aString ifPresent: [:assoc :mod | ^assoc]. ^aBlock value! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 9/5/2001 18:46'! associationFor: aString ifPresent: aBlock "look up definition for the given symbol, and proceed into imported modules. If found, evaluate aBlock for assoc and defining module. Use this message to look up names available to code defined inside this module." | assoc | assoc _ self localAssocFor: aString ifAbsent: [ self importedAssocFor: aString ifPresent: [:ass :mod | aBlock value: ass value: mod. ^ass]. ^nil]. aBlock value: assoc value: self. ^assoc! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 10/9/2001 12:32'! definitionFor: aString ifAbsent: aBlock ^(self associationFor: aString ifAbsent: [^aBlock value]) value! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 8/31/2001 13:06'! doesNotUnderstand: aMessage "emulate uppercase accessor messages for exports" self exportedAssocFor: aMessage selector ifPresent: [:ass :mod | ^ass value]. ^super doesNotUnderstand: aMessage ! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 9/5/2001 18:47'! exportedAssocFor: aString ifPresent: aBlock "look up definition for the given symbol, and proceed into imported modules. If found, evaluate aBlock for assoc and defining module. Use this message to look up names available from outside this module." | assoc | assoc _ self localExportedAssocFor: aString asSymbol ifAbsent: [ self importedAssocFor: aString ifPresent: [:ass :mod | aBlock value: ass value: mod. ^ass]. ^nil]. aBlock value: assoc value: self. ^assoc! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 8/31/2001 11:45'! importedAssocFor: aString ifPresent: aBlock self importedModulesDo: [:module | module exportedAssocFor: aString ifPresent: [:ass :mod | aBlock value: ass value: mod. ^ass]]. ^nil! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 9/5/2001 18:47'! localAssocFor: aString ifAbsent: aBlock "look up assoc for the given name. only look locally in this module" ^self definedNames associationAt: aString asSymbol ifAbsent: aBlock ! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 9/5/2001 18:49'! localExportedAssocFor: aString ifAbsent: aBlock "look up assoc for the given name. only look at exported names defined in this module" ^self exportedNames associationAt: aString asSymbol ifAbsent: aBlock ! ! !Module methodsFor: 'accessing defined names' stamp: 'hg 10/1/2001 19:41'! qualifiedPrefixForName: aName andValue: aValue "return a string with the messages that need to precede aName in a fully qualified reference to aName from this module. Need aValue to handle multiple definitions" | ref first definingModule | first _ true. "Check if defined locally." (self localAssocFor: aName ifAbsent: [nil]) doIfNotNil: [:assoc | assoc value == aValue ifTrue: [^''] ifFalse: [first _ false]]. ref _ self neighborModuleRefs detect: [:aRef | aRef module exportedAssocFor: aName ifPresent: [:assoc :mod | assoc value = aValue ifTrue: [definingModule _ mod] ifFalse: [first _ false]]. definingModule notNil] ifNone: [ "If weak modules and first found name is correct, then just return blank." Preferences strongModules ifFalse: [ Module root associationFor: aName ifPresent: [:assoc :mod | assoc value = aValue ifTrue: [^'']]]. self error: 'Out of scope reference']. ref importNames & first ifTrue: [^'']. "no prefix needed for first imported occurrence" ^ref hasAlias ifTrue: [ref alias asString] ifFalse: [ref module pathAsMessages] ! ! !Module methodsFor: 'changing defined names' stamp: 'hg 10/9/2001 13:23'! addAssoc: assoc export: exportIt [definedNames _ self definedNames add: assoc; yourself] on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true]. exportIt ifTrue: [self exportName: assoc key]. self invalidateCaches ! ! !Module methodsFor: 'changing defined names' stamp: 'hg 9/25/2001 14:42'! changeName: oldName to: newName forValue: value self redefineName: newName as: value export: (self exportsName: oldName). self removeName: oldName. "with weak modules, retain compatibility by also renaming value in Smalltalk" (Preferences strongModules not and: [Module smalltalk notNil]) ifTrue: [ Module smalltalk changeName: oldName to: newName forValue: value]! ! !Module methodsFor: 'changing defined names' stamp: 'hg 10/2/2001 21:18'! defineName: aString as: value export: exportIt self localAssocFor: aString ifAbsent: [ ^self redefineName: aString as: value export: exportIt]. self notify: aString asText allBold, ' already defined in ', self pathAsMessages, '!!\Proceed will overwrite it.' withCRs ! ! !Module methodsFor: 'changing defined names' stamp: 'hg 9/25/2001 14:41'! exportName: aString | assoc | (self exportsName: aString) ifFalse: [ assoc _ self definedNames associationAt: aString asSymbol. exportedNames _ self exportedNames add: assoc; yourself]! ! !Module methodsFor: 'changing defined names' stamp: 'hg 10/1/2001 13:11'! moveName: oldName toModule: newModule | value export | value _ definedNames at: oldName. export _ self exportsName: oldName. self removeName: oldName. newModule defineName: oldName as: value export: export. (value respondsTo: #module:) ifTrue: [value module: newModule]. self invalidateCaches ! ! !Module methodsFor: 'changing defined names' stamp: 'hg 10/12/2001 20:20'! redefineName: aString as: value export: exportIt aString first isUppercase ifFalse: [ self notify: 'Global names should be Capitalized, but "', aString asText allBold, '" is not. This could cause various problems. Cancel unless you want to create this lowercase global name.']. self addAssoc: (aString asSymbol)->value export: exportIt. "with weak modules, retain compatibility by also putting globals in Smalltalk" (Preferences strongModules not and: [Module smalltalk notNil and: [(value isKindOf: Module) not]]) ifTrue: [ Module smalltalk redefineName: aString as: value export: false]! ! !Module methodsFor: 'changing defined names' stamp: 'hg 10/9/2001 17:56'! removeName: aString "with weak modules, retain compatibility by also removing value from Smalltalk" (Preferences strongModules not and: [Module smalltalk notNil and: [ (Module smalltalk definitionFor: aString ifAbsent: [nil]) == (self definitionFor: aString ifAbsent: [nil])]]) ifTrue: [ Module smalltalk removeName: aString]. self definedNames removeKey: aString asSymbol. self exportedNames removeKey: aString asSymbol ifAbsent: []. self invalidateCaches ! ! !Module methodsFor: 'changing defined names' stamp: 'hg 10/2/2001 21:11'! validateName: aString forValue: anObject "Validate the name for a new binding" | oldAssoc defModule | aString first isUppercase ifFalse:[ self error: 'The name must be capitalized'. ^false]. oldAssoc _ self localAssocFor: aString ifAbsent:[nil]. oldAssoc ifNil: [ "check if name already used in a different module" Module root allDefinitionsFor: aString detect: [:v :m | defModule _ m. true]. defModule ifNotNil: [ self notify: 'The name ', aString asText allBold, ' is already defined in module ', defModule pathAsMessages, '.\Proceed will create a second definition with this name.' withCRs]] ifNotNil: [ "don't protest if e.g. the new value is a new class and the old value was a class too" (oldAssoc value isKindOf: anObject class) ifFalse: [ self notify: 'The name ', aString asText allBold, ' is already used in module ', self pathAsMessages, '!!\Proceed will store over it.' withCRs]]. ^true! ! !Module methodsFor: 'module definition protocol' stamp: 'hg 10/11/2001 09:29'! deltaModuleOn: baseModule alias: aString version: versionOrNil importNames: shouldImport "use this message to declare that this module has a delta module" | ref symOrNil | symOrNil _ aString ifNotNil: [aString asSymbol]. ref _ DeltaModuleReference new in: self name: symOrNil version: versionOrNil baseModule: baseModule import: shouldImport. self addNeighborModule: ref export: self shouldExportDeltaModules. ^ref module ! ! !Module methodsFor: 'module definition protocol' stamp: 'hg 9/25/2001 14:46'! externalModule: module alias: aString version: versionOrNil importNames: shouldImport "use this message to declare that this module depends on an external module" | ref symOrNil | symOrNil _ aString ifNotNil: [aString asSymbol]. ref _ ModuleReference new name: symOrNil version: versionOrNil module: module import: shouldImport. self addNeighborModule: ref export: self shouldExportExternalModules. ^module ! ! !Module methodsFor: 'module definition protocol' stamp: 'hg 9/25/2001 14:46'! parameterModuleWithDefault: moduleOrNil version: versionOrNil alias: moduleName importNames: shouldImport "use this message to declare a module parameter. Set its module value to the default." | ref | ref _ ModuleParameter new name: moduleName module: moduleOrNil import: shouldImport defaultModule: moduleOrNil version: versionOrNil. self addNeighborModule: ref export: self shouldExportExternalModules. ^moduleOrNil ! ! !Module methodsFor: 'module definition protocol' stamp: 'hg 10/10/2001 18:27'! submodule: mod name: submoduleName version: versionOrNil importNames: shouldImport "use this message to declare a submodule of this module" | ref submodule | submodule _ mod ifNotNil: [mod version: mod verbatimVersion parentModule: self] "use path instead of module during loading" ifNil: [self path copyWith: submoduleName]. ref _ SubmoduleReference new name: submoduleName version: versionOrNil module: submodule import: shouldImport. self addNeighborModule: ref export: self shouldExportSubmodules. ^submodule ! ! !Module methodsFor: 'module composition' stamp: 'hg 8/30/2001 22:55'! deepClassesDo: aBlock "evaluate aBlock for each class in my entire hierarchy of submodules" self deepSubmodulesDo: [:mod | mod allClassesDo: [:class | aBlock value: class]]! ! !Module methodsFor: 'module composition' stamp: 'hg 10/8/2001 19:33'! deepSubmodules | deepSubmodules | deepSubmodules _ OrderedCollection new. self deepSubmodulesDo: [:m | deepSubmodules add: m]. ^deepSubmodules! ! !Module methodsFor: 'module composition' stamp: 'hg 9/3/2001 18:48'! deepSubmodulesBottomUpDo: aBlock "evaluate aBlock for each module in my entire hierarchy of submodules" self submodulesDo: [:mod | mod deepSubmodulesBottomUpDo: aBlock]. aBlock value: self. ! ! !Module methodsFor: 'module composition' stamp: 'hg 9/24/2001 18:35'! deepSubmodulesDo: aBlock "evaluate aBlock for each module in my entire hierarchy of submodules. Do not include DeltaModules." aBlock value: self. self submodulesDo: [:mod | mod deepSubmodulesDo: aBlock]! ! !Module methodsFor: 'module composition' stamp: 'hg 10/12/2001 21:35'! deltaModuleFor: baseModule | path | path _ (baseModule isKindOf: Array) ifFalse: [baseModule path] ifTrue: [baseModule]. ^self deltaModules detect: [:mod | path = ((mod baseModule isKindOf: Array) ifFalse: [mod baseModule path] ifTrue: [mod baseModule])] ifNone: [nil]! ! !Module methodsFor: 'module composition' stamp: 'hg 9/2/2001 12:39'! importedModules | mods | mods _ OrderedCollection new. self importedModulesDo: [:mod | mods add: mod]. ^mods! ! !Module methodsFor: 'module composition' stamp: 'hg 9/25/2001 15:18'! importedModulesDo: aBlock "iterate non-recursively over my included modules, in the correct order for name lookup" self neighborModuleRefs do: [:ref | ref importNames ifTrue: [aBlock value: ref module]]! ! !Module methodsFor: 'module composition' stamp: 'hg 9/25/2001 19:43'! neighborModuleRefs "return a collection of all my module references" ^neighborModules ifNil: [#()]! ! !Module methodsFor: 'module composition' stamp: 'hg 10/11/2001 17:56'! neighborModules "return a collection of all modules that I reference" ^self neighborModuleRefs "this just to avoid problems in rare sensitive special cases" select: [:ref | ref isModuleResolved or: [ref refersToDeltaModule]] thenCollect: [:ref | ref module]! ! !Module methodsFor: 'module composition' stamp: 'hg 9/25/2001 15:20'! refForNeighborModule: module ^self neighborModuleRefs detect: [:ref | ref module = module] ifNone: [nil] ! ! !Module methodsFor: 'module composition' stamp: 'hg 9/25/2001 17:36'! submodules | mods | mods _ OrderedCollection new. self submodulesDo: [:mod | mods add: mod]. ^mods! ! !Module methodsFor: 'module composition' stamp: 'hg 10/11/2001 10:24'! submodulesDo: aBlock ^self neighborModuleRefs do: [:ref | ref isSubmodule & ref isModuleResolved ifTrue: [aBlock value: ref module]]! ! !Module methodsFor: 'changing module composition' stamp: 'hg 9/25/2001 18:07'! addNeighborModule: moduleReference export: shouldExport (self hasNeighborModule: moduleReference module) ifTrue: [ self error: 'Neighbor module ', moduleReference module pathAsMessages, ' already exists.']. moduleReference importNames & moduleReference module notNil ifTrue: [ self checkImportForCircularity: moduleReference module]. moduleReference hasAlias ifTrue: [ self defineName: moduleReference name as: moduleReference module export: shouldExport]. self addNeighborModuleRef: moduleReference. ! ! !Module methodsFor: 'changing module composition' stamp: 'hg 9/25/2001 14:10'! addNeighborModuleRef: moduleReference neighborModules _ self neighborModuleRefs copyWith: moduleReference. self invalidateCaches. ! ! !Module methodsFor: 'changing module composition' stamp: 'hg 9/25/2001 12:50'! addSubmoduleNamed: aString importNames: import "create and add a submodule" | submodule | submodule _ self species new version: nil parentModule: self. self submodule: submodule name: aString version: nil importNames: import. ^submodule ! ! !Module methodsFor: 'changing module composition' stamp: 'hg 10/9/2001 18:17'! cleanOutModule "classes have special removal needs" self allClassesDo: [:cl | cl removeFromSystem]. "under weak modules you must clear the names (from Smalltalk)" Preferences strongModules ifFalse: [ self definedNames keys do: [:name | self removeName: name]]. ! ! !Module methodsFor: 'changing module composition' stamp: 'hg 10/11/2001 09:40'! deltaModuleForBase: baseModule forceCreate: create asActive: markedAsActive "return the DeltaModule associated with this module that has the given base module. If not found, create one if asked to, otherwise return nil." | ref | (self deltaModuleFor: baseModule) doIfNotNil: [:mod | ^mod]. ^create ifTrue: [ self deltaModuleOn: baseModule alias: nil version: nil importNames: false. ref _ self neighborModuleRefs last. ref module markAsActive: markedAsActive. ref module]! ! !Module methodsFor: 'changing module composition' stamp: 'hg 9/25/2001 14:34'! ensureExternalModule: module (self hasNeighborModule: module) ifFalse: [ self externalModule: module alias: nil version: nil importNames: false]! ! !Module methodsFor: 'changing module composition' stamp: 'hg 10/9/2001 18:18'! hardRemoveModule "this ought to be as easy as removing from parent, but it ain't for compatibility reasons" "this to remove e.g. upstream refs to my names" ModuleInstaller deactivate: self. self deepSubmodulesDo: [:mod | mod cleanOutModule]. self parentModule removeNeighborModule: self! ! !Module methodsFor: 'changing module composition' stamp: 'hg 10/8/2001 17:03'! moveModule: module toAfter: anotherModule "use this to change the order of name lookup" | moveRef afterRef | moveRef _ self refForNeighborModule: module. afterRef _ self refForNeighborModule: anotherModule. moveRef isNil | afterRef isNil ifTrue: [ self error: 'module reference not found']. neighborModules _ (neighborModules asOrderedCollection remove: moveRef; add: moveRef after: afterRef; yourself) asArray. self invalidateCaches. ! ! !Module methodsFor: 'changing module composition' stamp: 'hg 10/8/2001 17:12'! moveModule: module toBefore: anotherModule "use this to change the order of name lookup" | moveRef beforeRef | moveRef _ self refForNeighborModule: module. beforeRef _ self refForNeighborModule: anotherModule. moveRef isNil | beforeRef isNil ifTrue: [ self error: 'module reference not found']. neighborModules _ (neighborModules asOrderedCollection remove: moveRef; add: moveRef before: beforeRef; yourself) asArray. self invalidateCaches. ! ! !Module methodsFor: 'changing module composition' stamp: 'hg 10/10/2001 15:13'! removeNeighborModule: module "just remove the module from me--do not finialize/unistall it, etc." | moduleReference | moduleReference _ self refForNeighborModule: module. moduleReference hasAlias ifTrue: [self removeName: moduleReference name]. self removeNeighborModuleRef: moduleReference. ^moduleReference! ! !Module methodsFor: 'changing module composition' stamp: 'hg 9/25/2001 14:11'! removeNeighborModuleRef: moduleReference neighborModules _ self neighborModuleRefs copyWithout: moduleReference. self invalidateCaches. ! ! !Module methodsFor: 'version handling' stamp: 'hg 9/10/2001 14:58'! incrementVersion "increment the version by one minimal unit" version _ version + self minimalVersionIncrease. ^version! ! !Module methodsFor: 'version handling' stamp: 'hg 9/10/2001 14:56'! minimalVersionIncrease "return the unit of the smallest version increase. One thousand per decimal version seems ok:" ^0.0001! ! !Module methodsFor: 'version handling' stamp: 'hg 9/10/2001 21:38'! verbatimVersion ^version! ! !Module methodsFor: 'version handling' stamp: 'hg 9/10/2001 19:30'! version "inherit version from parent if mine is nil" ^version ifNil: [parentModule version]! ! !Module methodsFor: 'change sets' stamp: 'hg 8/27/2001 21:53'! changes "there is no longer a global active change set. All changes should be placed in the active change set of the module where the change belongs." ^Preferences changeSetsPerModule ifTrue: [activeChangeSet ifNil: [self createChanges. activeChangeSet]] ifFalse: [Smalltalk changes]! ! !Module methodsFor: 'change sets' stamp: 'hg 8/21/2001 21:38'! changes: cs activeChangeSet _ cs! ! !Module methodsFor: 'change sets' stamp: 'hg 9/10/2001 12:24'! createChanges "there is no longer a global active change set. All changes should be placed in the active change set of the module where the change belongs." self newChanges: (ChangeSet basicNewNamed: self pathAsMessages).! ! !Module methodsFor: 'change sets' stamp: 'hg 8/21/2001 21:37'! newChanges: aChangeSet "Set the module ChangeSet to be the argument, aChangeSet. " self changes: aChangeSet "SystemDicitonary>>newChanges was: Tell the current project that aChangeSet is now its change set. When called from Project enter:, the setChangeSet: call is redundant but harmless; when called from code that changes the current-change-set from within a project, it's vital" "SystemChanges isolationSet: nil. SystemChanges _ aChangeSet. Smalltalk currentProjectDo: [:proj | proj setChangeSet: aChangeSet. aChangeSet isolationSet: proj isolationSet]"! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 10/9/2001 16:39'! classDefinitionFor: class "return a string with a message that defines the given variable in this module. ClassBuilder adds class to the module by itself." ^(class modularDefinition: false), ' self'! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 10/14/2001 23:19'! definition "Answer a String that builds the definition of the receiver as messages to it (don't print the receiver)." | aStream | aStream _ WriteStream on: (String new: 300). "Keep flag: messages with used selectors here so that this code will be updated if the selectors are changed." self flag: #version: . aStream "nextPutAll: self class name, ' new';" crtab; nextPutAll:'version: '; print: self verbatimVersion; nextPutAll: ';'. self neighborDefinitionsOn: aStream. aStream tab; nextPutAll: 'yourself. '. ^ aStream contents! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 10/11/2001 23:13'! fileOutMethodsOn: aStream moveSource: moveSource toFile: fileIndex self allClassesDo: [:class | class fileOutContentsOn: aStream moveSource: moveSource toFile: fileIndex. class class nonTrivial ifTrue: [ class class fileOutContentsOn: aStream moveSource: moveSource toFile: fileIndex]]! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 10/14/2001 23:20'! neighborDefinitionsOn: aStream self neighborModuleRefs do: [:ref | aStream crtab. ref storeOn: aStream. aStream nextPut: $;]. aStream cr. ! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 9/10/2001 13:01'! printOn: aStream "a simple pretty-printer" self path literalPrintOn: aStream! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 9/7/2001 19:35'! storeOn: aStream "a simple pretty-printer" aStream nextPutAll: 'Module @ '. self printOn: aStream.! ! !Module methodsFor: 'fileIn/Out' stamp: 'hg 10/1/2001 16:49'! variableDefinitionFor: definedName "return a string with a message that defines the given variable in this module" self flag: #defineName:as:export:. ^'defineName: ', definedName printString, ' as: nil export: ', (self exportsName: definedName) printString! ! !Module methodsFor: 'un/loading' stamp: 'hg 10/8/2001 18:59'! markAsActive: shouldBeActive ^self! ! !Module methodsFor: 'un/loading' stamp: 'hg 10/8/2001 18:59'! switchActiveStatePhase1: shouldBeInstalled ^nil! ! !Module methodsFor: 'code analysis' stamp: 'hg 9/24/2001 22:36'! localUnresolvedRefs "all unresolved global references from code in this Module" "(Module fromPath: #(Morphic)) localUnresolvedRefs" | lits list allClasses found | list _ OrderedCollection new. allClasses _ OrderedCollection new. self allClassesDo: [:cls | allClasses addLast: cls; addLast: cls class]. allClasses do: [:cl | cl methodDict keysAndValuesDo: [:sel :cm | lits _ cm literals. found _ lits detect: [:lit | lit isVariableBinding and: [(lit value == cl or: [ self scopedLookup: lit key inClass: cl cachedIn: OutOfScopeCache]) not]] ifNone: [nil]. found ifNotNil: [ list add: ( MethodReference new setStandardClass: cl methodSymbol: sel)] ]]. ^list! ! !Module methodsFor: 'system conversion' stamp: 'hg 10/10/2001 15:08'! collectUpstreamMethodsOutside: homeModule "find all methods in all systemwide classes outside homeModule that contain references to names defined by this module, then add to this module DeltaModules with classes referring to those methods. This does not at all affect the actual classes or methods." | incoming deltaModule deltaClass method n | incoming _ self deepIncomingRefsFromOutside: homeModule. Smalltalk newChanges: (ChangeSet basicNewNamed: self name, 'Reorganization', Time now printString). ChangeSorter initialize. 'Collecting upstream definitions ...' displayProgressAt: Sensor cursorPoint from: 0 to: incoming size during: [:bar | n _ 0. incoming keysAndValuesDo: [:key :upstreamMethodRefs | bar value: (n _ n + 1). upstreamMethodRefs do: [:mref | deltaModule _ self deltaModuleForBase: mref actualClass module forceCreate: true asActive: true. deltaClass _ deltaModule deltaClassFor: mref actualClass forceCreate: true. method _ mref actualClass compiledMethodAt: mref methodSymbol. deltaModule defineSelector: mref methodSymbol asMethod: method previousVersion: nil inClass: deltaClass]]]. ^incoming! ! !Module methodsFor: 'compatibility' stamp: 'hg 10/12/2001 20:34'! at: aString "simple pools compatibility method, to support e.g. 'TextConstants at: #NN'. Should really remove this and use 'TextConstants NN' instead" ^self definitionFor: aString asSymbol ifAbsent: [ self error: 'Key not found']! ! !Module methodsFor: 'compatibility' stamp: 'hg 8/22/2001 22:16'! organization ^SystemOrganization ! ! !Module methodsFor: 'compatibility' stamp: 'hg 10/9/2001 17:58'! removeClassFromSystem: aClass logged: aBool "Delete the class, aClass, from the system, but log the removal neither to the current change set nor to the changes log" aBool ifTrue:[ aClass wantsChangeSetLogging ifTrue: [self changes noteRemovalOf: aClass]. aClass acceptsLoggingOfCompilation ifTrue: [Smalltalk logChange: self pathAsMessages, ' removeClassNamed: #', aClass name]. ]. "self organization removeElement: aClass name." Smalltalk removeFromStartUpList: aClass. Smalltalk removeFromShutDownList: aClass. self removeName: aClass name. Smalltalk flushClassNameCache ! ! !Module methodsFor: 'private' stamp: 'hg 9/10/2001 12:24'! checkImportForCircularity: module "check that adding the given module to my imported modules will not create an import circularity." (self importCreatesCircularity: module) ifTrue: [ self error: 'Importing ', module pathAsMessages, ' into module ', self pathAsMessages, ' would create a circular import']! ! !Module methodsFor: 'private' stamp: 'hg 10/11/2001 09:25'! clearDeclaredModules neighborModules _ self neighborModuleRefs select: [:ref | ref refersToExternalModule not]! ! !Module methodsFor: 'private' stamp: 'di 9/14/2001 10:18'! invalidateCaches parentModule ifNotNil: [parentModule invalidateCaches]! ! !Module methodsFor: 'private' stamp: 'hg 9/23/2001 16:18'! privateSimplifiedPath "a simplified version of the path used for e.g. long name and simulated category" | path | path _ self path. ^(path size > 1 and: [path first = Module squeak name]) ifTrue: [path allButFirst] ifFalse: [path]! ! !Module methodsFor: 'private' stamp: 'hg 9/25/2001 15:18'! refForModuleDefining: aName "answer the ModuleReference that gives this module access to the definition of aName" self neighborModuleRefs do: [:ref | ref module exportedAssocFor: aName ifPresent: [:assoc :mod | ^ref]]. ^nil! ! !Module methodsFor: 'copying' stamp: 'hg 10/9/2001 18:33'! veryDeepFixupWith: deepCopier super veryDeepFixupWith: deepCopier. repository _ deepCopier references at: repository ifAbsent: [repository]. ! ! !Module methodsFor: 'copying' stamp: 'hg 10/9/2001 18:29'! veryDeepInner: deepCopier "Copy all of my instance variables." super veryDeepInner: deepCopier. version _ version copy. parentModule _ parentModule. neighborModules _ neighborModules copy. definedNames _ definedNames copy. exportedNames _ exportedNames copy. repository _ repository. ! ! !Module class methodsFor: 'instance creation' stamp: 'hg 9/12/2001 22:27'! new ^super new initialize! ! !Module class methodsFor: 'class initialization' stamp: 'hg 9/8/2001 20:30'! createModularClassDefinitionsPreference Preferences addPreference: #modularClassDefinitions category: #modules default: false balloonHelp: 'Specifies whether class definitions should contain their system category or their home module.'! ! !Module class methodsFor: 'class initialization' stamp: 'hg 8/28/2001 23:03'! createStrongModulesPreference Preferences addPreference: #strongModules category: #modules default: false balloonHelp: 'If false, global definitions are placed into modules without disrupting the old-style system organization: all globals are still held in the global Smalltalk dictionary, out-of-scope references are not validated, and so on. This allows the analysis of a modularized system without disrupting existing tools and so on.'! ! !Module class methodsFor: 'class initialization' stamp: 'hg 10/3/2001 23:04'! initialize "Module initialize" self createModularClassDefinitionsPreference. self createStrongModulesPreference. self resetWeakModules. RootModule _ VirtualRootModule setup. SmalltalkModule _ TransitionalSmalltalkModule setup. ! ! !Module class methodsFor: 'class initialization' stamp: 'hg 8/30/2001 19:28'! resetWeakModules "prepare system for change of regime" Preferences strongModules ifFalse: [ Smalltalk allClassesDo: [:cl | cl module: nil]].! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 9/4/2001 19:36'! @ fullPath "convenient form for accessing module from its path. Module @ #(Kernel Objects)" ^self fromPath: fullPath ! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 8/21/2001 18:10'! fromPath: modulePath "return the module with the given path" ^self fromPath: modulePath forceCreate: false! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 10/11/2001 10:24'! fromPath: modulePath forceCreate: force "return the module with the given path" "don't be case sensitive but preserve given case when creating names" | subref | ^modulePath inject: self root into: [:mod :localName | subref _ mod neighborModuleRefs detect: [:ref | ref isSubmodule and: [ref isModuleResolved and: [ ref name asLowercase = localName asLowercase]]] ifNone: [nil]. subref ifNotNil: [subref module] ifNil: [ force ifFalse: [^nil] ifTrue: [mod addSubmoduleNamed: localName importNames: false]]]! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 9/7/2001 19:31'! root ^RootModule! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 8/30/2001 23:46'! smalltalk "return the module whose dictionary is Smalltalk. use this method instead of hardcoding references to Smalltalk" ^SmalltalkModule! ! !Module class methodsFor: 'virtual hierarchy' stamp: 'hg 9/10/2001 17:52'! squeak "return the module that holds all the Squeak system classes." ^self @ #(Squeak)! ! !Module class methodsFor: 'fileIn/Out' stamp: 'hg 10/1/2001 15:27'! metaPrerequisites "Answer a lists of prerequisites for being able to understand (i.e. load) my instances. A prerequisite is simply given as a ModuleReference with the adequate module and VersionSpecification. This is not final yet." ^Array with: (ModuleReference new name: nil version: self module version module: self module import: nil)! ! !ModuleReference methodsFor: 'accessing' stamp: 'hg 9/25/2001 16:10'! alias "answer my verbatim name, which may be nil" ^name! ! !ModuleReference methodsFor: 'accessing' stamp: 'hg 9/25/2001 12:21'! importNames ^importNames! ! !ModuleReference methodsFor: 'accessing' stamp: 'hg 9/25/2001 12:21'! importNames: aBoolean importNames _ aBoolean! ! !ModuleReference methodsFor: 'accessing' stamp: 'hg 9/25/2001 12:21'! module ^module! ! !ModuleReference methodsFor: 'accessing' stamp: 'hg 9/25/2001 16:11'! name "answer my alias, or the module's default name if my alias is nil" ^self alias ifNil: [module name]! ! !ModuleReference methodsFor: 'accessing' stamp: 'hg 9/28/2001 15:52'! pathAndVersionDefinition "this is just preliminary" ^(specifiedVersion ifNil: [module path] ifNotNil: [module path copyWith: specifiedVersion]) literalPrintString! ! !ModuleReference methodsFor: 'resolving' stamp: 'hg 10/14/2001 02:09'! createModuleFromPathAndVersion | mod | mod _ Module fromPath: self specifiedPath forceCreate: true. self resolvedModule: mod. ^mod! ! !ModuleReference methodsFor: 'resolving' stamp: 'hg 10/11/2001 11:09'! findModuleFromPathAndVersion "this is just preliminary" ^Module @ self specifiedPath doIfNotNil: [:mod | (specifiedVersion isNil or: [specifiedVersion = mod version]) ifTrue: [self resolvedModule: mod]]! ! !ModuleReference methodsFor: 'resolving' stamp: 'hg 10/11/2001 11:07'! resolvedModule: mod "resolve my reference to point to the given module" module _ mod! ! !ModuleReference methodsFor: 'resolving' stamp: 'hg 9/30/2001 16:41'! specifiedPath (module isKindOf: Array) ifFalse: [ self error: 'Only use this method when I hold a path in my module instvar.']. ^module! ! !ModuleReference methodsFor: 'resolving' stamp: 'hg 10/10/2001 16:14'! specifiedPathAndVersion ^self specifiesVersion ifFalse: [self specifiedPath] ifTrue: [self specifiedPath copyWith: specifiedVersion]! ! !ModuleReference methodsFor: 'resolving' stamp: 'hg 9/25/2001 17:21'! specifiedVersion ^specifiedVersion! ! !ModuleReference methodsFor: 'initializing' stamp: 'hg 9/25/2001 16:25'! name: stringOrNil version: versionOrNil module: aModule import: import name _ stringOrNil ifNotNil: [stringOrNil asSymbol]. specifiedVersion _ versionOrNil. module _ aModule. importNames _ import ! ! !ModuleReference methodsFor: 'initializing' stamp: 'hg 10/10/2001 16:17'! onPath: pathAndVersion "initialize me for temporarily holding a path instead of a module" | version path | (pathAndVersion last isKindOf: Number) ifTrue: [version _ pathAndVersion last. path _ pathAndVersion allButLast] ifFalse: [version _ nil. path _ pathAndVersion]. ^self name: nil version: version module: path import: false! ! !ModuleReference methodsFor: 'printing' stamp: 'hg 9/25/2001 12:21'! explorerContents ^self module moduleExplorerContents ! ! !ModuleReference methodsFor: 'printing' stamp: 'hg 10/10/2001 22:21'! printOn: aStream aStream nextPutAll: '^ '. self hasAlias ifTrue: [ aStream nextPutAll: '#', name, '->']. aStream print: module. importNames ifTrue: [aStream nextPut: $*].! ! !ModuleReference methodsFor: 'printing' stamp: 'hg 10/11/2001 09:23'! storeOn: aStream "write a message string that will create myself if sent to a module" "Keep flag: messages with used selectors here so that this code will be updated if the selectors are changed." self flag: #externalModule:alias:version:importNames: . aStream nextPutAll: 'externalModule: ', self module path literalPrintString; nextPutAll: ' alias: '; print: self alias; nextPutAll: ' version: '; print: specifiedVersion; nextPutAll: ' importNames: '; print: self importNames ! ! !ModuleReference methodsFor: 'testing' stamp: 'hg 9/28/2001 15:54'! <= other ^self module <= other module! ! !ModuleReference methodsFor: 'testing' stamp: 'hg 9/25/2001 12:28'! hasAlias ^name notNil! ! !ModuleReference methodsFor: 'testing' stamp: 'hg 10/11/2001 10:22'! isModuleResolved "I may declare a module before it has been loaded or otherwise resolved, and in that case this method return false. Then my module variable holds the path of the Module object until that object has been resolved." ^module isKindOf: Module! ! !ModuleReference methodsFor: 'testing' stamp: 'hg 9/25/2001 12:28'! isSubmodule ^false! ! !ModuleReference methodsFor: 'testing' stamp: 'hg 10/11/2001 09:16'! refersToDeltaModule ^false! ! !ModuleReference methodsFor: 'testing' stamp: 'hg 10/11/2001 09:24'! refersToExternalModule "an external module is a neighbor that is neither a delta module nor a submodule" ^true! ! !ModuleReference methodsFor: 'testing' stamp: 'hg 9/25/2001 16:25'! specifiesVersion "Do I specify a module version? Note that the module I hold will have a version in any case," ^specifiedVersion notNil! ! !ModuleParameter methodsFor: 'initializing' stamp: 'hg 9/25/2001 16:05'! name: string module: aModule import: import defaultModule: default version: versionOrNil string ifNil: [self error: 'a module parameter must have name']. super name: string version: versionOrNil module: aModule import: import. defaultModule _ default! ! !ModuleParameter methodsFor: 'initializing' stamp: 'hg 9/25/2001 16:06'! name: string version: versionOrNil module: aModule import: import ^self shouldNotImplement! ! !ModuleParameter methodsFor: 'accessing' stamp: 'hg 9/25/2001 12:59'! module "answer the module, or the default if none" ^module ifNil: [defaultModule]! ! !ModuleReference class methodsFor: 'instance creation' stamp: 'hg 10/10/2001 16:12'! fromPath: pathAndVersion | version path | (pathAndVersion last isKindOf: Number) ifTrue: [version _ pathAndVersion last. path _ pathAndVersion allButLast] ifFalse: [version _ nil. path _ pathAndVersion]. ^self new name: nil version: version module: path import: false! ! !ModuleReference class methodsFor: 'instance creation' stamp: 'hg 10/10/2001 16:18'! onPath: pathAndVersion ^self new onPath: pathAndVersion! ! !SubmoduleReference methodsFor: 'accessing' stamp: 'hg 9/25/2001 16:12'! name "answer my verbatim name, which can't be nil" ^name! ! !SubmoduleReference methodsFor: 'initializing' stamp: 'hg 9/25/2001 12:27'! name: string version: versionOrNil module: aModule import: import string ifNil: [self error: 'submodule must have name']. super name: string version: versionOrNil module: aModule import: import ! ! !SubmoduleReference methodsFor: 'testing' stamp: 'hg 9/25/2001 12:27'! isSubmodule ^true! ! !SubmoduleReference methodsFor: 'testing' stamp: 'hg 10/11/2001 09:25'! refersToExternalModule ^false! ! !SubmoduleReference methodsFor: 'printing' stamp: 'hg 10/11/2001 18:20'! printOn: aStream aStream nextPutAll: '^ '; print: module. importNames ifTrue: [aStream nextPut: $*].! ! !SubmoduleReference methodsFor: 'printing' stamp: 'hg 10/10/2001 20:32'! storeOn: aStream "write a message string that will create myself if sent to a module" | moduleObjectCreator | "Keep flag: messages with used selectors here so that this code will be updated if the selectors are changed." self flag: #submodule:name:version:importNames: . moduleObjectCreator _ self module repository isStandalone ifTrue: ['nil'] ifFalse: ['(', self module class printString, ' new)']. aStream nextPutAll: 'submodule: ', moduleObjectCreator "path literalPrintString"; nextPutAll: ' name: '; print: self name; nextPutAll: ' version: '; print: specifiedVersion; nextPutAll: ' importNames: '; print: self importNames. ! ! !TransitionalSmalltalkModule methodsFor: 'accessing defined names' stamp: 'hg 9/11/2001 12:18'! allClassesDo: aBlock "just expose exported classes, as other modules expose the others" self exportedNames valuesDo: [:value | (value isKindOf: Class) ifTrue: [aBlock value: value]] ! ! !TransitionalSmalltalkModule methodsFor: 'compatibility' stamp: 'hg 9/3/2001 18:39'! doesNotUnderstand: aMessage "signal and reroute messages to the SystemDictionary for backward compatibility" Transcript show: aMessage printString, ' from ', thisContext sender printString, '.'; cr. ^self definedNames perform: aMessage selector withArguments: aMessage arguments ! ! !TransitionalSmalltalkModule methodsFor: 'compatibility' stamp: 'hg 8/31/2001 17:43'! initialize "Set my name dictionaries to point to the old-style global dictionary Smalltalk" super initialize. definedNames _ Smalltalk. exportedNames _ IdentityDictionary newFrom: Smalltalk. ! ! !TransitionalSmalltalkModule methodsFor: 'code analysis' stamp: 'hg 9/2/2001 15:09'! localUnresolvedRefs "Don't do this for Smalltalk" ^#()! ! !TransitionalSmalltalkModule methodsFor: 'changing defined names' stamp: 'hg 9/25/2001 14:42'! changeName: oldName to: newName forValue: value self redefineName: newName as: value export: (self exportsName: oldName). self removeName: oldName.! ! !TransitionalSmalltalkModule methodsFor: 'changing defined names' stamp: 'hg 9/7/2001 20:28'! redefineName: aString as: value export: exportIt self addAssoc: (aString asSymbol)->value export: exportIt. ! ! !TransitionalSmalltalkModule methodsFor: 'changing defined names' stamp: 'hg 10/1/2001 13:22'! removeName: aString self definedNames removeKey: aString asSymbol ifAbsent: []. self exportedNames removeKey: aString asSymbol ifAbsent: []. self invalidateCaches ! ! !TransitionalSmalltalkModule methodsFor: 'system conversion' stamp: 'hg 10/8/2001 17:04'! moveOutOfTheWay "ensure that I am the last module to be scanned for names" | currentLast | currentLast _ Module root neighborModuleRefs last. currentLast = self ifTrue: [^self]. Module root moveModule: self toAfter: Module root neighborModuleRefs last module. ! ! !TransitionalSmalltalkModule class methodsFor: 'class initialization' stamp: 'hg 9/26/2001 16:34'! setup "install instance of me as Smalltalk submodule of Root" | instance | instance _ self new version: nil parentModule: Module root. Module root submodule: instance name: #OldstyleSmalltalk version: nil importNames: false. ^instance! ! !VirtualRootModule methodsFor: 'module name and path' stamp: 'hg 9/2/2001 16:55'! longName ^#Root! ! !VirtualRootModule methodsFor: 'module name and path' stamp: 'hg 9/10/2001 12:29'! path "I am the root of the virtual Module hierarchy. Note that a path is an Array of literals. " ^#()! ! !VirtualRootModule methodsFor: 'module name and path' stamp: 'hg 9/10/2001 12:34'! pathAsMessages "return the full path as the source code for a sequence of messages to refer to me. Names defined in the Root require no prefixing (at least for now)" ^''! ! !VirtualRootModule methodsFor: 'testing' stamp: 'hg 9/28/2001 15:08'! < other "sort modules in their breadth-first traversal order. Root is first. " ^self ~~ other! ! !VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 9/24/2001 16:36'! allDefinitionsFor: aString detect: aBlock "look up all definitions for the given symbol in all modules. If found, evaluate aBlock for the defined value and defining module. Terminate lookup and return defined value if block returns true. This method is meant for handling the possibility of multiple definitions by the same name, which arises whenever a search for an unqualified global name is done." | assoc found | self deepSubmodulesDo: [:mod | assoc _ mod localAssocFor: aString ifAbsent: [nil]. assoc ifNotNil: [ found _ aBlock value: assoc value value: mod. found == true ifTrue: [^assoc value]]]. ^nil! ! !VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 8/21/2001 21:57'! allModules | all | all _ OrderedCollection with: self. self deepSubmodulesDo: [:mod | all add: mod]. ^all! ! !VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 8/28/2001 19:56'! classNames "Answer a SortedCollection of all class names." ^cachedClassNames ifNil: [cachedClassNames _ self computeClassNames asSortedCollection]. ! ! !VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 9/7/2001 16:15'! computeClassNames "Answer a SortedCollection of all class names." | names | names _ OrderedCollection new. self deepClassesDo: [:cl | names add: cl name]. ^names asSortedCollection! ! !VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 9/24/2001 21:39'! importedAssocFor: aString ifPresent: aBlock "for efficiency, just look locally since all modules will be traversed anyway" | assoc | self importedModulesDo: [:module | assoc _ module localExportedAssocFor: aString ifAbsent: [nil]. assoc ifNotNil: [ aBlock value: assoc value: module. ^assoc]]. ^nil! ! !VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 9/24/2001 16:38'! lenientScopeHas: varName ifTrue: assocBlock "Compatibility hack -- find things in all modules for now" self associationFor: varName ifPresent: [:assoc :mod | . assocBlock value: assoc. ^true]. ^ false! ! !VirtualRootModule methodsFor: 'accessing defined names' stamp: 'hg 9/24/2001 16:36'! moduleDefining: varName "search all modules in the system. assume name is not for a module" ^self allDefinitionsFor: varName detect: [:value :module | (value isKindOf: Module) ifFalse: [^module]]. ! ! !VirtualRootModule methodsFor: 'module composition' stamp: 'hg 10/1/2001 19:32'! importedModulesDo: aBlock "iterate recursively over all modules in the hierarchy (except myself!!). This implements the special name semantics of the virtual root, which is that it has direct access to all exported names from all modules" self submodulesDo: [:sub | sub deepSubmodulesDo: aBlock]! ! !VirtualRootModule methodsFor: 'module composition' stamp: 'hg 10/8/2001 20:58'! incomingNeighborsOf: module ^self deepSubmodules select: [:mod | mod submodules includes: module]! ! !VirtualRootModule methodsFor: 'printing' stamp: 'hg 9/1/2001 19:39'! printOn: aStream aStream nextPutAll: '(the Virtual Root Module)'! ! !VirtualRootModule methodsFor: 'private' stamp: 'hg 9/2/2001 12:31'! checkImportForCircularity: module "don't do this because of the special import policy for root" ^self! ! !VirtualRootModule class methodsFor: 'instance creation' stamp: 'hg 8/22/2001 18:42'! new ^self error: 'There should only be one Root module'! ! !VirtualRootModule class methodsFor: 'instance creation' stamp: 'hg 9/10/2001 19:33'! setup "create the single instance" ^super new version: 0.0; yourself! ! !VirtualRootModule reorganize! ('module name and path' longName path pathAsMessages) ('initializing' invalidateCaches) ('testing' <) ('accessing defined names' allDefinitionsFor:detect: allModules classNames computeClassNames importedAssocFor:ifPresent: lenientScopeHas:ifTrue: moduleDefining:) ('module composition' importedModulesDo: incomingNeighborsOf:) ('printing' printOn:) ('private' checkImportForCircularity:) ! SubmoduleReference removeSelector: #isExternalModule! ModuleReference removeSelector: #createLoadableModuleFromPathAndVersion! ModuleReference removeSelector: #isExternalModule! ModuleReference removeSelector: #moduleIsLoaded! !ModuleReference reorganize! ('accessing' alias importNames importNames: module name pathAndVersionDefinition) ('resolving' createModuleFromPathAndVersion findModuleFromPathAndVersion resolvedModule: specifiedPath specifiedPathAndVersion specifiedVersion) ('initializing' name:version:module:import: onPath:) ('printing' explorerContents printOn: storeOn:) ('testing' <= hasAlias isModuleResolved isSubmodule refersToDeltaModule refersToExternalModule specifiesVersion) ! Module initialize! !Module class reorganize! ('instance creation' new) ('class initialization' createModularClassDefinitionsPreference createStrongModulesPreference initialize resetWeakModules) ('virtual hierarchy' @ fromPath: fromPath:forceCreate: moduleForCategory:forceCreate: pathFromCategory: root smalltalk squeak) ('fileIn/Out' metaPrerequisites) ('system conversion' aRefactorer convertSystemOrganizationToModules createTopLevels fixProperCategoryNames generateSubmodules:for: modulesFromSystemCategories properCategoryNames topLevelModuleList) ('pool conversion') ! Module removeSelector: #deltaModuleForBase:forceCreate:! Module removeSelector: #markAsInstalled:! Module removeSelector: #moveModuleRef:toAfter:! Module removeSelector: #moveModuleRef:toBefore:! Module removeSelector: #switchInstalledStatePhase1:! !Module reorganize! ('accessing' annotationAt: annotationAt:ifAbsent: annotationAt:put: annotations classNames definedNames exportedNames parentModule repository repository: species verbatimRepository) ('testing' < <= conflictsWith: exportsName: hasNeighborModule: importCreatesCircularity: isActive isDeltaModule shouldExportDeltaModules shouldExportExternalModules shouldExportSubmodules) ('initializing' initialize version: version:parentModule:) ('module name and path' longName name path pathAndVersion pathAsMessages pathTo: simulatedCategory) ('accessing defined names' allClassesDo: associationFor:ifAbsent: associationFor:ifPresent: definitionFor:ifAbsent: doesNotUnderstand: exportedAssocFor:ifPresent: importedAssocFor:ifPresent: localAssocFor:ifAbsent: localExportedAssocFor:ifAbsent: qualifiedPrefixForName:andValue:) ('changing defined names' addAssoc:export: changeName:to:forValue: defineName:as:export: exportName: moveName:toModule: redefineName:as:export: removeName: validateName:forValue:) ('module definition protocol' deltaModuleOn:alias:version:importNames: externalModule:alias:version:importNames: parameterModuleWithDefault:version:alias:importNames: submodule:name:version:importNames:) ('module composition' deepClassesDo: deepSubmodules deepSubmodulesBottomUpDo: deepSubmodulesDo: deltaModuleFor: deltaModules importedModules importedModulesDo: neighborModuleRefs neighborModules refForNeighborModule: submodules submodulesDo:) ('changing module composition' addNeighborModule:export: addNeighborModuleRef: addSubmoduleNamed:importNames: cleanOutModule deltaModuleForBase:forceCreate:asActive: ensureExternalModule: hardRemoveModule moveModule:toAfter: moveModule:toBefore: removeNeighborModule: removeNeighborModuleRef:) ('version handling' incrementVersion minimalVersionIncrease verbatimVersion version) ('change sets' changes changes: createChanges newChanges:) ('fileIn/Out' classDefinitionFor: definition fileOutMethodsOn:moveSource:toFile: neighborDefinitionsOn: printOn: storeOn: variableDefinitionFor:) ('un/loading' markAsActive: switchActiveStatePhase1:) ('user interface' explore moduleExplorerContents) ('code analysis' deepIncomingRefsFromOutside: deepUniqueMessagesToOutside: deepUnresolvedRefs localIncomingRefsFromOutside: localUnresolvedRefs resetOutOfScopeCache scopedLookup:inClass:cachedIn: setUnresolvedCount: viewDeepUnresolvedRefs zeroOutOfScopeCache) ('system conversion' collectUpstreamMethodsOutside: declareExternalRefs declareExternalRefsForSelector:inClass: importIntoParent rewriteIndirectRefs rewriteSourceForSelector:inClass:) ('compatibility' at: organization removeClassFromSystem:logged:) ('private' checkImportForCircularity: clearDeclaredModules invalidateCaches privateSimplifiedPath refForModuleDefining:) ('copying' veryDeepFixupWith: veryDeepInner:) ! "Postscript: Leave the line above, and replace the rest of this comment by a useful one. Executable statements should follow this comment, and should be separated by periods, with no exclamation points (!!). Be sure to put any further comments in double-quotes, like this one." !