Subversion Repositories tendra.SVN

Rev

Rev 5 | Details | Compare with Previous | Last modification | View Log | RSS feed

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