Simplify hasLiteralThorough: by dispatching literal checking on objects.

Rename hasLiteralThorough: to refersToLiteral:

src/Collections-Sequenceable/Array.class.st

@@ -298,6 +298,12 @@ Array >> printOn: aStream [
 	super printOn: aStream
 ]
 
+{ #category : #'literal testing' }
+Array >> refersToLiteral: literal [
+	^ (self literalEqual: literal) 
+		or: [ self hasLiteral: literal ]
+]
+
 { #category : #accessing }
 Array >> replaceFrom: start to: stop with: replacement startingAt: repStart [ 
 	"Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."

src/Kernel-Tests-Extended/BehaviorTest.extension.st

@@ -8,11 +8,11 @@ BehaviorTest >> testAllReferencesTo [
 	self assert: (result anySatisfy: [ :each | each actualClass = self class and: [ each selector = #testAllReferencesTo ] ]).
 
 	result := SystemNavigation new allReferencesTo: #printOn:.
-	result do: [ :each | self assert: (each compiledMethod hasLiteralThorough: #printOn:) ].
+	result do: [ :each | self assert: (each compiledMethod refersToLiteral: #printOn:) ].
 	self assert: (result anySatisfy: [ :each | each actualClass = self class and: [ each selector = #testAllReferencesTo ] ]).
 
 	result := SystemNavigation new allReferencesTo: #+.
-	result do: [ :each | self assert: ((each compiledMethod sendsSelector: #+) or: [ each compiledMethod hasLiteralThorough: #+ ]) ].
+	result do: [ :each | self assert: ((each compiledMethod sendsSelector: #+) or: [ each compiledMethod refersToLiteral: #+ ]) ].
 	self assert: (result anySatisfy: [ :each | each actualClass = self class and: [ each selector = #testAllReferencesTo ] ])
 ]
 

src/Kernel-Tests/CompiledCodeTest.class.st

@@ -25,88 +25,88 @@ CompiledCodeTest >> testLiteralsDoesNotContainMethodClass [
 	self
 		deny:
 			(self compiledMethod1
-				hasLiteralThorough: (self class environment associationAt: self class name asSymbol))
+				refersToLiteral: (self class environment associationAt: self class name asSymbol))
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testLiteralsDoesNotContainMethodName [
 
-	self deny: (self compiledMethod1 hasLiteralThorough: #method1)
+	self deny: (self compiledMethod1 refersToLiteral: #method1)
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsFalseWhenLiteralNotInMethodPropertiesKey [
 
 	[ self compiledMethod1 propertyAt: #Once put: true.
-	self deny: (self compiledMethod1 hasLiteralThorough: #Absent) ]
+	self deny: (self compiledMethod1 refersToLiteral: #Absent) ]
 		ensure: [ self compiledMethod1 removeProperty: #Once ]
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsArrayOfLiterals [
 
-	self assert: (self compiledMethod1 hasLiteralThorough: #(#add #at: #remove))
+	self assert: (self compiledMethod1 refersToLiteral: #(#add #at: #remove))
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsByteString [
 
-	self assert: (self compiledMethod1 hasLiteralThorough: 'Pharo loves tests')
+	self assert: (self compiledMethod1 refersToLiteral: 'Pharo loves tests')
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsByteSymbol [
 
-	self assert: (self compiledMethod1 hasLiteralThorough: #printOn:)
+	self assert: (self compiledMethod1 refersToLiteral: #printOn:)
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsContainedInArrayOfLitterals [
 
-	self assert: (self compiledMethod1 hasLiteralThorough: #add)
+	self assert: (self compiledMethod1 refersToLiteral: #add)
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsGlobalVariable [
 
 	self assert: (self compiledMethod1
-				hasLiteralThorough: (self class environment associationAt: #Array))
+				refersToLiteral: (self class environment associationAt: #Array))
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInMethodPropertiesKey [
 
 	[ self compiledMethod1 propertyAt: #Once put: true.
-	self assert: (self compiledMethod1 hasLiteralThorough: #Once) ]
+	self assert: (self compiledMethod1 refersToLiteral: #Once) ]
 		ensure: [ self compiledMethod1 removeProperty: #Once ]
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInMethodPropertiesValue [
 
 	[ self compiledMethod1 propertyAt: #Once put: '123'.
-	self assert: (self compiledMethod1 hasLiteralThorough: '123') ]
+	self assert: (self compiledMethod1 refersToLiteral: '123') ]
 		ensure: [ self compiledMethod1 removeProperty: #Once ]
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInMethodPropertiesValueArray [
 
 	[ self compiledMethod1 propertyAt: #Once put: #(1 2 3).
-	self assert: (self compiledMethod1 hasLiteralThorough: 1) ]
+	self assert: (self compiledMethod1 refersToLiteral: 1) ]
 		ensure: [ self compiledMethod1 removeProperty: #Once ]
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInPragmaArguments [
 
-	self assert: (self compiledMethod1 hasLiteralThorough: 'bar').
-	self assert: (self compiledMethod1 hasLiteralThorough: 123)
+	self assert: (self compiledMethod1 refersToLiteral: 'bar').
+	self assert: (self compiledMethod1 refersToLiteral: 123)
 ]
 
 { #category : #accessing }
 CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInPragmaSelector [
 
 	self assert: (self compiledMethod1
-				hasLiteralThorough: #pragma1:foo:)
+				refersToLiteral: #pragma1:foo:)
 ]

src/Kernel/AdditionalMethodState.class.st

@@ -188,20 +188,13 @@ AdditionalMethodState >> hasLiteralSuchThat: aBlock [
 ]
 
 { #category : #testing }
-AdditionalMethodState >> hasLiteralThorough: literal [
-	"Answer true if any literal in these properties is literal,
-	 even if embedded in array structure."
-	1 to: self basicSize do: [:i |
-		| propertyOrPragma "<Association|Pragma>" |
-		propertyOrPragma := self basicAt: i.
-		(propertyOrPragma isVariableBinding
-			ifTrue: [propertyOrPragma key == literal
-					or: [propertyOrPragma value == literal
-					or: [propertyOrPragma value isArray
-						and: [propertyOrPragma value hasLiteral: literal]]]]
-			ifFalse: [propertyOrPragma hasLiteral: literal]) ifTrue:
-			[^true]].
-	^false
+AdditionalMethodState >> hasLiteralThorough: aLiteral [
+	self 
+		deprecated: 'Use #refersToLiteral: instead.' 
+		on: '31 January 2020'
+		in: #Pharo9
+		transformWith: '`@receiver hasLiteralThorough: `@arg' -> '`@receiver refersToLiteral: `@arg'.
+	^ self refersToLiteral: aLiteral
 ]
 
 { #category : #testing }
@@ -367,6 +360,23 @@ AdditionalMethodState >> propertyValueAt: aKey ifAbsent: aBlock [
 	^self propertyAt: aKey ifAbsent: aBlock
 ]
 
+{ #category : #testing }
+AdditionalMethodState >> refersToLiteral: literal [
+	"Answer true if any literal in these properties is literal,
+	 even if embedded in array structure."
+	1 to: self basicSize do: [:i |
+		| propertyOrPragma "<Association|Pragma>" |
+		propertyOrPragma := self basicAt: i.
+		(propertyOrPragma isVariableBinding
+			ifTrue: [propertyOrPragma key == literal
+					or: [propertyOrPragma value == literal
+					or: [propertyOrPragma value isArray
+						and: [propertyOrPragma value hasLiteral: literal]]]]
+			ifFalse: [propertyOrPragma hasLiteral: literal]) ifTrue:
+			[^true]].
+	^false
+]
+
 { #category : #properties }
 AdditionalMethodState >> removeKey: aKey [
 	"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."

src/Kernel/CompiledCode.class.st

@@ -80,7 +80,7 @@ CompiledCode >> accessesSlot: aSlot [
 { #category : #literals }
 CompiledCode >> additionalMethodStateRefersToLitteral: literal [
 	^ self penultimateLiteral isMethodProperties
-		and: [ self penultimateLiteral hasLiteralThorough: literal ]
+		and: [ self penultimateLiteral refersToLiteral: literal ]
 ]
 
 { #category : #literals }
@@ -247,20 +247,13 @@ CompiledCode >> hasLiteralSuchThat: litBlock [
 ]
 
 { #category : #literals }
-CompiledCode >> hasLiteralThorough: literal [
-	"Answer true if any literal in this method is literal,
-	even if embedded in array structure."
-
-	(self additionalMethodStateRefersToLitteral: literal)
-		ifTrue: [ ^ true ].
-
-	2 to: self numLiterals - 1 "exclude header and methodClass or outerCode"
-	   do:[:index | | lit |
-		(((lit := self objectAt: index) literalEqual: literal)
-		 or: [lit isArray and: [lit hasLiteral: literal]]) ifTrue:
-			[^ true].
-		(lit isMemberOf: CompiledBlock) ifTrue: [ (lit hasLiteralThorough: literal) ifTrue: [ ^true ] ] ].
-	^ false 
+CompiledCode >> hasLiteralThorough: aLiteral [
+	self 
+		deprecated: 'Use #refersToLiteral: instead.' 
+		on: '31 January 2020'
+		in: #Pharo9
+		transformWith: '`@receiver hasLiteralThorough: `@arg' -> '`@receiver refersToLiteral: `@arg'.
+	^ self refersToLiteral: aLiteral
 ]
 
 { #category : #accessing }
@@ -280,7 +273,7 @@ CompiledCode >> hasSelector: selector specialSelectorIndex: specialOrNil [
 	 If you don't know what's a special selector, use #hasSelector:.
 	 If you do, you may call this method directly to avoid recomputing 
 	 the special selector index all the time."
-	 (self hasLiteralThorough: selector) ifTrue: [ ^ true ].
+	 (self refersToLiteral: selector) ifTrue: [ ^ true ].
 	^ specialOrNil 
 		ifNil: [ false ] 
 		ifNotNil: [ self scanFor: self encoderClass firstSpecialSelectorByte + specialOrNil ]
@@ -688,12 +681,20 @@ CompiledCode >> referredInstVars [
 ]
 
 { #category : #literals }
-CompiledCode >> refersToLiteral: aLiteral [ 
-	"Answer true if any literal in this method is literal, even if embedded in array structure or within its pragmas."
-	"only iterate to numLiterals - 1, as the last has the classBinding and the last-but-one needs special treatment"
-	
-	"to deprecate: use hasLiteralThorough:"
-	^ self hasLiteralThorough: aLiteral.
+CompiledCode >> refersToLiteral: aLiteral [
+	"Answer true if any literal in this method is literal,
+	even if embedded in array structure."
+
+	(self additionalMethodStateRefersToLitteral: aLiteral)
+		ifTrue: [ ^ true ].
+
+	"exclude selector or additional method state (penultimate slot) 
+	and methodClass or outerCode (last slot)"
+	1 to: self numLiterals - 2 do: [ :index | 
+		((self literalAt: index) refersToLiteral: aLiteral)
+			ifTrue: [ ^ true ] ].
+
+	^ false
 ]
 
 { #category : #comparing }

src/Kernel/Object.class.st

@@ -1690,6 +1690,11 @@ Object >> readSlotNamed: aName [
 	^(self class slotNamed: aName) read: self
 ]
 
+{ #category : #testing }
+Object >> refersToLiteral: aLitteral [
+	^ self literalEqual: aLitteral
+]
+
 { #category : #dependencies }
 Object >> release [
 	"Remove references to objects that may refer to the receiver. This message