Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
2 
    		 Crown Copyright (c) 1997
3 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
12 
 
13 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
15 
 
16 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
19 
 
20 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
23 
 
24 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
28 
*/
29 
 
30 
 
31 
/*** types.c --- Type ADTs.
32 
 *
33 
 ** Author: Steve Folkes <smf@hermes.mod.uk>
34 
 *
35 
 *** Commentary:
36 
 *
37 
 * This file implements the type manipulation routines specified.
38 
 *
39 
 *** Change Log:
40 
 * $Log: types.c,v $
41 
 * Revision 1.1.1.1  1998/01/17  15:57:47  release
42 
 * First version to be checked into rolling release.
43 
 *
44 
 * Revision 1.2  1994/12/15  09:59:13  smf
45 
 * Brought into line with OSSG C Coding Standards Document, as per
46 
 * "CR94_178.sid+tld-update".
47 
 *
48 
 * Revision 1.1.1.1  1994/07/25  16:04:44  smf
49 
 * Initial import of SID 1.8 non shared files.
50 
 *
51 
**/
52 
 
53 
/****************************************************************************/
54 
 
55 
#include "types.h"
56 
#include "dalloc.h"
57 
#include "gen-errors.h"
58 
#include "name.h"
59 
#include "rstack.h"
60 
#include "rule.h"
61 
#include "table.h"
62 
 
63 
/*==========================================================================*\
64 
|| Type tuple handling fuctions.
65 
\*==========================================================================*/
66 
 
67 
static void
68 
types_add_name_and_type_1 PROTO_N ((to, name, type, reference, assign))
69 
			  PROTO_T (TypeTupleP  to X
70 
				   EntryP      name X
71 
				   EntryP      type X
72 
				   BoolT       reference X
73 
				   BoolT       assign)
74 
{
75 
    TypeTupleEntryP link = ALLOCATE (TypeTupleEntryT);
76 
 
77 
    link->next      = NIL (TypeTupleEntryP);
78 
    link->type      = type;
79 
    link->name      = name;
80 
    link->reference = reference;
81 
    link->mutated   = FALSE;
82 
    link->assign    = assign;
83 
    *(to->tail)     = link;
84 
    to->tail        = &(link->next);
85 
}
86 
 
87 
static void
88 
types_iter_alt_item_type_names PROTO_N ((alts, proc))
89 
			       PROTO_T (AltP   alts X
90 
					void (*proc) PROTO_S ((NameP)))
91 
{
92 
    AltP            alt;
93 
    TypeTupleEntryP type;
94 
 
95 
    for (alt = alts; alt; alt = alt_next (alt)) {
96 
	ItemP item;
97 
 
98 
	for (item = alt_item_head (alt); item; item = item_next (item)) {
99 
	    TypeTupleP param  = item_param (item);
100 
	    TypeTupleP result = item_result (item);
101 
 
102 
	    for (type = param->head; type; type = type->next) {
103 
		(*proc) (entry_get_name (type->name));
104 
	    }
105 
	    for (type = result->head; type; type = type->next) {
106 
		(*proc) (entry_get_name (type->name));
107 
	    }
108 
	}
109 
    }
110 
}
111 
 
112 
/*--------------------------------------------------------------------------*/
113 
 
114 
void
115 
types_init PROTO_N ((tuple))
116 
	   PROTO_T (TypeTupleP tuple)
117 
{
118 
    tuple->head = NIL (TypeTupleEntryP);
119 
    tuple->tail = &(tuple->head);
120 
}
121 
 
122 
void
123 
types_copy PROTO_N ((to, from))
124 
	   PROTO_T (TypeTupleP to X
125 
		    TypeTupleP from)
126 
{
127 
    TypeTupleEntryP from_ptr;
128 
 
129 
    to->head = NIL (TypeTupleEntryP);
130 
    to->tail = &(to->head);
131 
    for (from_ptr = from->head; from_ptr; from_ptr = from_ptr->next) {
132 
	types_add_name_and_type_1 (to, from_ptr->name, from_ptr->type,
133 
				   from_ptr->reference, from_ptr->assign);
134 
    }
135 
}
136 
 
137 
void
138 
types_copy_and_translate PROTO_N ((to, from, translator, table))
139 
			 PROTO_T (TypeTupleP to X
140 
				  TypeTupleP from X
141 
				  TypeTransP translator X
142 
				  TableP     table)
143 
{
144 
    TypeTupleEntryP from_ptr;
145 
 
146 
    to->head = NIL (TypeTupleEntryP);
147 
    to->tail = &(to->head);
148 
    for (from_ptr = from->head; from_ptr; from_ptr = from_ptr->next) {
149 
	EntryP new_name;
150 
 
151 
	new_name = trans_get_translation (translator, from_ptr->name);
152 
	if (new_name == NIL (EntryP)) {
153 
	    new_name = table_add_generated_name (table);
154 
	    trans_add_translation (translator, from_ptr->name, new_name);
155 
	}
156 
	types_add_name_and_type_1 (to, new_name, from_ptr->type,
157 
				   from_ptr->reference, from_ptr->assign);
158 
    }
159 
}
160 
 
161 
void
162 
types_append_copy PROTO_N ((to, from))
163 
		  PROTO_T (TypeTupleP to X
164 
			   TypeTupleP from)
165 
{
166 
    TypeTupleEntryP from_ptr;
167 
 
168 
    for (from_ptr = from->head; from_ptr; from_ptr = from_ptr->next) {
169 
	types_add_name_and_type_1 (to, from_ptr->name, from_ptr->type,
170 
				   from_ptr->reference, from_ptr->assign);
171 
    }
172 
}
173 
 
174 
void
175 
types_translate PROTO_N ((tuple, translator))
176 
		PROTO_T (TypeTupleP  tuple X
177 
			 TypeBTransP translator)
178 
{
179 
    TypeTupleEntryP tuple_ptr;
180 
 
181 
    for (tuple_ptr = tuple->head; tuple_ptr; tuple_ptr = tuple_ptr->next) {
182 
	EntryP new_name;
183 
 
184 
	new_name = btrans_get_translation (translator, tuple_ptr->name);
185 
	if (new_name != NIL (EntryP)) {
186 
	    tuple_ptr->name = new_name;
187 
	}
188 
    }
189 
}
190 
 
191 
void
192 
types_renumber PROTO_N ((tuple, translator))
193 
	       PROTO_T (TypeTupleP  tuple X
194 
			TypeNTransP translator)
195 
{
196 
    TypeTupleEntryP tuple_ptr;
197 
 
198 
    for (tuple_ptr = tuple->head; tuple_ptr; tuple_ptr = tuple_ptr->next) {
199 
	if (!entry_is_non_local (tuple_ptr->name)) {
200 
	    tuple_ptr->number = ntrans_get_translation (translator,
201 
							tuple_ptr->name);
202 
	}
203 
    }
204 
}
205 
 
206 
void
207 
types_assign PROTO_N ((to, from))
208 
	     PROTO_T (TypeTupleP to X
209 
		      TypeTupleP from)
210 
{
211 
    if ((to->head = from->head) != NIL (TypeTupleEntryP)) {
212 
	to->tail = from->tail;
213 
    } else {
214 
	to->tail = &(to->head);
215 
    }
216 
}
217 
 
218 
EntryP
219 
types_find_name_type PROTO_N ((tuple, name, reference_ref))
220 
		     PROTO_T (TypeTupleP tuple X
221 
			      EntryP     name X
222 
			      BoolT     *reference_ref)
