Subversion Repositories tendra.SVN

Rev

Rev 2 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 2 Rev 7
Line -... Line 1...
- 
 
 1 
/*
- 
 
 2 
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
- 
 
 3 
 * All rights reserved.
- 
 
 4 
 *
- 
 
 5 
 * Redistribution and use in source and binary forms, with or without
- 
 
 6 
 * modification, are permitted provided that the following conditions are met:
- 
 
 7 
 *
- 
 
 8 
 * 1. Redistributions of source code must retain the above copyright notice,
- 
 
 9 
 *    this list of conditions and the following disclaimer.
- 
 
 10 
 * 2. Redistributions in binary form must reproduce the above copyright notice,
- 
 
 11 
 *    this list of conditions and the following disclaimer in the documentation
- 
 
 12 
 *    and/or other materials provided with the distribution.
- 
 
 13 
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
- 
 
 14 
 *    may be used to endorse or promote products derived from this software
- 
 
 15 
 *    without specific, prior written permission.
- 
 
 16 
 *
- 
 
 17 
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
- 
 
 18 
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
- 
 
 19 
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
- 
 
 20 
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
- 
 
 21 
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
- 
 
 22 
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- 
 
 23 
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- 
 
 24 
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- 
 
 25 
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- 
 
 26 
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- 
 
 27 
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- 
 
 28 
 *
- 
 
 29 
 * $Id$
- 
 
 30 
 */
1 
/*
 31 
/*
2 
    		 Crown Copyright (c) 1997
 32 
    		 Crown Copyright (c) 1997
3
33 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
 34 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
 35 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
 36 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
 37 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
 38 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
 39 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
 40 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
 41 
    shall be deemed to be acceptance of the following conditions:-
12
42 
 
13 
        (1) Its Recipients shall ensure that this Notice is
 43 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
 44 
        reproduced upon any copies or amended versions of it;
15
45 
 
16 
        (2) Any amended version of it shall be clearly marked to
 46 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
 47 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
 48 
        for the relevant amendment or amendments;
19
49 
 
20 
        (3) Its onward transfer from a recipient to another
 50 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
 51 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
 52 
        these conditions;
23
53 
 
24 
        (4) DERA gives no warranty or assurance as to its
 54 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
 55 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
 56 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
 57 
        it may be put.
28 
*/
 58 
*/
Line 44... Line 74...
44 
    BASIC SHAPES
 74 
    BASIC SHAPES
45 
 
 75 
 
46 
    These shapes are fixed.
 76 
    These shapes are fixed.
47 
*/
 77 
*/
48 
 
 78 
 
49 
node *sh_bottom = null ;
 79 
node *sh_bottom = null;
50 
node *sh_proc = null ;
 80 
node *sh_proc = null;
51 
node *sh_top = null ;
 81 
node *sh_top = null;
52 
 
 82 
 
53 
 
 83 
 
54 
/*
 84 
/*
55 
    INITIALIZE BASIC SHAPES
 85 
    INITIALIZE BASIC SHAPES
56 
 
 86 
 
57 
    This routine initializes the basic shapes above.
 87 
    This routine initializes the basic shapes above.
58 
*/
 88 
*/
59 
 
 89 
 
60 
void init_shapes
 90 
void
61 
    PROTO_Z ()
 91 
init_shapes(void)
62 
{
 92 
{
63 
    if ( sh_bottom == null ) {
 93 
    if (sh_bottom == null) {
64 
	/* Construct sh_bottom */
 94 
	/* Construct sh_bottom */
65 
	sh_bottom = new_node () ;
 95 
	sh_bottom = new_node();
66 
	sh_bottom->cons = cons_no ( SORT_shape, ENC_bottom ) ;
 96 
	sh_bottom->cons = cons_no(SORT_shape, ENC_bottom);
67 
 
 97 
 
68 
	/* Construct sh_proc */
 98 
	/* Construct sh_proc */
69 
	sh_proc = new_node () ;
 99 
	sh_proc = new_node();
70 
	sh_proc->cons = cons_no ( SORT_shape, ENC_proc ) ;
 100 
	sh_proc->cons = cons_no(SORT_shape, ENC_proc);
71 
 
 101 
 
72 
	/* Construct sh_top */
 102 
	/* Construct sh_top */
73 
	sh_top = new_node () ;
 103 
	sh_top = new_node();
74 
	sh_top->cons = cons_no ( SORT_shape, ENC_top ) ;
 104 
	sh_top->cons = cons_no(SORT_shape, ENC_top);
75 
 
 105 
 
76 
	/* Initialize alignments */
 106 
	/* Initialize alignments */
77 
	init_alignments () ;
 107 
	init_alignments();
78 
    }
 108 
    }
79 
    return ;
 109 
    return;
80 
}
 110 
}
81 
 
 111 
 
82 
 
 112 
 
83 
/*
 113 
/*
84 
    CREATE A NAT CORRESPONDING TO THE LENGTH OF STRING s
 114 
    CREATE A NAT CORRESPONDING TO THE LENGTH OF STRING s
85 
 
 115 
 
86 
    This routine returns a nat giving the length of the string s or the
 116 
    This routine returns a nat giving the length of the string s or the
87 
    null node if this cannot be found.
 117 
    null node if this cannot be found.
88 
*/
 118 
*/
89 
 
 119 
 
90 
node *string_length
 120 
node *
91 
    PROTO_N ( ( s ) )
 - 
 
92 
    PROTO_T ( node *s )
 121 
string_length(node *s)
93 
{
 122 
{
94 
    if ( s->cons->encoding == ENC_make_string ) {
 123 
    if (s->cons->encoding == ENC_make_string) {
95 
	node *str = s->son ;
 124 
	node *str = s->son;
96 
	long n = str->cons->encoding ;
 125 
	long n = str->cons->encoding;
97 
	if ( n == -1 ) {
 126 
	if (n == -1) {
98 
	    str = str->son->bro ;
 127 
	    str = str->son->bro;
99 
	    n = str->cons->encoding ;
 128 
	    n = str->cons->encoding;
100 
	}
 129 
	}
101 
	return ( make_nat ( n ) ) ;
 130 
	return(make_nat(n));
102 
    }
 131 
    }
103 
    return ( null ) ;
 132 
    return(null);
104 
}
 133 
}
105 
 
 134 
 
106 
 
 135 
 
107 
/*
 136 
/*
108 
    COPY A NODE
 137 
    COPY A NODE
109 
 
 138 
 
110 
    This routine makes a copy of the node p.
 139 
    This routine makes a copy of the node p.
111 
*/
 140 
*/
112 
 
 141 
 
113 
node *copy_node
 142 
node *
114 
    PROTO_N ( ( p ) )
 - 
 
115 
    PROTO_T ( node *p )
 143 
copy_node(node *p)
116 
{
 144 
{
117 
    node *q ;
 145 
    node *q;
118 
    if ( p == null ) return ( null ) ;
 146 
    if (p == null) return(null);
119 
    q = new_node () ;
 147 
    q = new_node();
120 
    if ( p->cons->alias ) {
 148 
    if (p->cons->alias) {
121 
	q->cons = p->cons->alias ;
 149 
	q->cons = p->cons->alias;
122 
    } else {
 150 
    } else {
123 
	q->cons = p->cons ;
 151 
	q->cons = p->cons;
124 
    }
 152 
    }
125 
    q->son = p->son ;
 153 
    q->son = p->son;
126 
    q->shape = p->shape ;
 154 
    q->shape = p->shape;
127 
    return ( q ) ;
 155 
    return(q);
128 
}
 156 
}
129 
 
 157 
 
130 
 
 158 
 
131 
/*
 159 
/*
132 
    FORM AN INTEGER SHAPE
 160 
    FORM AN INTEGER SHAPE
133 
 
 161 
 
134 
    This routine creates an integer shape from a variety p.
 162 
    This routine creates an integer shape from a variety p.
135 
*/
 163 
*/
136 
 
 164 
 
137 
node *sh_integer
 165 
node *
138 
    PROTO_N ( ( p ) )
 - 
 
139 
    PROTO_T ( node *p )
 166 
sh_integer(node *p)
140 
{
 167 
{
141 
    node *q = new_node () ;
 168 
    node *q = new_node();
142 
    q->cons = cons_no ( SORT_shape, ENC_integer ) ;
 169 
    q->cons = cons_no(SORT_shape, ENC_integer);
143 
    q->son = new_node () ;
 170 
    q->son = new_node();
144 
    if ( p == null ) {
 171 
    if (p == null) {
145 
	q->son->cons = &unknown_cons ;
 172 
	q->son->cons = &unknown_cons;
146 
    } else {
 173 
    } else {
147 
	q->son->cons = p->cons ;
 174 
	q->son->cons = p->cons;
148 
	q->son->son = p->son ;
 175 
	q->son->son = p->son;
149 
    }
 176 
    }
150 
    return ( q ) ;
 177 
    return(q);
151 
}
 178 
}
152 
 
 179 
 
153 
 
 180 
 
154 
/*
 181 
/*
155 
    FORM A FLOATING SHAPE
 182 
    FORM A FLOATING SHAPE
156 
 
 183 
 
157 
    This routine creates a floating shape from a floating variety p.
 184 
    This routine creates a floating shape from a floating variety p.
158 
*/
 185 
*/
159 
 
 186 
 
