The Trunk: Environments-cwp.42.mcz

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

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

Name: Environments-cwp.42
Author: cwp
Time: 1 January 2014, 1:15:54.611 pm
UUID: 7fd8f64b-fea3-4ab8-9dda-00142f2a3808
Ancestors: Environments-cwp.41

Rewrite import/export to be eager, rather than lazy. (step 2 of 3)

=============== Diff against Environments-cwp.41 ===============

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

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

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

Item was changed:
  ----- Method: Environment>>export: (in category 'configuring') -----
  export: spec
+ | policy |
+ policy := BindingPolicy
+ environment: self
- exports := Export
- namespace: public
  policy: (ExplicitNamePolicy spec: spec)
+ addSelector: #notifyObserversOfBindingAdded:
+ removeSelector: #notifyObserversOfBindingRemoved:.
+ policies := policies copyWith: policy!
- next: exports.
- self publicizeContents!

Item was changed:
  ----- Method: Environment>>exportAddingPrefix: (in category 'configuring') -----
  exportAddingPrefix: aString
+ | policy |
+ policy := BindingPolicy
+ environment: self
- exports := Export
- namespace: public
  policy: (AddPrefixNamePolicy prefix: aString)
+ addSelector: #notifyObserversOfBindingAdded:
+ removeSelector: #notifyObserversOfBindingAdded:.
+ policies := policies copyWith: policy!
- next: exports.
- self publicizeContents!

Item was changed:
  ----- Method: Environment>>exportRemovingPrefix: (in category 'configuring') -----
  exportRemovingPrefix: aString
+ | policy |
+ policy := BindingPolicy
+ environment: self
- exports := Export
- namespace: public
  policy: (RemovePrefixNamePolicy prefix: aString)
+ addSelector: #notifyObserversOfBindingAdded:
+ removeSelector: #notifyObserversOfBindingAdded:.
+ policies := policies copyWith: policy!
- next: exports.
- self publicizeContents.!

Item was changed:
  ----- Method: Environment>>exportSelf (in category 'configuring') -----
  exportSelf
+ | policy |
+ policy := BindingPolicy
+ environment: self
+ policy: (AllNamePolicy new)
+ addSelector: #notifyObserversOfBindingAdded:
+ removeSelector: #notifyObserversOfBindingAdded:.
+ policies := policies copyWith: policy!
- exports := Export namespace: public next: exports.
- self publicizeContents.!

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

Item was changed:
  ----- Method: Environment>>from:import: (in category 'configuring') -----
  from: anEnvironment import: spec
+ | policy |
+ policy := BindingPolicy
+ environment: anEnvironment
- imports := Import
- namespace: anEnvironment public
  policy: (ExplicitNamePolicy spec: spec)
+ addSelector: #showBinding:
+ removeSelector: #hideBinding:.
+ policies := policies copyWith: policy.
+ anEnvironment addObserver: self.
+ anEnvironment addAllBindings.!
- next: imports.
- !

Item was changed:
  ----- Method: Environment>>import: (in category 'configuring') -----
  import: anEnvironment
+ | policy |
+ policy := BindingPolicy
+ environment: anEnvironment
+ policy: AllNamePolicy new
+ addSelector: #showBinding:
+ removeSelector: #hideBinding:.
+ policies := policies copyWith: policy.
+ anEnvironment addObserver: self.
+ anEnvironment addAllBindings.!
- imports := Import namespace: anEnvironment public next: imports.
- self rebindUndeclared!

Item was changed:
  ----- Method: Environment>>import:addingPrefix: (in category 'configuring') -----
  import: anEnvironment addingPrefix: aString
+
+ | import |
+ import := BindingPolicy
+ environment: anEnvironment
+ policy: (AddPrefixNamePolicy prefix: aString)
+ addSelector: #showBinding:
+ removeSelector: #hideBinding:.
+ policies := policies copyWith: import.
+ anEnvironment addObserver: self.
+ anEnvironment addAllBindings.!
- "This implementation is slightly counter-intuitive. The local name has a prefix,
- so we have to remove it before doing the look up in the other environment."
-
- imports := Import
- namespace: anEnvironment public
- policy: (RemovePrefixNamePolicy prefix: aString)
- next: imports.
- self rebindUndeclared.!

Item was changed:
  ----- Method: Environment>>import:removingPrefix: (in category 'configuring') -----
  import: anEnvironment removingPrefix: aString
- "This implementation is slightly counter-intuitive. The local name doesn't have a
- prefix, so we have to add one when look it up in the other environment."
 
+ | import |
+ import := BindingPolicy
+ environment: anEnvironment
+ policy: (RemovePrefixNamePolicy prefix: aString)
+ addSelector: #showBinding:
+ removeSelector: #hideBinding:.
+ policies := policies copyWith: import.
+ anEnvironment addObserver: self.
+ anEnvironment addAllBindings.!
- imports := Import
- namespace: anEnvironment public
- policy: (AddPrefixNamePolicy prefix: aString)
- next: imports.
- self rebindUndeclared.!

Item was changed:
  ----- Method: Environment>>importSelf (in category 'configuring') -----
  importSelf
+ | policy |
+ policy := BindingPolicy
+ environment: self
+ policy: AllNamePolicy new
+ addSelector: #showBinding:
+ removeSelector: #hideBinding:.
+ policies := policies copyWith: policy.
+
+ declarations associationsDo:
+ [:ea | (bindings includesKey: ea key) ifFalse:
+ [bindings add: ea]]!
- imports := Import namespace: declarations next: imports.
- self rebindUndeclared!

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

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

Item was changed:
  ----- Method: Environment>>removeKey:ifAbsent: (in category 'emulating') -----
+ removeKey: aSymbol ifAbsent: aBlock
+ | binding |
- removeKey: key ifAbsent: aBlock
  self flag: #review.
+
+ (declarations includesKey: aSymbol) ifFalse: [^aBlock value].
+ binding := (declarations associationAt: aSymbol).
+ declarations removeKey: aSymbol.
+ self
+ binding: binding
+ removedFrom: self.
+ ^ binding value!
- ^ declarations 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."
 
  | binding category |
- binding := declarations associationAt: oldName.
  category := self organization categoryOfElement: oldName.
  self organization classify: newName under: category suppressIfDefault: true.
  self organization removeElement: oldName.
+
+ binding := self associationAt: oldName.
+ declarations removeKey: oldName.
+ self binding: binding removedFrom: self.
+
+ binding key: newName.
+ declarations add: binding.
+ self binding: binding addedTo: self.
+
- self
- remove: binding
- from: declarations
- readdAfter: [
- self
- remove: binding
- from: references
- readdAfter: [
- self
- remove: binding
- from: public
- readdAfter: [
- binding key: newName ] ] ].
  Smalltalk renamedClass: aClass from: oldName to: newName.
  SystemChangeNotifier uniqueInstance
  classRenamed: aClass
  from: oldName
  to: newName
  inCategory: category!

Item was changed:
  ----- Method: Environment>>valueOf:ifAbsent: (in category 'binding') -----
  valueOf: aSymbol ifAbsent: aBlock
+ ^ (self bindingOf: aSymbol ifAbsent: [^ aBlock value]) value!
- ^ references at: aSymbol ifAbsent: aBlock!

Item was removed:
- (PackageInfo named: 'Environments') postscript: '"below, add code to be run after the loading of this package"
-
- Smalltalk globals migrate.
- '!