Packages December 2009

packages@lists.squeakfoundation.org

1 participants
1032 discussions

The Trunk: Traits-ar.254.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

Andreas Raab uploaded a new version of Traits to project The Trunk: http://source.squeak.org/trunk/Traits-ar.254.mcz ==================== Summary ==================== Name: Traits-ar.254 Author: ar Time: 29 December 2009, 4:39:15 am UUID: 299d99f4-3397-994e-bda6-007fbf65caa7 Ancestors: Traits-ar.253 Shipping NanoTraits part 2: Commit package back after NanoTraits install. =============== Diff against Traits-ar.253 =============== Item was added: + ----- Method: Behavior>>providedSelectors (in category '*Traits') ----- + providedSelectors + ^ProvidedSelectors current for: self!

1 0

The Trunk: Traits-ar.253.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

Andreas Raab uploaded a new version of Traits to project The Trunk: http://source.squeak.org/trunk/Traits-ar.253.mcz ==================== Summary ==================== Name: Traits-ar.253 Author: ar Time: 29 December 2009, 4:27:03 am UUID: aacbbb6c-5526-f04e-927d-4461d769972f Ancestors: Traits-ar.252 Install NanoTraits. =============== Diff against Traits-ar.251 =============== Item was added: + ----- Method: ClassDescription>>traitAddSelector:withMethod: (in category '*Traits-NanoKernel') ----- + traitAddSelector: selector withMethod: traitMethod + "Add a method inherited from a trait. + Recompiles to avoid sharing and implement aliasing." + | oldMethod source methodNode newMethod originalSelector | + oldMethod := self compiledMethodAt: selector ifAbsent:[nil]. + oldMethod ifNotNil:[ + "The following is an important optimization as it prevents exponential + growth in recompilation. If T1 is used by T2 and T2 by T3 then (without + this optimization) any change in T1 would cause all methods in T2 to be + recompiled and each recompilation of a method in T2 would cause T3 + to be fully recompiled. The test eliminates all such situations." + (oldMethod sameTraitCodeAs: traitMethod) ifTrue:[^oldMethod]. + ]. + originalSelector := traitMethod selector. + source := traitMethod methodClass sourceCodeAt: originalSelector. + originalSelector == selector ifFalse:[ + "Replace source selectors for aliases" + source := self replaceSelector: originalSelector withAlias: selector in: source. + ]. + methodNode := self compilerClass new + compile: source in: self classified: nil notifying: nil ifFail:[^nil]. + newMethod := methodNode generate: self defaultMethodTrailer. + newMethod putSource: source fromParseNode: methodNode inFile: 2 + withPreamble: [:f | f cr; nextPut: $!!; nextChunkPut: 'Trait method'; cr]. + newMethod originalTraitMethod: traitMethod. + ^super addSelectorSilently: selector withMethod: newMethod.! Item was added: + ----- Method: ClassDescription>>isLocalMethod: (in category '*Traits-NanoKernel') ----- + isLocalMethod: aCompiledMethod + "Answer true if the method is a local method, e.g., defined in the receiver instead of a trait." + ^aCompiledMethod methodHome == self! Item was added: + ----- Method: Metaclass>>updateTraitsFrom: (in category '*Traits-NanoKernel') ----- + updateTraitsFrom: instanceTraits + "Update me from the given instance traits" + | map newTraits trait | + ((instanceTraits isKindOf: NanoTraitComposition) or:[instanceTraits isEmpty]) + ifFalse:[self error: 'Invalid trait']. + + map := Dictionary new. + self traitComposition isEmpty ifFalse:[ + self traitComposition do:[:composed| map at: composed trait put: composed]. + ]. + + newTraits := (instanceTraits collect:[:composed| + trait := composed trait classTrait. + map at: trait ifAbsent:[trait]]). + + self traitComposition isEmpty ifFalse:[ + newTraits := newTraits, (self traitComposition select:[:comp| comp trait isBaseTrait]). + ]. + self installTraitsFrom: newTraits! Item was added: + ----- Method: NanoTrait>>baseTrait (in category 'accessing') ----- + baseTrait + ^self! Item was added: + ----- Method: NanoTraitDescription>>traitComposition: (in category 'accessing') ----- + traitComposition: aTraitComposition + traitComposition := aTraitComposition. + ! Item was added: + ----- Method: ClassDescription>>setTraitComposition: (in category '*Traits-NanoKernel') ----- + setTraitComposition: aTraitComposition + "OBSOLETE. Use Class uses: aTraitComposition instead." + (aTraitComposition isKindOf: NanoTraitComposition) + ifTrue:[^self uses: aTraitComposition]. + (aTraitComposition isKindOf: TraitComposition) + ifTrue:[^super setTraitComposition: aTraitComposition]. + "Unspecified. Check for prevailing traitOverride" + ClassDescription traitImpl == NanoTrait + ifTrue:[^self uses: aTraitComposition] + ifFalse:[^super setTraitComposition: aTraitComposition].! Item was added: + ----- Method: NanoClassTrait>>soleInstance (in category 'accessing') ----- + soleInstance + ^baseTrait! Item was added: + ----- Method: NanoTraitDescription>>isClassTrait (in category 'testing') ----- + isClassTrait + ^false! Item was added: + ----- Method: NanoTraitComposition>>isAliasSelector: (in category 'operations') ----- + isAliasSelector: selector + "enumerates all selectors and methods in a trait composition" + ^self anySatisfy:[:any| any isAliasSelector: selector]! Item was added: + ----- Method: NanoTraitTransformation>>addTraitUser: (in category 'accessing') ----- + addTraitUser: aTrait + users := users copyWith: aTrait. + subject addTraitUser: aTrait. + ! Item was added: + ----- Method: NanoTrait class>>updateTraits: (in category 'installing') ----- + updateTraits: aCollection + "Convert all the traits in aCollection to NanoTraits. Used during installation." + "ClassDescription traitImpl: NanoTrait. + NanoTrait updateTraits:{ + TSequencedStreamTest. TGettableStreamTest. TReadStreamTest. + TStreamTest. TPuttableStreamTest. TWriteStreamTest + }" + | remain processed classes oldTrait classDef newTrait count instTraits classSelectors | + ClassDescription traitImpl == self ifFalse:[self error: 'What are you doing???']. + remain := (aCollection reject:[:tc| tc isKindOf: self]) asSet. + processed := Set new. + classes := Set new. + count := 0. + 'Converting ....' displayProgressAt: Sensor cursorPoint from: 1 to: remain size during:[:bar| + [remain isEmpty] whileFalse:[ + "Pick any trait whose traits are already converted" + oldTrait := remain detect:[:any| + any traitComposition traits allSatisfy:[:t| (Smalltalk at: t name) isKindOf: self]. + ] ifNone:[self error: 'Cannot convert cyclic traits']. + remain remove: oldTrait. + + bar value: (count := count +1). + ProgressNotification signal: '' extra: 'Converting ', oldTrait name. + + "Silently remove the old trait class and recreate it based on NanoTrait" + classDef := oldTrait definition. + Smalltalk removeKey: oldTrait name. + + "Create the NanoTrait from the same definition" + newTrait := Compiler evaluate: classDef. + + "Update comment" + oldTrait organization classComment ifNotEmpty:[ + newTrait classComment: oldTrait organization commentRemoteStr + stamp: oldTrait organization commentStamp. + ]. + + "Copy local methods to new trait" + oldTrait localSelectors do:[:sel| + newTrait + compile: (oldTrait sourceCodeAt: sel) + classified: (oldTrait organization categoryOfElement: sel) + withStamp: (oldTrait compiledMethodAt: sel) timeStamp + notifying: nil + ]. + oldTrait classSide localSelectors do:[:sel| + newTrait classSide + compile: (oldTrait classSide sourceCodeAt: sel) + classified: (oldTrait classSide organization categoryOfElement: sel) + withStamp: (oldTrait classSide compiledMethodAt: sel) timeStamp + notifying: nil + ]. + + newTrait selectors sort = oldTrait selectors sort + ifFalse:[self error: 'Something went VERY wrong']. + newTrait classSide selectors sort = oldTrait classSide selectors sort + ifFalse:[self error: 'Something went VERY wrong']. + + processed add: oldTrait. + classes addAll: (oldTrait users reject:[:aClass| aClass isObsolete]). + ]. + ]. + + classes := classes asArray select:[:cls| cls isKindOf: ClassDescription]. + 'Updating ....' displayProgressAt: Sensor cursorPoint from: 1 to: classes size during:[:bar| + "The traits are all converted, next update the classes" + classes keysAndValuesDo:[:index :aClass| + bar value: index. + ProgressNotification signal: '' extra: 'Updating ', aClass name. + + instTraits := Compiler evaluate: aClass traitComposition asString. + "Keep the local selectors from before" + localSelectors := aClass localSelectors. + classSelectors := aClass class localSelectors. + "Nuke the old traits composition" + aClass traitComposition: nil. + aClass class traitComposition: nil. + "Install the new one" + aClass uses: instTraits. + "Remove the old trait (now local) selectors" + (aClass selectors reject:[:sel| localSelectors includes: sel]) do:[:sel| + aClass removeSelectorSilently: sel. + (aClass includesSelector: sel) ifFalse:[self halt: 'Where is the code?']. + ]. + (aClass class selectors reject:[:sel| classSelectors includes: sel]) do:[:sel| + aClass class removeSelectorSilently: sel. + (aClass class includesSelector: sel) ifFalse:[self halt: 'Where is the code?']. + ]. + ]. + ]. + + "Finally, obsolete all the old traits" + processed do:[:trait| trait obsolete]. + ! Item was added: + ----- Method: NanoTraitDescription>>@ (in category 'operations') ----- + @ anArrayOfAssociations + "Creates an alias" + ^ NanoTraitAlias with: self aliases: anArrayOfAssociations! Item was added: + ----- Method: ClassDescription>>traitRemoveSelector: (in category '*Traits-NanoKernel') ----- + traitRemoveSelector: selector + "Remove the message whose selector is given from the method + dictionary of the receiver, if it is there. Answer nil otherwise." + | priorMethod priorProtocol | + priorMethod := self compiledMethodAt: selector ifAbsent: [^ nil]. + priorProtocol := self whichCategoryIncludesSelector: selector. + SystemChangeNotifier uniqueInstance doSilently: [ + self organization removeElement: selector]. + super basicRemoveSelector: selector. + SystemChangeNotifier uniqueInstance + methodRemoved: priorMethod selector: selector inProtocol: priorProtocol class: self. + (self organization isEmptyCategoryNamed: priorProtocol) + ifTrue:[self organization removeCategory: priorProtocol]. + ! Item was added: + ----- Method: NanoTraitDescription class>>conflict:with:with:with:with:with: (in category 'conflict methods') ----- + conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: NanoTraitComposition>>@ (in category 'converting') ----- + @ anArrayOfAssociations + "the modifier operators #@ and #- bind stronger than +. + Thus, #@ or #- sent to a sum will only affect the most right summand" + + self addLast: (self removeLast @ anArrayOfAssociations)! Item was added: + ----- Method: NanoTraitDescription>>fileOut (in category 'fileIn/Out') ----- + fileOut + "Create a file whose name is the name of the receiver with '.st' as the + extension, and file a description of the receiver onto it." + ^ self fileOutAsHtml: false! Item was added: + ----- Method: NanoClassTrait>>theNonMetaClass (in category 'accessing') ----- + theNonMetaClass + "Sent to a class or metaclass, always return the class" + ^baseTrait! Item was added: + ----- Method: NanoTraitExclusion>>@ (in category 'converting') ----- + @ anArrayOfAssociations + + NanoTraitCompositionException signal: 'Invalid trait exclusion. Aliases have to be specified before exclusions.' + ! Item was added: + ----- Method: NanoTraitExclusion>>includesSelector: (in category 'composition') ----- + includesSelector: selector + "Answers true if the receiver provides the selector" + ^(subject includesSelector: selector) and:[(exclusions includes: selector) not]! Item was added: + ----- Method: NanoTraitTransformation>>isAliasSelector: (in category 'testing') ----- + isAliasSelector: selector + ^subject isAliasSelector: selector! Item was added: + ----- Method: NanoTrait>>obsolete (in category 'initialize') ----- + obsolete + self name: ('AnObsolete' , self name) asSymbol. + super obsolete! Item was added: + ----- Method: NanoTraitComposition>>isLocalAliasSelector: (in category 'operations') ----- + isLocalAliasSelector: selector + "Return true if the selector aSymbol is an alias defined in the receiver." + ^self anySatisfy:[:any| any isTraitTransformation and:[any isLocalAliasSelector: selector]]! Item was added: + ----- Method: NanoTraitTransformation>>removeTraitUser: (in category 'accessing') ----- + removeTraitUser: aTrait + users := users copyWithout: aTrait. + subject removeTraitUser: aTrait.! Item was added: + ----- Method: NanoTraitTransformation>>allTraits (in category 'accessing') ----- + allTraits + ^subject allTraits! Item was added: + ----- Method: NanoTraitDescription>>installTraitsFrom: (in category 'operations') ----- + installTraitsFrom: aTraitComposition + super installTraitsFrom: aTraitComposition. + self users do:[:each| each updateTraits].! Item was added: + ----- Method: NanoTraitTransformation>>@ (in category 'converting') ----- + @ anArrayOfAssociations + ^self subclassResponsibility! Item was added: + ----- Method: NanoTrait class>>named:uses:category: (in category 'public') ----- + named: aSymbol uses: aTraitCompositionOrCollection category: aString + "Dispatch through ClassDescription for alternative implementations" + ^ClassDescription newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString! Item was added: + NanoTraitTransformation subclass: #NanoTraitAlias + instanceVariableNames: 'aliases' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoTraitAlias commentStamp: '<historical>' prior: 0! + A trait transformation representing the alias (->) operator.! Item was added: + ----- Method: NanoTraitDescription>>fileOutAsHtml: (in category 'fileIn/Out') ----- + fileOutAsHtml: useHtml + "File a description of the receiver onto a new file whose base name is the name of the receiver." + + | internalStream | + internalStream := WriteStream on: (String new: 100). + internalStream header; timeStamp. + + self fileOutOn: internalStream moveSource: false toFile: 0. + internalStream trailer. + + FileStream writeSourceCodeFrom: internalStream baseName: self name isSt: true useHtml: useHtml. + ! Item was added: + ----- Method: NanoTraitTransformation>>isLocalAliasSelector: (in category 'testing') ----- + isLocalAliasSelector: selector + ^false! Item was added: + ----- Method: NanoTraitTransformation>>updateTraits (in category 'operations') ----- + updateTraits + "Recompute my users traits composition" + users do:[:each| each updateTraits].! Item was added: + ----- Method: NanoTraitDescription>>printHierarchy (in category 'printing') ----- + printHierarchy + "For hierarchy view in the browser; print the users of a trait" + ^String streamContents:[:s| self printUsersOf: self on: s level: 0].! Item was added: + ----- Method: NanoTrait>>isObsolete (in category 'testing') ----- + isObsolete + "Return true if the receiver is obsolete." + ^(self environment at: name ifAbsent: [nil]) ~~ self! Item was added: + ----- Method: ClassDescription>>traitComposition: (in category '*Traits-NanoKernel') ----- + traitComposition: aTraitComposition + "Install my traits" + ^self subclassResponsibility! Item was added: + ----- Method: ClassDescription>>isAliasSelector: (in category '*Traits-NanoKernel') ----- + isAliasSelector: aSymbol + "Return true if the selector aSymbol is an alias defined + in my or in another composition somewhere deeper in + the tree of traits compositions." + + ^(self includesLocalSelector: aSymbol) not + and: [self hasTraitComposition] + and: [self traitComposition isAliasSelector: aSymbol]! Item was added: + ----- Method: NanoClassTrait>>classSide (in category 'accessing') ----- + classSide + ^self! Item was added: + ----- Method: Array>>asTraitComposition (in category '*Traits-NanoKernel') ----- + asTraitComposition + "For convenience the composition {T1. T2 ...} is the same as T1 + T2 + ..." + ^self isEmpty + ifFalse: [ + self size = 1 + ifTrue: [self first asTraitComposition] + ifFalse: [ + self copyWithoutFirst + inject: self first + into: [:left :right | left + right]]] + ifTrue: [ClassDescription newTraitComposition]! Item was added: + ----- Method: ClassDescription>>hasTraitComposition (in category '*Traits-NanoKernel') ----- + hasTraitComposition + ^self traitComposition notEmpty! Item was added: + ----- Method: ClassDescription>>classify:under:from:trait: (in category '*Traits-NanoKernel') ----- + classify: selector under: heading from: category trait: aTrait + "Update the organization for a trait. the dumb, unoptimized version" + self updateTraits.! Item was added: + ----- Method: ClassDescription>>localSelectors (in category '*Traits-NanoKernel') ----- + localSelectors + ^(self traitComposition isKindOf: NanoTraitComposition) + ifTrue:[self selectors select:[:sel| self includesLocalSelector: sel]] + ifFalse:[super localSelectors]. + ! Item was added: + ----- Method: NanoTraitComposition>>traitCompositionString (in category 'operations') ----- + traitCompositionString + "Answer the trait composition string (used for class definitions)" + self size = 0 ifTrue:[^'{}']. + self size = 1 ifTrue:[^self first asString]. + ^String streamContents:[:s| + self do:[:each| s nextPutAll: each asString] separatedBy:[s nextPutAll: ' + ']. + ].! Item was added: + ----- Method: NanoTrait class>>unloadBerneTraits (in category 'installing') ----- + unloadBerneTraits + "Unload Berne traits via Monticello" + #(TraitBehavior TraitDescription ClassTrait) do:[:clsName| + Smalltalk at: clsName ifPresent:[:aClass| aClass traitComposition: nil]]. + + "Special for Trait since it becomes a plain old global" + Smalltalk at: #Trait ifPresent:[:aClass| + aClass name == #Trait ifTrue:[aClass traitComposition: nil]. + ]. + Smalltalk at: #ModelExtension ifPresent:[:aClass| + aClass withAllSubclassesDo:[:subclass| + SystemChangeNotifier uniqueInstance noMoreNotificationsFor: subclass. + SystemChangeNotifier uniqueInstance noMoreNotificationsFor: subclass current. + ]]. + + (MCPackage named: 'Traits') unload. + + Smalltalk allClassesDo:[:aClass| + aClass basicLocalSelectors: nil. + aClass class basicLocalSelectors: nil. + aClass traitComposition class isObsolete + ifTrue:[aClass traitComposition: nil]. + aClass classSide traitComposition class isObsolete + ifTrue:[aClass classSide traitComposition: nil]. + ]. + ! Item was added: + ----- Method: ClassDescription>>isLocalAliasSelector: (in category '*Traits-NanoKernel') ----- + isLocalAliasSelector: aSymbol + "Return true if the selector aSymbol is an alias defined + in my or in another composition somewhere deeper in + the tree of traits compositions." + + ^(self includesLocalSelector: aSymbol) not + and: [self hasTraitComposition] + and: [self traitComposition isLocalAliasSelector: aSymbol]! Item was added: + ----- Method: ClassDescription>>updateTraits (in category '*Traits-NanoKernel') ----- + updateTraits + "Recompute my local traits composition" + (self traitComposition isKindOf: NanoTraitComposition) + ifTrue:[self installTraitsFrom: self traitComposition]. + ! Item was added: + ----- Method: NanoTraitDescription class>>conflict: (in category 'conflict methods') ----- + conflict: arg1 + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: NanoClassTrait>>definition (in category 'accessing') ----- + definition + ^String streamContents: [:stream | + stream nextPutAll: self name. + stream cr; tab; nextPutAll: 'uses: '; + nextPutAll: self traitComposition asString. + ].! Item was added: + ----- Method: NanoClassTrait>>baseTrait (in category 'accessing') ----- + baseTrait + ^baseTrait! Item was added: + NanoTraitBehavior subclass: #NanoTraitDescription + instanceVariableNames: 'users traitComposition' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoTraitDescription commentStamp: 'ar 12/3/2009 23:42' prior: 0! + TraitDescription combines common behavior for both (instance) traits and (meta) class traits.! Item was added: + ----- Method: NanoTraitAlias>>printOn: (in category 'operations') ----- + printOn: s + "Answer the trait composition string (used for class definitions)" + s nextPutAll: subject asString. + s nextPutAll: ' @ {'. + aliases do:[:assoc| s print: assoc] separatedBy:[s nextPutAll:'. ']. + s nextPutAll: '}'. + ! Item was added: + ----- Method: ClassDescription>>includesLocalSelector: (in category '*Traits-NanoKernel') ----- + includesLocalSelector: selector + self traitComposition isEmpty "guard for Berne traits" + ifTrue:[^self includesSelector: selector]. + ^(self traitComposition isKindOf: NanoTraitComposition) + ifTrue:[(self compiledMethodAt: selector ifAbsent:[^false]) methodHome == self] + ifFalse:[super includesLocalSelector: selector].! Item was added: + ----- Method: NanoTraitAlias>>includesSelector: (in category 'operations') ----- + includesSelector: selector + "Answers true if the receiver provides the selector" + ^(subject includesSelector: selector) or:[aliases anySatisfy:[:assoc| assoc key == selector]]! Item was added: + Error subclass: #NanoTraitCompositionException + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoTraitCompositionException commentStamp: '<historical>' prior: 0! + Signals invalid trait compositions.! Item was added: + ----- Method: ClassDescription>>installTraitsFrom: (in category '*Traits-NanoKernel') ----- + installTraitsFrom: aTraitComposition + "Install the traits from the given composition" + | allTraits methods oldMethod removals oldCategories | + (aTraitComposition isKindOf: NanoTraitComposition) + ifFalse:[self error: 'Invalid composition']. + (self traitComposition isEmpty and: [aTraitComposition isEmpty]) ifTrue: [^self]. + + "Check for cycles" + allTraits := aTraitComposition gather: [:t | t allTraits copyWith: t]. + (allTraits includes: self) ifTrue:[^self error: 'Cyclic trait definition detected']. + + "XXXX: addUser/removeUser should be part of setter, but subclass + override prevents it until we've got rid of Traits mess." + self traitComposition removeTraitUser: self. + self traitComposition: aTraitComposition. + aTraitComposition addTraitUser: self. + + "Assemble the methods in a new dictionary first. + Uses a Dictionary instead of a MethodDictionary for speed (MDs grow by #become:)" + methods := Dictionary new. + + "Stick in the local methods first, since this avoids generating conflict methods unnecessarily" + self selectorsAndMethodsDo:[:sel :newMethod| + (self isLocalMethod: newMethod) + ifTrue:[methods at: sel put:newMethod]]. + + "Now assemble the traits methods" + aTraitComposition do:[:trait| + trait selectorsAndMethodsDo:[:sel :newMethod| + oldMethod := methods at: sel ifAbsentPut:[newMethod]. + newMethod == oldMethod ifFalse:["a conflict" + (self isLocalMethod: oldMethod) ifFalse:[ + methods at: sel put: (self resolveTraitsConflict: sel from: oldMethod to: newMethod). + ]. + ]. + ]. + ]. + + "Apply the changes. We first add the new or changed methods." + oldCategories := Set new. + methods keysAndValuesDo:[:sel :newMethod| + oldMethod := self compiledMethodAt: sel ifAbsent:[nil]. + oldMethod == newMethod ifFalse:[ + self traitAddSelector: sel withMethod: newMethod. + (self organization categoryOfElement: sel) ifNotNil:[:cat| oldCategories add: cat]. + self organization classify: sel under: + (newMethod methodHome organization categoryOfElement: newMethod selector). + ]]. + + "Now remove the old or obsoleted ones" + removals := OrderedCollection new. + self selectorsDo:[:sel| (methods includesKey: sel) ifFalse:[removals add: sel]]. + removals do:[:sel| self traitRemoveSelector: sel]. + + "Clean out empty categories" + oldCategories do:[:cat| + (self organization isEmptyCategoryNamed: cat) + ifTrue:[self organization removeCategory: cat]]. + + self isMeta ifFalse:[self class updateTraitsFrom: aTraitComposition].! Item was added: + ----- Method: NanoTraitDescription>>classPool (in category 'accessing') ----- + classPool + "Traits have no class pool" + ^ Dictionary new! Item was added: + ----- Method: NanoTraitAlias>>aliases: (in category 'accessing') ----- + aliases: aCollection + "Collection of associations where key is the + alias and value the original selector." + aliases := aCollection! Item was added: + Object subclass: #NanoTraitTransformation + instanceVariableNames: 'subject users' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoTraitTransformation commentStamp: '<historical>' prior: 0! + A trait transformation is an instance of one of my concrete subclasses, TraitAlias or TraitExclusion. These represent a transformation of a trait, specified by the alias and exclusion operators. + + I define an instance variable named subject which holds the object that is transformed. Thus, an alias transformation has as its subject a trait, and a trait exclusion has as its subject either a trait alias or a trait. Each of the concrete transformation classes implement the method allSelectors according to the transformation it represents. + ! Item was added: + ----- Method: NanoTraitAlias>>isLocalAliasSelector: (in category 'testing') ----- + isLocalAliasSelector: selector + ^(aliases anySatisfy:[:assoc| assoc key == selector])! Item was added: + ----- Method: NanoTrait class>>install (in category 'installing') ----- + install "NanoTrait install" + "Installs NanoTraits" + + "Force recompilation of basic classes to get traits aliasing right" + {Behavior. ClassDescription. Class. Metaclass} do:[:aClass| + aClass selectorsDo:[:sel| + aClass + compile: (aClass sourceCodeAt: sel) + classified: (aClass organization categoryOfElement: sel) + withStamp: (aClass compiledMethodAt: sel) timeStamp + notifying: nil]. + aClass setTraitCompositionFrom: {}]. + + ClassDescription traitImpl: self. "Create all new traits as NanoTraits" + self updateTraits: Smalltalk allTraits. "And convert everything to NanoTraits" + Smalltalk allClassesAndTraitsDo:[:aClass| + aClass traitComposition isEmpty + ifTrue:[aClass traitComposition: nil]. + aClass classSide traitComposition isEmpty + ifTrue:[aClass classSide traitComposition: nil]]. + + "TWriteStreamTest has the class traits reversed which which will be undone + by installation. Put it back in reverse order to keep MC happy." + TWriteStreamTest classTrait + uses: TSequencedStreamTest classTrait + TPuttableStreamTest classTrait + ! Item was added: + ----- Method: NanoTraitTransformation>>isTraitTransformation (in category 'testing') ----- + isTraitTransformation + "Polymorphic with Trait" + ^true! Item was added: + ----- Method: NanoTrait>>classTrait (in category 'accessing') ----- + classTrait + ^self class! Item was added: + ----- Method: NanoTraitComposition>>traits (in category 'accessing') ----- + traits + ^Array streamContents:[:s| self traitsDo:[:t| s nextPut: t]]! Item was added: + ----- Method: NanoTraitAlias class>>assertValidAliasDefinition: (in category 'instance creation') ----- + assertValidAliasDefinition: anArrayOfAssociations + "Throw an exceptions if the alias definition is not valid. + It is expected to be a collection of associations and + the number of arguments of the alias selector has to + be the same as the original selector." + + ((anArrayOfAssociations isKindOf: Collection) and: [ + anArrayOfAssociations allSatisfy: [:each | + each isKindOf: Association]]) ifFalse: [ + self error: 'Invalid alias definition: Not a collection of associations.']. + + (anArrayOfAssociations allSatisfy: [:association | + (association key numArgs = association value numArgs and: [ + (association key numArgs = -1) not])]) ifFalse: [ + NanoTraitCompositionException signal: 'Invalid alias definition: Alias and original selector have to have the same number of arguments.']! Item was added: + ----- Method: NanoTraitAlias>>copyTraitExpression (in category 'operations') ----- + copyTraitExpression + "Copy all except the actual traits" + ^NanoTraitAlias + with: subject + aliases: aliases! Item was added: + ----- Method: NanoTrait>>environment (in category 'accessing') ----- + environment + ^environment! Item was added: + ----- Method: NanoTraitDescription class>>conflict:with:with: (in category 'conflict methods') ----- + conflict: arg1 with: arg2 with: arg3 + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: NanoTrait>>name (in category 'accessing') ----- + name + ^name! Item was added: + ----- Method: NanoTraitDescription>>+ (in category 'operations') ----- + + aTrait + "Creates a composition with the receiver and aTrait" + aTrait traitsDo:[:t| self == t ifTrue:[NanoTraitCompositionException + signal: 'Trait ' , self asString, ' already in composition']]. + ^NanoTraitComposition withAll: {self}, aTrait asTraitComposition! Item was added: + ----- Method: ClassDescription>>traitCompositionString (in category '*Traits-NanoKernel') ----- + traitCompositionString + "Answer the trait composition string for the receiver" + ^self traitComposition isEmpty + ifTrue:['{}'] + ifFalse:[self traitComposition asString].! Item was added: + ----- Method: ClassDescription>>uses: (in category '*Traits-NanoKernel') ----- + uses: aTraitComposition + | newTraits | + newTraits := (aTraitComposition isKindOf: NanoTrait orOf: NanoTraitTransformation) + ifTrue:[NanoTraitComposition with: aTraitComposition] + ifFalse:[(aTraitComposition isKindOf: SequenceableCollection) + ifTrue:[NanoTraitComposition withAll: aTraitComposition asArray] + ifFalse:[self error: 'Invalid traits specification']]. + self installTraitsFrom: newTraits. + ! Item was added: + ----- Method: NanoTraitComposition>>+ (in category 'converting') ----- + + aTrait + self traitsDo:[:t| (t == aTrait trait) ifTrue:[^NanoTraitCompositionException + signal: 'Trait ' , aTrait trait asString, ' already in composition']]. + self addLast: aTrait. + ^self! Item was added: + ----- Method: NanoTrait>>category (in category 'accessing') ----- + category + "Answer the system organization category for the receiver. First check whether the + category name stored in the ivar is still correct and only if this fails look it up + (latter is much more expensive)" + + | result | + category ifNotNilDo: [ :symbol | + ((SystemOrganization listAtCategoryNamed: symbol) includes: self name) + ifTrue: [ ^symbol ] ]. + category := (result := SystemOrganization categoryOfElement: self name). + ^result! Item was added: + ----- Method: NanoTraitDescription>>removeTraitUser: (in category 'accessing') ----- + removeTraitUser: aTrait + users := self users copyWithout: aTrait. + ! Item was added: + ----- Method: NanoTraitComposition>>allTraits (in category 'accessing') ----- + allTraits + ^self gather:[:each| each allTraits copyWith: each trait]! Item was added: + ----- Method: NanoTraitComposition>>removeTraitUser: (in category 'accessing') ----- + removeTraitUser: aUser + self do:[:each| each removeTraitUser: aUser]! Item was added: + ----- Method: ClassDescription>>replaceSelector:withAlias:in: (in category '*Traits-NanoKernel') ----- + replaceSelector: originalSelector withAlias: aliasSelector in: source + "replaces originalSelector with aliasSelector in in given source code" + | oldKeywords newKeywords args selectorWithArgs s | + oldKeywords := originalSelector keywords. + newKeywords := aliasSelector keywords. + oldKeywords size = newKeywords size ifFalse:[self error: 'Keyword mismatch']. + args := (self parserClass new parseArgsAndTemps: source asString notifying: nil) + copyFrom: 1 to: originalSelector numArgs. + selectorWithArgs := String streamContents: [:stream | + newKeywords keysAndValuesDo: [:index :keyword | + stream nextPutAll: keyword. + stream space. + args size >= index ifTrue: [ + stream nextPutAll: (args at: index); space]]]. + s := source asString readStream. + oldKeywords do: [ :each | s match: each ]. + args isEmpty ifFalse: [ s match: args last ]. + ^selectorWithArgs withBlanksTrimmed asText , s upToEnd + ! Item was added: + ----- Method: NanoTraitComposition>>removeUser: (in category 'accessing') ----- + removeUser: aUser + ^self removeTraitUser: aUser! Item was added: + ----- Method: NanoTraitComposition>>printOn: (in category 'converting') ----- + printOn: aStream + "Answer the trait composition string (used for class definitions)" + aStream nextPutAll: self traitCompositionString. + ! Item was added: + ----- Method: NanoTraitTransformation>>+ (in category 'converting') ----- + + aTrait + "Just like ordered collection" + ^NanoTraitComposition withAll: {self. aTrait}! Item was added: + ----- Method: NanoTraitAlias>>initializeFrom: (in category 'initialize-release') ----- + initializeFrom: anArrayOfAssociations + | newNames | + newNames := (anArrayOfAssociations collect: [:each | each key]) asIdentitySet. + newNames size < anArrayOfAssociations size ifTrue: [ + NanoTraitCompositionException signal: 'Cannot use the same alias name twice']. + anArrayOfAssociations do: [:each | + (newNames includes: each value) ifTrue: [ + NanoTraitCompositionException signal: 'Cannot define an alias for an alias']]. + aliases := anArrayOfAssociations. + ! Item was added: + ----- Method: NanoTraitTransformation>>subject: (in category 'accessing') ----- + subject: aSubject + subject := aSubject.! Item was added: + ----- Method: NanoTrait class>>unloadNanoTraits (in category 'installing') ----- + unloadNanoTraits + "Unload NanoTraits" + ClassDescription traitImpl == self + ifTrue:[ClassDescription traitImpl: nil]. + + CompiledMethod allInstancesDo:[:cm| + "Clean out NanoTraitState for all methods; this makes all methods local" + (cm properties isKindOf: NanoTraitMethodState) ifTrue:[ + cm penultimateLiteral: (AdditionalMethodState newFrom: cm properties). + ]. + ]. + + self allTraitsDo:[:trait| + "Clean out the existing users for this trait" + trait users do:[:user| user uses: {}]. + ]. + + "We need a stub updateTraits method during unload" + [Behavior halt compileSilently: 'updateTraits' classified: nil. + "Finally, unload NanoTraits" + (MCPackage named: 'NanoTraits') unload. + ] ensure:[Behavior removeSelectorSilently: #updateTraits]. + + Smalltalk allClassesAndTraitsDo:[:aClass| + "Clean out existing NanoTraitCompositions" + (aClass traitComposition class isObsolete) + ifTrue:[aClass traitComposition: #()]. + (aClass classSide traitComposition class isObsolete) + ifTrue:[aClass classSide traitComposition: #()]. + ]. + + Smalltalk at: #Trait ifPresent:[:aClass| + aClass isObsolete ifTrue:[Smalltalk at: #Trait put: nil]. + ]. + + Compiler recompileAll.! Item was added: + ----- Method: NanoTrait>>bindingOf: (in category 'compiling') ----- + bindingOf: varName + "Answer the binding of some variable resolved in the scope of the receiver" + ^self environment bindingOf: varName asSymbol.! Item was added: + ----- Method: NanoTraitExclusion>>printOn: (in category 'composition') ----- + printOn: aStream + "Answer the trait composition string (used for class definitions)" + aStream nextPutAll: subject asString. + aStream nextPutAll: ' - {'. + exclusions asArray sort do:[:exc| aStream store: exc] separatedBy:[aStream nextPutAll: '. ']. + aStream nextPutAll: '}'.! Item was added: + ----- Method: ClassDescription>>basicRemoveSelector: (in category '*Traits-NanoKernel') ----- + basicRemoveSelector: aSelector + "Remove the message whose selector is given from the method + dictionary of the receiver, if it is there. Update the trait composition." + | oldMethod | + oldMethod := super basicRemoveSelector: aSelector. + oldMethod ifNotNil:[self updateTraits]. + ^oldMethod! Item was added: + ----- Method: ClassDescription>>traits (in category '*Traits-NanoKernel') ----- + traits + "Answer an array of my traits" + ^self traitComposition asArray collect:[:composed| composed trait]! Item was added: + ----- Method: NanoClassTrait>>asMCDefinition (in category 'monticello') ----- + asMCDefinition + ^Smalltalk at: #MCClassTraitDefinition ifPresent:[:aClass| + aClass + baseTraitName: self baseTrait name + classTraitComposition: self traitCompositionString + ].! Item was added: + ----- Method: NanoTraitDescription>>copyTraitExpression (in category 'copying') ----- + copyTraitExpression + "Copy all except the actual traits" + ^self! Item was added: + ----- Method: NanoTraitDescription>>users (in category 'accessing') ----- + users + ^users ifNil:[#()]! Item was added: + ----- Method: NanoTraitComposition>>removeFromComposition: (in category 'compat') ----- + removeFromComposition: aTrait + "--- ignore ---"! Item was added: + ----- Method: NanoTraitComposition>>selectorsAndMethodsDo: (in category 'operations') ----- + selectorsAndMethodsDo: aBlock + "enumerates all selectors and methods in a trait composition" + self do:[:each| each selectorsAndMethodsDo: aBlock].! Item was added: + ----- Method: NanoTraitComposition>>copyTraitExpression (in category 'operations') ----- + copyTraitExpression + "Copy all except the actual traits" + ^self collect:[:each| each copyTraitExpression].! Item was added: + ----- Method: NanoTraitExclusion class>>with:exclusions: (in category 'instance creation') ----- + with: aTraitComposition exclusions: anArrayOfSelectors + ^self new + subject: aTraitComposition; + exclusions: anArrayOfSelectors; + yourself + ! Item was added: + ----- Method: NanoTraitExclusion>>selectorsAndMethodsDo: (in category 'composition') ----- + selectorsAndMethodsDo: aBlock + "enumerates all selectors and methods in a trait composition" + ^subject selectorsAndMethodsDo:[:sel :meth| + (exclusions includes: sel) ifFalse:[aBlock value: sel value: meth]. + ].! Item was added: + ----- Method: NanoTraitExclusion>>copyTraitExpression (in category 'composition') ----- + copyTraitExpression + "Copy all except the actual traits" + ^NanoTraitExclusion + with: subject + exclusions: exclusions asArray! Item was added: + NanoTraitTransformation subclass: #NanoTraitExclusion + instanceVariableNames: 'exclusions' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoTraitExclusion commentStamp: '<historical>' prior: 0! + A trait transformation representing the exclusion (-) operator.! Item was added: + ----- Method: NanoTrait>>fileOutOn:moveSource:toFile: (in category 'fileIn/Out') ----- + fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex + super fileOutOn: aFileStream moveSource: moveSource toFile: fileIndex. + self classSide hasMethods ifTrue:[ + aFileStream cr; nextPutAll: '"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!'; cr; cr. + self classSide + fileOutOn: aFileStream + moveSource: moveSource + toFile: fileIndex].! Item was changed: SystemOrganization addCategory: #'Traits-Composition'! SystemOrganization addCategory: #'Traits-Kernel'! SystemOrganization addCategory: #'Traits-Kernel-Traits'! SystemOrganization addCategory: #'Traits-LocalSends'! SystemOrganization addCategory: #'Traits-Requires'! SystemOrganization addCategory: #'Traits-Tests'! + SystemOrganization addCategory: #'Traits-NanoKernel'! Item was added: + ----- Method: NanoTrait>>classDefinitions (in category 'monticello') ----- + classDefinitions + | definitions | + definitions := OrderedCollection with: self asClassDefinition. + (self hasClassTrait + and: [self classTrait hasTraitComposition] + and: [self classTrait traitComposition isEmpty not]) + ifTrue: [definitions add: self classTrait asMCDefinition]. + ^definitions asArray! Item was added: + ----- Method: NanoClassTrait>>isClassTrait (in category 'testing') ----- + isClassTrait + ^true! Item was added: + ----- Method: ClassDescription>>allTraits (in category '*Traits-NanoKernel') ----- + allTraits + "Answer all the traits that are used by myself without their transformations" + ^self traitComposition isEmpty + ifTrue:[#()] + ifFalse:[self traitComposition allTraits].! Item was added: + ----- Method: NanoTraitTransformation>>selectorsAndMethodsDo: (in category 'operations') ----- + selectorsAndMethodsDo: aBlock + "enumerates all selectors and methods in a trait composition" + ^self subclassResponsibility! Item was added: + ----- Method: NanoClassTrait>>theMetaClass (in category 'accessing') ----- + theMetaClass + ^self! Item was added: + ----- Method: NanoTraitTransformation>>copyTraitExpression (in category 'operations') ----- + copyTraitExpression + "Copy all except the actual traits" + ^self subclassResponsibility! Item was added: + ----- Method: NanoTrait>>asClassDefinition (in category 'monticello') ----- + asClassDefinition + ^Smalltalk at: #MCTraitDefinition ifPresent:[:aClass| + aClass + name: self name + traitComposition: self traitCompositionString + category: self category + comment: self organization classComment asString + commentStamp: self organization commentStamp].! Item was added: + ----- Method: NanoTraitDescription>>sharedPools (in category 'accessing') ----- + sharedPools + "Traits have no shared pools" + ^ Dictionary new! Item was added: + ----- Method: NanoClassTrait>>definitionST80 (in category 'accessing') ----- + definitionST80 + ^String streamContents: [:stream | + stream nextPutAll: self name. + stream cr; tab; nextPutAll: 'uses: '; + nextPutAll: self traitComposition asString. + ].! Item was added: + ----- Method: NanoTraitAlias>>initialize (in category 'initialize-release') ----- + initialize + super initialize. + aliases := #().! Item was added: + ----- Method: NanoTrait class>>newTemplateIn: (in category 'public') ----- + newTemplateIn: categoryString + ^String streamContents: [:stream | + stream + nextPutAll: 'Trait named: #NameOfTrait'; + cr; tab; + nextPutAll: 'uses: {}'; + cr; tab; + nextPutAll: 'category: '; + nextPut: $'; + nextPutAll: categoryString; + nextPut: $' ]! Item was added: + ----- Method: NanoTrait class>>newTraitNamed:uses:category: (in category 'public') ----- + newTraitNamed: aSymbol uses: aTraitCompositionOrCollection category: aString + "Creates a new trait." + | env | + env := self environment. + ^self + named: aSymbol + uses: aTraitCompositionOrCollection + category: aString + env: env! Item was added: + ----- Method: NanoTraitExclusion>>exclusions: (in category 'accessing') ----- + exclusions: aCollection + exclusions := Set withAll: aCollection! Item was added: + ----- Method: AdditionalMethodState>>originalTraitMethod (in category '*Traits-NanoKernel') ----- + originalTraitMethod + "The original method from the trait. + Only available in TraitMethodState." + ^nil! Item was added: + ----- Method: NanoTraitDescription>>isTraitTransformation (in category 'testing') ----- + isTraitTransformation + "Polymorphic with TraitTransformation" + ^false! Item was added: + ----- Method: NanoTraitExclusion>>- (in category 'converting') ----- + - anArrayOfSelectors + ^NanoTraitExclusion + with: subject + exclusions: (anArrayOfSelectors, exclusions asArray)! Item was added: + ----- Method: ClassDescription>>resolveTraitsConflict:from:to: (in category '*Traits-NanoKernel') ----- + resolveTraitsConflict: aSelector from: oldMethod to: newMethod + "Resolve a traits conflict. Rules: + - If one method is required the other one wins + - Otherwise we compile a traits conflict + " + | marker selector | + oldMethod methodHome == newMethod methodHome ifTrue:[^oldMethod]. + marker := oldMethod markerOrNil. + (#(requirement explicitRequirement subclassResponsibility shouldNotImplement) includes: marker) + ifTrue:[^newMethod]. + marker := newMethod markerOrNil. + (#(requirement explicitRequirement subclassResponsibility shouldNotImplement) includes: marker) + ifTrue:[^oldMethod]. + "Create a conflict marker" + selector := #(conflict conflict: conflict:with: conflict:with:with: conflict:with:with:with: + conflict:with:with:with:with: conflict:with:with:with:with:with: conflict:with:with:with:with:with:with: + conflict:with:with:with:with:with:with:with:) at: oldMethod numArgs+1. + ^NanoTraitDescription class compiledMethodAt: selector.! Item was added: + ----- Method: NanoTraitComposition>>isTraitTransformation (in category 'testing') ----- + isTraitTransformation + "Polymorphic with TraitTransformation" + ^false! Item was added: + ----- Method: NanoTrait>>rename: (in category 'initialize') ----- + rename: aString + "The new name of the receiver is the argument, aString." + + | newName | + (newName := aString asSymbol) ~= self name + ifFalse: [^ self]. + (self environment includesKey: newName) + ifTrue: [^ self error: newName , ' already exists']. + (Undeclared includesKey: newName) + ifTrue: [self inform: 'There are references to, ' , aString printString , ' + from Undeclared. Check them after this change.']. + self environment renameClass: self as: newName. + name := newName! Item was added: + ----- Method: AdditionalMethodState>>originalTraitOrClass (in category '*Traits-NanoKernel') ----- + originalTraitOrClass + "The original trait for this method" + ^method methodClass! Item was added: + ----- Method: ClassDescription>>users (in category '*Traits-NanoKernel') ----- + users + ^#()! Item was added: + ----- Method: CompiledMethod>>originalTraitMethod: (in category '*Traits-NanoKernel') ----- + originalTraitMethod: aCompiledMethod + "Remember the original trait method for the receiver." + | methodState | + methodState := NanoTraitMethodState newFrom: self properties. + methodState originalTraitMethod: aCompiledMethod. + self penultimateLiteral: methodState.! Item was added: + ----- Method: NanoTraitComposition>>includesTrait: (in category 'testing') ----- + includesTrait: aTrait + ^self anySatisfy:[:each| each includesTrait: aTrait]! Item was added: + ----- Method: NanoTrait>>isBaseTrait (in category 'testing') ----- + isBaseTrait + ^true! Item was added: + ----- Method: CompiledMethod>>sameTraitCodeAs: (in category '*Traits-NanoKernel') ----- + sameTraitCodeAs: method + "Answer whether the receiver implements the same code as the + argument, method. Does not look at properties/pragmas since they + do not affect the resulting code." + | numLits | + (method isKindOf: CompiledMethod) ifFalse: [^false]. + self methodHome == method methodHome ifFalse:[^false]. + (self properties analogousCodeTo: method properties) ifFalse:[^false]. + self size = method size ifFalse: [^false]. + self header = method header ifFalse: [^false]. + self initialPC to: self endPC do:[:i | (self at: i) = (method at: i) ifFalse: [^false]]. + (numLits := self numLiterals) ~= method numLiterals ifTrue: [^false]. + 1 to: numLits-2 do:[:i| | lit1 lit2 | + lit1 := self literalAt: i. + lit2 := method literalAt: i. + lit1 = lit2 ifFalse:[ + (i = 1 and: [#(117 120) includes: self primitive]) ifTrue: [ + lit1 isArray ifTrue:[ + (lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:[^false] + ] ifFalse: "ExternalLibraryFunction" + [(lit1 analogousCodeTo: lit2) ifFalse:[^false]]. + ] ifFalse:[ + lit1 isFloat + ifTrue:[(lit1 closeTo: lit2) ifFalse: [^false]] + ifFalse:["any other discrepancy is a failure"^ false]]]]. + ^true! Item was added: + ----- Method: NanoTraitDescription>>addSelectorSilently:withMethod: (in category 'operations') ----- + addSelectorSilently: selector withMethod: compiledMethod + "Overridden to update the users of this trait" + super addSelectorSilently: selector withMethod: compiledMethod. + self users do:[:each| each updateTraits].! Item was added: + ----- Method: NanoTraitDescription class>>conflict:with: (in category 'conflict methods') ----- + conflict: arg1 with: arg2 + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: NanoTrait class>>newTraitComposition (in category 'public') ----- + newTraitComposition + "Creates a new TraitComposition" + ^NanoTraitComposition new! Item was added: + ----- Method: NanoTrait class>>named:uses:category:env: (in category 'instance creation') ----- + named: aSymbol uses: aTraitComposition category: aString env: anEnvironment + | trait oldTrait systemCategory oldCategory | + systemCategory := aString asSymbol. + oldTrait := anEnvironment at: aSymbol ifAbsent: [nil]. + oldTrait ifNil:[ + trait := NanoClassTrait new new. + ] ifNotNil:[ + oldCategory := oldTrait category. + trait := oldTrait. + ]. + (trait isKindOf: NanoTrait) ifFalse: [ + ^self error: trait name , ' is not a Trait']. + trait + setName: aSymbol + andRegisterInCategory: systemCategory + environment: anEnvironment. + + trait uses: aTraitComposition. + + "... notify interested clients ..." + oldTrait ifNil:[ + SystemChangeNotifier uniqueInstance classAdded: trait inCategory: systemCategory. + ] ifNotNil:[ + systemCategory = oldCategory ifFalse:[ + SystemChangeNotifier uniqueInstance class: trait + recategorizedFrom: oldTrait category to: systemCategory]. + ]. + ^ trait! Item was added: + ----- Method: NanoTraitTransformation>>traitsDo: (in category 'accessing') ----- + traitsDo: aBlock + ^subject traitsDo: aBlock! Item was added: + ----- Method: NanoTraitAlias>>selectorsAndMethodsDo: (in category 'operations') ----- + selectorsAndMethodsDo: aBlock + "enumerates all selectors and methods in a trait composition" + subject selectorsAndMethodsDo:[:sel :meth| + aBlock value: sel value: meth. + ]. + aliases do:[:assoc| | method | + "Method can be nil during removals" + method := subject compiledMethodAt: assoc value ifAbsent:[nil]. + method ifNotNil:[aBlock value: assoc key value: method]. + ].! Item was added: + ----- Method: NanoClassTrait>>bindingOf: (in category 'compiling') ----- + bindingOf: varName + "Answer the binding of some variable resolved in the scope of the receiver" + ^baseTrait bindingOf: varName! Item was added: + ----- Method: NanoTraitDescription>>copy (in category 'copying') ----- + copy + self error: 'Traits cannot be trivially copied'! Item was added: + ----- Method: NanoTraitTransformation>>includesTrait: (in category 'testing') ----- + includesTrait: aTrait + ^subject includesTrait: aTrait! Item was added: + ----- Method: NanoTraitTransformation>>asTraitTransform (in category 'converting') ----- + asTraitTransform + ^self! Item was added: + ----- Method: NanoTrait>>removeFromSystem: (in category 'initialize') ----- + removeFromSystem: logged + self environment forgetClass: self logged: logged. + self obsolete! Item was added: + ----- Method: NanoClassTrait>>uses: (in category 'initialize') ----- + uses: aTraitComposition + | newTraits | + newTraits := (aTraitComposition isTrait or:[aTraitComposition isTraitTransformation]) + ifTrue:[NanoTraitComposition with: aTraitComposition] + ifFalse:[(aTraitComposition isKindOf: SequenceableCollection) + ifTrue:[NanoTraitComposition withAll: aTraitComposition asArray] + ifFalse:[self error: 'Invalid traits specification']]. + newTraits traitsDo:[:t| + (t isBaseTrait and:[t classSide hasMethods]) + ifTrue:[self error: 'Cannot add: ', t]. + (t isClassTrait and:[(baseTrait includesTrait: t baseTrait) not]) + ifTrue:[self error: 'Cannot add: ', t]. + ]. + self installTraitsFrom: newTraits.! Item was added: + ----- Method: NanoTrait>>definition (in category 'initialize') ----- + definition + ^String streamContents: [:stream | + stream nextPutAll: 'Trait named: '; + store: self name. + stream cr; tab; nextPutAll: 'uses: '; + nextPutAll: self traitComposition asString. + stream cr; tab; nextPutAll: 'category: '; + store: self category asString].! Item was added: + ----- Method: NanoTraitTransformation>>trait (in category 'accessing') ----- + trait + ^subject trait! Item was added: + ----- Method: NanoTraitTransformation>>updateSelector:withTraitMethod:from: (in category 'operations') ----- + updateSelector: aSelector withTraitMethod: compiledMethod from: aTrait + "broadcasts the change of a selector to all users of a trait" + ^self subclassResponsibility! Item was added: + ----- Method: NanoTraitDescription>>addUser: (in category 'accessing') ----- + addUser: aTrait + ^self addTraitUser: aTrait! Item was added: + NanoTraitDescription subclass: #NanoClassTrait + instanceVariableNames: 'baseTrait' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoClassTrait commentStamp: '<historical>' prior: 0! + While every class has an associated metaclass, a trait can have an associated classtrait, an instance of me. To preserve metaclass compatibility, the associated classtrait (if there is one) is automatically applied to the metaclass, whenever a trait is applied to a class. Consequently, a trait with an associated classtrait can only be applied to classes, whereas a trait without a classtrait can be applied to both classes and metaclasses.! Item was added: + NanoTraitDescription subclass: #NanoTrait + instanceVariableNames: 'name environment category' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoTrait commentStamp: '<historical>' prior: 0! + Each trait in the system is represented as an instance of me. Like Class, I concretize my superclass by providing instance variables for the name and the environment.! Item was added: + ----- Method: NanoClassTrait>>isMeta (in category 'testing') ----- + isMeta + ^true! Item was added: + ----- Method: NanoTraitComposition>>addUser: (in category 'accessing') ----- + addUser: aUser + ^self addTraitUser: aUser! Item was added: + ----- Method: NanoTraitDescription>>isBaseTrait (in category 'testing') ----- + isBaseTrait + ^false! Item was added: + ----- Method: NanoTraitExclusion>>initialize (in category 'initialize') ----- + initialize + super initialize. + exclusions := Set new. + ! Item was added: + ----- Method: ClassDescription>>setTraitCompositionFrom: (in category '*Traits-NanoKernel') ----- + setTraitCompositionFrom: aTraitComposition + "OBSOLETE. Use Class uses: aTraitComposition instead." + (aTraitComposition isKindOf: NanoTraitComposition) + ifTrue:[^self uses: aTraitComposition]. + (aTraitComposition isKindOf: TraitComposition) + ifTrue:[^super setTraitCompositionFrom: aTraitComposition]. + "Unspecified. Check for prevailing traitOverride" + ClassDescription traitImpl == NanoTrait + ifTrue:[^self uses: aTraitComposition] + ifFalse:[^super setTraitCompositionFrom: aTraitComposition].! Item was added: + ----- Method: NanoTraitDescription>>removeUser: (in category 'accessing') ----- + removeUser: aTrait + ^self removeTraitUser: aTrait! Item was added: + ----- Method: NanoTraitAlias>>- (in category 'converting') ----- + - anArrayOfSelectors + ^NanoTraitExclusion + with: self + exclusions: anArrayOfSelectors! Item was added: + ----- Method: NanoTraitDescription>>asTraitComposition (in category 'converting') ----- + asTraitComposition + ^NanoTraitComposition with: self! Item was added: + ----- Method: NanoTraitAlias class>>with:aliases: (in category 'instance creation') ----- + with: aTraitComposition aliases: anArrayOfAssociations + self assertValidAliasDefinition: anArrayOfAssociations. + ^self new + subject: aTraitComposition; + initializeFrom: anArrayOfAssociations; + yourself! Item was added: + ----- Method: NanoTrait>>isValidTraitName: (in category 'initialize') ----- + isValidTraitName: aSymbol + ^(aSymbol isEmptyOrNil + or: [aSymbol first isLetter not] + or: [aSymbol anySatisfy: [:character | character isAlphaNumeric not]]) not! Item was added: + ----- Method: NanoTraitDescription>>isTrait (in category 'testing') ----- + isTrait + ^true! Item was added: + ----- Method: NanoTrait>>removeFromSystem (in category 'initialize') ----- + removeFromSystem + self removeFromSystem: true! Item was added: + ----- Method: NanoTraitComposition>>asTraitComposition (in category 'converting') ----- + asTraitComposition + ^self! Item was added: + ----- Method: NanoTraitDescription>>printUsersOf:on:level: (in category 'printing') ----- + printUsersOf: aClass on: aStream level: indent + aStream crtab: indent. + aStream nextPutAll: aClass name. + aClass isTrait ifTrue:[ + aClass users do:[:each| self printUsersOf: aClass on: aStream level: indent+1]. + ]. + ! Item was added: + ----- Method: NanoTraitDescription>>traitComposition (in category 'accessing') ----- + traitComposition + ^traitComposition ifNil:[traitComposition := NanoTraitComposition new] + ! Item was added: + ----- Method: NanoTrait class>>allTraitsDo: (in category 'public') ----- + allTraitsDo: aBlock + "Evaluate aBlock with all the instance and class traits present in the system" + NanoClassTrait allInstances do: [:metaTrait| + aBlock value: metaTrait instanceSide. + aBlock value: metaTrait. + ].! Item was added: + ----- Method: NanoTrait>>hasClassTrait (in category 'testing') ----- + hasClassTrait + ^true! Item was added: + ----- Method: NanoTraitTransformation>>initialize (in category 'initialize') ----- + initialize + super initialize. + users := #().! Item was added: + ----- Method: NanoTraitMethodState>>originalTraitMethod (in category 'accessing') ----- + originalTraitMethod + "The original method from the trait" + ^originalTraitMethod! Item was added: + ----- Method: NanoTraitDescription class>>conflict:with:with:with:with:with:with:with: (in category 'conflict methods') ----- + conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 with: arg8 + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: ClassDescription>>includesTrait: (in category '*Traits-NanoKernel') ----- + includesTrait: aTrait + ^self traitComposition includesTrait: aTrait! Item was added: + ----- Method: NanoTrait>>setName:andRegisterInCategory:environment: (in category 'initialize') ----- + setName: aSymbol andRegisterInCategory: categorySymbol environment: aSystemDictionary + (self isValidTraitName: aSymbol) ifFalse: [self error:'Invalid trait name']. + + (self environment == aSystemDictionary + and: [self name = aSymbol + and: [self category = categorySymbol]]) ifTrue: [^self]. + + ((aSystemDictionary includes: aSymbol) and: [(aSystemDictionary at: aSymbol) ~~ self]) + ifTrue: [self error: 'The name ''' , aSymbol , ''' is already used']. + + (self environment notNil and: [self name notNil and: [self name ~= aSymbol]]) ifTrue: [ + self environment renameClass: self as: aSymbol]. + + self name: aSymbol. + self environment: aSystemDictionary. + self environment at: self name put: self. + self environment organization classify: self name under: categorySymbol. + ^ true! Item was added: + ----- Method: NanoTraitMethodState>>originalTraitOrClass (in category 'accessing') ----- + originalTraitOrClass + "The original trait for this method" + ^originalTraitMethod originalTraitOrClass! Item was added: + ----- Method: NanoTraitDescription>>users: (in category 'accessing') ----- + users: aCollection + users := aCollection! Item was added: + ----- Method: NanoTraitTransformation>>asTraitComposition (in category 'converting') ----- + asTraitComposition + ^NanoTraitComposition with: self! Item was added: + ----- Method: CompiledMethod>>originalTraitMethod (in category '*Traits-NanoKernel') ----- + originalTraitMethod + "Remember the original trait method for the receiver." + ^self properties originalTraitMethod! Item was added: + ClassDescription subclass: #NanoTraitBehavior + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoTraitBehavior commentStamp: 'ar 12/29/2009 15:57' prior: 0! + Stub class for backward compatibility. Allows past extension methods in TraitBehavior to continue to work.! Item was added: + ----- Method: NanoTrait>>category: (in category 'accessing') ----- + category: aString + "Categorize the receiver under the system category, aString, removing it from + any previous categorization." + + | oldCategory | + oldCategory := category. + aString isString + ifTrue: [ + category := aString asSymbol. + SystemOrganization classify: self name under: category ] + ifFalse: [self errorCategoryName]. + SystemChangeNotifier uniqueInstance + class: self recategorizedFrom: oldCategory to: category! Item was added: + ----- Method: CompiledMethod>>originalTraitOrClass (in category '*Traits-NanoKernel') ----- + originalTraitOrClass + "The original trait for this method" + ^self properties originalTraitOrClass! Item was added: + ----- Method: NanoTrait>>name: (in category 'accessing') ----- + name: aSymbol + name := aSymbol! Item was added: + AdditionalMethodState variableSubclass: #NanoTraitMethodState + instanceVariableNames: 'originalTraitMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoTraitMethodState commentStamp: '<historical>' prior: 0! + Additional method state for trait provided methods.! Item was added: + ----- Method: NanoClassTrait class>>new (in category 'instance creation') ----- + new + | newMeta | + newMeta := super new. + newMeta + superclass: NanoTrait + methodDictionary: MethodDictionary new + format: NanoTrait format. + ^newMeta! Item was added: + ----- Method: NanoTraitMethodState>>methodHome (in category 'accessing') ----- + methodHome + "The behavior (trait/class) this method was originally defined in. + Derived from the originalTraitMethod if any." + ^originalTraitMethod ifNil:[super methodHome] ifNotNil:[:m| m methodHome]! Item was added: + ----- Method: NanoTraitDescription>>notifyOfRecategorizedSelector:from:to: (in category 'operations') ----- + notifyOfRecategorizedSelector: element from: oldCategory to: newCategory + super notifyOfRecategorizedSelector: element from: oldCategory to: newCategory. + self users do:[:each| each classify: element under: newCategory from: oldCategory trait: self].! Item was added: + ----- Method: NanoClassTrait>>instanceSide (in category 'accessing') ----- + instanceSide + ^self baseTrait! Item was added: + ----- Method: NanoTraitDescription>>- (in category 'operations') ----- + - anArrayOfSelectors + "Creates an exclusion" + ^NanoTraitExclusion + with: self + exclusions: anArrayOfSelectors! Item was added: + ----- Method: NanoTraitAlias>>isAliasSelector: (in category 'testing') ----- + isAliasSelector: selector + ^(self isLocalAliasSelector: selector) or:[super isAliasSelector: selector]! Item was added: + ----- Method: NanoTraitComposition>>- (in category 'converting') ----- + - anArray + "the modifier operators #@ and #- bind stronger than +. + Thus, #@ or #- sent to a sum will only affect the most right summand" + + self addLast: (self removeLast - anArray)! Item was added: + ----- Method: NanoTrait class>>initialize (in category 'initialize') ----- + initialize + "Install NanoTraits" + self install. + ! Item was added: + ----- Method: ClassDescription>>traitComposition (in category '*Traits-NanoKernel') ----- + traitComposition + "Answer my trait composition" + ^#()! Item was added: + ----- Method: NanoClassTrait>>new (in category 'accessing') ----- + new + baseTrait ifNotNil:[self error: 'Already initialized']. + baseTrait := self basicNew initialize. + baseTrait + superclass: nil + methodDictionary: MethodDictionary new + format: Object format. + ^baseTrait! Item was added: + ----- Method: NanoTraitDescription class>>conflict:with:with:with:with:with:with: (in category 'conflict methods') ----- + conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 with: arg6 with: arg7 + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: NanoTraitAlias>>@ (in category 'converting') ----- + @ anArrayOfAssociations + ^NanoTraitAlias + with: subject + aliases: (anArrayOfAssociations, self aliases)! Item was added: + ----- Method: NanoClassTrait>>updateTraitsFrom: (in category 'initialize') ----- + updateTraitsFrom: instanceTraits + "Update me from the given instance traits" + | map newTraits trait | + map := Dictionary new. + self traitComposition do:[:composed| map at: composed trait put: composed]. + newTraits := (instanceTraits collect:[:composed| + trait := composed trait classTrait. + map at: trait ifAbsent:[trait]] + ), (self traitComposition select:[:comp| comp trait isBaseTrait]). + + self installTraitsFrom: newTraits! Item was added: + ----- Method: NanoClassTrait>>name (in category 'accessing') ----- + name + ^baseTrait name, ' classTrait'! Item was added: + OrderedCollection subclass: #NanoTraitComposition + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Traits-NanoKernel'! + + !NanoTraitComposition commentStamp: '<historical>' prior: 0! + A trait composition is a collection of Traits or TraitTransformations.! Item was added: + ----- Method: NanoTraitDescription>>traitsDo: (in category 'operations') ----- + traitsDo: aBlock + aBlock value: self.! Item was added: + ----- Method: NanoTraitExclusion>>exclusions (in category 'accessing') ----- + exclusions + ^exclusions! Item was added: + ----- Method: NanoTraitMethodState>>originalTraitMethod: (in category 'accessing') ----- + originalTraitMethod: aCompiledMethod + "The original method from the trait" + originalTraitMethod := aCompiledMethod! Item was added: + ----- Method: NanoTraitComposition>>traitsDo: (in category 'accessing') ----- + traitsDo: aBlock + ^self do:[:each| each traitsDo: aBlock]! Item was added: + ----- Method: NanoTraitDescription class>>conflict (in category 'conflict methods') ----- + conflict + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: NanoTraitDescription>>allClassVarNames (in category 'accessing') ----- + allClassVarNames + "Traits have no class var names" + ^#()! Item was added: + ----- Method: NanoTraitDescription class>>conflict:with:with:with:with: (in category 'conflict methods') ----- + conflict: arg1 with: arg2 with: arg3 with: arg4 with: arg5 + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: NanoTraitTransformation>>- (in category 'converting') ----- + - anArrayOfSelectors + ^self subclassResponsibility! Item was added: + ----- Method: NanoTrait>>environment: (in category 'accessing') ----- + environment: anObject + environment := anObject! Item was added: + ----- Method: NanoTraitDescription>>includesTrait: (in category 'testing') ----- + includesTrait: aTrait + ^self == aTrait or:[super includesTrait: aTrait]! Item was added: + ----- Method: NanoTraitDescription>>trait (in category 'accessing') ----- + trait + ^self! Item was added: + ----- Method: NanoTraitDescription class>>conflict:with:with:with: (in category 'conflict methods') ----- + conflict: arg1 with: arg2 with: arg3 with: arg4 + "This method has a trait conflict" + ^self traitConflict! Item was added: + ----- Method: NanoTrait>>definitionST80 (in category 'initialize') ----- + definitionST80 + ^String streamContents: [:stream | + stream nextPutAll: 'Trait named: '; + store: self name. + stream cr; tab; nextPutAll: 'uses: '; + nextPutAll: self traitComposition asString. + stream cr; tab; nextPutAll: 'category: '; + store: self category asString].! Item was added: + ----- Method: NanoTraitDescription>>addTraitUser: (in category 'accessing') ----- + addTraitUser: aTrait + users := self users copyWith: aTrait. + ! Item was added: + ----- Method: NanoTraitAlias>>aliases (in category 'accessing') ----- + aliases + "Collection of associations where key is the + alias and value the original selector." + ^aliases! Item was added: + ----- Method: NanoTraitComposition>>addTraitUser: (in category 'accessing') ----- + addTraitUser: aUser + self do:[:each| each addTraitUser: aUser]!