160 
node *sh_floating
 187 
node *
161 
    PROTO_N ( ( p ) )
 - 
 
162 
    PROTO_T ( node *p )
 188 
sh_floating(node *p)
163 
{
 189 
{
164 
    node *q = new_node () ;
 190 
    node *q = new_node();
165 
    q->cons = cons_no ( SORT_shape, ENC_floating ) ;
 191 
    q->cons = cons_no(SORT_shape, ENC_floating);
166 
    q->son = new_node () ;
 192 
    q->son = new_node();
167 
    if ( p == null ) {
 193 
    if (p == null) {
168 
	q->son->cons = &unknown_cons ;
 194 
	q->son->cons = &unknown_cons;
169 
    } else {
 195 
    } else {
170 
	q->son->cons = p->cons ;
 196 
	q->son->cons = p->cons;
171 
	q->son->son = p->son ;
 197 
	q->son->son = p->son;
172 
    }
 198 
    }
173 
    return ( q ) ;
 199 
    return(q);
174 
}
 200 
}
175 
 
 201 
 
176 
 
 202 
 
177 
/*
 203 
/*
178 
    FORM A POINTER SHAPE
 204 
    FORM A POINTER SHAPE
179 
 
 205 
 
180 
    This routine creates a pointer shape from an alignment p or a shape p.
 206 
    This routine creates a pointer shape from an alignment p or a shape p.
181 
*/
 207 
*/
182 
 
 208 
 
183 
node *sh_pointer
 209 
node *
184 
    PROTO_N ( ( p ) )
 - 
 
185 
    PROTO_T ( node *p )
 210 
sh_pointer(node *p)
186 
{
 211 
{
187 
    node *q = new_node () ;
 212 
    node *q = new_node();
188 
    q->cons = cons_no ( SORT_shape, ENC_pointer ) ;
 213 
    q->cons = cons_no(SORT_shape, ENC_pointer);
189 
    q->son = new_node () ;
 214 
    q->son = new_node();
190 
    p = al_shape ( p ) ;
 215 
    p = al_shape(p);
191 
    if ( p == null ) {
 216 
    if (p == null) {
192 
	q->son->cons = &unknown_cons ;
 217 
	q->son->cons = &unknown_cons;
193 
    } else {
 218 
    } else {
194 
	q->son->cons = p->cons ;
 219 
	q->son->cons = p->cons;
195 
	q->son->son = p->son ;
 220 
	q->son->son = p->son;
196 
    }
 221 
    }
197 
    return ( q ) ;
 222 
    return(q);
198 
}
 223 
}
199 
 
 224 
 
200 
 
 225 
 
201 
/*
 226 
/*
202 
    FORM AN OFFSET SHAPE
 227 
    FORM AN OFFSET SHAPE
203 
 
 228 
 
204 
    This routine creates an offset shape from the alignments p and q.
 229 
    This routine creates an offset shape from the alignments p and q.
205 
*/
 230 
*/
206 
 
 231 
 
207 
node *sh_offset
 232 
node *
208 
    PROTO_N ( ( p, q ) )
 - 
 
209 
    PROTO_T ( node *p X node *q )
 233 
sh_offset(node *p, node *q)
210 
{
 234 
{
211 
    node *r = new_node () ;
 235 
    node *r = new_node();
212 
    r->cons = cons_no ( SORT_shape, ENC_offset ) ;
 236 
    r->cons = cons_no(SORT_shape, ENC_offset);
213 
    r->son = new_node () ;
 237 
    r->son = new_node();
214 
    p = al_shape ( p ) ;
 238 
    p = al_shape(p);
215 
    q = al_shape ( q ) ;
 239 
    q = al_shape(q);
216 
    al_includes ( p, q ) ;
 240 
    al_includes(p, q);
217 
    if ( p == null ) {
 241 
    if (p == null) {
218 
	r->son->cons = &unknown_cons ;
 242 
	r->son->cons = &unknown_cons;
219 
    } else {
 243 
    } else {
220 
	r->son->cons = p->cons ;
 244 
	r->son->cons = p->cons;
221 
	r->son->son = p->son ;
 245 
	r->son->son = p->son;
222 
    }
 246 
    }
223 
    r->son->bro = new_node () ;
 247 
    r->son->bro = new_node();
224 
    if ( q == null ) {
 248 
    if (q == null) {
225 
	r->son->bro->cons = &unknown_cons ;
 249 
	r->son->bro->cons = &unknown_cons;
226 
    } else {
 250 
    } else {
227 
	r->son->bro->cons = q->cons ;
 251 
	r->son->bro->cons = q->cons;
228 
	r->son->bro->son = q->son ;
 252 
	r->son->bro->son = q->son;
229 
    }
 253 
    }
230 
    return ( r ) ;
 254 
    return(r);
231 
}
 255 
}
232 
 
 256 
 
233 
 
 257 
 
234 
/*
 258 
/*
235 
    FORM AN ARRAY SHAPE
 259 
    FORM AN ARRAY SHAPE
236 
 
 260 
 
237 
    This routine creates an array shape consisting of n copies of
 261 
    This routine creates an array shape consisting of n copies of
238 
    the shape p.
 262 
    the shape p.
239 
*/
 263 
*/
240 
 
 264 
 
241 
node *sh_nof
 265 
node *
242 
    PROTO_N ( ( n, p ) )
 - 
 
243 
    PROTO_T ( node *n X node *p )
 266 
sh_nof(node *n, node *p)
244 
{
 267 
{
245 
    node *q = new_node () ;
 268 
    node *q = new_node();
246 
    q->cons = cons_no ( SORT_shape, ENC_nof ) ;
 269 
    q->cons = cons_no(SORT_shape, ENC_nof);
247 
    q->son = new_node () ;
 270 
    q->son = new_node();
248 
    if ( n == null ) {
 271 
    if (n == null) {
249 
	q->son->cons = &unknown_cons ;
 272 
	q->son->cons = &unknown_cons;
250 
    } else {
 273 
    } else {
251 
	q->son->cons = n->cons ;
 274 
	q->son->cons = n->cons;
252 
	q->son->son = n->son ;
 275 
	q->son->son = n->son;
253 
    }
 276 
    }
254 
    q->son->bro = new_node () ;
 277 
    q->son->bro = new_node();
255 
    if ( p == null ) {
 278 
    if (p == null) {
256 
	q->son->bro->cons = &unknown_cons ;
 279 
	q->son->bro->cons = &unknown_cons;
257 
    } else {
 280 
    } else {
258 
	q->son->bro->cons = p->cons ;
 281 
	q->son->bro->cons = p->cons;
259 
	q->son->bro->son = p->son ;
 282 
	q->son->bro->son = p->son;
260 
    }
 283 
    }
261 
    return ( q ) ;
 284 
    return(q);
262 
}
 285 
}
263 
 
 286 
 
264 
 
 287 
 
265 
/*
 288 
/*
266 
    FORM A BITFIELD SHAPE
 289 
    FORM A BITFIELD SHAPE
267 
 
 290 
 
268 
    This routine creates a bitfield shape from a bitfield variety p.
 291 
    This routine creates a bitfield shape from a bitfield variety p.
269 
*/
 292 
*/
270 
 
 293 
 
271 
node *sh_bitfield
 294 
node *
272 
    PROTO_N ( ( p ) )
 - 
 
273 
    PROTO_T ( node *p )
 295 
sh_bitfield(node *p)
274 
{
 296 
{
275 
    node *q = new_node () ;
 297 
    node *q = new_node();
276 
    q->cons = cons_no ( SORT_shape, ENC_bitfield ) ;
 298 
    q->cons = cons_no(SORT_shape, ENC_bitfield);
277 
    q->son = new_node () ;
 299 
    q->son = new_node();
278 
    if ( p == null ) {
 300 
    if (p == null) {
279 
	q->son->cons = &unknown_cons ;
 301 
	q->son->cons = &unknown_cons;
280 
    } else {
 302 
    } else {
281 
	q->son->cons = p->cons ;
 303 
	q->son->cons = p->cons;
282 
	q->son->son = p->son ;
 304 
	q->son->son = p->son;
283 
    }
 305 
    }
284 
    return ( q ) ;
 306 
    return(q);
285 
}
 307 
}
286 
 
 308 
 
287 
 
 309 
 
288 
/*
 310 
/*
289 
    FORM A COMPOUND SHAPE
 311 
    FORM A COMPOUND SHAPE
290 
 
 312 
 
291 
    This routine creates a compound shape from an expression p.
 313 
    This routine creates a compound shape from an expression p.
292 
*/
 314 
*/
293 
 
 315 
 
294 
node *sh_compound
 316 
node *
295 
    PROTO_N ( ( p ) )
 - 
 
296 
    PROTO_T ( node *p )
 317 
sh_compound(node *p)
297 
{
 318 
{
298 
    node *q = new_node () ;
 319 
    node *q = new_node();
299 
    q->cons = cons_no ( SORT_shape, ENC_compound ) ;
 320 
    q->cons = cons_no(SORT_shape, ENC_compound);
300 
    q->son = new_node () ;
 321 
    q->son = new_node();
301 
    if ( p == null ) {
 322 
    if (p == null) {
302 
	q->son->cons = &unknown_cons ;
 323 
	q->son->cons = &unknown_cons;
303 
    } else {
 324 
    } else {
304 
	q->son->cons = p->cons ;
 325 
	q->son->cons = p->cons;
305 
	q->son->son = p->son ;
 326 
	q->son->son = p->son;
306 
    }
 327 
    }
307 
    return ( q ) ;
 328 
    return(q);
308 
}
 329 
}
309 
 
 330 
 
