Refactor.

lang/src/Compiler-Core.js

@@ -559,23 +559,25 @@ selector: "compile:forClass:protocol:",
 protocol: "compiling",
 fn: function (aString,aClass,anotherString){
 var self=this,$self=this;
-var compilationResult;
+var compilationResult,result;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
 compilationResult=$self._compileSource_forClass_protocol_(aString,aClass,anotherString);
 $recv(compilationResult)._at_put_("fn",$self._eval_forPackage_($recv(compilationResult)._at_("fn"),$self._currentPackage()));
-return compilationResult;
+result=$recv($recv($globals.Smalltalk)._core())._method_(compilationResult);
+$recv(result)._protocol_(anotherString);
+return result;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx1) {$ctx1.fill(self,"compile:forClass:protocol:",{aString:aString,aClass:aClass,anotherString:anotherString,compilationResult:compilationResult},$globals.Compiler)});
+}, function($ctx1) {$ctx1.fill(self,"compile:forClass:protocol:",{aString:aString,aClass:aClass,anotherString:anotherString,compilationResult:compilationResult,result:result},$globals.Compiler)});
 //>>excludeEnd("ctx");
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aString", "aClass", "anotherString"],
-source: "compile: aString forClass: aClass protocol: anotherString\x0a\x09| compilationResult |\x0a\x09compilationResult :=\x0a\x09\x09self compileSource: aString forClass: aClass protocol: anotherString.\x0a\x09compilationResult\x0a\x09\x09at: #fn\x0a\x09\x09put: (self eval: (compilationResult at: #fn) forPackage: self currentPackage).\x0a\x09^ compilationResult",
-referencedClasses: [],
+source: "compile: aString forClass: aClass protocol: anotherString\x0a\x09| compilationResult result |\x0a\x09compilationResult :=\x0a\x09\x09self compileSource: aString forClass: aClass protocol: anotherString.\x0a\x09compilationResult\x0a\x09\x09at: #fn\x0a\x09\x09put: (self eval: (compilationResult at: #fn) forPackage: self currentPackage).\x0a\x09result := Smalltalk core method: compilationResult.\x0a\x09result protocol: anotherString.\x0a\x09^ result",
+referencedClasses: ["Smalltalk"],
 //>>excludeEnd("ide");
-messageSends: ["compileSource:forClass:protocol:", "at:put:", "eval:forPackage:", "at:", "currentPackage"]
+messageSends: ["compileSource:forClass:protocol:", "at:put:", "eval:forPackage:", "at:", "currentPackage", "method:", "core", "protocol:"]
 }),
 $globals.Compiler);
 
@@ -658,29 +660,6 @@ messageSends: ["source:", "forClass:protocol:", "compileNode:", "parse:"]
 }),
 $globals.Compiler);
 
-$core.addMethod(
-$core.method({
-selector: "compiledMethodFrom:",
-protocol: "compiling",
-fn: function (aHashedCollection){
-var self=this,$self=this;
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-return $core.withContext(function($ctx1) {
-//>>excludeEnd("ctx");
-return $recv($recv($globals.Smalltalk)._core())._method_(aHashedCollection);
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx1) {$ctx1.fill(self,"compiledMethodFrom:",{aHashedCollection:aHashedCollection},$globals.Compiler)});
-//>>excludeEnd("ctx");
-},
-//>>excludeStart("ide", pragmas.excludeIdeData);
-args: ["aHashedCollection"],
-source: "compiledMethodFrom: aHashedCollection\x0a\x09^ Smalltalk core method: aHashedCollection",
-referencedClasses: ["Smalltalk"],
-//>>excludeEnd("ide");
-messageSends: ["method:", "core"]
-}),
-$globals.Compiler);
-
 $core.addMethod(
 $core.method({
 selector: "currentClass",
@@ -843,15 +822,13 @@ var result,method;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-var $1,$2,$3;
-method=$self._compiledMethodFrom_($self._compileExpression_on_(aString,anObject));
-$1=$recv($globals.ClassBuilder)._new();
-$2=method;
-$3=$recv(anObject)._class();
+var $1;
+method=$self._compileExpression_on_(aString,anObject);
+$1=$recv(anObject)._class();
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 $ctx1.sendIdx["class"]=1;
 //>>excludeEnd("ctx");
-$recv($1)._installMethod_forClass_protocol_($2,$3,"**xxxDoIt");
+$recv($1)._addCompiledMethod_(method);
 result=$recv(anObject)._xxxDoIt();
 $recv($recv(anObject)._class())._removeCompiledMethod_(method);
 return result;
@@ -861,10 +838,10 @@ return result;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aString", "anObject"],
-source: "evaluateExpression: aString on: anObject\x0a\x09\x22Unlike #eval: evaluate a Smalltalk expression with anObject as the receiver and answer the returned object\x22\x0a\x09| result method |\x0a\x09method := self compiledMethodFrom: (self compileExpression: aString on: anObject).\x0a\x09ClassBuilder new installMethod: method forClass: anObject class protocol: '**xxxDoIt'.\x0a\x09result := anObject xxxDoIt.\x0a\x09anObject class removeCompiledMethod: method.\x0a\x09^ result",
-referencedClasses: ["ClassBuilder"],
+source: "evaluateExpression: aString on: anObject\x0a\x09\x22Unlike #eval: evaluate a Smalltalk expression with anObject as the receiver and answer the returned object\x22\x0a\x09| result method |\x0a\x09method := self compileExpression: aString on: anObject.\x0a\x09anObject class addCompiledMethod: method.\x0a\x09result := anObject xxxDoIt.\x0a\x09anObject class removeCompiledMethod: method.\x0a\x09^ result",
+referencedClasses: [],
 //>>excludeEnd("ide");
-messageSends: ["compiledMethodFrom:", "compileExpression:on:", "installMethod:forClass:protocol:", "new", "class", "xxxDoIt", "removeCompiledMethod:"]
+messageSends: ["compileExpression:on:", "addCompiledMethod:", "class", "xxxDoIt", "removeCompiledMethod:"]
 }),
 $globals.Compiler);
 
