includingPossibleMetaDo:

lang/API-CHANGES.txt

@@ -1,5 +1,10 @@
 0.24.0:
 
++ TBehaviorDefaults >>
+  + includingPossibleMetaDo:
++ Class >>
+  + includingPossibleMetaDo:
+
 - SmalltalkImage >>
   - includesKey:
 

lang/src/Compiler-Core.js

@@ -1007,33 +1007,27 @@ var self=this,$self=this;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-var $1,$2,$3,$receiver;
-$recv($recv($recv(aClass)._methodDictionary())._values())._do_displayingProgress_((function(each){
+var $1;
+$recv(aClass)._includingPossibleMetaDo_((function(eachSide){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx2) {
 //>>excludeEnd("ctx");
-$1=$recv($recv(each)._methodClass()).__eq(aClass);
+return $recv($recv($recv(eachSide)._methodDictionary())._values())._do_displayingProgress_((function(each){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx2.sendIdx["="]=1;
+return $core.withContext(function($ctx3) {
 //>>excludeEnd("ctx");
+$1=$recv($recv(each)._methodClass()).__eq(eachSide);
 if($core.assert($1)){
-return $self._install_forClass_protocol_($recv(each)._source(),aClass,$recv(each)._protocol());
+return $self._install_forClass_protocol_($recv(each)._source(),eachSide,$recv(each)._protocol());
 }
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)});
+}, function($ctx3) {$ctx3.fillBlock({each:each},$ctx2,2)});
 //>>excludeEnd("ctx");
-}),"Recompiling ".__comma($recv(aClass)._name()));
-$2=$recv(aClass)._theMetaClass();
-if(($receiver = $2) == null || $receiver.a$nil){
-$2;
-} else {
-var meta;
-meta=$receiver;
-$3=$recv(meta).__eq(aClass);
-if(!$core.assert($3)){
-$self._recompile_(meta);
-}
-}
+}),"Recompiling ".__comma($recv(eachSide)._name()));
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx2) {$ctx2.fillBlock({eachSide:eachSide},$ctx1,1)});
+//>>excludeEnd("ctx");
+}));
 return self;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"recompile:",{aClass:aClass})});
@@ -1041,11 +1035,11 @@ return self;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aClass"],
-source: "recompile: aClass\x0a\x09aClass methodDictionary values\x0a\x09\x09do: [ :each | each methodClass = aClass ifTrue: [ \x0a\x09\x09\x09self \x0a\x09\x09\x09\x09install: each source \x0a\x09\x09\x09\x09forClass: aClass \x0a\x09\x09\x09\x09protocol: each protocol ] ]\x0a\x09\x09displayingProgress: 'Recompiling ', aClass name.\x0a\x09aClass theMetaClass ifNotNil: [ :meta |\x0a\x09\x09meta = aClass ifFalse: [ self recompile: meta ] ]",
+source: "recompile: aClass\x0a\x09aClass includingPossibleMetaDo: [ :eachSide |\x0a\x09\x09eachSide methodDictionary values\x0a\x09\x09\x09do: [ :each | each methodClass = eachSide ifTrue: [ \x0a\x09\x09\x09\x09self \x0a\x09\x09\x09\x09\x09install: each source \x0a\x09\x09\x09\x09\x09forClass: eachSide \x0a\x09\x09\x09\x09\x09protocol: each protocol ] ]\x0a\x09\x09\x09displayingProgress: 'Recompiling ', eachSide name ]",
 referencedClasses: [],
 //>>excludeEnd("ide");
 pragmas: [],
-messageSends: ["do:displayingProgress:", "values", "methodDictionary", "ifTrue:", "=", "methodClass", "install:forClass:protocol:", "source", "protocol", ",", "name", "ifNotNil:", "theMetaClass", "ifFalse:", "recompile:"]
+messageSends: ["includingPossibleMetaDo:", "do:displayingProgress:", "values", "methodDictionary", "ifTrue:", "=", "methodClass", "install:forClass:protocol:", "source", "protocol", ",", "name"]
 }),
 $globals.Compiler);
 

lang/src/Compiler-Core.st

@@ -247,15 +247,14 @@ parseExpression: aString
 !
 
 recompile: aClass