310 
 
 331 
 
311 
/*
 332 
/*
312 
    FIND THE NORMALIZED VERSION OF A SHAPE
 333 
    FIND THE NORMALIZED VERSION OF A SHAPE
313 
 
 334 
 
314 
    This routine returns the normalized version of the shape p.
 335 
    This routine returns the normalized version of the shape p.
315 
*/
 336 
*/
316 
 
 337 
 
317 
node *normalize
 338 
node *
318 
    PROTO_N ( ( p ) )
 - 
 
319 
    PROTO_T ( node *p )
 339 
normalize(node *p)
320 
{
 340 
{
321 
    if ( p == null ) return ( null ) ;
 341 
    if (p == null) return(null);
322 
    if ( p->cons->sortnum == SORT_shape ) {
 342 
    if (p->cons->sortnum == SORT_shape) {
323 
	switch ( p->cons->encoding ) {
 343 
	switch (p->cons->encoding) {
324 
	    case ENC_shape_apply_token : {
 344 
	    case ENC_shape_apply_token: {
325 
		node *q = expand_tok ( p ) ;
 345 
		node *q = expand_tok(p);
326 
		if ( q ) return ( normalize ( q ) ) ;
 346 
		if (q) return(normalize(q));
327 
		break ;
 347 
		break;
328 
	    }
 348 
	    }
329 
	    case ENC_offset : {
 349 
	    case ENC_offset: {
330 
		node *al1 = al_shape ( p->son ) ;
 350 
		node *al1 = al_shape(p->son);
331 
		node *al2 = al_shape ( p->son->bro ) ;
 351 
		node *al2 = al_shape(p->son->bro);
332 
		return ( sh_offset ( al1, al2 ) ) ;
 352 
		return(sh_offset(al1, al2));
333 
	    }
 353 
	    }
334 
	    case ENC_pointer : {
 354 
	    case ENC_pointer: {
335 
		return ( sh_pointer ( al_shape ( p->son ) ) ) ;
 355 
		return(sh_pointer(al_shape(p->son)));
336 
	    }
 356 
	    }
337 
	}
 357 
	}
338 
    }
 358 
    }
339 
    return ( copy_node ( p ) ) ;
 359 
    return(copy_node(p));
340 
}
 360 
}
341 
 
 361 
 
342 
 
 362 
 
343 
/*
 363 
/*
344 
    EXPAND TOKEN APPLICATIONS
 364 
    EXPAND TOKEN APPLICATIONS
Line 346... Line 366...
346 
    If p is the application of a token it is replaced by the definition
 366 
    If p is the application of a token it is replaced by the definition
347 
    of that token.  If this is null, null is returned, otherwise the
 367 
    of that token.  If this is null, null is returned, otherwise the
348 
    expansion continues until p is not a token application.
 368 
    expansion continues until p is not a token application.
349 
*/
 369 
*/
350 
 
 370 
 
351 
node *expand_tok
 371 
node *
352 
    PROTO_N ( ( p ) )
 - 
 
353 
    PROTO_T ( node *p )
 372 
expand_tok(node *p)
354 
{
 373 
{
355 
    int count = 0 ;
 374 
    int count = 0;
356 
    sortname s = p->cons->sortnum ;
 375 
    sortname s = p->cons->sortnum;
357 
    while ( p->cons->encoding == sort_tokens [s] ) {
 376 
    while (p->cons->encoding == sort_tokens[s]) {
358 
	tok_info *info = get_tok_info ( p->son->cons ) ;
 377 
	tok_info *info = get_tok_info(p->son->cons);
359 
	if ( info->def ) {
 378 
	if (info->def) {
360 
	    p = info->def ;
 379 
	    p = info->def;
361 
	    if ( p->cons->sortnum == SORT_completion ) p = p->son ;
 380 
	    if (p->cons->sortnum == SORT_completion)p = p->son;
362 
	} else {
 381 
	} else {
363 
	    return ( null ) ;
 382 
	    return(null);
364 
	}
 383 
	}
365 
	if ( ++count > 100 ) return ( null ) ;
 384 
	if (++count > 100) return(null);
366 
    }
 385 
    }
367 
    return ( p ) ;
 386 
    return(p);
368 
}
 387 
}
369 
 
 388 
 
370 
 
 389 
 
371 
/*
 390 
/*
372 
    CHECK THAT TWO SHAPES ARE COMPATIBLE
 391 
    CHECK THAT TWO SHAPES ARE COMPATIBLE
Line 379... Line 398...
379 
    returns sh_bottom if either p or q is the shape bottom, p if p and
 398 
    returns sh_bottom if either p or q is the shape bottom, p if p and
380 
    q are definitely compatible, null is they are possible compatible,
 399 
    q are definitely compatible, null is they are possible compatible,
381 
    and sh_top if they are definitely not compatible.
 400 
    and sh_top if they are definitely not compatible.
382 
*/
 401 
*/
383 
 
 402 
 
384 
node *check_shapes
 403 
node *
385 
    PROTO_N ( ( p, q, tg ) )
 - 
 
386 
    PROTO_T ( node *p X node *q X int tg )
 404 
