/[ascend]/trunk/base/generic/compiler/type_desc.c
ViewVC logotype

Contents of /trunk/base/generic/compiler/type_desc.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1290 - (show annotations) (download) (as text)
Mon Feb 26 04:54:45 2007 UTC (17 years, 5 months ago) by johnpye
File MIME type: text/x-csrc
File size: 46998 byte(s)
Added new 'default' functionality plus test case
1 /* ASCEND modelling environment
2 Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
3 Copyright (C) 2006 Carnegie Mellon University
4
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2, or (at your option)
8 any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place - Suite 330,
18 Boston, MA 02111-1307, USA.
19 *//** @file
20 Type description structure Implementation
21 *//*
22 by Tom Epperly
23 Created: 1/12/90
24 Last in CVS: $Revision: 1.41 $ $Date: 1998/05/18 16:36:48 $ $Author: ballan $
25 */
26
27 #include "type_desc.h"
28 #include "type_descio.h"
29
30 #include <stdarg.h>
31
32 #include <utilities/ascMalloc.h>
33 #include <utilities/ascPanic.h>
34
35 #include "functype.h"
36 #include "expr_types.h"
37 #include "sets.h"
38 #include "proc.h"
39 #include "symtab.h"
40 #include "vlist.h"
41 #include "stattypes.h"
42 #include "statement.h"
43 #include "statio.h"
44 #include "select.h"
45 #include "instance_enum.h"
46 #include "cmpfunc.h"
47 #include "library.h"
48 #include "watchpt.h"
49 #include "initialize.h"
50
51 #define TYPELINKDEBUG 0
52 /*
53 * When this is 1, generates lots of spew about type linking
54 * and unlinking using d->refiners.
55 */
56
57 static
58 long g_parse_count = 1;
59 /*
60 * This is the total number of times a create type of any sort
61 * has been called. It can be used to disambiguate type
62 * queries by assigning the parseid from parse_count.
63 * by initialization, 0 is never a valid parseid.
64 * negative parseid indicate something destroyed.
65 */
66
67 struct ArrayDescList {
68 struct ArrayDescList *next;
69 struct TypeDescription *desc;
70 };
71
72 static unsigned long g_array_desc_count = 0L;
73 /*
74 * Count of the number of names ever made for array nodes, which normally
75 * are invisible but having names is awfully convenient in some places.
76 * should be reset 0 when list goes empty.
77 */
78 static struct ArrayDescList *g_array_desc_list=NULL;
79 /*
80 * Singly linked list of array type descriptions.
81 * Descriptions are added/deleted/searched linearly all the time
82 * which may be a very bad idea.
83 */
84
85
86 static struct IndexType g_it_dummy_enum = {NULL,NULL,0};
87 static struct IndexType g_it_dummy_int = {NULL,NULL,1};
88
89 struct IndexType *CreateDummyIndexType(int intindex)
90 {
91 if (intindex) {
92 return &g_it_dummy_int;
93 } else {
94 return &g_it_dummy_enum;
95 }
96 }
97
98 struct IndexType *CreateIndexType(struct Set *set, int int_index)
99 {
100 char *set_str; /* KAA_DEBUG */
101 struct IndexType *result;
102 result = (struct IndexType *)ascmalloc(sizeof(struct IndexType));
103 result->int_index = int_index ? 1 : 0;
104 set_str = CreateStrFromSet(set);
105 result->set = set; /* this will NOT go away. baa */
106 result->sptr = AddSymbol(set_str);
107 ascfree(set_str);
108 return result;
109 }
110
111 struct IndexType *CreateIndexTypeFromStr(char *str, int int_index)
112 {
113 struct IndexType *result; /* KAA_DEBUG */
114 result = (struct IndexType *)ascmalloc(sizeof(struct IndexType));
115 result->int_index = int_index ? 1 : 0;
116 result->sptr = AddSymbol(str); /* in symbol table */
117 result->set = NULL;
118 return result;
119 }
120
121
122 void DestroyIndexType(struct IndexType *ind)
123 {
124 if (ind == &g_it_dummy_int || ind == &g_it_dummy_enum) return;
125 AssertAllocatedMemory(ind,sizeof(struct IndexType));
126 ind->sptr = NULL; /* we own the string in symtab */
127 if (ind->set) {
128 DestroySetList(ind->set);
129 ind->set = NULL;
130 }
131 ascfree(ind);
132 }
133
134 /*
135 * This function compares two types by name and if identical complains
136 * unless ptrs are also identical.
137 * Does not tolerate null input very well.
138 * We need a function to compare symchar properly here.
139 * Breaks ties with parseid.
140 */
141 static
142 int CmpLinkedTypes(struct TypeDescription *t1, struct TypeDescription *t2)
143 {
144 int result;
145 assert(t1!=NULL);
146 assert(t2!=NULL);
147 if (t1==t2) {
148 return 0;
149 }
150 result = CmpSymchar(t1->name,t2->name);
151 if (!result) {
152 /* same name */
153 #if TYPELINKDEBUG
154 FPRINTF(ASCERR,"Distinct refinements with same name (%s) found %ld %ld\n",
155 SCP(t1->name),GetParseId(t1),GetParseId(t2));
156 #endif
157 assert(GetParseId(t1)>0 && GetParseId(t2)>0);
158 /* assumes parseid are unique! */
159 return ((GetParseId(t1) > GetParseId(t2))? 1 : -1);
160 }
161 return result;
162 }
163 /*
164 * This functions establishes the forward pointer to the new type
165 * from the old type. The new type is the more refined one.
166 * Whines if another refinement of the same name is found.
167 */
168 static
169 void LinkTypeDesc(struct TypeDescription *old,
170 struct TypeDescription *new)
171 {
172 if (old==NULL || new == NULL) {
173 ASC_PANIC("Attempt to link bad types- old (%p) new (%p)."
174 ,old, new
175 );
176 }
177 if (old->refiners == NULL) {
178 old->refiners = gl_create(2);
179 }
180 assert(old->refiners != NULL);
181 #if TYPELINKDEBUG
182 if (1) {
183 unsigned long int c,len;
184 struct TypeDescription *desc;
185
186 FPRINTF(ASCERR,"%s refiners:\n",GetName(old));
187 len = gl_length(old->refiners);
188 for (c=1; c <= len; c++) {
189 desc = (struct TypeDescription *)gl_fetch(old->refiners,c);
190 FPRINTF(ASCERR,"%s (%ld)\n",GetName(desc),GetParseId(desc));
191 }
192 }
193 #endif
194 gl_insert_sorted(old->refiners,new,(CmpFunc)CmpLinkedTypes);
195 #if TYPELINKDEBUG
196 if (1) {
197 unsigned long int c,len;
198 struct TypeDescription *desc;
199
200 FPRINTF(ASCERR,"%s refiners:\n",GetName(old));
201 len = gl_length(old->refiners);
202 for (c=1; c <= len; c++) {
203 desc = (struct TypeDescription *)gl_fetch(old->refiners,c);
204 FPRINTF(ASCERR,"%s (%ld)\n",GetName(desc),GetParseId(desc));
205 }
206 }
207 #endif
208 }
209 /*
210 * deletes the reference to new in old->refiners
211 * so that new can be tossed.
212 */
213 static
214 void UnLinkTypeDesc(struct TypeDescription *old,
215 struct TypeDescription *new)
216 {
217 unsigned long int pos;
218 assert(old!=NULL);
219 assert(new!=NULL);
220 assert(old->refiners!=NULL);
221 pos = gl_search(old->refiners,new,(CmpFunc)CmpLinkedTypes);
222 if (!pos) {
223 FPRINTF(ASCERR,"Attempt to unlink corrupted type descriptions");
224 return;
225 }
226 #if TYPELINKDEBUG
227 if (1) {
228 struct TypeDescription *desc;
229 desc = (struct TypeDescription *)gl_fetch(old->refiners,pos);
230 FPRINTF(ASCERR,"Unlinking attempt %s (%ld)\n",new->name,GetParseId(new));
231 FPRINTF(ASCERR,"Unlinking type %s (%ld)\n",desc->name,GetParseId(desc));
232 }
233 #endif
234 gl_delete(old->refiners,pos,0);
235 }
236
237 /* a widget to check for := in a statement list. returns the bit
238 * TYPECONTAINSDEFAULTS appropriate for defaults if so and 0 otherwise.
239 * handle null input gracefully.
240 */
241 static
242 unsigned short int StatListHasDefaults(struct StatementList *sl) {
243 register unsigned long len,c;
244 register CONST struct gl_list_t *l;
245
246 len = StatementListLength(sl);
247 if (len==0L) return 0;
248 l = GetList(sl);
249 for(c=1;c<=len;c++) {
250 if ( StatementType((struct Statement *)gl_fetch(l,c)) == ASGN ) {
251 return TYPECONTAINSDEFAULTS;
252 }
253 }
254 return 0;
255 }
256
257 /* forward declaration */
258 static
259 unsigned short int ParametersInType(struct StatementList *,
260 struct StatementList *);
261
262 /*
263 * To check for () in the statements lists of a SELECT
264 * statement. returns 1 for parameters if so and 0 otherwise.
265 */
266 static
267 int ParametersInTypeInsideSelect(struct Statement *stat)
268 {
269 struct SelectList *cases;
270 struct StatementList *sl;
271
272 cases = SelectStatCases(stat);
273
274 while ( cases!=NULL ) {
275 sl = SelectStatementList(cases);
276 if (ParametersInType(sl,NULL) != 0) {
277 return 1;
278 }
279 cases = NextSelectCase(cases);
280 }
281 return 0;
282 }
283
284
285 /* a widget to check for () in a statement list. returns the bit
286 * TYPECONTAINSPARINSTS appropriate for parameters if so and 0 otherwise.
287 * handle null input gracefully.
288 */
289 static
290 unsigned short int ParametersInType(struct StatementList *sl,
291 struct StatementList *psl) {
292 register unsigned long len,c;
293 register CONST struct gl_list_t *l;
294 struct TypeDescription *d;
295 struct Statement *stat;
296 unsigned int forflags = (contains_ISA | contains_WILLBE | contains_IRT );
297
298 if (StatementListLength(psl)!=0L) {
299 return TYPECONTAINSPARINSTS;
300 }
301 len = StatementListLength(sl);
302 if (len==0L) return 0;
303 l = GetList(sl);
304 for(c=1;c<=len;c++) {
305 stat = (struct Statement *)gl_fetch(l,c);
306 switch ( StatementType(stat) ) {
307 case WILLBE:
308 case ISA:
309 case IRT:
310 d = GetStatTypeDesc(stat);
311 if ( d != NULL && TypeHasParameterizedInsts(d)!=0 ) {
312 return TYPECONTAINSPARINSTS;
313 }
314 break;
315 case FOR:
316 if ((ForContains(stat) & forflags) != 0 ) {
317 if (ParametersInType(ForStatStmts(stat),NULL) != 0) {
318 return TYPECONTAINSPARINSTS;
319 }
320 }
321 break;
322 case SELECT:
323 if (ParametersInTypeInsideSelect(stat) != 0) {
324 return TYPECONTAINSPARINSTS;
325 }
326 break;
327 default:
328 break;
329 }
330 }
331 return 0;
332 }
333
334 /* counts total lhs names in a list of IS_A's
335 * and WILL_BE's. list given may be null.
336 */
337 static
338 unsigned int CountParameters(CONST struct StatementList *sl)
339 {
340 unsigned cnt=0;
341 unsigned long c,len;
342 CONST struct Statement *s;
343 /* count the IS_A's and WILL_BE's, then add the number
344 * of extra identifiers the WILL_BE's have.
345 */
346 len = StatementListLength(sl);
347 cnt = len;
348 if (cnt > 0) {
349 for (c=1;c<=len;c++) {
350 s = GetStatement(sl,c);
351 switch(StatementType(s)) {
352 case WILLBE:
353 cnt += (VariableListLength(GetStatVarList(s)) - 1);
354 break;
355 case ISA:
356 default:
357 break;
358 }
359 }
360 }
361 return cnt;
362 }
363
364 /* returns old, the number of procedures in pl already
365 * claimed by another type.
366 */
367 static
368 int ClaimNewMethodsTypeDesc(long parseid, struct gl_list_t *pl)
369 {
370 unsigned long c;
371 struct InitProcedure *p;
372 int old=0;
373 assert(parseid != 0);
374 if (pl==NULL) {
375 return 0;
376 }
377 for (c = gl_length(pl); c > 0; c--) {
378 p = (struct InitProcedure *)gl_fetch(pl,c);
379 if (p != NULL && GetProcParseId(p) == 0) {
380 SetProcParseId(p,parseid);
381 } else {
382 old++;
383 }
384 }
385 return old;
386 }
387
388 struct TypeDescription
389 *CreateModelTypeDesc(symchar *name, /* name of the type*/
390 struct TypeDescription *rdesc,/* type that it refines or NULL */
391 struct module_t *mod, /* module it is defined in */
392 ChildListPtr cl, /* list of the type's child names */
393 struct gl_list_t *pl, /* list of initialization procedures */
394 struct StatementList *sl, /* list of declarative statements */
395 int univ, /* UNIVERSAL flag */
396 struct StatementList *psl, /* list of parameter statements */
397 struct StatementList *rsl, /* list of reduction statements */
398 struct StatementList *tsl, /* list of reduced statements */
399 struct StatementList *wsl /* list of wbts statements */
400 ){
401 register struct TypeDescription *result;
402 result=ASC_NEW(struct TypeDescription);
403 result->ref_count = 1;
404 result->t = model_type;
405 result->name = name;
406 result->refines = rdesc;
407 result->refiners = NULL;
408 result->parseid = g_parse_count++;
409 ClaimNewMethodsTypeDesc(result->parseid,pl);
410 if (rdesc!=NULL) CopyTypeDesc(rdesc);
411 if (rdesc!=NULL) LinkTypeDesc(rdesc,result);
412 result->mod = mod;
413 result->children = cl;
414 result->init = pl;
415 result->stats = sl;
416 result->universal = univ;
417 result->flags = 0;
418 result->flags |= StatListHasDefaults(sl);
419 result->flags |= ParametersInType(sl,psl);
420 result->flags |= TYPESHOW;
421 result->u.modarg.declarations = psl;
422 result->u.modarg.absorbed = tsl;
423 result->u.modarg.reductions = rsl;
424 result->u.modarg.wheres = wsl;
425 /*
426 result->u.modarg.argdata = NULL;
427 */
428 result->u.modarg.argcnt = CountParameters(psl);
429 return result;
430 }
431
432 struct TypeDescription
433 *CreateDummyTypeDesc(symchar *name)
434 {
435 register struct TypeDescription *result;
436 result=ASC_NEW(struct TypeDescription);
437 result->ref_count = 1;
438 result->t = dummy_type;
439 result->name = name;
440 result->refines = NULL;
441 result->refiners = NULL;
442 result->parseid = g_parse_count++;
443 result->mod = NULL;
444 result->children = NULL;
445 result->init = NULL;
446 result->stats = EmptyStatementList();
447 result->universal = 1;
448 result->flags = 0;
449 result->flags |= TYPESHOW;
450 return result;
451 }
452
453 struct TypeDescription *CreateConstantTypeDesc(
454 symchar *name, /* name of type */
455 enum type_kind t, /* base type of atom */
456 struct TypeDescription *rdesc, /* type description what it refines */
457 struct module_t *mod, /* module where the type is defined */
458 unsigned long bytesize, /* instance size */
459 int defaulted, /* valid for constants, indicates default value was assigned */
460 double rval, /* default value for real const */
461 CONST dim_type *dim, /* dimensions of default real */
462 long ival, /* default integer const */
463 symchar *sval, /* default symbol */
464 int univ
465 ){
466 register struct TypeDescription *result;
467 result=ASC_NEW(struct TypeDescription);
468 result->t = t;
469 result->ref_count = 1;
470 result->name = name;
471 result->refines = rdesc;
472 result->refiners = NULL;
473 result->parseid = g_parse_count++;
474 if (rdesc!=NULL) CopyTypeDesc(rdesc);
475 if (rdesc!=NULL) LinkTypeDesc(rdesc,result);
476 result->mod = mod;
477 result->children = NULL;
478 result->init = NULL;
479 result->stats = EmptyStatementList();
480 result->universal = univ;
481 result->flags = 0;
482 result->flags |= TYPESHOW;
483 result->u.constant.byte_length = bytesize;
484 result->u.constant.defaulted = (defaulted) ? 1 : 0;
485 switch (t) {
486 case real_constant_type:
487 result->u.constant.u.defreal = rval;
488 result->u.constant.dimp = dim;
489 break;
490 case integer_constant_type:
491 result->u.constant.u.definteger = ival;
492 break;
493 case boolean_constant_type:
494 result->u.constant.u.defboolean = (ival) ? 1 : 0;
495 break;
496 case symbol_constant_type:
497 result->u.constant.u.defsymbol = sval;
498 break;
499 default: /* not reached we hope */
500 ASC_PANIC("ERROR 666\n");
501 break;
502 }
503 return result;
504 }
505
506 struct TypeDescription
507 *CreateAtomTypeDesc(symchar *name, /* name of type */
508 enum type_kind t, /* base type of atom */
509 struct TypeDescription *rdesc, /* type description what it refines */
510 struct module_t *mod, /* module where the type is defined */
511 ChildListPtr childl, /* list of children names */
512 struct gl_list_t *procl, /* list of initialization procedures */
513 struct StatementList *statl, /* list of declarative statements */
514 unsigned long int bytesize, /* size of an instance in bytes. */
515 struct ChildDesc *childd, /* description of the atom's children */
516 int defaulted, /* TRUE indicates default value was assigned */
517 double dval, /* default value for real atoms */
518 CONST dim_type *ddim, /* dimensions of default value */
519 int univ,
520 long ival,
521 symchar *sval
522 ){
523 register struct TypeDescription *result;
524 result=ASC_NEW(struct TypeDescription);
525 #if TYPELINKDEBUG
526 FPRINTF(ASCERR,"\n");
527 #endif
528 result->t = t;
529 result->ref_count = 1;
530 result->name = name;
531 result->refines = rdesc;
532 result->refiners = NULL;
533 result->parseid = g_parse_count++;
534 ClaimNewMethodsTypeDesc(result->parseid,procl);
535 if (rdesc!=NULL) CopyTypeDesc(rdesc);
536 if (rdesc!=NULL) LinkTypeDesc(rdesc,result);
537 result->mod = mod;
538 result->children = childl;
539 result->init = procl;
540 result->stats = statl;
541 result->universal = univ;
542 result->flags = 0;
543 result->flags |= StatListHasDefaults(statl);
544 result->flags |= TYPESHOW;
545 result->u.atom.byte_length = bytesize;
546 result->u.atom.childinfo = childd;
547 result->u.atom.defaulted = (defaulted) ? 1 : 0;
548 switch(t) {
549 case real_type:
550 result->u.atom.u.defval = dval;
551 break;
552 case integer_type:
553 result->u.atom.u.defint = ival;
554 break;
555 case boolean_type:
556 result->u.atom.u.defbool = ival ? 1 : 0;
557 break;
558 case symbol_type:
559 result->u.atom.u.defsym = sval;
560 break;
561 case set_type: /* don't have defaults, but are atoms... eww! */
562 break;
563 default:
564 FPRINTF(ASCERR,"CreateAtomTypeDesc called with unexpected type for %s\n",
565 SCP(name));
566 break;
567 }
568 result->u.atom.dimp = ddim;
569 return result;
570 }
571
572 static
573 int IndicesEqual(struct gl_list_t *i1, struct gl_list_t *i2){
574 unsigned long c,len;
575 struct IndexType *ind1,*ind2;
576 if (gl_length(i1)!=gl_length(i2)) return 0;
577 len = gl_length(i1);
578 for(c=1;c<=len;c++){
579 ind1 = (struct IndexType *)gl_fetch(i1,c);
580 ind2 = (struct IndexType *)gl_fetch(i2,c);
581 if (ind1==ind2) continue; /* matching dummies */
582 if (ind1->int_index!=ind2->int_index) return 0;
583 /* FOR loop ALIASES-IS_A has forced the dummies into the typedesc. */
584 if (ind1->sptr == NULL || ind2->sptr==NULL) {
585 /* unequal dummies or dummy vs real index are only possible NULL */
586 return 0;
587 }
588 assert(AscFindSymbol(ind1->sptr)!=NULL);
589 assert(AscFindSymbol(ind2->sptr)!=NULL);
590 if (ind1->sptr != ind2->sptr) {
591 return 0;
592 }
593 }
594 return 1;
595 }
596
597 static
598 int ArrayDescsEqual(struct TypeDescription *src,
599 struct module_t *mod,
600 struct TypeDescription *desc,
601 int isintset,
602 int isrel,
603 int islogrel,
604 int iswhen,
605 struct gl_list_t *indices)
606 {
607 if (src->mod != mod) return 0;
608 if (src->u.array.desc != desc) return 0;
609 if ((src->u.array.isrelation&&!isrel)||
610 (isrel&&!src->u.array.isrelation)) return 0;
611 if ((src->u.array.islogrel&&!islogrel)||
612 (islogrel&&!src->u.array.islogrel)) return 0;
613 if ((src->u.array.iswhen&&!iswhen)||
614 (iswhen&&!src->u.array.iswhen)) return 0;
615 if ((src->u.array.isintset&&!isintset)||(isintset&&!src->u.array.isintset))
616 return 0;
617 return IndicesEqual(src->u.array.indices,indices);
618 }
619
620 static
621 struct TypeDescription *FindArray(struct module_t *mod,
622 struct TypeDescription *desc,
623 int isintset,
624 int isrel,
625 int islogrel,
626 int iswhen,
627 struct gl_list_t *indices
628 ){
629 register struct ArrayDescList *ptr;
630 int ade;
631 ptr = g_array_desc_list;
632 while(ptr!=NULL){
633 ade =
634 ArrayDescsEqual(ptr->desc,mod,desc,isintset,
635 isrel,islogrel,iswhen,indices);
636 if (ade) {
637 CopyTypeDesc(ptr->desc);
638 return ptr->desc;
639 }
640 ptr = ptr->next;
641 }
642 return NULL;
643 }
644
645 static
646 void AddArray(struct TypeDescription *d){
647 register struct ArrayDescList *ptr;
648 ptr = g_array_desc_list;
649 g_array_desc_list =
650 (struct ArrayDescList *)ascmalloc(sizeof(struct ArrayDescList));
651 g_array_desc_list->next = ptr;
652 g_array_desc_list->desc = d;
653 }
654
655 static
656 void RemoveArrayTypeDesc(struct TypeDescription *d){
657 register struct ArrayDescList *ptr , *next;
658 ptr = g_array_desc_list;
659 if (ptr!=NULL){
660 if (ptr->desc == d){
661 g_array_desc_list = ptr->next;
662 ascfree(ptr);
663 } else {
664 while(NULL != (next = ptr->next)){
665 if (next->desc == d){
666 ptr->next = next->next;
667 ascfree(next);
668 return;
669 } else {
670 ptr = next;
671 }
672 }
673 }
674 }
675 if (g_array_desc_list==NULL) {
676 g_array_desc_count = 0L; /* reset the count if all gone */
677 }
678 }
679
680 struct TypeDescription *CreateArrayTypeDesc(struct module_t *mod,
681 struct TypeDescription *desc,
682 int isint,
683 int isrel,
684 int islogrel,
685 int iswhen,
686 struct gl_list_t *indices
687 ){
688 register struct TypeDescription *result;
689 #if MAKEARRAYNAMES
690 char name[64];
691 #endif
692 if ((result =FindArray(mod,desc,isint,isrel,islogrel,iswhen,indices))==NULL){
693 result=ASC_NEW(struct TypeDescription);
694 result->t = array_type;
695 #if MAKEARRAYNAMES
696 sprintf(name,"array_%lu",g_array_desc_count++);
697 result->name = AddSymbol(name);
698 #else
699 result->name = NULL;
700 #endif
701 result->refines = NULL;
702 result->refiners = NULL;
703 result->parseid = g_parse_count++;
704 result->mod = mod;
705 result->children = NULL;
706 result->init = NULL;
707 result->stats = NULL;
708 result->universal = 0;
709 result->flags = 0;
710 result->flags |= TYPESHOW;
711 result->ref_count = 1;
712 result->u.array.indices = indices;
713 result->u.array.isintset = isint;
714 result->u.array.isrelation = isrel;
715 result->u.array.islogrel = islogrel;
716 result->u.array.iswhen = iswhen;
717 if (desc) CopyTypeDesc(desc);
718 result->u.array.desc = desc;
719 AddArray(result);
720 }
721 else{ /* array type already exists */
722 if (indices){
723 gl_iterate(indices,(void (*)(VOIDPTR))DestroyIndexType);
724 gl_destroy(indices);
725 }
726 }
727 return result;
728 }
729
730 struct TypeDescription *CreateRelationTypeDesc(struct module_t *mod,
731 ChildListPtr clist,
732 struct gl_list_t *plist,
733 struct StatementList *statl,
734 unsigned long int bytesize,
735 struct ChildDesc *childd
736 ){
737 struct TypeDescription *result;
738 result=ASC_NEW(struct TypeDescription);
739 result->t = relation_type;
740 result->ref_count = 1;
741 result->name = GetBaseTypeName(relation_type);
742 result->refines = NULL;
743 result->refiners = NULL;
744 result->parseid = g_parse_count++;
745 result->mod = mod;
746 result->children = clist;
747 result->init = plist;
748 result->stats = statl;
749 result->universal = 0;
750 result->flags = 0;
751 result->flags |= StatListHasDefaults(statl);
752 result->flags |= TYPESHOW;
753 result->u.atom.byte_length = bytesize;
754 result->u.atom.childinfo = childd;
755 result->u.atom.defaulted = 0;
756 result->u.atom.defval = 0.0;
757 result->u.atom.dimp = NULL;
758 return result;
759 }
760
761
762 struct TypeDescription *CreateLogRelTypeDesc(struct module_t *mod,
763 ChildListPtr clist,
764 struct gl_list_t *plist,
765 struct StatementList *statl,
766 unsigned long int bytesize,
767 struct ChildDesc *childd
768 ){
769 struct TypeDescription *result;
770 result=ASC_NEW(struct TypeDescription);
771 result->t = logrel_type;
772 result->ref_count = 1;
773 result->name = GetBaseTypeName(logrel_type);
774 result->refines = NULL;
775 result->refiners = NULL;
776 result->parseid = g_parse_count++;
777 result->mod = mod;
778 result->children = clist;
779 result->init = plist;
780 result->stats = statl;
781 result->universal = 0;
782 result->flags = 0;
783 result->flags |= StatListHasDefaults(statl);
784 result->flags |= TYPESHOW;
785 result->u.atom.byte_length = bytesize;
786 result->u.atom.childinfo = childd;
787 result->u.atom.defaulted = 0;
788 result->u.atom.defval = 0.0;
789 result->u.atom.dimp = NULL;
790 result->u.atom.u.defbool = 0;
791 return result;
792 }
793
794
795 struct TypeDescription
796 *CreateWhenTypeDesc(struct module_t *mod, /* module it is defined in */
797 struct gl_list_t *plist,
798 struct StatementList *statl
799 ){
800 struct TypeDescription *result;
801 result=ASC_NEW(struct TypeDescription);
802 result->ref_count = 1;
803 result->t = when_type;
804 result->name = GetBaseTypeName(when_type);
805 result->refines = NULL;
806 result->refiners = NULL;
807 result->parseid = g_parse_count++;
808 result->mod = mod;
809 result->children = NULL;
810 result->init = plist;
811 result->stats = statl;
812 result->universal = 0;
813 result->flags = 0;
814 result->flags |= TYPESHOW;
815 return result;
816 }
817
818
819 struct TypeDescription
820 *CreatePatchTypeDesc(symchar *name, /* name of the type*/
821 struct TypeDescription *rdesc,/* type that it patches*/
822 struct module_t *mod, /* module patch was defined */
823 struct gl_list_t *pl, /* procedures */
824 struct StatementList *sl /* declarative */
825 ){
826 register struct TypeDescription *result;
827 assert(rdesc!=NULL); /* mandatory */
828 result=ASC_NEW(struct TypeDescription);
829 result->ref_count = 1;
830 result->t = patch_type;
831 result->name = name;
832 result->refines = rdesc;
833 result->refiners = NULL;
834 result->parseid = g_parse_count++;
835 if (rdesc!=NULL) CopyTypeDesc(rdesc);
836 result->mod = mod;
837 result->children = NULL;
838 result->init = pl;
839 result->stats = sl;
840 result->flags = 0;
841 result->flags |= StatListHasDefaults(sl);
842 result->flags |= TYPESHOW;
843 result->universal = 0;
844 return result;
845 }
846
847
848 struct TypeDescription *MoreRefined(CONST struct TypeDescription *desc1,
849 CONST struct TypeDescription *desc2)
850 {
851 register CONST struct TypeDescription *ptr1,*ptr2;
852 AssertAllocatedMemory(desc1,sizeof(struct TypeDescription));
853 AssertAllocatedMemory(desc2,sizeof(struct TypeDescription));
854 if (desc1->t!=desc2->t) return NULL; /* base types unequal */
855 ptr1 = desc1;
856 ptr2 = desc2;
857 while (((ptr1!=NULL)||(ptr2!=NULL))&&(ptr1!=desc2)&&(ptr2!=desc1)){
858 if (ptr1!=NULL) ptr1 = ptr1->refines;
859 if (ptr2!=NULL) ptr2 = ptr2->refines;
860 }
861 if (ptr1==desc2) {
862 /* desc1 is more refined */
863 return (struct TypeDescription *)desc1;
864 }
865 if (ptr2==desc1) {
866 /* desc2 is more refined */
867 return (struct TypeDescription *)desc2;
868 }
869 return NULL; /* unconformable */
870 }
871
872 struct ancestor {
873 CONST struct TypeDescription *d;
874 struct ancestor *next;
875 };
876 #define CreateAncestor(p) \
877 (p) = (struct ancestor *)ascmalloc(sizeof(struct ancestor))
878 #define DestroyAncestor(p) ascfree(p)
879 /*
880 * produce a list of ancestors starting at a base type and
881 * continuing through d;
882 */
883 static struct ancestor *CreateAncestorList(CONST struct TypeDescription *d) {
884 struct ancestor *list=NULL, *new;
885 while (d!=NULL) {
886 CreateAncestor(new);
887 new->d = d;
888 new->next = list;
889 list = new;
890 d = d->refines;
891 }
892 return list;
893 }
894
895 static void DestroyAncestorList(struct ancestor *list){
896 struct ancestor *old;
897 while (list != NULL) {
898 old = list;
899 list = list->next;
900 DestroyAncestor(old);
901 }
902 }
903
904 CONST struct TypeDescription *
905 GreatestCommonAncestor(CONST struct TypeDescription *d1,
906 CONST struct TypeDescription *d2)
907 {
908 CONST struct TypeDescription *result;
909 struct ancestor *head1, *head2, *a1, *a2;
910 if (d1==d2) {
911 return d1;
912 }
913 if (d1 == NULL || d2 == NULL || d1->t != d2->t) {
914 return NULL; /* base types unequal */
915 }
916 a1 = head1 = CreateAncestorList(d1);
917 a2 = head2 = CreateAncestorList(d2);
918 assert(a1!=NULL);
919 assert(a2!=NULL);
920 /* now we know the head1->d == head2->d by construction, unless the
921 * types in question are of MODEL, which has no base.
922 * So walk, looking one step ahead for type incompatibility
923 * or the end of either list.
924 */
925 while (a1->next != NULL && /* stop if a1 is at its last node */
926 a2->next != NULL && /* stop if a2 is at its last node */
927 a1->next->d == a2->next->d /* stop if next is incompatible */) {
928 a1 = a1->next;
929 a2 = a2->next;
930 }
931 /* we are now at the last place a1 and a2 are compatible
932 * or we are stuck at the head of each list so may
933 * return a1 or a2 ->d if both are the same, else NULL.
934 */
935 result = (a1->d==a2->d) ? a1->d : NULL;
936 DestroyAncestorList(head1);
937 DestroyAncestorList(head2);
938 return result;
939 }
940
941 struct gl_list_t *GetAncestorNames(CONST struct TypeDescription *d){
942 struct gl_list_t *result;
943 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
944 assert((d->t&ERROR_KIND)==0);
945 assert(d->ref_count > 0);
946 result = gl_create(4L);
947 while (GetRefinement(d) != NULL) {
948 d = GetRefinement(d);
949 gl_append_ptr(result,(VOIDPTR)GetName(d));
950 }
951 return result;
952 }
953
954 ChildListPtr GetChildListF(CONST struct TypeDescription *d){
955 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
956 assert((d->t&ERROR_KIND)==0);
957 assert(d->ref_count > 0);
958 return (CONST ChildListPtr)(d->children);
959 }
960
961 enum type_kind GetBaseTypeF(CONST struct TypeDescription *d){
962 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
963 assert((d->t&ERROR_KIND)==0);
964 assert(d->ref_count > 0);
965 return d->t;
966 }
967
968 CONST struct StatementList *GetStatementListF(CONST struct TypeDescription *d){
969 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
970 assert((d->t&ERROR_KIND)==0);
971 assert(d->ref_count > 0);
972 return d->stats;
973 }
974
975 struct gl_list_t *GetInitializationListF(CONST struct TypeDescription *d){
976 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
977 assert((d->t&ERROR_KIND)==0);
978 assert(d->ref_count > 0);
979 return d->init;
980 }
981
982 /* This recursively adds a method to d and its refiners.
983 * When following a refiner trail, if we reach a type that
984 * has a method with the same name as new, that type remains
985 * undisturbed and that trail stops. This is because that
986 * other definition of the method in the new type would supercede the
987 * proc we are inserting in the ancestor type if the method
988 * had been written in the ancestor when first the ancestor
989 * was parsed.
990 *
991 * The method pointer this is called with does not become
992 * part of anything. if it is kept, it is by copying.
993 *
994 * Due to the implementation of the base MODEL methods in
995 * a global list, this function will allow you to Add
996 * a method with the same name as a global one. This is
997 * inconsistent but desirable. If you wish to disallow that,
998 * then the filter should be in AddMethods, not in this function.
999 */
1000 static
1001 void RealAddMethod(struct TypeDescription *d, struct InitProcedure *new){
1002 unsigned long c;
1003 struct gl_list_t *opl;
1004 struct InitProcedure *old, *copy;
1005 struct gl_list_t *refiners;
1006
1007 assert(d != NULL);
1008 assert(new != NULL);
1009
1010 opl = GetInitializationList(d);
1011 old = SearchProcList(opl,ProcName(new));
1012 if (old != NULL) {
1013 return;
1014 }
1015 copy = CopyProcedure(new);
1016 gl_insert_sorted(opl,copy,(CmpFunc)CmpProcs);
1017 refiners = GetRefiners(d);
1018 if (refiners != NULL) {
1019 for (c=gl_length(refiners); c > 0; c--) {
1020 d = (struct TypeDescription *)gl_fetch(refiners,c);
1021 RealAddMethod(d,new);
1022 }
1023 }
1024 }
1025
1026 static
1027 void RealReplaceMethod(struct TypeDescription *d, struct InitProcedure *new){
1028 unsigned long c,pos;
1029 struct gl_list_t *opl;
1030 struct InitProcedure *old = NULL, *copy;
1031 struct gl_list_t *refiners;
1032
1033 assert(d != NULL);
1034 assert(new != NULL);
1035
1036 opl = GetInitializationList(d);
1037 pos = gl_search(opl,new,(CmpFunc)CmpProcs);
1038
1039 if ((pos == 0) || (0 != (old = (struct InitProcedure *)gl_fetch(opl,pos))),
1040 GetProcParseId(old) > GetProcParseId(new)) {
1041 return; /* type never had it or type redefined it */
1042 }
1043 copy = CopyProcedure(new);
1044 gl_store(opl,pos,copy);
1045 DestroyProcedure(old);
1046 refiners = GetRefiners(d);
1047 if (refiners != NULL) {
1048 c = gl_length(refiners);
1049 for (; c > 0; c--) {
1050 d = (struct TypeDescription *)gl_fetch(refiners,c);
1051 RealReplaceMethod(d,new);
1052 }
1053 }
1054 }
1055
1056 /* what's legal in the next two functions is different and needs
1057 * different checking.
1058 */
1059 int AddMethods(struct TypeDescription *d, struct gl_list_t *pl, int err){
1060 unsigned long c,len;
1061 int old;
1062 struct gl_list_t *opl;
1063 struct InitProcedure *newproc, *oldproc;
1064 if (d==NULL) {
1065 return 1;
1066 }
1067 if (err!= 0) {
1068 FPRINTF(ASCERR, "%sADD METHODS abandoned due to previous syntax errors.\n",
1069 StatioLabel(3));
1070 return 1;
1071 }
1072 if (d == ILLEGAL_DEFINITION) {
1073 /* stick in UNIVERSAL list */
1074 opl = GetUniversalProcedureList();
1075 if (opl == NULL) {
1076 SetUniversalProcedureList(pl);
1077 return 0;
1078 }
1079 len = gl_length(pl);
1080 for (c = 1; c <= len; c++) {
1081 newproc = (struct InitProcedure *)gl_fetch(pl,c);
1082 oldproc = SearchProcList(opl,ProcName(newproc));
1083 if (oldproc != NULL) {
1084 err++;
1085 FPRINTF(ASCERR,
1086 "%s: ADD METHODS cannot replace MODEL DEFINITION METHOD %s.\n",
1087 StatioLabel(3),SCP(ProcName(newproc)));
1088 DestroyProcedure(newproc);
1089 } else {
1090 gl_append_ptr(opl,newproc);
1091 }
1092 }
1093 SetUniversalProcedureList(opl);
1094 gl_destroy(pl);
1095 return (int)err;
1096 } else {
1097 if (pl==NULL) {
1098 return 0;
1099 }
1100 old = ClaimNewMethodsTypeDesc(GetParseId(d),pl);
1101 if (old) {
1102 return 1; /* we want virgin pl only */
1103 }
1104 len = gl_length(pl);
1105 opl = GetInitializationList(d);
1106 for (c = 1; c <= len; c++) {
1107 newproc = (struct InitProcedure *)gl_fetch(pl,c);
1108 oldproc = SearchProcList(opl,ProcName(newproc));
1109 if (oldproc != NULL) {
1110 err++;
1111 /* should whine something here */
1112 FPRINTF(ASCERR,
1113 "%s: ADD METHODS cannot replace METHOD %s in type %s.\n",
1114 StatioLabel(3),SCP(ProcName(newproc)),SCP(GetName(d)));
1115 } else {
1116 RealAddMethod(d,newproc);
1117 /* find and copy to destinations recursively */
1118 }
1119 }
1120 if (!err) {
1121 DestroyProcedureList(pl);
1122 return 0;
1123 }
1124 return 1;
1125 }
1126 }
1127
1128 int ReplaceMethods(struct TypeDescription *d,struct gl_list_t *pl, int err){
1129 unsigned long c,len,pos;
1130 int old;
1131 struct gl_list_t *opl;
1132 struct InitProcedure *newproc, *oldproc;
1133
1134 if (d==NULL) {
1135 return 1;
1136 }
1137 if (err!= 0) {
1138 FPRINTF(ASCERR,
1139 "%sREPLACE METHODS abandoned due to previous syntax errors.\n",
1140 StatioLabel(3));
1141 return 1;
1142 }
1143 if (d == ILLEGAL_DEFINITION) {
1144 /* replace in UNIVERSAL list */
1145 opl = GetUniversalProcedureList();
1146 if (opl == NULL) {
1147 SetUniversalProcedureList(pl);
1148 return 0;
1149 }
1150 len = gl_length(pl);
1151 for (c = 1; c <= len; c++) {
1152 newproc = (struct InitProcedure *)gl_fetch(pl,c);
1153 pos = gl_search(opl,newproc,(CmpFunc)CmpProcs);
1154 if (pos == 0) {
1155 err++;
1156 FPRINTF(ASCERR,
1157 "%s: REPLACE METHODS cannot ADD method %s in MODEL DEFINITION.\n",
1158 StatioLabel(3),SCP(ProcName(newproc)));
1159 DestroyProcedure(newproc);
1160 } else {
1161 oldproc = (struct InitProcedure *)gl_fetch(opl,pos);
1162 gl_store(opl,pos,newproc);
1163 DestroyProcedure(oldproc);
1164 }
1165 }
1166 SetUniversalProcedureList(opl);
1167 gl_destroy(pl);
1168 return (int)err;
1169 } else {
1170 if (pl==NULL) {
1171 return 0;
1172 }
1173 old = ClaimNewMethodsTypeDesc(GetParseId(d),pl);
1174 if (old) {
1175 return 1; /* we want virgin pl only */
1176 }
1177 len = gl_length(pl);
1178 opl = GetInitializationList(d);
1179 for (c = 1; c <= len; c++) {
1180 newproc = (struct InitProcedure *)gl_fetch(pl,c);
1181 oldproc = SearchProcList(opl,ProcName(newproc));
1182 if (oldproc == NULL) {
1183 err++;
1184 FPRINTF(ASCERR,
1185 "%s: REPLACE METHODS cannot add METHOD %s in type %s.\n",
1186 StatioLabel(3),SCP(ProcName(newproc)),SCP(GetName(d)));
1187 } else {
1188 RealReplaceMethod(d,newproc);
1189 /* find and copy to destinations (existing) recursively */
1190 }
1191 }
1192 if (!err) {
1193 DestroyProcedureList(pl);
1194 return 0;
1195 }
1196 return 1;
1197 }
1198 }
1199
1200 struct InitProcedure *FindMethod(const struct TypeDescription *d, const symchar *procname){
1201 struct gl_list_t *plist;
1202 struct InitProcedure *result = NULL;
1203
1204 plist = GetInitializationList(d);
1205 if(plist != NULL){
1206 result = SearchProcList(plist,procname);
1207 }
1208 plist = GetUniversalProcedureList();
1209 if(result == NULL && plist != NULL) {
1210 /* try for a UNIVERSAL method seen since parsing MODEL of i */
1211 result = SearchProcList(plist,procname);
1212 }
1213 return result;
1214 }
1215
1216
1217 void CopyTypeDescF(struct TypeDescription *d)
1218 {
1219 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1220 assert((d->t&ERROR_KIND)==0);
1221 assert(d->ref_count > 0);
1222 d->ref_count++;
1223 }
1224
1225 void DeleteNewTypeDesc(struct TypeDescription *d){
1226 if (d->ref_count!=1) {
1227 FPRINTF(ASCERR,"New type definition %s with unexpectedly high ref_count\n",
1228 SCP(GetName(d)));
1229 }
1230 DeleteTypeDesc(d);
1231 }
1232
1233 void DeleteTypeDesc(struct TypeDescription *d){
1234 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1235 assert((d->t&ERROR_KIND)==0);
1236 assert(d->ref_count > 0);
1237 --d->ref_count;
1238 if (d->ref_count == 0){
1239 #if (TYPELINKDEBUG)
1240 FPRINTF(ASCERR,"Deleteing type: %s, parseid %ld\n",
1241 d->name,GetParseId(d));
1242 #endif
1243 switch(d->t){
1244 case relation_type:
1245 case logrel_type:
1246 case real_type:
1247 case boolean_type:
1248 case integer_type:
1249 case set_type:
1250 case symbol_type:
1251 if (d->u.atom.childinfo && d->children)
1252 DestroyChildDescArray(d->u.atom.childinfo,
1253 ChildListLen(d->children));
1254 break;
1255 case array_type:
1256 if (d->u.array.desc) DeleteTypeDesc(d->u.array.desc);
1257 if (d->u.array.indices){
1258 gl_iterate(d->u.array.indices,(void (*)(VOIDPTR))DestroyIndexType);
1259 gl_destroy(d->u.array.indices);
1260 }
1261 RemoveArrayTypeDesc(d);
1262 break;
1263 case model_type:
1264 DestroyStatementList(d->u.modarg.declarations);
1265 DestroyStatementList(d->u.modarg.absorbed);
1266 DestroyStatementList(d->u.modarg.reductions);
1267 DestroyStatementList(d->u.modarg.wheres);
1268 /* not in use. probably needs to be smarter if it was.
1269 if (d->u.modarg.argdata!=NULL) {
1270 gl_destroy(d->u.modarg.argdata);
1271 }
1272 */
1273 break;
1274 case patch_type:
1275 break;
1276 case when_type:
1277 break;
1278 case dummy_type:
1279 break;
1280 default:
1281 break;
1282 }
1283 if (d->refines != NULL) {
1284 UnLinkTypeDesc(d->refines,d); /* tell ancestor to forget d */
1285 DeleteTypeDesc(d->refines); /* remove d's reference to ancestor */
1286 /* d->refines->refiners isn't a reference. */
1287 }
1288 if (d->refiners!=NULL) {
1289 assert(gl_length(d->refiners)==0); /* non 0 => bad refcount */
1290 gl_destroy(d->refiners);
1291 }
1292 if (d->children!=NULL) {
1293 DestroyChildList(d->children);
1294 }
1295 DestroyStatementList(d->stats);
1296 DestroyProcedureList(d->init);
1297 d->t = ERROR_KIND; /* should be error_type. patch will do */
1298 d->parseid = -(d->parseid); /* flip the sign */
1299 ascfree(d);
1300 }
1301 }
1302
1303 unsigned GetByteSizeF(CONST struct TypeDescription *d){
1304 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1305 assert((d->t&ERROR_KIND)==0);
1306 assert(d->ref_count > 0);
1307 return (unsigned)d->u.atom.byte_length;
1308 }
1309
1310 CONST struct ChildDesc *GetChildDescF(CONST struct TypeDescription *d){
1311 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1312 assert((d->t&ERROR_KIND)==0);
1313 assert(d->ref_count > 0);
1314 return d->u.atom.childinfo;
1315 }
1316
1317 int GetUniversalFlagF(CONST struct TypeDescription *d){
1318 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1319 assert((d->t&ERROR_KIND)==0);
1320 assert(d->ref_count > 0);
1321 return d->universal;
1322 }
1323
1324 unsigned short int GetTypeFlagsF(CONST struct TypeDescription *d){
1325 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1326 assert((d->t&ERROR_KIND)==0);
1327 assert(d->ref_count > 0);
1328 return d->flags;
1329 }
1330
1331 unsigned int TypeHasDefaultStatementsF(CONST struct TypeDescription *d){
1332 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1333 assert((d->t&ERROR_KIND)==0);
1334 assert(d->ref_count > 0);
1335 return (d->flags & TYPECONTAINSDEFAULTS);
1336 }
1337
1338 unsigned int TypeHasParameterizedInstsF(CONST struct TypeDescription *d){
1339 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1340 assert((d->t&ERROR_KIND)==0);
1341 assert(d->ref_count > 0);
1342 return (d->flags & TYPECONTAINSPARINSTS);
1343 }
1344
1345
1346 double GetRealDefaultF(CONST struct TypeDescription *d,
1347 CONST char *file, CONST int line
1348 ){
1349 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1350 assert((d->t&ERROR_KIND)==0);
1351 assert(d->ref_count > 0);
1352 if (GetBaseType(d)==real_type) {
1353 return d->u.atom.u.defval;
1354 } else {
1355 error_reporter(ASC_PROG_ERROR,file,line,NULL,"GetRealDefault called without real_type");
1356 return 0.0;
1357 }
1358 }
1359
1360 unsigned GetBoolDefaultF(CONST struct TypeDescription *d,
1361 CONST char *file, CONST int line
1362 ){
1363 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1364 assert((d->t&ERROR_KIND)==0);
1365 assert(d->ref_count > 0);
1366 if (GetBaseType(d)==boolean_type) {
1367 return d->u.atom.u.defbool;
1368 } else {
1369 error_reporter(ASC_PROG_ERROR,file,line,NULL,"GetBoolDefault called without boolean_type");
1370 return 0;
1371 }
1372 }
1373
1374 CONST dim_type *GetRealDimensF(CONST struct TypeDescription *d,
1375 CONST char *file, CONST int line
1376 ){
1377 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1378 assert((d->t&ERROR_KIND)==0);
1379 assert(d->ref_count > 0);
1380 if (BaseTypeIsAtomic(d)) {
1381 return d->u.atom.dimp;
1382 } else {
1383 error_reporter(ASC_PROG_ERROR,file,line,NULL,"GetRealDimens called non-atom type");
1384 return WildDimension();
1385 }
1386 }
1387
1388 CONST dim_type *GetConstantDimensF(CONST struct TypeDescription *d,
1389 CONST char *file, CONST int line
1390 ){
1391 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1392 assert((d->t&ERROR_KIND)==0);
1393 assert(d->ref_count > 0);
1394 if (GetBaseType(d)==real_constant_type ||
1395 GetBaseType(d)==integer_constant_type ||
1396 GetBaseType(d)==boolean_constant_type ||
1397 GetBaseType(d)==symbol_constant_type) {
1398 return d->u.constant.dimp;
1399 } else {
1400 error_reporter(ASC_PROG_ERROR,file,line,NULL,"GetConstDimens called without constant type");
1401 return WildDimension();
1402 }
1403 }
1404
1405 symchar *GetNameF(CONST struct TypeDescription *d){
1406 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1407 assert((d->t&ERROR_KIND)==0);
1408 assert(d->ref_count > 0);
1409 return d->name;
1410 }
1411
1412 int TypesAreEquivalent(CONST struct TypeDescription *d1,
1413 CONST struct TypeDescription *d2
1414 ){
1415 unsigned long n;
1416
1417 if (d1 == d2) {
1418 return 1;
1419 }
1420 if (d1->t != d2->t ||
1421 d1->name != d2->name ||
1422 d1->universal != d2->universal ||
1423 d1->refines != d2->refines) {
1424 return 0; /* basetype, univ, symtab name, ancestor must be == */
1425 }
1426 /*
1427 * check special things, then for all types, check stats, init.
1428 */
1429 switch (d1->t) {
1430 case real_type:
1431 if (d1->u.atom.defaulted != d2->u.atom.defaulted ||
1432 (d1->u.atom.defaulted &&
1433 d1->u.atom.u.defval != d2->u.atom.u.defval) ||
1434 d1->u.atom.dimp != d2->u.atom.dimp
1435 ) {
1436 return 0;
1437 }
1438 break;
1439 case boolean_type:
1440 if (d1->u.atom.defaulted != d2->u.atom.defaulted ||
1441 (d1->u.atom.defaulted &&
1442 d1->u.atom.u.defbool != d2->u.atom.u.defbool)
1443 ) {
1444 return 0;
1445 }
1446 break;
1447 case integer_type:
1448 if (d1->u.atom.defaulted != d2->u.atom.defaulted ||
1449 (d1->u.atom.defaulted &&
1450 d1->u.atom.u.defint != d2->u.atom.u.defint)
1451 ) {
1452 return 0;
1453 }
1454 break;
1455 case symbol_type:
1456 if (d1->u.atom.defaulted != d2->u.atom.defaulted ||
1457 (d1->u.atom.defaulted &&
1458 d1->u.atom.u.defsym != d2->u.atom.u.defsym)
1459 ) {
1460 return 0;
1461 }
1462 break;
1463 case real_constant_type:
1464 if (d1->u.constant.defaulted != d2->u.constant.defaulted ||
1465 (d1->u.constant.defaulted &&
1466 d1->u.constant.u.defreal != d2->u.constant.u.defreal) ||
1467 d1->u.constant.dimp != d2->u.constant.dimp
1468 ) {
1469 return 0;
1470 }
1471 break;
1472 case boolean_constant_type:
1473 if (d1->u.constant.defaulted != d2->u.constant.defaulted ||
1474 (d1->u.constant.defaulted &&
1475 d1->u.constant.u.defboolean != d2->u.constant.u.defboolean)
1476 ) {
1477 return 0;
1478 }
1479 break;
1480 case integer_constant_type:
1481 if (d1->u.constant.defaulted != d2->u.constant.defaulted ||
1482 (d1->u.constant.defaulted &&
1483 d1->u.constant.u.definteger != d2->u.constant.u.definteger)
1484 ) {
1485 return 0;
1486 }
1487 break;
1488 case symbol_constant_type:
1489 if (d1->u.constant.defaulted != d2->u.constant.defaulted ||
1490 (d1->u.constant.defaulted &&
1491 d1->u.constant.u.defsymbol != d2->u.constant.u.defsymbol)
1492 ) {
1493 return 0;
1494 }
1495 break;
1496 case set_type: /* odd! */
1497 case relation_type:
1498 /* fall through */
1499 case logrel_type:
1500 break;
1501 case array_type:
1502 return 0; /* array types are weird */
1503 case model_type:
1504 if (
1505 CompareStatementLists(
1506 d1->u.modarg.declarations,
1507 d2->u.modarg.declarations,&n) != 0 ||
1508 CompareStatementLists(
1509 d1->u.modarg.absorbed,
1510 d2->u.modarg.absorbed,&n) != 0 ||
1511 CompareStatementLists(
1512 d1->u.modarg.reductions,
1513 d2->u.modarg.reductions,&n) != 0 ||
1514 CompareStatementLists(
1515 d1->u.modarg.wheres,
1516 d2->u.modarg.wheres,&n) != 0 ||
1517 CompareChildLists( d1->children, d2->children,&n) != 0
1518 ) {
1519 return 0;
1520 }
1521 /* not in use. probably needs to be smarter if it was.
1522 * if (d->u.modarg.argdata!=NULL) {
1523 * }
1524 */
1525 break;
1526 case patch_type:
1527 return 0; /* patches are not to be checked in detail */
1528 case when_type:
1529 case dummy_type:
1530 return 0; /* not to be checked. and should never be sent. */
1531 default:
1532 return 0; /* say what? */
1533 }
1534 /*
1535 *if (d->refiners!=NULL) {
1536 * we don't care who REFINES us, we're only comparing these two.
1537 * presumably one is new and won't have refiners yet.
1538 *}
1539 */
1540 if (CompareStatementLists(d1->stats,d2->stats,&n) != 0 ||
1541 CompareProcedureLists(d1->init,d2->init,&n) != 0) {
1542 return 0;
1543 }
1544 return 1; /* if everything checks, return 1; */
1545 }
1546
1547 void DifferentVersionCheck(CONST struct TypeDescription *desc1,
1548 CONST struct TypeDescription *desc2
1549 ){
1550 register CONST struct TypeDescription *ptr;
1551 int erred;
1552 erred = 0;
1553 AssertAllocatedMemory(desc1,sizeof(struct TypeDescription));
1554 AssertAllocatedMemory(desc2,sizeof(struct TypeDescription));
1555
1556 if (desc1->t != desc2->t) return;
1557 ptr = desc1;
1558 while (ptr){
1559 if (!CmpSymchar(ptr->name,desc2->name)){
1560 erred = 1;
1561 FPRINTF(ASCERR,"%s and %s are conformable by name;",
1562 SCP(desc1->name), SCP(desc2->name));
1563 FPRINTF(ASCERR,"but they are unconformable because of different");
1564 FPRINTF(ASCERR,"different type versions.\n");
1565 }
1566 ptr = ptr->refines;
1567 }
1568 ptr = desc2;
1569 while (ptr){
1570 if (!CmpSymchar(ptr->name,desc1->name)) {
1571 erred = 1;
1572 FPRINTF(ASCERR,"%s and %s are conformable by name;",
1573 SCP(desc1->name), SCP(desc2->name));
1574 FPRINTF(ASCERR,"but they are unconformable because of different");
1575 FPRINTF(ASCERR,"type versions.\n");
1576 }
1577 ptr = ptr->refines;
1578 }
1579 if (erred) {
1580 FPRINTF(ASCERR,"Different versions caused by previous redefinition\n");
1581 FPRINTF(ASCERR,
1582 "Try writing values, deleting all types, and recompiling\n");
1583 }
1584 }
1585
1586 struct TypeDescription *GetStatTypeDesc(CONST struct Statement *s){
1587 symchar *tn;
1588 if (s==NULL) return NULL;
1589 switch(StatementType(s)) {
1590 case ISA:
1591 case WILLBE:
1592 case IRT:
1593 tn = GetStatType(s);
1594 if (tn!=NULL && tn != GetBaseTypeName(set_type)) {
1595 return FindType(tn);
1596 }
1597 break;
1598 case ALIASES:
1599 case ARR:
1600 case ATS:
1601 case WBTS:
1602 case WNBTS:
1603 case AA:
1604 case FOR:
1605 case REL:
1606 case LOGREL:
1607 case ASGN:
1608 case CASGN:
1609 case WHEN:
1610 case FNAME:
1611 case SELECT:
1612 case EXT:
1613 case REF:
1614 case COND:
1615 case RUN:
1616 case CALL:
1617 case IF:
1618 break;
1619 default:
1620 FPRINTF(ASCERR,"GetStatTypeDesc called with unknown stat type\n");
1621 }
1622 return NULL;
1623 }
1624
1625 void WriteArrayTypeList(FILE *f){
1626 struct ArrayDescList *ptr;
1627 unsigned long count = 0L;
1628
1629 FPRINTF(f,"Number of descriptions made: %lu\n",g_array_desc_count);
1630 ptr = g_array_desc_list;
1631 if (ptr!=NULL) {
1632 FPRINTF(f,"Descriptions:\n");
1633 }
1634 while (ptr!=NULL) {
1635 count++;
1636 if (ptr->desc!=NULL) {
1637 WriteDefinition(f,ptr->desc);
1638 } else {
1639 FPRINTF(f," *** NULL Description! ***\n");
1640 }
1641 ptr = ptr->next;
1642 }
1643 FPRINTF(f,"Number of descriptions current: %lu\n",count);
1644 }
1645
1646
1647 unsigned TypeShowF(CONST struct TypeDescription *d){
1648 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1649 assert((d->t&ERROR_KIND)==0);
1650 return (d->flags & TYPESHOW);
1651 }
1652
1653
1654 void SetTypeShowBit(struct TypeDescription *d, int value){
1655 AssertAllocatedMemory(d,sizeof(struct TypeDescription));
1656 assert((d->t&ERROR_KIND)==0);
1657 if (value) {
1658 d->flags |= TYPESHOW;
1659 } else {
1660 d->flags &= ~TYPESHOW;
1661 }
1662 }
1663

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22