-	aClass methodDictionary values
-		do: [ :each | each methodClass = aClass ifTrue: [ 
-			self 
-				install: each source 
-				forClass: aClass 
-				protocol: each protocol ] ]
-		displayingProgress: 'Recompiling ', aClass name.
-	aClass theMetaClass ifNotNil: [ :meta |
-		meta = aClass ifFalse: [ self recompile: meta ] ]
+	aClass includingPossibleMetaDo: [ :eachSide |
+		eachSide methodDictionary values
+			do: [ :each | each methodClass = eachSide ifTrue: [ 
+				self 
+					install: each source 
+					forClass: eachSide 
+					protocol: each protocol ] ]
+			displayingProgress: 'Recompiling ', eachSide name ]
 !
 
 recompileAll

lang/src/Kernel-Classes.js

@@ -805,6 +805,35 @@ messageSends: ["streamContents:", "print:", "superclass", "write:", "printSymbol
 }),
 $globals.Class);
 
+$core.addMethod(
+$core.method({
+selector: "includingPossibleMetaDo:",
+protocol: "enumerating",
+fn: function (aBlock){
+var self=this,$self=this;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+$recv(aBlock)._value_(self);
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["value:"]=1;
+//>>excludeEnd("ctx");
+$recv(aBlock)._value_($self._theMetaClass());
+return self;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"includingPossibleMetaDo:",{aBlock:aBlock})});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aBlock"],
+source: "includingPossibleMetaDo: aBlock\x0a\x0a\x09aBlock value: self.\x0a\x09aBlock value: self theMetaClass",
+referencedClasses: [],
+//>>excludeEnd("ide");
+pragmas: [],
+messageSends: ["value:", "theMetaClass"]
+}),
+$globals.Class);
+
 $core.addMethod(
 $core.method({
 selector: "isClass",
@@ -2221,6 +2250,31 @@ messageSends: []
 }),
 $globals.TBehaviorDefaults);
 
