Split MethodContext and AIContext.

Using TMethodContext trait.

lang/src/Compiler-Interpreter.js

@@ -327,7 +327,7 @@ messageSends: ["initializeWithContext:node:", "new", "yourself"]
 $globals.AIBlockClosure.a$cls);
 
 
-$core.addClass("AIContext", $globals.MethodContext, ["outerContext", "innerContext", "pc", "locals", "selector", "index", "sendIndexes", "evaluatedSelector", "ast", "interpreter", "supercall"], "Compiler-Interpreter");
+$core.addClass("AIContext", $globals.Object, ["outerContext", "innerContext", "pc", "locals", "selector", "index", "sendIndexes", "evaluatedSelector", "ast", "interpreter", "supercall"], "Compiler-Interpreter");
 //>>excludeStart("ide", pragmas.excludeIdeData);
 $globals.AIContext.comment="I am like a `MethodContext`, used by the `ASTInterpreter`.\x0aUnlike a `MethodContext`, my instances are not read-only.\x0a\x0aWhen debugging, my instances are created by copying the current `MethodContext` (thisContext)";
 //>>excludeEnd("ide");
@@ -3757,6 +3757,8 @@ messageSends: ["visitSendNode:", "ifTrue:", "=", "selector", "trackedIndex", "in
 $globals.ASTPCNodeVisitor);
 
 
