Compiler evaluates in package context. Fix #1125.

Also, extract 'what package this protocol of that class
belongs to' into Behavior >> packageOfProtocol:

src/Compiler-Core.js

@@ -1,6 +1,7 @@
 define("amber_core/Compiler-Core", ["amber/boot", "amber_core/Kernel-Objects", "amber_core/Kernel-Infrastructure", "amber_core/Kernel-Collections"], function($boot){
 var $core=$boot.api,nil=$boot.nil,$recv=$boot.asReceiver,$globals=$boot.globals;
 $core.addPackage('Compiler-Core');
+$core.packages["Compiler-Core"].innerEval = function (expr) { return eval(expr); };
 $core.packages["Compiler-Core"].transport = {"type":"amd","amdNamespace":"amber_core"};
 
 $core.addClass('AbstractCodeGenerator', $globals.Object, ['currentClass', 'source'], 'Compiler-Core');
@@ -576,6 +577,32 @@ messageSends: []
 }),
 $globals.Compiler);
 
+$core.addMethod(
+$core.method({
+selector: "eval:forPackage:",
+protocol: 'compiling',
+fn: function (aString,aPackage){
+var self=this;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+return aPackage && aPackage.innerEval
+		? aPackage.innerEval(aString)
+		: eval(aString);
+return self;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"eval:forPackage:",{aString:aString,aPackage:aPackage},$globals.Compiler)});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aString", "aPackage"],
+source: "eval: aString forPackage: aPackage\x0a\x09<return aPackage && aPackage.innerEval\x0a\x09\x09? aPackage.innerEval(aString)\x0a\x09\x09: eval(aString)>",
+referencedClasses: [],
+//>>excludeEnd("ide");
+messageSends: []
+}),
+$globals.Compiler);
+
 $core.addMethod(
 $core.method({
 selector: "evaluateExpression:",
@@ -643,23 +670,25 @@ selector: "install:forClass:protocol:",
 protocol: 'compiling',
 fn: function (aString,aBehavior,anotherString){
 var self=this;
+var compiledMethod;
 function $ClassBuilder(){return $globals.ClassBuilder||(typeof ClassBuilder=="undefined"?nil:ClassBuilder)}
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
 var $1;
-$1=$recv($recv($ClassBuilder())._new())._installMethod_forClass_protocol_(self._eval_(self._compile_forClass_(aString,aBehavior)),aBehavior,anotherString);
+compiledMethod=self._eval_forPackage_(self._compile_forClass_(aString,aBehavior),$recv(aBehavior)._packageOfProtocol_(anotherString));
+$1=$recv($recv($ClassBuilder())._new())._installMethod_forClass_protocol_(compiledMethod,aBehavior,anotherString);
 return $1;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
-}, function($ctx1) {$ctx1.fill(self,"install:forClass:protocol:",{aString:aString,aBehavior:aBehavior,anotherString:anotherString},$globals.Compiler)});
+}, 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^ ClassBuilder new\x0a\x09\x09installMethod: (self eval: (self compile: aString forClass: aBehavior))\x0a\x09\x09forClass: aBehavior\x0a\x09\x09protocol: anotherString",
+source: "install: aString forClass: aBehavior protocol: anotherString\x0a\x09| compiledMethod |\x0a\x09compiledMethod := self\x0a\x09\x09eval: (self compile: aString forClass: aBehavior)\x0a\x09\x09forPackage: (aBehavior packageOfProtocol: anotherString).\x0a\x09^ ClassBuilder new\x0a\x09\x09installMethod: compiledMethod\x0a\x09\x09forClass: aBehavior\x0a\x09\x09protocol: anotherString",
 referencedClasses: ["ClassBuilder"],
 //>>excludeEnd("ide");
-messageSends: ["installMethod:forClass:protocol:", "new", "eval:", "compile:forClass:"]
+messageSends: ["eval:forPackage:", "compile:forClass:", "packageOfProtocol:", "installMethod:forClass:protocol:", "new"]
 }),
 $globals.Compiler);
 

src/Compiler-Core.st

@@ -158,6 +158,12 @@ eval: aString
 	<return eval(aString)>
 !
 
+eval: aString forPackage: aPackage
+	<return aPackage && aPackage.innerEval
+		? aPackage.innerEval(aString)
+		: eval(aString)>
+!
+
 evaluateExpression: aString
 	"Unlike #eval: evaluate a Smalltalk expression and answer the returned object"
 	^ self evaluateExpression: aString on: DoIt new