@@ -903,18 +880,19 @@ var compiledMethod;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-compiledMethod=$self._compiledMethodFrom_($self._compile_forClass_protocol_(aString,aBehavior,anotherString));
-return $recv($recv($globals.ClassBuilder)._new())._installMethod_forClass_protocol_(compiledMethod,aBehavior,anotherString);
+compiledMethod=$self._compile_forClass_protocol_(aString,aBehavior,anotherString);
+$recv(aBehavior)._addCompiledMethod_(compiledMethod);
+return compiledMethod;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"install:forClass:protocol:",{aString:aString,aBehavior:aBehavior,anotherString:anotherString,compiledMethod:compiledMethod},$globals.Compiler)});
 //>>excludeEnd("ctx");
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aString", "aBehavior", "anotherString"],
-source: "install: aString forClass: aBehavior protocol: anotherString\x0a\x09| compiledMethod |\x0a\x09compiledMethod := self\x0a\x09\x09compiledMethodFrom: (self compile: aString forClass: aBehavior protocol: anotherString).\x0a\x09^ ClassBuilder new\x0a\x09\x09installMethod: compiledMethod\x0a\x09\x09forClass: aBehavior\x0a\x09\x09protocol: anotherString",
-referencedClasses: ["ClassBuilder"],
+source: "install: aString forClass: aBehavior protocol: anotherString\x0a\x09| compiledMethod |\x0a\x09compiledMethod := self compile: aString forClass: aBehavior protocol: anotherString.\x0a\x09aBehavior addCompiledMethod: compiledMethod.\x0a\x09^ compiledMethod",
+referencedClasses: [],
 //>>excludeEnd("ide");
-messageSends: ["compiledMethodFrom:", "compile:forClass:protocol:", "installMethod:forClass:protocol:", "new"]
+messageSends: ["compile:forClass:protocol:", "addCompiledMethod:"]
 }),
 $globals.Compiler);
 

lang/src/Compiler-Core.st

@@ -168,13 +168,15 @@ ast: aString forClass: aClass protocol: anotherString
 !
 
 compile: aString forClass: aClass protocol: anotherString
-	| compilationResult |
+	| compilationResult result |
 	compilationResult :=
 		self compileSource: aString forClass: aClass protocol: anotherString.
 	compilationResult
 		at: #fn
 		put: (self eval: (compilationResult at: #fn) forPackage: self currentPackage).
-	^ compilationResult
+	result := Smalltalk core method: compilationResult.
+	result protocol: anotherString.
+	^ result
 !
 
 compileExpression: aString on: anObject
@@ -198,10 +200,6 @@ compileSource: aString forClass: aClass protocol: anotherString
 		compileNode: (self parse: aString)
 !
 
-compiledMethodFrom: aHashedCollection
-	^ Smalltalk core method: aHashedCollection
-!
-
 eval: aString
 	<inlineJS: 'return eval(aString)'>
 !
@@ -220,8 +218,8 @@ evaluateExpression: aString
 evaluateExpression: aString on: anObject
 	"Unlike #eval: evaluate a Smalltalk expression with anObject as the receiver and answer the returned object"
 	| result method |
-	method := self compiledMethodFrom: (self compileExpression: aString on: anObject).
-	ClassBuilder new installMethod: method forClass: anObject class protocol: '**xxxDoIt'.
+	method := self compileExpression: aString on: anObject.
+	anObject class addCompiledMethod: method.
 	result := anObject xxxDoIt.
 	anObject class removeCompiledMethod: method.
 	^ result
@@ -235,12 +233,9 @@ forClass: aClass protocol: anotherString
 
 install: aString forClass: aBehavior protocol: anotherString
 	| compiledMethod |
-	compiledMethod := self
-		compiledMethodFrom: (self compile: aString forClass: aBehavior protocol: anotherString).
-	^ ClassBuilder new
-		installMethod: compiledMethod
-		forClass: aBehavior
-		protocol: anotherString
+	compiledMethod := self compile: aString forClass: aBehavior protocol: anotherString.
+	aBehavior addCompiledMethod: compiledMethod.
+	^ compiledMethod
 !
 
 parse: aString

lang/src/Kernel-Classes.js

@@ -1658,31 +1658,6 @@ messageSends: ["comment:", "comment", "valuesDo:", "methodDictionary", "ifTrue:"
 }),
 $globals.ClassBuilder);
 