+$core.addMethod(
+$core.method({
+selector: "includingPossibleMetaDo:",
+protocol: "enumerating",
+fn: function (aBlock){
+var self=this,$self=this;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+$recv(aBlock)._value_(self);
+return self;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"includingPossibleMetaDo:",{aBlock:aBlock})});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aBlock"],
+source: "includingPossibleMetaDo: aBlock\x0a\x09\x22Default for non-classes.\x22\x0a\x09aBlock value: self",
+referencedClasses: [],
+//>>excludeEnd("ide");
+pragmas: [],
+messageSends: ["value:"]
+}),
+$globals.TBehaviorDefaults);
+
 $core.addMethod(
 $core.method({
 selector: "name",

lang/src/Kernel-Classes.st

@@ -209,6 +209,14 @@ provided
 	^ self javascriptConstructor provided
 ! !
 
+!Class methodsFor: 'enumerating'!
+
+includingPossibleMetaDo: aBlock
+
+	aBlock value: self.
+	aBlock value: self theMetaClass
+! !
+
 !Class methodsFor: 'testing'!
 
 isClass
@@ -599,6 +607,11 @@ traitUsers
 
 allSubclassesDo: aBlock
 	"Default for non-classes; to be able to send #allSubclassesDo: to any class / trait."
+!
+
+includingPossibleMetaDo: aBlock
+	"Default for non-classes."
+	aBlock value: self
 ! !
 
 !TBehaviorDefaults methodsFor: 'printing'!

lang/src/Kernel-Infrastructure.js

@@ -2181,31 +2181,22 @@ var traitCompositions;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-var $1,$2,$3,$receiver;
 traitCompositions=$recv($globals.Dictionary)._new();
-$recv($self._classes())._do_((function(each){
+$recv($self._classes())._do_((function(eachClass){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx2) {
 //>>excludeEnd("ctx");
-$1=traitCompositions;
-$2=$recv(each)._traitComposition();
+return $recv(eachClass)._includingPossibleMetaDo_((function(each){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx2.sendIdx["traitComposition"]=1;
+return $core.withContext(function($ctx3) {
 //>>excludeEnd("ctx");
-$recv($1)._at_put_(each,$2);
+return $recv(traitCompositions)._at_put_(each,$recv(each)._traitComposition());
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx2.sendIdx["at:put:"]=1;
+}, function($ctx3) {$ctx3.fillBlock({each:each},$ctx2,2)});
 //>>excludeEnd("ctx");
-$3=$recv(each)._theMetaClass();
-if(($receiver = $3) == null || $receiver.a$nil){
-return $3;
-} else {
-var meta;
-meta=$receiver;
-return $recv(traitCompositions)._at_put_(meta,$recv(meta)._traitComposition());
-}
+}));
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)});
+}, function($ctx2) {$ctx2.fillBlock({eachClass:eachClass},$ctx1,1)});
 //>>excludeEnd("ctx");
 }));
 return $recv(traitCompositions)._reject_((function(each){
@@ -2223,11 +2214,11 @@ return $recv(each)._isEmpty();
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: [],
-source: "traitCompositions\x0a\x09| traitCompositions |\x0a\x09traitCompositions := Dictionary new.\x0a\x09self classes do: [ :each |\x0a\x09\x09traitCompositions at: each put: each traitComposition.\x0a\x09\x09each theMetaClass ifNotNil: [ :meta | traitCompositions at: meta put: meta traitComposition ] ].\x0a\x09^ traitCompositions reject: [ :each | each isEmpty ]",
+source: "traitCompositions\x0a\x09| traitCompositions |\x0a\x09traitCompositions := Dictionary new.\x0a\x09self classes do: [ :eachClass | eachClass includingPossibleMetaDo: [ :each |\x0a\x09\x09traitCompositions at: each put: each traitComposition ] ].\x0a\x09^ traitCompositions reject: [ :each | each isEmpty ]",
 referencedClasses: ["Dictionary"],
 //>>excludeEnd("ide");
 pragmas: [],
-messageSends: ["new", "do:", "classes", "at:put:", "traitComposition", "ifNotNil:", "theMetaClass", "reject:", "isEmpty"]
+messageSends: ["new", "do:", "classes", "includingPossibleMetaDo:", "at:put:", "traitComposition", "reject:", "isEmpty"]
 }),
 $globals.Package);
 
@@ -3915,7 +3906,7 @@ var self=this,$self=this;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-var $1,$2,$5,$4,$6,$3,$7,$8,$10,$9,$receiver;
+var $1,$2,$5,$4,$6,$3,$7,$9,$8;
 $1=$recv(aClass)._isMetaclass();
 if($core.assert($1)){
 $2=$recv($recv(aClass)._asString()).__comma(" is a Metaclass and cannot be removed!");
@@ -3965,23 +3956,20 @@ return $self._error_($recv($recv(aClass)._name()).__comma(" has trait users."));
 //>>excludeEnd("ctx");
 }));
 $self._deleteClass_(aClass);
-$recv(aClass)._setTraitComposition_([]);
+$recv(aClass)._includingPossibleMetaDo_((function(each){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["setTraitComposition:"]=1;
+return $core.withContext(function($ctx2) {
 //>>excludeEnd("ctx");
-$7=$recv(aClass)._theMetaClass();
-if(($receiver = $7) == null || $receiver.a$nil){
-$7;
-} else {
-var meta;
-meta=$receiver;
-$recv(meta)._setTraitComposition_([]);
-}
-$8=$recv($globals.SystemAnnouncer)._current();
-$10=$recv($globals.ClassRemoved)._new();
-$recv($10)._theClass_(aClass);
-$9=$recv($10)._yourself();
-$recv($8)._announce_($9);
+return $recv(each)._setTraitComposition_([]);
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,4)});
+//>>excludeEnd("ctx");
+}));
+$7=$recv($globals.SystemAnnouncer)._current();
+$9=$recv($globals.ClassRemoved)._new();
+$recv($9)._theClass_(aClass);
+$8=$recv($9)._yourself();
+$recv($7)._announce_($8);
 return self;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"removeClass:",{aClass:aClass})});
