[Pkg] The Trunk: Environments-cwp.27.mcz

[commits at source.squeak.org]

Colin Putney uploaded a new version of Environments to project The Trunk:
http://source.squeak.org/trunk/Environments-cwp.27.mcz

==================== Summary ====================

Name: Environments-cwp.27
Author: cwp
Time: 26 May 2013, 1:14:09.526 pm
UUID: 42218eb4-3638-4d7d-8fdb-5ed5a4e0bb98
Ancestors: Environments-fbs.26

Refactor for clarity; rename some confusing instance variables.

=============== Diff against Environments-fbs.26 ===============

Item was changed:
  Object subclass: #Environment
+ 	instanceVariableNames: 'info imports exports declarations references public undeclared'
- 	instanceVariableNames: 'info imports exports contents bindings public undeclared'
  	classVariableNames: 'Default Instances'
  	poolDictionaries: ''
  	category: 'Environments-Core'!
+ 
+ !Environment commentStamp: 'cwp 5/26/2013 13:06' prior: 0!
+ I am a context for compiling methods. I maintain the namespace of classes and gobal variables that are visible to the methods compiled within me. 
+ 
+ Instance Variables:
+ 	info <EnvironmentInfo> 
+ 	Metadata about me and the code I contain
+ 	
+ 	imports <Import> 
+ 	Rules for importing globals from other environments
+ 	
+ 	exports <Export> 
+ 	Rules for exposing globals to other environments
+ 	
+ 	declarations <IdentityDictionary> 
+ 	Bindings for globals that have been declared inside me
+ 	
+ 	references	<IdentityDictionary>
+ 	Bindings for globals that are used by methods compiled inside me. 
+ 	
+ 	public <IdentityDictionary>
+ 	Bindings for classes that have been declared inside me, and which satisfy 
+ 	the export rules contain in 'exports'.
+ 	
+ 	undeclared	<Dictionary>
+ 	Bindings for globals that are used by methods compiled inside me, but
+ 	which aren't present 'references' and couldn't be found via the rules in 
+ 	'imports'.
+ 	!

Item was changed:
  ----- Method: Environment>>allClassesAndTraitsDo: (in category 'classes and traits') -----
  allClassesAndTraitsDo: aBlock
+ 	declarations keysAndValuesDo:
- 	contents keysAndValuesDo:
  		[:key :value |
  		((value isBehavior) and: [key == value name]) ifTrue:
  			[aBlock value: value]]!

Item was changed:
  ----- Method: Environment>>associationAt: (in category 'emulating') -----
  associationAt: aSymbol
  	"Senders of this should probably be using #bindingOf:"
  	
  	self flag: #review.
+ 	^ declarations associationAt: aSymbol!
- 	^ contents associationAt: aSymbol!

Item was changed:
  ----- Method: Environment>>associationAt:ifAbsent: (in category 'emulating') -----
  associationAt: aSymbol ifAbsent: aBlock
  	"Senders of this should probably be using #bindingOf:"
  	
  	self flag: #review.
+ 	^ declarations associationAt: aSymbol ifAbsent: aBlock!
- 	^ contents associationAt: aSymbol ifAbsent: aBlock!

Item was changed:
  ----- Method: Environment>>associationOrUndeclaredAt: (in category 'emulating') -----
  associationOrUndeclaredAt: key
+ 	^ references associationAt: key ifAbsent:
- 	^ bindings associationAt: key ifAbsent:
  		[undeclared at: key put: nil.
  		undeclared associationAt: key]
  	!

Item was changed:
  ----- Method: Environment>>at: (in category 'emulating') -----
  at: aSymbol
+ 	^ declarations at: aSymbol!
- 	^ contents at: aSymbol!

Item was changed:
  ----- Method: Environment>>at:ifAbsent: (in category 'emulating') -----
  at: aSymbol ifAbsent: aBlock
+ 	^ declarations at: aSymbol ifAbsent: aBlock!
- 	^ contents at: aSymbol ifAbsent: aBlock!

Item was changed:
  ----- Method: Environment>>at:ifAbsentPut: (in category 'emulating') -----
  at: aSymbol ifAbsentPut: aBlock 
+ 	^ declarations
- 	^ contents
  		at: aSymbol
  		ifAbsentPut: aBlock!

Item was changed:
  ----- Method: Environment>>at:ifPresent: (in category 'emulating') -----
  at: aSymbol ifPresent: aBlock
+ 	^ declarations at: aSymbol ifPresent: aBlock!
- 	^ contents at: aSymbol ifPresent: aBlock!