@@ -175,8 +181,12 @@ evaluateExpression: aString on: anObject
 !
 
 install: aString forClass: aBehavior protocol: anotherString
+	| compiledMethod |
+	compiledMethod := self
+		eval: (self compile: aString forClass: aBehavior)
+		forPackage: (aBehavior packageOfProtocol: anotherString).
 	^ ClassBuilder new
-		installMethod: (self eval: (self compile: aString forClass: aBehavior))
+		installMethod: compiledMethod
 		forClass: aBehavior
 		protocol: anotherString
 !

src/Kernel-Announcements.js

@@ -1,6 +1,7 @@
 define("amber_core/Kernel-Announcements", ["amber/boot", "amber_core/Kernel-Objects"], function($boot){
 var $core=$boot.api,nil=$boot.nil,$recv=$boot.asReceiver,$globals=$boot.globals;
 $core.addPackage('Kernel-Announcements');
+$core.packages["Kernel-Announcements"].innerEval = function (expr) { return eval(expr); };
 $core.packages["Kernel-Announcements"].transport = {"type":"amd","amdNamespace":"amber_core"};
 
 $core.addClass('AnnouncementSubscription', $globals.Object, ['valuable', 'announcementClass'], 'Kernel-Announcements');
@@ -1063,35 +1064,29 @@ selector: "package",
 protocol: 'accessing',
 fn: function (){
 var self=this;
-function $Package(){return $globals.Package||(typeof Package=="undefined"?nil:Package)}
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-var $2,$1,$3,$4;
-$2=self._protocol();
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["protocol"]=1;
-//>>excludeEnd("ctx");
-$1=$recv($2)._beginsWith_("*");
-if(!$core.assert($1)){
-$3=$recv(self._theClass())._package();
-return $3;
+var $2,$1,$receiver;
+$2=self._theClass();
+if(($receiver = $2) == null || $receiver.isNil){
+$1=$2;
+} else {
+var class_;
+class_=$receiver;
+$1=$recv(class_)._packageOfProtocol_(self._protocol());
 };
-$4=$recv($Package())._named_ifAbsent_($recv(self._protocol())._allButFirst(),(function(){
-return nil;
-
-}));
-return $4;
+return $1;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"package",{},$globals.ProtocolAnnouncement)});
 //>>excludeEnd("ctx");
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: [],
-source: "package\x0a\x0a\x09(self protocol beginsWith: '*') ifFalse: [\x0a\x09\x09^ self theClass package ].\x0a\x09\x09\x0a\x09^ Package \x0a\x09\x09named: self protocol allButFirst\x0a\x09\x09ifAbsent: [ nil ]",
-referencedClasses: ["Package"],
+source: "package\x0a\x09\x0a\x09^ self theClass ifNotNil: [ :class | class packageOfProtocol: self protocol ]",
+referencedClasses: [],
 //>>excludeEnd("ide");
-messageSends: ["ifFalse:", "beginsWith:", "protocol", "package", "theClass", "named:ifAbsent:", "allButFirst"]
+messageSends: ["ifNotNil:", "theClass", "packageOfProtocol:", "protocol"]
 }),
 $globals.ProtocolAnnouncement);
 

src/Kernel-Announcements.st

@@ -386,13 +386,8 @@ I am the abstract superclass of protocol-related announcements.!
 !ProtocolAnnouncement methodsFor: 'accessing'!
 
 package
-
-	(self protocol beginsWith: '*') ifFalse: [
-		^ self theClass package ].
-		
-	^ Package 
-		named: self protocol allButFirst
-		ifAbsent: [ nil ]
+	
+	^ self theClass ifNotNil: [ :class | class packageOfProtocol: self protocol ]
 !
 
 protocol

src/Kernel-Classes.js

@@ -1,6 +1,7 @@
 define("amber_core/Kernel-Classes", ["amber/boot", "amber_core/Kernel-Objects"], function($boot){
 var $core=$boot.api,nil=$boot.nil,$recv=$boot.asReceiver,$globals=$boot.globals;
 $core.addPackage('Kernel-Classes');
+$core.packages["Kernel-Classes"].innerEval = function (expr) { return eval(expr); };
 $core.packages["Kernel-Classes"].transport = {"type":"amd","amdNamespace":"amber_core"};
 
 $core.addClass('Behavior', $globals.Object, [], 'Kernel-Classes');
@@ -1271,6 +1272,40 @@ messageSends: ["reject:", "protocols", "match:"]
 }),
 $globals.Behavior);
 
