在没有递归或编译器技巧的情况下,在仅消息语言中是否有一种方法来定义whileTrue消息？

Question

Smalltalk具有whileTrue:-Message通过递归(在VisualWorks中)或通过编译器内联(在Squeak/Pharo中)实现.有没有办法在不使用其中一种方法的情况下定义这样的方法？如果没有,是否有可以在某处获得的证明？

Answer 1

我提出以下解决方案:

BlockContext>>myWhileTrue: aBlock 
    | start |
    start := thisContext pc.
    self value ifFalse: [ ^ self ].
    aBlock value.
    thisContext pc: start

上面的代码使用了对执行堆栈的反射,而不是使用递归和编译器技巧.在循环开始之前,该方法将当前程序计数器存储在临时变量中,并在结束时将其重置以跳回到方法的开头.在一些Smalltalk实现中,这种方法可能会很慢,因为一些Smalltalk方言仅仅根据需要重新启动堆栈,但在Pharo/Squeak中,这个技巧非常实用.

注意,上面的代码没有回答最后一个块激活的结果,因为#whileTrue:的原始实现.虽然应该很容易解决这个问题.

Answer 2

whileTrue: & whileFalse: 总是返回 nil。例如，如果有一个正常的递归定义：

whileTrue: aBlock
    ^self value ifTrue: [self whileTrue: aBlock]

如果 self 值为 false，则 ifTrue: 将返回 nil，因此该值应始终为 nil。这反映在编译器的优化中。原来的蓝皮书Smalltalk-80 V2定义是

whileTrue: aBlock
    "Evaluate the argument, aBlock, as long as the value
    of the receiver is true. Ordinarily compiled in-line.
    But could also be done in Smalltalk as follows"

    ^self value
        ifTrue:
            [aBlock value.
            self whileTrue: aBlock]

所以只需将你的更改为

BlockContext>>myWhileTrue: aBlock 
    | start |
    start := thisContext pc.
    self value ifFalse: [ ^ nil ].
    aBlock value.
    thisContext pc: start

或者？？

BlockContext>>myWhileTrue: aBlock 
    | start |
    start := thisContext pc.
    ^self value ifTrue:
        [aBlock value.
         thisContext pc: start]

但可惜的是，这两个方法都会在第二次迭代后的某个时候使虚拟机崩溃，因为 thisContext pc 不会在下一次迭代中应答 pc，而是无论堆栈顶部是什么:)

但是，以下方法确实有效：

ContextPart methods for controlling
label
    ^{ pc. stackp }

goto: aLabel
    "N.B. we *must* answer label so that the
     top of stack is aLabel as it is when we send label"
    pc := aLabel at: 1.
    self stackp: (aLabel at: 2).
    ^aLabel

BlockContext>>myWhileTrue: aBlock 
    | label |
    label := thisContext label.
    self value ifFalse: [^nil].
    aBlock value.
    thisContext goto: label

BlockClosure>>myWhileTrue: aBlock 
    | label |
    label := thisContext label.
    ^self value ifTrue:
        [aBlock value.
         thisContext goto: label]