[squeak-dev] The Trunk: 60Deprecated-mt.40.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jul 12 08:05:16 UTC 2019


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

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

Name: 60Deprecated-mt.40
Author: mt
Time: 12 July 2019, 10:05:15.833568 am
UUID: 26bbfaf7-4982-c34d-a02b-4dbfe0dcc607
Ancestors: 60Deprecated-mt.39

Refactoring of #literalsDo: - Step 3 of 3. 

For more information, see http://forum.world.st/Please-Review-Refactoring-for-literalsDo-etc-tp5099756p5100896.html.

=============== Diff against 60Deprecated-mt.39 ===============

Item was added:
+ ----- Method: AdditionalMethodState>>hasLiteralThorough: (in category '*60Deprecated-literals') -----
+ hasLiteralThorough: literal
+ 
+ 	self deprecated: 'Use #hasLiteral: instead. It is always thorough.'.
+ 	^ self hasLiteral: literal!

Item was changed:
  ----- Method: Behavior>>whichSelectorsReferTo:special:byte:thorough: (in category '*60Deprecated-testing method dictionary') -----
  whichSelectorsReferTo: literal special: specialFlag byte: specialByte thorough: thorough
- 	"Answer a set of selectors whose methods access the argument as a literal. If thorough is true, then dives into the compact literal notation, making it slow but thorough "
  
+ 	self deprecated: 'Use #whichSelectorsReferTo: instead'.
+ 	^ self whichSelectorsReferTo: literal!
- 	| who |
- 	self deprecated: 'Use whichSelectorsReferTo:thorough: instead'.
- 	who := IdentitySet new.
- 	self selectorsAndMethodsDo: [ :selector :method |
- 		(((thorough
- 			ifFalse: [ method hasLiteral: literal ]
- 			ifTrue: [ method hasLiteralThorough: literal ]) or: [
- 				specialFlag and: [ method scanFor: specialByte ] ]) and: [
- 			literal isVariableBinding not or: [
- 				"N.B. (method indexOfLiteral: literal) < method numLiterals copes with l;ooking for
- 				Float bindingOf: #NaN, since (Float bindingOf: #NaN) ~= (Float bindingOf: #NaN)."
- 				(method indexOfLiteral: literal) ~= 0] ]) ifTrue: [
- 			who add: selector ] ].
- 	^who!

Item was added:
+ ----- Method: Behavior>>whichSelectorsReferTo:thorough: (in category '*60Deprecated-testing method dictionary') -----
+ whichSelectorsReferTo: aLiteral thorough: thorough
+ 
+ 	self deprecated: 'Literal test is thorough by default. Use #whichSelectorsReferTo: instead.'.
+ 	^ self whichSelectorsReferTo: aLiteral!

Item was changed:
  ----- Method: CompiledBlock>>allSubLiterals (in category '*60Deprecated-literals') -----
  allSubLiterals
+ 
+ 	self deprecated: 'Use #allLiterals.'.
+ 	^ self allLiterals!
- 	| literalsExceptOuter unfoldedSubLiterals |
- 	literalsExceptOuter := self literals allButLast.
- 	unfoldedSubLiterals := literalsExceptOuter
- 								select: [:lit| lit isCompiledCode]
- 								thenCollect: [:blockMethod| blockMethod allSubLiterals].
- 	unfoldedSubLiterals ifEmpty:
- 		[^literalsExceptOuter].
- 	^literalsExceptOuter, (unfoldedSubLiterals fold: [:a :b| a, b])!

Item was changed:
  ----- Method: CompiledCode>>messagesDo:encoderClass:visitedSet: (in category '*60Deprecated-private') -----
  messagesDo: aBlock encoderClass: encoderClass visitedSet: visitedSet
- 	"The inner engine for messagesDo:"
  
+ 	self deprecated: 'Use #messagesDo:.'.
+ 	self messagesDo: aBlock.!
- 	| scanner |
- 	scanner := InstructionStream on: self.
- 	scanner scanFor: [ :x | 
- 		| selector |
- 		(selector := encoderClass selectorToSendOrItselfFor: scanner in: self at: scanner pc) == scanner
- 			ifFalse:
- 				[(visitedSet ifAbsentAdd: selector) ifTrue:
- 					[aBlock value: selector]]
- 			ifTrue:
- 				[(encoderClass blockMethodOrNilFor: scanner in: self at: scanner pc) ifNotNil:
- 					[:blockMethod|
- 					 blockMethod messagesDo: aBlock encoderClass: encoderClass visitedSet: visitedSet]].
- 		false "keep scanning" ]!

