Fresh Fish 10/Fresh_Fish_10_2352.bin/new/dev/obero/oberon-a/source/library/sets.mod

Text File | 1995-06-29 | 11KB | 473 lines

(*************************************************************************

     $RCSfile: Sets.mod $
  Description: A general module for handling sets of all sizes.

   Created by: fjc (Frank Copeland)
    $Revision: 1.4 $
      $Author: fjc $
        $Date: 1995/06/04 23:22:41 $

  Copyright © 1994-1995, Frank Copeland.
  This file is part of the Oberon-A Library.
  See Oberon-A.doc for conditions of use and distribution.

*************************************************************************)

<* STANDARD- *>

MODULE Sets;

(**
** This module serves a number of purposes. It first of all attempts to
** provide a portable interface to the non-standard set variants used by
** a number of Oberon compilers. It also implements a Set class to handle
** sets of any arbitrary size. This is based on an example in Mössenböck's
** "Object-oriented Programming in Oberon-2". Finally, it provides an
** extension of the Set class that emulates Modula-2's SET OF CHAR.
*)

(**
** Portable set variants.
**
** The following types are aliases intended to provide a portable
** interface to the non-standard set types provided by many Oberon
** compilers.
**
** The problem is this: Oberon defines only one set type, which is
** typically implemented as the "natural" word size of the host machine.
** However, many compilers provide set variants in different sizes. The
** logical type hierarchy is LONGSET <- SET <- SHORTSET, with LONGSET
** being 32 bits, SET 16 bits and SHORTSET 8 bits. Unfortunately, the
** Oakwood Report and the defacto standard OP2 compiler do not provide
** for variants, and use 32 bits for SET types. Oberon-A follows this
** standard by making SET 32 bits, but it also provides 16 and 8 bit
** variants, which makes it incompatible with other compilers that use the
** LONGSET/SET/SHORTSET system.
**
** The objective of this module is to provide a portable interface to
** such set variants that can be used with different compilers. The
** implementation will vary depending on the compiler being used, and if a
** particular sized set is not provided it must be emulated.
*)

IMPORT SYSTEM;

TYPE

  SET8  *= SYSTEM.BYTESET;
  SET16 *= SYSTEM.WORDSET;
  SET32 *= SET;


(**
** The Set type defines a class that can be used to create and manage sets
** of any arbitrary size. It is based directly on an example in chapter
** 4.3 of "Object-oriented Programming in Oberon-2".
*)

CONST setSize = MAX (SET) + 1;

TYPE

  Set *= RECORD
    max -: INTEGER; (* Largest element allowed *)
    val : POINTER TO ARRAY OF SET;
  END; (* Set *)


(**
** The CharSet class extends the Set class to allow for sets of ASCII
** characters, emulating the SET OF CHAR type that was possible in most
** Modula-2s.
*)

TYPE

  CharSet *= RECORD (Set) END;


(**
** The following procedures implement the basic set operations:
**
**   - assigning the empty set : s := {}      -> Clear? (s)
**   - assigning a set value   : s := s1      -> Copy? (s, s1)
**   - including an element    : INCL (s, i)  -> Incl? (s, i)
**   - excluding an element    : EXCL (s, i)  -> Excl? (s, i)
**   - set union               : s := s1 + s2 -> s := Add? (s1, s2)
**   - set difference          : s := s1 - s2 -> s := Subtract? (s1, s2)
**   - set intersection        : s := s1 * s2 -> s := Intersect? (s1, s2)
**   - symmetric differnece    : s := s1 / s2 -> s := SymDiff? (s1, s2)
**   - set membership          : i IN s       -> In? (s, i)
**
** Three versions of each procedure are provided, one for each set type.
** Most of these procedures may seem unnecessary, as they are implemented
** directly using normal set operations. However, when using a compiler
** that does not provide any or all of the set variants as extensions, the
** operations must be implemented using other types, such as SYSTEM.BYTE.
** The procedures allow code using this module to be ported to such a
** compiler without change, as the details of the implementation are
** wrapped in a procedure interface.
**
** Type conversion functions are also provided:
**
**   - 8 bit  -> 16 bit : Long8()
**   - 16 bit -> 32 bit : Long16()
**   - 16 bit -> 8 bit  : Short16()
**   - 32 bit -> 16 bit : Short32()
*)

PROCEDURE Clear8 * ( VAR s : SET8 );
BEGIN (* Clear8 *)
  s := {}
END Clear8;


PROCEDURE Copy8 * ( VAR s1 : SET8; s2 : SET8 );
BEGIN (* Copy8 *)
  s1 := s2
END Copy8;


PROCEDURE Incl8 * ( VAR s : SET8; i : INTEGER );
BEGIN (* Incl8 *)
  INCL (s, i)
END Incl8;


PROCEDURE Excl8 * ( VAR s : SET8; i : INTEGER );
BEGIN (* Excl8 *)
  EXCL (s, i)
END Excl8;


PROCEDURE Add8 * ( s1, s2 : SET8 ) : SET8;
BEGIN (* Add8 *)
  RETURN s1 + s2
END Add8;


PROCEDURE Subtract8 * ( s1, s2 : SET8 ) : SET8;
BEGIN (* Subtract8 *)
  RETURN s1 - s2
END Subtract8;


PROCEDURE Intersect8 * ( s1, s2 : SET8 ) : SET8;
BEGIN (* Intersect8 *)
  RETURN s1 * s2
END Intersect8;