Item was changed:
  ----- Method: Environment>>at:ifPresent:ifAbsent: (in category 'emulating') -----
  at: aSymbol ifPresent: presentBlock ifAbsent: absentBlock
+ 	^ declarations
- 	^ contents
  		at: aSymbol
  		ifPresent: presentBlock
  		ifAbsent: absentBlock.!

Item was changed:
  ----- Method: Environment>>at:ifPresentAndInMemory: (in category 'emulating') -----
  at: key ifPresentAndInMemory: aBlock
+ 	^ declarations
- 	^ contents
  		at: key
  		ifPresent: 
  			[:v |
  			v isInMemory ifTrue:
  				[aBlock value: v]]!

Item was changed:
  ----- Method: Environment>>at:put: (in category 'emulating') -----
  at: aSymbol put: anObject
  	| binding |
+ 	(declarations includesKey: aSymbol)
+ 		ifTrue: [declarations at: aSymbol put: anObject]
- 	(contents includesKey: aSymbol)
- 		ifTrue: [contents at: aSymbol put: anObject]
  		ifFalse:
  			[(undeclared includesKey: aSymbol) 
  				ifTrue: 
+ 					[declarations declare: aSymbol from: undeclared.
+ 					declarations at: aSymbol put: anObject]
- 					[contents declare: aSymbol from: undeclared.
- 					contents at: aSymbol put: anObject]
  				ifFalse: 
  					[binding := aSymbol => anObject.
+ 					declarations add: binding.
- 					contents add: binding.
  					exports bind: binding]].
  	^ anObject
  !

Item was changed:
  ----- Method: Environment>>bindingOf:ifAbsent: (in category 'binding') -----
  bindingOf: aSymbol ifAbsent: aBlock
+ 	^ references associationAt: aSymbol ifAbsent: 
- 	^ bindings associationAt: aSymbol ifAbsent: 
  		[(imports bindingOf: aSymbol)
  			ifNil: aBlock
+ 			ifNotNil: [:foreign | references add: (foreign asBinding: aSymbol)]]!
- 			ifNotNil: [:foreign | bindings add: (foreign asBinding: aSymbol)]]!

Item was changed:
  ----- Method: Environment>>classOrTraitNamed: (in category 'classes and traits') -----
  classOrTraitNamed: aString 
  	"aString is either a class or trait name or a class or trait name followed by ' class' or 'classTrait' respectively.
  	Answer the class or metaclass it names."
  
  	| meta baseName |
  	(aString endsWith: ' class')
  		ifTrue: [meta := true.
  				baseName := aString copyFrom: 1 to: aString size - 6]
  		ifFalse: [
  			(aString endsWith: ' classTrait')
  				ifTrue: [
  					meta := true.
  					baseName := aString copyFrom: 1 to: aString size - 11]
  				ifFalse: [
  					meta := false.
  					baseName := aString]].
  
+ 	^declarations at: baseName asSymbol ifPresent:
- 	^contents at: baseName asSymbol ifPresent:
  		[ :global |
   		global isBehavior ifTrue:
  			[ meta
  				ifFalse: [ global ]
  				ifTrue: [ global classSide ]]]!

Item was changed:
  ----- Method: Environment>>do: (in category 'emulating') -----
  do: aBlock 
  	"Evaluate aBlock for each of the receiver's values."
  
+ 	declarations valuesDo: aBlock!
- 	contents valuesDo: aBlock!

Item was changed:
  ----- Method: Environment>>forgetClass:logged: (in category 'classes and traits') -----
  forgetClass: aClass logged: aBool
  	aBool ifTrue: 
  		[SystemChangeNotifier uniqueInstance 
  			classRemoved: aClass fromCategory: aClass category].
  	self organization removeElement: aClass name.
  	Smalltalk removeFromStartUpList: aClass.
  	Smalltalk removeFromShutDownList: aClass.
  	
+ 	undeclared declare: aClass name from: declarations.
- 	undeclared declare: aClass name from: contents.
  	
  	imports forgetName: aClass name.
  	exports forgetName: aClass name.
+ 	declarations removeKey: aClass name ifAbsent: [].
+ 	references removeKey: aClass name ifAbsent: [].
- 	contents removeKey: aClass name ifAbsent: [].
- 	bindings removeKey: aClass name ifAbsent: [].
  
  	[undeclared at: aClass name put: nil]
  		on: AttemptToWriteReadOnlyGlobal
  		do: [:n | n resume: true].
  !

Item was changed:
  ----- Method: Environment>>hasBindingThatBeginsWith: (in category 'binding') -----
  hasBindingThatBeginsWith: aString