223 
{
224 
    TypeTupleEntryP type;
225 
 
226 
    for (type = tuple->head; type; type = type->next) {
227 
	if (type->name == name) {
228 
	    *reference_ref = type->reference;
229 
	    return (type->type);
230 
	}
231 
    }
232 
    return (NIL (EntryP));
233 
}
234 
 
235 
BoolT
236 
types_mutated PROTO_N ((tuple, name))
237 
	      PROTO_T (TypeTupleP tuple X
238 
		       EntryP     name)
239 
{
240 
    TypeTupleEntryP type;
241 
 
242 
    for (type = tuple->head; type; type = type->next) {
243 
	if (type->name == name) {
244 
	    type->mutated = TRUE;
245 
	    return (TRUE);
246 
	}
247 
    }
248 
    return (FALSE);
249 
}
250 
 
251 
BoolT
252 
types_compute_mutations PROTO_N ((rule, item, action))
253 
			PROTO_T (TypeTupleP rule X
254 
				 TypeTupleP item X
255 
				 TypeTupleP action)
256 
{
257 
    BoolT           propogate  = FALSE;
258 
    TypeTupleEntryP item_ptr   = item->head;
259 
    TypeTupleEntryP action_ptr = action->head;
260 
 
261 
    while (action_ptr) {
262 
	ASSERT (item_ptr);
263 
	if (action_ptr->mutated) {
264 
	    TypeTupleEntryP rule_ptr = rule->head;
265 
 
266 
	    while (rule_ptr) {
267 
		if ((rule_ptr->name == item_ptr->name) &&
268 
		    (!(rule_ptr->mutated))) {
269 
		    rule_ptr->mutated = TRUE;
270 
		    if (rule_ptr->reference) {
271 
			propogate = TRUE;
272 
		    }
273 
		    break;
274 
		}
275 
		rule_ptr = rule_ptr->next;
276 
	    }
277 
	}
278 
	item_ptr   = item_ptr->next;
279 
	action_ptr = action_ptr->next;
280 
    }
281 
    ASSERT (item_ptr == NIL (TypeTupleEntryP));
282 
    return (propogate);
283 
}
284 
 
285 
BoolT
286 
types_compute_assign_mutations PROTO_N ((rule, item))
287 
			       PROTO_T (TypeTupleP rule X
288 
					TypeTupleP item)
289 
{
290 
    BoolT           propogate  = FALSE;
291 
    TypeTupleEntryP item_ptr   = item->head;
292 
 
293 
    while (item_ptr) {
294 
	if (item_ptr->assign) {
295 
	    TypeTupleEntryP rule_ptr = rule->head;
296 
 
297 
	    while (rule_ptr) {
298 
		if ((rule_ptr->name == item_ptr->name) &&
299 
		    (!(rule_ptr->mutated))) {
300 
		    rule_ptr->mutated = TRUE;
301 
		    if (rule_ptr->reference) {
302 
			propogate = TRUE;
303 
		    }
304 
		    break;
305 
		}
306 
		rule_ptr = rule_ptr->next;
307 
	    }
308 
	}
309 
	item_ptr = item_ptr->next;
310 
    }
311 
    return (propogate);
312 
}
313 
 
314 
void
315 
types_propogate_mutations PROTO_N ((to, from))
316 
			  PROTO_T (TypeTupleP to X
317 
				   TypeTupleP from)
318 
{
319 
    TypeTupleEntryP to_ptr   = to->head;
320 
    TypeTupleEntryP from_ptr = from->head;
321 
 
322 
    while (to_ptr) {
323 
	ASSERT (from_ptr);
324 
	to_ptr->mutated = from_ptr->mutated;
325 
	to_ptr          = to_ptr->next;
326 
	from_ptr        = from_ptr->next;
327 
    }
328 
    ASSERT (from_ptr == NIL (TypeTupleEntryP));
329 
}
330 
 
331 
BoolT
332 
types_contains PROTO_N ((tuple, name))
333 
	       PROTO_T (TypeTupleP tuple X
334 
			EntryP     name)
335 
{
336 
    TypeTupleEntryP type;
337 
 
338 
    for (type = tuple->head; type; type = type->next) {
339 
	if (type->name == name) {
340 
	    return (TRUE);
341 
	}
342 
    }
343 
    return (FALSE);
344 
}
345 
 
346 
BoolT
347 
types_contains_names PROTO_N ((tuple))
348 
		     PROTO_T (TypeTupleP tuple)
349 
{
350 
    TypeTupleEntryP type;
351 
 
352 
    for (type = tuple->head; type; type = type->next) {
353 
	if (type->name) {
354 
	    return (TRUE);
355 
	}
356 
    }
357 
    return (FALSE);
358 
}
359 
 
360 
BoolT
361 
types_contains_references PROTO_N ((tuple))
362 
			  PROTO_T (TypeTupleP tuple)
363 
{
364 
    TypeTupleEntryP type;
365 
 
366 
    for (type = tuple->head; type; type = type->next) {
367 
	if (type->reference) {
368 
	    return (TRUE);
369 
	}
370 
    }
371 
    return (FALSE);
372 
}
373 
 
374 
void
375 
types_make_references PROTO_N ((param, args))
376 
		      PROTO_T (TypeTupleP param X
377 
			       TypeTupleP args)
378 
{
379 
    TypeTupleEntryP ptr;
380 
 
381 
    for (ptr = param->head; ptr; ptr = ptr->next) {
382 
	ptr->reference = TRUE;
383 
    }
384 
    for (ptr = args->head; ptr; ptr = ptr->next) {
385 
	ptr->reference = TRUE;
386 
    }
387 
}
388 
 
389 
BoolT
390 
types_intersect PROTO_N ((tuple1, tuple2))
391 
		PROTO_T (TypeTupleP tuple1 X
392 
			 TypeTupleP tuple2)
393 
{
394 
    TypeTupleEntryP type;
395 
 
396 
    for (type = tuple1->head; type; type = type->next) {
397 
	if (types_contains (tuple2, type->name)) {
398 
	    return (TRUE);
399 
	}
400 
    }
401 
    return (FALSE);
402 
}
403 
 
404 
void
405 
types_inplace_intersection PROTO_N ((to, from))
406 
			   PROTO_T (TypeTupleP to X
407 
				    TypeTupleP from)
408 
{
409 
    TypeTupleEntryP type;
410 
 
411 
    to->tail = &(to->head);
412 
    while ((type = *(to->tail)) != NIL (TypeTupleEntryP)) {
413 
	if (!types_contains (from, type->name)) {
414 
	    *(to->tail) = type->next;
415 
	    DEALLOCATE (type);
416 
	} else {
417 
	    to->tail = &(type->next);
418 
	}
419 
    }
420 
}
421 
 
422 
void
423 
types_compute_intersection PROTO_N ((to, tuple1, tuple2))
424 
			   PROTO_T (TypeTupleP to X
425 
				    TypeTupleP tuple1 X
426 
				    TypeTupleP tuple2)
427 
{
428 
    TypeTupleEntryP type;
429 
 
430 
    for (type = tuple1->head; type; type = type->next) {
431 
	if ((types_contains (tuple2, type->name)) &&
432 
	    (!types_contains (to, type->name))) {
433 
	    types_add_name_and_type_1 (to, type->name, type->type,
434 
				       type->reference, type->assign);
435 
	}
436 
    }
437 
}
438 
 
