IMPLEMENTATION MODULE BagSUUN;
(*==============================================================
    Version  : 1.00  02 May 1989  C. Lins
    Compiler : TopSpeed Modula-2
    Component: Monolithic Structures - Bag
               Sequential Unbounded Unmanaged Non-Iterator
    Code Size: R-  bytes

    INTRODUCTION
    This module provides the Bag ADT for generic Items. Uses an
	ordered, linear list for the items.

    REVISION HISTORY
    v1.00  02 May 1989  C. Lins
        Initial implementation derived from BagSUUI module.

    (C) Copyright 1989 Charles A. Lins
================================================================*)

FROM JPIStorage IMPORT
    (*--Proc*) Allocate, Deallocate;

FROM Items IMPORT
    (*--Type*) Item, CompareProc;

FROM ErrorHandling IMPORT
    (*--Type*) HandlerProc,
    (*--Proc*) Raise, NullHandler, ExitOnError;

FROM Relations IMPORT
    (*--Type*) Relation;

FROM BagEnum IMPORT
    (*--Type*) Exceptions, Operations, ComponentID;

FROM TypeManager IMPORT
    (*--Cons*) NullType,
    (*--Type*) TypeID,
	(*--Proc*) CompareOf;

    (*--------------------*)

TYPE  Link = POINTER TO Node;
TYPE  Node = RECORD      (*-- a bag item node *)
        item : Item;     (*-- the item nodes' data *)
		count: CARDINAL; (*-- number of these items *)
		next : Link;     (*-- link to next node in list *)
	  END (*-- Node *);
CONST NullLink = NIL;

TYPE  UnboundedBag = RECORD (*-- bag header *)
		dataID : TypeID;    (*-- defined data type *)
        length : CARDINAL;  (*-- current bag length, := 0 *)
        first  : Link;      (*-- link to first Item node *)
      END (*-- UnboundedBag *);

TYPE  Bag = POINTER TO UnboundedBag;


    (*---------------------------------*)
    (*--          EXCEPTIONS         --*)

VAR   bagError  : Exceptions;
VAR   handlers  : ARRAY Exceptions OF HandlerProc;


    (*-----------------------*)

PROCEDURE BagError () : Exceptions (*-- out   *);
BEGIN
  RETURN bagError;
END BagError;
(*--------------------*)

PROCEDURE GetHandler  (    ofError   : Exceptions  (*-- in    *))
                                     : HandlerProc (*-- out   *);
BEGIN
  RETURN handlers[ofError];
END GetHandler;
(*--------------------*)

PROCEDURE SetHandler  (    ofError   : Exceptions  (*-- in    *);
                           toHandler : HandlerProc (*-- in    *));
BEGIN
  handlers[ofError] := toHandler;
END SetHandler;
(*--------------------*)

PROCEDURE RaiseErrIn (    theRoutine : Operations    (*-- in    *);
                          theError   : Exceptions    (*-- in    *));
BEGIN
  bagError := theError;
  Raise(ComponentID + ModuleID, theRoutine, theError, handlers[theError]);
END RaiseErrIn;
(*--------------------*)


    (*---------------------------------*)
    (*--       LOCAL ROUTINES        --*)

VAR   bagRoutine : Operations;  (*-- Routine calling NewNode *)

PROCEDURE NewNode       (    theItem : Item        (*-- in    *);
       	       	             theCount: CARDINAL    (*-- in    *);
       	       	             theNext : Link        (*-- in    *))
							         : Link        (*-- out   *);

VAR   newLink : Link;

BEGIN
  Allocate(newLink, SIZE(Node));
  IF (newLink = NullLink) THEN
    RaiseErrIn(bagRoutine, overflow);
  ELSE
    WITH newLink^ DO
	  item  := theItem;
	  count := theCount;
	  next  := theNext;
	END (*--with*);
  END (*--if*);
  RETURN newLink;
END NewNode;
(*--------------------*)

PROCEDURE TailInsert (    theNode : Link (*--in   *);
					  VAR first   : Link (*--inout*);
					  VAR last    : Link (*--inout*));
BEGIN
  IF (first = NullLink) THEN
	first := theNode;
  ELSE
	last^.next := theNode;
  END (*--if*);
  last := theNode;
END TailInsert;
(*--------------------*)

PROCEDURE CopySubset (    fromIndex  : Link       (*-- in    *);
                          toIndex    : Link       (*-- in    *);
                      VAR toBag      : Bag        (*-- inout *));

VAR   tempNode : Link;

BEGIN
  LOOP
    IF (fromIndex = NullLink) THEN
	  EXIT (*--loop*);
	ELSE
	  WITH fromIndex^ DO
	    tempNode := NewNode(item, count, NIL);
	  END (*--with*);
	  IF (tempNode = NullLink) THEN
	    EXIT (*--loop*);
	  END (*--if*);
	  INC(toBag^.length);
	  TailInsert(tempNode, toBag^.first, toIndex);
      fromIndex := fromIndex^.next;
	END (*--if*);
  END (*--loop*);
END CopySubset;
(*--------------------*)

PROCEDURE Recreate (VAR theBag  : Bag       (*--inout*);
                        theType : TypeID    (*--in   *))
                                : BOOLEAN   (*--out  *);
BEGIN
  IF (theBag = NullBag) THEN
    theBag := Create(theType);
  ELSE
    Clear(theBag);
    theBag^.dataID := theType;
  END (*--if*);
  RETURN (bagError = noerr);
END Recreate;
(*--------------------*)


    (*---------------------------------*)
    (*--        CONSTRUCTORS         --*)

PROCEDURE Create        (    theType  : TypeID    (*-- in    *))
                                      : Bag       (*-- out   *);

VAR   newBag : Bag; (*-- new bag variable being created *)

BEGIN
  bagError := noerr;
  Allocate(newBag, SIZE(UnboundedBag));
  IF (newBag = NullBag) THEN
    RaiseErrIn(create, overflow);
  ELSE
    WITH newBag^ DO
	  dataID := theType;
      length := 0;
	  first  := NullLink;
    END (*--with*);
  END (*--if*);
  RETURN newBag;
END Create;
(*--------------------*)

PROCEDURE Destroy       (VAR theBag   : Bag       (*-- inout *));
BEGIN
  Clear(theBag);
  IF (bagError = noerr) THEN
    Deallocate(theBag, SIZE(UnboundedBag));
  END (*--if*);
END Destroy;
(*--------------------*)

PROCEDURE Clear         (VAR theBag   : Bag       (*-- inout *));

VAR   theNode  : Link;        (*-- Bag node to be deallocated *)

BEGIN
  bagError := noerr;
  IF (theBag # NullBag) THEN
    WITH theBag^ DO
	  WHILE (first # NullLink) DO
	    theNode := first;
		first   := first^.next;
		Deallocate(theNode, SIZE(theNode^));
	  END (*--while*);
  	  length := 0;
    END (*--with*);
  ELSE
    RaiseErrIn(clear, undefined);
  END (*--if*);
END Clear;
(*--------------------*)

PROCEDURE Assign        (    theBag   : Bag       (*-- in    *);
                         VAR toBag    : Bag       (*-- inout *));

VAR   fromIndex : Link; (*-- Loop index over source bag items *)
	  toIndex   : Link; (*-- new item node in target bag *)

BEGIN
  bagError := noerr;
  bagRoutine := assign;
  IF (theBag # NullBag) THEN
    IF Recreate(toBag, theBag^.dataID) THEN
	  IF (theBag^.first = NullLink) THEN
		RETURN;
	  END (*--if*);

      WITH theBag^.first^ DO
	    toBag^.first := NewNode(item, count, NullLink);
	  END (*--with*);
	  IF (bagError = overflow) THEN
        RETURN;
	  END (*--if*);
	  toIndex   := toBag^.first;
	  fromIndex := theBag^.first;

      WHILE (fromIndex^.next # NIL) DO
	    fromIndex := fromIndex^.next;
        WITH fromIndex^ DO
	      toIndex^.next := NewNode(item, count, NullLink);
	    END (*--with*);
	    IF (bagError = overflow) THEN
		  RETURN;
        END (*--if*);
        toIndex := toIndex^.next;
      END (*--while*);
      toBag^.length := theBag^.length;
    END (*--if*);
  ELSE
    RaiseErrIn(assign, undefined);
  END (*--if*);
END Assign;
(*--------------------*)

PROCEDURE Include       (    theItem  : Item      (*-- in    *);
       	       	         VAR inBag    : Bag       (*-- inout *));

VAR   current     : Link;        (*-- Loop index in search of theItem *)
      previous    : Link;        (*-- Previous node examined *)
	  newNode     : Link;        (*-- For new node to add *)
	  compareItem : CompareProc; (*-- Item comparison routine *)
	  itemOrder   : Relation;    (*-- Ordering relation between items *)

BEGIN
  bagError := noerr;
  IF (inBag # NullBag) THEN
	compareItem := CompareOf(inBag^.dataID);
    current     := inBag^.first;
	previous    := NullLink;
    LOOP
	  IF (current = NullLink) THEN
        EXIT (*--loop*); (*-- theItem is not in the bag *)
      END (*--if*);

	  itemOrder := compareItem(current^.item, theItem);

      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
	    INC(current^.count);
        RETURN;

	  ELSIF (itemOrder = greater) THEN
        EXIT (*--loop*); (*-- theItem is not in the bag *)
      END (*--if*);

      previous := current; (*-- Keep looking *)
      current  := current^.next;
    END (*--loop*);

    (*-- Insert the new item *)

	Allocate(newNode, SIZE(Node));
	IF (newNode = NullLink) THEN
	  RaiseErrIn(include, overflow);
    ELSE
	  WITH newNode^ DO
	    item  := theItem;
		count := 1;
	  END (*--with*);
	  IF (previous = NullLink) THEN
	    newNode^.next := inBag^.first;
		inBag^.first  := newNode;
	  ELSE
	    newNode^.next  := current;
		previous^.next := newNode;
      END (*--if*);
      INC(inBag^.length);
    END (*--if*);
  ELSE
    RaiseErrIn(include, undefined);
  END (*--if*);
END Include;
(*--------------------*)

PROCEDURE Exclude       (    theItem  : Item      (*-- in    *);
       	       	         VAR fromBag  : Bag       (*-- inout *));

VAR   current     : Link;        (*-- Loop index over items *)
      previous    : Link;        (*-- Previous node examined *)
	  compareItem : CompareProc; (*-- Item comparison routine *)
	  itemOrder   : Relation;    (*-- Relation between items *)

BEGIN
  bagError := noerr;
  IF (fromBag # NullBag) THEN
	compareItem := CompareOf(fromBag^.dataID);
    current     := fromBag^.first;
	previous    := NullLink;
    LOOP
	  IF (current = NullLink) THEN
        RETURN; (*-- theItem is not in the bag *)
      END (*--if*);

	  itemOrder := compareItem(current^.item, theItem);

      IF (itemOrder = equal) THEN (*-- theItem is in the bag *)
	    IF (current^.count > 1) THEN
		  DEC(current^.count);
		  RETURN;
		ELSE
          EXIT (*--loop*);
		END (*--if*);
      ELSIF (itemOrder = greater) THEN
        RETURN;          (*-- theItem is not in the bag *)
      END (*--if*);

      previous := current;       (*-- Keep looking *)
      current  := current^.next;
    END (*--loop*);

    (*-- ╥current╙ points to the node to be deleted. *)

    IF (previous = NullLink) THEN
	  fromBag^.first := current^.next;
	ELSE
	  previous^.next := current^.next;
	END (*--if*);
	Deallocate(current, SIZE(current^));
    DEC(fromBag^.length);
  ELSE
    RaiseErrIn(exclude, undefined);
  END (*--if*);
END Exclude;
(*--------------------*)

PROCEDURE Union         (    left     : Bag       (*-- in    *);
       	       	             right    : Bag       (*-- in    *);
                         VAR toBag    : Bag       (*-- inout *));

VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
      rightIndex  : Link;        (*-- Loop index over right bag *)
	  toIndex     : Link;        (*-- List of target bag nodes *)
	  tempNode    : Link;        (*-- Temporary node *)
	  compareItem : CompareProc; (*-- Item comparison routine *)
	  order       : Relation;    (*-- Ordering relation between items *)

BEGIN
  bagError := noerr;
  IF (left = NullBag) OR (right = NullBag) THEN
    RaiseErrIn(union, undefined);
	RETURN;
  ELSIF (left^.dataID # right^.dataID) THEN
    RaiseErrIn(union, typeerror);
	RETURN;
  ELSIF ~Recreate(toBag, left^.dataID) THEN
    RETURN;
  END (*--if*);

  compareItem := CompareOf(toBag^.dataID);
  bagRoutine := union;

  leftIndex  := left^.first;
  rightIndex := right^.first;
  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
	Allocate(tempNode, SIZE(Node));
	IF (tempNode = NullLink) THEN
	  RaiseErrIn(union, overflow);
	  RETURN;
	END (*--if*);
	tempNode^.next := NullLink;

    order := compareItem(leftIndex^.item, rightIndex^.item);
	INC(toBag^.length);

    IF (order = less) THEN
	  WITH tempNode^ DO
        item  := leftIndex^.item;
	    count := leftIndex^.count;
	  END (*--with*);
      leftIndex := leftIndex^.next;
	ELSIF (order = equal) THEN
	  WITH tempNode^ DO
        item  := leftIndex^.item;
	    count := leftIndex^.count + rightIndex^.count;
	  END (*--with*);
      leftIndex  := leftIndex^.next;
      rightIndex := rightIndex^.next;
    ELSE
	  WITH tempNode^ DO
        item  := rightIndex^.item;
	    count := rightIndex^.count;
	  END (*--with*);
      rightIndex := rightIndex^.next;
    END (*--if*);

	TailInsert(tempNode, toBag^.first, toIndex);

  END (*--while*);

  (*-- Copy remaining items, if any, from either the left bag or
    -- the right bag to the destination bag. *)

  IF (leftIndex = NullLink) THEN
    CopySubset(rightIndex, toIndex, toBag);
  ELSIF (rightIndex = NullLink) THEN
    CopySubset(leftIndex, toIndex, toBag);
  END (*--if*);
END Union;
(*--------------------*)

PROCEDURE Intersection  (    left    : Bag         (*-- in    *);
       	       	             right   : Bag         (*-- in    *);
                         VAR toBag   : Bag         (*-- inout *));

VAR   leftIndex   : Link;        (*-- Loop link over left bag *)
      rightIndex  : Link;        (*-- Loop link over right bag *)
	  toIndex     : Link;        (*-- List of target bag nodes *)
	  tempNode    : Link;		 (*-- temporary for new node *)
	  compareItem : CompareProc; (*-- Item comparison routine *)
	  order       : Relation;    (*-- Ordering relation between items *)
	  newCount    : CARDINAL;    (*-- Smaller of left/right counts *)

BEGIN
  bagError := noerr;
  IF (left = NullBag) OR (right = NullBag) THEN
    RaiseErrIn(intersection, undefined);
	RETURN;
  ELSIF (left^.dataID # right^.dataID) THEN
    RaiseErrIn(intersection, typeerror);
	RETURN;
  ELSIF ~Recreate(toBag, left^.dataID) THEN
    RETURN;
  END (*--if*);
  
  compareItem := CompareOf(toBag^.dataID);
  bagRoutine := intersection;

  leftIndex  := left^.first;
  rightIndex := right^.first;
  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
    order := compareItem(leftIndex^.item, rightIndex^.item);
    IF (order = equal) THEN

	  IF (leftIndex^.count < rightIndex^.count) THEN
	    newCount := leftIndex^.count;
	  ELSE
	    newCount := rightIndex^.count;
	  END (*--if*);

	  tempNode := NewNode(leftIndex^.item, newCount, NullLink);
	  IF (bagError = overflow) THEN
	    RETURN;
	  END (*--if*);
	  TailInsert(tempNode, toBag^.first, toIndex);
	  INC(toBag^.length);
      leftIndex  := leftIndex^.next;
      rightIndex := rightIndex^.next;

    ELSIF (order = less) THEN
      leftIndex  := leftIndex^.next;

    ELSE
      rightIndex := rightIndex^.next;
    END (*--if*);
  END (*--while*);
END Intersection;
(*--------------------*)

PROCEDURE Difference    (    left    : Bag         (*-- in    *);
       	       	             right   : Bag         (*-- in    *);
                         VAR toBag   : Bag         (*-- inout *));

VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
      rightIndex  : Link;        (*-- Loop index over right bag *)
	  toIndex     : Link;        (*-- List of target bag nodes *)
	  tempNode    : Link;        (*-- Temporary for new node *)
	  compareItem : CompareProc; (*-- Item comparison routine *)
	  order       : Relation;    (*-- Ordering relation between items *)

BEGIN
  bagError := noerr;
  IF (left = NullBag) OR (right = NullBag) THEN
    RaiseErrIn(difference, undefined);
	RETURN;
  ELSIF (left^.dataID # right^.dataID) THEN
    RaiseErrIn(difference, typeerror);
	RETURN;
  ELSIF ~Recreate(toBag, left^.dataID) THEN
    RETURN;
  END (*--if*);
  
  compareItem := CompareOf(toBag^.dataID);
  bagRoutine := difference;

  leftIndex  := left^.first;
  rightIndex := right^.first;
  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
    order := compareItem(leftIndex^.item, rightIndex^.item);

    IF (order = equal) THEN
	  IF (leftIndex^.count > rightIndex^.count) THEN
	    tempNode := NewNode(leftIndex^.item,
		                    leftIndex^.count - rightIndex^.count,
							NullLink);
	    IF (bagError = overflow) THEN
	      RETURN;
	    END (*--if*);

	    TailInsert(tempNode, toBag^.first, toIndex);
	    INC(toBag^.length);
	  END (*--if*);

      leftIndex  := leftIndex^.next;
      rightIndex := rightIndex^.next;

    ELSIF (order = less) THEN
	  WITH leftIndex^ DO
	    tempNode := NewNode(item, count, NullLink);
	  END (*--with*);
	  IF (bagError # noerr) THEN
	    RETURN;
	  END (*--if*);
	  TailInsert(tempNode, toBag^.first, toIndex);
	  INC(toBag^.length);

      leftIndex  := leftIndex^.next;

    ELSE
      rightIndex := rightIndex^.next;
    END (*--if*);
  END (*--while*);

  (*-- Copy remaining items, if any, from the left bag to the
    -- destination bag. *)

  CopySubset(leftIndex, toIndex, toBag);
END Difference;
(*--------------------*)

PROCEDURE SymDifference (    left    : Bag         (*-- in    *);
       	       	             right   : Bag         (*-- in    *);
                         VAR toBag   : Bag         (*-- inout *));

VAR   leftIndex   : Link;        (*-- Loop index over left bag *)
      rightIndex  : Link;        (*-- Loop index over right bag *)
	  toIndex     : Link;        (*-- List of target bag nodes *)
	  tempNode    : Link;        (*-- Temporary node *)
	  compareItem : CompareProc; (*-- Item comparison routine *)
	  order       : Relation;    (*-- Ordering relation between items *)
	  newItem     : Item;        (*-- Either left/right item *)
	  newCount    : CARDINAL;    (*-- Either left/right count *)

BEGIN
  bagError := noerr;
  IF (left = NullBag) OR (right = NullBag) THEN
    RaiseErrIn(symdifference, undefined);
	RETURN;
  ELSIF (left^.dataID # right^.dataID) THEN
    RaiseErrIn(symdifference, typeerror);
	RETURN;
  ELSIF ~Recreate(toBag, left^.dataID) THEN
    RETURN;
  END (*--if*);
  
  compareItem := CompareOf(toBag^.dataID);

  bagRoutine := symdifference;
  leftIndex  := left^.first;
  rightIndex := right^.first;

  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
    order := compareItem(leftIndex^.item, rightIndex^.item);

    IF (order = equal) THEN
	  IF (leftIndex^.count > rightIndex^.count) THEN
	    WITH leftIndex^ DO
	      tempNode := NewNode(item, count - rightIndex^.count, NullLink);
	    END (*--with*);
	    IF (bagError = overflow) THEN
	      RETURN;
	    END (*--if*);

	    TailInsert(tempNode, toBag^.first, toIndex);
	    INC(toBag^.length);
	  END (*--if*);

      leftIndex  := leftIndex^.next;
      rightIndex := rightIndex^.next;

    ELSE
      IF (order = less) THEN
	    WITH leftIndex^ DO
	      newItem  := item;
		  newCount := count;
		END (*--with*);
        leftIndex := leftIndex^.next;
      ELSE
	    WITH rightIndex^ DO
	      newItem  := item;
		  newCount := count;
		END (*--with*);
        rightIndex := rightIndex^.next;
      END (*--if*);

	  tempNode := NewNode(newItem, newCount, NullLink);
      IF (tempNode = NullLink) THEN
        RETURN;
      END (*--if*);

	  TailInsert(tempNode, toBag^.first, toIndex);
      INC(toBag^.length);
    END (*--if*);
  END (*--while*);

  (*-- Copy remaining items, if any, from either the left bag or
    -- the right bag to the destination bag. *)

  IF (leftIndex = NullLink) THEN
    CopySubset(rightIndex, toIndex, toBag);
  ELSIF (rightIndex = NullLink) THEN
    CopySubset(leftIndex, toIndex, toBag);
  END (*--if*);
END SymDifference;
(*--------------------*)


    (*---------------------------------*)
    (*--         SELECTORS           --*)

PROCEDURE IsDefined     (    theBag  : Bag      (*-- in    *))
                                     : BOOLEAN  (*-- out   *);
BEGIN
  RETURN (theBag # NullBag);
END IsDefined;
(*--------------------*)

PROCEDURE IsEmpty       (    theBag  : Bag      (*-- in    *))
                                     : BOOLEAN  (*-- out   *);
BEGIN
  bagError := noerr;
  IF (theBag # NullBag) THEN
    RETURN (theBag^.length = 0);
  END (*--if*);

  RaiseErrIn(isempty, undefined);
  RETURN TRUE;
END IsEmpty;
(*--------------------*)

PROCEDURE TypeOf        (    theBag  : Bag      (*-- in    *))
                                     : TypeID   (*-- out   *);
BEGIN
  bagError := noerr;
  IF (theBag # NullBag) THEN
    RETURN theBag^.dataID;
  END (*--if*);

  RaiseErrIn(typeof, undefined);
  RETURN NullType;
END TypeOf;
(*--------------------*)

PROCEDURE IsEqual       (    left    : Bag      (*-- in    *);
                             right   : Bag      (*-- in    *))
                                     : BOOLEAN  (*-- out   *);

VAR   leftIndex : Link; (*-- Loop index over left bag items *)
      rightIndex: Link; (*-- Loop index over right bag items *)

BEGIN
  bagError := noerr;
  IF (left # NullBag) & (right # NullBag) THEN
    IF (left^.dataID = right^.dataID) THEN
      IF (left^.length = right^.length) THEN

        (*-- Scan both Bags looking for the first mismatch (inequality)
          -- which indicates that the Bags are unequal.
          -- If the WHILE loop completes then the Bags must be equal.
		  -- Because the lengths are equal, rightIndex will be NIL
		  -- when leftIndex is NIL. *)

        leftIndex := left^.first;
		rightIndex:= right^.first;
        WHILE (leftIndex # NullLink) DO
          IF (leftIndex^.item # rightIndex^.item) THEN
            RETURN FALSE;
          END (*--if*);
		  leftIndex := leftIndex^.next;
		  rightIndex:= rightIndex^.next;
        END (*--while*);
        RETURN TRUE;
	  END (*--if*);
	ELSE
      RaiseErrIn(isequal, typeerror);
    END (*--if*);
  ELSE
    RaiseErrIn(isequal, undefined);
  END (*--if*);

  (*-- the Bags must be unequal, either by having different
    -- lengths, mismatched types, or an undefined Bag exception. *)

  RETURN FALSE;
END IsEqual;
(*----------------------------*)

PROCEDURE NumMembers    (    theBag  : Bag         (*-- in    *))
                                     : CARDINAL    (*-- out   *);

VAR   current    : Link;
      totalCount : CARDINAL;

BEGIN
  bagError   := noerr;
  totalCount := 0;
  IF (theBag # NullBag) THEN
    current := theBag^.first;
    WHILE (current # NullLink) DO
      INC(totalCount, current^.count);
	  current := current^.next;
    END (*--while*);
  END (*--if*);

  RaiseErrIn(nummembers, undefined);
  RETURN totalCount;
END NumMembers;
(*----------------------------*)

PROCEDURE UniqueMembers (    theBag  : Bag      (*-- in    *))
                                     : CARDINAL (*-- out   *);
BEGIN
  bagError := noerr;
  IF (theBag # NullBag) THEN
    RETURN theBag^.length;
  END (*--if*);

  RaiseErrIn(uniquemembers, undefined);
  RETURN 0;
END UniqueMembers;
(*----------------------------*)

PROCEDURE IsAMember     (    theItem : Item        (*-- in    *);
       	       	             theBag  : Bag         (*-- in    *))
                                     : BOOLEAN     (*-- out   *);

VAR   index       : Link;        (*-- Loop index over items *)
	  compareItem : CompareProc; (*-- Item comparison routine *)
	  order       : Relation;    (*-- Ordering relation between items *)

BEGIN
  bagError := noerr;
  IF (theBag # NullBag) THEN
    WITH theBag^ DO
	  compareItem := CompareOf(dataID);
	  index := first;
	END (*--with*);
    WHILE (index # NullLink) DO
      IF (theItem = index^.item) THEN
        RETURN TRUE;
      ELSE
	    order := compareItem(index^.item, theItem);
        IF (order = greater) THEN
		  RETURN FALSE;
        END (*--if*);
      END (*--if*);
	  index := index^.next;
    END (*--while*);
  ELSE
    RaiseErrIn(ismember, undefined);
  END (*--if*);

  RETURN FALSE;
END IsAMember;
(*----------------------------*)

PROCEDURE NumberOf      (    theItem : Item     (*-- in    *);
       	       	             theBag  : Bag      (*-- in    *))
                                     : CARDINAL (*-- out   *);

VAR   index       : Link;        (*-- Loop index over items *)
	  compareItem : CompareProc; (*-- Item comparison routine *)
	  order       : Relation;    (*-- Ordering relation between items *)

BEGIN
  bagError := noerr;
  IF (theBag # NullBag) THEN
    WITH theBag^ DO
	  compareItem := CompareOf(dataID);
	  index := first;
	END (*--with*);
    WHILE (index # NullLink) DO
      IF (theItem = index^.item) THEN
        RETURN index^.count;
      ELSE
	    order := compareItem(index^.item, theItem);
        IF (order = greater) THEN
		  RETURN 0;
        END (*--if*);
      END (*--if*);
	  index := index^.next;
    END (*--while*);
  ELSE
    RaiseErrIn(numberof, undefined);
  END (*--if*);

  RETURN 0;
END NumberOf;
(*----------------------------*)

PROCEDURE IsSubset      (    left    : Bag         (*-- in    *);
                             right   : Bag         (*-- in    *))
                                     : BOOLEAN     (*-- out   *);

VAR   leftIndex   : Link;    (*-- Loop index over left bag *)
      rightIndex  : Link;    (*-- Loop index over right bag *)
	  compareItem : CompareProc; (*-- Item comparison routine *)
	  order       : Relation;    (*-- Ordering relation between items *)

BEGIN
  bagError := noerr;
  IF (left = NullBag) OR (right = NullBag) THEN
    RaiseErrIn(issubset, undefined);
    RETURN FALSE;
  ELSIF (left^.dataID # right^.dataID) THEN
    RaiseErrIn(issubset, typeerror);
    RETURN FALSE;
  END (*--if*);

  compareItem:= CompareOf(left^.dataID);
  leftIndex  := left^.first;
  rightIndex := right^.first;
  WHILE (leftIndex # NullLink) & (rightIndex # NullLink) DO
    order := compareItem(leftIndex^.item, rightIndex^.item);
    IF (order = equal) THEN
      leftIndex  := leftIndex^.next;
      rightIndex := rightIndex^.next;
    ELSIF (order = less) THEN
      RETURN FALSE;
    ELSE
      rightIndex := rightIndex^.next;
    END (*--if*);
  END (*--while*);
  RETURN (leftIndex = NullLink);
END IsSubset;
(*----------------------------*)

PROCEDURE IsProperSubset(    left    : Bag         (*-- in    *);
       	       	             right   : Bag         (*-- in    *))
                                     : BOOLEAN     (*-- out   *);
BEGIN
  RETURN IsSubset(left, right) & (left^.length < right^.length);
END IsProperSubset;
(*----------------------------*)


(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
(*~~ MODULE INITIALIZATION  ~~*)

BEGIN
  FOR bagError := MIN(Exceptions) TO MAX(Exceptions) DO
    handlers[bagError] := ExitOnError;
  END (*--for*);
  handlers[noerr] := NullHandler;
  bagError := noerr;
END BagSUUN.