Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-eem.1154.mcz
==================== Summary ====================
Name: Kernel-eem.1154 Author: eem Time: 27 February 2018, 10:50:39.300209 am UUID: f403de94-416e-4740-a83c-7b74e1d00810 Ancestors: Kernel-ul.1153
Fix CompiledCode>>allLiterals for the FullBlockClosure regime. Have CompiledBlock implement allSubLiterals for literals within a block and blocks nested within it.
Have CompiledMethod>>hasLiteralSuchThat: recurse through compiled blocks to match its descent into arrays and method properties.
Provide CompiledMethod>>scanForInstructionPattern: as a convenient wrapper for scanForInstructionSequence:
=============== Diff against Kernel-ul.1153 ===============
Item was added: + ----- Method: CompiledBlock>>allLiterals (in category 'literals') ----- + allLiterals + ^self homeMethod allLiterals!
Item was added: + ----- Method: CompiledBlock>>allSubLiterals (in category 'literals') ----- + allSubLiterals + | 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 added: + ----- Method: CompiledBlock>>hasLiteralSuchThat: (in category 'literals') ----- + hasLiteralSuchThat: litBlock + "Answer true if litBlock returns true for any literal in this method, even if embedded in array structure." + 2 to: self numLiterals do: + [:index | | lit | + lit := self objectAt: index. + ((litBlock value: lit) + or: [(lit isArray or: [lit isCompiledBlock]) and: [lit hasLiteralSuchThat: litBlock]]) ifTrue: + [^true]]. + ^false!
Item was added: + ----- Method: CompiledCode>>allLiterals (in category 'literals') ----- + allLiterals + self subclassResponsibility!
Item was added: + ----- Method: CompiledCode>>literals (in category 'literals') ----- + literals + "Answer an Array of the literals referenced by the receiver." + | literals numberLiterals | + literals := Array new: (numberLiterals := self numLiterals). + 1 to: numberLiterals do: + [:index | + literals at: index put: (self objectAt: index + 1)]. + ^literals!
Item was changed: ----- Method: CompiledMethod>>allLiterals (in category 'literals') ----- allLiterals + | literals unfoldedSubLiterals | + literals := self literals. + unfoldedSubLiterals := literals + select: [:lit| lit isCompiledCode] + thenCollect: [:blockMethod| blockMethod allSubLiterals]. + unfoldedSubLiterals ifEmpty: + [^literals]. + ^literals, (unfoldedSubLiterals fold: [:a :b| a, b])! - ^self literals!
Item was changed: ----- Method: CompiledMethod>>hasLiteralSuchThat: (in category 'literals') ----- hasLiteralSuchThat: litBlock "Answer true if litBlock returns true for any literal in this method, even if embedded in array structure." (self penultimateLiteral isMethodProperties and: [self penultimateLiteral hasLiteralSuchThat: litBlock]) ifTrue: [^true]. 2 to: self numLiterals + 1 do: [:index | | lit | lit := self objectAt: index. ((litBlock value: lit) + or: [(lit isArray or: [lit isCompiledBlock]) and: [lit hasLiteralSuchThat: litBlock]]) ifTrue: - or: [lit isArray and: [lit hasLiteralSuchThat: litBlock]]) ifTrue: [^true]]. ^false!
Item was removed: - ----- Method: CompiledMethod>>literals (in category 'literals') ----- - literals - "Answer an Array of the literals referenced by the receiver." - | literals numberLiterals | - literals := Array new: (numberLiterals := self numLiterals). - 1 to: numberLiterals do: - [:index | - literals at: index put: (self objectAt: index + 1)]. - ^literals!
Item was added: + ----- Method: CompiledMethod>>scanForInstructionPattern: (in category 'scanning') ----- + scanForInstructionPattern: tuple + "Convenient use of scanForInstructionSequence: + e.g. self systemNavigation browseAllSelect: [:m| m scanForInstructionPattern: #((pushConstant: true) (send:super:numArgs: spilled: false 1))] + self systemNavigation browseAllSelect: [:m| m scanForInstructionPattern: #((send:super:numArgs: arguments false 0) (send:super:numArgs: = false 1))]" + | first firstArgs second secondArgs third thirdArgs | + ^(InstructionStream on: self) scanForInstructionSequence: + (tuple size caseOf: { + [1] -> [first := tuple first. + firstArgs := first allButFirst. + first := first first. + [:a| + a selector == first and: [a arguments = firstArgs]]]. + [2] -> [first := tuple first. + firstArgs := first allButFirst. + second := tuple second. + secondArgs := second allButFirst. + first := first first. + second := second first. + [:a :b| + a selector == first and: [a arguments = firstArgs + and: [b selector == second and: [b arguments = secondArgs]]]]]. + [3] -> [first := tuple first. + firstArgs := first allButFirst. + second := tuple second. + secondArgs := second allButFirst. + third := tuple third. + thirdArgs := third allButFirst. + first := first first. + second := second first. + third := third first. + [:a :b :c| + a selector == first and: [a arguments = firstArgs + and: [b selector == second and: [b arguments = secondArgs + and: [c selector == third and: [c arguments = thirdArgs]]]]]]] })!