home *** CD-ROM | disk | FTP | other *** search
/ Really Useful CD 1 / ReallyUsefulCD1.iso / extras / languages / smalltalk / _smalltalk / tests / generator < prev    next >
Encoding:
Text File  |  1987-12-30  |  6.6 KB  |  175 lines
  1. Class Generator :Collection
  2. [
  3.      , aGenerator
  4.           ^ DyadicControlGenerator new;
  5.                firstGen: self
  6.                secondGen: aGenerator
  7.                control: [:x :y |
  8.                     (x isNil)
  9.                          ifTrue:
  10.                               [(y isNil)
  11.                                    ifTrue:  [2r01000000]
  12.                                    ifFalse: [2r00000101]
  13.                               ]
  14.                          ifFalse: [2r00001010] ]
  15.                compute: [:x | x ]
  16. |
  17.      collect: xformBlock
  18.           ^ MonadicControlGenerator new;
  19.                     initGen: self deepCopy
  20.                     control: [ :x | 
  21.                     (x isNil) 
  22.                          ifTrue:  [2r1000] 
  23.                          ifFalse: [2r0101] 
  24.                      ]
  25.                     init: []
  26.                     compute: [:x | xformBlock value: x]
  27. |
  28.      first: limit     | count |
  29.           count <- 0.
  30.           ^ MonadicControlGenerator new;
  31.                     initGen: self deepCopy
  32.                     control: [ :x |
  33.                               (x isNil)
  34.                               ifTrue:  [2r1000]
  35.                               ifFalse: [((count <- count + 1) > limit)
  36.                                              ifTrue:  [2r1000]
  37.                                              ifFalse: [2r0101]
  38.                                          ]
  39.                           ]
  40.                     init: [count <- 0]
  41.                     compute: [:x | x]
  42. |
  43.      select: condBlock
  44.           ^ MonadicControlGenerator new;
  45.                     initGen: self deepCopy
  46.                     control: [ :x |
  47.                          (x isNil)
  48.                               ifTrue:  [2r1000]
  49.                               ifFalse: [(condBlock value: x)
  50.                                              ifTrue:  [2r0101]
  51.                                              ifFalse: [2r0001]
  52.                                          ]
  53.                           ]
  54.                     init: []
  55.                     compute: [:x | x]
  56. |
  57.      until: condBlock
  58.           ^ MonadicControlGenerator new;
  59.                     initGen: self deepCopy
  60.                     control: [ :x |
  61.                          (x isNil)
  62.                               ifTrue:  [2r1000]
  63.                               ifFalse: [(condBlock value: x)
  64.                                              ifTrue:  [2r1000]
  65.                                              ifFalse: [2r0101]
  66.                                          ]
  67.                           ]
  68.                     init: []
  69.                     compute: [:x | x]
  70. |
  71.      with: aGenerator when: conditionBlock
  72.           ^ DyadicControlGenerator new ;
  73.                firstGen: self
  74.                secondGen: aGenerator
  75.                control: [:x :y |
  76.                     (x isNil)
  77.                          ifTrue: [(y isNil)
  78.                               ifTrue:  [2r01000000]
  79.                               ifFalse: [2r00000101] ]
  80.                          ifFalse: [(y isNil)
  81.                               ifTrue:  [2r00001010]
  82.                               ifFalse: [(conditionBlock
  83.                                    value: x value: y)
  84.                                    ifTrue:  [2r00001010]
  85.                                    ifFalse: [2r00000101]
  86.                                    ] ] ]
  87.                compute: [:x | x ]
  88. ]
  89.  
  90. Class MonadicControlGenerator :Generator
  91. | subGenerator  currentValue  controlBlock  initBlock  computeBlock |
  92. [
  93.      initGen: aGenerator 
  94.      control: conBlk 
  95.      init: iniBlk 
  96.      compute: cmpBlk
  97.           subGenerator <- aGenerator.
  98.           controlBlock <- conBlk.
  99.           initBlock <- iniBlk.
  100.           computeBlock <- cmpBlk.
  101.           currentValue <- nil
  102. |
  103.      first
  104.           (currentValue <- subGenerator first) isNil
  105.                     ifTrue: [^ nil].
  106.           initBlock value.
  107.           ^ self next
  108. |
  109.      next     | control  returnedValue |
  110.           control <- 0.
  111.           [control anyMask: 2r0100] whileFalse:
  112.                     [
  113.                     control <- controlBlock value: currentValue.
  114.  
  115.                     (control anyMask: 2r1000) ifTrue:
  116.                               [^ nil].
  117.                     (control anyMask: 2r0100) ifTrue:
  118.                               [returnedValue <- 
  119.                               computeBlock value: currentValue].
  120.                     (control anyMask: 2r0010) ifTrue:
  121.                               [currentValue <- subGenerator first].
  122.                     (control anyMask: 2r0001) ifTrue:
  123.                         [currentValue <- subGenerator next]
  124.                ].
  125.           ^ returnedValue
  126. ]
  127. Class DyadicControlGenerator :Generator
  128. | firstGenerator secondGenerator
  129.   currentFirst currentSecond
  130.   controlBlock computeBlock |
  131. [
  132.      firstGen: firstGen
  133.      secondGen: secondGen
  134.      control: contBlock
  135.      compute: compBlock
  136.  
  137.                 firstGenerator <- firstGen.
  138.                 secondGenerator <- secondGen.
  139.                 controlBlock <- contBlock.
  140.                 computeBlock <- compBlock
  141.  
  142. |       first
  143.                 currentFirst <- firstGenerator first.
  144.                 currentSecond <- secondGenerator first.
  145.                 (currentFirst isNil & currentSecond isNil) ifTrue: [^ nil].
  146.                 ^ self next
  147.  
  148. |       next        | control returnedValue |
  149.                 control <- 0.
  150.                 [ control anyMask: 2r00001100] whileFalse: [
  151.                   control <- controlBlock value: currentFirst
  152.                                           value: currentSecond.
  153.                    (control allMask: 2r01000000) ifTrue: [^nil].
  154.                    (control allMask: 2r00100000) ifTrue:
  155.                                 [currentFirst <- firstGenerator first].
  156.                    (control allMask: 2r00010000) ifTrue:
  157.                                 [currentSecond <- secondGenerator first].
  158.                    (control allMask: 2r00001100)
  159.                       ifTrue:
  160.                           [returnedValue <- computeBlock
  161.                                value: currentFirst value: currentSecond]
  162.                       ifFalse: [
  163.                          (control allMask: 2r00001000) ifTrue:
  164.                            [returnedValue <- computeBlock value: currentFirst].
  165.                          (control allMask: 2r00000100) ifTrue:
  166.                            [returnedValue <- computeBlock value: currentSecond].
  167.                          ].
  168.                    (control allMask: 2r00000010) ifTrue:
  169.                            [currentFirst <- firstGenerator next].
  170.                    (control allMask: 2r00000001) ifTrue:
  171.                            [currentSecond <- secondGenerator next].
  172.                   ].
  173.                 ^ returnedValue
  174. ]
  175.