+ 	references associationsDo:
- 	bindings associationsDo:
  		[:ea | (ea key beginsWith: aString) ifTrue: [^ true]].
  	^ false
  	
  !

Item was changed:
  ----- Method: Environment>>hasClassNamed: (in category 'classes and traits') -----
  hasClassNamed: aString
  	Symbol hasInterned: aString ifTrue:
  		[:symbol | 
+ 		^ (declarations at: symbol ifAbsent: [nil])
- 		^ (contents at: symbol ifAbsent: [nil])
  			isKindOf: Class].
  	^ false.!

Item was changed:
  ----- Method: Environment>>importSelf (in category 'configuring') -----
  importSelf
+ 	imports := Import namespace: declarations next: imports.
- 	imports := Import namespace: contents next: imports.
  	self rebindUndeclared!

Item was changed:
  ----- Method: Environment>>includes: (in category 'emulating') -----
  includes: value
+ 	^ declarations includes: value!
- 	^ contents includes: value!

Item was changed:
  ----- Method: Environment>>includesKey: (in category 'emulating') -----
  includesKey: key
+ 	^ declarations includesKey: key!
- 	^ contents includesKey: key!

Item was changed:
  ----- Method: Environment>>initialize (in category 'initialize-release') -----
  initialize
+ 	references := IdentityDictionary new.
+ 	declarations := IdentityDictionary new.
- 	bindings := IdentityDictionary new.
- 	contents := IdentityDictionary new.
  	public := IdentityDictionary new.
  	undeclared := IdentityDictionary new.
  	imports := Import null.
  	exports := Export null.
  	self importSelf.!

Item was changed:
  ----- Method: Environment>>initializeWithName: (in category 'initialize-release') -----
  initializeWithName: aString
  	| smalltalk |
  	self initialize.
  	info := EnvironmentInfo name: aString.
  .
  	smalltalk := SmalltalkImage basicNew.
  	smalltalk globals: self.
+ 	declarations at: #Smalltalk put: smalltalk.
+ 	declarations at: #Undeclared put: undeclared.!
- 	contents at: #Smalltalk put: smalltalk.
- 	contents at: #Undeclared put: undeclared.!

Item was changed:
  ----- Method: Environment>>initializeWithSystemDictionary: (in category 'initialize-release') -----
  initializeWithSystemDictionary: old
  	
  	self initialize.
  	info := EnvironmentInfo 
  		name: 'Smalltalk'
  		organization: old organization
  		packages: PackageOrganizer default.
