'From Squeak3.2BCalpha of 21 January 2002 [latest update: #4653] on 25 January 2002 at 10:03:15 am'! TestCase subclass: #BlockClosuresTestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'BlockCLosures-Tests'! !BlockClosuresTestCase commentStamp: '' prior: 0! This test case collects examples for block uses that require full block closures.! Object subclass: #CollectionCombinator instanceVariableNames: 'resultProcessingBlock collectionOfArrays buffer ' classVariableNames: '' poolDictionaries: '' category: 'BlockCLosures-Tests'! !CollectionCombinator commentStamp: '' prior: 0! For a collection of collections, enumerate all elements of the cartesian product. The code shows how recursion is used to implement variable nesting of loops. The cartesian product is usually a huge collection, that should not be kept in memory. Therefore the user of the class has to provide a block with one argument that is called each time a tuple is constructed. When possible, that block should not build a collection of all these tuples, but should immediately drop unsuitable tuples. To get a first impression, try this with 'inspect it': | result | result := OrderedCollection new. CollectionCombinator new forArrays: (OrderedCollection with: #(#a #b #c) with: #(1 2 3 4 5) with: #('v' 'w' 'x' 'y' 'z') with: #('one' 'two' 'three') ) processWith: [:item |result addLast: item]. result ! !BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 17:45'! testContinuationExample1 | array | array := (1 to: 20) asOrderedCollection. self assert: ((self continuationExample1: array) = array) ! ! !BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 17:45'! testContinuationExample2 | array | array := (1 to: 20) asOrderedCollection. self assert: ((self continuationExample2: array) = (array collect: [:x | x * x])) ! ! !BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 17:45'! testContinuationExample3 | array | array := (1 to: 20) asOrderedCollection. self assert: ((self continuationExample3: array) = (array collect: [:x | x * x - 10])) ! ! !BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 16:05'! testExample1 self assert: ((self example1: 5) = 5 factorial) ! ! !BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 18:28'! testExample2 self assert: ((self example2: 5) = (1 to: 5) asOrderedCollection) ! ! !BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 17:59'! testGpsExample1 | result array | array := (1 to: 100) asArray. result := array inject: 0 into: [:sum :val | sum + val]. self assert: ((self gpsExample1: array) = result) ! ! !BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/25/2002 09:57'! testGpsExample2 | result array | " integer matrix elements should be used for the purpose of this test. " array := #(#(1 2 3 4 5) #(6 7 8 9 10) #(11 12 13 14 15) #(16 17 18 19 20) #(21 22 23 24 25)). result := array inject: 0 into: [:sum :subarray | sum + (subarray inject: 0 into: [:s :elem | s + elem])]. self assert: ((self gpsExample2: array) = result) ! ! !BlockClosuresTestCase methodsFor: 'testing' stamp: 'BG 1/24/2002 16:40'! testNestedLoopsExample1 | arrays result | arrays := OrderedCollection new. arrays add: #(#a #b); add: #(1 2 3 4); add: #('w' 'x' 'y' 'z'). result := OrderedCollection new. CollectionCombinator new forArrays: arrays processWith: [:item |result addLast: item]. self assert: ((self nestedLoopsExample: arrays) = result) ! ! !BlockClosuresTestCase methodsFor: 'examples' stamp: 'BG 1/24/2002 17:44'! continuationExample1: aCollection " see comment below. Here we simply collect the values of a value with continuation block " | streamCreator collector | streamCreator := [:collection | | i localBlock | i := 1. localBlock := [ | current | current := collection at: i. i := i + 1. Array with: current with: (i<= collection size ifTrue: [localBlock] ifFalse: [nil]) ]. ]. collector := [:valueWithContinuation | | oc | oc := OrderedCollection new. [ | local | local := valueWithContinuation value. oc add: local first. local last notNil] whileTrue: []. oc. ]. ^collector value: (streamCreator value: aCollection). "The continuation examples are examples of a 'back to LISP' style. These examples use blocks to process the elements of a collection in a fashion that is similar to streaming. The creator block creates a blocks that act like a stream. In the following, this block is called a 'value with continuation block'. When such a value with continuation block receives the message value, it returns a Array of two elements, the value and the continuation 1. the next collection element 2. a so-called continuation, which is either nil or a block that can return the next value with continuation. To collect all elements of a value with continuation stream, use the collector block. " ! ! !BlockClosuresTestCase methodsFor: 'examples' stamp: 'BG 1/24/2002 17:44'! continuationExample2: aCollection " see comment in method continuationExample1:. The block named 'processor' takes a value with contiuation and a processing block. It creates a new value with continuation. Again we use a collector to collect all values. " | stream processor collector | stream := [:collection | | i localBlock | i := 1. localBlock := [ | current | current := collection at: i. i := i + 1. Array with: current with: (i<= collection size ifTrue: [localBlock] ifFalse: [nil]) ]. ]. processor := [:valueWithContinuation :activity | | localBlock | localBlock := [ | current | current := valueWithContinuation value. Array with: (activity value: current first) with: (current last notNil ifTrue: [localBlock])]. localBlock ]. collector := [:valueWithContinuation | | oc | oc := OrderedCollection new. [ | local | local := valueWithContinuation value. oc add: local first. local last notNil] whileTrue: []. oc. ]. ^collector value: (processor value: (stream value: aCollection) value: [:x | x * x]).! ! !BlockClosuresTestCase methodsFor: 'examples' stamp: 'BG 1/24/2002 17:27'! continuationExample3: aCollection " see comment in method continuationExample1:. The block named 'processor' takes a value with contiuation and a processing block. It creates a new value with continuation. Here we set up a chain of three values with continuation: one data source and two value processors. Again we use a collector to collect all values. " | stream processor collector | stream := [:collection | | i localBlock | i := 1. localBlock := [ | current | current := collection at: i. i := i + 1. Array with: current with: (i<= collection size ifTrue: [localBlock] ifFalse: [nil]) ]. ]. processor := [:valueWithContinuation :activity | | localBlock | localBlock := [ | current | current := valueWithContinuation value. Array with: (activity value: current first) with: (current last notNil ifTrue: [localBlock])]. localBlock ]. collector := [:valueWithContinuation | | oc | oc := OrderedCollection new. [ | local | local := valueWithContinuation value. oc add: local first. local last notNil] whileTrue: []. oc. ]. ^collector value: (processor value: (processor value: (stream value: aCollection) value: [:x | x * x]) value: [:x | x - 10]).! ! !BlockClosuresTestCase methodsFor: 'examples' stamp: 'BG 1/24/2002 17:44'! example1: anInteger " this example is very simple. A named block recursively computes the factorial. The example tests whether the value of x is still available after the recursive call. Note that the recursive call precedes the multiplication. For the purpose of the test this is essential. (When you commute the factors, the example will work also in some system without block closures, but not in Squeak.) " | factorial | factorial := [:x | x = 1 ifTrue: [1] ifFalse: [(factorial value: x - 1)* x]]. ^ factorial value: anInteger ! ! !BlockClosuresTestCase methodsFor: 'examples' stamp: 'BG 1/24/2002 18:35'! example2: anInteger " BlockClosuresTestCase new example2: 6" " to complicate the example1, we set up a dynamic reference chain that is used to dump all calls of facorial when recursion depth is maximal. The return value is an instance of orderedCollection, the trace. " | factorial trace | trace := OrderedCollection new. factorial := [:x :dumper :trace | | localDumper | localDumper := [ :collection | collection add: x. dumper value: collection.]. x = 1 ifTrue: [localDumper value: trace. 1] ifFalse: [(factorial value: x - 1 value: localDumper value: trace)* x. ] ]. factorial value: anInteger value: [ :collection | ] value: trace. ^trace! ! !BlockClosuresTestCase methodsFor: 'examples' stamp: 'BG 1/24/2002 16:30'! nestedLoopsExample: arrays " A while ago, Hans Baveco asked for a way to dynamically nest loops. Better solutions than this one were proposed, but this one is a beautiful test for recursive block usage. " | result sizeOfResult streams block | "arrays := OrderedCollection new. arrays add: #(#a #b); add: #(1 2 3 4); add: #('w' 'x' 'y' 'z')." sizeOfResult := arrays inject: 1 into: [:prod :array | prod * array size]. streams := arrays collect: [:a | ReadStream on: a]. " This is an OrderedCollection of Streams " result := OrderedCollection new: sizeOfResult. block := [:r :tupel :allStreams | | innerBlock | innerBlock := [:myIdx | [myIdx = allStreams size ifTrue: [1 to: allStreams size do: [:i | tupel at: i put: (allStreams at: i) peek]. r addLast: tupel shallowCopy] ifFalse: [innerBlock value: myIdx + 1]. (allStreams at: myIdx) next. (allStreams at: myIdx) atEnd ] whileFalse: []. (allStreams at: myIdx) reset. ]. innerBlock value: 1. r ]. block value: result value: (Array new: streams size) " this is a buffer " value: streams. ^result ! ! !BlockClosuresTestCase methodsFor: 'jensen device examples' stamp: 'BG 1/25/2002 10:01'! comment " The Jensen device was something very sophisticated in the days of Algol 60. Essentially it was tricky use of a parameter passing policy that was called 'call by name'. In modern terminology, a call by name parameter was a pair of blocks (in a system with full block closures, of course.) For the lovers of Algol 60, here is a short example: BEGIN REAL PROCEDURE JensenSum (A, I, N); REAL A; INTEGER I, N; BEGIN REAL S; S := 0.0; FOR I := 1 STEP 1 UNTIL N DO S := S + A; JensenSum := S; END; ARRAY X [1:10], Y[1:10, 1:10]; COMMENT Do array initialization here ; JensenSum (X[I], I, 10); JensenSum (Y[I, I], I, 10); JensenSum(JensenSum(Y[I, J], J, 10), I, 10); END; The first call sums the elements of X, the second sums the diagonal elements of Y and the third call sums up all elements of Y. It is possible to reimplement all this with blocks only and that is what is done in the jensen device examples. Additional remark: The Jensen device was something for clever minds. I remember an artice written by Donald Knuth and published in the Communications of the ACM (I think in 1962, but I may err) about that programming trick. That article showed how a simple procedure (called the general problem solver) could be used to do almost anything. The problem was of course to find out the right parameters. I seached my collection of photocopies for that article, but regrettably I could not find it. Perhaps I can find it later. "! ! !BlockClosuresTestCase methodsFor: 'jensen device examples' stamp: 'BG 1/24/2002 18:00'! gpsExample1: aCollection " BlockClosuresTestCase new gpsExample1: (1 to: 100) asArray" | gps i s | gps := [:idx :exp :sum | | cnt | cnt := 1. sum first value: 0. [idx first value: cnt. sum first value: (sum last value + exp last value). cnt := cnt + 1. cnt <= aCollection size] whileTrue: [ ]. sum last value ]. ^gps value: (Array with: [:val | i := val] with: [ i]) value: (Array with: [:val | aCollection at: i put: val] with: [ aCollection at: i]) value: (Array with: [:val | s := val] with: [ s]) ! ! !BlockClosuresTestCase methodsFor: 'jensen device examples' stamp: 'BG 1/25/2002 10:03'! gpsExample2: aCollection " BlockClosuresTestCase new gpsExample2: #(#(1 2 3 4 5) #(6 7 8 9 10) #(11 12 13 14 15) #(16 17 18 19 20) #(21 22 23 24 25))" | js i j | " js is the translation of the Algol procedure from method comment. " js := [:a :idx :n | | sum | sum := 0. idx first value: 1. [idx last value <= n last value] whileTrue: [sum := sum + a last value. idx first value: idx last value + 1.]. sum ]. " This is the most complicated call that is mentioned in method comment. Note that js is called recursively. " ^ js value: (Array with: [:val | self error: 'can not assign to procedure'] with: [ js value: (Array with: [:val | (aCollection at: i) at: j put: val] with: [ (aCollection at: i) at: j]) value: (Array with:[:val | j := val] with: [ j]) value: (Array with: [:val | self error: 'can not assign to constant'] with: [ aCollection size]) ] ) value: (Array with:[:val | i := val] with: [ i]) value: (Array with: [:val | self error: 'can not assign to constant'] with: [ aCollection size]) ! ! !CollectionCombinator methodsFor: 'as yet unclassified' stamp: 'BG 12/20/2001 21:33'! combineFromIdx: myIdx " this method is recursive. Recursion runs from values 1 to collectionOfArrays size of parameter myIdx. Each time it is called, this method has the responsiblity to provide all possible values for one index position of the result tuples. That index position is given by the value of myIdx." (collectionOfArrays at: myIdx) do: [:item | buffer at: myIdx put: item. myIdx = collectionOfArrays size ifTrue: [resultProcessingBlock value: buffer shallowCopy] ifFalse: [self combineFromIdx: myIdx + 1] ]. " The buffer is a shared object and its contents are later changed. It is therefore necessary to make a copy. "! ! !CollectionCombinator methodsFor: 'as yet unclassified' stamp: 'BG 12/20/2001 21:32'! forArrays: anArray processWith: aBlock " anArray is a kind of a sequenceable collection of arrays. aBlock is a block with one argument, that is used to process a tuple immediately after it is constructed. " collectionOfArrays := anArray. resultProcessingBlock := aBlock. buffer := Array new: anArray size. self combineFromIdx: 1 ! ! !BlockClosuresTestCase reorganize! ('testing' testContinuationExample1 testContinuationExample2 testContinuationExample3 testExample1 testExample2 testGpsExample1 testGpsExample2 testNestedLoopsExample1) ('examples' continuationExample1: continuationExample2: continuationExample3: example1: example2: nestedLoopsExample:) ('jensen device examples' comment gpsExample1: gpsExample2:) !