SystemOrganization addCategory: #'Continuations-Core'! SystemOrganization addCategory: #'Continuations-Marker'! SystemOrganization addCategory: #'Continuations-Tests'! SystemOrganization addCategory: #'Continuations-Operators'! Notification subclass: #CCPromptMarker instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Marker'! Notification subclass: #CCResetMarker instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Marker'! Notification subclass: #FMarker instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! !ContextPart methodsFor: '*continuations' stamp: 'lr 4/12/2007 13:33'! sender: aContext sender := aContext! ! Object subclass: #CCContinuation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Core'! !CCContinuation methodsFor: 'accessing' stamp: 'lr 4/12/2007 12:06'! numArgs ^ 1! ! !CCContinuation methodsFor: 'evaluating' stamp: 'lr 4/12/2007 12:06'! value ^ self value: nil! ! !CCContinuation methodsFor: 'evaluating' stamp: 'lr 4/12/2007 12:06'! value: anObject self subclassResponsibility! ! CCContinuation subclass: #CCFullContinuation instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Core'! CCContinuation subclass: #CCPartialContinuation instanceVariableNames: 'stack' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Core'! !CCPartialContinuation commentStamp: 'lr 4/10/2007 22:55' prior: 0! A partical continuation is a "continuation slice" which may be viewed as the "difference" of two regular continuations. It is thus identified by two points in the stack: the place where the partical continuation starts and the point where the partical continuation finishes. A partical continuation can be used as a regular function. Unlike continuations, partical continuations return a value and therefor can be composed.! !CCPartialContinuation class methodsFor: 'instance-creation' stamp: 'lr 4/11/2007 15:34'! from: aStartContext to: anEndContext ^ self basicNew from: aStartContext to: anEndContext! ! !CCPartialContinuation class methodsFor: 'errors' stamp: 'lr 4/12/2007 15:42'! markerNotFound: aString ^ CCMarkerNotFound signal: aString! ! !CCPartialContinuation methodsFor: 'accessing' stamp: 'lr 4/12/2007 15:27'! frames ^ stack stack! ! !CCPartialContinuation methodsFor: 'initialization' stamp: 'lr 4/14/2007 20:03'! from: aStartContext to: aStopContext "Create a snapshot of the stack from aStartContext up and including a StopContext." stack := aStartContext copyTo: aStopContext sender! ! !CCPartialContinuation methodsFor: 'accessing' stamp: 'lr 4/12/2007 12:33'! stack ^ stack! ! !CCPartialContinuation methodsFor: 'evaluating' stamp: 'lr 4/12/2007 15:30'! value: anObject | current | current := stack copyStack . current bottomContext sender: thisContext sender. thisContext sender: current. ^ anObject! ! CCPartialContinuation subclass: #CCPromptControlOperator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Core'! !CCPromptControlOperator class methodsFor: 'instance-creation' stamp: 'lr 4/12/2007 18:58'! control: aBlock "The control operator reifies the context up to the nearest dynamically enclosing prompt. The captured continuation does not include the prompt delimiter." | marker continuation | aBlock fixTemps. marker := CCPromptMarker signal ifNil: [ self markerNotFound: 'No enclosing prompt found.' ]. continuation := self from: thisContext sender to: marker. thisContext sender terminateTo: marker. ^ aBlock value: continuation! ! !CCPromptControlOperator class methodsFor: 'instance-creation' stamp: 'lr 4/12/2007 19:05'! prompt: aBlock "The prompt operator identifies a context to be used by control." | marker | ^ [ marker := thisContext. aBlock value ] on: CCPromptMarker do: [ :n | n resume: marker ]! ! CCPartialContinuation subclass: #CCResetShiftOperator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Core'! !CCResetShiftOperator class methodsFor: 'instance-creation' stamp: 'lr 4/12/2007 19:04'! reset: aBlock "The reset operator identifies a context to be used by shift." | marker | marker := thisContext. ^ aBlock on: CCResetMarker do: [ :n | n resume: marker ]! ! !CCResetShiftOperator class methodsFor: 'instance-creation' stamp: 'lr 4/12/2007 19:05'! shift: aBlock "The control operator reifies the context up to the nearest dynamically enclosing reset. The captured continuation includes the prompt delimiter." | marker continuation | aBlock fixTemps. marker := CCResetMarker signal ifNil: [ self markerNotFound: 'No enclosing reset found.' ]. continuation := self from: thisContext sender to: marker. thisContext sender terminateTo: marker. ^ aBlock value: continuation! ! CCPartialContinuation subclass: #FOperator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! FOperator subclass: #FControl instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! !FControl class methodsFor: 'testing' stamp: 'lr 4/14/2007 20:52'! isDelimited ^ true! ! !FControl class methodsFor: 'testing' stamp: 'lr 4/14/2007 20:52'! isShifted ^ false! ! FOperator subclass: #FControl0 instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! !FControl0 class methodsFor: 'testing' stamp: 'lr 4/14/2007 00:46'! isDelimited ^ false! ! !FControl0 class methodsFor: 'testing' stamp: 'lr 4/14/2007 00:46'! isShifted ^ false! ! !FOperator class methodsFor: 'public' stamp: 'lr 4/14/2007 21:07'! abort: anObject | marker | marker := FMarker signal ifNil: [ FMarkerNotFound signal: 'Marker not found.' ]. thisContext sender: marker. ^ anObject! ! !FOperator class methodsFor: 'testing' stamp: 'lr 4/14/2007 20:55'! isDelimited ^ self subclassResponsibility! ! !FOperator class methodsFor: 'testing' stamp: 'lr 4/14/2007 00:45'! isShifted ^ self subclassResponsibility! ! !FOperator class methodsFor: 'public' stamp: 'lr 4/14/2007 21:15'! mark: aBlock | context | ^ [ context := thisContext. aBlock value ] on: FMarker do: [ :n | n resume: context ]! ! !FOperator class methodsFor: 'public' stamp: 'lr 4/14/2007 21:14'! reify: aBlock | marker continuation | marker := FMarker signal ifNil: [ FMarkerNotFound signal: 'Marker not found.' ]. continuation := self from: thisContext sender to: (self isDelimited ifTrue: [ marker sender ] ifFalse: [ marker ]). thisContext sender: (self isShifted ifTrue: [ marker sender ] ifFalse: [ marker ]). ^ aBlock value: continuation! ! FOperator subclass: #FShift instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! !FShift class methodsFor: 'testing' stamp: 'lr 4/14/2007 00:46'! isDelimited ^ true! ! !FShift class methodsFor: 'testing' stamp: 'lr 4/14/2007 00:46'! isShifted ^ true! ! FOperator subclass: #FShift0 instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! !FShift0 class methodsFor: 'testing' stamp: 'lr 4/14/2007 20:53'! isDelimited ^ false! ! !FShift0 class methodsFor: 'testing' stamp: 'lr 4/14/2007 20:53'! isShifted ^ true! ! TestCase subclass: #CCPromptControlTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Tests'! !CCPromptControlTest methodsFor: 'utilities' stamp: 'lr 4/14/2007 01:05'! control: aBlock ^ FControl do: aBlock! ! !CCPromptControlTest methodsFor: 'utilities' stamp: 'lr 4/14/2007 01:05'! prompt: aBlock ^ FControl mark: aBlock! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 15:46'! test001 | x | self assert: (self prompt: [ x := self control: [ :f | 'a' , (f value: '') ]. self control: [ :g | x ] ]) = ''! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 15:50'! test002 self assert: (self prompt: [ [ :x | self control: [ :f | 2 ] ] value: (self control: [ :g | 1 + (g value: 0)]) ]) = 2! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 15:51'! test003 self assert: (self prompt: [ self control: [ :f | 'a' , (f value: '') ] ]) = 'a'! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 15:53'! test004 | x | self assert: (self prompt: [ x := self control: [ :f | 'a' , (f value: '') ]. self control: [ :g | g value: x ] ]) = 'a'! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 12:10'! testPromptControl3 "Chung-chieh Shan: Shift to Control, 2004 Scheme Workshop" self assert: ('x' , (self prompt: [ (self control: [ :f1 | 'z' , (f1 value: 'y') ]) , (self control: [ :f2 | '' ])] )) = 'x'! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 15:40'! testPromptControl4 "Chung-chieh Shan: Shift to Control, 2004 Scheme Workshop" | stream | stream := LimitedWriteStream on: String new. stream setLimit: 50 limitBlock: [ ^ self assert: stream contents = '13234234423444234444234444423444444234444444234444' ]. self prompt: [ stream print: (self control: [ :f | f value: 1. f value: 2 ]). stream print: (self control: [ :g | g value: 3. g value: 4 ]) ]! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 12:10'! testPromptControlA self assert: (self prompt: [ 2 * (self control: [ :f | 3 ]) ]) = 3! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 12:10'! testPromptControlB self assert: (self prompt: [ 2 * (self control: [ :f | 5 * (f value: 3) ]) ]) = 30! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 12:10'! testPromptControlC self assert: (self prompt: [ 2 * (self control: [ :f | (f value: (f value: 3)) ]) ]) = 12! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 12:10'! testPromptControlD self assert: ((self prompt: [ 2 * (self control: [ :f | f ]) ]) value: 3) = 6! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 18:58'! testPromptControlE self assert: (self prompt: [ 5 * (self prompt: [ 2 * (self control: [ :f2 | "f2: [ :x | 2 * x ]" self assert: (f2 value: 2) = 4. self assert: (f2 value: 3) = 6. 3 * (self control: [ :f3 | "f3: [ :x | 3 * x ]" self assert: (f3 value: 2) = 6. self assert: (f3 value: 3) = 9. 7 ]) ]) ]) ]) = 35! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 18:50'! testPromptControlF self assert: (self prompt: [ 5 * (self prompt: [ 2 * (self control: [ :f2 | self assert: (f2 value: 2) = 4. self assert: (f2 value: 3) = 6. [ 3 * (self control: [ :f3 | self assert: (f3 value: 2) = 30. self assert: (f3 value: 3) = 45. 7 ]) ] ]) ]) value ]) = 7! ! !CCPromptControlTest methodsFor: 'testing' stamp: 'lr 4/12/2007 12:10'! testPromptControlG self assert: (self prompt: [ 5 * ([ :x | self control: [ :f1 | x ] ] value: (3 * (self control: [ :f2 | 2 * (f2 value: 7) ]) )) ]) = 21! ! TestCase subclass: #CCResetShiftTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Tests'! !CCResetShiftTest methodsFor: 'utilities' stamp: 'lr 4/14/2007 01:05'! reset: aBlock ^ FShift mark: aBlock! ! !CCResetShiftTest methodsFor: 'utilities' stamp: 'lr 4/14/2007 01:05'! shift: aBlock ^ FShift do: aBlock! ! !CCResetShiftTest methodsFor: 'testing-operational' stamp: 'lr 4/12/2007 12:20'! test001 "Chung-chieh Shan: Shift to Control, 2004 Scheme Workshop" "Reset itself doesn't do much." self assert: ('x' , (self reset: [ 'y' ])) = 'xy'! ! !CCResetShiftTest methodsFor: 'testing-operational' stamp: 'lr 4/12/2007 12:30'! test002 "Chung-chieh Shan: Shift to Control, 2004 Scheme Workshop" "Shift captures the surrounding context up to the nearest reset." self assert: ('x' , (self reset: [ (self shift: [ :c | 'z' , (c value: 'y') ]) , '' ])) = 'xzy' ! ! !CCResetShiftTest methodsFor: 'testing-operational' stamp: 'lr 4/12/2007 18:22'! test003 "Chung-chieh Shan: Shift to Control, 2004 Scheme Workshop" "The fine print matters when the captured context itself contains shift." self assert: ('x' , (self reset: [ (self shift: [ :c | 'z' , (c value: 'y') ]) , (self shift: [ :d | '' ]) ])) = 'xz'! ! !CCResetShiftTest methodsFor: 'testing-operational' stamp: 'lr 4/12/2007 15:47'! test004 | x | self assert: (self reset: [ x := self shift: [ :f | 'a' , (f value: '') ]. self shift: [ :g | x ] ]) = 'a'! ! !CCResetShiftTest methodsFor: 'testing' stamp: 'lr 4/11/2007 18:30'! testResetShift4 "Chung-chieh Shan: Shift to Control, 2004 Scheme Workshop" self assert: ('a' , (self reset: [ 'b' , (self shift: [ :f | '1' , (f value: (f value: 'c')) ]) ])) = 'a1bbc'! ! !CCResetShiftTest methodsFor: 'testing' stamp: 'lr 4/11/2007 18:18'! testResetShiftA "Christian Queinnec: A Library of High Level Control Operators" self assert: (self reset: [ 2 * (self shift: [ :f | 3 ]) ]) = 3! ! !CCResetShiftTest methodsFor: 'testing' stamp: 'lr 4/11/2007 18:18'! testResetShiftB "Christian Queinnec: A Library of High Level Control Operators" self assert: (self reset: [ 2 * (self shift: [ :f | 5 * (f value: 3) ]) ]) = 30! ! !CCResetShiftTest methodsFor: 'testing' stamp: 'lr 4/11/2007 18:18'! testResetShiftC "Christian Queinnec: A Library of High Level Control Operators" self assert: (self reset: [ 2 * (self shift: [ :f | (f value: (f value: 3)) ]) ]) = 12! ! !CCResetShiftTest methodsFor: 'testing' stamp: 'lr 4/11/2007 18:18'! testResetShiftD "Christian Queinnec: A Library of High Level Control Operators" self assert: ((self reset: [ 2 * (self shift: [ :f | f ]) ]) value: 3) = 6! ! !CCResetShiftTest methodsFor: 'testing' stamp: 'lr 4/12/2007 15:33'! testResetShiftE "Christian Queinnec: A Library of High Level Control Operators" self assert: (self reset: [ 5 * (self reset: [ 2 * (self shift: [ :f2 | 3 * (self shift: [ :f3 | 7 ]) ]) ]) ]) = 7! ! !CCResetShiftTest methodsFor: 'testing' stamp: 'lr 4/11/2007 18:18'! testResetShiftF "Christian Queinnec: A Library of High Level Control Operators" self assert: (self reset: [ 5 * (self reset: [ 2 * (self shift: [ :f2 | [ 3 * (self shift: [ :f3 | 7 ]) ] ]) ]) value ]) = 7! ! !CCResetShiftTest methodsFor: 'testing' stamp: 'lr 4/11/2007 19:42'! testResetShiftG "Christian Queinnec: A Library of High Level Control Operators" self assert: (self reset: [ 5 * ([ :x | self shift: [ :f1 | x ] ] value: (3 * (self shift: [ :f2 | 2 * (f2 value: 7) ]) )) ]) = 42! ! TestCase subclass: #FOperatorTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! !FOperatorTest methodsFor: 'utilities' stamp: 'lr 4/14/2007 21:09'! abort: anObject ^ FOperator abort: anObject! ! FOperatorTest subclass: #FPromptTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! !FPromptTest methodsFor: 'utilities' stamp: 'lr 4/14/2007 21:08'! control: aBlock ^ FControl reify: aBlock! ! !FPromptTest methodsFor: 'utilities' stamp: 'lr 4/14/2007 10:40'! prompt: aBlock ^ FControl mark: aBlock! ! !FPromptTest methodsFor: 'testing' stamp: 'lr 4/14/2007 10:43'! test001 self assert: (10 + (self prompt: [ 2 + (self control: [ :k | 100 + (k value: (k value: 3))] )] )) = 117! ! !FPromptTest methodsFor: 'testing' stamp: 'lr 4/14/2007 21:12'! test002 | x | self assert: (self prompt: [ x := self control: [ :f | 'a' , (f value: '') ]. self control: [ :g | g value: x ] ]) = ''! ! !FPromptTest methodsFor: 'testing' stamp: 'lr 4/14/2007 21:11'! test003 | g | g := self prompt: [ 2 * (self control: [ :k | k ]) ]. self assert: (3 * (self prompt: [ 5 * (self abort: (g value: 7)) ])) = 42! ! !FPromptTest methodsFor: 'testing' stamp: 'lr 4/14/2007 21:11'! test004 ! ! FOperatorTest subclass: #FShiftTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! !FShiftTest methodsFor: 'utilities' stamp: 'lr 4/14/2007 10:38'! reset: aBlock ^ FShift mark: aBlock! ! !FShiftTest methodsFor: 'utilities' stamp: 'lr 4/14/2007 21:08'! shift: aBlock ^ FShift reify: aBlock! ! !FShiftTest methodsFor: 'testing' stamp: 'lr 4/14/2007 10:41'! test01 self assert: (1 + (self reset: [ 2 * (self shift: [ :k | 4 ] )])) = 5! ! !FShiftTest methodsFor: 'testing' stamp: 'lr 4/14/2007 10:41'! test02 self assert: (10 + (self reset: [ 2 + (self shift: [ :k | 100 + (k value: (k value: 3)) ]) ])) = 117! ! !FShiftTest methodsFor: 'testing' stamp: 'lr 4/14/2007 10:41'! test03 self assert: (10 * (self reset: [ 2 * (self shift: [ :g | self reset: [ 5 * (self shift: [ :f | (f value: 1) + 1 ]) ]]) ])) = 60! ! !FShiftTest methodsFor: 'testing' stamp: 'lr 4/14/2007 10:41'! test04 | f | f := [ :x | self shift: [ :k | k value: (k value: x) ] ]. self assert: (1 + (self reset: [ 10 + (f value: 100) ])) = 121! ! !FShiftTest methodsFor: 'testing' stamp: 'lr 4/14/2007 10:41'! test05 | x | self assert: 'a' , (self reset: [ x := self shift: [ :f | 'a' , (f value: '') ]. self shift: [ :g | x ] ]) = 'a'! ! !FShiftTest methodsFor: 'testing' stamp: 'lr 4/14/2007 10:41'! test06 self assert: 'a' , (self reset: [ 'b' , (self shift: [ :f | '1' , (f value: (f value: 'c')) ]) ]) = 'a1bbc'! ! !FShiftTest methodsFor: 'testing' stamp: 'lr 4/14/2007 10:41'! test07 self should: [ self shift: [ :k | ] ] raise: FMarkerNotFound ! ! Error subclass: #CCMarkerNotFound instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Core'! !CCMarkerNotFound methodsFor: 'private' stamp: 'lr 4/12/2007 15:43'! isResumable ^ true! ! Error subclass: #FMarkerNotFound instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Continuations-Operators'! !FMarkerNotFound methodsFor: 'private' stamp: 'lr 4/14/2007 10:24'! isResumable ^ true! !