IMPLEMENTATION MODULE Sets ;
(* Implements large set functions. *)

IMPORT Exceptions ;
FROM SYSTEM IMPORT BITSPERWORD , WORD ;

VAR
   ExceptionElementRange    : ARRAY [ 0..24 ] OF CHAR ;
   ExceptionUnequal         : ARRAY [ 0..24 ] OF CHAR ;


PROCEDURE Initialise( VAR Set : ARRAY OF BITSET ; Full : BOOLEAN ) ;
VAR
   Index                  : CARDINAL ;
BEGIN
   FOR Index := 0 TO HIGH( Set ) DO
      IF Full THEN
         Set[ Index ] := BITSET( -1 ) ;
      ELSE
         Set[ Index ] := { } ;
      END (* if *) ;
   END (* for *) ;
END Initialise ;


PROCEDURE Range( VAR Set : ARRAY OF BITSET ; From , To : WORD ) ;
VAR
   Index                  : CARDINAL ;
BEGIN
   IF ( CARDINAL( From ) >= ( HIGH( Set ) + 1 ) * BITSPERWORD )
      OR ( CARDINAL( To ) >= ( HIGH( Set ) + 1 ) * BITSPERWORD ) THEN
      Exceptions.RAISE( ExceptionElementRange ) ;
   END (* if *) ;
   Initialise( Set , FALSE ) ;
   FOR Index := CARDINAL( From ) TO CARDINAL( To ) DO
      Incl( Set , Index ) ;
   END (* for *) ;
END Range ;


PROCEDURE Equal( Set1 , Set2 : ARRAY OF BITSET ) : BOOLEAN ;
(*     Set1 = Set2                                         *)
VAR
   Index                  : CARDINAL ;
BEGIN
   IF HIGH( Set1 ) <> HIGH( Set2 ) THEN
      Exceptions.RAISE( ExceptionElementRange ) ;
      RETURN FALSE ;
   END (* if *) ;
   FOR Index := 0 TO HIGH( Set1 ) DO
      IF Set1[ Index ] <> Set2[ Index ] THEN
         RETURN FALSE ;
      END (* if *) ;
   END (* for *) ;
   RETURN TRUE ;
END Equal ;


PROCEDURE In( Element : WORD ; Set : ARRAY OF BITSET ) : BOOLEAN ;
(*     Element IN Set                                      *)
BEGIN
   IF CARDINAL( Element ) >= ( HIGH( Set ) + 1 ) * BITSPERWORD THEN
      Exceptions.RAISE( ExceptionElementRange ) ;
   END (* if *) ;
   RETURN ( CARDINAL( Element ) MOD BITSPERWORD ) IN
               Set[ CARDINAL( Element ) DIV BITSPERWORD ] ;
END In ;


PROCEDURE Excl( VAR Set : ARRAY OF BITSET ; Element : WORD ) ;
(*     EXCL( Set , Element )                               *)
BEGIN
   IF CARDINAL( Element ) >= ( HIGH( Set ) + 1 ) * BITSPERWORD THEN
      Exceptions.RAISE( ExceptionElementRange ) ;
   END (* if *) ;
   EXCL( Set[ CARDINAL( Element ) DIV BITSPERWORD ] ,
         CARDINAL( Element ) MOD BITSPERWORD ) ;
END Excl ;


PROCEDURE Incl( VAR Set : ARRAY OF BITSET ; Element : WORD ) ;
(*     INCL( Set , Element )                               *)
BEGIN
   IF CARDINAL( Element ) >= ( HIGH( Set ) + 1 ) * BITSPERWORD THEN
      Exceptions.RAISE( ExceptionElementRange ) ;
   END (* if *) ;
   INCL( Set[ CARDINAL( Element ) DIV BITSPERWORD ] ,
         CARDINAL( Element ) MOD BITSPERWORD ) ;
END Incl ;


PROCEDURE And( VAR Result : ARRAY OF BITSET ;
               Left , Right : ARRAY OF BITSET ) ;
(*     Result := Left * Right                              *)
VAR
   Index               : CARDINAL ;
BEGIN
   IF ( HIGH( Left ) = HIGH( Right ) )
   AND ( HIGH( Left ) = HIGH( Result ) ) THEN
      FOR Index := 0 TO HIGH( Result ) DO
         Result[ Index ] := Left[ Index ] * Right[ Index ] ;
      END (* for *) ;
   ELSE
      Exceptions.RAISE( ExceptionUnequal ) ;
   END (* if *) ;
END And ;


PROCEDURE AndNot( VAR Result : ARRAY OF BITSET ;
                  Left , Right : ARRAY OF BITSET ) ;
(*     Result := Left - Right                              *)
VAR
   Index               : CARDINAL ;
BEGIN
   IF ( HIGH( Left ) = HIGH( Right ) )
   AND ( HIGH( Left ) = HIGH( Result ) ) THEN
      FOR Index := 0 TO HIGH( Result ) DO
         Result[ Index ] := Left[ Index ] - Right[ Index ] ;
      END (* for *) ;
   ELSE
      Exceptions.RAISE( ExceptionUnequal ) ;
   END (* if *) ;
END AndNot ;


PROCEDURE Or( VAR Result : ARRAY OF BITSET ;
              Left , Right : ARRAY OF BITSET ) ;
(*     Result := Left + Right                              *)
VAR
   Index               : CARDINAL ;
BEGIN
   IF ( HIGH( Left ) = HIGH( Right ) )
   AND ( HIGH( Left ) = HIGH( Result ) ) THEN
      FOR Index := 0 TO HIGH( Result ) DO
         Result[ Index ] := Left[ Index ] + Right[ Index ] ;
      END (* for *) ;
   ELSE
      Exceptions.RAISE( ExceptionUnequal ) ;
   END (* if *) ;
END Or ;


PROCEDURE Exor( VAR Result : ARRAY OF BITSET ;
                  Left , Right : ARRAY OF BITSET ) ;
(*     Result := Left / Right                              *)
VAR
   Index               : CARDINAL ;
BEGIN
   IF ( HIGH( Left ) = HIGH( Right ) )
   AND ( HIGH( Left ) = HIGH( Result ) ) THEN
      FOR Index := 0 TO HIGH( Result ) DO
         Result[ Index ] := Left[ Index ] / Right[ Index ] ;
      END (* for *) ;
   ELSE
      Exceptions.RAISE( ExceptionUnequal ) ;
   END (* if *) ;
END Exor ;


BEGIN
   ExceptionElementRange := "Large Set element range";
   ExceptionUnequal := "Large Set sizes unequal";
END Sets.