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;