+ 	old associationsDo: [:assc | declarations add: assc].
- 	old associationsDo: [:assc | contents add: assc].
  	(old at: #Undeclared) associationsDo: [:assc | undeclared add: assc].
+ 	(declarations at: #Smalltalk) instVarNamed: 'globals' put: self.
+ 	declarations at: #Undeclared put: undeclared.!
- 	(contents at: #Smalltalk) instVarNamed: 'globals' put: self.
- 	contents at: #Undeclared put: undeclared.!

Item was changed:
  ----- Method: Environment>>keyAtIdentityValue: (in category 'emulating') -----
  keyAtIdentityValue: anObject
+ 	^ declarations keyAtIdentityValue: anObject.!
- 	^ contents keyAtIdentityValue: anObject.!

Item was changed:
  ----- Method: Environment>>keyAtIdentityValue:ifAbsent: (in category 'emulating') -----
  keyAtIdentityValue: anObject ifAbsent: aBlock
+ 	^ declarations keyAtIdentityValue: anObject ifAbsent: aBlock!
- 	^ contents keyAtIdentityValue: anObject ifAbsent: aBlock!

Item was changed:
  ----- Method: Environment>>keys (in category 'emulating') -----
  keys
+ 	^ declarations keys!
- 	^ contents keys!

Item was changed:
  ----- Method: Environment>>keysDo: (in category 'emulating') -----
  keysDo: aBlock 
  	"Evaluate aBlock for each of the receiver's keys."
  
+ 	declarations keysDo: aBlock!
- 	contents keysDo: aBlock!

Item was changed:
  ----- Method: Environment>>migrate (in category 'initialize-release') -----
  migrate
+ 	references := IdentityDictionary new.
- 	bindings := IdentityDictionary new.
  	public := IdentityDictionary new.
+ 	imports := Import namespace: declarations.
- 	imports := Import namespace: contents.
  	exports :=  Export namespace: public.
+ 	declarations keysAndValuesDo:
- 	contents keysAndValuesDo:
  		[:name :value |
+ 		references at: name put: value.
- 		bindings at: name put: value.
  		public at: name put: value]
  !

Item was changed:
  ----- Method: Environment>>publicizeContents (in category 'private') -----
  publicizeContents
+ 	declarations associationsDo: [:binding | exports bind: binding].
- 	contents associationsDo: [:binding | exports bind: binding].
  !

Item was changed:
  ----- Method: Environment>>rebindUndeclared (in category 'private') -----
  rebindUndeclared
  	undeclared keys do: 
  		[:name | 
  		(imports valueOf: name) ifNotNil: 
  			[:v | 
+ 			references declare: name from: undeclared.
+ 			references at: name put: v]]!
- 			bindings declare: name from: undeclared.
- 			bindings at: name put: v]]!

Item was changed:
  ----- Method: Environment>>recompileAll (in category 'operations') -----
  recompileAll	
+ 	references removeAll.
- 	bindings removeAll.
  	self allClassesAndTraits 
  		do: [:classOrTrait | classOrTrait compileAll] 
  		displayingProgress:[:classOrTrait| 'Recompiling ', classOrTrait]
  
  
  !

Item was changed:
  ----- Method: Environment>>removeClassNamed: (in category 'classes and traits') -----
  removeClassNamed: aString
+ 	declarations 
- 	contents 
  		at: aString asSymbol 
  		ifPresent: [:class | class removeFromSystem]
  		ifAbsent: 
  			[Transcript cr; show: 'Removal of class named ', aString, 
  			' ignored because ', aString, ' does not exist.']!

Item was changed:
  ----- Method: Environment>>removeKey:ifAbsent: (in category 'emulating') -----
  removeKey: key ifAbsent: aBlock
  	self flag: #review.
+ 	^ declarations removeKey: key ifAbsent: aBlock!
- 	^ contents removeKey: key ifAbsent: aBlock!

Item was changed:
  ----- Method: Environment>>renameClass:from:to: (in category 'classes and traits') -----
  renameClass: aClass from: oldName to: newName
  	"Rename the class, aClass, to have the title newName."
  
  	| oldref category |
  	category := self organization categoryOfElement: oldName.
  	self organization classify: newName under: category suppressIfDefault: true.
  	self organization removeElement: oldName.
  	oldref := self associationAt: oldName.
+ 	declarations removeKey: oldName.
- 	contents removeKey: oldName.
  	oldref key: newName.
+ 	declarations add: oldref. 
- 	contents add: oldref. 
  	Smalltalk renamedClass: aClass from: oldName to: newName.
  	SystemChangeNotifier uniqueInstance 
  		classRenamed: aClass 
  		from: oldName 
  		to: newName 
  		inCategory: category!

Item was changed:
  ----- Method: Environment>>renameClassNamed:as: (in category 'classes and traits') -----
  renameClassNamed: oldName as: newName
+ 	declarations
- 	contents
  		at: oldName
  		ifPresent: [:class | class rename: newName]
  		ifAbsent:
  			[Transcript cr; show: 'Class-rename for ', oldName, 
  			' ignored because ', oldName, ' does not exist.']!

Item was changed:
  ----- Method: Environment>>scopeFor:from:envtAndPathIfFound: (in category 'emulating') -----
  scopeFor: aSymbol from: lower envtAndPathIfFound: aBlock
+ 	^ (declarations includesKey: aSymbol)
- 	^ (contents includesKey: aSymbol)
  		ifTrue: [aBlock value: self value: String new]
  		!

Item was changed:
  ----- Method: Environment>>select: (in category 'emulating') -----
  select: aBlock
+ 	^ declarations select: aBlock!
- 	^ contents select: aBlock!

Item was changed:
  ----- Method: Environment>>valueOf:ifAbsent: (in category 'binding') -----
  valueOf: aSymbol ifAbsent: aBlock
+ 	^ references at: aSymbol ifAbsent: aBlock!
- 	^ bindings at: aSymbol ifAbsent: aBlock!

Item was changed:
  Object subclass: #EnvironmentInfo
  	instanceVariableNames: 'name organization packages'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Environments-Core'!
+ 
+ !EnvironmentInfo commentStamp: 'cwp 5/26/2013 13:09' prior: 0!
+ I contain metadata about an Environment.
+ 
+ I have the following instance variables:
+ 	
+ name <String>
+ A human-friendly name for my environment.
+ 
+ organization <SystemOrganizer>
+ The organization of the classes in my environment into system categories.
+ 
+ packages <PackageOranizer>
+ A registry of the packages that have been loaded into my environment.!