439 
CmpT
440 
types_compare PROTO_N ((tuple1, tuple2))
441 
	      PROTO_T (TypeTupleP tuple1 X
442 
		       TypeTupleP tuple2)
443 
{
444 
    TypeTupleEntryP tuple1_ptr = (tuple1->head);
445 
    TypeTupleEntryP tuple2_ptr = (tuple2->head);
446 
 
447 
    while (tuple1_ptr && tuple2_ptr) {
448 
	if (tuple1_ptr->number < tuple2_ptr->number) {
449 
	    return (CMP_LT);
450 
	} else if (tuple1_ptr->number > tuple2_ptr->number) {
451 
	    return (CMP_GT);
452 
	}
453 
	switch (key_compare (entry_key (tuple1_ptr->type),
454 
			     entry_key (tuple2_ptr->type))) EXHAUSTIVE {
455 
	  case CMP_LT:
456 
	    return (CMP_LT);
457 
	  case CMP_GT:
458 
	    return (CMP_GT);
459 
	  case CMP_EQ:
460 
	    break;
461 
	}
462 
	if (tuple1_ptr->reference != tuple2_ptr->reference) {
463 
	    return ((CmpT) ((tuple1_ptr->reference) ? CMP_GT : CMP_LT));
464 
	} else if (tuple1_ptr->assign != tuple2_ptr->assign) {
465 
	    return ((CmpT) ((tuple1_ptr->assign) ? CMP_GT : CMP_LT));
466 
	}
467 
	tuple1_ptr = tuple1_ptr->next;
468 
	tuple2_ptr = tuple2_ptr->next;
469 
    }
470 
    if (tuple1_ptr != NIL (TypeTupleEntryP)) {
471 
	return (CMP_GT);
472 
    } else if (tuple2_ptr != NIL (TypeTupleEntryP)) {
473 
	return (CMP_LT);
474 
    } else {
475 
	return (CMP_EQ);
476 
    }
477 
}
478 
 
479 
BoolT
480 
types_equal PROTO_N ((tuple1, tuple2))
481 
	    PROTO_T (TypeTupleP tuple1 X
482 
		     TypeTupleP tuple2)
483 
{
484 
    TypeTupleEntryP tuple1_ptr = (tuple1->head);
485 
    TypeTupleEntryP tuple2_ptr = (tuple2->head);
486 
 
487 
    while ((tuple1_ptr) && (tuple2_ptr)) {
488 
	if (((tuple1_ptr->type) != (tuple2_ptr->type)) ||
489 
	    ((tuple1_ptr->reference) != (tuple2_ptr->reference)) ||
490 
	    ((tuple1_ptr->assign) != (tuple2_ptr->assign))) {
491 
	    return (FALSE);
492 
	}
493 
	tuple1_ptr = (tuple1_ptr->next);
494 
	tuple2_ptr = (tuple2_ptr->next);
495 
    }
496 
    return ((tuple1_ptr == NIL (TypeTupleEntryP)) &&
497 
	    (tuple2_ptr == NIL (TypeTupleEntryP)));
498 
}
499 
 
500 
#ifdef FS_FAST
501 
#undef types_equal_zero_tuple
502 
#endif /* defined (FS_FAST) */
503 
BoolT
504 
types_equal_zero_tuple PROTO_N ((tuple))
505 
		       PROTO_T (TypeTupleP tuple)
506 
{
507 
    return (tuple->head == NIL (TypeTupleEntryP));
508 
}
509 
#ifdef FS_FAST
510 
#define types_equal_zero_tuple(t) ((t)->head == NIL (TypeTupleEntryP))
511 
#endif /* defined (FS_FAST) */
512 
 
513 
BoolT
514 
types_equal_names PROTO_N ((tuple1, tuple2))
515 
		  PROTO_T (TypeTupleP tuple1 X
516 
			   TypeTupleP tuple2)
517 
{
518 
    TypeTupleEntryP tuple1_ptr = (tuple1->head);
519 
    TypeTupleEntryP tuple2_ptr = (tuple2->head);
520 
 
521 
    while ((tuple1_ptr) && (tuple2_ptr)) {
522 
	if (((tuple1_ptr->type) != (tuple2_ptr->type)) ||
523 
	    ((tuple1_ptr->reference) != (tuple2_ptr->reference)) ||
524 
	    ((tuple1_ptr->assign) != (tuple2_ptr->assign)) ||
525 
	    ((tuple1_ptr->name) != (tuple2_ptr->name))) {
526 
	    return (FALSE);
527 
	}
528 
	tuple1_ptr = (tuple1_ptr->next);
529 
	tuple2_ptr = (tuple2_ptr->next);
530 
    }
531 
    return ((tuple1_ptr == NIL (TypeTupleEntryP)) &&
532 
	    (tuple2_ptr == NIL (TypeTupleEntryP)));
533 
}
534 
 
535 
BoolT
536 
types_equal_numbers PROTO_N ((tuple1, tuple2))
537 
		    PROTO_T (TypeTupleP tuple1 X
538 
			     TypeTupleP tuple2)
539 
{
540 
    TypeTupleEntryP tuple1_ptr = (tuple1->head);
541 
    TypeTupleEntryP tuple2_ptr = (tuple2->head);
542 
 
543 
    while ((tuple1_ptr) && (tuple2_ptr)) {
544 
	if ((tuple1_ptr->type != tuple2_ptr->type) ||
545 
	    (tuple1_ptr->reference != tuple2_ptr->reference) ||
546 
	    (tuple1_ptr->assign != tuple2_ptr->assign)) {
547 
	    return (FALSE);
548 
	} else if (entry_is_non_local (tuple1_ptr->name) ||
549 
		   entry_is_non_local (tuple2_ptr->name)) {
550 
	    if (tuple1_ptr->name != tuple2_ptr->name) {
551 
		return (FALSE);
552 
	    }
553 
	} else if (tuple1_ptr->number != tuple2_ptr->number) {
554 
	    return (FALSE);
555 
	}
556 
	tuple1_ptr = (tuple1_ptr->next);
557 
	tuple2_ptr = (tuple2_ptr->next);
558 
    }
559 
    return ((tuple1_ptr == NIL (TypeTupleEntryP)) &&
560 
	    (tuple2_ptr == NIL (TypeTupleEntryP)));
561 
}
562 
 
563 
void
564 
types_add_name_and_type PROTO_N ((to, name, type, reference))
565 
			PROTO_T (TypeTupleP  to X
566 
				 EntryP      name X
567 
				 EntryP      type X
568 
				 BoolT       reference)
569 
{
570 
    types_add_name_and_type_1 (to, name, type, reference, FALSE);
571 
}
572 
 
573 
void
574 
types_add_name_and_type_var PROTO_N ((to, name, type))
575 
			    PROTO_T (TypeTupleP  to X
576 
				     EntryP      name X
577 
				     EntryP      type)
578 
{
579 
    types_add_name_and_type_1 (to, name, type, FALSE, TRUE);
580 
}
581 
 
582 
BoolT
583 
types_add_type PROTO_N ((tuple, table, name, reference))
584 
	       PROTO_T (TypeTupleP tuple X
585 
			TableP     table X
586 
			NStringP   name X
587 
			BoolT      reference)
588 
{
589 
    EntryP entry = table_get_type (table, name);
590 
 
591 
    if (entry) {
592 
	types_add_name_and_type (tuple, NIL (EntryP), entry, reference);
593 
	return (TRUE);
594 
    }
595 
    return (FALSE);
596 
}
597 
 