PROCEDURE SymDiff8 * ( s1, s2 : SET8 ) : SET8;
BEGIN (* SymDiff8 *)
  RETURN s1 / s2
END SymDiff8;


PROCEDURE In8 * ( s1 : SET8; i : INTEGER ) : BOOLEAN;
BEGIN (* In8 *)
  RETURN i IN s1
END In8;


PROCEDURE Clear16 * ( VAR s : SET16 );
BEGIN (* Clear16 *)
  s := {}
END Clear16;


PROCEDURE Copy16 * ( VAR s1 : SET16; s2 : SET16 );
BEGIN (* Copy16 *)
  s1 := s2
END Copy16;


PROCEDURE Incl16 * ( VAR s : SET16; i : INTEGER );
BEGIN (* Incl16 *)
  INCL (s, i)
END Incl16;


PROCEDURE Excl16 * ( VAR s : SET16; i : INTEGER );
BEGIN (* Excl16 *)
  EXCL (s, i)
END Excl16;


PROCEDURE Add16 * ( s1, s2 : SET16 ) : SET16;
BEGIN (* Add16 *)
  RETURN s1 + s2
END Add16;


PROCEDURE Subtract16 * ( s1, s2 : SET16 ) : SET16;
BEGIN (* Subtract16 *)
  RETURN s1 - s2
END Subtract16;


PROCEDURE Intersect16 * ( s1, s2 : SET16 ) : SET16;
BEGIN (* Intersect16 *)
  RETURN s1 * s2
END Intersect16;


PROCEDURE SymDiff16 * ( s1, s2 : SET16 ) : SET16;
BEGIN (* SymDiff16 *)
  RETURN s1 / s2
END SymDiff16;


PROCEDURE In16 * ( s1 : SET16; i : INTEGER ) : BOOLEAN;
BEGIN (* In16 *)
  RETURN i IN s1
END In16;


PROCEDURE Clear32 * ( VAR s : SET32 );
BEGIN (* Clear32 *)
  s := {}
END Clear32;


PROCEDURE Copy32 * ( VAR s1 : SET32; s2 : SET32 );
BEGIN (* Copy32 *)
  s1 := s2
END Copy32;


PROCEDURE Incl32 * ( VAR s : SET32; i : INTEGER );
BEGIN (* Incl32 *)
  INCL (s, i)
END Incl32;


PROCEDURE Excl32 * ( VAR s : SET32; i : INTEGER );
BEGIN (* Excl32 *)
  EXCL (s, i)
END Excl32;


PROCEDURE Add32 * ( s1, s2 : SET32 ) : SET32;
BEGIN (* Add32 *)
  RETURN s1 + s2
END Add32;


PROCEDURE Subtract32 * ( s1, s2 : SET32 ) : SET32;
BEGIN (* Subtract32 *)
  RETURN s1 - s2
END Subtract32;


PROCEDURE Intersect32 * ( s1, s2 : SET32 ) : SET32;
BEGIN (* Intersect32 *)
  RETURN s1 * s2
END Intersect32;


PROCEDURE SymDiff32 * ( s1, s2 : SET32 ) : SET32;
BEGIN (* SymDiff32 *)
  RETURN s1 / s2
END SymDiff32;


PROCEDURE In32 * ( s1 : SET32; i : INTEGER ) : BOOLEAN;
BEGIN (* In32 *)
  RETURN i IN s1
END In32;


PROCEDURE Long8 * ( s : SET8 ) : SET16;
BEGIN (* Long8 *)
  RETURN LONG (s)
END Long8;


PROCEDURE Long16 * ( s : SET16 ) : SET32;
BEGIN (* Long16 *)
  RETURN LONG (s)
END Long16;


PROCEDURE Short16 * ( s : SET16 ) : SET8;
BEGIN (* Short16 *)
  RETURN SHORT (s)
END Short16;


PROCEDURE Short32 * ( s : SET32 ) : SET16;
BEGIN (* Short32 *)
  RETURN SHORT (s)
END Short32;


<*$IndexChk-*>

PROCEDURE (VAR s : Set) Init * ( max : INTEGER );
BEGIN (* Init *)
  s.max := max;
  NEW (s.val, (max + setSize) DIV setSize)
END Init;


PROCEDURE (VAR s : Set) CopyTo * ( VAR s1 : Set );
  VAR i : INTEGER;
BEGIN (* CopyTo *)
  s1.Init (s.max);
  FOR i := 0 TO s.max DIV setSize DO s1.val [i] := s.val [i] END
END CopyTo;


PROCEDURE (VAR s : Set) Clear *;
  VAR i : INTEGER;
BEGIN (* Clear *)
  FOR i := 0 TO s.max DIV setSize DO s.val [i] := {} END
END Clear;


PROCEDURE (VAR s : Set) Incl * ( x : INTEGER );
BEGIN (* Incl *)
  IF (x > 0) & (x <= s.max) THEN
    INCL (s.val [x DIV setSize], x MOD setSize)
  END
END Incl;


PROCEDURE (VAR s : Set) InclRange * ( x, y : INTEGER );
  VAR i : INTEGER;
BEGIN (* InclRange *)
  IF y < x THEN i := x; x := y; y := i END;
  IF x < 0 THEN x := 0 END; IF y > s.max THEN y := s.max END;
  FOR i := x TO y DO
    INCL (s.val [i DIV setSize], i MOD setSize)
  END
END InclRange;


PROCEDURE (VAR s : Set) Excl * ( x : INTE