'From Squeak3.2alpha of 8 October 2001 [latest update: #4418] on 16 October 2001 at 4:21:41 pm'! Association subclass: #DeltaAssociation instanceVariableNames: 'previousValue ' classVariableNames: '' poolDictionaries: '' category: 'System-Modules'! !DeltaAssociation commentStamp: '' prior: 0! I am a special kind of association that can also hold a previous version of its value. I am used in DeltaModules to remember the previous version of e.g. methods that are modified or deleted by a DeltaModule. By convention, defining either the old or new method as nil indicates the selector should be undefined in that state (i.e. removed).! ModuleReference subclass: #DeltaModuleReference instanceVariableNames: 'baseModule ' classVariableNames: '' poolDictionaries: '' category: 'System-Modules'! !DeltaModuleReference commentStamp: '' prior: 0! I am needed only to handle the loading/definition of DeltaModules, which is special in that it may also require the DM's baseModule to be loaded.! Module subclass: #DeltaModule instanceVariableNames: 'baseModule isActive ' classVariableNames: '' poolDictionaries: '' category: 'System-Modules'! !DeltaModule commentStamp: '' prior: 0! The mojo of this class is that it unifies a number of different functionalities (once complete): - It is relative to another module (a specific version of it), and only stores the differences wrt the original (hence Delta). It should not record the changes, but the final state, it just does it in a delta-format for efficiency. Hence, it still provides an exact definition of a module but in relative format. It is meant to subsume change sets. - When loaded into the image, it can still be installed/active or not. Ie. its differences wrt the base may be installed into the base module or not. - (Un)Installation can be done atomically (like isolatedProjects), and separate from code loading. - Upstream modifications Deltas are meant to be used for holding modifications to upstream classes (things like String>>asUrl or Object>>isDraggableMorph). Notice the lame unintentional joke in upstream/ñdeltaî. - Un/install yields a form of ñlayersî for handling package conflicts. - DeltaModules should subsume the PackageBrowser, as a package can be read into the image, edited, etc. without being installed and active, the usual tools should handle it. In the long run, the design goal of DeltaModules and -classes should be to use a minimal amount of memory to represent differences w r t the base, while being virtually indistinguishable from a normal module/class, at least in terms of usability. If I am not installed, my contents should not be considered as being 'in' the system.! !DeltaAssociation methodsFor: 'accessing' stamp: 'hg 10/9/2001 13:00'! asAssociationWhenActive: returnActiveValue ^self key -> (self valueWhenActive: returnActiveValue)! ! !DeltaAssociation methodsFor: 'accessing' stamp: 'hg 9/24/2001 15:44'! previousValue ^previousValue! ! !DeltaAssociation methodsFor: 'accessing' stamp: 'hg 9/24/2001 15:45'! previousValue: anObject previousValue _ anObject! ! !DeltaAssociation methodsFor: 'accessing' stamp: 'hg 10/9/2001 12:51'! valueWhenActive: returnActiveValue ^returnActiveValue ifTrue: [value] ifFalse: [previousValue]! ! !DeltaAssociation methodsFor: 'printing' stamp: 'hg 9/24/2001 17:49'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' / '. previousValue printOn: aStream! ! !DeltaAssociation class methodsFor: 'instance creation' stamp: 'hg 9/24/2001 17:43'! key: newKey value: newValue previousValue: previousValue ^(self new key: newKey value: newValue) previousValue: previousValue! ! !DeltaModuleReference methodsFor: 'initializing' stamp: 'hg 10/11/2001 09:44'! in: parentModule name: stringOrNil version: versionOrNil baseModule: baseMod import: import "also create the DeltaModule here" | delta | baseModule _ baseMod. delta _ DeltaModule baseModule: baseModule parentModule: parentModule. self name: stringOrNil version: versionOrNil module: delta import: import. ! ! !DeltaModuleReference 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 baseModule variable holds the path of the Module object until that object has been resolved." ^baseModule isKindOf: Module! ! !DeltaModuleReference methodsFor: 'testing' stamp: 'hg 10/11/2001 09:50'! refersToDeltaModule ^true! ! !DeltaModuleReference methodsFor: 'testing' stamp: 'hg 10/11/2001 09:25'! refersToExternalModule "an external module is a neighbor that is neither a delta module nor a submodule" ^false! ! !DeltaModuleReference methodsFor: 'resolving' stamp: 'hg 10/11/2001 21:16'! resolvedModule: mod "resolve my reference to point to the given module" baseModule _ mod. module baseModule: mod.! ! !DeltaModuleReference methodsFor: 'resolving' stamp: 'hg 10/11/2001 09:49'! specifiedPath (baseModule isKindOf: Array) ifFalse: [ self error: 'Only use this method when I hold a path in my baseModule instvar.']. ^baseModule! ! !DeltaModuleReference 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: #deltaModuleOn:alias:version:importNames: . aStream nextPutAll: 'deltaModuleOn: ', self module baseModule path literalPrintString; nextPutAll: ' alias: '; print: self alias; nextPutAll: ' version: '; print: specifiedVersion; nextPutAll: ' importNames: '; print: self importNames ! ! !Module methodsFor: 'testing' stamp: 'hg 9/12/2001 20:11'! isDeltaModule ^false! ! !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 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 10/2/2001 22:41'! deltaModules ^self neighborModules select: [:mod | mod isDeltaModule]! ! !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]! ! !DeltaModule methodsFor: 'testing' stamp: 'hg 10/10/2001 22:33'! hasBaseModule "is my base module defined or still a ModuleReference ?" ^baseModule isKindOf: Module! ! !DeltaModule methodsFor: 'testing' stamp: 'hg 10/10/2001 15:18'! isActive ^isActive ~= false! ! !DeltaModule methodsFor: 'testing' stamp: 'hg 10/9/2001 12:37'! isDeltaClass: class (self definitionFor: class name ifAbsent: [nil]) == class ifFalse: [^false]. self baseModule definitionFor: class name ifAbsent: [^false]. ^true! ! !DeltaModule methodsFor: 'testing' stamp: 'hg 9/12/2001 20:11'! isDeltaModule ^true! ! !DeltaModule methodsFor: 'accessing' stamp: 'hg 10/9/2001 12:33'! baseClassFor: deltaClass | nonMeta | nonMeta _ self baseModule definitionFor: deltaClass theNonMetaClass name ifAbsent: [^nil]. ^deltaClass isMeta ifFalse: [nonMeta] ifTrue: [nonMeta class]! ! !DeltaModule methodsFor: 'accessing' stamp: 'hg 9/12/2001 20:12'! baseModule ^baseModule! ! !DeltaModule methodsFor: 'accessing' stamp: 'hg 10/11/2001 21:16'! baseModule: module baseModule _ module! ! !DeltaModule methodsFor: 'accessing' stamp: 'hg 10/10/2001 18:22'! name ^(self baseModule printString, 'Delta') asSymbol ! ! !DeltaModule methodsFor: 'initializing' stamp: 'hg 9/12/2001 20:16'! baseModule: base parentModule: parent baseModule _ base. parentModule _ parent! ! !DeltaModule methodsFor: 'changing defined names' stamp: 'hg 10/9/2001 13:25'! addAssoc: assoc export: exportIt "by default add DeltaAssociation with previousValue = nil" ^super addAssoc: (assoc as: DeltaAssociation) export: exportIt ! ! !DeltaModule methodsFor: 'changing defined names' stamp: 'hg 9/20/2001 09:49'! redefineName: aString as: value export: exportIt "special version so as not to also put globals in Smalltalk" aString first isUppercase ifFalse: [self error: 'global names must be Capitalized']. self addAssoc: (aString asSymbol)->value export: exportIt ! ! !DeltaModule methodsFor: 'module composition' stamp: 'hg 9/25/2001 19:06'! addNeighborModuleRef: moduleReference "cf. DeltaModule>>neighborModules " self error: 'you cannot add neighbor modules to DeltaModules'! ! !DeltaModule methodsFor: 'module composition' stamp: 'hg 10/14/2001 23:22'! changedNeighborModuleRefs "a DeltaModule does not define its neighbors, but changes to its baseModule's neighbors" ^super neighborModuleRefs! ! !DeltaModule methodsFor: 'module composition' stamp: 'hg 9/25/2001 19:34'! deepSubmodulesBottomUpDo: aBlock self deepSubmodulesDo: aBlock! ! !DeltaModule methodsFor: 'module composition' stamp: 'hg 10/15/2001 16:19'! neighborModuleRefs "a DeltaModule does not define its neighbors, but changes to its baseModule's neighbors (implement it properly later)" ^self baseModule neighborModuleRefs copyWith: (self baseModule parentModule refForNeighborModule: self baseModule)! ! !DeltaModule methodsFor: 'fileIn/Out' stamp: 'hg 10/14/2001 22:49'! classDefinitionFor: class "return a string with a message that defines the given class in this module. Use minimal definition for delta classes for now, since they can only contain method changes for now." ^(self isDeltaClass: class) ifFalse: [super classDefinitionFor: class] ifTrue: [ 'self deltaClassFor: self baseModule ', (self baseClassFor: class) name]! ! !DeltaModule methodsFor: 'fileIn/Out' stamp: 'hg 10/9/2001 14:42'! defineMethodRemovals: selectors forDeltaClass: deltaClass on: aStream aStream nextPutAll: deltaClass name, ' undefinedSelectors: ', selectors asSortedCollection asArray literalPrintString, ' forDeltaClass: ', deltaClass name, '.'; cr! ! !DeltaModule methodsFor: 'fileIn/Out' stamp: 'hg 10/11/2001 23:17'! fileOutMethodsOn: aStream moveSource: shouldMove toFile: anInteger "handle nil methods (i.e. methods marked for deletion)" | removals storableDeltaClass | self allClassesDo: [:cl | (cl class nonTrivial ifFalse: [Array with: cl] ifTrue: [Array with: cl with: cl class]) do: [:class | storableDeltaClass _ class clone. storableDeltaClass methodDictionary: class methodDictionary copy; organization: class organization copy. (self isDeltaClass: class) ifTrue: [ removals _ class methodDictionary select: [:cm | cm isNil]. removals isEmpty ifFalse: [ aStream nextPutAll: (self defineMethodRemovals: removals keys forDeltaClass: class on: aStream); cr]. removals do: [:sel | storableDeltaClass removeSelectorUnlogged: sel]]. storableDeltaClass fileOutContentsOn: aStream moveSource: shouldMove toFile: anInteger]]! ! !DeltaModule methodsFor: 'fileIn/Out' stamp: 'hg 10/14/2001 23:50'! neighborDefinitionsOn: aStream "store the changes that I make realtive to base. not the final implementaiton yet" self changedNeighborModuleRefs do: [:ref | aStream crtab. ref storeOn: aStream. aStream nextPut: $;]. aStream cr. ! ! !DeltaModule methodsFor: 'un/loading' stamp: 'hg 10/2/2001 23:22'! markAsActive: shouldBeActive isActive _ shouldBeActive! ! !DeltaModule methodsFor: 'un/loading' stamp: 'hg 10/9/2001 13:13'! switchActiveStatePhase1: shouldBeActive "Make me be active or inactive. A DeltaModule is a modified version of its baseModule. Activating a DM means to modify its baseModule by installing its changes into it. Phase 1 prepares before- and after-versions of all objects in the baseModule that should be changed. This is done without actually modifying the current baseModule. Then Phase 2 makes a quick and safe atomic switch between the before and after versions to enforce the activation." | preSwitchObjects postSwitchObjects beforeAfter | self isActive = shouldBeActive ifTrue: [^nil]. preSwitchObjects _ OrderedCollection new. postSwitchObjects _ OrderedCollection new. beforeAfter _ self switchDefinitions: shouldBeActive. preSwitchObjects add: beforeAfter first. postSwitchObjects add: beforeAfter second. beforeAfter _ self switchDeltaClasses: shouldBeActive. preSwitchObjects addAll: beforeAfter first. postSwitchObjects addAll: beforeAfter second. ^Array with: preSwitchObjects with: postSwitchObjects! ! !DeltaModule methodsFor: 'un/loading' stamp: 'hg 10/9/2001 18:37'! switchDefinitions: shouldBeActive | moduleAfter value | moduleAfter _ self baseModule veryDeepCopy. self definedNames associationsDo: [:assoc | value _ assoc valueWhenActive: shouldBeActive. (self isDeltaClass: value) ifFalse: [ assoc value ifNotNil: [ moduleAfter redefineName: assoc key as: value export: (self exportsName: assoc key)] ifNil: [ (moduleAfter definitionFor: assoc key ifAbsent: [nil]) ifNotNil: [moduleAfter removeName: assoc key]]]]. ^Array with: self baseModule with: moduleAfter! ! !DeltaModule methodsFor: 'un/loading' stamp: 'hg 10/9/2001 12:27'! switchDeltaClasses: shouldBeActive | preSwitchObjects postSwitchObjects | preSwitchObjects _ OrderedCollection new. postSwitchObjects _ OrderedCollection new. self deltaClassesDo: [:deltaClass | (Array with: deltaClass with: deltaClass class) do: [:cl | preSwitchObjects add: (self baseClassFor: cl). postSwitchObjects add: (self baseClassForDelta: cl asActive: shouldBeActive)]]. ^Array with: preSwitchObjects with: postSwitchObjects! ! !DeltaModule methodsFor: 'user interface' stamp: 'hg 10/12/2001 20:43'! moduleExplorerContents ^(Array with: (ModuleExplorerWrapper with: self baseModule name: 'base module' model: self)) , super moduleExplorerContents copyWith: (ModuleExplorerWrapper with: self isActive name: 'is activated' model: self)! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/9/2001 12:58'! baseClassForDelta: deltaClass asActive: shouldBeActive "return an instance of the base class after the changes of deltaClass have been (de)activated. Install if shouldBeActive is true, otherwise uninstall changes. This method should get more sophisticated over time to handle (de)activating 1. method additions, removals and modifications (handled now) 2. class var additions (removals ?) 3. inst var additions (removals ?) -- how handle existing instances? 4. deeper class format changes, e.g. changed superclass The hard part of 3-4 is to handle converting existing instances." | now after value selector | now _ self baseClassFor: deltaClass. after _ now clone copyMethodDictionaryFrom: now. deltaClass methodDictionary associationsDo: [:deltaAssoc | value _ deltaAssoc valueWhenActive: shouldBeActive. selector _ deltaAssoc key. value ifNil: [after removeSelectorUnlogged: selector] ifNotNil: [ after addSelector: selector withMethod: value. after organization classify: selector under: (deltaClass organization categoryOfElement: selector)]]. ^after! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/10/2001 14:56'! defineSelector: methodSymbol asMethod: methodOrNil previousVersion: oldMethodOrNil inClass: deltaClass "by convention, defining either old or new method as nil indicates the selector should be undefined" deltaClass methodDictionary removeKey: methodSymbol ifAbsent: []; add: (DeltaAssociation key: methodSymbol value: methodOrNil previousValue: oldMethodOrNil)! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/14/2001 18:32'! deltaClassFor: baseClass | deltaClass | deltaClass _ self deltaRepresentationForClass: baseClass. self redefineName: baseClass name as: deltaClass export: true. (self definedNames associationAt: baseClass name) previousValue: deltaClass. ^deltaClass. ! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/14/2001 18:34'! deltaClassFor: baseClassOrMeta forceCreate: create | baseClass deltaClass assoc | baseClass _ baseClassOrMeta theNonMetaClass. baseClass module == self baseModule ifFalse: [ self error: baseClass name, ' is not defined in my base module']. assoc _ self localAssocFor: baseClass name ifAbsent: [ ^create ifTrue: [self deltaClassFor: baseClass]]. deltaClass _ assoc value. (deltaClass isKindOf: Class) ifFalse: [ self error: assoc key, ' is not a class']. ^deltaClass. ! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/9/2001 12:29'! deltaClassesDo: aBlock self allClassesDo: [:class | (self isDeltaClass: class) ifTrue: [aBlock value: class]]! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 9/23/2001 16:10'! deltaRepresentationForClass: baseClass "return the object used to represent the regular class baseClass in a DeltaModule. For now use simplest possible copy of the original class, with its own copy of the meta class, for maximum compatibility." | meta delta | delta _ baseClass copy. meta _ delta class. self initializeClassDelta: meta. self initializeClassDelta: delta. ^delta! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/10/2001 15:00'! fixDeltaRepresentations "after e.g. a fileIn, deltaClasses have regular Associations, fix that here" self deltaClassesDo: [:deltaClass | deltaClass methodDictionary copy keysAndValuesDo: [:selector :cm | self defineSelector: selector asMethod: cm previousVersion: nil inClass: deltaClass]]! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/9/2001 16:12'! initializeClassDelta: delta "set module to me, and use a clean dictionary for method deltas" delta isMeta ifFalse: [delta module: self]. delta methodDictionary: Dictionary new. delta zapOrganization! ! !DeltaModule methodsFor: 'delta representations' stamp: 'hg 10/9/2001 14:39'! undefinedSelectors: selectors forDeltaClass: deltaClass (self isDeltaClass: deltaClass) ifFalse: [self error: 'not a delta class']. selectors do: [:sel | self defineSelector: sel asMethod: nil previousVersion: ((self baseClassFor: deltaClass) compiledMethodAt: sel) inClass: deltaClass]! ! !DeltaModule class methodsFor: 'instance creation' stamp: 'hg 9/12/2001 20:16'! baseModule: base parentModule: parent ^self new baseModule: base parentModule: parent! ! DeltaModule removeSelector: #defineMethodRemovals:forClass:! DeltaModule removeSelector: #defineMethodRemovals:forClass:on:! DeltaModule removeSelector: #fixDeltaRepresentation! DeltaModuleReference removeSelector: #createModuleFromPathAndVersion! DeltaModuleReference removeSelector: #findModuleFromPathAndVersion! DeltaModuleReference removeSelector: #hasModule! DeltaModuleReference removeSelector: #isExternalModule! !DeltaModuleReference reorganize! ('initializing' in:name:version:baseModule:import:) ('testing' isModuleResolved refersToDeltaModule refersToExternalModule) ('resolving' resolvedModule: specifiedPath) ('printing' storeOn:) !