598 
void
599 
types_add_name PROTO_N ((tuple, table, name, reference))
600 
	       PROTO_T (TypeTupleP tuple X
601 
			TableP     table X
602 
			NStringP   name X
603 
			BoolT      reference)
604 
{
605 
    EntryP entry = table_add_name (table, name);
606 
 
607 
    types_add_name_and_type (tuple, entry, NIL (EntryP), reference);
608 
}
609 
 
610 
BoolT
611 
types_add_typed_name PROTO_N ((tuple, table, name, type, reference))
612 
		     PROTO_T (TypeTupleP tuple X
613 
			      TableP     table X
614 
			      NStringP   name X
615 
			      NStringP   type X
616 
			      BoolT      reference)
617 
{
618 
    EntryP type_entry = table_get_type (table, type);
619 
    EntryP name_entry = table_add_name (table, name);
620 
 
621 
    if (type_entry) {
622 
	types_add_name_and_type (tuple, name_entry, type_entry, reference);
623 
	return (TRUE);
624 
    }
625 
    return (FALSE);
626 
}
627 
 
628 
void
629 
types_add_name_entry PROTO_N ((tuple, entry))
630 
		     PROTO_T (TypeTupleP tuple X
631 
			      EntryP     entry)
632 
{
633 
    types_add_name_and_type (tuple, entry, NIL (EntryP), FALSE);
634 
}
635 
 
636 
void
637 
types_add_type_entry PROTO_N ((tuple, entry, reference))
638 
		     PROTO_T (TypeTupleP tuple X
639 
			      EntryP     entry X
640 
			      BoolT      reference)
641 
{
642 
    types_add_name_and_type (tuple, NIL (EntryP), entry, reference);
643 
}
644 
 
645 
void
646 
types_add_new_names PROTO_N ((to, from, exclude))
647 
		    PROTO_T (TypeTupleP to X
648 
			     TypeTupleP from X
649 
			     EntryP     exclude)
650 
{
651 
    TypeTupleEntryP from_ptr;
652 
 
653 
    for (from_ptr = from->head; from_ptr; from_ptr = from_ptr->next) {
654 
	if ((from_ptr->name != exclude) &&
655 
	    (!(from_ptr->assign)) &&
656 
	    (!types_contains (to, from_ptr->name))) {
657 
	    types_add_name_and_type (to, from_ptr->name, from_ptr->type,
658 
				     from_ptr->reference);
659 
	}
660 
    }
661 
}
662 
 
663 
BoolT
664 
types_disjoint_names PROTO_N ((tuple))
665 
		     PROTO_T (TypeTupleP tuple)
666 
{
667 
    BoolT           disjoint = TRUE;
668 
    TypeTupleEntryP ptr;
669 
 
670 
    for (ptr = tuple->head; ptr; ptr = ptr->next) {
671 
	if (ptr->name) {
672 
	    if (name_test_and_set_clash (entry_get_name (ptr->name))) {
673 
		disjoint = FALSE;
674 
		goto done;
675 
	    }
676 
	} else {
677 
	    disjoint = FALSE;
678 
	    goto done;
679 
	}
680 
    }
681 
  done:
682 
    for (ptr = tuple->head; ptr; ptr = ptr->next) {
683 
	if (ptr->name) {
684 
	    name_reset_clash (entry_get_name (ptr->name));
685 
	}
686 
    }
687 
    return (disjoint);
688 
}
689 
 
690 
BoolT
691 
types_resolve PROTO_N ((to, args, locals, unknown_proc, rule, alt))
692 
	      PROTO_T (TypeTupleP to X
693 
		       TypeTupleP args X
694 
		       TypeTupleP locals X
695 
		       void     (*unknown_proc) PROTO_S ((KeyP, KeyP,
696 
							  unsigned)) X
697 
		       KeyP       rule X
698 
		       unsigned   alt)
699 
{
700 
    BoolT           ok = TRUE;
701 
    TypeTupleEntryP name;
702 
 
703 
    for (name = to->head; name; name = name->next) {
704 
	BoolT reference;
705 
 
706 
	if (entry_is_non_local (name->name)) {
707 
	    name->type = entry_get_non_local (name->name);
708 
	} else if (((name->type = types_find_name_type (args, name->name,
709 
							&reference)) ==
710 
		    NIL (EntryP)) &&
711 
		   ((name->type = types_find_name_type (locals, name->name,
712 
							&reference)) ==
713 
		    NIL (EntryP))) {
714 
	    (*unknown_proc) (entry_key (name->name), rule, alt);
715 
	    ok = FALSE;
716 
	}
717 
    }
718 
    return (ok);
719 
}
720 
 
721 
BoolT
722 
types_check_undefined PROTO_N ((to, args, locals, error_proc, rule, alt))
723 
		      PROTO_T (TypeTupleP to X
724 
			       TypeTupleP args X
725 
			       TypeTupleP locals X
726 
			       void     (*error_proc) PROTO_S ((KeyP, KeyP,
727 
								unsigned)) X
728 
			       KeyP       rule X
729 
			       unsigned   alt)
730 
{
731 
    BoolT           ok = TRUE;
732 
    TypeTupleEntryP name;
733 
 
734 
    for (name = to->head; name; name = name->next) {
735 
	if ((!(name->assign)) &&
736 
	    (entry_is_non_local (name->name) ||
737 
	     types_contains (args, name->name) ||
738 
	     types_contains (locals, name->name))) {
739 
	    (*error_proc) (entry_key (name->name), rule, alt);
740 
	    ok = FALSE;
741 
	}
742 
    }
743 
    return (ok);
744 
}
745 
 
746 
BoolT
747 
types_fillin_types PROTO_N ((to, from))
748 
		   PROTO_T (TypeTupleP to X
749 
			    TypeTupleP from)
750 
{
751 
    TypeTupleEntryP to_ptr   = to->head;
752 
    TypeTupleEntryP from_ptr = from->head;
753 
 
754 
    while ((to_ptr) && (from_ptr)) {
755 
	if (to_ptr->type == NIL (EntryP)) {
756 
	    to_ptr->type      = from_ptr->type;
757 
	    to_ptr->reference = from_ptr->reference;
758 
	} else if ((to_ptr->type != from_ptr->type) ||
759 
		   (to_ptr->reference != from_ptr->reference)) {
760 
	    return (FALSE);
761 
	}
762 
	to_ptr   = to_ptr->next;
763 
	from_ptr = from_ptr->next;
764 
    }
765 
    return ((to_ptr == NIL (TypeTupleEntryP)) &&
766 
	    (from_ptr == NIL (TypeTupleEntryP)));
767 
}
768 
 
769 
BoolT
770 
types_fillin_names PROTO_N ((to, from))
771 
		   PROTO_T (TypeTupleP to X
772 
			    TypeTupleP from)
773 
{
774 
    TypeTupleEntryP to_ptr   = to->head;
775 
    TypeTupleEntryP from_ptr = from->head;
776 
 
777 
    while ((to_ptr) && (from_ptr)) {
778 
	ASSERT (to_ptr->name == NIL (EntryP));
779 
	to_ptr->name = from_ptr->name;
780 
	if ((from_ptr->type) &&
781 
	    ((to_ptr->type != from_ptr->type) ||
782 
	     (to_ptr->reference != from_ptr->reference))) {
783 
	    return (FALSE);
784 
	}
785 
	to_ptr   = to_ptr->next;
786 
	from_ptr = from_ptr->next;
787 
    }
788 
    return ((to_ptr == NIL (TypeTupleEntryP)) &&
789 
	    (from_ptr == NIL (TypeTupleEntryP)));
790 
}
791 
 
