The Inbox: Kernel-ct.1365.mcz

A new version of Kernel was added to project The Inbox:
http://source.squeak.org/inbox/Kernel-ct.1365.mcz

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

Name: Kernel-ct.1365
Author: ct
Time: 13 November 2020, 7:32:09.051415 pm
UUID: 9ff3b9b1-5fda-434e-907b-f6c7f1875070
Ancestors: Kernel-eem.1361

Introduces and revises BlockClosure >> #generateExpressionWithArguments:, formerly available on InspectorField class. For usage examples, see the tests. :-)

=============== Diff against Kernel-eem.1361 ===============

Item was added:
+ ----- Method: BlockClosure>>generateExpression (in category 'printing') -----
+ generateExpression
+
+ ^ self generateExpressionWithArguments: #()!

Item was added:
+ ----- Method: BlockClosure>>generateExpressionWithArguments: (in category 'printing') -----
+ generateExpressionWithArguments: argumentNames
+ "Answer a valid Smalltalk expression string that is equivalent to the receiver but does not depend on it's context and environment. To do so, all non-global referenced are hard-coded into the expression if they are literals; otherwise, an error is signaled."
+
+ | blockNode arguments variables expression recompiled |
+ self flag: #experimental.
+ self assert: argumentNames size >= self numArgs description:
+ ['This block accepts <1p> arguments but only <2p> names were given'
+ expandMacrosWith: self numArgs
+ with: argumentNames size].
+
+ blockNode := self decompile veryDeepCopy. "some literals are singletons, see #becomeForward: below"
+ arguments := blockNode arguments collect: #name.
+
+ "Collect local and constant variables for substitution"
+ variables := Dictionary new.
+ variables
+ at: #true put: true;
+ at: #false put: false;
+ at: #nil put: nil.
+ self receiver class allInstVarNames
+ withIndexDo: [:name :index |
+ variables at: name put: (self receiver instVarAt: index)].
+ self outerContext tempNames
+ withIndexDo: [:name :index |
+ variables at: name put: (self outerContext namedTempAt: index)].
+
+ "Substitute local variables and argument names"
+ blockNode nodesDo: [:node |
+ self flag: #ct. "Should we introduce #nodesCollect: instead of using dangerous #becomeForward:?"
+ {
+ [node isVariableNode not
+ or: [self receiver environment includesKey: node name]].
+ [| argumentIndex |
+ argumentIndex := arguments indexOf: node name.
+ argumentIndex isZero
+ ifFalse: [node name: (argumentNames at: argumentIndex)];
+ not].
+ [variables at: node name
+ ifPresent: [:value |
+ value isLiteral
+ ifTrue: [node becomeForward: (LiteralNode new key: value)];
+ yourself]
+ ifAbsent: [false]].
+ [node isTemp].
+ } detect: #value ifNone: [self error: 'Unknown block node, cannot generate expression']].
+
+ "Generate modified expression tree"
+ expression := String streamContents: [:stream |
+ blockNode
+ printTemporaries: blockNode temporaries
+ on: stream
+ doPrior: [].
+ (blockNode temporaries notEmpty
+ and: [blockNode statements size > 1])
+ ifTrue: [stream cr].
+ blockNode
+ printStatementsOn: stream
+ indent: 0].
+
+ "Recompile it to be sure there are no syntax errors or unavailable variables."
+ recompiled := Compiler new
+ compileNoPattern: ('[{1}{2}]' format: {
+ argumentNames ifEmpty: [''] ifNotEmpty: [
+ ((argumentNames collect: [:name | ':' , name]) joinSeparatedBy: ' ') , '|'].
+ expression})
+ in: nil class notifying: nil ifFail: nil.
+ recompiled nodesDo: [:node |
+ self assert: (node isKindOf: LiteralVariableNode) ==> [self class environment includesKey: node name asSymbol]].
+
+ "Et voilà!!"
+ ^ expression!