home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 1 / RISC_DISC_1.iso / pd_share / code / smalltalk / !GNUst / st / Bag < prev    next >
Encoding:
Text File  |  1991-09-13  |  4.5 KB  |  187 lines
  1. "======================================================================
  2. |
  3. |   Bag Method Definitions
  4. |
  5.  ======================================================================"
  6.  
  7.  
  8. "======================================================================
  9. |
  10. | Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  11. | Written by Steve Byrne.
  12. |
  13. | This file is part of GNU Smalltalk.
  14. |
  15. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  16. | under the terms of the GNU General Public License as published by the Free
  17. | Software Foundation; either version 1, or (at your option) any later version.
  18. | 
  19. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  20. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  21. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  22. | details.
  23. | 
  24. | You should have received a copy of the GNU General Public License along with
  25. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  26. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  27. |
  28.  ======================================================================"
  29.  
  30.  
  31. "
  32. |     Change Log
  33. | ============================================================================
  34. | Author       Date       Change 
  35. | sbb         12 Sep 91      Fixed #= method
  36. |
  37. | sbyrne     25 Apr 89      created.
  38. |
  39. "
  40.  
  41. Collection subclass: #Bag
  42.        instanceVariableNames: 'contents'
  43.        classVariableNames: ''
  44.        poolDictionaries: ''
  45.        category: nil.
  46.  
  47. Bag comment:
  48. 'My instances are unordered collections of objects.  You can think
  49. of me as a set with a memory; that is, if the same object is added to me
  50. twice, then I will report that that element has been stored twice.'!
  51.  
  52.  
  53. !Bag class methodsFor: 'basic'!
  54.  
  55. new
  56.     ^super new initContents
  57. !!
  58.  
  59.  
  60.  
  61. !Bag methodsFor: 'Adding to a collection'!
  62.  
  63. add: newObject withOccurrences: anInteger
  64.     contents at: newObject
  65.          put: (self occurrencesOf: newObject) + anInteger.
  66.     ^newObject
  67. !
  68.  
  69. add: newObject
  70.     self add: newObject withOccurrences: 1.
  71.     ^newObject 
  72. !
  73.  
  74. at: index
  75.     self error: 'at: is not allowed for a Bag'
  76. !
  77.  
  78. at: index put: value
  79.     self error: 'at:put: is not allowed for a Bag'
  80. !!
  81.  
  82.  
  83.  
  84. !Bag methodsFor: 'Removing from a collection'!
  85.  
  86. remove: oldObject ifAbsent: anExceptionBlock
  87.     | count |
  88.     "Remove oldObject from the collection and return it.  Since we're using
  89.     a dictionary, we need decrement the value until it's zero, in which case
  90.     we can then remove the object from the dictionary"
  91.     count _ self occurrencesOf: oldObject.
  92.     count = 0 ifTrue: [ ^anExceptionBlock value ].
  93.     count = 1 ifTrue: [ contents removeKey: oldObject ]
  94.               ifFalse: [ contents at: oldObject
  95.                                 put: count - 1 ].
  96.     ^oldObject
  97. !!
  98.  
  99.  
  100.  
  101. !Bag methodsFor: 'testing collections'!
  102.  
  103. occurrencesOf: anObject
  104.     ^contents at: anObject ifAbsent: [ ^0 ]
  105. !
  106.  
  107. size
  108.     | count |
  109.     count _ 0.
  110.     contents do: [ :element | count _ count + element ].
  111.     ^count
  112. !
  113.  
  114. hash
  115.     ^contents hash
  116. !
  117.  
  118. = aBag
  119.     self class == aBag class
  120.     ifFalse: [ ^false ].
  121.     ^contents = aBag contents
  122. !!
  123.  
  124.  
  125.  
  126. !Bag methodsFor: 'enumerating the elements of a collection'!
  127.  
  128. do: aBlock
  129.     "Perform the block for all members in the collection.  For Bags, we need
  130.     to go through the contents dictionary, and perform the block for as many
  131.     occurrences of the objects as there are."
  132.     contents associationsDo:
  133.       [ :assoc |  assoc value timesRepeat: [ aBlock value: assoc key ] ]
  134. !!
  135.  
  136.  
  137.  
  138. !Bag methodsFor: 'printing'!
  139.  
  140. printOn: aStream
  141.     | firstTime |
  142.     aStream nextPutAll: self classNameString.
  143.     aStream nextPutAll: ' ('.
  144.     firstTime _ true.
  145.     contents associationsDo:
  146.       [ :assoc | firstTime ifTrue: [ firstTime _ false ]
  147.                              ifFalse: [ aStream nextPut: Character space ].
  148.                  assoc key storeOn: aStream.
  149.          aStream nextPut: $,.
  150.          assoc value storeOn: aStream ].
  151.     aStream nextPut: $)
  152. !!
  153.  
  154.  
  155.  
  156. !Bag methodsFor: 'storing'!
  157.  
  158. storeOn: aStream
  159.     | noElements |
  160.     aStream nextPut: $(.
  161.     aStream nextPutAll: self classNameString.
  162.     aStream nextPutAll: ' new'.
  163.     noElements _ true.
  164.     contents associationsDo:
  165.       [ :assoc | aStream nextPutAll: ' add: '.
  166.                  assoc key storeOn: aStream.
  167.          aStream nextPutAll: ' withOccurrences: '.
  168.          assoc value storeOn: aStream.
  169.          aStream nextPut: $;.
  170.          noElements _ false ].
  171.     noElements ifFalse: [ aStream nextPutAll: '; yourself' ].
  172.     aStream nextPut: $)
  173. !!
  174.  
  175.  
  176.  
  177. !Bag methodsFor: 'private'!
  178.  
  179. initContents
  180.     contents _ Dictionary new
  181. !
  182.  
  183. contents
  184.     ^contents
  185. !!
  186.  
  187.