792 
BoolT
793 
types_check_names PROTO_N ((to, from))
794 
		  PROTO_T (TypeTupleP to X
795 
			   TypeTupleP from)
796 
{
797 
    TypeTupleEntryP to_ptr;
798 
 
799 
    for (to_ptr = to->head; to_ptr; to_ptr = to_ptr->next) {
800 
	BoolT reference;
801 
 
802 
	if ((types_find_name_type (from, to_ptr->name, &reference) !=
803 
	     to_ptr->type) ||
804 
	    (reference != to_ptr->reference)) {
805 
	    return (FALSE);
806 
	}
807 
    }
808 
    return (TRUE);
809 
}
810 
 
811 
void
812 
types_check_used PROTO_N ((tuple, error_proc, gclosure))
813 
		 PROTO_T (TypeTupleP tuple X
814 
			  void     (*error_proc) PROTO_S ((GenericP, EntryP)) X
815 
			  GenericP   gclosure)
816 
{
817 
    TypeTupleEntryP ptr;
818 
 
819 
    for (ptr = tuple->head; ptr; ptr = ptr->next) {
820 
	ASSERT (!entry_is_non_local (ptr->name));
821 
	if (!name_is_used (entry_get_name (ptr->name))) {
822 
	    (*error_proc) (gclosure, ptr->name);
823 
	}
824 
    }
825 
}
826 
 
827 
void
828 
types_unlink_used PROTO_N ((to, from))
829 
		  PROTO_T (TypeTupleP to X
830 
			   TypeTupleP from)
831 
{
832 
    TypeTupleEntryP type;
833 
 
834 
    to->tail = &(to->head);
835 
    while ((type = *(to->tail)) != NIL (TypeTupleEntryP)) {
836 
	if (types_contains (from, type->name)) {
837 
	    *(to->tail) = type->next;
838 
	    DEALLOCATE (type);
839 
	} else {
840 
	    to->tail = &(type->next);
841 
	}
842 
    }
843 
}
844 
 
845 
void
846 
types_unlink_unused PROTO_N ((tuple, alts))
847 
		    PROTO_T (TypeTupleP tuple X
848 
			     AltP       alts)
849 
{
850 
    TypeTupleEntryP type;
851 
 
852 
    types_iter_alt_item_type_names (alts, name_used);
853 
    tuple->tail = &(tuple->head);
854 
    while ((type = *(tuple->tail)) != NIL (TypeTupleEntryP)) {
855 
	ASSERT (!entry_is_non_local (type->name));
856 
	if (name_is_used (entry_get_name (type->name))) {
857 
	    tuple->tail = &(type->next);
858 
	} else {
859 
	    *(tuple->tail) = type->next;
860 
	    DEALLOCATE (type);
861 
	}
862 
    }
863 
    types_iter_alt_item_type_names (alts, name_not_used);
864 
}
865 
 
866 
void
867 
types_compute_formal_renaming PROTO_N ((names, translator))
868 
			      PROTO_T (TypeTupleP  names X
869 
				       TypeRTransP translator)
870 
{
871 
    TypeTupleEntryP ptr;
872 
 
873 
    for (ptr = names->head; ptr; ptr = ptr->next) {
874 
	rtrans_add_translation (translator, ptr->name, ptr->name, ptr->type,
875 
				ptr->reference);
876 
    }
877 
}
878 
 
879 
void
880 
types_compute_formal_inlining PROTO_N ((names, renames, translator, state))
881 
			      PROTO_T (TypeTupleP  names X
882 
				       TypeTupleP  renames X
883 
				       TypeRTransP translator X
884 
				       SaveRStackP state)
885 
{
886 
    TypeTupleEntryP ptr   = names->head;
887 
    TypeTupleEntryP reptr = renames->head;
888 
 
889 
    while (ptr) {
890 
	EntryP entry;
891 
	EntryP type;
892 
	BoolT  reference;
893 
 
894 
	ASSERT (reptr);
895 
	entry = rstack_get_translation (state, reptr->name, &type, &reference);
896 
	ASSERT (entry);
897 
	rtrans_add_translation (translator, ptr->name, entry, type, reference);
898 
	ptr   = ptr->next;
899 
	reptr = reptr->next;
900 
    }
901 
    ASSERT (reptr == NIL (TypeTupleEntryP));
902 
}
903 
 
904 
void
905 
types_compute_local_renaming PROTO_N ((names, exclude, translator, state,
906 
				       table))
907 
			     PROTO_T (TypeTupleP  names X
908 
				      TypeTupleP  exclude X
909 
				      TypeRTransP translator X
910 
				      SaveRStackP state X
911 
				      TableP      table)
912 
{
913 
    TypeTupleEntryP ptr;
914 
 
915 
    for (ptr = names->head; ptr; ptr = ptr->next) {
916 
	if (!types_contains (exclude, ptr->name)) {
917 
	    EntryP type;
918 
	    BoolT  reference;
919 
 
920 
	    if (rstack_get_translation (state, ptr->name, &type,
921 
					&reference) != NIL (EntryP)) {
922 
		EntryP entry = table_add_generated_name (table);
923 
 
924 
		rtrans_add_translation (translator, ptr->name, entry,
925 
					ptr->type, ptr->reference);
926 
	    } else {
927 
		rtrans_add_translation (translator, ptr->name, ptr->name,
928 
					ptr->type, ptr->reference);
929 
	    }
930 
	}
931 
    }
932 
}
933 
 
934 
void
935 
types_compute_param_from_trans PROTO_N ((new_param, from_translator,
936 
					 to_translator, old_param))
937 
			       PROTO_T (TypeTupleP  new_param X
938 
					TypeNTransP from_translator X
939 
					TypeNTransP to_translator X
940 
					TypeTupleP  old_param)
941 
{
942 
    TypeTupleEntryP ptr;
943 
 
944 
    types_init (new_param);
945 
    for (ptr = old_param->head; ptr; ptr = ptr->next) {
946 
	EntryP entry = ntrans_get_indirect_translation (from_translator,
947 
							to_translator,
948 
							ptr->name);
949 
 
950 
	if (entry) {
951 
	    types_add_name_and_type (new_param, entry, ptr->type,
952 
				     ptr->reference);
953 
	}
954 
    }
955 
}
956 
 
957 
BoolT
958 
types_check_shadowing PROTO_N ((tuple, stack, rule))
959 
		      PROTO_T (TypeTupleP  tuple X
960 
			       ScopeStackP stack X
961 
			       RuleP       rule)
962 
{
963 
    BoolT           errored = FALSE;
964 
    TypeTupleEntryP ptr;
965 
 
966 
    for (ptr = tuple->head; ptr; ptr = ptr->next) {
967 
	if (scope_stack_check_shadowing (stack, ptr->name, rule)) {
968 
	    errored = TRUE;
969 
	}
970 
    }
971 
    return (errored);
972 
}
973 
 
974 
void
975 
types_iter_for_table PROTO_N ((tuple, proc, closure))
976 
		     PROTO_T (TypeTupleP tuple X
977 
			      void     (*proc) PROTO_S ((EntryP, GenericP)) X
978 
			      GenericP   closure)
979 
{
980 
    TypeTupleEntryP ptr;
981 
 
982 
    for (ptr = tuple->head; ptr; ptr = ptr->next) {
983 
	if (ptr->type) {
984 
	    entry_iter (ptr->type, TRUE, proc, closure);
985 
	}
986 
	if (ptr->name) {
987 
	    entry_iter (ptr->name, TRUE, proc, closure);
988 
	}
989 
    }
990 
}
991 
 