check_shapes(node *p, node *q, int tg)
387 
{
 405 
{
388 
    sortname s ;
 406 
    sortname s;
389 
    long np, nq ;
 407 
    long np, nq;
390 
    boolean ok = 1 ;
 408 
    boolean ok = 1;
391 
    node *p0 = ( tg == 2 ? null : p ) ;
 409 
    node *p0 = (tg == 2 ? null : p);
392 
    node *q0 = ( tg == 2 ? null : q ) ;
 410 
    node *q0 = (tg == 2 ? null : q);
393 
    node *p1 = p ;
 411 
    node *p1 = p;
394 
    boolean check_further = 0 ;
 412 
    boolean check_further = 0;
395 
 
 413 
 
396 
    /* If one is unknown, return the other */
 414 
    /* If one is unknown, return the other */
397 
    if ( p == null ) return ( q0 ) ;
 415 
    if (p == null) return(q0);
398 
    if ( q == null ) return ( p0 ) ;
 416 
    if (q == null) return(p0);
399 
    if ( p->cons->sortnum == SORT_unknown ) return ( q0 ) ;
 417 
    if (p->cons->sortnum == SORT_unknown) return(q0);
400 
    if ( q->cons->sortnum == SORT_unknown ) return ( p0 ) ;
 418 
    if (q->cons->sortnum == SORT_unknown) return(p0);
401 
 
 419 
 
402 
    s = p->cons->sortnum ;
 420 
    s = p->cons->sortnum;
403 
    np = p->cons->encoding ;
 421 
    np = p->cons->encoding;
404 
    nq = q->cons->encoding ;
 422 
    nq = q->cons->encoding;
405 
 
 423 
 
406 
    /* Check for tokens */
 424 
    /* Check for tokens */
407 
    if ( np == sort_tokens [s] ) {
 425 
    if (np == sort_tokens[s]) {
408 
	p = expand_tok ( p ) ;
 426 
	p = expand_tok(p);
409 
	if ( p == null ) {
 427 
	if (p == null) {
410 
	    if ( np == nq && p1->son->cons == q->son->cons ) {
 428 
	    if (np == nq && p1->son->cons == q->son->cons) {
411 
		if ( p1->son->son == null ) return ( p1 ) ;
 429 
		if (p1->son->son == null) return(p1);
412 
	    }
 430 
	    }
413 
	    return ( q0 ) ;
 431 
	    return(q0);
414 
	}
 432 
	}
415 
	np = p->cons->encoding ;
 433 
	np = p->cons->encoding;
416 
    }
 434 
    }
417 
    if ( nq == sort_tokens [s] ) {
 435 
    if (nq == sort_tokens[s]) {
418 
	q = expand_tok ( q ) ;
 436 
	q = expand_tok(q);
419 
	if ( q == null ) return ( p0 ) ;
 437 
	if (q == null) return(p0);
420 
	nq = q->cons->encoding ;
 438 
	nq = q->cons->encoding;
421 
    }
 439 
    }
422 
 
 440 
 
423 
    switch ( s ) {
 441 
    switch (s) {
424 
 
 442 
 
425 
	case SORT_shape : {
 443 
	case SORT_shape: {
426 
	    /* Check for bottoms */
 444 
	    /* Check for bottoms */
427 
	    if ( tg == 2 ) {
 445 
	    if (tg == 2) {
428 
		if ( np == ENC_bottom ) return ( sh_bottom ) ;
 446 
		if (np == ENC_bottom) return(sh_bottom);
429 
		if ( nq == ENC_bottom ) return ( sh_bottom ) ;
 447 
		if (nq == ENC_bottom) return(sh_bottom);
430 
	    }
 448 
	    }
431 
	    /* Don't know about or conditionals */
 449 
	    /* Don't know about or conditionals */
432 
	    if ( np == ENC_shape_cond ) return ( q0 ) ;
 450 
	    if (np == ENC_shape_cond) return(q0);
433 
	    if ( nq == ENC_shape_cond ) return ( p0 ) ;
 451 
	    if (nq == ENC_shape_cond) return(p0);
434 
	    if ( np != nq ) {
 452 
	    if (np != nq) {
435 
		ok = 0 ;
 453 
		ok = 0;
436 
	    } else {
 454 
	    } else {
437 
		switch ( np ) {
 455 
		switch (np) {
438 
 
 456 
 
439 
		    case ENC_bitfield :
 457 
		    case ENC_bitfield:
440 
		    case ENC_floating :
 458 
		    case ENC_floating:
441 
		    case ENC_integer :
 459 
		    case ENC_integer:
442 
		    case ENC_nof : {
 460 
		    case ENC_nof: {
443 
			/* Some shapes are inspected closer */
 461 
			/* Some shapes are inspected closer */
444 
			check_further = 1 ;
 462 
			check_further = 1;
445 
			break ;
 463 
			break;
446 
		    }
 464 
		    }
447 
 
 465 
 
448 
		    /* case ENC_pointer */
 466 
		    /* case ENC_pointer */
449 
		    /* case ENC_offset */
 467 
		    /* case ENC_offset */
450 
 
 468 
 
451 
		    case ENC_bottom :
 469 
		    case ENC_bottom:
452 
		    case ENC_proc :
 470 
		    case ENC_proc:
453 
		    case ENC_top : {
 471 
		    case ENC_top: {
454 
			/* These are definitely compatible */
 472 
			/* These are definitely compatible */
455 
			if ( tg == 2 ) return ( p1 ) ;
 473 
			if (tg == 2) return(p1);
456 
			break ;
 474 
			break;
457 
		    }
 475 
		    }
458 
		}
 476 
		}
459 
	    }
 477 
	    }
460 
	    break ;
 478 
	    break;
461 
	}
 479 
	}
462 
 
 480 
 
463 
	case SORT_bitfield_variety : {
 481 
	case SORT_bitfield_variety: {
464 
	    /* Don't know about conditionals */
 482 
	    /* Don't know about conditionals */
465 
	    if ( np == ENC_bfvar_cond ) return ( q0 ) ;
 483 
	    if (np == ENC_bfvar_cond) return(q0);
466 
	    if ( nq == ENC_bfvar_cond ) return ( p0 ) ;
 484 
	    if (nq == ENC_bfvar_cond) return(p0);
467 
	    if ( np != nq ) {
 485 
	    if (np != nq) {
468 
		ok = 0 ;
 486 
		ok = 0;
469 
	    } else {
 487 
	    } else {
470 
		/* Simple bitfield varieties are inspected closer */
 488 
		/* Simple bitfield varieties are inspected closer */
471 
		if ( np == ENC_bfvar_bits ) check_further = 1 ;
 489 
		if (np == ENC_bfvar_bits)check_further = 1;
472 
	    }
 490 
	    }
473 
	    break ;
 491 
	    break;
474 
	}
 492 
	}
475 
 
 493 
 
476 
	case SORT_bool : {
 494 
	case SORT_bool: {
477 
	    /* Don't know about conditionals */
 495 
	    /* Don't know about conditionals */
478 
	    if ( np == ENC_bool_cond ) return ( q0 ) ;
 496 
	    if (np == ENC_bool_cond) return(q0);
479 
	    if ( nq == ENC_bool_cond ) return ( p0 ) ;
 497 
	    if (nq == ENC_bool_cond) return(p0);
480 
	    if ( np != nq ) ok = 0 ;
 498 
	    if (np != nq)ok = 0;
481 
	    if ( tg == 2 ) return ( ok ? p1 : sh_top ) ;
 499 
	    if (tg == 2) return(ok ? p1 : sh_top);
482 
	    break ;
 500 
	    break;
483 
	}
 501 
	}
484 
 
 502 
 
485 
	case SORT_floating_variety : {
 503 
	case SORT_floating_variety: {
486 
	    /* Don't know about conditionals */
 504 
	    /* Don't know about conditionals */
487 
	    if ( np == ENC_flvar_cond ) return ( q0 ) ;
 505 
	    if (np == ENC_flvar_cond) return(q0);
488 
	    if ( nq == ENC_flvar_cond ) return ( p0 ) ;
 506 
	    if (nq == ENC_flvar_cond) return(p0);
489 
	    if ( np != nq ) {
 507 
	    if (np != nq) {
490 
		ok = 0 ;
 508 
		ok = 0;
491 
	    } else {
 509 
	    } else {
492 
		/* Simple floating varieties are inspected closer */
 510 
		/* Simple floating varieties are inspected closer */
493 
		if ( np == ENC_flvar_parms ) check_further = 1 ;
 511 
		if (np == ENC_flvar_parms)check_further = 1;
494 
	    }
 512 
	    }
495 
	    break ;
 513 
	    break;
496 
	}
 514 
	}
497 
 
 515 
 
498 
	case SORT_nat : {
 516 
	case SORT_nat: {
499 
	    /* Don't know about conditionals */
 517 
	    /* Don't know about conditionals */
500 
	    if ( np == ENC_nat_cond ) return ( q0 ) ;
 518 
	    if (np == ENC_nat_cond) return(q0);
501 
	    if ( nq == ENC_nat_cond ) return ( p0 ) ;
 519 
	    if (nq == ENC_nat_cond) return(p0);
502 
	    if ( np != nq ) {
 520 
	    if (np != nq) {
503 
		ok = 0 ;
 521 
		ok = 0;
504 
	    } else {
 522 
	    } else {
505 
		/* Simple nats are checked */
 523 
		/* Simple nats are checked */
506 
		if ( np == ENC_make_nat ) {
 524 
		if (np == ENC_make_nat) {
507 
		    if ( !eq_node ( p->son, q->son ) ) ok = 0 ;
 525 
		    if (!eq_node(p->son, q->son))ok = 0;
508 
		    if ( tg == 2 ) return ( ok ? p1 : sh_top ) ;
 526 
		    if (tg == 2) return(ok ? p1 : sh_top);
509 
		}
 527 
		}
510 
	    }
 528 
	    }
511 
	    break ;
 529 
	    break;
512 
	}
 530 
	}
513 
 
 531 
 
514 
	case SORT_signed_nat : {
 532 
	case SORT_signed_nat: {
515 
	    /* Don't know about conditionals */
 533 
	    /* Don't know about conditionals */
516 
	    if ( np == ENC_signed_nat_cond ) return ( q0 ) ;
 534 
	    if (np == ENC_signed_nat_cond) return(q0);
517 
	    if ( nq == ENC_signed_nat_cond ) return ( p0 ) ;
 535 
	    if (nq == ENC_signed_nat_cond) return(p0);
518 
	    if ( np != nq ) {
 536 
	    if (np != nq) {
519 
		ok = 0 ;
 537 
		ok = 0;
520 
	    } else {
 538 
	    } else {
521 
		/* Simple signed_nats are checked */
 539 
		/* Simple signed_nats are checked */
522 
		if ( np == ENC_make_signed_nat ) {
 540 
		if (np == ENC_make_signed_nat) {
523 
		    if ( !eq_node ( p->son, q->son ) ) ok = 0 ;
 541 
		    if (!eq_node(p->son, q->son))ok = 0;
524 
		    if ( tg == 2 ) return ( ok ? p1 : sh_top ) ;
 542 
		    if (tg == 2) return(ok ? p1 : sh_top);
525 
		}
 543 
		}
526 
	    }
 544 
	    }
527 
	    break ;
 545 
	    break;
528 
	}
 546 
	}
529 
 
 547 
 
530 
	case SORT_variety : {
 548 
	case SORT_variety: {
531 
	    /* Don't know about conditionals */
 549 
	    /* Don't know about conditionals */
532 
	    if ( np == ENC_var_cond ) return ( q0 ) ;
 550 
	    if (np == ENC_var_cond) return(q0);
533 
	    if ( nq == ENC_var_cond ) return ( p0 ) ;
 551 
	    if (nq == ENC_var_cond) return(p0);
534 
	    if ( np != nq ) {
 552 
	    if (np != nq) {
535 
		ok = 0 ;
 553 
		ok = 0;
536 
	    } else {
 554 
	    } else {
537 
		/* Simple varieties are inspected closer */
 555 
		/* Simple varieties are inspected closer */
538 
		if ( np == ENC_var_limits ) check_further = 1 ;
 556 
		if (np == ENC_var_limits)check_further = 1;
539 
	    }
 557 
	    }
540 
	    break ;
 558 
	    break;
541 
	}
 559 
	}
542 
 
 560 
 
543 
	default : {
 561 
	default : {
544 
	    is_fatal = 0 ;
 562 
	    is_fatal = 0;
545 
	    input_error ( "Shouldn't be checking %s's", sort_name ( s ) ) ;
 563 
	    input_error("Shouldn't be checking %s's", sort_name(s));
546 
	    break ;
 564 
	    break;
547 
	}
 565 
	}
548 
    }
 566 
    }
549 
 
 567 
 
550 
    /* Check arguments if necessary */
 568 
    /* Check arguments if necessary */
551 
    if ( check_further ) {
 569 
    if (check_further) {
552 
	node *xp = p->son ;
 570 
	node *xp = p->son;
553 
	node *xq = q->son ;
 571 
	node *xq = q->son;
554 
	while ( xp && xq ) {
 572 
	while (xp && xq) {
555 
	    node *c = check_shapes ( xp, xq, tg ) ;
 573 
	    node *c = check_shapes(xp, xq, tg);
556 
	    if ( tg == 2 ) {
 574 
	    if (tg == 2) {
557 
		if ( c == null ) return ( null ) ;
 575 
		if (c == null) return(null);
558 
		if ( c == sh_top ) return ( sh_top ) ;
 576 
		if (c == sh_top) return(sh_top);
559 
	    }
 577 
	    }
560 
	    xp = xp->bro ;
 578 
	    xp = xp->bro;
561 
	    xq = xq->bro ;
 579 
	    xq = xq->bro;
562 
	}
 580 
	}
563 
    } else {
 581 
    } else {
564 
	if ( tg == 2 ) return ( null ) ;
 582 
	if (tg == 2) return(null);
565 
    }
 583 
    }
566 
 
 584 
 
567 
    if ( !ok ) {
 585 
    if (!ok) {
568 
	/* Definitely not compatible */
 586 
	/* Definitely not compatible */
569 
	if ( tg == 2 ) return ( sh_top ) ;
 587 
	if (tg == 2) return(sh_top);
570 
	is_fatal = 0 ;
 588 
	is_fatal = 0;
571 
	if ( tg ) {
 589 
	if (tg) {
572 
	    input_error ( "Shape of tag %s does not match declaration",
 590 
	    input_error("Shape of tag %s does not match declaration",
573 
			  checking ) ;
 591 
			  checking);
574 
	} else {
 592 
	} else {
575 
	    input_error ( "Shape incompatibility in %s", checking ) ;
 593 
	    input_error("Shape incompatibility in %s", checking);
576 
	}
 594 
	}
577 
	return ( null ) ;
 595 
	return(null);
578 
    }
 596 
    }
579 
    return ( p1 ) ;
 597 
    return(p1);
580 
}
 598 
}
581 
 
 599 
 
