Return to symbol_table.adb CVS log

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

Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Polynomials/symbol_table.adb, Revision 1.1

1.1     ! maekawa     1: with unchecked_deallocation;
        !             2:
        !             3: package body Symbol_Table is
        !             4:
        !             5: -- INTERNAL DATA :
        !             6:
        !             7:   type Symbol_Array is array(positive range <>) of Symbol;
        !             8:   type Symbol_Table ( max : natural ) is record
        !             9:     number : natural;     -- number of symbols that are not blank
        !            10:     syms : Symbol_Array(1..max);
        !            11:   end record;
        !            12:   type Link_to_Symbol_Table is access Symbol_Table;
        !            13:
        !            14:   st : Link_to_Symbol_Table;
        !            15:
        !            16: -- CREATORS :
        !            17:
        !            18:   procedure Init ( max : in natural ) is
        !            19:   begin
        !            20:     st := new Symbol_Table(max);
        !            21:     st.all.number := 0;
        !            22:   end Init;
        !            23:
        !            24:   procedure Enlarge ( max : in natural ) is
        !            25:   begin
        !            26:     if Empty
        !            27:      then Init(max);
        !            28:      else declare
        !            29:             oldst : Symbol_Array(1..st.number);
        !            30:             maxst : constant natural := max + st.max;
        !            31:           begin
        !            32:             for i in oldst'range loop
        !            33:               oldst(i) := st.syms(i);
        !            34:             end loop;
        !            35:             Clear;
        !            36:             Init(maxst);
        !            37:             for i in oldst'range loop
        !            38:               Add(oldst(i));
        !            39:             end loop;
        !            40:           end;
        !            41:     end if;
        !            42:   end Enlarge;
        !            43:
        !            44:   procedure Replace ( i : in natural; sb : in Symbol ) is
        !            45:
        !            46:     tab : Symbol_Table renames st.all;
        !            47:
        !            48:   begin
        !            49:     if i <= tab.number
        !            50:      then for j in sb'range loop
        !            51:             tab.syms(i)(j) := sb(j);
        !            52:           end loop;
        !            53:     end if;
        !            54:   end Replace;
        !            55:
        !            56: -- CONSTRUCTORS :
        !            57:
        !            58:   procedure Add ( sb : in Symbol; pos : out natural ) is
        !            59:
        !            60:     tab : Symbol_Table renames st.all;
        !            61:
        !            62:   begin
        !            63:     tab.number := tab.number + 1;
        !            64:     for i in sb'range loop
        !            65:       tab.syms(tab.number)(i) := sb(i);
        !            66:     end loop;
        !            67:     pos := tab.number;
        !            68:   exception
        !            69:     when others => raise OVERFLOW_IN_THE_SYMBOL_TABLE;
        !            70:   end Add;
        !            71:
        !            72:   procedure Add ( sb : in Symbol ) is
        !            73:
        !            74:     pos : natural;
        !            75:
        !            76:   begin
        !            77:     Add(sb,pos);
        !            78:   end Add;
        !            79:
        !            80:   procedure Remove ( sb : in Symbol ) is
        !            81:
        !            82:     pos : natural := Get(sb);
        !            83:
        !            84:   begin
        !            85:     Remove(pos);
        !            86:   end Remove;
        !            87:
        !            88:   procedure Remove ( i : in natural ) is
        !            89:
        !            90:     tab : Symbol_Table renames st.all;
        !            91:
        !            92:   begin
        !            93:     if ((i /= 0) and then (tab.number >= i))
        !            94:      then tab.number := tab.number - 1;                -- reduce #symbols
        !            95:           for j in i..tab.number loop                  -- shift symbol table
        !            96:             for k in tab.syms(j)'range loop
        !            97:               tab.syms(j)(k) := tab.syms(j+1)(k);
        !            98:             end loop;
        !            99:           end loop;
        !           100:     end if;
        !           101:   end Remove;
        !           102:
        !           103: -- SELECTORS :
        !           104:
        !           105:   function "<" ( s1,s2 : Symbol ) return boolean is
        !           106:   begin
        !           107:     for i in s1'range loop
        !           108:       if s1(i) < s2(i)
        !           109:        then return true;
        !           110:        elsif s1(i) > s2(i)
        !           111:            then return false;
        !           112:       end if;
        !           113:     end loop;
        !           114:     return false;
        !           115:   end "<";
        !           116:
        !           117:   function ">" ( s1,s2 : Symbol ) return boolean is
        !           118:   begin
        !           119:     for i in s1'range loop
        !           120:       if s1(i) > s2(i)
        !           121:        then return true;
        !           122:        elsif s1(i) < s2(i)
        !           123:            then return false;
        !           124:       end if;
        !           125:     end loop;
        !           126:     return false;
        !           127:   end ">";
        !           128:
        !           129:   function Maximal_Size return natural is
        !           130:   begin
        !           131:     if st = null
        !           132:      then return 0;
        !           133:      else return st.max;
        !           134:     end if;
        !           135:   end Maximal_Size;
        !           136:
        !           137:   function Number return natural is
        !           138:   begin
        !           139:     if st = null
        !           140:      then return 0;
        !           141:      else return st.all.number;
        !           142:     end if;
        !           143:   end Number;
        !           144:
        !           145:   function Empty return boolean is
        !           146:   begin
        !           147:     return (st = null);
        !           148:   end Empty;
        !           149:
        !           150:   function Get ( sb : Symbol ) return natural is
        !           151:
        !           152:     tab : Symbol_Table renames st.all;
        !           153:
        !           154:   begin
        !           155:     for i in 1..tab.number loop
        !           156:       if tab.syms(i) = sb
        !           157:        then return i;
        !           158:       end if;
        !           159:     end loop;
        !           160:     return 0;
        !           161:   end Get;
        !           162:
        !           163:   function Get ( i : natural ) return Symbol is
        !           164:
        !           165:     tab : Symbol_Table renames st.all;
        !           166:
        !           167:   begin
        !           168:     if i > tab.number
        !           169:      then raise INDEX_OUT_OF_RANGE;
        !           170:      else return tab.syms(i);
        !           171:     end if;
        !           172:   end Get;
        !           173:
        !           174: -- DESTRUCTOR :
        !           175:
        !           176:   procedure Clear is
        !           177:
        !           178:     procedure free is
        !           179:       new unchecked_deallocation (Symbol_Table,Link_to_Symbol_Table);
        !           180:
        !           181:   begin
        !           182:     free(st);
        !           183:   end Clear;
        !           184:
        !           185: end Symbol_Table;