-$core.addMethod(
-$core.method({
-selector: "installMethod:forClass:protocol:",
-protocol: "method definition",
-fn: function (aCompiledMethod,aBehavior,aString){
-var self=this,$self=this;
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-return $core.withContext(function($ctx1) {
-//>>excludeEnd("ctx");
-$recv(aCompiledMethod)._protocol_(aString);
-$recv(aBehavior)._addCompiledMethod_(aCompiledMethod);
-return aCompiledMethod;
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx1) {$ctx1.fill(self,"installMethod:forClass:protocol:",{aCompiledMethod:aCompiledMethod,aBehavior:aBehavior,aString:aString},$globals.ClassBuilder)});
-//>>excludeEnd("ctx");
-},
-//>>excludeStart("ide", pragmas.excludeIdeData);
-args: ["aCompiledMethod", "aBehavior", "aString"],
-source: "installMethod: aCompiledMethod forClass: aBehavior protocol: aString\x0a\x09aCompiledMethod protocol: aString.\x0a\x09aBehavior addCompiledMethod: aCompiledMethod.\x0a\x09^ aCompiledMethod",
-referencedClasses: [],
-//>>excludeEnd("ide");
-messageSends: ["protocol:", "addCompiledMethod:"]
-}),
-$globals.ClassBuilder);
-
 $core.addMethod(
 $core.method({
 selector: "migrateClass:superclass:",

lang/src/Kernel-Classes.st

@@ -465,14 +465,6 @@ copyClass: aClass to: anotherClass
 	anotherClass class setTraitComposition: aClass class traitComposition
 ! !
 
-!ClassBuilder methodsFor: 'method definition'!
-
-installMethod: aCompiledMethod forClass: aBehavior protocol: aString
-	aCompiledMethod protocol: aString.
-	aBehavior addCompiledMethod: aCompiledMethod.
-	^ aCompiledMethod
-! !
-
 !ClassBuilder methodsFor: 'private'!
 
 basicAddSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName

lang/src/Kernel-Methods.js

@@ -1064,18 +1064,23 @@ var oldProtocol;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-var $1,$3,$2,$4,$receiver;
+var $1,$2,$4,$3,$5,$receiver;
 oldProtocol=$self._protocol();
 $self.protocol=aString;
-$1=$recv($globals.SystemAnnouncer)._current();
-$3=$recv($globals.MethodMoved)._new();
-$recv($3)._method_(self);
-$recv($3)._oldProtocol_(oldProtocol);
-$2=$recv($3)._yourself();
-$recv($1)._announce_($2);
-$4=$self._methodClass();
-if(($receiver = $4) == null || $receiver.a$nil){
-$4;
+$1=oldProtocol;
+if(($receiver = $1) == null || $receiver.a$nil){
+$1;
+} else {
+$2=$recv($globals.SystemAnnouncer)._current();
+$4=$recv($globals.MethodMoved)._new();
+$recv($4)._method_(self);
+$recv($4)._oldProtocol_(oldProtocol);
+$3=$recv($4)._yourself();
+$recv($2)._announce_($3);
+}
+$5=$self._methodClass();
+if(($receiver = $5) == null || $receiver.a$nil){
+$5;
 } else {
 var methodClass;
 methodClass=$receiver;
@@ -1089,10 +1094,10 @@ return self;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: ["aString"],
-source: "protocol: aString\x0a\x09| oldProtocol |\x0a\x09oldProtocol := self protocol.\x0a\x09protocol := aString.\x0a\x0a\x09SystemAnnouncer current announce: (MethodMoved new\x0a\x09\x09method: self;\x0a\x09\x09oldProtocol: oldProtocol;\x0a\x09\x09yourself).\x0a\x0a\x09self methodClass ifNotNil: [ :methodClass |\x0a\x09\x09methodClass organization addElement: aString.\x0a\x09\x09methodClass removeProtocolIfEmpty: oldProtocol ]",
+source: "protocol: aString\x0a\x09| oldProtocol |\x0a\x09oldProtocol := self protocol.\x0a\x09protocol := aString.\x0a\x0a\x09oldProtocol ifNotNil: [\x0a\x09\x09SystemAnnouncer current announce: (MethodMoved new\x0a\x09\x09\x09method: self;\x0a\x09\x09\x09oldProtocol: oldProtocol;\x0a\x09\x09\x09yourself) ].\x0a\x0a\x09self methodClass ifNotNil: [ :methodClass |\x0a\x09\x09methodClass organization addElement: aString.\x0a\x09\x09methodClass removeProtocolIfEmpty: oldProtocol ]",
 referencedClasses: ["SystemAnnouncer", "MethodMoved"],
 //>>excludeEnd("ide");
-messageSends: ["protocol", "announce:", "current", "method:", "new", "oldProtocol:", "yourself", "ifNotNil:", "methodClass", "addElement:", "organization", "removeProtocolIfEmpty:"]
+messageSends: ["protocol", "ifNotNil:", "announce:", "current", "method:", "new", "oldProtocol:", "yourself", "methodClass", "addElement:", "organization", "removeProtocolIfEmpty:"]
 }),
 $globals.CompiledMethod);
 

lang/src/Kernel-Methods.st

@@ -266,10 +266,11 @@ protocol: aString
 	oldProtocol := self protocol.
 	protocol := aString.
 
-	SystemAnnouncer current announce: (MethodMoved new
-		method: self;
-		oldProtocol: oldProtocol;
-		yourself).
+	oldProtocol ifNotNil: [
+		SystemAnnouncer current announce: (MethodMoved new
+			method: self;
+			oldProtocol: oldProtocol;
+			yourself) ].
 
 	self methodClass ifNotNil: [ :methodClass |
 		methodClass organization addElement: aString.

lang/src/Kernel-Tests.js

@@ -520,8 +520,9 @@ return $recv(selfarg)._at_(x);
 }, function($ctx2) {$ctx2.fillBlock({selfarg:selfarg,x:x},$ctx1,1)});
 //>>excludeEnd("ctx");
 }))._currySelf())._asCompiledMethod_("foo:");