582 
 
 600 
 
583 
/*
 601 
/*
584 
    FIND THE LEAST UPPER BOUND OF TWO SHAPES
 602 
    FIND THE LEAST UPPER BOUND OF TWO SHAPES
585 
 
 603 
 
586 
    This routine returns the least upper bound of the shapes p and q.
 604 
    This routine returns the least upper bound of the shapes p and q.
587 
    A return value of null means that the result is unknown.
 605 
    A return value of null means that the result is unknown.
588 
*/
 606 
*/
589 
 
 607 
 
590 
node *lub
 608 
node *
591 
    PROTO_N ( ( p, q ) )
 - 
 
592 
    PROTO_T ( node *p X node *q )
 609 
lub(node *p, node *q)
593 
{
 610 
{
594 
    return ( check_shapes ( p, q, 2 ) ) ;
 611 
    return(check_shapes(p, q, 2));
595 
}
 612 
}
596 
 
 613 
 
597 
 
 614 
 
598 
/*
 615 
/*
599 
    CHECK THAT A SINGLE EXPRESSION HAS THE RIGHT FORM
 616 
    CHECK THAT A SINGLE EXPRESSION HAS THE RIGHT FORM
Line 601... Line 618...
601 
    The shape of the expression p is checked to be of the form indicated
 618 
    The shape of the expression p is checked to be of the form indicated
602 
    by t.  If so (or possibly so) the shape is returned, otherwise an error
 619 
    by t.  If so (or possibly so) the shape is returned, otherwise an error
603 
    is flagged and null is returned.
 620 
    is flagged and null is returned.
604 
*/
 621 
*/
605 
 
 622 
 
606 
node *check1
 623 
node *
607 
    PROTO_N ( ( t, p ) )
 - 
 
608 
    PROTO_T ( int t X node *p )
 624 
check1(int t, node *p)
609 
{
 625 
{
610 
    long n ;
 626 
    long n;
611 
    char *nm = p->cons->name ;
 627 
    char *nm = p->cons->name;
612 
    node *s = p->shape, *s0 = s ;
 628 
    node *s = p->shape, *s0 = s;
613 
 
 629 
 
614 
    if ( s == null ) return ( null ) ;
 630 
    if (s == null) return(null);
615 
    if ( s->cons->sortnum == SORT_unknown ) return ( s ) ;
 631 
    if (s->cons->sortnum == SORT_unknown) return(s);
616 
    if ( t >= ENC_shape_none ) return ( s ) ;
 632 
    if (t >= ENC_shape_none) return(s);
617 
 
 633 
 
618 
    n = s->cons->encoding ;
 634 
    n = s->cons->encoding;
619 
    if ( n == ENC_shape_apply_token ) {
 635 
    if (n == ENC_shape_apply_token) {
620 
	s = expand_tok ( s ) ;
 636 
	s = expand_tok(s);
621 
	if ( s == null ) return ( s0 ) ;
 637 
	if (s == null) return(s0);
622 
	n = s->cons->encoding ;
 638 
	n = s->cons->encoding;
623 
    }
 639 
    }
624 
 
 640 
 
625 
    if ( n == ENC_shape_cond ) {
 641 
    if (n == ENC_shape_cond) {
626 
	/* Don't know about conditionals */
 642 
	/* Don't know about conditionals */
627 
    } else if ( n != ( long ) t ) {
 643 
    } else if (n != (long)t) {
628 
	char tbuff [1000] ;
 644 
	char tbuff[1000];
629 
	construct *c = cons_no ( SORT_shape, t ) ;
 645 
	construct *c = cons_no(SORT_shape, t);
630 
	if ( p->cons->encoding == ENC_exp_apply_token ) {
 646 
	if (p->cons->encoding == ENC_exp_apply_token) {
631 
	    IGNORE sprintf ( tbuff, "%s (%s)", nm, p->son->cons->name ) ;
 647 
	    IGNORE sprintf(tbuff, "%s (%s)", nm, p->son->cons->name);
632 
	    nm = tbuff ;
 648 
	    nm = tbuff;
633 
	}
 649 
	}
634 
	is_fatal = 0 ;
 650 
	is_fatal = 0;
635 
	input_error ( "%s argument to %s should be of %s shape",
 651 
	input_error("%s argument to %s should be of %s shape",
636 
		      nm, checking, c->name ) ;
 652 
		      nm, checking, c->name);
637 
	return ( null ) ;
 653 
	return(null);
638 
    }
 654 
    }
639 
    return ( normalize ( s ) ) ;
 655 
    return(normalize(s));
640 
}
 656 
}
641 
 
 657 
 
642 
 
 658 
 
643 
/*
 659 
/*
644 
    CHECK THAT TWO EXPRESSIONS HAVE THE RIGHT FORM
 660 
    CHECK THAT TWO EXPRESSIONS HAVE THE RIGHT FORM
645 
 
 661 
 
646 
    The shapes of the expressions p and q are checked to be of the form
 662 
    The shapes of the expressions p and q are checked to be of the form
647 
    indicated by t and to be compatible.  The shape or null is returned.
 663 
    indicated by t and to be compatible.  The shape or null is returned.
648 
*/
 664 
*/
649 
 
 665 
 
650 
node *check2
 666 
node *
651 
    PROTO_N ( ( t, p, q ) )
 - 
 
652 
    PROTO_T ( int t X node *p X node *q )
 667 
check2(int t, node *p, node *q)
653 
{
 668 
{
654 
    node *sp = check1 ( t, p ) ;
 669 
    node *sp = check1(t, p);
655 
    node *sq = check1 ( t, q ) ;
 670 
    node *sq = check1(t, q);
656 
 
 671 
 
657 
    if ( t == ENC_nof ) {
 672 
    if (t == ENC_nof) {
658 
	/* For arrays check for concat_nof */
 673 
	/* For arrays check for concat_nof */
659 
	node *s = null ;
 674 
	node *s = null;
660 
	node *n = null ;
 675 
	node *n = null;
661 
	if ( sp && sq ) {
 676 
	if (sp && sq) {
662 
	    sp = expand_tok ( sp ) ;
 677 
	    sp = expand_tok(sp);
663 
	    sq = expand_tok ( sq ) ;
 678 
	    sq = expand_tok(sq);
664 
	    if ( sp && sp->cons->encoding == ENC_nof &&
 679 
	    if (sp && sp->cons->encoding == ENC_nof &&
665 
		 sq && sq->cons->encoding == ENC_nof ) {
 680 
		 sq && sq->cons->encoding == ENC_nof) {
666 
		/* Find base shape of array */
 681 
		/* Find base shape of array */
667 
		s = check_shapes ( sp->son->bro, sq->son->bro, 0 ) ;
 682 
		s = check_shapes(sp->son->bro, sq->son->bro, 0);
668 
		sp = expand_tok ( sp->son ) ;
 683 
		sp = expand_tok(sp->son);
669 
		sq = expand_tok ( sq->son ) ;
 684 
		sq = expand_tok(sq->son);
670 
		if ( sp && sp->cons->encoding == ENC_make_nat &&
 685 
		if (sp && sp->cons->encoding == ENC_make_nat &&
671 
		     sq && sq->cons->encoding == ENC_make_nat ) {
 686 
		     sq && sq->cons->encoding == ENC_make_nat) {
672 
		    /* Arrays of known size - find concatenated size */
 687 
		    /* Arrays of known size - find concatenated size */
673 
		    construct *np = sp->son->cons ;
 688 
		    construct *np = sp->son->cons;
674 
		    construct *nq = sp->son->cons ;
 689 
		    construct *nq = sp->son->cons;
675 
		    if ( np->sortnum == SORT_small_tdfint &&
 690 
		    if (np->sortnum == SORT_small_tdfint &&
676 
			 nq->sortnum == SORT_small_tdfint ) {
 691 
			 nq->sortnum == SORT_small_tdfint) {
677 
			long up = np->encoding ;
 692 
			long up = np->encoding;
678 
			long uq = nq->encoding ;
 693 
			long uq = nq->encoding;
679 
			long umax = ( ( long ) 1 ) << 24 ;
 694 
			long umax = ((long)1) << 24;
680 
			if ( up <= umax && uq <= umax ) {
 695 
			if (up <= umax && uq <= umax) {
681 
			    n = make_nat ( up + uq ) ;
 696 
			    n = make_nat(up + uq);
682 
			}
 697 
			}
683 
		    }
 698 
		    }
684 
		}
 699 
		}
685 
	    }
 700 
	    }
686 
	}
 701 
	}
687 
	return ( sh_nof ( n, s ) ) ;
 702 
	return(sh_nof(n, s));
688 
    }
 703 
    }
689 
 
 704 
 
690 
    return ( check_shapes ( sp, sq, 0 ) ) ;
 705 
    return(check_shapes(sp, sq, 0));
691 
}
 706 
}
692 
 
 707 
 