Item was changed:
  ----- Method: CompiledCode>>refersTo:bytecodeScanner:thorough: (in category '*60Deprecated-literals') -----
  refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough
+ 
+ 	self deprecated: 'Use #hasLiteral:.'.
+ 	^ self hasLiteral: literal!
- 	"Answer if the receiver refers to the literal.  If the scan block is non-nil, then
- 	 use it to find the literal in bytecode.  If thorough is true, dive down into
- 	 literal arrays and method properties to locate references to the literal there-in."
- 	2 to: (self isCompiledBlock
- 			ifTrue: [self numLiterals] "exclude outerCode or methodClass"
- 			ifFalse: [self numLiterals - 1]) "exclude selector/properties and methodClass"
- 	   do: [:i| | lit |
- 		lit := self objectAt: i.
- 		(literal == lit or: [literal literalEqual: lit]) ifTrue: [^true]. "== for Float bindingOf: #NaN since NaN ~= NaN"
- 		lit isCompiledCode
- 			ifTrue:
- 				[(lit refersTo: literal bytecodeScanner: scanBlockOrNil thorough: thorough) ifTrue:
- 					[^true]]
- 			ifFalse:
- 				[thorough ifTrue:
- 					[lit isVariableBinding
- 						ifTrue:
- 							[literal == lit key ifTrue: [^true]]
- 						ifFalse:
- 							[(lit isArray
- 							   and: [(lit hasLiteral: literal)
- 								or: [literal isVariableBinding
- 									and: [literal key isSymbol
- 									and: [lit hasLiteral: literal key]]]]) ifTrue:
- 								[^true]]]]].
- 	scanBlockOrNil ifNotNil:
- 		[(self scanFor: scanBlockOrNil) ifTrue:
- 			[^true]].
- 	^false!

Item was changed:
  ----- Method: CompiledCode>>refersTo:primaryBytecodeScanner:secondaryBytecodeScanner:thorough: (in category '*60Deprecated-literals') -----
  refersTo: literal primaryBytecodeScanner: primaryScanBlockOrNil secondaryBytecodeScanner: secondaryScanBlockOrNil thorough: thorough
+ 	
+ 	self deprecated: 'Use #hasLiteral:.'.
+ 	^ self hasLiteral: literal!
- 	"Answer if the receiver refers to the literal.  If the scan blocks are non-nil, then
- 	 use them to find the literal in bytecode.  If thorough is true, dive down into
- 	 literal arrays and method properties to locate references to the literal there-in."
- 	^self
- 		refersTo: literal
- 		bytecodeScanner: (self signFlag
- 							ifTrue: [secondaryScanBlockOrNil]
- 							ifFalse: [primaryScanBlockOrNil])
- 		thorough: thorough!

Item was changed:
  ----- Method: CompiledMethod>>hasLiteralThorough: (in category '*60Deprecated-literals') -----
  hasLiteralThorough: literal
- 	"Answer true if any literal in this method is literal,
- 	even if embedded in array structure."
  
+ 	self deprecated: 'Use #hasLiteral: instead. It is always thorough.'.
+ 	^ self hasLiteral: literal!
- 	(self penultimateLiteral isMethodProperties
- 	 and: [self penultimateLiteral hasLiteralThorough: literal]) ifTrue:[^true].
- 	2 to: self numLiterals - 1 "exclude superclass + selector/properties"
- 	   do:[:index | | lit |
- 		(((lit := self objectAt: index) literalEqual: literal)
- 		 or: [(lit isVariableBinding and: [lit key == literal])
- 		 or: [lit isArray and: [lit hasLiteral: literal]]]) ifTrue:
- 			[^ true]].
- 	^ false !

Item was changed:
  ----- Method: CompiledMethod>>refersToLiteral: (in category '*60Deprecated-literals') -----
  refersToLiteral:aLiteral
  
+ 	self deprecated: 'Use #hasLiteral: instead.'.
+ 	^self hasLiteral: aLiteral!
- 	^self hasLiteral: aLiteral.!

Item was added:
+ ----- Method: SystemNavigation class>>thoroughSenders (in category '*60Deprecated-preferences') -----
+ thoroughSenders
+ 
+ 	self deprecated: 'Senders browsing is always thorough. See #allLiterals vs. #literals.'.
+ 	^ true!

Item was added:
+ ----- Method: SystemNavigation class>>thoroughSenders: (in category '*60Deprecated-preferences') -----
+ thoroughSenders: aBoolean
+ 	
+ 	self deprecated: 'Senders browsing is always thorough. See #allLiterals vs. #literals.'.!



More information about the Squeak-dev mailing list