[squeak-dev] The Trunk: System-mt.1190.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Nov 5 15:23:36 UTC 2020


Marcel Taeumel uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-mt.1190.mcz

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

Name: System-mt.1190
Author: mt
Time: 5 November 2020, 4:23:31.287798 pm
UUID: 832d3d0e-dc06-a14f-ac49-d7dc709680ea
Ancestors: System-mt.1189

Speeds up String >> #translated and locale switching as follows:
- Only call #localeChanged(Gently) on classes that implement it, just like #cleanUp:
- For the InternalTranslator, make translation-in-all-domains a no-op; 122µs -> 1.3µs
- For the GetTextTranslator, make translation-in-all-domains fetch all available .mo files once, then directly enumerate that cache until a result is found; roughly 50µs -> 8µs
- Avoid loading all .mo files on #localeChanged(Gently); only do that for translation-in-all-domains

=============== Diff against System-mt.1189 ===============

Item was added:
+ ----- Method: GetTextTranslator class>>addUserDefaultLocaleDir: (in category 'translation data layout') -----
+ addUserDefaultLocaleDir: dir
+ 	"new dir will be put as first"
+  	self userDefaultLocaleDirs addFirst: dir!

Item was changed:
  ----- Method: GetTextTranslator class>>availableLanguageLocaleIDs (in category 'accessing') -----
  availableLanguageLocaleIDs
  	"GetTextTranslator availableLanguageLocaleIDs"
  	| ids dirs localeDirForLang directoryNames |
  	ids := Set new.
  	dirs := Set new.