693 
 
 708 
 
694 
/*
 709 
/*
695 
    CHECK THAT A LIST OF EXPRESSIONS HAVE THE RIGHT FORM
 710 
    CHECK THAT A LIST OF EXPRESSIONS HAVE THE RIGHT FORM
Line 698... Line 713...
698 
    of the form indicated by t and to be compatible.  The shape or
 713 
    of the form indicated by t and to be compatible.  The shape or
699 
    null is returned.  If nz is true an error is flagged if p is the
 714 
    null is returned.  If nz is true an error is flagged if p is the
700 
    empty list.
 715 
    empty list.
701 
*/
 716 
*/
702 
 
 717 
 
703 
node *checkn
 718 
node *
704 
    PROTO_N ( ( t, p, nz ) )
 - 
 
705 
    PROTO_T ( int t X node *p X int nz )
 719 
checkn(int t, node *p, int nz)
706 
{
 720 
{
707 
    node *q, *r ;
 721 
    node *q, *r;
708 
    if ( p->cons->encoding == 0 ) {
 722 
    if (p->cons->encoding == 0) {
709 
	if ( nz ) {
 723 
	if (nz) {
710 
	    is_fatal = 0 ;
 724 
	    is_fatal = 0;
711 
	    input_error ( "Repeated statement in %s cannot be empty",
 725 
	    input_error("Repeated statement in %s cannot be empty",
712 
			  checking ) ;
 726 
			  checking);
713 
	}
 727 
	}
714 
	return ( null ) ;
 728 
	return(null);
715 
    }
 729 
    }
716 
    q = p->son ;
 730 
    q = p->son;
717 
    r = check1 ( t, q ) ;
 731 
    r = check1(t, q);
718 
    while ( q = q->bro, q != null ) {
 732 
    while (q = q->bro, q != null) {
719 
	node *s = check1 ( t, q ) ;
 733 
	node *s = check1(t, q);
720 
	r = check_shapes ( r, s, 0 ) ;
 734 
	r = check_shapes(r, s, 0);
721 
    }
 735 
    }
722 
    return ( r ) ;
 736 
    return(r);
723 
}
 737 
}
724 
 
 738 
 
725 
 
 739 
 
726 
/*
 740 
/*
727 
    SET TOKEN ARGUMENTS
 741 
    SET TOKEN ARGUMENTS
Line 730... Line 744...
730 
    arguments given in c.  It is a prelude to expanding token applications.
 744 
    arguments given in c.  It is a prelude to expanding token applications.
731 
    Any missing arguments are set to null.  The routine returns the list
 745 
    Any missing arguments are set to null.  The routine returns the list
732 
    of previous argument values if set is true.
 746 
    of previous argument values if set is true.
733 
*/
 747 
*/
734 
 
 748 
 
735 
node *set_token_args
 749 
node *
736 
    PROTO_N ( ( c, p, set ) )
 - 
 
737 
    PROTO_T ( construct **c X node *p X int set )
 750 
set_token_args(construct **c, node *p, int set)
738 
{
 751 
{
739 
    node *q = null ;
 752 
    node *q = null;
740 
    node *aq = null ;
 753 
    node *aq = null;
741 
    if ( c ) {
 754 
    if (c) {
742 
	while ( *c ) {
 755 
	while (*c) {
743 
	    tok_info *info = get_tok_info ( *c ) ;
 756 
	    tok_info *info = get_tok_info(*c);
744 
	    if ( set ) {
 757 
	    if (set) {
745 
		node *r = info->def ;
 758 
		node *r = info->def;
746 
		if ( r ) {
 759 
		if (r) {
747 
		    r = copy_node ( r ) ;
 760 
		    r = copy_node(r);
748 
		    if ( aq == null ) {
 761 
		    if (aq == null) {
749 
			q = r ;
 762 
			q = r;
750 
		    } else {
 763 
		    } else {
751 
			aq->bro = r ;
 764 
			aq->bro = r;
752 
		    }
 765 
		    }
753 
		    aq = r ;
 766 
		    aq = r;
754 
		}
 767 
		}
755 
	    }
 768 
	    }
756 
	    info->def = copy_node ( p ) ;
 769 
	    info->def = copy_node(p);
757 
	    if ( p ) p = p->bro ;
 770 
	    if (p)p = p->bro;
758 
	    c++ ;
 771 
	    c++;
759 
	}
 772 
	}
760 
    }
 773 
    }
761 
    return ( q ) ;
 774 
    return(q);
762 
}
 775 
}
763 
 
 776 
 
764 
 
 777 
 
765 
/*
 778 
/*
766 
    DOES A CONSTRUCT INTRODUCE A TAG OR A LABEL?
 779 
    DOES A CONSTRUCT INTRODUCE A TAG OR A LABEL?
767 
 
 780 
 
768 
    This routine checks whether the construct c introduces a local tag or
 781 
    This routine checks whether the construct c introduces a local tag or
769 
    label.
 782 
    label.
770 
*/
 783 
*/
771 
 
 784 
 
772 
static int is_intro_exp
 785 
static int
773 
    PROTO_N ( ( c ) )
 - 
 
774 
    PROTO_T ( construct *c )
 786 
is_intro_exp(construct *c)
775 
{
 787 
{
776 
    if ( c->sortnum == SORT_exp ) {
 788 
    if (c->sortnum == SORT_exp) {
777 
	switch ( c->encoding ) {
 789 
	switch (c->encoding) {
778 
	    case ENC_apply_general_proc :
 790 
	    case ENC_apply_general_proc:
779 
	    case ENC_conditional :
 791 
	    case ENC_conditional:
780 
	    case ENC_identify :
 792 
	    case ENC_identify:
781 
	    case ENC_labelled :
 793 
	    case ENC_labelled:
782 
	    case ENC_make_general_proc :
 794 
	    case ENC_make_general_proc:
783 
	    case ENC_make_proc :
 795 
	    case ENC_make_proc:
784 
	    case ENC_repeat :
 796 
	    case ENC_repeat:
785 
	    case ENC_variable : {
 797 
	    case ENC_variable: {
786 
		return ( 1 ) ;
 798 
		return(1);
787 
	    }
 799 
	    }
788 
	}
 800 
	}
789 
    }
 801 
    }
790 
    return ( 0 ) ;
 802 
    return(0);
791 
}
 803 
}
792 
 
 804 
 
793 
 
 805 
 
794 
/*
 806 
/*
795 
    DOES A NODE CONTAIN DEFINED TOKENS?
 807 
    DOES A NODE CONTAIN DEFINED TOKENS?
Line 799... Line 811...
799 
    flag is used to determine this) or a make_tag construct which introduces
 811 
    flag is used to determine this) or a make_tag construct which introduces
800 
    a new tag, 2 if it is a use of such an introduced label or tag, 1 if
 812 
    a new tag, 2 if it is a use of such an introduced label or tag, 1 if
801 
    some subnode returns at least tok, and 0 otherwise.
 813 
    some subnode returns at least tok, and 0 otherwise.
802 
*/
 814 
*/
803 
 
 815 
 
804 
static int contains_tokens
 816 
static int
805 
    PROTO_N ( ( p, intro, tok ) )
 - 
 
806 
    PROTO_T ( node *p X int intro X int tok )
 817 