+$core.setTraitComposition([{trait: $globals.TMethodContext}], $globals.AIContext);
+
 $core.addMethod(
 $core.method({
 selector: "isLastChild",

lang/src/Compiler-Interpreter.st

@@ -100,7 +100,7 @@ forContext: aContext node: aNode
 		yourself
 ! !
 
-MethodContext subclass: #AIContext
+Object subclass: #AIContext
 	instanceVariableNames: 'outerContext innerContext pc locals selector index sendIndexes evaluatedSelector ast interpreter supercall'
 	package: 'Compiler-Interpreter'!
 !AIContext commentStamp!
@@ -971,6 +971,9 @@ visitSendNode: aNode
 		self increaseTrackedIndex ]
 ! !
 
+AIContext setTraitComposition: {TMethodContext} asTraitComposition!
+! !
+
 !ASTNode methodsFor: '*Compiler-Interpreter'!
 
 isLastChild

lang/src/Kernel-Methods.st

@@ -583,21 +583,6 @@ evaluatedSelector
 	<inlineJS: 'return self.evaluatedSelector'>
 !
 
-findContextSuchThat: testBlock
-	"Search self and my sender chain for first one that satisfies `testBlock`.  
-	Answer `nil` if none satisfy"
-
-	| context |
-	
-	context := self.
-	[ context isNil] whileFalse: [
-		(testBlock value: context) 
-			ifTrue: [ ^ context ].
-		context := context outerContext ].
-
-	^ nil
-!
-
 home
 	<inlineJS: 'return self.homeContext'>
 !
@@ -610,39 +595,10 @@ locals
 	<inlineJS: 'return self.locals || {}'>
 !
 
-method
-	| method lookupClass receiverClass supercall |
-	
-	self methodContext ifNil: [ ^ nil ].
-
-	receiverClass := self methodContext receiver class.
-	method := receiverClass lookupSelector: self methodContext selector.
-	supercall := self outerContext 
-		ifNil: [ false ]
-		ifNotNil: [ :outer | outer supercall ].
-
-	^ supercall
-		ifFalse: [ method ]
-		ifTrue: [ method methodClass superclass lookupSelector: self methodContext selector ]
-!
-
-methodContext
-	self isBlockContext ifFalse: [ ^ self ].
-	
-	^ self outerContext ifNotNil: [ :outer |
-		outer methodContext ]
-!
-
 outerContext
 	<inlineJS: 'return self.outerContext || self.homeContext'>
 !
 
-receiver
-	^ (self isBlockContext and: [ self outerContext notNil ])
-		ifTrue: [ self outerContext receiver ]
-		ifFalse: [ self basicReceiver ]
-!
-
 selector
 	<inlineJS: '
 		if(self.selector) {
@@ -653,10 +609,6 @@ selector
 	'>
 !
 
-sendIndexAt: aSelector
-	<inlineJS: 'return self.sendIdx[aSelector] || 0'>
-!
-
 sendIndexes
 	<inlineJS: 'return self.sendIdx'>
 !
@@ -669,19 +621,6 @@ supercall
 	<inlineJS: 'return self.supercall == true'>
 ! !
 
-!MethodContext methodsFor: 'converting'!
-
-asString
-	^ self isBlockContext
-		ifTrue: [ 'a block (in ', self methodContext asString, ')' ]
-		ifFalse: [ 
-			| methodClass |
-			methodClass := self method methodClass.
-			methodClass = self receiver class 
-				ifTrue: [ self receiver class name, ' >> ', self selector ]
-				ifFalse: [ self receiver class name, '(', methodClass name, ') >> ', self selector ] ]
-! !
-
 !MethodContext methodsFor: 'error handling'!
 
 stubToAtMost: anInteger
@@ -691,24 +630,6 @@ stubToAtMost: anInteger
 	context ifNotNil: [ context stubHere ]
 ! !
 
-!MethodContext methodsFor: 'printing'!
-
-printOn: aStream
-	super printOn: aStream.
-	aStream 
-		nextPutAll: '(';
-		nextPutAll: self asString;
-		nextPutAll: ')'
-! !
-
-!MethodContext methodsFor: 'testing'!
-
-isBlockContext
-	"Block context do not have selectors."
-	
-	^ self selector isNil
-! !
-
 Object subclass: #NativeFunction
 	instanceVariableNames: ''
 	package: 'Kernel-Methods'!
@@ -891,6 +812,118 @@ isNativeFunction: anObject
 	<inlineJS: 'return typeof anObject === "function"'>
 ! !
 
+Trait named: #TMethodContext
+	package: 'Kernel-Methods'!
+
+!TMethodContext methodsFor: 'accessing'!
+
+basicReceiver
+	self subclassResponsibility
+!
+
+findContextSuchThat: testBlock
+	"Search self and my sender chain for first one that satisfies `testBlock`.  
+	Answer `nil` if none satisfy"
+
+	| context |
+	
+	context := self.
+	[ context isNil] whileFalse: [
+		(testBlock value: context) 
+			ifTrue: [ ^ context ].
+		context := context outerContext ].
+
+	^ nil
+!
+
+home
+	self subclassResponsibility
+!
+
+index
+	self subclassResponsibility
+!
+
+locals
+	self subclassResponsibility
+!
+
+method
+	| method lookupClass receiverClass supercall |
+	
+	self methodContext ifNil: [ ^ nil ].
+
+	receiverClass := self methodContext receiver class.
+	method := receiverClass lookupSelector: self methodContext selector.
+	supercall := self outerContext 
+		ifNil: [ false ]
+		ifNotNil: [ :outer | outer supercall ].
+
+	^ supercall
+		ifFalse: [ method ]
+		ifTrue: [ method methodClass superclass lookupSelector: self methodContext selector ]
+!
+
+methodContext
+	self isBlockContext ifFalse: [ ^ self ].
+	
+	^ self outerContext ifNotNil: [ :outer |
+		outer methodContext ]
+!
+
+outerContext
+	self subclassResponsibility
+!
+
+receiver
+	^ (self isBlockContext and: [ self outerContext notNil ])
+		ifTrue: [ self outerContext receiver ]
+		ifFalse: [ self basicReceiver ]
+!
+
+selector
+	self subclassResponsibility
+!
+
+sendIndexes
+	self subclassResponsibility
+!
+
+supercall
+	self subclassResponsibility
+! !
+
+!TMethodContext methodsFor: 'converting'!
+
+asString
+	^ self isBlockContext
+		ifTrue: [ 'a block (in ', self methodContext asString, ')' ]
+		ifFalse: [ 
+			| methodClass |
+			methodClass := self method methodClass.
+			methodClass = self receiver class 
+				ifTrue: [ self receiver class name, ' >> ', self selector ]
+				ifFalse: [ self receiver class name, '(', methodClass name, ') >> ', self selector ] ]
+! !
+
+!TMethodContext methodsFor: 'printing'!
+
+printOn: aStream
+	super printOn: aStream.
+	aStream 
+		nextPutAll: '(';
+		nextPutAll: self asString;
+		nextPutAll: ')'
+! !
+
+!TMethodContext methodsFor: 'testing'!
+
+isBlockContext
+	"Block context do not have selectors."
+	
+	^ self selector isNil
+! !
+
 Object subclass: #Timeout
 	instanceVariableNames: 'rawTimeout'
 	package: 'Kernel-Methods'!
@@ -929,3 +962,6 @@ on: anObject
 	^ self new rawTimeout: anObject; yourself
 ! !
 
+MethodContext setTraitComposition: {TMethodContext} asTraitComposition!
+! !
+

lang/src/Platform-Services.js

@@ -2105,62 +2105,6 @@ messageSends: ["new", "at:put:", "jsObject", "setLabel:", "printString", "addObj
 }),
 $globals.JSObjectProxy);
 
-$core.addMethod(
-$core.method({
-selector: "inspectOn:",
-protocol: "*Platform-Services",
-fn: function (anInspector){
-var self=this,$self=this;
-var variables;
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-return $core.withContext(function($ctx1) {
-//>>excludeEnd("ctx");
-variables=$recv($globals.Dictionary)._new();
-$recv(variables)._at_put_("#self",self);
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["at:put:"]=1;
-//>>excludeEnd("ctx");
-$recv(variables)._at_put_("#home",$self._home());
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["at:put:"]=2;
-//>>excludeEnd("ctx");
-$recv(variables)._at_put_("#receiver",$self._receiver());
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["at:put:"]=3;
-//>>excludeEnd("ctx");
-$recv(variables)._at_put_("#selector",$self._selector());
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["at:put:"]=4;
-//>>excludeEnd("ctx");
-$recv(variables)._at_put_("#locals",$self._locals());
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["at:put:"]=5;
-//>>excludeEnd("ctx");
-$recv($recv($self._class())._instanceVariableNames())._do_((function(each){
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-return $core.withContext(function($ctx2) {
-//>>excludeEnd("ctx");
-return $recv(variables)._at_put_(each,$self._instVarAt_(each));
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)});
-//>>excludeEnd("ctx");
-}));
-$recv(anInspector)._setLabel_($self._printString());
-$recv(anInspector)._setVariables_(variables);
-return self;
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx1) {$ctx1.fill(self,"inspectOn:",{anInspector:anInspector,variables:variables},$globals.MethodContext)});
-//>>excludeEnd("ctx");
-},
-//>>excludeStart("ide", pragmas.excludeIdeData);
-args: ["anInspector"],
-source: "inspectOn: anInspector\x0a\x09| variables |\x0a\x09variables := Dictionary new.\x0a\x09variables at: '#self' put: self.\x0a\x09variables at: '#home' put: self home.\x0a\x09variables at: '#receiver' put: self receiver.\x0a\x09variables at: '#selector' put: self selector.\x0a\x09variables at: '#locals' put: self locals.\x0a\x09self class instanceVariableNames do: [ :each |\x0a\x09\x09variables at: each put: (self instVarAt: each) ].\x0a\x09anInspector\x0a\x09\x09setLabel: self printString;\x0a\x09\x09setVariables: variables",
-referencedClasses: ["Dictionary"],
-//>>excludeEnd("ide");
-messageSends: ["new", "at:put:", "home", "receiver", "selector", "locals", "do:", "instanceVariableNames", "class", "instVarAt:", "setLabel:", "printString", "setVariables:"]
-}),
-$globals.MethodContext);
-
 $core.addMethod(
 $core.method({
 selector: "inspectOn:",
@@ -2320,4 +2264,60 @@ messageSends: ["inspectOn:", "ifTrue:ifFalse:", ">", "size", "printString", ",",
 }),
 $globals.String);
 
+$core.addMethod(
+$core.method({
+selector: "inspectOn:",
+protocol: "*Platform-Services",
+fn: function (anInspector){
+var self=this,$self=this;
+var variables;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+variables=$recv($globals.Dictionary)._new();
+$recv(variables)._at_put_("#self",self);
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["at:put:"]=1;
+//>>excludeEnd("ctx");
+$recv(variables)._at_put_("#home",$self._home());
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["at:put:"]=2;
+//>>excludeEnd("ctx");
+$recv(variables)._at_put_("#receiver",$self._receiver());
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["at:put:"]=3;
+//>>excludeEnd("ctx");
+$recv(variables)._at_put_("#selector",$self._selector());
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["at:put:"]=4;
+//>>excludeEnd("ctx");
+$recv(variables)._at_put_("#locals",$self._locals());
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["at:put:"]=5;
+//>>excludeEnd("ctx");
+$recv($recv($self._class())._instanceVariableNames())._do_((function(each){
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx2) {
+//>>excludeEnd("ctx");
+return $recv(variables)._at_put_(each,$self._instVarAt_(each));
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx2) {$ctx2.fillBlock({each:each},$ctx1,1)});
+//>>excludeEnd("ctx");
+}));
+$recv(anInspector)._setLabel_($self._printString());
+$recv(anInspector)._setVariables_(variables);
+return self;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"inspectOn:",{anInspector:anInspector,variables:variables},$globals.TMethodContext)});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["anInspector"],
+source: "inspectOn: anInspector\x0a\x09| variables |\x0a\x09variables := Dictionary new.\x0a\x09variables at: '#self' put: self.\x0a\x09variables at: '#home' put: self home.\x0a\x09variables at: '#receiver' put: self receiver.\x0a\x09variables at: '#selector' put: self selector.\x0a\x09variables at: '#locals' put: self locals.\x0a\x09self class instanceVariableNames do: [ :each |\x0a\x09\x09variables at: each put: (self instVarAt: each) ].\x0a\x09anInspector\x0a\x09\x09setLabel: self printString;\x0a\x09\x09setVariables: variables",
+referencedClasses: ["Dictionary"],
+//>>excludeEnd("ide");
+messageSends: ["new", "at:put:", "home", "receiver", "selector", "locals", "do:", "instanceVariableNames", "class", "instVarAt:", "setLabel:", "printString", "setVariables:"]
+}),
+$globals.TMethodContext);
+
 });