1 0

The Trunk: Traits-ar.253.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

1 0

The Trunk: Traits-ar.253.mcz
by commits＠source.squeak.org 31 Dec '09

31 Dec '09

1 0

The Trunk: MonticelloConfigurations-ar.71.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

Andreas Raab uploaded a new version of MonticelloConfigurations to project The Trunk: http://source.squeak.org/trunk/MonticelloConfigurations-ar.71.mcz ==================== Summary ==================== Name: MonticelloConfigurations-ar.71 Author: ar Time: 30 December 2009, 5:35:52 am UUID: 908da779-6dd4-c34b-8be4-757825367db3 Ancestors: MonticelloConfigurations-ar.70 With the additional progress info from MC, configs are a bit noisy when updating. Suppress a good chunk of progress depending (for now) on a preference. The result are smoother and less noisy progress notifications during updates. =============== Diff against MonticelloConfigurations-ar.70 =============== Item was changed: ----- Method: MCConfiguration>>versionNamed:for:from: (in category 'private') ----- versionNamed: verName for: aDependency from: repo | baseName fileName ver | (repo filterFileNames: repo cachedFileNames forVersionNamed: verName) ifNotEmptyDo: [:cachedNames | fileName := cachedNames anyOne. + self class extraProgressInfo + ifTrue:[ProgressNotification signal: '' extra: 'Using cached ', fileName]. - ProgressNotification signal: '' extra: 'Using cached ', fileName. ver := repo versionFromFileNamed: fileName]. ver ifNil: [ baseName := self diffBaseFor: aDependency. (baseName notNil and: [baseName ~= verName and: [repo includesVersionNamed: baseName]]) ifTrue: [ fileName := (MCDiffyVersion nameForVer: verName base: baseName), '.mcd'. + self class extraProgressInfo + ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName]. - ProgressNotification signal: '' extra: 'Downloading ', fileName. ver := repo versionFromFileNamed: fileName]]. ver ifNil: [ fileName := verName, '.mcz'. + self class extraProgressInfo + ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName]. - ProgressNotification signal: '' extra: 'Downloading ', fileName. ver := repo versionFromFileNamed: fileName]. ^ver! Item was added: + ----- Method: MCConfiguration class>>extraProgressInfo: (in category 'preferences') ----- + extraProgressInfo: aBool + "Whether to display for additional progress info during load." + ExtraProgressInfo := aBool. + ! Item was changed: ----- Method: MCConfiguration>>depsSatisfying:versionDo:displayingProgress: (in category 'private') ----- depsSatisfying: selectBlock versionDo: verBlock displayingProgress: progressString + | repoMap count action | - | repoMap count | repoMap := Dictionary new. self repositories do: [:repo | MCRepositoryGroup default addRepository: repo. repo allVersionNames ifEmpty: [self logWarning: 'cannot read from ', repo description] ifNotEmptyDo: [:all | all do: [:ver | repoMap at: ver put: repo]]]. count := 0. + action := [:dep | - self dependencies do: [:dep | | ver repo | ver := dep versionInfo name. repo := repoMap at: ver ifAbsent: [ self logError: 'Version ', ver, ' not found in any repository'. self logError: 'Aborting'. ^count]. (selectBlock value: dep) ifTrue: [ | new | new := self versionNamed: ver for: dep from: repo. new ifNil: [ self logError: 'Could not download version ', ver, ' from ', repo description. self logError: 'Aborting'. ^count] ifNotNil: [ self logUpdate: dep package with: new. + self class extraProgressInfo + ifTrue:[ProgressNotification signal: '' extra: 'Installing ', ver]. - ProgressNotification signal: '' extra: 'Installing ', ver. verBlock value: new. count := count + 1. ] ]. dep package workingCopy repositoryGroup addRepository: repo. + ]. + self class extraProgressInfo + ifTrue:[self dependencies do: action displayingProgress: progressString] + ifFalse:[self dependencies do: action]. - ] displayingProgress: progressString. - ^count! Item was changed: Object subclass: #MCConfiguration instanceVariableNames: 'name dependencies repositories log' + classVariableNames: 'DefaultLog ExtraProgressInfo LogToFile' - classVariableNames: 'DefaultLog LogToFile' poolDictionaries: '' category: 'MonticelloConfigurations'! Item was added: + ----- Method: MCConfiguration class>>extraProgressInfo (in category 'preferences') ----- + extraProgressInfo + "Answer true for additional progress info during load. + With the newly added MC down/upload operations this seems unnecessary + but some people might disagree, so let's leave it as a preference right now" + <preference: 'Extra Progress Info' + category: 'Monticello' + description: 'If true, additional progress information is displayed when loading MC configurations (i.e., during updates)' + type: #Boolean> + ^ExtraProgressInfo ifNil:[false]!

