I propose to harvest the cleaning behavior.
I will go over the list and check

Stef

On Oct 1, 2008, at 10:53 PM, Damien Pollet wrote:

Hi list, we (with Stef) are browsing Kernel-Extensions, here are some
notes for discussion, as we think there is stuff that should be merged
in Pharo.

Null and Split-Join could be packaged on their own since they are
well-defined features.

Most of the cleanup methods make sense, but what's the difference
between cleanUp and freeSomeSpace ?

AppRegistry class >> removeObsolete
        "AppRegistry removeObsoleteClasses"
        self registeredClasses copy do:[:cls|
                (cls class isObsolete or:[cls isBehavior and:[cls isObsolete]])
                        ifTrue:[self unregister: cls]].
        self subclasses do:[:cls| cls removeObsolete].

Behavior class >> flushObsoleteSubclasses
        "Behavior flushObsoleteSubclasses"
        ObsoleteSubclasses finalizeValues.

Behavior >> sourceMatchesBytecodeAt:

Class class >> freeSomeSpace
"Fix some problems with classes. Use Smalltalk allClassesDo: since it
does not use the subclass list, which we may be modifying during this
iteration"
        Smalltalk allClassesDo: [:ea |
                ea fixObsoleteSuperclass.
                ea removeDuplicateSubclassEntries]

Collection >> contains:    should probably be standardized as part of
the STEPS project
Collection >> reject:thenDo: and select:thenDo:       should be
included and similar enumerations reimplemented in this way too

SystemDictionary >> forgetClass: aClass logged: aBool            badly
named but interesting
        "Delete the class, aClass, from the system.
        Note that this doesn't do everything required to dispose of a class -
to do that use Class>>removeFromSystem."

        aBool ifTrue: [SystemChangeNotifier uniqueInstance classRemoved:
aClass fromCategory: aClass category].
        SystemOrganization removeElement: aClass name.
        self removeFromStartUpList: aClass.
        self removeFromShutDownList: aClass.
        self removeKey: aClass name ifAbsent: [].
        DataStream classRemoved: aClass.
        self flushClassNameCache

SystemDictionary >> globals     needs to pay attention that compiled
methods share the associations

Number >> to: stop do: aBlock displayingProgress: aString     would be
probably nicer with the block argument last


=== To discuss:

Collection >> removeAll: comment should explain in which cases it is useful
        "the slow way"
        ^ self removeAllSuchThat: [ :each | true ]

SequenceableCollection >> <=    smells funny… what is it useful for ?
SequenceableCollection >> replacing:with:     replaces in place, not
obvious from the name
the stream methods like putOn: … convenience ? are they coherent ?

String >> withoutTrailing:    probably makes sense but then this is
mostly useful for line breaks… why not a #trimLinebreak

Set >> likeOrAdd:     ok but then that should be available for any
collection (and renamed addIfAbsent:)
        "Include newObject as one of the receiver's elements, but only if
        not already present. Answer the oldObject."


=== Useless:

ProtoObject >> iconOrThumbnailOfSize:
Object >> askFor: and askFor:ifDefault:   that's a workaround

Object >> deprecated is already here
Object >> log should be packaged in a logging package since it's a
convenience method

SequenceableCollection >> copyReplacing:with: just to type one space less ?



--
Damien Pollet
type less, do more [ | ] http://people.untyped.org/damien.pollet
_______________________________________________
Pharo-project mailing list
[email protected]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project


_______________________________________________
Pharo-project mailing list
[email protected]
http://lists.gforge.inria.fr/cgi-bin/mailman/listinfo/pharo-project

Reply via email to