[ANN] Closure CompilerAvi Bryant avi at beta4.comWed Feb 5 06:49:24 UTC 2003
Anthony, This is great work. Thank you. I very much hope this gets properly tested and evaluated for inclusion in the mainstream release. I personally especially appreciate that you made an effort to cleanly support continuations. I made some changes to your Continuation class - first, I added #currentDo: to the class side, which is the interface I currently use in Seaside: Continuation currentDo: [:k | ...] feels slightly more "Smalltalky" to me than [:k | ...] callCC does. More importantly, I've made sure that Continuation>>value and #value: properly terminate the current stack before jumping to the new one. This cleans up a number of small problems, particulary when dealing with BlockContexts. I've attached a fileOut that includes the modified Continuation class, an SUnit test case for Continuation, and an example of using continuations: the Amb class (you can find some background on Amb at http://mitpress.mit.edu/sicp/full-text/sicp/book/node89.html, and see the methods of AmbTest for example usage in Smalltalk). Cheers, Avi -------------- next part -------------- Object subclass: #Amb instanceVariableNames: 'failureContinuation ' classVariableNames: '' poolDictionaries: '' category: 'Backtracking'! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/13/2002 02:40'! allValues: aBlock |kPrev results| kPrev _ failureContinuation. results _ OrderedCollection new. (Continuation currentDo: [:kRetry | failureContinuation _ [:v | kRetry value: false]. results add: aBlock value. kRetry value: true]) ifTrue: [self fail]. failureContinuation _ kPrev. ^ results asArray ! ! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 02:11'! assert: aBoolean aBoolean ifFalse: [self fail]! ! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 02:12'! deny: aBoolean self assert: aBoolean not! ! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 02:15'! fail ^ failureContinuation value: nil! ! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 02:00'! initialize failureContinuation _ [self error: 'Amb tree exhausted'].! ! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 13:05'! maybe ^ self oneOf: {true. false}! ! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 02:09'! oneOf: aCollection ^ self valueOfOneOf: (aCollection collect: [:ea | [ea] fixTemps])! ! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 02:10'! valueOf: blockOne or: blockTwo ^ self valueOfOneOf: {blockOne. blockTwo}! ! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 02:10'! valueOf: blockOne or: blockTwo or: blockThree ^ self valueOfOneOf: {blockOne. blockTwo. blockThree}! ! !Amb methodsFor: 'as yet unclassified' stamp: 'ab 12/13/2002 02:39'! valueOfOneOf: blockCollection |kPrev| kPrev _ failureContinuation. ^ Continuation currentDo: [:kEntry | blockCollection do: [:ea | Continuation currentDo: [:kNext | failureContinuation _ [:v | failureContinuation _ kPrev. kNext value: v] fixTemps. kEntry value: ea value]]. kPrev value: nil] ! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Amb class instanceVariableNames: ''! !Amb class methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 01:59'! new ^ super new initialize! ! TestCase subclass: #AmbTest instanceVariableNames: 'amb ' classVariableNames: '' poolDictionaries: '' category: 'Backtracking'! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 12:20'! pickANumber ^ self pickANumberGreaterThan: 0! ! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 12:20'! pickANumberGreaterThan: aNumber ^ amb valueOf: [aNumber + 1] or: [self pickANumberGreaterThan: aNumber + 1]! ! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/13/2002 01:15'! setUp amb _ Amb new! ! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 02:43'! testAllValuesAboveFive |x results| results _ amb allValues: [x _ amb oneOf: (1 to: 10). amb assert: (x > 5). x]. self assert: results = #(6 7 8 9 10). ! ! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 13:33'! testMaybe |x y z| x _ amb maybe. y _ amb maybe. z _ amb maybe not. amb deny: x = y. amb deny: x = z. self assert: {x. y. z} = {true. false. false}. ! ! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 12:21'! testPickANumber self assert: self pickANumber = 1.! ! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 12:21'! testPickANumberAboveFive |x| x _ self pickANumber. amb assert: (x > 5). self assert: x = 6. ! ! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 13:16'! testSicpLogicProblem "Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors. Baker does not live on the top floor. Cooper does not live on the bottom floor. Fletcher does not live on either the top or the bottom floor. Miller lives on a higher floor than does Cooper. Smith does not live on a floor adjacent to Fletcher's. Fletcher does not live on a floor adjacent to Cooper's. Where does everyone live?" "This implementation is too slow - uncomment to actually run it." " |baker cooper fletcher miller smith| baker _ amb oneOf: (1 to: 5). cooper _ amb oneOf: (1 to: 5). fletcher _ amb oneOf: (1 to: 5). miller _ amb oneOf: (1 to: 5). smith _ amb oneOf: (1 to: 5). amb assert: {baker. cooper. fletcher. miller. smith} asSet size = 5. amb deny: baker = 5. amb deny: cooper = 1. amb deny: fletcher = 5. amb deny: fletcher = 1. amb assert: miller > cooper. amb deny: (smith - fletcher) abs = 1. amb deny: (fletcher - cooper) abs = 1. self assert: {baker. cooper. fletcher. miller. smith} = #(3 2 4 5 1)."! ! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 03:06'! testSicpLogicProblemFaster "Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors. Baker does not live on the top floor. Cooper does not live on the bottom floor. Fletcher does not live on either the top or the bottom floor. Miller lives on a higher floor than does Cooper. Smith does not live on a floor adjacent to Fletcher's. Fletcher does not live on a floor adjacent to Cooper's. Where does everyone live?" |baker cooper fletcher miller smith| fletcher _ amb oneOf: (1 to: 5). amb deny: fletcher = 5. amb deny: fletcher = 1. smith _ amb oneOf: (1 to: 5). amb deny: (smith - fletcher) abs = 1. cooper _ amb oneOf: (1 to: 5). amb deny: cooper = 1. amb deny: (fletcher - cooper) abs = 1. miller _ amb oneOf: (1 to: 5). amb assert: miller > cooper. baker _ amb oneOf: (1 to: 5). amb deny: baker = 5. amb assert: {baker. cooper. fletcher. miller. smith} asSet size = 5. self assert: {baker. cooper. fletcher. miller. smith} = #(3 2 4 5 1).! ! !AmbTest methodsFor: 'as yet unclassified' stamp: 'ab 12/6/2002 02:27'! testSolveAnEquation |x y| x _ amb oneOf: (1 to: 10). y _ amb oneOf: (1 to: 10). amb assert: (y * x) = 42. self assert: x = 6. self assert: y = 7. ! ! Object subclass: #Continuation instanceVariableNames: 'suspendedContext ' classVariableNames: '' poolDictionaries: '' category: 'Backtracking'! !Continuation commentStamp: 'ajh 1/27/2003 19:51' prior: 0! I contain a suspended context chain that gets copied and resumed upon evaluation (ala Scheme). The following example will execute 'hello' inspect twice, once after normal return and once after continuation evaluation (resumeValue value: nil): | resumeValue | resumeValue := [:continuation | continuation] callCC. 'hello' inspect. resumeValue ifNotNil: [ "resumeValue equals the continuation the first time. Now resume the continuation with a resume value of nil" resumeValue value: nil]. Thanks to Avi Bryant for explaining continuations and providing the above example. ! ]style[(131 15 73 22 344)f1,f1i,f1,f1i,f1! !Continuation methodsFor: 'as yet unclassified' stamp: 'ajh 1/27/2003 21:21'! longPrintOn: stream | ctxt | super printOn: stream. stream cr. ctxt _ self suspendedContext. [ctxt == nil] whileFalse: [ stream space. ctxt printOn: stream. stream cr. ctxt _ ctxt sender. ]. ! ! !Continuation methodsFor: 'as yet unclassified' stamp: 'ajh 1/27/2003 21:22'! suspendedContext ^ suspendedContext! ! !Continuation methodsFor: 'as yet unclassified' stamp: 'ajh 1/27/2003 19:01'! suspendedContext: aContext suspendedContext _ aContext! ! !Continuation methodsFor: 'as yet unclassified' stamp: 'ab 2/4/2003 22:33'! terminate: aContext |earliest| earliest _ aContext. [earliest sender notNil] whileTrue: [earliest _ earliest sender]. aContext terminateTo: earliest. ! ! !Continuation methodsFor: 'as yet unclassified' stamp: 'ab 2/4/2003 22:30'! value "Copy and resume my thread. Send this to results of 'Continuation current'" self terminate: thisContext sender. suspendedContext copyStack jump! ! !Continuation methodsFor: 'as yet unclassified' stamp: 'ab 2/4/2003 22:30'! value: resumeValue "Copy and resume my thread. Send this to results of #callCC. resumeValue will be the return value of callCC" self terminate: thisContext sender. suspendedContext copyStack push: resumeValue; jumpTop! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Continuation class instanceVariableNames: ''! !Continuation class methodsFor: 'as yet unclassified' stamp: 'ajh 1/27/2003 19:08'! current ^ thisContext sender asContinuation! ! !Continuation class methodsFor: 'as yet unclassified' stamp: 'ab 2/4/2003 22:27'! currentDo: aBlock ^ aBlock value: thisContext sender asContinuation! ! TestCase subclass: #ContinuationTest instanceVariableNames: 'tmp tmp2 ' classVariableNames: '' poolDictionaries: '' category: 'Backtracking'! !ContinuationTest methodsFor: 'as yet unclassified' stamp: 'ab 1/16/2003 15:54'! testBlockEscape |x| tmp _ 0. x _ [tmp _ tmp + 1. tmp2 value]. Continuation currentDo: [:cc | tmp2 _ cc. x value]. tmp2 _ []. x value. self assert: tmp = 2.! ! !ContinuationTest methodsFor: 'as yet unclassified' stamp: 'ab 12/13/2002 02:35'! testBlockTemps |y| #(1 2 3) do: [:i ||x| x _ i. tmp ifNil: [tmp2 _ (Continuation currentDo: [:cc | tmp _ cc. [:q]])]. tmp2 value: x. x _ 17]. y _ (Continuation currentDo: [:cc | tmp value: cc. 42]). self assert: y = 1.! ! !ContinuationTest methodsFor: 'as yet unclassified' stamp: 'ab 12/13/2002 02:36'! testBlockVars |continuation| tmp _ 0. tmp _ (Continuation currentDo: [:cc | continuation _ cc. 0]) + tmp. tmp2 ifNotNil: [tmp2 value] ifNil: [#(1 2 3) do: [:i | Continuation currentDo: [:cc | tmp2 _ cc. continuation value: i]]]. self assert: tmp = 6.! ! !ContinuationTest methodsFor: 'as yet unclassified' stamp: 'ab 12/13/2002 02:37'! testMethodTemps |i continuation| i _ 0. i _ i + (Continuation currentDo: [:cc | continuation _ cc. 1]). self assert: i ~= 3. i = 2 ifFalse: [continuation value: 2].! ! !ContinuationTest methodsFor: 'as yet unclassified' stamp: 'ab 12/13/2002 02:37'! testSimpleCallCC |x continuation| x _ Continuation currentDo: [:cc | continuation _ cc. false]. x ifFalse: [continuation value: true]. self assert: x.! ! !ContinuationTest methodsFor: 'as yet unclassified' stamp: 'ab 12/13/2002 02:37'! testSimplestCallCC |x| x _ Continuation currentDo: [:cc | cc value: true]. self assert: x.! !
More information about the Squeak-dev mailing list |