contains_tokens(node *p, int intro, int tok)
807 
{
 818 
{
808 
    long n ;
 819 
    long n;
809 
    node *q ;
 820 
    node *q;
810 
    sortname s ;
 821 
    sortname s;
811 
    if ( p == null ) return ( 0 ) ;
 822 
    if (p == null) return(0);
812 
    s = p->cons->sortnum ;
 823 
    s = p->cons->sortnum;
813 
    n = p->cons->encoding ;
 824 
    n = p->cons->encoding;
814 
    switch ( s ) {
 825 
    switch (s) {
815 
	case SORT_al_tag : {
 826 
	case SORT_al_tag: {
816 
	    if ( n == ENC_make_al_tag ) return ( 0 ) ;
 827 
	    if (n == ENC_make_al_tag) return(0);
817 
	    intro = 0 ;
 828 
	    intro = 0;
818 
	    break ;
 829 
	    break;
819 
	}
 830 
	}
820 
	case SORT_label : {
 831 
	case SORT_label: {
821 
	    if ( n == ENC_make_label ) {
 832 
	    if (n == ENC_make_label) {
822 
		if ( intro ) {
 833 
		if (intro) {
823 
		    p->cons->alias = p->cons ;
 834 
		    p->cons->alias = p->cons;
824 
		    return ( 3 ) ;
 835 
		    return(3);
825 
		}
 836 
		}
826 
		if ( p->cons->alias ) return ( 2 ) ;
 837 
		if (p->cons->alias) return(2);
827 
		return ( 0 ) ;
 838 
		return(0);
828 
	    }
 839 
	    }
829 
	    intro = 0 ;
 840 
	    intro = 0;
830 
	    break ;
 841 
	    break;
831 
	}
 842 
	}
832 
	case SORT_tag : {
 843 
	case SORT_tag: {
833 
	    if ( n == ENC_make_tag ) {
 844 
	    if (n == ENC_make_tag) {
834 
		if ( intro ) {
 845 
		if (intro) {
835 
		    p->cons->alias = p->cons ;
 846 
		    p->cons->alias = p->cons;
836 
		    return ( 3 ) ;
 847 
		    return(3);
837 
		}
 848 
		}
838 
		if ( p->cons->alias ) return ( 2 ) ;
 849 
		if (p->cons->alias) return(2);
839 
		return ( 0 ) ;
 850 
		return(0);
840 
	    }
 851 
	    }
841 
	    intro = 0 ;
 852 
	    intro = 0;
842 
	    break ;
 853 
	    break;
843 
	}
 854 
	}
844 
	case SORT_token : {
 855 
	case SORT_token: {
845 
	    if ( n == ENC_make_tok ) return ( 0 ) ;
 856 
	    if (n == ENC_make_tok) return(0);
846 
	    intro = 0 ;
 857 
	    intro = 0;
847 
	    break ;
 858 
	    break;
848 
	}
 859 
	}
849 
	case SORT_exp : {
 860 
	case SORT_exp: {
850 
	    intro = is_intro_exp ( p->cons ) ;
 861 
	    intro = is_intro_exp(p->cons);
851 
	    break ;
 862 
	    break;
852 
	}
 863 
	}
853 
	default : {
 864 
	default : {
854 
	    if ( s > 0 ) intro = 0 ;
 865 
	    if (s > 0)intro = 0;
855 
	    break ;
 866 
	    break;
856 
	}
 867 
	}
857 
    }
 868 
    }
858 
    if ( p->cons == &shape_of ) {
 869 
    if (p->cons == &shape_of) {
859 
	tok_info *info = get_tok_info ( p->son->cons ) ;
 870 
	tok_info *info = get_tok_info(p->son->cons);
860 
	q = info->def ;
 871 
	q = info->def;
861 
	if ( q && q->cons->sortnum == SORT_completion ) q = q->son ;
 872 
	if (q && q->cons->sortnum == SORT_completion)q = q->son;
862 
	if ( q && q->shape ) return ( 4 ) ;
 873 
	if (q && q->shape) return(4);
863 
	p = p->son ;
 874 
	p = p->son;
864 
    }
 875 
    }
865 
    if ( s > 0 && n == sort_tokens [s] ) {
 876 
    if (s > 0 && n == sort_tokens[s]) {
866 
	tok_info *info = get_tok_info ( p->son->cons ) ;
 877 
	tok_info *info = get_tok_info(p->son->cons);
867 
	q = info->def ;
 878 
	q = info->def;
868 
	if ( q ) return ( 4 ) ;
 879 
	if (q) return(4);
869 
	p = p->son ;
 880 
	p = p->son;
870 
    }
 881 
    }
871 
    for ( q = p->son ; q ; q = q->bro ) {
 882 
    for (q = p->son; q; q = q->bro) {
872 
	int c = contains_tokens ( q, intro, tok ) ;
 883 
	int c = contains_tokens(q, intro, tok);
873 
	if ( c == 1 || c >= tok ) return ( 1 ) ;
 884 
	if (c == 1 || c >= tok) return(1);
874 
    }
 885 
    }
875 
    return ( 0 ) ;
 886 
    return(0);
876 
}
 887 
}
877 
 
 888 
 
878 
 
 889 
 
879 
/*
 890 
/*
880 
    FULLY EXPAND A NODE
 891 
    FULLY EXPAND A NODE
881 
 
 892 
 
882 
    The node p which has contains_tokens value c (see above) is expanded
 893 
    The node p which has contains_tokens value c (see above) is expanded
883 
    recursively.  def is true during the expansion of a token definition.
 894 
    recursively.  def is true during the expansion of a token definition.
884 
*/
 895 
*/
885 
 
 896 
 
886 
static node *expand_fully_aux
 897 
static node *
887 
    PROTO_N ( ( p, c, def ) )
 - 
 
888 
    PROTO_T ( node *p X int c X int def )
 898 
expand_fully_aux(node *p, int c, int def)
889 
{
 899 
{
890 
    node *q ;
 900 
    node *q;
891 
    switch ( c ) {
 901 
    switch (c) {
892 
	case 1 : {
 902 
	case 1: {
893 
	    /* Expand arguments */
 903 
	    /* Expand arguments */
894 
	    node *ap ;
 904 
	    node *ap;
895 
	    node *aq = null ;
 905 
	    node *aq = null;
896 
	    int intro = is_intro_exp ( p->cons ) ;
 906 
	    int intro = is_intro_exp(p->cons);
897 
	    q = new_node () ;
 907 
	    q = new_node();
898 
	    q->cons = p->cons ;
 908 
	    q->cons = p->cons;
899 
	    q->shape = p->shape ;
 909 
	    q->shape = p->shape;
900 
	    for ( ap = p->son ; ap ; ap = ap->bro ) {
 910 
	    for (ap = p->son; ap; ap = ap->bro) {
901 
		node *a ;
 911 
		node *a;
902 
		c = contains_tokens ( ap, intro, 2 ) ;
 912 
		c = contains_tokens(ap, intro, 2);
903 
		a = expand_fully_aux ( ap, c, def ) ;
 913 
		a = expand_fully_aux(ap, c, def);
904 
		if ( aq ) {
 914 
		if (aq) {
905 
		    aq->bro = a ;
 915 
		    aq->bro = a;
906 
		} else {
 916 
		} else {
907 
		    q->son = a ;
 917 
		    q->son = a;
908 
		}
 918 
		}
909 
		aq = a ;
 919 
		aq = a;
910 
	    }
 920 
	    }
911 
	    break ;
 921 
	    break;
912 
	}
 922 
	}
913 
	case 2 : {
 923 
	case 2: {
914 
	    /* Tag or label usage */
 924 
	    /* Tag or label usage */
915 
	    q = copy_node ( p ) ;
 925 
	    q = copy_node(p);
916 
	    q->son = copy_node ( q->son ) ;
 926 
	    q->son = copy_node(q->son);
917 
	    break ;
 927 
	    break;
918 
	}
 928 
	}
919 
	case 3 : {
 929 
	case 3: {
920 
	    /* Tag or label declaration */
 930 
	    /* Tag or label declaration */
921 
	    p->son->cons->alias = null ;
 931 
	    p->son->cons->alias = null;
922 
	    if ( def ) {
 932 
	    if (def) {
923 
		copy_construct ( p->son->cons ) ;
 933 
		copy_construct(p->son->cons);
924 
		q = copy_node ( p ) ;
 934 
		q = copy_node(p);
925 
		q->son = copy_node ( q->son ) ;
 935 
		q->son = copy_node(q->son);
926 
	    } else {
 936 
	    } else {
927 
		q = copy_node ( p ) ;
 937 
		q = copy_node(p);
928 
	    }
 938 
	    }
929 
	    break ;
 939 
	    break;
930 
	}
 940 
	}
931 
	case 4 : {
 941 
	case 4: {
932 
	    /* Token application */
 942 
	    /* Token application */
933 
	    construct *tok = p->son->cons ;
 943 
	    construct *tok = p->son->cons;
934 
	    tok_info *info = get_tok_info ( tok ) ;
 944 
	    tok_info *info = get_tok_info(tok);
935 
	    q = info->def ;
 945 
	    q = info->def;
936 
	    if ( q ) {
 946 
	    if (q) {
937 
		if ( info->depth < 100 ) {
 947 
		if (info->depth < 100) {
938 
		    node *prev ;
 948 
		    node *prev;
939 
		    info->depth++ ;
 949 
		    info->depth++;
940 
		    if ( q->cons->sortnum == SORT_completion ) q = q->son ;
 950 
		    if (q->cons->sortnum == SORT_completion)q = q->son;
941 
		    if ( p->cons == &shape_of ) q = q->shape ;
 951 
		    if (p->cons == &shape_of)q = q->shape;
942 
		    prev = set_token_args ( info->pars, p->son->son, 1 ) ;
 952 
		    prev = set_token_args(info->pars, p->son->son, 1);
943 
		    c = contains_tokens ( q, 0, 2 ) ;
 953 
		    c = contains_tokens(q, 0, 2);
944 
		    q = expand_fully_aux ( q, c, 1 ) ;
 954 
		    q = expand_fully_aux(q, c, 1);
945 
		    IGNORE set_token_args ( info->pars, prev, 0 ) ;
 955 
		    IGNORE set_token_args(info->pars, prev, 0);
946 
		    info->depth-- ;
 956 
		    info->depth--;
947 
		} else {
 957 
		} else {
948 
		    is_fatal = 0 ;
 958 
		    is_fatal = 0;
949 
		    input_error ( "Nested expansion of token %s", tok->name ) ;
 959 
		    input_error("Nested expansion of token %s", tok->name);
950 
		    q = copy_node ( p ) ;
 960 
		    q = copy_node(p);
951 
		    info->depth++ ;
 961 
		    info->depth++;
952 
		}
 962 
		}
953 
	    } else {
 963 
	    } else {
954 
		q = copy_node ( p ) ;
 964 
		q = copy_node(p);
955 
		info->depth++ ;
 965 
		info->depth++;
956 
	    }
 966 
	    }
957 
	    break ;
 967 
	    break;
958 
	}
 968 
	}
959 
	default : {
 969 
	default : {
960 
	    /* Simple construct */
 970 
	    /* Simple construct */
961 
	    q = copy_node ( p ) ;
 971 
	    q = copy_node(p);
962 
	    break ;
 972 
	    break;
963 
	}
 973 
	}
964 
    }
 974 
    }
965 
    return ( q ) ;
 975 
    return(q);
966 
}
 976 
}
967 
 
 977 
 
