![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to symbol_table.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Polynomials|
Return to symbol_table.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Polynomials |
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;