      *>----------------------------------------------------------------
      *> An instance of Bag is a collection which stores non-ordered
      *> elements. You can store duplicate elements in bags.
      *> Bags provide a more space efficient mechanism than arrays by
      *> taking account of objects with the same value.
      *> Bags are recommended when
      *> you expect to store many duplicate elements.
      *>
      *> Elements can be objects or COBOL intrinsic data. Use the
      *> "ofReferences" method to create an instance for storing
      *> objects, and the "ofValues" method to create an instance for
      *> storing COBOL intrinsic data.
      *>
      *>#See the method "ofValues".
      *>#See the method "ofReferences".
      *>
      *> Copyright (C) 1991-1999 Micro Focus International Ltd.
      *>
      *>----------------------------------------------------------------
      $set mfoo
       class-id. Bag data is protected
               inherits from collection with data.

       special-names.
           call-convention 0 is paramcountcheck
           .
        object section.
        class-control.
           collection is class "collectn"
           bag is class "bag"
           cobolcomp5 is class "comp5"
           dictionary is class "dictinry"
           association is class "associtn"
           callback is class "callback".

       class-object.

       object-storage section.

      *>----------------------------------------------------------------
      *> Returns a new instance of Bag to store values rather than
      *> objects. The type and length of data to be stored is
      *> specified by lnkTemplate.
      *> Parameter lnkTemplate is a subclass of Intrinsic for the data
      *> type, and cloned to the length of data which you want to store.
      *>
      *>#See the section Intrinsic Data.
      *>----------------------------------------------------------------
       method-id. "ofValues".
       local-storage section.
       01 abag             usage object reference.
       01 atemplate2       usage object reference.

       linkage section.
       01 lnktemplate          usage object reference.
       01 acollection          usage object reference.
       01 lnkSize              pic x(4) comp-5.
       procedure division using lnktemplate lnkSize
                           returning acollection.
           invoke super "privateNew" returning abag

           invoke association "newClass" using lnktemplate CobolComp5
                                                returning atemplate2
           invoke abag "initialize" using lnktemplate atemplate2 lnkSize
           set acollection to abag
           exit method.
       end method "ofValues".
      *>----------------------------------------------------------------
      *> Returns a new instance of Bag for storing objects as elements.
      *>----------------------------------------------------------------
       method-id. "ofReferences".

       local-storage section.

       01 abag             usage object reference.
       01 atemplate2       usage object reference.
       01 anObject         usage object reference.
       linkage section.
       01 acollection       usage object reference.
       01 lnkSize           pic x(4) comp-5.
       procedure division using lnkSize returning acollection.
           invoke super "privateNew" returning abag
           set anObject to null
           invoke association "newClass" using anObject cobolcomp5
                                                returning atemplate2
           invoke abag "initialize" using anObject atemplate2 lnkSize
           set acollection to abag
           exit method.
       end method "ofReferences".

       end class-object.

       Object.

       object-storage section.

      *>>---------------------------------------------------------------
      *>> A dictionary used to implement bag. The keys hold the value
      *>> to be stored in this bag whereas the values keep a count of
      *>> how many of these objects are in the bag.
      *>>---------------------------------------------------------------

       01 contents usage object reference value null.

      *>>---------------------------------------------------------------
      *>> A clone of the association class indicating which type
      *>> of object is stored within this bag.
      *>>---------------------------------------------------------------

       01 associationclass usage object reference value null.
      *>---------------------------------------------------------------
      *> PRIVATE. Method used to initialize the instance variables for
      *> new instances of Bag.
      *>---------------------------------------------------------------
       method-id. "initialize".
       working-storage section.
       01 astride               pic s9(9) comp-5 value
                                         objectReferenceSize.

       local-storage section.

       01 adict                usage object reference.
       01 asize                pic s9(9) comp-5.
       01 anObject             usage object reference.

       linkage section.
       01 lnktemplate          usage object reference.
       01 assoctemplate        usage object reference.
       01 lnkSize              pic x(4) comp-5.
       procedure division paramcountcheck
                        using lnktemplate assoctemplate lnkSize.
           set collectiontemplate to lnktemplate
           set anObject to null
           invoke collectiontemplate "sizeInBytes"
                returning collectionstride
           set associationclass to assoctemplate
           if address of lnkSize = null
               move 10 to asize
           *>>    stop "size not supplied"
           else
           *>>    stop "size supplied"
               move lnkSize to aSize
           end-if
           *>> display "lnkSize = " aSize
           invoke dictionary "privateNew" using asize anObject astride
                                                assoctemplate
                                         returning adict
           set contents to adict
           exit method.
       end method "initialize".
      *>---------------------------------------------------------------
      *> Add anElement to this bag.
      *>---------------------------------------------------------------
       method-id. "add".
       local-storage section.

       01 i                pic s9(9) comp-5.

       linkage section.
       01 anelement        COLLECTABLE.

       procedure division using anelement.
           move 1 to i
           invoke self "addWithOccurrences" using anelement i
           exit method.
       end method "add".
      *>----------------------------------------------------------------
      *> Return true is this object is an indexed instance
      *>----------------------------------------------------------------
       method-id. "isIndexed".
       linkage section.
       01 lnkbool               pic 9 comp-5.
       procedure division returning lnkbool.
           move 0 to lnkBool
           exit method.
       end method "isIndexed".
      *>---------------------------------------------------------------
      *> Return a copy of this bag.
      *>---------------------------------------------------------------
       method-id. "copy".
       local-storage section.
       01 newContents  usage object reference.
       linkage section.
       01 aNewBag      usage object reference.

       procedure division returning aNewBag.
           invoke self "basicCopy" returning aNewBag
           invoke contents "copy" returning newContents
           invoke aNewBag "setContents" using newContents
           exit method.
       end method "copy".
      *>---------------------------------------------------------------
      *> PRIVATE. Reset the contents for this bag.
      *>---------------------------------------------------------------
       method-id. "setContents".
       linkage section.
       01 lnkNewContents      usage object reference.
       procedure division using lnkNewContents.
           set contents to lnkNewContents
           exit method.
       end method "setContents".
      *>---------------------------------------------------------------
      *> Add anElement lnkOccurs times to this bag.
      *>---------------------------------------------------------------
       method-id. "addwithOccurrences".
       local-storage section.

       01 bool                 pic x comp-5.
           88 istrue           value 1.
           88 isfalse          value 0.
       01 i                pic s9(9) comp-5.

       linkage section.
       01 anelement            COLLECTABLE.
       01 lnkoccurs             pic s9(9) comp-5.

       procedure division using anelement lnkoccurs.
           add lnkoccurs to numberelements
           invoke contents "includesKey"  using anelement
                                           returning bool
           if istrue
               invoke contents "at" using anElement
                        returning i
               add lnkoccurs to i
               invoke contents "atPut" using anElement i
           else
               move lnkoccurs to i
               invoke contents "atput" using anElement i
           end-if
           exit method.
       end method "addwithOccurrences".
      *>---------------------------------------------------------------
      *> Return the number of occurrences of anElement.
      *>---------------------------------------------------------------
       method-id. "occurrencesOf".
       local-storage section.

       01 bool                 pic x comp-5.
           88 istrue           value 1.
           88 isfalse          value 0.

       linkage section.
       01 anelement            COLLECTABLE.
       01 lnkoccurs            pic s9(9) comp-5.

       procedure division using anelement
                                   returning lnkoccurs.
           invoke contents "includesKey" using anelement
                                          returning bool
           if isfalse
               move zero to lnkoccurs
           else
               invoke contents "at" using anelement
                                     returning lnkoccurs
           end-if
           exit method.
       end method "occurrencesOf".
      *>----------------------------------------------------------------
      *> Return true if this bag contains anElement.
      *>----------------------------------------------------------------
       method-id. "includes".
       linkage section.
       01 anelement             COLLECTABLE.
       01 lnkbool                 pic x comp-5.
           88 lnkistrue           value 1.
           88 lnkisfalse          value 0.

       procedure division using anelement returning lnkbool.
           invoke contents "includesKey" using anelement
                                          returning lnkbool
           exit method.
       end method "includes".
      *>----------------------------------------------------------------
      *> Send the message aMessage passing each element of the bag to
      *> the CallBack in turn.
      *>----------------------------------------------------------------
       method-id. "doWithOutCopy".
       local-storage section.

       01 amessageselector     pic x(80).
       01 ooreturnptr          usage pointer.
       01 amessage2            usage object reference.

       linkage section.
       01 lnkreturnbuffer       usage object reference.
       01 amessage             usage object reference.

       procedure division using amessage.
           move "doBM" to amessageselector
           invoke self "allocateElement"
                            returning ooreturnptr
           invoke callback "new" using self amessageselector amessage
                                       ooreturnptr
                             returning amessage2
           invoke contents "keysandDatado" using amessage2
           invoke self "dealloc" using ooreturnptr
           exit method.
       end method "doWithOutCopy".
      *>----------------------------------------------------------------
      *> PRIVATE. CallBack to help perform the function of "do"
      *>----------------------------------------------------------------
       method-id. "doBM".
       local-storage section.
       01 i pic x(4) comp-5.

       linkage section.
       01 lnkreturnbuffer       usage object reference.
       01 amessage             usage object reference.
       01 defaultreturn        usage object reference.
       01 anelement            COLLECTABLE.
       01 lnkoccurs             pic s9(9) comp-5.
       01 lnkPtr                usage pointer.
       procedure division using amessage lnkPtr anelement lnkoccurs
                      returning defaultreturn.
           set defaultreturn to self
           set address of lnkreturnbuffer to lnkPtr
           perform varying i from 1 by 1 until i > lnkoccurs
                   or ooquit
               invoke amessage "invoke" using anelement
                                        returning lnkreturnbuffer
           end-perform
           exit method.
       end method "doBM".

      $if gc not defined  
      *>----------------------------------------------------------------
      *> Delete this bag.
      *>----------------------------------------------------------------

       method-id. "finalize".
       linkage section.
       01 defaultreturn        usage object reference.

       procedure division returning defaultreturn.
           invoke contents "finalize" returning defaultreturn
           invoke super "finalize" returning defaultreturn
           exit method.
       end method "finalize".

      *>----------------------------------------------------------------
      *> Destroy this object, and all the elements in it up to a depth
      *> lnkDepth.
      *>----------------------------------------------------------------
       method-id. "deepfinalizeWithDepth".
       linkage section.
       01 lnkDepth             pic x(4) comp-5.
       01 defaultreturn        usage object reference.

       procedure division using lnkDepth returning defaultreturn.
           invoke contents "deepfinalizeWithDepth"
               using lnkdepth
           returning defaultreturn
           invoke super "finalize" returning defaultreturn
           exit method.
       end method "deepfinalizeWithDepth".

      $end

      *>----------------------------------------------------------------
      *> Return the number of elements stored within this bag.
      *>----------------------------------------------------------------
       method-id. "size".
       linkage section.
       01 lnksize              pic s9(9) comp-5.

       procedure division returning lnksize.
           move numberelements to lnksize
           exit method.
       end method "size".
      *>----------------------------------------------------------------
      *> Remove a single occurrence of anElement from this bag.
      *>----------------------------------------------------------------
       method-id. "remove".
       local-storage section.

       01 anobject             usage object reference.
       01 bool                 pic x comp-5.
           88 istrue           value 1.
           88 isfalse          value 0.
       01 i                pic s9(9) comp-5.
       01 exceptionnumber  pic s9(9) comp-5.

       linkage section.
       01 anelement             COLLECTABLE.

       procedure division using anelement.
           invoke contents "includesKey" using anelement
                                          returning bool
           if istrue

               invoke contents "at" using anelement
                                            returning i
               if i = 1
                   invoke contents "removeKey" using anElement
               else
                   subtract 1 from i
                   invoke contents "atPut" using anElement i
               end-if
               subtract 1 from numberelements
           else
               move 12 to exceptionnumber
               invoke self "raiseException" using exceptionnumber
           end-if
           exit method.
       end method "remove".
       end object.
       end class bag.