@@ -3989,11 +3977,11 @@ return self;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aClass"],
-source: "removeClass: aClass\x0a\x09aClass isMetaclass ifTrue: [ self error: aClass asString, ' is a Metaclass and cannot be removed!' ].\x0a\x09aClass allSubclassesDo: [ :subclass | self error: aClass name, ' has a subclass: ', subclass name ].\x0a\x09aClass traitUsers ifNotEmpty: [ self error: aClass name, ' has trait users.' ].\x0a\x09\x0a\x09self deleteClass: aClass.\x0a\x09aClass setTraitComposition: #().\x0a\x09aClass theMetaClass ifNotNil: [ :meta | meta setTraitComposition: #() ].\x0a\x09\x0a\x09SystemAnnouncer current\x0a\x09\x09announce: (ClassRemoved new\x0a\x09\x09\x09theClass: aClass;\x0a\x09\x09\x09yourself)",
+source: "removeClass: aClass\x0a\x09aClass isMetaclass ifTrue: [ self error: aClass asString, ' is a Metaclass and cannot be removed!' ].\x0a\x09aClass allSubclassesDo: [ :subclass | self error: aClass name, ' has a subclass: ', subclass name ].\x0a\x09aClass traitUsers ifNotEmpty: [ self error: aClass name, ' has trait users.' ].\x0a\x09\x0a\x09self deleteClass: aClass.\x0a\x09aClass includingPossibleMetaDo: [ :each | each setTraitComposition: #() ].\x0a\x09\x0a\x09SystemAnnouncer current\x0a\x09\x09announce: (ClassRemoved new\x0a\x09\x09\x09theClass: aClass;\x0a\x09\x09\x09yourself)",
 referencedClasses: ["SystemAnnouncer", "ClassRemoved"],
 //>>excludeEnd("ide");
 pragmas: [],
-messageSends: ["ifTrue:", "isMetaclass", "error:", ",", "asString", "allSubclassesDo:", "name", "ifNotEmpty:", "traitUsers", "deleteClass:", "setTraitComposition:", "ifNotNil:", "theMetaClass", "announce:", "current", "theClass:", "new", "yourself"]
+messageSends: ["ifTrue:", "isMetaclass", "error:", ",", "asString", "allSubclassesDo:", "name", "ifNotEmpty:", "traitUsers", "deleteClass:", "includingPossibleMetaDo:", "setTraitComposition:", "announce:", "current", "theClass:", "new", "yourself"]
 }),
 $globals.SmalltalkImage);
 

lang/src/Kernel-Infrastructure.st

@@ -514,9 +514,8 @@ loadDependencyClasses
 traitCompositions
 	| traitCompositions |
 	traitCompositions := Dictionary new.
-	self classes do: [ :each |
-		traitCompositions at: each put: each traitComposition.
-		each theMetaClass ifNotNil: [ :meta | traitCompositions at: meta put: meta traitComposition ] ].
+	self classes do: [ :eachClass | eachClass includingPossibleMetaDo: [ :each |
+		traitCompositions at: each put: each traitComposition ] ].
 	^ traitCompositions reject: [ :each | each isEmpty ]
 ! !
 
@@ -930,8 +929,7 @@ removeClass: aClass
 	aClass traitUsers ifNotEmpty: [ self error: aClass name, ' has trait users.' ].
 	
 	self deleteClass: aClass.