+$core.addMethod(
+$core.method({
+selector: "packageOfProtocol:",
+protocol: 'accessing',
+fn: function (aString){
+var self=this;
+function $Package(){return $globals.Package||(typeof Package=="undefined"?nil:Package)}
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+var $1,$2,$3;
+$1=$recv(aString)._beginsWith_("*");
+if(!$core.assert($1)){
+$2=self._package();
+return $2;
+};
+$3=$recv($Package())._named_ifAbsent_($recv(aString)._allButFirst(),(function(){
+return nil;
+
+}));
+return $3;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"packageOfProtocol:",{aString:aString},$globals.Behavior)});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aString"],
+source: "packageOfProtocol: aString\x0a\x09\x22Answer the package the method of receiver belongs to:\x0a\x09- if it is an extension method, answer the corresponding package\x0a\x09- else answer the receiver's package\x22\x0a\x09\x0a\x09(aString beginsWith: '*') ifFalse: [\x0a\x09\x09^ self package ].\x0a\x09\x09\x0a\x09^ Package \x0a\x09\x09named: aString allButFirst\x0a\x09\x09ifAbsent: [ nil ]",
+referencedClasses: ["Package"],
+//>>excludeEnd("ide");
+messageSends: ["ifFalse:", "beginsWith:", "package", "named:ifAbsent:", "allButFirst"]
+}),
+$globals.Behavior);
+
 $core.addMethod(
 $core.method({
 selector: "protocols",

src/Kernel-Classes.st

@@ -184,6 +184,19 @@ ownProtocols
 		each match: '^\*' ]
 !
 
+packageOfProtocol: aString
+	"Answer the package the method of receiver belongs to:
+	- if it is an extension method, answer the corresponding package
+	- else answer the receiver's package"
+	
+	(aString beginsWith: '*') ifFalse: [
+		^ self package ].
+		
+	^ Package 
+		named: aString allButFirst
+		ifAbsent: [ nil ]
+!
+
 protocols
 	^ self organization elements sorted
 !

src/Kernel-ImportExport.js

@@ -1,6 +1,7 @@
 define("amber_core/Kernel-ImportExport", ["amber/boot", "amber_core/Kernel-Objects", "amber_core/Kernel-Infrastructure"], function($boot){
 var $core=$boot.api,nil=$boot.nil,$recv=$boot.asReceiver,$globals=$boot.globals;
 $core.addPackage('Kernel-ImportExport');
+$core.packages["Kernel-ImportExport"].innerEval = function (expr) { return eval(expr); };
 $core.packages["Kernel-ImportExport"].transport = {"type":"amd","amdNamespace":"amber_core"};
 
 $core.addClass('AbstractExporter', $globals.Object, [], 'Kernel-ImportExport');
@@ -1378,6 +1379,7 @@ return $core.withContext(function($ctx1) {
 var $1,$2;
 self._exportPackagePrologueOf_on_(aPackage,aStream);
 self._exportPackageDefinitionOf_on_(aPackage,aStream);
+self._exportPackageContextOf_on_(aPackage,aStream);
 $1=self._exportPackageTransportOf_on_(aPackage,aStream);
 $recv($recv(aPackage)._sortedClasses())._do_((function(each){
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
@@ -1443,10 +1445,52 @@ 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\x09exportPackageTransportOf: aPackage on: aStream.\x0a\x09\x0a\x09aPackage sortedClasses do: [ :each |\x0a\x09\x09self exportDefinitionOf: each on: aStream.\x0a\x09\x09each ownMethods do: [ :method |\x0a\x09\x09\x09self exportMethod: method on: aStream ].\x0a\x09\x09\x09\x0a\x09\x09self exportMetaDefinitionOf: each on: aStream.\x0a\x09\x09each class ownMethods do: [ :method |\x0a\x09\x09\x09self exportMethod: method on: aStream ] ].\x0a\x09\x09\x09\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\x09exportPackageTransportOf: aPackage on: aStream.\x0a\x09\x0a\x09aPackage sortedClasses do: [ :each |\x0a\x09\x09self exportDefinitionOf: each on: aStream.\x0a\x09\x09each ownMethods do: [ :method |\x0a\x09\x09\x09self exportMethod: method on: aStream ].\x0a\x09\x09\x09\x0a\x09\x09self exportMetaDefinitionOf: each on: aStream.\x0a\x09\x09each class ownMethods do: [ :method |\x0a\x09\x09\x09self exportMethod: method on: aStream ] ].\x0a\x09\x09\x09\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");
-messageSends: ["exportPackagePrologueOf:on:", "exportPackageDefinitionOf:on:", "exportPackageTransportOf:on:", "do:", "sortedClasses", "exportDefinitionOf:on:", "ownMethods", "exportMethod:on:", "exportMetaDefinitionOf:on:", "class", "extensionMethodsOfPackage:", "exportPackageEpilogueOf:on:"]
+messageSends: ["exportPackagePrologueOf:on:", "exportPackageDefinitionOf:on:", "exportPackageContextOf:on:", "exportPackageTransportOf:on:", "do:", "sortedClasses", "exportDefinitionOf:on:", "ownMethods", "exportMethod:on:", "exportMetaDefinitionOf:on:", "class", "extensionMethodsOfPackage:", "exportPackageEpilogueOf:on:"]
+}),
+$globals.Exporter);
+
+$core.addMethod(
+$core.method({
+selector: "exportPackageContextOf:on:",
+protocol: 'output',
+fn: function (aPackage,aStream){
+var self=this;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+return $core.withContext(function($ctx1) {
+//>>excludeEnd("ctx");
+var $1;
+$recv(aStream)._nextPutAll_("$core.packages[");
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["nextPutAll:"]=1;
+//>>excludeEnd("ctx");
+$recv(aStream)._nextPutAll_($recv($recv(aPackage)._name())._asJavascript());
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["nextPutAll:"]=2;
+//>>excludeEnd("ctx");
+$recv(aStream)._nextPutAll_("].innerEval = ");
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["nextPutAll:"]=3;
+//>>excludeEnd("ctx");
+$recv(aStream)._nextPutAll_("function (expr) { return eval(expr); }");
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+$ctx1.sendIdx["nextPutAll:"]=4;
+//>>excludeEnd("ctx");
+$recv(aStream)._nextPutAll_(";");
+$1=$recv(aStream)._lf();
+return self;
+//>>excludeStart("ctx", pragmas.excludeDebugContexts);
+}, function($ctx1) {$ctx1.fill(self,"exportPackageContextOf:on:",{aPackage:aPackage,aStream:aStream},$globals.Exporter)});
+//>>excludeEnd("ctx");
+},
+//>>excludeStart("ide", pragmas.excludeIdeData);
+args: ["aPackage", "aStream"],
+source: "exportPackageContextOf: aPackage on: aStream\x0a\x09aStream\x0a\x09\x09nextPutAll: '$core.packages[';\x0a\x09\x09nextPutAll: aPackage name asJavascript;\x0a\x09\x09nextPutAll: '].innerEval = ';\x0a\x09\x09nextPutAll: 'function (expr) { return eval(expr); }';\x0a\x09\x09nextPutAll: ';';\x0a\x09\x09lf",
+referencedClasses: [],
+//>>excludeEnd("ide");
+messageSends: ["nextPutAll:", "asJavascript", "name", "lf"]
 }),
 $globals.Exporter);
 

src/Kernel-ImportExport.st

@@ -321,6 +321,7 @@ exportPackage: aPackage on: aStream
 	self 
 		exportPackagePrologueOf: aPackage on: aStream;
 		exportPackageDefinitionOf: aPackage on: aStream;
+		exportPackageContextOf: aPackage on: aStream;
 		exportPackageTransportOf: aPackage on: aStream.
 	
 	aPackage sortedClasses do: [ :each |
@@ -338,6 +339,16 @@ exportPackage: aPackage on: aStream
 	self exportPackageEpilogueOf: aPackage on: aStream
 !
 
+exportPackageContextOf: aPackage on: aStream
+	aStream
+		nextPutAll: '$core.packages[';
+		nextPutAll: aPackage name asJavascript;
+		nextPutAll: '].innerEval = ';
+		nextPutAll: 'function (expr) { return eval(expr); }';
+		nextPutAll: ';';
+		lf
+!
+
 exportPackageDefinitionOf: aPackage on: aStream
 	aStream
 		nextPutAll: '$core.addPackage(';

src/Kernel-Methods.js

@@ -1,6 +1,7 @@
 define("amber_core/Kernel-Methods", ["amber/boot", "amber_core/Kernel-Objects"], function($boot){
 var $core=$boot.api,nil=$boot.nil,$recv=$boot.asReceiver,$globals=$boot.globals;
 $core.addPackage('Kernel-Methods');
+$core.packages["Kernel-Methods"].innerEval = function (expr) { return eval(expr); };
 $core.packages["Kernel-Methods"].transport = {"type":"amd","amdNamespace":"amber_core"};
 
 $core.addClass('BlockClosure', $globals.Object, [], 'Kernel-Methods');
@@ -1002,44 +1003,29 @@ selector: "package",
 protocol: 'accessing',
 fn: function (){
 var self=this;
-function $Package(){return $globals.Package||(typeof Package=="undefined"?nil:Package)}
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 return $core.withContext(function($ctx1) {
 //>>excludeEnd("ctx");
-var $1,$3,$2,$4,$5,$receiver;
-$1=self._methodClass();
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["methodClass"]=1;
-//>>excludeEnd("ctx");
-if(($receiver = $1) == null || $receiver.isNil){
-return nil;
+var $2,$1,$receiver;
+$2=self._methodClass();
+if(($receiver = $2) == null || $receiver.isNil){
+$1=$2;
 } else {
-$1;
+var class_;
+class_=$receiver;
+$1=$recv(class_)._packageOfProtocol_(self._protocol());
 };
-$3=self._protocol();
-//>>excludeStart("ctx", pragmas.excludeDebugContexts);
-$ctx1.sendIdx["protocol"]=1;
-//>>excludeEnd("ctx");
-$2=$recv($3)._beginsWith_("*");
-if(!$core.assert($2)){
-$4=$recv(self._methodClass())._package();
-return $4;
-};
-$5=$recv($Package())._named_ifAbsent_($recv(self._protocol())._allButFirst(),(function(){
-return nil;
-
-}));
-return $5;
+return $1;
 //>>excludeStart("ctx", pragmas.excludeDebugContexts);
 }, function($ctx1) {$ctx1.fill(self,"package",{},$globals.CompiledMethod)});
 //>>excludeEnd("ctx");
 },
 //>>excludeStart("ide", pragmas.excludeIdeData);
 args: [],
-source: "package\x0a\x09\x22Answer the package the receiver belongs to:\x0a\x09- if it is an extension method, answer the corresponding package\x0a\x09- else answer the `methodClass` package\x22\x0a\x09\x0a\x09self methodClass ifNil: [ ^ nil ].\x0a\x09\x0a\x09(self protocol beginsWith: '*') ifFalse: [\x0a\x09\x09^ self methodClass package ].\x0a\x09\x09\x0a\x09^ Package \x0a\x09\x09named: self protocol allButFirst\x0a\x09\x09ifAbsent: [ nil ]",
-referencedClasses: ["Package"],
+source: "package\x0a\x09\x22Answer the package the receiver belongs to:\x0a\x09- if it is an extension method, answer the corresponding package\x0a\x09- else answer the `methodClass` package\x22\x0a\x09\x0a\x09^ self methodClass ifNotNil: [ :class | class packageOfProtocol: self protocol ]",
+referencedClasses: [],
 //>>excludeEnd("ide");
-messageSends: ["ifNil:", "methodClass", "ifFalse:", "beginsWith:", "protocol", "package", "named:ifAbsent:", "allButFirst"]
+messageSends: ["ifNotNil:", "methodClass", "packageOfProtocol:", "protocol"]
 }),
 $globals.CompiledMethod);
 

src/Kernel-Methods.st

@@ -239,14 +239,7 @@ package
 	- if it is an extension method, answer the corresponding package
 	- else answer the `methodClass` package"
 	
-	self methodClass ifNil: [ ^ nil ].
-	
-	(self protocol beginsWith: '*') ifFalse: [
-		^ self methodClass package ].
-		
-	^ Package 
-		named: self protocol allButFirst
-		ifAbsent: [ nil ]
+	^ self methodClass ifNotNil: [ :class | class packageOfProtocol: self protocol ]
 !
 
 protocol