The Trunk: Environments-cwp.27.mcz

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.!