-	aClass setTraitComposition: #().
-	aClass theMetaClass ifNotNil: [ :meta | meta setTraitComposition: #() ].
+	aClass includingPossibleMetaDo: [ :each | each setTraitComposition: #() ].
 	
 	SystemAnnouncer current
 		announce: (ClassRemoved new

lang/src/Platform-ImportExport.js

@@ -101,7 +101,7 @@ return $recv($2).__lt($recv(b)._name());
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx2) {
 //>>excludeEnd("ctx");
-return $recv($recv([each,$recv(each)._theMetaClass()])._copyWithout_(nil))._do_((function(behavior){
+return $recv(each)._includingPossibleMetaDo_((function(behavior){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx3) {
 //>>excludeEnd("ctx");
@@ -117,9 +117,6 @@ return $recv(result)._add_($recv($globals.ExportMethodProtocol)._name_theClass_(
 }, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,2)});
 //>>excludeEnd("ctx");
 }));
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["do:"]=1;
-//>>excludeEnd("ctx");
 return result;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"extensionProtocolsOfPackage:",{aPackage:aPackage,extensionName:extensionName,result:result})});
@@ -127,11 +124,11 @@ return result;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aPackage"],
-source: "extensionProtocolsOfPackage: aPackage\x0a\x09| extensionName result |\x0a\x09\x0a\x09extensionName := '*', aPackage name.\x0a\x09result := OrderedCollection new.\x0a\x09\x0a\x09\x22The classes must be loaded since it is extensions only.\x0a\x09Therefore topological sorting (dependency resolution) does not matter here.\x0a\x09Not sorting topologically improves the speed by a number of magnitude.\x0a\x09\x0a\x09Not to shuffle diffs, classes are sorted by their name.\x22\x0a\x09\x0a\x09(Smalltalk classes asArray sorted: [ :a :b | a name < b name ]) do: [ :each |\x0a\x09\x09({each. each theMetaClass} copyWithout: nil) do: [ :behavior |\x0a\x09\x09\x09(behavior protocols includes: extensionName) ifTrue: [\x0a\x09\x09\x09\x09result add: (ExportMethodProtocol name: extensionName theClass: behavior) ] ] ].\x0a\x0a\x09^ result",
+source: "extensionProtocolsOfPackage: aPackage\x0a\x09| extensionName result |\x0a\x09\x0a\x09extensionName := '*', aPackage name.\x0a\x09result := OrderedCollection new.\x0a\x09\x0a\x09\x22The classes must be loaded since it is extensions only.\x0a\x09Therefore topological sorting (dependency resolution) does not matter here.\x0a\x09Not sorting topologically improves the speed by a number of magnitude.\x0a\x09\x0a\x09Not to shuffle diffs, classes are sorted by their name.\x22\x0a\x09\x0a\x09(Smalltalk classes asArray sorted: [ :a :b | a name < b name ]) do: [ :each |\x0a\x09\x09each includingPossibleMetaDo: [ :behavior |\x0a\x09\x09\x09(behavior protocols includes: extensionName) ifTrue: [\x0a\x09\x09\x09\x09result add: (ExportMethodProtocol name: extensionName theClass: behavior) ] ] ].\x0a\x0a\x09^ result",
 referencedClasses: ["OrderedCollection", "Smalltalk", "ExportMethodProtocol"],
 //>>excludeEnd("ide");
 pragmas: [],
-messageSends: [",", "name", "new", "do:", "sorted:", "asArray", "classes", "<", "copyWithout:", "theMetaClass", "ifTrue:", "includes:", "protocols", "add:", "name:theClass:"]
+messageSends: [",", "name", "new", "do:", "sorted:", "asArray", "classes", "<", "includingPossibleMetaDo:", "ifTrue:", "includes:", "protocols", "add:", "name:theClass:"]
 }),
 $globals.AbstractExporter);
 
@@ -448,27 +445,23 @@ var self=this,$self=this;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-var $1,$receiver;
 $self._exportPackageDefinitionOf_on_(aPackage,aStream);
 $self._exportPackageImportsOf_on_(aPackage,aStream);
-$recv($recv(aPackage)._sortedClasses())._do_((function(each){
+$recv($recv(aPackage)._sortedClasses())._do_((function(eachClass){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx2) {
 //>>excludeEnd("ctx");
-$self._exportBehavior_on_(each,aStream);
+return $recv(eachClass)._includingPossibleMetaDo_((function(each){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx2.sendIdx["exportBehavior:on:"]=1;
+return $core.withContext(function($ctx3) {
 //>>excludeEnd("ctx");
-$1=$recv(each)._theMetaClass();
-if(($receiver = $1) == null || $receiver.a$nil){
-return $1;
-} else {
-var meta;
-meta=$receiver;
-return $self._exportBehavior_on_(meta,aStream);
-}
+return $self._exportBehavior_on_(each,aStream);
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)});
+}, function($ctx3) {$ctx3.fillBlock({each:each},$ctx2,2)});
+//>>excludeEnd("ctx");
+}));
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx2) {$ctx2.fillBlock({eachClass:eachClass},$ctx1,1)});
 //>>excludeEnd("ctx");
 }));
 $self._exportPackageTraitCompositionsOf_on_(aPackage,aStream);