+$recv(curriedMethod)._protocol_("**test helper");
 array=[(3), (1), (4)];
-$recv($recv($globals.ClassBuilder)._new())._installMethod_forClass_protocol_(curriedMethod,$globals.Array,"**test helper");
+$recv($globals.Array)._addCompiledMethod_(curriedMethod);
 $recv((function(){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx2) {
@@ -546,10 +547,10 @@ return self;
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: [],
-source: "testCurrySelf\x0a\x09| curriedMethod array |\x0a\x09curriedMethod := [ :selfarg :x | selfarg at: x ] currySelf asCompiledMethod: 'foo:'.\x0a\x09array := #(3 1 4).\x0a\x09ClassBuilder new installMethod: curriedMethod forClass: Array protocol: '**test helper'.\x0a\x09[ self assert: (array foo: 2) equals: 1 ]\x0a\x09ensure: [ Array removeCompiledMethod: curriedMethod ]",
-referencedClasses: ["ClassBuilder", "Array"],
+source: "testCurrySelf\x0a\x09| curriedMethod array |\x0a\x09curriedMethod := [ :selfarg :x | selfarg at: x ] currySelf asCompiledMethod: 'foo:'.\x0a\x09curriedMethod protocol: '**test helper'.\x0a\x09array := #(3 1 4).\x0a\x09Array addCompiledMethod: curriedMethod.\x0a\x09[ self assert: (array foo: 2) equals: 1 ]\x0a\x09ensure: [ Array removeCompiledMethod: curriedMethod ]",
+referencedClasses: ["Array"],
 //>>excludeEnd("ide");
-messageSends: ["asCompiledMethod:", "currySelf", "at:", "installMethod:forClass:protocol:", "new", "ensure:", "assert:equals:", "foo:", "removeCompiledMethod:"]
+messageSends: ["asCompiledMethod:", "currySelf", "at:", "protocol:", "addCompiledMethod:", "ensure:", "assert:equals:", "foo:", "removeCompiledMethod:"]
 }),
 $globals.BlockClosureTest);
 

lang/src/Kernel-Tests.st

@@ -119,8 +119,9 @@ testCompiledSource
 testCurrySelf
 	| curriedMethod array |
 	curriedMethod := [ :selfarg :x | selfarg at: x ] currySelf asCompiledMethod: 'foo:'.
+	curriedMethod protocol: '**test helper'.
 	array := #(3 1 4).
-	ClassBuilder new installMethod: curriedMethod forClass: Array protocol: '**test helper'.
+	Array addCompiledMethod: curriedMethod.
 	[ self assert: (array foo: 2) equals: 1 ]
 	ensure: [ Array removeCompiledMethod: curriedMethod ]
 !