992 
void
993 
types_destroy PROTO_N ((tuple))
994 
	      PROTO_T (TypeTupleP tuple)
995 
{
996 
    TypeTupleEntryP tuple_ptr = (tuple->head);
997 
 
998 
    while (tuple_ptr) {
999 
	TypeTupleEntryP tmp_ptr = (tuple_ptr->next);
1000 
 
1001 
	DEALLOCATE (tuple_ptr);
1002 
	tuple_ptr = tmp_ptr;
1003 
    }
1004 
}
1005 
 
1006 
void
1007 
write_type_types PROTO_N ((ostream, tuple))
1008 
		 PROTO_T (OStreamP   ostream X
1009 
			  TypeTupleP tuple)
1010 
{
1011 
    TypeTupleEntryP type;
1012 
 
1013 
    write_char (ostream, '(');
1014 
    for (type = tuple->head; type; type = type->next) {
1015 
	if (type->type) {
1016 
	    write_cstring (ostream, ": ");
1017 
	    write_key (ostream, entry_key (type->type));
1018 
	    if (type->reference) {
1019 
		write_cstring (ostream, " &");
1020 
	    }
1021 
	} else {
1022 
	    write_cstring (ostream, ": <unknown>");
1023 
	}
1024 
	if (type->next) {
1025 
	    write_cstring (ostream, ", ");
1026 
	}
1027 
    }
1028 
    write_char (ostream, ')');
1029 
}
1030 
 
1031 
void
1032 
write_type_names PROTO_N ((ostream, tuple, call))
1033 
		 PROTO_T (OStreamP   ostream X
1034 
			  TypeTupleP tuple X
1035 
			  BoolT      call)
1036 
{
1037 
    TypeTupleEntryP type;
1038 
 
1039 
    write_char (ostream, '(');
1040 
    for (type = tuple->head; type; type = type->next) {
1041 
	if (type->name) {
1042 
	    if ((call && type->reference) || (type->assign)) {
1043 
		write_char (ostream, '&');
1044 
	    }
1045 
	    write_key (ostream, entry_key (type->name));
1046 
	}
1047 
	if (type->type) {
1048 
	    write_cstring (ostream, ": ");
1049 
	    write_key (ostream, entry_key (type->type));
1050 
	    if (type->reference) {
1051 
		write_cstring (ostream, " &");
1052 
	    }
1053 
	}
1054 
	if (type->next) {
1055 
	    write_cstring (ostream, ", ");
1056 
	}
1057 
    }
1058 
    write_char (ostream, ')');
1059 
}
1060 
 
1061 
/*==========================================================================*\
1062 
|| Basic name translator handling functions.
1063 
\*==========================================================================*/
1064 
 
1065 
void
1066 
btrans_init PROTO_N ((translator))
1067 
	    PROTO_T (TypeBTransP translator)
1068 
{
1069 
    translator->head = NIL (TransP);
1070 
    translator->tail = &(translator->head);
1071 
}
1072 
 
1073 
void
1074 
btrans_add_translations PROTO_N ((translator, from, to))
1075 
			PROTO_T (TypeBTransP translator X
1076 
				 TypeTupleP  from X
1077 
				 TypeTupleP  to)
1078 
{
1079 
    TypeTupleEntryP from_ptr = from->head;
1080 
    TypeTupleEntryP to_ptr   = to->head;
1081 
 
1082 
    while (from_ptr) {
1083 
	ASSERT (to_ptr != NIL (TypeTupleEntryP));
1084 
	btrans_add_translation (translator, from_ptr->name, to_ptr->name);
1085 
	from_ptr = from_ptr->next;
1086 
	to_ptr   = to_ptr->next;
1087 
    }
1088 
    ASSERT (to_ptr == NIL (TypeTupleEntryP));
1089 
}
1090 
 
1091 
void
1092 
btrans_add_translation PROTO_N ((translator, from, to))
1093 
		       PROTO_T (TypeBTransP translator X
1094 
				EntryP      from X
1095 
				EntryP      to)
1096 
{
1097 
    TransP link = ALLOCATE (TransT);
1098 
 
1099 
    link->to            = to;
1100 
    link->from          = from;
1101 
    link->next          = NIL (TransP);
1102 
    *(translator->tail) = link;
1103 
    translator->tail    = &(link->next);
1104 
}
1105 
 
1106 
void
1107 
btrans_generate_names PROTO_N ((translator, tuple, table))
1108 
		      PROTO_T (TypeBTransP translator X
1109 
			       TypeTupleP  tuple X
1110 
			       TableP      table)
1111 
{
1112 
    TypeTupleEntryP tuple_ptr = tuple->head;
1113 
 
1114 
    while (tuple_ptr) {
1115 
	btrans_add_translation (translator, tuple_ptr->name,
1116 
				table_add_generated_name (table));
1117 
	tuple_ptr = tuple_ptr->next;
1118 
    }
1119 
}
1120 
 
1121 
void
1122 
btrans_regenerate_names PROTO_N ((translator, tuple))
1123 
			PROTO_T (TypeBTransP translator X
1124 
				 TypeTupleP  tuple)
1125 
{
1126 
    TypeTupleEntryP  tuple_ptr = tuple->head;
1127 
    TransP           trans_ptr = translator->head;
1128 
 
1129 
    while (tuple_ptr) {
1130 
	ASSERT (trans_ptr != NIL (TransP));
1131 
	trans_ptr->from = tuple_ptr->name;
1132 
	trans_ptr       = trans_ptr->next;
1133 
	tuple_ptr       = tuple_ptr->next;
1134 
    }
1135 
    ASSERT (trans_ptr == NIL (TransP));
1136 
}
1137 
 
1138 
ItemP
1139 
btrans_generate_non_pred_names PROTO_N ((translator, tuple, result,
1140 
					 predicate_id, table))
1141 
			       PROTO_T (TypeBTransP translator X
1142 
					TypeTupleP  tuple X
1143 
					TypeTupleP  result X
1144 
					EntryP      predicate_id X
1145 
					TableP      table)
1146 
{
1147 
    TypeTupleEntryP ptr = tuple->head;
1148 
    TypeTupleT      from;
1149 
    TypeTupleT      to;
1150 
 
1151 
    types_init (&from);
1152 
    types_init (&to);
1153 
    while (ptr) {
1154 
	if (ptr->name == predicate_id) {
1155 
	    btrans_add_translation (translator, predicate_id, predicate_id);
1156 
	} else {
1157 
	    EntryP entry = table_add_generated_name (table);
1158 
 
1159 
	    btrans_add_translation (translator, ptr->name, entry);
1160 
	    if (types_contains (result, ptr->name)) {
1161 
		types_add_name_and_type (&from, entry, ptr->type,
1162 
					 ptr->reference);
1163 
		types_add_name_and_type (&to, ptr->name, ptr->type,
1164 
					 ptr->reference);
1165 
	    }
1166 
	}
1167 
	ptr = ptr->next;
1168 
    }
1169 
    if (types_equal_zero_tuple (&from)) {
1170 
	types_destroy (&from);
1171 
	types_destroy (&to);
1172 
	return (NIL (ItemP));
1173 
    } else {
1174 
	ItemP item = item_create (table_add_rename (table));
1175 
 
1176 
	types_assign (item_param (item), &from);
1177 
	types_assign (item_result (item), &to);
1178 
	return (item);
1179 
    }
1180 
}
1181 
 