@@ -480,11 +473,11 @@ return self;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aPackage", "aStream"],
-source: "exportPackage: aPackage on: aStream\x0a\x0a\x09self\x0a\x09\x09exportPackageDefinitionOf: aPackage on: aStream;\x0a\x09\x09exportPackageImportsOf: aPackage on: aStream.\x0a\x09\x0a\x09aPackage sortedClasses do: [ :each |\x0a\x09\x09self exportBehavior: each on: aStream.\x0a\x09\x09each theMetaClass ifNotNil: [ :meta | self exportBehavior: meta on: aStream ] ].\x0a\x09\x0a\x09self exportPackageTraitCompositionsOf: aPackage on: aStream.\x0a\x0a\x09self \x0a\x09\x09exportProtocols: (self extensionProtocolsOfPackage: aPackage)\x0a\x09\x09on: aStream",
+source: "exportPackage: aPackage on: aStream\x0a\x0a\x09self\x0a\x09\x09exportPackageDefinitionOf: aPackage on: aStream;\x0a\x09\x09exportPackageImportsOf: aPackage on: aStream.\x0a\x09\x0a\x09aPackage sortedClasses do: [ :eachClass | eachClass includingPossibleMetaDo: [ :each |\x0a\x09\x09self exportBehavior: each on: aStream ] ].\x0a\x09\x0a\x09self exportPackageTraitCompositionsOf: aPackage on: aStream.\x0a\x0a\x09self \x0a\x09\x09exportProtocols: (self extensionProtocolsOfPackage: aPackage)\x0a\x09\x09on: aStream",
 referencedClasses: [],
 //>>excludeEnd("ide");
 pragmas: [],
-messageSends: ["exportPackageDefinitionOf:on:", "exportPackageImportsOf:on:", "do:", "sortedClasses", "exportBehavior:on:", "ifNotNil:", "theMetaClass", "exportPackageTraitCompositionsOf:on:", "exportProtocols:on:", "extensionProtocolsOfPackage:"]
+messageSends: ["exportPackageDefinitionOf:on:", "exportPackageImportsOf:on:", "do:", "sortedClasses", "includingPossibleMetaDo:", "exportBehavior:on:", "exportPackageTraitCompositionsOf:on:", "exportProtocols:on:", "extensionProtocolsOfPackage:"]
 }),
 $globals.ChunkExporter);
 
@@ -900,7 +893,7 @@ $recv($recv($globals.Package)._sortedClasses_($recv($globals.Smalltalk)._classes
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx2) {
 //>>excludeEnd("ctx");
-return $recv([each,$recv(each)._theMetaClass()])._do_((function(aClass){
+return $recv(each)._includingPossibleMetaDo_((function(aClass){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx3) {
 //>>excludeEnd("ctx");
@@ -942,9 +935,6 @@ return $recv($globals.MethodCategory)._name_theClass_methods_(category,aClass,$r
 }, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)});
 //>>excludeEnd("ctx");
 }));
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["do:"]=1;
-//>>excludeEnd("ctx");
 return result;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"extensionCategoriesOfPackage:",{aPackage:aPackage,name:name,map:map,result:result})});
@@ -952,11 +942,11 @@ return result;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aPackage"],
-source: "extensionCategoriesOfPackage: aPackage\x0a\x09\x22Issue #143: sort protocol alphabetically\x22\x0a\x0a\x09| name map result |\x0a\x09name := aPackage name.\x0a\x09result := OrderedCollection new.\x0a\x09(Package sortedClasses: Smalltalk classes) do: [ :each |\x0a\x09\x09{each. each theMetaClass} do: [ :aClass |\x0a\x09\x09\x09map := Dictionary new.\x0a\x09\x09\x09aClass protocolsDo: [ :category :methods |\x0a\x09\x09\x09\x09category = ('*', name) ifTrue: [ map at: category put: methods ] ].\x0a\x09\x09\x09result addAll: ((map keys sorted: [ :a :b | a <= b ]) collect: [ :category |\x0a\x09\x09\x09\x09MethodCategory name: category theClass: aClass methods: (map at: category) ]) ] ].\x0a\x09^ result",
+source: "extensionCategoriesOfPackage: aPackage\x0a\x09\x22Issue #143: sort protocol alphabetically\x22\x0a\x0a\x09| name map result |\x0a\x09name := aPackage name.\x0a\x09result := OrderedCollection new.\x0a\x09(Package sortedClasses: Smalltalk classes) do: [ :each |\x0a\x09\x09each includingPossibleMetaDo: [ :aClass |\x0a\x09\x09\x09map := Dictionary new.\x0a\x09\x09\x09aClass protocolsDo: [ :category :methods |\x0a\x09\x09\x09\x09category = ('*', name) ifTrue: [ map at: category put: methods ] ].\x0a\x09\x09\x09result addAll: ((map keys sorted: [ :a :b | a <= b ]) collect: [ :category |\x0a\x09\x09\x09\x09MethodCategory name: category theClass: aClass methods: (map at: category) ]) ] ].\x0a\x09^ result",
 referencedClasses: ["OrderedCollection", "Package", "Smalltalk", "Dictionary", "MethodCategory"],
 //>>excludeEnd("ide");
 pragmas: [],