lang/src/Platform-Services.st

@@ -584,23 +584,6 @@ inspectOn: anInspector
 	anInspector setVariables: variables
 ! !
 
-!MethodContext methodsFor: '*Platform-Services'!
-
-inspectOn: anInspector
-	| variables |
-	variables := Dictionary new.
-	variables at: '#self' put: self.
-	variables at: '#home' put: self home.
-	variables at: '#receiver' put: self receiver.
-	variables at: '#selector' put: self selector.
-	variables at: '#locals' put: self locals.
-	self class instanceVariableNames do: [ :each |
-		variables at: each put: (self instVarAt: each) ].
-	anInspector
-		setLabel: self printString;
-		setVariables: variables
-! !
-
 !Object methodsFor: '*Platform-Services'!
 
 inspectOn: anInspector
@@ -649,3 +632,20 @@ inspectOn: anInspector
 	anInspector setLabel: label
 ! !
 
+!TMethodContext methodsFor: '*Platform-Services'!
+
+inspectOn: anInspector
+	| variables |
+	variables := Dictionary new.
+	variables at: '#self' put: self.
+	variables at: '#home' put: self home.
+	variables at: '#receiver' put: self receiver.
+	variables at: '#selector' put: self selector.
+	variables at: '#locals' put: self locals.
+	self class instanceVariableNames do: [ :each |
+		variables at: each put: (self instVarAt: each) ].
+	anInspector
+		setLabel: self printString;
+		setVariables: variables
+! !
+