1182 
ItemP
1183 
btrans_regen_non_pred_names PROTO_N ((translator, tuple, result, table))
1184 
			    PROTO_T (TypeBTransP translator X
1185 
				     TypeTupleP  tuple X
1186 
				     TypeTupleP  result X
1187 
				     TableP      table)
1188 
{
1189 
    TypeTupleEntryP tuple_ptr = tuple->head;
1190 
    TransP          trans_ptr = translator->head;
1191 
    TypeTupleT      from;
1192 
    TypeTupleT      to;
1193 
 
1194 
    types_init (&from);
1195 
    types_init (&to);
1196 
    while (tuple_ptr) {
1197 
	ASSERT (trans_ptr != NIL (TransP));
1198 
	trans_ptr->from = tuple_ptr->name;
1199 
	if (types_contains (result, tuple_ptr->name)) {
1200 
	    types_add_name_and_type (&from, trans_ptr->to, tuple_ptr->type,
1201 
				     tuple_ptr->reference);
1202 
	    types_add_name_and_type (&to, trans_ptr->from, tuple_ptr->type,
1203 
				     tuple_ptr->reference);
1204 
	}
1205 
	trans_ptr       = trans_ptr->next;
1206 
	tuple_ptr       = tuple_ptr->next;
1207 
    }
1208 
    ASSERT (trans_ptr == NIL (TransP));
1209 
    if (types_equal_zero_tuple (&from)) {
1210 
	types_destroy (&from);
1211 
	types_destroy (&to);
1212 
	return (NIL (ItemP));
1213 
    } else {
1214 
	ItemP item = item_create (table_add_rename (table));
1215 
 
1216 
	types_assign (item_param (item), &from);
1217 
	types_assign (item_result (item), &to);
1218 
	return (item);
1219 
    }
1220 
}
1221 
 
1222 
EntryP
1223 
btrans_get_translation PROTO_N ((translator, entry))
1224 
		       PROTO_T (TypeBTransP translator X
1225 
				EntryP      entry)
1226 
{
1227 
    EntryP translation = NIL (EntryP);
1228 
    TransP ptr;
1229 
 
1230 
    for (ptr = translator->head; ptr; ptr = ptr->next) {
1231 
	if (ptr->from == entry) {
1232 
	    translation = ptr->to;
1233 
	}
1234 
    }
1235 
    return (translation);
1236 
}
1237 
 
1238 
void
1239 
btrans_destroy PROTO_N ((translator))
1240 
	       PROTO_T (TypeBTransP translator)
1241 
{
1242 
    TransP ptr = (translator->head);
1243 
    TransP tmp;
1244 
 
1245 
    while ((tmp = ptr) != NIL (TransP)) {
1246 
	ptr = ptr->next;
1247 
	DEALLOCATE (tmp);
1248 
    }
1249 
}
1250 
 
1251 
/*==========================================================================*\
1252 
|| Rename stack name translator handling functions.
1253 
\*==========================================================================*/
1254 
 
1255 
void
1256 
rtrans_init PROTO_N ((translator))
1257 
	    PROTO_T (TypeRTransP translator)
1258 
{
1259 
    translator->head = NIL (RTransP);
1260 
    translator->tail = &(translator->head);
1261 
}
1262 
 
1263 
void
1264 
rtrans_add_translation PROTO_N ((translator, from, to, type, reference))
1265 
		       PROTO_T (TypeRTransP translator X
1266 
				EntryP      from X
1267 
				EntryP      to X
1268 
				EntryP      type X
1269 
				BoolT       reference)
1270 
{
1271 
    RTransP link = ALLOCATE (RTransT);
1272 
 
1273 
    link->next          = NIL (RTransP);
1274 
    link->to            = to;
1275 
    link->from          = from;
1276 
    link->type          = type;
1277 
    link->reference     = reference;
1278 
    *(translator->tail) = link;
1279 
    translator->tail    = &(link->next);
1280 
}
1281 
 
1282 
EntryP
1283 
rtrans_get_translation PROTO_N ((translator, entry, type_ref, reference_ref))
1284 
		       PROTO_T (TypeRTransP translator X
1285 
				EntryP      entry X
1286 
				EntryP     *type_ref X
1287 
				BoolT      *reference_ref)
1288 
{
1289 
    RTransP ptr;
1290 
 
1291 
    for (ptr = translator->head; ptr; ptr = ptr->next) {
1292 
	if (ptr->from == entry) {
1293 
	    *type_ref      = ptr->type;
1294 
	    *reference_ref = ptr->reference;
1295 
	    return (ptr->to);
1296 
	}
1297 
    }
1298 
    return (NIL (EntryP));
1299 
}
1300 
 
1301 
void
1302 
rtrans_apply_for_non_locals PROTO_N ((translator, proc, closure))
1303 
			    PROTO_T (TypeRTransP translator X
1304 
				     void      (*proc) PROTO_S ((EntryP,
1305 
								 EntryP,
1306 
								 GenericP)) X
1307 
				     GenericP    closure)
1308 
{
1309 
    RTransP ptr;
1310 
 
1311 
    for (ptr = translator->head; ptr; ptr = ptr->next) {
1312 
	(*proc) (ptr->from, ptr->to, closure);
1313 
    }
1314 
}
1315 
 
1316 
void
1317 
rtrans_destroy PROTO_N ((translator))
1318 
	       PROTO_T (TypeRTransP translator)
1319 
{
1320 
    RTransP ptr = (translator->head);
1321 
    RTransP tmp;
1322 
 
1323 
    while ((tmp = ptr) != NIL (RTransP)) {
1324 
	ptr = ptr->next;
1325 
	DEALLOCATE (tmp);
1326 
    }
1327 
}
1328 
 
1329 
/*==========================================================================*\
1330 
|| Name translator handling functions.
1331 
\*==========================================================================*/
1332 
 
1333 
void
1334 
trans_init PROTO_N ((translator, param, result, alt))
1335 
	   PROTO_T (TypeTransP translator X
1336 
		    TypeTupleP param X
1337 
		    TypeTupleP result X
1338 
		    AltP       alt)
1339 
{
1340 
    TypeTupleEntryP ptr;
1341 
    ItemP           item;
1342 
 
1343 
    translator->head = NIL (TransP);
1344 
    translator->tail = &(translator->head);
1345 
    entry_list_init (&(translator->used_names));
1346 
    for (ptr = param->head; ptr; ptr = ptr->next) {
1347 
        entry_list_add_if_missing (&(translator->used_names), ptr->name);
1348 
    }
1349 
    for (ptr = result->head; ptr; ptr = ptr->next) {
1350 
	entry_list_add_if_missing (&(translator->used_names), ptr->name);
1351 
    }
1352 
    for (item = alt_item_head (alt); item; item = item_next (item)) {
1353 
        TypeTupleP type = item_result (item);
1354 
 
1355 
	for (ptr = type->head; ptr; ptr = ptr->next) {
1356 
	    entry_list_add_if_missing (&(translator->used_names), ptr->name);
1357 
	}
1358 
    }
1359 
}
1360 
 
1361 
void
1362 
trans_add_translation PROTO_N ((translator, from, to))
1363 
		      PROTO_T (TypeTransP translator X
1364 
			       EntryP     from X
1365 
			       EntryP     to)