-messageSends: ["name", "new", "do:", "sortedClasses:", "classes", "theMetaClass", "protocolsDo:", "ifTrue:", "=", ",", "at:put:", "addAll:", "collect:", "sorted:", "keys", "<=", "name:theClass:methods:", "at:"]
+messageSends: ["name", "new", "do:", "sortedClasses:", "classes", "includingPossibleMetaDo:", "protocolsDo:", "ifTrue:", "=", ",", "at:put:", "addAll:", "collect:", "sorted:", "keys", "<=", "name:theClass:methods:", "at:"]
 }),
 $globals.ChunkExporter);
 
@@ -1435,30 +1425,26 @@ var self=this,$self=this;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-var $1,$receiver;
 $self._exportPackagePrologueOf_on_(aPackage,aStream);
 $self._exportPackageDefinitionOf_on_(aPackage,aStream);
 $self._exportPackageContextOf_on_(aPackage,aStream);
 $self._exportPackageImportsOf_on_(aPackage,aStream);
 $self._exportPackageTransportOf_on_(aPackage,aStream);
-$recv($recv(aPackage)._sortedClasses())._do_((function(each){
+$recv($recv(aPackage)._sortedClasses())._do_((function(eachClass){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx2) {
 //>>excludeEnd("ctx");
-$self._exportBehavior_on_(each,aStream);
+return $recv(eachClass)._includingPossibleMetaDo_((function(each){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx2.sendIdx["exportBehavior:on:"]=1;
+return $core.withContext(function($ctx3) {
 //>>excludeEnd("ctx");
-$1=$recv(each)._theMetaClass();
-if(($receiver = $1) == null || $receiver.a$nil){
-return $1;
-} else {
-var meta;
-meta=$receiver;
-return $self._exportBehavior_on_(meta,aStream);
-}
+return $self._exportBehavior_on_(each,aStream);
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)});
+}, function($ctx3) {$ctx3.fillBlock({each:each},$ctx2,2)});
+//>>excludeEnd("ctx");
+}));
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx2) {$ctx2.fillBlock({eachClass:eachClass},$ctx1,1)});
 //>>excludeEnd("ctx");
 }));
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
@@ -1482,11 +1468,11 @@ return self;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aPackage", "aStream"],
-source: "exportPackage: aPackage on: aStream\x0a\x09\x0a\x09self \x0a\x09\x09exportPackagePrologueOf: aPackage on: aStream;\x0a\x09\x09exportPackageDefinitionOf: aPackage on: aStream;\x0a\x09\x09exportPackageContextOf: aPackage on: aStream;\x0a\x09\x09exportPackageImportsOf: aPackage on: aStream;\x0a\x09\x09exportPackageTransportOf: aPackage on: aStream.\x0a\x09\x0a\x09aPackage sortedClasses do: [ :each |\x0a\x09\x09self exportBehavior: each on: aStream.\x0a\x09\x09each theMetaClass ifNotNil: [ :meta | self exportBehavior: meta on: aStream ] ].\x0a\x09\x09\x09\x0a\x09self exportPackageTraitCompositionsOf: aPackage on: aStream.\x0a\x0a\x09(self extensionMethodsOfPackage: aPackage) do: [ :each |\x0a\x09\x09self exportMethod: each on: aStream ].\x0a\x09\x09\x0a\x09self exportPackageEpilogueOf: aPackage on: aStream",
+source: "exportPackage: aPackage on: aStream\x0a\x09\x0a\x09self \x0a\x09\x09exportPackagePrologueOf: aPackage on: aStream;\x0a\x09\x09exportPackageDefinitionOf: aPackage on: aStream;\x0a\x09\x09exportPackageContextOf: aPackage on: aStream;\x0a\x09\x09exportPackageImportsOf: aPackage on: aStream;\x0a\x09\x09exportPackageTransportOf: aPackage on: aStream.\x0a\x09\x0a\x09aPackage sortedClasses do: [ :eachClass | eachClass includingPossibleMetaDo: [ :each |\x0a\x09\x09self exportBehavior: each on: aStream ] ].\x0a\x09\x09\x09\x0a\x09self exportPackageTraitCompositionsOf: aPackage on: aStream.\x0a\x0a\x09(self extensionMethodsOfPackage: aPackage) do: [ :each |\x0a\x09\x09self exportMethod: each on: aStream ].\x0a\x09\x09\x0a\x09self exportPackageEpilogueOf: aPackage on: aStream",
 referencedClasses: [],
 //>>excludeEnd("ide");
 pragmas: [],