1 0

The Trunk: MonticelloConfigurations-ar.71.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

1 0

The Trunk: MonticelloConfigurations-ar.71.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

1 0

The Trunk: Monticello-ar.347.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

Andreas Raab uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ar.347.mcz ==================== Summary ==================== Name: Monticello-ar.347 Author: ar Time: 30 December 2009, 5:25:47 am UUID: f5913c41-3f80-e44c-b1a6-e04e9a18b30d Ancestors: Monticello-ar.346 Have MCPackageLoader use the best guess about the package being installed in progress notifications. =============== Diff against Monticello-ar.346 =============== Item was changed: ----- Method: MCPackageLoader>>basicLoad (in category 'private') ----- basicLoad + "Load the contents of some package. This is the core loading method + in Monticello. Be wary about modifying it unless you understand the details + and dependencies of the various entities being modified." + | pkgName | errorDefinitions := OrderedCollection new. + "Obviously this isn't the package name but we don't have anything else + to use here. ChangeSet current name will generally work since a CS is + usually installed prior to installation." + pkgName := ChangeSet current name. - [["Pass 1: Load everything but the methods, which are collected in methodAdditions." - additions do: [:ea | - [ea isMethodDefinition - ifTrue:[methodAdditions add: ea asMethodAddition] - ifFalse:[ea load]]on: Error do: [errorDefinitions add: ea]. - ] displayingProgress: 'Reshaping classes...'. - - "Pass 2: We compile new / changed methods" - methodAdditions do:[:ea| ea createCompiledMethod] displayingProgress: 'Compiling...'. - - 'Installing...' displayProgressAt: Sensor cursorPoint from: 0 to: 2 during:[:bar| - "There is progress *during* installation since a progress bar update - will redraw the world and potentially call methods that we're just trying to install." - bar value: 1. - - "Pass 3: Install the new / changed methods - (this is a separate pass to allow compiler changes to be loaded)" - methodAdditions do:[:ea| ea installMethod]. - - "Pass 4: Remove the obsolete methods" - removals do:[:ea| ea unload]. - ]. - - "Try again any delayed definitions" - self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. - errorDefinitions do: [:ea | ea load] displayingProgress: 'Reloading...'. - - "Finally, notify observers for the method additions" - methodAdditions do: [:each | each notifyObservers] - "the message is fake but actually telling people how much time we spend - in the notifications is embarrassing so lie instead" - displayingProgress: 'Installing...'. + [["Pass 1: Load everything but the methods, which are collected in methodAdditions." + additions do: [:ea | + [ea isMethodDefinition + ifTrue:[methodAdditions add: ea asMethodAddition] + ifFalse:[ea load]]on: Error do: [errorDefinitions add: ea]. + ] displayingProgress: 'Reshaping ', pkgName. + + "Pass 2: We compile new / changed methods" + methodAdditions do:[:ea| ea createCompiledMethod] + displayingProgress: 'Compiling ', pkgName. + + 'Installing ', pkgName displayProgressAt: Sensor cursorPoint from: 0 to: 2 during:[:bar| + "There is no progress *during* installation since a progress bar update + will redraw the world and potentially call methods that we're just trying to install." + bar value: 1. + + "Pass 3: Install the new / changed methods + (this is a separate pass to allow compiler changes to be loaded)" + methodAdditions do:[:ea| ea installMethod]. + + "Pass 4: Remove the obsolete methods" + removals do:[:ea| ea unload]. + ]. + + "Try again any delayed definitions" + self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. + errorDefinitions do: [:ea | ea load] + displayingProgress: 'Reloading ', pkgName. + + "Finally, notify observers for the method additions" + methodAdditions do: [:each | each notifyObservers] + "the message is fake but actually telling people how much time we spend + in the notifications is embarrassing so lie instead" + displayingProgress: 'Installing ', pkgName. + + additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] + displayingProgress: 'Initializing ', pkgName. + - additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] displayingProgress: 'Initializing...' ] on: InMidstOfFileinNotification do: [:n | n resume: true] ] ensure: [self flushChangesFile]!

1 0

The Trunk: Monticello-ar.347.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

1 0

The Trunk: Monticello-ar.347.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

1 0

← Newer
1
...
6
7
8
9
10
11
12
...
104
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages December 2009