1366 
{
1367 
    TransP link = ALLOCATE (TransT);
1368 
 
1369 
    link->to            = to;
1370 
    link->from          = from;
1371 
    link->next          = NIL (TransP);
1372 
    *(translator->tail) = link;
1373 
    translator->tail    = &(link->next);
1374 
}
1375 
 
1376 
void
1377 
trans_add_translations PROTO_N ((translator, from, to))
1378 
		       PROTO_T (TypeTransP translator X
1379 
				TypeTupleP from X
1380 
				TypeTupleP to)
1381 
{
1382 
    TypeTupleEntryP from_ptr = from->head;
1383 
    TypeTupleEntryP to_ptr   = to->head;
1384 
 
1385 
    while (from_ptr) {
1386 
	ASSERT (to_ptr != NIL (TypeTupleEntryP));
1387 
	trans_add_translation (translator, from_ptr->name, to_ptr->name);
1388 
	from_ptr = from_ptr->next;
1389 
	to_ptr   = to_ptr->next;
1390 
    }
1391 
    ASSERT (to_ptr == NIL (TypeTupleEntryP));
1392 
}
1393 
 
1394 
void
1395 
trans_save_state PROTO_N ((translator, state))
1396 
		 PROTO_T (TypeTransP translator X
1397 
			  SaveTransP state)
1398 
{
1399 
    state->last_ref = translator->tail;
1400 
}
1401 
 
1402 
EntryP
1403 
trans_get_translation PROTO_N ((translator, entry))
1404 
		      PROTO_T (TypeTransP translator X
1405 
			       EntryP     entry)
1406 
{
1407 
    EntryP translation = NIL (EntryP);
1408 
    TransP      ptr;
1409 
 
1410 
    for (ptr = translator->head; ptr; ptr = ptr->next) {
1411 
	if (ptr->from == entry) {
1412 
	    translation = ptr->to;
1413 
	}
1414 
    }
1415 
    if (translation) {
1416 
	return (translation);
1417 
    }
1418 
    if (!entry_list_contains (&(translator->used_names), entry)) {
1419 
        return (entry);
1420 
    }
1421 
    return (NIL (EntryP));
1422 
}
1423 
 
1424 
void
1425 
trans_restore_state PROTO_N ((translator, state))
1426 
		    PROTO_T (TypeTransP translator X
1427 
			     SaveTransP state)
1428 
{
1429 
    TransP ptr = (*(state->last_ref));
1430 
    TransP tmp;
1431 
 
1432 
    *(state->last_ref) = NIL (TransP);
1433 
    while ((tmp = ptr) != NIL (TransP)) {
1434 
	ptr = ptr->next;
1435 
	DEALLOCATE (tmp);
1436 
    }
1437 
    translator->tail = state->last_ref;
1438 
}
1439 
 
1440 
void
1441 
trans_destroy PROTO_N ((translator))
1442 
	      PROTO_T (TypeTransP translator)
1443 
{
1444 
    TransP ptr = (translator->head);
1445 
    TransP tmp;
1446 
 
1447 
    while ((tmp = ptr) != NIL (TransP)) {
1448 
	ptr = ptr->next;
1449 
	DEALLOCATE (tmp);
1450 
    }
1451 
    entry_list_destroy (&(translator->used_names));
1452 
}
1453 
 
1454 
/*==========================================================================*\
1455 
|| Numeric translator handling functions.
1456 
\*==========================================================================*/
1457 
 
1458 
static unsigned
1459 
ntrans_add_translation PROTO_N ((translator, from))
1460 
		       PROTO_T (TypeNTransP translator X
1461 
				EntryP      from)
1462 
{
1463 
    NTransP link = ALLOCATE (NTransT);
1464 
 
1465 
    if (translator->count == UINT_MAX) {
1466 
	E_too_many_generated_names ();
1467 
	UNREACHED;
1468 
    }
1469 
    link->to            = (translator->count) ++;
1470 
    link->from          = from;
1471 
    link->next          = NIL (NTransP);
1472 
    *(translator->tail) = link;
1473 
    translator->tail    = &(link->next);
1474 
    return (link->to);
1475 
}
1476 
 
1477 
/*--------------------------------------------------------------------------*/
1478 
 
1479 
void
1480 
ntrans_init PROTO_N ((translator))
1481 
	    PROTO_T (TypeNTransP translator)
1482 
{
1483 
    translator->count      = 0;
1484 
    translator->head       = NIL (NTransP);
1485 
    translator->tail       = &(translator->head);
1486 
}
1487 
 
1488 
void
1489 
ntrans_save_state PROTO_N ((translator, state))
1490 
		  PROTO_T (TypeNTransP translator X
1491 
			   SaveNTransP state)
1492 
{
1493 
    state->last_count = translator->count;
1494 
    state->last_ref   = translator->tail;
1495 
}
1496 
 
1497 
unsigned
1498 
ntrans_get_translation PROTO_N ((translator, entry))
1499 
		       PROTO_T (TypeNTransP translator X
1500 
				EntryP      entry)
1501 
{
1502 
    NTransP ptr;
1503 
 
1504 
    for (ptr = translator->head; ptr; ptr = ptr->next) {
1505 
	if (ptr->from == entry) {
1506 
	    return (ptr->to);
1507 
	}
1508 
    }
1509 
    return (ntrans_add_translation (translator, entry));
1510 
}
1511 
 
1512 
EntryP
1513 
ntrans_get_indirect_translation PROTO_N ((from_translator, to_translator,
1514 
					  entry))
1515 
				PROTO_T (TypeNTransP from_translator X
1516 
					 TypeNTransP to_translator X
1517 
					 EntryP      entry)
1518 
{
1519 
    NTransP  ptr;
1520 
    unsigned name;
1521 
 
1522 
    for (ptr = from_translator->head; ptr; ptr = ptr->next) {
1523 
	if (ptr->from == entry) {
1524 
	    name = ptr->to;
1525 
	    goto found;
1526 
	}
1527 
    }
1528 
    return (NIL (EntryP));
1529 
  found:
1530 
    for (ptr = to_translator->head; ptr; ptr = ptr->next) {
1531 
	if (ptr->to == name) {
1532 
	    return (ptr->from);
1533 
	}
1534 
    }
1535 
    UNREACHED;
1536 
}
1537 
 
1538 
void
1539 
ntrans_restore_state PROTO_N ((translator, state))
1540 
		     PROTO_T (TypeNTransP translator X
1541 
			      SaveNTransP state)
1542 
{
1543 
    NTransP ptr = (*(state->last_ref));
1544 
    NTransP tmp;
1545 
 
1546 
    *(state->last_ref) = NIL (NTransP);
1547 
    translator->count  = state->last_count;
1548 
    while ((tmp = ptr) != NIL (NTransP)) {
1549 
	ptr = ptr->next;
1550 
	DEALLOCATE (tmp);
1551 
    }
1552 
    translator->tail = state->last_ref;
1553 
}
1554 
 
1555 
void
1556 
ntrans_destroy PROTO_N ((translator))
1557 
	       PROTO_T (TypeNTransP translator)
1558 
{
1559 
    NTransP ptr = (translator->head);
1560 
    NTransP tmp;
1561 
 
1562 
    while ((tmp = ptr) != NIL (NTransP)) {
1563 
	ptr = ptr->next;
1564 
	DEALLOCATE (tmp);
1565 
    }
1566 
}
1567 
 
1568 
/*
1569 
 * Local variables(smf):
1570 
 * eval: (include::add-path-entry "../os-interface" "../library")
1571 
 * eval: (include::add-path-entry "../generated")
1572 
 * end:
1573 
**/