Return to symbol_table.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Polynomials

Import the second public release of PHCpack.

OKed by Jan Verschelde.

with unchecked_deallocation;

package body Symbol_Table is

-- INTERNAL DATA :

  type Symbol_Array is array(positive range <>) of Symbol;
  type Symbol_Table ( max : natural ) is record
    number : natural;     -- number of symbols that are not blank
    syms : Symbol_Array(1..max);
  end record;
  type Link_to_Symbol_Table is access Symbol_Table;

  st : Link_to_Symbol_Table;

-- CREATORS :

  procedure Init ( max : in natural ) is
  begin
    st := new Symbol_Table(max);
    st.all.number := 0;
  end Init;

  procedure Enlarge ( max : in natural ) is
  begin
    if Empty
     then Init(max);
     else declare
            oldst : Symbol_Array(1..st.number);
            maxst : constant natural := max + st.max;
          begin
            for i in oldst'range loop
              oldst(i) := st.syms(i);
            end loop;
            Clear;
            Init(maxst);
            for i in oldst'range loop
              Add(oldst(i));
            end loop;
          end;
    end if;
  end Enlarge;

  procedure Replace ( i : in natural; sb : in Symbol ) is

    tab : Symbol_Table renames st.all;

  begin
    if i <= tab.number
     then for j in sb'range loop
            tab.syms(i)(j) := sb(j);
          end loop;
    end if;
  end Replace;

-- CONSTRUCTORS :

  procedure Add ( sb : in Symbol; pos : out natural ) is

    tab : Symbol_Table renames st.all;

  begin
    tab.number := tab.number + 1;
    for i in sb'range loop
      tab.syms(tab.number)(i) := sb(i);
    end loop;
    pos := tab.number;
  exception
    when others => raise OVERFLOW_IN_THE_SYMBOL_TABLE;
  end Add;

  procedure Add ( sb : in Symbol ) is

    pos : natural;

  begin
    Add(sb,pos);
  end Add;

  procedure Remove ( sb : in Symbol ) is

    pos : natural := Get(sb);

  begin
    Remove(pos);
  end Remove;

  procedure Remove ( i : in natural ) is

    tab : Symbol_Table renames st.all;

  begin
    if ((i /= 0) and then (tab.number >= i))
     then tab.number := tab.number - 1;                -- reduce #symbols
          for j in i..tab.number loop                  -- shift symbol table
            for k in tab.syms(j)'range loop
              tab.syms(j)(k) := tab.syms(j+1)(k);
            end loop;
          end loop;
    end if;
  end Remove;

-- SELECTORS :

  function "<" ( s1,s2 : Symbol ) return boolean is
  begin
    for i in s1'range loop
      if s1(i) < s2(i)
       then return true;
       elsif s1(i) > s2(i)
           then return false;
      end if;
    end loop;
    return false;
  end "<";

  function ">" ( s1,s2 : Symbol ) return boolean is
  begin
    for i in s1'range loop
      if s1(i) > s2(i)
       then return true;
       elsif s1(i) < s2(i)
           then return false;
      end if;
    end loop;
    return false;
  end ">";

  function Maximal_Size return natural is
  begin
    if st = null
     then return 0;
     else return st.max;
    end if;
  end Maximal_Size;

  function Number return natural is
  begin
    if st = null
     then return 0;
     else return st.all.number;
    end if;
  end Number;
  
  function Empty return boolean is
  begin
    return (st = null);
  end Empty;

  function Get ( sb : Symbol ) return natural is

    tab : Symbol_Table renames st.all;

  begin
    for i in 1..tab.number loop
      if tab.syms(i) = sb
       then return i;
      end if;
    end loop;
    return 0;
  end Get;

  function Get ( i : natural ) return Symbol is

    tab : Symbol_Table renames st.all;

  begin
    if i > tab.number
     then raise INDEX_OUT_OF_RANGE;
     else return tab.syms(i);
    end if;
  end Get;

-- DESTRUCTOR :

  procedure Clear is

    procedure free is 
      new unchecked_deallocation (Symbol_Table,Link_to_Symbol_Table);

  begin
    free(st);
  end Clear;

end Symbol_Table;