File : sets1.adb

package body Sets1 is

  IPrim: constant Int := Int(Prim);

  function Empty return S_Set is
  begin
    return 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
    S: L_Set;
  begin
    for I in 0 .. ILast loop
      S(I) := 0;
    end loop;
    return S;
  end Empty;

  function Full return L_Set is
    S: L_Set;
  begin
    for I in 0 .. ILast loop
      S(I) := not Int(0);
    end loop;
    return S;
  end Full;

  function Cardinality(S: L_Set) return Integer is
    T: Int;
    N: Integer := 0;
  begin
    for I in 0 .. ILast loop
      T := S(I);
      for K in 0 .. 31 loop
        N := N+Integer(T mod 2);
        T := T/2;
      end loop;
    end loop;
    return N;
  end Cardinality;

  function Contains(E: L_Element; S: L_Set) return Boolean is
    Si: constant Int := S(E/32);
  begin
    return Si=(Si or Int(2**(E mod 32)));
  end Contains;

  procedure AddElement(E: in L_Element; S: in out L_Set) is
    I: constant Natural := E/32;
  begin
    S(I) := S(I) or Int(2**(E mod 32));
  end AddElement;

  procedure RmElement(E: in L_Element; S: in out L_Set) is
    I: constant Natural := E/32;
  begin
    S(I) := S(I) and not Int(2**(E mod 32));
  end RmElement;

  procedure FillGap(N: in Positive; S: in out L_Set) is
    K: Integer := N;
    T: Int;
  begin
    for I in 0 .. ILast loop
      T := 1;
      declare
        Si: constant Int := S(I);
      begin
        loop
          if (Si and T)=Int(0) then
            K := K-1;
            if K=0 then S(I) := (Si or T); return; end if;
          end if;
          T := 2*T;
          exit when T=Int(0);
        end loop;
      end;
    end loop;
  end FillGap;

  function ModP(S: L_Set) return PMod is
    Q: PMod := PMod(S(ILast) mod IPrim);
  begin
    for I in reverse 0 .. ILast-1 loop
      Q := PFac*Q+PMod(S(I) mod IPrim);
    end loop;
    return Q;
  end ModP;

end Sets1;