File : sets2.adb

package body Sets2 is

  IPrim: constant Int := Int(Prim);
  IPrim2: constant Int2 := Int2(Prim);

  function Empty return S_Set is
  begin
    return Int(0);
  end Empty;

  function Full return S_Set is
  begin
    return not Int(0);
  end Full;

  function Cardinality(S: S_Set) return Integer is
    T: Int := S;
    N: Integer := Integer(T mod 2);
  begin
    while T /= 0 loop
      T := T/2;
      N := N+Integer(T mod 2);
    end loop;
    return N;
  end Cardinality;

  function Contains(E: S_Element; S: S_Set) return Boolean is
  begin
    return S=(S or Int(2**E));
  end Contains;

  procedure AddElement(E: in S_Element; S: in out S_Set) is
  begin
    S := S or Int(2**E);
  end AddElement;

  procedure AddElements(S: in S_Set; T: in out S_Set) is
  begin
    T := T or S;
  end AddElements;

  procedure RmElement(E: in S_Element; S: in out S_Set) is
  begin
    S := S and not Int(2**E);
  end RmElement;

  procedure FillGap(N: in Positive; S: in out S_Set) is
    K: Integer := N;
    T: S_Set := 1;
  begin
    loop
      if (S and T)=Int(0) then
        K := K-1;
        if K=0 then S := (S or T); return; end if;
      end if;
      T := 2*T;
    end loop;
  end FillGap;

  procedure UnPack(S: in S_Set; U: out IVec; ULast: out Integer) is
    K: Integer := 0;
    T: Int := S;
  begin
    ULast := -1;
    loop
      if (T mod 2) /= 0 then
        ULast := ULast+1;
        U(ULast) := K;
      end if;
      T := T/2;
      exit when T=0;
      K := K+1;
    end loop;
  end UnPack;

  function ModP(S: S_Set) return PMod is
  begin
    return PMod(S mod IPrim);
  end ModP;

--------------------------

  function Empty return L_Set is
  begin
    return Int2(0);
  end Empty;

  function Full return L_Set is
  begin
    return not Int2(0);
  end Full;

  function Cardinality(S: L_Set) return Integer is
    T: Int2 := S;
    N: Integer := Integer(T mod 2);
  begin
    while T /= 0 loop
      T := T/2;
      N := N+Integer(T mod 2);
    end loop;
    return N;
  end Cardinality;

  function Contains(E: L_Element; S: L_Set) return Boolean is
  begin
    return S=(S or Int2(2**E));
  end Contains;

  procedure AddElement(E: in L_Element; S: in out L_Set) is
  begin
    S := S or Int2(2**E);
  end AddElement;

  procedure AddElements(S: in L_Set; T: in out L_Set) is
  begin
    T := T or S;
  end AddElements;

  procedure RmElement(E: in L_Element; S: in out L_Set) is
  begin
    S := S and not Int2(2**E);
  end RmElement;

  procedure FillGap(N: in Positive; S: in out L_Set) is
    K: Integer := N;
    T: L_Set := 1;
  begin
    loop
      if (S and T)=Int2(0) then
        K := K-1;
        if K=0 then S := (S or T); return; end if;
      end if;
      T := 2*T;
    end loop;
  end FillGap;

  procedure UnPack(S: in L_Set; U: out IVec; ULast: out Integer) is
    K: Integer := 0;
    T: Int2 := S;
  begin
    ULast := -1;
    loop
      if (T mod 2) /= 0 then
        ULast := ULast+1;
        U(ULast) := K;
      end if;
      T := T/2;
      exit when T=0;
      K := K+1;
    end loop;
  end UnPack;

  function ModP(S: L_Set) return PMod is
  begin
    return PMod(S mod IPrim2);
  end ModP;

begin

  if L_Last>63 then raise Constraint_Error; end if;

end Sets2;