+ 	dirs addAll: self localeDirsForDomain.
+ 	dirs addAll: self userDefaultLocaleDirs.
+ 	dirs addAll: self systemDefaultLocaleDirs.
- 	dirs addAll: LocaleDirsForDomain values.
- 	dirs addAll: self defaultLocaleDirs.
  	dirs do: [:dir |
  		| localesDir |
  		localesDir := FileDirectory on: dir. 
  		directoryNames := [localesDir directoryNames] on: InvalidDirectoryError do: [:e | #()].
  		directoryNames
  				do: [:langDirName | 
  					| localeID  |
  					localeID := LocaleID posixName: langDirName.
  					localeDirForLang := localesDir directoryNamed: (self langDirNameForLocaleID: localeID).
  					localeDirForLang ifNotNil: [
  						(localeDirForLang fileNamesMatching: '*.mo') ifNotEmpty: [ids add: localeID]].
  					localeID hasParent ifTrue: [
  						localeDirForLang := localesDir directoryNamed: (self langDirNameForLocaleID: localeID parent).
  						localeDirForLang ifNotNil: [
  							(localeDirForLang fileNamesMatching: '*.mo') ifNotEmpty: [ids add: localeID parent]]].
  				].
  	].
  	^ids!

Item was added:
+ ----- Method: GetTextTranslator class>>cleanUp: (in category 'class initialization') -----
+ cleanUp: aggressive
+ 
+ 	aggressive ifTrue: [
+ 		UserDefaultLocaleDirs := OrderedCollection new.
+ 		LocaleDirsForDomain := Dictionary new].!

Item was removed:
- ----- Method: GetTextTranslator class>>defaultLocaleDirs (in category 'translation data layout') -----
- defaultLocaleDirs
- 	| dirs |
- 	dirs := OrderedCollection new.
- 	UserDefaultLocaleDirs ifNotNil: [dirs addAll: UserDefaultLocaleDirs].
- 	dirs addAll: self systemDefaultLocaleDirs.
- 	^dirs
- !

Item was added:
+ ----- Method: GetTextTranslator class>>findAllMOsForLocaleID: (in category 'private') -----
+ findAllMOsForLocaleID: id
+ 
+ 	| relativePath path allMONames result |
+ 	relativePath := String streamContents: [:stream |
+ 		stream
+ 			nextPutAll: FileDirectory slash;
+ 			nextPutAll: (self langDirNameForLocaleID: id);
+ 			nextPutAll: FileDirectory slash].
+ 	allMONames := TextDomainManager allKnownDomains
+ 		collect: [:each | each -> (self moNameForDomain: each)].
+ 	result := OrderedCollection new.
+ 	self localeDirsDo: [:localeDir | 
+ 		allMONames do: [:moName |
+ 			path := String streamContents: [:s |
+ 				s nextPutAll: localeDir; nextPutAll: relativePath; nextPutAll: moName value].
+ 			([FileDirectory default fileExists: path] on: InvalidDirectoryError do: [false])
+ 				 ifTrue: [result add: moName key -> path] ]].
+ 	^ result!

Item was changed:
  ----- Method: GetTextTranslator class>>findMOForLocaleID:domain: (in category 'private') -----
  findMOForLocaleID: id domain: aDomainName
+ 
+ 	| relativePath path |
+ 	relativePath := String streamContents: [:stream |
+ 		stream
+ 			nextPutAll: FileDirectory slash;
+ 			nextPutAll: (self langDirNameForLocaleID: id);
+ 			nextPutAll: FileDirectory slash;
+ 			nextPutAll: (self moNameForDomain: aDomainName)].
+ 	self
+ 		localeDirsForDomain: aDomainName
+ 		do: [:localeDir |
+ 			path := localeDir, relativePath.
+ 			([FileDirectory default fileExists: path] on: InvalidDirectoryError do: [false])
+ 				ifTrue: [^ path]].
+ 	^ nil!
- 	| sepa langSubDir path |
- 	sepa := FileDirectory slash.
- 	langSubDir := self langDirNameForLocaleID: id.
- 	(self localeDirsForDomain: aDomainName)
- 		do: [:each |
- 			path := each , sepa , langSubDir, sepa , (self moNameForDomain: aDomainName).
- 			[(FileDirectory default fileExists: path)
- 				 ifTrue: [^path]] on: InvalidDirectoryError do: [:e | ^nil]].
- 	^nil.!

Item was added:
+ ----- Method: GetTextTranslator class>>getLocaleDirForDomain: (in category 'translation data layout') -----
+ getLocaleDirForDomain: aDomainName
+ 	"returns registered localeDirectory for the textdomain. returns nil if not registered"
+ 	^LocaleDirsForDomain at: aDomainName ifAbsent: [nil]!

Item was removed:
- ----- Method: GetTextTranslator class>>localeDirForDomain: (in category 'translation data layout') -----
- localeDirForDomain: aDomainName
- 	"returns registered localeDirectory for the textdomain. returns nil if not registered"
- 	^LocaleDirsForDomain at: aDomainName ifAbsent: [nil]!

Item was added:
+ ----- Method: GetTextTranslator class>>localeDirsDo: (in category 'translation data layout') -----
+ localeDirsDo: workBlock
+ 	"Enumerates all locale directories, regardless of a specific text domain. Begin with domain-specific directories, then user-specific directories, finally system-specific directories."
+ 	
+ 	self localeDirsForDomain do: workBlock.
+ 	self userDefaultLocaleDirs do: workBlock.
+ 	self systemDefaultLocaleDirs do: workBlock.!

Item was changed:
+ ----- Method: GetTextTranslator class>>localeDirsForDomain (in category 'accessing') -----
- ----- Method: GetTextTranslator class>>localeDirsForDomain (in category 'private') -----
  localeDirsForDomain
+ 
+ 	^ LocaleDirsForDomain values!
- 	^LocaleDirsForDomain ifNil: [LocaleDirsForDomain := Dictionary new]!

Item was removed:
- ----- Method: GetTextTranslator class>>localeDirsForDomain: (in category 'translation data layout') -----
- localeDirsForDomain: aDomainName
- 	"returns collection of locale directories for text domain.  
- 	This includes user defined one for the domain, user defaults and system defaults" 
- 	| dirs dir |
- 	dirs := OrderedCollection new.
- 	dir := self localeDirForDomain: aDomainName.
- 	dir ifNotNil: [dirs add: dir].
- 	dirs addAll:  self defaultLocaleDirs.
- 	^dirs!

Item was added:
+ ----- Method: GetTextTranslator class>>localeDirsForDomain:do: (in category 'translation data layout') -----
+ localeDirsForDomain: aDomainName do: workBlock
+ 	"Enumerates all locale directories for the text domain. Begin with domain-specific directories, then user-specific directories, finally system-specific directories."
+ 	
+ 	(self getLocaleDirForDomain: aDomainName)
+ 		ifNotNil: [:dir | workBlock value: dir].
+ 		
+ 	self userDefaultLocaleDirs do: workBlock.
+ 	self systemDefaultLocaleDirs do: workBlock.!

Item was changed:
  ----- Method: GetTextTranslator class>>privateStartUp (in category 'class initialization') -----
  privateStartUp
+ 	self setSystemDefaultLocaleDirs.
- 	self setupLocaleDirs.
  	self availableLanguageLocaleIDs do: [ :localeID |
  		NaturalLanguageTranslator translators 
  				at: localeID 
  				put: (self newForLocaleID: localeID).
  	]!

Item was removed:
- ----- Method: GetTextTranslator class>>setLocaleDir:forDoamin: (in category 'translation data layout') -----
- setLocaleDir: path forDoamin: aDomainName
- 	self LocaleDirsForDomain
- 		at: aDomainName
- 		put: path.!

Item was added:
+ ----- Method: GetTextTranslator class>>setLocaleDirForDomain:to: (in category 'translation data layout') -----
+ setLocaleDirForDomain: aDomainName to: aPath
+ 
+ 	LocaleDirsForDomain at: aDomainName put: aPath.!

Item was added:
+ ----- Method: GetTextTranslator class>>setSystemDefaultLocaleDirs (in category 'translation data layout') -----
+ setSystemDefaultLocaleDirs
+ 
+ 	| dirs sepa localesDirName |
+ 	sepa := FileDirectory slash.
+ 	SystemDefaultLocaleDirs := nil.
+ 	dirs := self systemDefaultLocaleDirs.
+ 	localesDirName := 'locale'.
+ 	{ Smalltalk imagePath. Smalltalk vmPath } do: [:path |
+ 		dirs addIfNotPresent: ((path endsWith: sepa)
+ 			ifTrue: [path, localesDirName]
+ 			ifFalse: [path, sepa, localesDirName])].!

Item was removed:
- ----- Method: GetTextTranslator class>>setupLocaleDirs (in category 'translation data layout') -----
- setupLocaleDirs
- 	| dirs sepa localesDirName |
- 	sepa := FileDirectory slash.
- 	SystemDefaultLocaleDirs := nil.
- 	dirs := self systemDefaultLocaleDirs.
- 	localesDirName := 'locale'.
- 	dirs add:  (Smalltalk imagePath) , sepa , localesDirName.
- 	dirs add:  (Smalltalk vmPath) , sepa , localesDirName.
- 	^dirs!

Item was changed:
+ ----- Method: GetTextTranslator class>>systemDefaultLocaleDirs (in category 'accessing') -----
- ----- Method: GetTextTranslator class>>systemDefaultLocaleDirs (in category 'translation data layout') -----
  systemDefaultLocaleDirs
  	^SystemDefaultLocaleDirs ifNil: [SystemDefaultLocaleDirs := OrderedCollection new]
  !

Item was changed:
+ ----- Method: GetTextTranslator class>>userDefaultLocaleDirs (in category 'accessing') -----
- ----- Method: GetTextTranslator class>>userDefaultLocaleDirs (in category 'translation data layout') -----
  userDefaultLocaleDirs
  	^UserDefaultLocaleDirs ifNil: [UserDefaultLocaleDirs := OrderedCollection new]
  !

Item was changed:
  ----- Method: GetTextTranslator>>initialize (in category 'initialize-release') -----
  initialize
+ 
+ 	super initialize.
  	moFiles := Dictionary new.!

Item was removed:
- ----- Method: GetTextTranslator>>loadMOFiles (in category 'accessing') -----
- loadMOFiles
- 	TextDomainManager allKnownDomains 
- 		do: [:domainName |
- 			self moFileForDomain: domainName
- 		].!

Item was added:
+ ----- Method: GetTextTranslator>>loadMOFilesForAllDomains (in category 'private') -----
+ loadMOFilesForAllDomains
+ 
+ 	moFiles := Dictionary new.
+ 	moFiles at: #* put: OrderedCollection new.
+ 
+ 	(self class findAllMOsForLocaleID: self localeID) do: [:moName |
+ 		| moFile |
+ 		moFile := MOFile new load: moName value localeID: self localeID.
+ 		moFiles at: moName key put: moFile.
+ 		(moFiles at: #*) add: moFile].
+ 	
+ 	^ moFiles at: #*!

Item was added:
+ ----- Method: GetTextTranslator>>localeChanged (in category 'language switching') -----
+ localeChanged
+ 	"Reset cached .mo files. They will be loaded again as needed."
+ 
+ 	moFiles := Dictionary new.!

Item was removed:
- ----- Method: GetTextTranslator>>reloadMOFiles (in category 'accessing') -----
- reloadMOFiles
- 	moFiles := Dictionary new.
- 	self loadMOFiles.!

Item was removed:
- ----- Method: GetTextTranslator>>setCurrent (in category 'language switching') -----
- setCurrent
- 	"ensure actual contents of MOs is loaded on switching language"
- 	self loadMOFiles!

Item was added:
+ ----- Method: GetTextTranslator>>translateInAllDomains: (in category 'translation') -----
+ translateInAllDomains: aString
+ 
+ 	| translation |
+ 	(self moFiles at: #* ifAbsent: [self loadMOFilesForAllDomains])
+ 		do: [:moFile | 
+ 			translation := moFile translationFor: aString.
+ 			translation == aString ifFalse: [^ translation]].
+ 	^ aString "no translation found"!

Item was added:
+ ----- Method: InternalTranslator>>translateInAllDomains: (in category 'translation') -----
+ translateInAllDomains: aString
+ 	"Domains do not matter for the internal translator."
+ 	
+ 	^ aString!

Item was changed:
  ----- Method: Locale class>>localeChanged (in category 'notification') -----
  localeChanged
+ 	
+ 	NaturalLanguageTranslator localeChanged.
  	SystemNavigation default allBehaviorsDo: [:b |
+ 		(b ~~ self and: [b ~~ NaturalLanguageTranslator])
+ 			ifTrue: [(b class includesSelector: #localeChanged)
+ 				ifTrue: [b localeChanged]]].!
- 		b == self ifFalse: [b localeChanged]].!

Item was changed:
  ----- Method: Locale class>>localeChangedGently (in category 'notification') -----
  localeChangedGently
+ 
+ 	NaturalLanguageTranslator localeChangedGently.
+ 	SystemNavigation default allBehaviorsDo: [:b |
+ 		(b ~~ self and: [b ~~ NaturalLanguageTranslator])
+ 			ifTrue: [(b class includesSelector: #localeChangedGently)
+ 				ifTrue: [b localeChangedGently]]].!
- 	SystemNavigation default allBehaviorsDo: [:b | b == self ifFalse: [b localeChangedGently]].!

Item was changed:
  ----- Method: Locale class>>switchTo:gently: (in category 'accessing') -----
  switchTo: locale gently: gentlyFlag
  	"Locale switchTo: (Locale isoLanguage: 'de')"
  	| availableID |
  	availableID := (NaturalLanguageTranslator availableForLocaleID: locale localeID) localeID.
  	Current localeID = availableID
  		ifFalse: [Previous := Current.
  				CurrentPlatform := Current := Locale localeID: availableID.
- 				NaturalLanguageTranslator localeChanged.
  				gentlyFlag ifTrue: [self localeChangedGently] ifFalse: [self localeChanged]]!

Item was changed:
  ----- Method: NaturalLanguageTranslator class>>localeChanged (in category 'accessing') -----
  localeChanged
  	"notify some project starts to use this locale.
  	 this facility may use the event to load translation data dynamically" 
+ 	self current localeChanged.
- 	self current setCurrent
  !

Item was added:
+ ----- Method: NaturalLanguageTranslator>>localeChanged (in category 'language switching') -----
+ localeChanged
+ 	"The system's current locale (ID) changed. Make sure to update all lookup caches if your translator needs external resources such as files."!

Item was removed:
- ----- Method: NaturalLanguageTranslator>>setCurrent (in category 'language switching') -----
- setCurrent
- 	"notify locale of the translator become current"
- !

Item was added:
+ ----- Method: NaturalLanguageTranslator>>translateInAllDomains: (in category 'translation') -----
+ translateInAllDomains: aString
+ 
+ 	| translation |
+ 	TextDomainManager allKnownDomains do: [:domain |
+ 		translation := self translate: aString inDomain: domain.
+ 		aString == translation ifFalse: [^ translation]].
+ 	^ aString!

Item was changed:
  ----- Method: String>>translated (in category '*System-Localization') -----
  translated
+ 	"Note that we cannot call #translatedTo: because the sender context encodes the domain name."
+ 	
+ 	^ self
- 	"answer the receiver translated to the default language"
- 	| translation |
- 	translation := self
  		translatedTo: LocaleID current
+ 		inDomain: (TextDomainManager domainOfMethod: thisContext sender method)!
- 		inDomain: (TextDomainManager domainOfMethod: thisContext sender method).
- 	self == translation ifTrue: [^self translatedInAllDomains].
- 	^translation!

Item was removed:
- ----- Method: String>>translatedInAllDomains (in category '*System-Localization') -----
- translatedInAllDomains
- 	| translation |
- 	"Transcript show: self printString, ' translatedInAllDomains'; cr."
- 	TextDomainManager allKnownDomains do: [:domain |
- 		translation := self translatedTo: LocaleID current inDomain: domain.
- 		self = translation ifFalse: [^translation]
- 	].
- 	^self!

Item was removed:
- ----- Method: String>>translatedInAnyDomain (in category '*System-Localization') -----
- translatedInAnyDomain
- 	| translation |
- 	Transcript show: self printString, ' translatedInAnyDomain'; cr.
- 	TextDomainManager allKnownDomains do: [:domain |
- 		translation := self translatedInDomain: domain.
- 		self = translation ifFalse: [^translation]].
- 	^self!

Item was changed:
  ----- Method: String>>translatedInDomain: (in category '*System-Localization') -----
  translatedInDomain: aDomainName
+ 
+ 	^ self
+ 		translatedTo: LocaleID current
+ 		inDomain: aDomainName!
- 	| translation |
- 	translation := self translatedTo: LocaleID current inDomain: aDomainName.
- 	self == translation ifTrue: [^self translatedInAllDomains].
- 	^translation
- !

Item was removed:
- ----- Method: String>>translatedInDomain:or: (in category '*System-Localization') -----
- translatedInDomain: aDomainName or: anotherDomainName
- 	| translation |
- 	translation := self translatedTo: LocaleID current inDomain: aDomainName.
- 	self == translation ifTrue: [^self translatedInDomain: anotherDomainName].
- 	^translation
- !

Item was changed:
  ----- Method: String>>translatedTo: (in category '*System-Localization') -----
  translatedTo: localeID 
  	"answer the receiver translated to the given locale id"
+ 
+ 	^ self
+ 		translatedTo: localeID
+ 		inDomain: (TextDomainManager domainOfMethod: thisContext sender method)!
- 	^ self translatedTo: localeID inDomain: (TextDomainManager domainOfMethod: thisContext sender method).!

Item was changed:
  ----- Method: String>>translatedTo:inDomain: (in category '*System-Localization') -----
  translatedTo: localeID inDomain: aDomainName
+ 	"Answer the receiver translated to the given locale id in the textdomain. If no translation can be found, try to lookup all domains for a translation."
- 	"answer the receiver translated to the given locale id in the textdomain"
  
+ 	| translator translation |
+ 	translator := NaturalLanguageTranslator availableForLocaleID: localeID.
+ 	translation := translator translate: self inDomain: aDomainName.
+ 	translation == self ifTrue: [^ translator translateInAllDomains: self].
+ 	^ translation!
- 	^ NaturalLanguageTranslator translate: self 
- 								toLocaleID: localeID 
- 								inDomain:  aDomainName!



More information about the Squeak-dev mailing list