-messageSends: ["exportPackagePrologueOf:on:", "exportPackageDefinitionOf:on:", "exportPackageContextOf:on:", "exportPackageImportsOf:on:", "exportPackageTransportOf:on:", "do:", "sortedClasses", "exportBehavior:on:", "ifNotNil:", "theMetaClass", "exportPackageTraitCompositionsOf:on:", "extensionMethodsOfPackage:", "exportMethod:on:", "exportPackageEpilogueOf:on:"]
+messageSends: ["exportPackagePrologueOf:on:", "exportPackageDefinitionOf:on:", "exportPackageContextOf:on:", "exportPackageImportsOf:on:", "exportPackageTransportOf:on:", "do:", "sortedClasses", "includingPossibleMetaDo:", "exportBehavior:on:", "exportPackageTraitCompositionsOf:on:", "extensionMethodsOfPackage:", "exportMethod:on:", "exportPackageEpilogueOf:on:"]
 }),
 $globals.Exporter);
 

lang/src/Platform-ImportExport.st

@@ -35,7 +35,7 @@ extensionProtocolsOfPackage: aPackage
 	Not to shuffle diffs, classes are sorted by their name."
 	
 	(Smalltalk classes asArray sorted: [ :a :b | a name < b name ]) do: [ :each |
-		({each. each theMetaClass} copyWithout: nil) do: [ :behavior |
+		each includingPossibleMetaDo: [ :behavior |
 			(behavior protocols includes: extensionName) ifTrue: [
 				result add: (ExportMethodProtocol name: extensionName theClass: behavior) ] ] ].
 
@@ -65,7 +65,7 @@ extensionCategoriesOfPackage: aPackage
 	name := aPackage name.
 	result := OrderedCollection new.
 	(Package sortedClasses: Smalltalk classes) do: [ :each |
-		{each. each theMetaClass} do: [ :aClass |
+		each includingPossibleMetaDo: [ :aClass |
 			map := Dictionary new.
 			aClass protocolsDo: [ :category :methods |
 				category = ('*', name) ifTrue: [ map at: category put: methods ] ].
@@ -183,9 +183,8 @@ exportPackage: aPackage on: aStream
 		exportPackageDefinitionOf: aPackage on: aStream;
 		exportPackageImportsOf: aPackage on: aStream.
 	
-	aPackage sortedClasses do: [ :each |
-		self exportBehavior: each on: aStream.
-		each theMetaClass ifNotNil: [ :meta | self exportBehavior: meta on: aStream ] ].
+	aPackage sortedClasses do: [ :eachClass | eachClass includingPossibleMetaDo: [ :each |
+		self exportBehavior: each on: aStream ] ].
 	
 	self exportPackageTraitCompositionsOf: aPackage on: aStream.
 
@@ -357,9 +356,8 @@ exportPackage: aPackage on: aStream
 		exportPackageImportsOf: aPackage on: aStream;
 		exportPackageTransportOf: aPackage on: aStream.
 	
-	aPackage sortedClasses do: [ :each |
-		self exportBehavior: each on: aStream.
-		each theMetaClass ifNotNil: [ :meta | self exportBehavior: meta on: aStream ] ].
+	aPackage sortedClasses do: [ :eachClass | eachClass includingPossibleMetaDo: [ :each |
+		self exportBehavior: each on: aStream ] ].
 			
 	self exportPackageTraitCompositionsOf: aPackage on: aStream.