![]() ![]() | ![]() |
File: [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Polynomials / symbol_table.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:27 2000 UTC (23 years, 10 months ago) by maekawa
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;