#
#  File: set.k3
#  Handles sets of booleans
#
#  Copyright 2005 Radboud University of Nijmegen
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU Library General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#  CVS ID: "$Id: set.k3,v 1.6 2005/10/19 15:30:33 marcs Exp $"
#
MODULE set = SIZE BITS.

DEFINES	SET,
	ACTION store set size (>INT),
	FUNCTION convert >INT to SET>,
	#FUNCTION convert >SET to INT>,
        FUNCTION convert >SET to hex TEXT>,
	FUNCTION convert >SET to TEXT>,
	FUNCTION convert >TEXT to SET>,
	FUNCTION empty (SET>),
	FUNCTION or >SET> with >SET1,
	FUNCTION and >SET> with >SET1,
	FUNCTION assign >SET1 and >SET2 to SET>,
	FUNCTION invert (>SET>),
	TEST check on max affix size,
	TEST is equal (>SET1, >SET2),
	TEST is disjoint (>SET1, >SET2),
	TEST is subset (>SET1, >SET2),
	TEST is empty (>SET),
	TEST is undefined (>SET),
	TEST is non empty (>SET).

USES globals, io.

######################### NOTICE ##########################
# Most of the routines in this file, occur in set.k3 of   #
# the lexgen2 system. They are indicated by a remark      #
# '*Lexgen2*'.Every change to these routines              #
# MUST be applied to set.k3 of the lexgen2 system as well #
########################################################### 

# CDL3 integers are 32 bits long
# Maximum set size is 4*32

SET :: INT INT INT INT;
       empty.

FUNCTION get words per set (INT>):
  [4 -> INT].	# number of words used for set definition

BITS = INT.
SIZE = INT.

PRELUDE init set:
  [ 32 -> BITS ].
#  get bits per word (INT),
#    [INT -> BITS].

# TODO: Is this correct? Why no error for e.g. 33%32=1?

ACTION store set size (>INT):
  [INT % BITS -> SIZE],
    get words per set (INT2),
      (greater (SIZE, INT2),
         convert INT to TEXT,
         convert (INT2 * BITS) to TEXT1,
         abort ("Set size (" + TEXT + ") too big, maximum size is " + TEXT1);
       +).

#*Lexgen2*#
FUNCTION convert >INT to SET>:
  [1<<(INT%%BITS)->INT1],
    (less(INT,BITS),
       [0 0 0 INT1->SET];
     less(INT,BITS*2),
       [0 0 INT1 0->SET];
     less(INT,BITS*3),
       [0 INT1 0 0->SET];
     [INT1 0 0 0->SET]).

TEST check on max affix size:
  less (SIZE, 2).

FUNCTION convert >SET to hex TEXT>:
  convert SET to TEXT,
    ["0x" + TEXT -> TEXT].

FUNCTION convert >SET to TEXT>:
  [SET->INT4 INT3 INT2 INT1],
    binhex(INT1,TEXT),
    (greater(SIZE,1),
       binhex(INT2,TEXT1),
       [TEXT1+"@"+TEXT->TEXT],
       (greater(SIZE,2),
          binhex(INT3,TEXT1),
          [TEXT1+"@"+TEXT->TEXT],
          (greater(SIZE,3),
             binhex(INT4,TEXT1),
             [TEXT1+"@"+TEXT->TEXT];
           +);
        +);
     +);
  ["empty"->TEXT].

FUNCTION split (>TEXT, TEXT4>, TEXT3>, TEXT2>, TEXT1>):
  length (TEXT, INT),
    (less (INT, 8),
       abort ("Strange hexdecimal value"),
       !;
     greater (INT, 26),
       extract (TEXT, 0, 8, TEXT4),
       extract (TEXT, 9, 17, TEXT3),
       extract (TEXT, 18, 26, TEXT2),
       extract (TEXT, 27, INT, TEXT1);
     ["00000000" -> TEXT4],
       (greater (INT, 17),
          extract (TEXT, 0, 8, TEXT3),
          extract (TEXT, 9, 17, TEXT2),
          extract (TEXT, 18, INT, TEXT1);
        [TEXT4 -> TEXT3],
          (greater (INT, 8),
             extract (TEXT, 0, 8, TEXT2),
             extract (TEXT, 9, INT, TEXT1);
           [TEXT3 -> TEXT2],
             [TEXT -> TEXT1]))).

FUNCTION convert  >TEXT to  SET>:
  is prefix ("0x", TEXT, TEXT),
    split (TEXT, TEXT4, TEXT3, TEXT2, TEXT1),
    hexbin (TEXT4, INT4),
    hexbin (TEXT3, INT3),
    hexbin (TEXT2, INT2),
    hexbin (TEXT1, INT1),
    [INT4 INT3 INT2 INT1 -> SET];
  abort ("Wrong hexnumber in 'convert >TEXT to SET>'"),
    [empty -> SET], 
    !.

FUNCTION empty (SET>):
  [empty -> SET].

#*Lexgen2*#
FUNCTION or >SET> with >SET1:
  [SET1->empty];
  [SET1->INT1 INT2 INT3 INT4],
    ([SET->empty],
       [SET1->SET];
     [SET->INT5 INT6 INT7 INT8],
       [INT1||INT5 INT2||INT6 INT3||INT7 INT4||INT8->SET];
     ?);
  ?.

#*Lexgen2*#
FUNCTION and >SET> with >SET1:
  [SET1->INT1 INT2 INT3 INT4],
    [SET->INT5 INT6 INT7 INT8],
    [INT1&INT5 INT2&INT6 INT3&INT7 INT4&INT8->SET];
  ?.

#*Lexgen2*#
FUNCTION assign >SET1 and >SET2 to SET>:
  [SET1->INT1 INT2 INT3 INT4],
    [SET2->INT5 INT6 INT7 INT8],
    [INT1&INT5 INT2&INT6 INT3&INT7 INT4&INT8->SET];
  ?.

TEST is subset (>SET1, >SET2):
  assign SET1 and SET2 to SET,
    [SET1 = SET].

#*Lexgen2*#
FUNCTION invert (>SET>):
  [SET -> INT1 INT2 INT3 INT4],
    [~INT1 ~INT2 ~INT3 ~INT4 -> SET];
  ?.

#*Lexgen2*#
TEST is disjoint (>SET1, >SET2):
  [SET1->INT1 INT2 INT3 INT4],
    ([SET2->INT5 INT6 INT7 INT8],
       [(INT1&INT5)||(INT2&INT6)||(INT3&INT7)||(INT4&INT8)->INT],
       ([INT->0],
          +;
        -);
     ?);
  ?.

#*Lexgen2*#
TEST is non empty (>SET):
  [SET -> INT1 INT2 INT3 INT4],
    ([INT1 -> 0],
       [INT2 -> 0],
       [INT3 -> 0],
       [INT4 -> 0],
       -;
     +);
  ?.

#*Lexgen2*#
TEST is empty (>SET):
  [SET -> INT1 INT2 INT3 INT4],
    ([INT1 -> 0],
       [INT2 -> 0],
       [INT3 -> 0],
       [INT4 -> 0]);
  ?.

TEST is undefined (>SET):
  [SET -> empty].

TEST is equal (>SET1, >SET2):
  [SET1 -> INT1 INT2 INT3 INT4],
    [SET2 -> INT5 INT6 INT7 INT8],
      ([INT1 = INT5],
         [INT2 = INT6],
         [INT3 = INT7],
         [INT4 = INT8];
       -);
  ?.