968 
 
 978 
 
969 
/*
 979 
/*
970 
    EXPAND A SHAPE RECURSIVELY
 980 
    EXPAND A SHAPE RECURSIVELY
971 
 
 981 
 
972 
    All applications of tokens in p are expanded.
 982 
    All applications of tokens in p are expanded.
973 
*/
 983 
*/
974 
 
 984 
 
975 
node *expand_fully
 985 
node *
976 
    PROTO_N ( ( p ) )
 - 
 
977 
    PROTO_T ( node *p )
 986 
expand_fully(node *p)
978 
{
 987 
{
979 
    if ( p ) {
 988 
    if (p) {
980 
	int c = contains_tokens ( p, 0, 4 ) ;
 989 
	int c = contains_tokens(p, 0, 4);
981 
	if ( c ) p = expand_fully_aux ( p, c, 0 ) ;
 990 
	if (c)p = expand_fully_aux(p, c, 0);
982 
    }
 991 
    }
983 
    return ( p ) ;
 992 
    return(p);
984 
}
 993 
}
985 
 
 994 
 
986 
 
 995 
 
987 
/*
 996 
/*
988 
    EXPAND A TOKEN DEFINITION
 997 
    EXPAND A TOKEN DEFINITION
989 
 
 998 
 
990 
    This routine expands all the token definitions in the definition of the
 999 
    This routine expands all the token definitions in the definition of the
991 
    token p.
 1000 
    token p.
992 
*/
 1001 
*/
993 
 
 1002 
 
994 
static void expand_tokdef
 1003 
static void
995 
    PROTO_N ( ( p ) )
 - 
 
996 
    PROTO_T ( construct *p )
 1004 
expand_tokdef(construct *p)
997 
{
 1005 
{
998 
    if ( p->encoding != -1 ) {
 1006 
    if (p->encoding != -1) {
999 
	tok_info *info = get_tok_info ( p ) ;
 1007 
	tok_info *info = get_tok_info(p);
1000 
	IGNORE set_token_args ( info->pars, ( node * ) null, 0 ) ;
 1008 
	IGNORE set_token_args(info->pars,(node *)null, 0);
1001 
	info->def = expand_fully ( info->def ) ;
 1009 
	info->def = expand_fully(info->def);
1002 
    }
 1010 
    }
1003 
    return ;
 1011 
    return;
1004 
}
 1012 
}
1005 
 
 1013 
 
1006 
 
 1014 
 
1007 
/*
 1015 
/*
1008 
    ELIMINATE A TOKEN DEFINITION
 1016 
    ELIMINATE A TOKEN DEFINITION
1009 
 
 1017 
 
1010 
    This routine checks whether p is a local token all of whose uses have
 1018 
    This routine checks whether p is a local token all of whose uses have
1011 
    been expanded.  If so it eliminates p.
 1019 
    been expanded.  If so it eliminates p.
1012 
*/
 1020 
*/
1013 
 
 1021 
 
1014 
static void elim_tokdef
 1022 
static void
1015 
    PROTO_N ( ( p ) )
 - 
 
1016 
    PROTO_T ( construct *p )
 1023 
elim_tokdef(construct *p)
1017 
{
 1024 
{
1018 
    if ( p->encoding != -1 && p->ename == null ) {
 1025 
    if (p->encoding != -1 && p->ename == null) {
1019 
	tok_info *info = get_tok_info ( p ) ;
 1026 
	tok_info *info = get_tok_info(p);
1020 
	if ( info->depth == 0 ) {
 1027 
	if (info->depth == 0) {
1021 
	    remove_var_hash ( p->name, SORT_token ) ;
 1028 
	    remove_var_hash(p->name, SORT_token);
1022 
	}
 1029 
	}
1023 
    }
 1030 
    }
1024 
    return ;
 1031 
    return;
1025 
}
 1032 
}
1026 
 
 1033 
 
1027 
 
 1034 
 
1028 
/*
 1035 
/*
1029 
    EXPAND AN ALIGNMENT TAG DEFINITION
 1036 
    EXPAND AN ALIGNMENT TAG DEFINITION
1030 
 
 1037 
 
1031 
    This routine expands all the token definitions in the definition of the
 1038 
    This routine expands all the token definitions in the definition of the
1032 
    alignment tag p.
 1039 
    alignment tag p.
1033 
*/
 1040 
*/
1034 
 
 1041 
 
1035 
static void expand_aldef
 1042 
static void
1036 
    PROTO_N ( ( p ) )
 - 
 
1037 
    PROTO_T ( construct *p )
 1043 
expand_aldef(construct *p)
1038 
{
 1044 
{
1039 
    if ( p->encoding != -1 ) {
 1045 
    if (p->encoding != -1) {
1040 
	al_tag_info *info = get_al_tag_info ( p ) ;
 1046 
	al_tag_info *info = get_al_tag_info(p);
1041 
	info->def = expand_fully ( info->def ) ;
 1047 
	info->def = expand_fully(info->def);
1042 
    }
 1048 
    }
1043 
    return ;
 1049 
    return;
1044 
}
 1050 
}
1045 
 
 1051 
 
1046 
 
 1052 
 
1047 
/*
 1053 
/*
1048 
    EXPAND A TAG DECLARATION AND DEFINITION
 1054 
    EXPAND A TAG DECLARATION AND DEFINITION
1049 
 
 1055 
 
1050 
    This routine expands all the token definitions in the declaration and
 1056 
    This routine expands all the token definitions in the declaration and
1051 
    definition of the tag p.
 1057 
    definition of the tag p.
1052 
*/
 1058 
*/
1053 
 
 1059 
 
1054 
static void expand_tagdef
 1060 
static void
1055 
    PROTO_N ( ( p ) )
 - 
 
1056 
    PROTO_T ( construct *p )
 1061 
expand_tagdef(construct *p)
1057 
{
 1062 
{
1058 
    if ( p->encoding != -1 ) {
 1063 
    if (p->encoding != -1) {
1059 
	tag_info *info = get_tag_info ( p ) ;
 1064 
	tag_info *info = get_tag_info(p);
1060 
	info->dec = expand_fully ( info->dec ) ;
 1065 
	info->dec = expand_fully(info->dec);
1061 
	info->def = expand_fully ( info->def ) ;
 1066 
	info->def = expand_fully(info->def);
1062 
    }
 1067 
    }
1063 
    return ;
 1068 
    return;
1064 
}
 1069 
}
1065 
 
 1070 
 
1066 
 
 1071 
 
1067 
/*
 1072 
/*
1068 
    EXPAND ALL TOKEN DEFINITIONS
 1073 
    EXPAND ALL TOKEN DEFINITIONS
1069 
 
 1074 
 
1070 
    This routine expands all defined tokens.
 1075 
    This routine expands all defined tokens.
1071 
*/
 1076 
*/
1072 
 
 1077 
 
1073 
void expand_all
 1078 
void
1074 
    PROTO_Z ()
 1079 
expand_all(void)
1075 
{
 1080 
{
1076 
    apply_to_all ( expand_tokdef, SORT_token ) ;
 1081 
    apply_to_all(expand_tokdef, SORT_token);
1077 
    apply_to_all ( expand_aldef, SORT_al_tag ) ;
 1082 
    apply_to_all(expand_aldef, SORT_al_tag);
1078 
    apply_to_all ( expand_tagdef, SORT_tag ) ;
 1083 
    apply_to_all(expand_tagdef, SORT_tag);
1079 
    apply_to_all ( elim_tokdef, SORT_token ) ;
 1084 
    apply_to_all(elim_tokdef, SORT_token);
1080 
    removals = null ;
 1085 
    removals = null;
1081 
    return ;
 1086 
    return;
1082 
}
 1087 
}