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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 303 - (show annotations) (download) (as text)
Tue Feb 21 02:38:13 2006 UTC (18 years, 4 months ago) by johnpye
File MIME type: text/x-csrc
File size: 29626 byte(s)
Documentation, indentation and debugging-message changes.
1 /*
2 * Ascend Instance Array Implementation
3 * by Tom Epperly & Ben Allan
4 * 9/3/89
5 * Version: $Revision: 1.23 $
6 * Version control file: $RCSfile: arrayinst.c,v $
7 * Date last modified: $Date: 1998/04/07 19:52:39 $
8 * Last modified by: $Author: ballan $
9 *
10 * This file is part of the Ascend Language Interpreter.
11 *
12 * Copyright (C) 1997 Carnegie Mellon University
13 * Copyright (C) 1996 Benjamin Andrew Allan
14 * based on instance.c
15 * Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
16 *
17 * The Ascend Language Interpreter is free software; you can redistribute
18 * it and/or modify it under the terms of the GNU General Public License as
19 * published by the Free Software Foundation; either version 2 of the
20 * License, or (at your option) any later version.
21 *
22 * The Ascend Language Interpreter is distributed in hope that it will be
23 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
24 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
25 * General Public License for more details.
26 *
27 * You should have received a copy of the GNU General Public License
28 * along with the program; if not, write to the Free Software Foundation,
29 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
30 * COPYING.
31 *
32 */
33 #include <stdarg.h>
34 #include "utilities/ascConfig.h"
35 #include "utilities/ascMalloc.h"
36 #include "utilities/ascPanic.h"
37 #include "general/list.h"
38 #include "general/dstring.h"
39 #include "compiler/compiler.h"
40 #include "compiler/bit.h"
41 #include "compiler/symtab.h"
42 #include "compiler/fractions.h"
43 #include "compiler/dimen.h"
44 #include "compiler/functype.h"
45 #include "compiler/types.h"
46 #include "compiler/instance_enum.h"
47 #include "compiler/instance_name.h"
48 #include "compiler/instance_io.h"
49 #include "compiler/check.h"
50 #include "compiler/dump.h"
51 #include "compiler/child.h"
52 #include "compiler/type_desc.h"
53 #include "compiler/prototype.h"
54 #include "compiler/vlist.h"
55 #include "compiler/pending.h"
56 #include "compiler/find.h"
57 #include "compiler/extfunc.h"
58 #include "compiler/relation_type.h"
59 #include "compiler/relation.h"
60 #include "compiler/logical_relation.h"
61 #include "compiler/logrelation.h"
62 #include "compiler/relation_util.h"
63 #include "compiler/logrel_util.h"
64 #include "compiler/rel_common.h"
65 #include "compiler/case.h"
66 #include "compiler/when_util.h"
67 #include "compiler/universal.h"
68 #include "general/pool.h"
69 #include "compiler/instance_types.h"
70 #include "compiler/instantiate.h"
71 /* new */
72 #include "compiler/arrayinst.h"
73 #include "compiler/atomvalue.h"
74 #include "compiler/atomsize.h"
75 #include "compiler/cmpfunc.h"
76 #include "compiler/copyinst.h"
77 #include "compiler/createinst.h"
78 #include "compiler/destroyinst.h"
79 #include "compiler/extinst.h"
80 #include "compiler/instmacro.h"
81 #include "compiler/instquery.h"
82 #include "compiler/linkinst.h"
83 #include "compiler/parentchild.h"
84 #include "compiler/refineinst.h"
85 #include "compiler/tmpnum.h"
86 /* needed, but didn't know it */
87 #include "compiler/forvars.h"
88 #include "compiler/setinstval.h"
89 #include "compiler/stattypes.h"
90 #include "compiler/statement.h"
91 #include "compiler/module.h"
92 #include "compiler/library.h"
93 #include "compiler/evaluate.h"
94 #include "compiler/statio.h"
95 #include "compiler/name.h"
96 #include "compiler/value_type.h"
97
98 #ifndef lint
99 static CONST char ArrayInstModuleID[] = "$Id: arrayinst.c,v 1.23 1998/04/07 19:52:39 ballan Exp $";
100 #endif
101
102 pool_store_t g_array_child_pool=NULL;
103 /*
104 * A pool_store for all the array children ever simultaneously in use.
105 */
106 #define IN_LEN 2
107 #if (SIZEOF_VOID_P == 8)
108 #define IN_WID 127
109 #else
110 #define IN_WID 255
111 #endif
112 /* retune if the size of ArrayChild changes dramatically */
113 #define IN_ELT_SIZE (sizeof(struct ArrayChild))
114 #define IN_MORE_ELTS 1
115 /* Number of slots filled if more elements needed.
116 * So if the pool grows, it grows by IN_MORE_ELTS*IN_WID elements at a time.
117 */
118 #define IN_MORE_BARS 200
119 /* This is the number of pool bar slots to add during expansion.
120 * not all the slots will be filled immediately.
121 */
122
123 void InitInstanceNanny(void)
124 {
125 if (g_array_child_pool != NULL ) {
126 Asc_Panic(2, NULL, "ERROR: InitInstanceNanny called twice.\n");
127 }
128 g_array_child_pool =
129 pool_create_store(IN_LEN, IN_WID, IN_ELT_SIZE, IN_MORE_ELTS, IN_MORE_BARS);
130 if (g_array_child_pool == NULL) {
131 Asc_Panic(2, NULL, "ERROR: InitInstanceNanny unable to allocate pool.\n");
132 }
133 }
134
135 void DestroyInstanceNanny(void)
136 {
137 assert(g_array_child_pool!=NULL);
138 pool_destroy_store(g_array_child_pool);
139 g_array_child_pool = NULL;
140 }
141
142 void ReportInstanceNanny(FILE *f)
143 {
144 assert(g_array_child_pool!=NULL);
145 FPRINTF(f,"InstanceNanny ");
146 pool_print_store(f,g_array_child_pool,0);
147 }
148
149 static
150 void ApplyToLeaves(struct Instance *i, AVProc func, int depth)
151 {
152 unsigned long c,len;
153 struct Instance *ch;
154 if (i == NULL) {
155 return;
156 }
157 len = NumberChildren(i);
158 if (depth == 1) {
159 for (c = 1; c <= len; c++) {
160 ch = InstanceChild(i,c);
161 if (ch != NULL) {
162 (*func)(ch);
163 }
164 }
165 } else {
166 depth--;
167 for (c = 1; c <= len; c++) {
168 ch = InstanceChild(i,c);
169 if (ch != NULL) {
170 ApplyToLeaves(ch,func,depth);
171 }
172 }
173 }
174 }
175 /*
176 * It may happen that there are no leaves if the array is
177 * defined over a NULL set in some portion. So for example if
178 * c[8][9] IS_A real; b[1..2][4..5] ALIASES c;
179 * then the instance b has 4 subscripts to the end user,
180 * but the 'leaves' of b which we don't want to
181 * count as parents of elements c[i] are b[i][j].
182 * Go NumberofDereferences(ch) and delete that contribution to
183 * the number of parents counts.
184 */
185 void ArrayVisitLocalLeaves(struct Instance *i, AVProc func)
186 {
187 register struct ArrayInstance *ary;
188 int depth;
189 AssertMemory(i);
190 ary = ARY_INST(i);
191 if ((ary->t==ARRAY_INT_INST)||(ary->t==ARRAY_ENUM_INST)) {
192 depth = (int)gl_length(GetArrayIndexList(ary->desc))-ary->indirected;
193 } else {
194 Asc_Panic(2, "ArrayVisitLocalLeaves",
195 "Incorrect instance type (nonarray) given.\n");
196 exit(2);/* NOT REACHED: Panic Exits--Needed to keep gcc from whining */
197 }
198 ApplyToLeaves(i,func,depth);
199 }
200
201 struct gl_list_t *CollectArrayInstances(CONST struct Instance *i,
202 struct gl_list_t *result)
203 {
204 unsigned long c, len;
205 struct gl_list_t *clist;
206 struct ArrayChild *ch;
207
208 assert(i != NULL && IsArrayInstance(i) != 0);
209 if (result == NULL) {
210 result = gl_create(10L);
211 }
212 assert(result != NULL);
213 clist = ARY_INST(i)->children;
214 if (clist==NULL) {
215 return result;
216 }
217 len = gl_length(clist);
218 for (c = 1; c <= len; c++) {
219 ch = (struct ArrayChild *)gl_fetch(clist,c);
220 if (ch != NULL) {
221 if (IsArrayInstance(ch->inst)==0) {
222 /* found something not an array */
223 gl_append_ptr(result,ch->inst);
224 } else {
225 /* found another array layer */
226 CollectArrayInstances(ch->inst,result);
227 }
228 }
229 }
230 return result;
231 }
232
233 int RectangleArrayExpanded(CONST struct Instance *i)
234 {
235 register struct ArrayInstance *ary;
236 register struct ArrayChild *ptr;
237 register unsigned long number;
238 AssertMemory(i);
239 ary = ARY_INST(i);
240 if ((ary->t==ARRAY_INT_INST)||(ary->t==ARRAY_ENUM_INST)) {
241 number = gl_length(GetArrayIndexList(ary->desc)) - ary->indirected;
242 while (number-- > 0) {
243 if (ary->children==NULL) return 0;
244 if (gl_length(ary->children)==0) return 1;
245 ptr = (struct ArrayChild *)gl_fetch(ary->children,1);
246 AssertContainedMemory(ptr,sizeof(struct ArrayChild));
247 if ((ptr==NULL)||(ptr->inst==NULL)){
248 Asc_Panic(2, NULL, "Illegal array data structure.\n");
249 }
250 ary = ARY_INST(ptr->inst);
251 }
252 return 1;
253 } else {
254 Asc_Panic(2, NULL,
255 "Incorrect instance type passed to RectangleArrayExpanded.\n");
256 exit(2);/* Needed to keep gcc from whining */
257 }
258 }
259
260 /* returns NULL for bad input OTHERWISE a set of indices from the array
261 * ai's immediate child list.
262 * if array is not expanded, returns NULL.
263 */
264 static
265 struct set_t *ExtractIndices(CONST struct Instance *ai)
266 {
267 struct set_t *result;
268 unsigned long c,len;
269 struct ArrayChild *ptr;
270 struct ArrayInstance *ary;
271
272 result = CreateEmptySet();
273 ary = ARY_INST(ai);
274 switch(InstanceKind(ai)) {
275 case ARRAY_INT_INST:
276 if (ary->children==NULL) {
277 DestroySet(result);
278 return NULL;
279 }
280 len = gl_length(ary->children);
281 for (c = 1; c <= len; c++) {
282 ptr = (struct ArrayChild *)gl_fetch(ary->children,c);
283 if ((ptr==NULL)||(ptr->inst==NULL)){
284 FPRINTF(ASCERR,"Illegal array data structure in ExtractIndices.\n");
285 DestroySet(result);
286 return NULL;
287 }
288 InsertInteger(result,ptr->name.index);
289 }
290 return result;
291 case ARRAY_ENUM_INST:
292 if (ary->children==NULL) {
293 DestroySet(result);
294 return NULL;
295 }
296 len = gl_length(ary->children);
297 for (c = 1; c <= len; c++) {
298 ptr = (struct ArrayChild *)gl_fetch(ary->children,c);
299 if ((ptr==NULL)||(ptr->inst==NULL)){
300 FPRINTF(ASCERR,"Illegal array data structure in ExtractIndices.\n");
301 DestroySet(result);
302 return NULL;
303 }
304 InsertString(result,ptr->name.str);
305 }
306 return result;
307 default:
308 DestroySet(result);
309 return NULL;
310 }
311 }
312
313 /* return 1 if match,
314 * 0 if not match,
315 * and -1 if horribly mangled
316 * and -2 if can't tell yet.
317 */
318 int RectangleSubscriptsMatch(CONST struct Instance *parent,
319 CONST struct Instance *ary,
320 CONST struct Name *setname)
321 {
322 struct ArrayChild *ptr;
323 struct value_t value, /* computed from of the expanded name element */
324 setval, /* value converted to set value for comparison */
325 indices, /* subscripts found in array, as a setvalue */
326 cmp; /* boolean comparison result */
327 CONST struct Set *setp;
328 struct set_t *sptr;
329 unsigned int really_ok = 0; /* reached matching empty array leaf */
330
331 /* outside the while loop, all value_t should be empty */
332 while (ary != NULL && setname != NULL) {
333 if ( (ary->t!=ARRAY_INT_INST) && (ary->t!=ARRAY_ENUM_INST) ) {
334 ary = NULL;
335 break;
336 }
337
338 /* calculate set expected */
339 assert(NameId(setname)==0);
340 assert(GetEvaluationContext()==NULL);
341 SetEvaluationContext(parent);
342 setp = NameSetPtr(setname);
343 value = EvaluateSet(setp,InstanceEvaluateName);
344 SetEvaluationContext(NULL);
345
346 /* check for sanity of expected set */
347 switch(ValueKind(value)) {
348 case list_value:
349 setval = CreateSetFromList(value); /* make unique,sorted,and monotypic */
350 DestroyValue(&value);
351 switch(ValueKind(setval)) {
352 case set_value:
353 break;
354 default:
355 DestroyValue(&setval);
356 return -1;
357 }
358 break;
359 case error_value:
360 switch(ErrorValue(value)){
361 case name_unfound:
362 case undefined_value:
363 DestroyValue(&value);
364 return -2; /* possibly pending name piece, or unexecuted assgn */
365 default:
366 FPRINTF(ASCERR,"Array index definition has incorrect type:\n");
367 DestroyValue(&value);
368 return -1;
369 }
370 default:
371 FPRINTF(ASCERR,"Array instance has incorrect index value type.\n");
372 break;
373 }
374
375 /* at this point value is cleared, and setval is ok */
376 /* extract array indices and compare. */
377 sptr = ExtractIndices(ary);
378 if (sptr==NULL) {
379 DestroyValue(&setval);
380 return -1;
381 }
382 indices = CreateSetValue(sptr);
383 cmp = EqualValues(indices,setval);
384 DestroyValue(&indices); /* also cleans up sptr */
385 DestroyValue(&setval);
386 switch(ValueKind(cmp)) {
387 case boolean_value:
388 if (BooleanValue(cmp)!=0) {
389 DestroyValue(&cmp);
390 break; /* move on to next subscript */
391 } else {
392 DestroyValue(&cmp);
393 return 0; /* value mismatch */
394 }
395 default: /* error in comparison value */
396 DestroyValue(&cmp);
397 return -1;
398 }
399
400 setname = NextName(setname);
401 if (gl_length(ARY_INST(ary)->children)==0) {
402 if (setname != NULL) {
403 /* more subscripts than children to fill them. */
404 return -1;
405 }
406 /* else the including while will kick out because setname NULL,
407 * then the if will pass because we force it to. it will
408 * OTHERWISE fail because the IsArrayInstance would return 1.
409 */
410 /* apply force */
411 ary = NULL;
412 really_ok =1;
413 } else {
414 /* here's where the rectangle-ism comes in. needs recursion
415 * to handle the sparse case.
416 */
417 ptr = (struct ArrayChild *)gl_fetch(ARY_INST(ary)->children,1);
418 ary = ptr->inst;
419 }
420 }
421 if ((ary!=NULL && IsArrayInstance(ary) == 0 && setname == NULL) ||
422 really_ok) {
423 /* only TRUE if at array leaf or emptyset defined array. */
424 return 1;
425 } else {
426 /* either set or ary terminated early/late. */
427 return -1;
428 }
429 }
430
431
432 unsigned long NextToExpand(CONST struct Instance *i)
433 {
434 register struct ArrayInstance *ary;
435 register struct ArrayChild *ptr;
436 register unsigned long number,c;
437 AssertMemory(i);
438 ary = ARY_INST(i);
439 if ((ary->t==ARRAY_INT_INST)||(ary->t==ARRAY_ENUM_INST)) {
440 c = number = gl_length(GetArrayIndexList(ary->desc))-ary->indirected;
441 while (c-->0) {
442 assert((ary->t==ARRAY_INT_INST)||(ary->t==ARRAY_ENUM_INST));
443 if (ary->children==NULL) return number-c;
444 if (gl_length(ary->children)==0) return 0;
445 ptr = (struct ArrayChild *)gl_fetch(ary->children,1);
446 AssertContainedMemory(ptr,sizeof(struct ArrayChild));
447 if ((ptr==NULL)||(ptr->inst==NULL)){
448 Asc_Panic(2, NULL, "Illegal array data structure.\n");
449 }
450 if (c) {
451 ary = ARY_INST(ptr->inst);
452 }
453 }
454 return 0;
455 } else {
456 Asc_Panic(2, NULL, "Incorrect instance type passed to NextToExpand.\n");
457 exit(2);/* Needed to keep gcc from whining */
458 }
459 }
460
461 unsigned long NumberofDereferences(CONST struct Instance *i)
462 {
463 register struct ArrayInstance *ary;
464 AssertMemory(i);
465 ary = ARY_INST(i);
466 if ((ary->t==ARRAY_INT_INST)||(ary->t==ARRAY_ENUM_INST)) {
467 return gl_length(GetArrayIndexList(ary->desc))-ary->indirected;
468 } else {
469 Asc_Panic(2, "NumberofDereferences",
470 "Incorrect instance type passed to NumberofDereferences.\n");
471 exit(2);/* NOT REACHED: Panic Exits--Needed to keep gcc from whining */
472 }
473 }
474
475 CONST struct Set *IndexSet(CONST struct Instance *i, unsigned long int num)
476 {
477 struct IndexType *ptr;
478 AssertMemory(i);
479 if ((i->t==ARRAY_INT_INST)||(i->t==ARRAY_ENUM_INST)){
480 ptr = (struct IndexType *)gl_fetch(GetArrayIndexList(ARY_INST(i)->desc),
481 num);
482 AssertAllocatedMemory(ptr,sizeof(struct IndexType));
483 return GetIndexSet(ptr);
484 } else {
485 Asc_Panic(2, NULL, "Incorrect instance type passed to IndexSet.\n");
486 exit(2);/* Needed to keep gcc from whining */
487 }
488 }
489
490 /*
491 * We have made this function longer by now explicitly
492 * requiring it to call ShortCutMakeUniversalInstance. This is
493 * so that the Create* routines will *always* provide
494 * a new copy of an instance. For models we do not add
495 * the instance to the pending list if it is a universal
496 * instance or if we copied a prototype,
497 * OTHERWISE we do add to pending.
498 *
499 * This function makes the final object that is the element
500 * of an array, whatever its type. Relation arrays are handled
501 * elsewhere, however. If called with a multisubscript array,
502 * it returns the next subscript layer of a rectangular array.
503 *
504 * We call this even in the case of aliases, because this is where
505 * we get the indirection of dense arrays done right.
506 * If rhsinst is not null, we assume we are in alias processing.
507 */
508 static
509 struct Instance *CreateArrayChildInst(struct Instance *i,
510 struct Instance *rhsinst,
511 struct Instance *arginst)
512 {
513 struct TypeDescription *def,*desc;
514 struct Instance *inst;
515 int isintset;
516 struct gl_list_t *list;
517
518 AssertMemory(i);
519 desc = ARY_INST(i)->desc;
520 AssertMemory(desc);
521 list = GetArrayIndexList(desc);
522 if ((ARY_INST(i)->indirected+1)>=gl_length(list)){
523 /* make or copy new object */
524 if (rhsinst==NULL) {
525 /* create new instance */
526 def = GetArrayBaseType(desc);
527 isintset = GetArrayBaseIsInt(desc);
528 switch(GetBaseType(def)){
529 case model_type:
530 inst = ShortCutMakeUniversalInstance(def);
531 if (inst==NULL) {
532 inst = ShortCutProtoInstance(def); /* check if prototype exists */
533 }
534 if (inst==NULL) { /* have to make one */
535 inst = CreateModelInstance(def);
536 if (!GetUniversalFlag(def)||!InstanceInList(inst)) {
537 /* see notes in instantiate.c */
538 ConfigureInstFromArgs(inst,arginst);
539 AddBelow(NULL,inst);
540 /* add PENDING model */
541 }
542 }
543 return inst;
544 case real_type:
545 case real_constant_type:
546 inst = ShortCutMakeUniversalInstance(def);
547 if (inst!=NULL) return inst;
548 return CreateRealInstance(def);
549 case boolean_type:
550 case boolean_constant_type:
551 inst = ShortCutMakeUniversalInstance(def);
552 if (inst!=NULL) return inst;
553 return CreateBooleanInstance(def);
554 case integer_type:
555 case integer_constant_type:
556 inst = ShortCutMakeUniversalInstance(def);
557 if (inst!=NULL) return inst;
558 return CreateIntegerInstance(def);
559 case set_type:
560 inst = ShortCutMakeUniversalInstance(def);
561 if (inst!=NULL) return inst;
562 return CreateSetInstance(def,isintset);
563 case symbol_type:
564 case symbol_constant_type:
565 inst = ShortCutMakeUniversalInstance(def);
566 if (inst!=NULL) return inst;
567 return CreateSymbolInstance(def);
568 case relation_type:
569 /*
570 * we dont know the reltype at this stage so
571 * set to undefined. we also dont call shortcut
572 * as relations cannot be universal by themselves.
573 */
574 if (GetArrayBaseIsRelation(desc)) {
575 return CreateRelationInstance(def,e_undefined);
576 }
577 /* fallthrough */
578 case logrel_type:
579 if (GetArrayBaseIsLogRel(desc)) {
580 return CreateLogRelInstance(def);
581 }
582 /* fallthrough */
583 case when_type:
584 if (GetArrayBaseIsWhen(desc)) {
585 return CreateWhenInstance(def);
586 }
587 /* fallthrough */
588 default:
589 FPRINTF(ASCERR,"Uggggh! CreateArrayChildInst.\n");
590 break; /* oh boy did it... */
591 }
592 return NULL;
593 } else {
594 /* take the single rhs pointer of the ALIASES statement. */
595 return rhsinst;
596 }
597 } else {
598 CopyTypeDesc(desc);
599 return CreateArrayInstance(desc,ARY_INST(i)->indirected+2);
600 }
601 }
602
603 static
604 struct ArrayChild *FindRHSByInt(struct gl_list_t *rhslist, long index)
605 {
606 unsigned long c,len;
607 for (c=1, len = gl_length(rhslist); c <= len; c++) {
608 if (CAC(gl_fetch(rhslist,c))->name.index == index) {
609 return CAC(gl_fetch(rhslist,c));
610 }
611 }
612 FPRINTF(ASCERR,"ALIASES-IS_A integer child has skipped town.\n");
613 return NULL;
614 }
615
616 static
617 struct ArrayChild *FindRHSByString(struct gl_list_t *rhslist, symchar *s)
618 {
619 unsigned long c,len;
620 for (c=1, len = gl_length(rhslist); c <= len; c++) {
621 if (CAC(gl_fetch(rhslist,c))->name.str == s ||
622 CmpSymchar(CAC(gl_fetch(rhslist,c))->name.str,s)==0) {
623 return CAC(gl_fetch(rhslist,c));
624 }
625 }
626 FPRINTF(ASCERR,"ALIASES-IS_A symbol child has skipped town.\n");
627 return NULL;
628 }
629
630 static
631 void ExpandIntegerSet(struct ArrayInstance *i, struct set_t *set,
632 struct Instance *rhsinst, struct Instance *arginst,
633 struct gl_list_t *rhslist)
634 {
635 register unsigned long c,len;
636 register struct ArrayChild *ptr, *rptr;
637 AssertMemory(i);
638 AssertMemory(set);
639 assert(rhslist==NULL||rhsinst==NULL); /* one type of alias or other */
640 if (i->t==ARRAY_INT_INST){
641 len = Cardinality(set);
642 i->children = gl_create(len);
643 AssertMemory(i->children);
644 for(c=1;c<=len;c++){
645 ptr = MALLOCPOOLAC;
646 ptr->name.index = FetchIntMember(set,c);
647 if (rhslist != NULL) {
648 rptr = FindRHSByInt(rhslist,ptr->name.index);
649 assert(rptr != NULL);
650 rhsinst = rptr->inst;
651 assert(rhsinst != NULL);
652 }
653 ptr->inst = CreateArrayChildInst(INST(i),rhsinst,arginst);
654 /* will return rhsinst or the next array layer in case of alias */
655 /* will return new instance or the next array layer in case of IS_A */
656 AssertContainedMemory(ptr,sizeof(struct ArrayChild));
657 if (rhsinst==NULL || /* regular case, but what about UNIVERSAL? */
658 (rhsinst!=NULL && /* alii */
659 SearchForParent(ptr->inst,INST(i))==0)
660 ) {
661 AddParent(ptr->inst,INST(i));
662 }
663 gl_append_ptr(i->children,(VOIDPTR)ptr);
664 }
665 gl_sort(i->children,(CmpFunc)CmpIntIndex);
666 } else {
667 Asc_Panic(2, NULL,
668 "Attempt to expand alias array with incorrect set type.\n");
669 }
670 }
671
672 static
673 void ExpandStringSet(struct ArrayInstance *i, struct set_t *set,
674 struct Instance *rhsinst, struct Instance *arginst,
675 struct gl_list_t *rhslist)
676 {
677 register unsigned long c,len;
678 register struct ArrayChild *ptr, *rptr;
679 AssertMemory(i);
680 AssertMemory(set);
681 assert(rhslist==NULL||rhsinst==NULL); /* one type of alias or other */
682 if (i->t==ARRAY_ENUM_INST){
683 len = Cardinality(set);
684 i->children = gl_create(len);
685 AssertMemory(i->children);
686 for(c=1;c<=len;c++){
687 ptr = MALLOCPOOLAC;
688 ptr->name.str = FetchStrMember(set,c);
689 if (rhslist != NULL) {
690 rptr = FindRHSByString(rhslist,ptr->name.str);
691 assert(rptr != NULL);
692 rhsinst = rptr->inst;
693 assert(rhsinst != NULL);
694 }
695 ptr->inst = CreateArrayChildInst(INST(i),rhsinst,arginst);
696 AssertContainedMemory(ptr,sizeof(struct ArrayChild));
697 if (rhsinst==NULL || /* regular case */
698 (rhsinst!=NULL && /* alii */
699 SearchForParent(ptr->inst,INST(i))==0)
700 ) {
701 AddParent(ptr->inst,INST(i));
702 }
703 gl_append_ptr(i->children,(VOIDPTR)ptr);
704 }
705 gl_sort(i->children,(CmpFunc)CmpStrIndex);
706 } else {
707 Asc_Panic(2, NULL, "Attempt to expand array with incorrect set type.\n");
708 }
709 }
710
711 /*
712 * The recursion is over the already expanded intermediate
713 * array nodes until we reach one that is not yet expanded or
714 * we reach the terminal subscript of the subscripts written
715 * explicitly in the IS_A/ALIASES/ALIASES-IS_A.
716 *
717 * Does not recurse down into the subscripts of the alias
718 * rhs instance in the case where those subscripts are incomplete
719 * because the typedesc of the instance being expanded does
720 * not include those.
721 */
722 static
723 void RecursiveExpand(struct Instance *i, unsigned long int num,
724 struct set_t *set,struct Instance *rhsinst,
725 struct Instance *arginst, struct gl_list_t *rhslist)
726 {
727 AssertMemory(i);
728 AssertMemory(set);
729 if ((i->t!=ARRAY_INT_INST)&&(i->t!=ARRAY_ENUM_INST)){
730 Asc_Panic(2, NULL, "Incorrect array structure in RecursiveExpand.\n");
731 }
732 if ((--num)==0){ /* we're here -- start creating instances */
733 if (ARY_INST(i)->children==NULL){
734 switch(SetKind(set)){
735 case empty_set: ARY_INST(i)->children = gl_create(0); break;
736 case integer_set:
737 ExpandIntegerSet(ARY_INST(i),set,rhsinst,arginst,rhslist);
738 break;
739 case string_set:
740 ExpandStringSet(ARY_INST(i),set,rhsinst,arginst,rhslist);
741 break;
742 }
743 } else {
744 Asc_Panic(2, NULL, "Attempt to expand previously expanded array.\n");
745 }
746 } else { /* not there yet recurse on each child */
747 register unsigned long c,len;
748 register struct ArrayChild *child;
749 register struct ArrayInstance *ptr;
750 ptr = ARY_INST(i);
751 if (ptr->children==NULL){
752 Asc_Panic(2, NULL,
753 "Incorrect call to ExpandArray died in RecursiveExpand.\n");
754 }
755 AssertMemory(ptr->children);
756 len = gl_length(ptr->children);
757 for(c=1;c<=len;c++){
758 child = (struct ArrayChild *)gl_fetch(ptr->children,c);
759 AssertContainedMemory(child,sizeof(struct ArrayChild));
760 RecursiveExpand(child->inst,num,set,rhsinst,arginst,rhslist);
761 }
762 }
763 }
764
765 void ExpandArray(struct Instance *i, unsigned long int num,
766 struct set_t *set, struct Instance *rhsinst,
767 struct Instance *arginst, struct gl_list_t *rhslist)
768 {
769 if ((i->t==ARRAY_INT_INST)||(i->t==ARRAY_ENUM_INST)){
770 assert((num >= 1)&&(num <= NumberofDereferences(i)));
771 AssertMemory(i);
772 AssertMemory(set);
773 RecursiveExpand(i,num,set,rhsinst,arginst,rhslist);
774 } else {
775 Asc_Panic(2, NULL, "Incorrect instance type passed to ExpandArray.\n");
776 }
777 }
778
779
780 static
781 struct ArrayChild *MakeNextInst(struct Instance *ary, long int v,
782 symchar *sym, struct Instance *rhsinst,
783 struct Instance *arginst)
784 {
785 struct ArrayChild *ptr;
786 ptr = MALLOCPOOLAC;
787 ptr->inst = CreateArrayChildInst(ary,rhsinst,arginst);
788 if (rhsinst==NULL || /* regular case */
789 (rhsinst != NULL && /* alii */
790 SearchForParent(ptr->inst,INST(ary))==0)
791 ) {
792 AddParent(ptr->inst,INST(ary));
793 }
794 if(sym==NULL) {
795 ptr->name.index = v;
796 } else {
797 ptr->name.str = sym;
798 }
799 return ptr;
800 }
801
802 struct Instance *FindOrAddIntChild(struct Instance *i, long int v,
803 struct Instance *rhsinst,
804 struct Instance *arginst)
805 {
806 struct ArrayChild rec,*ptr;
807 unsigned long pos;
808 switch(i->t) {
809 case ARRAY_INT_INST:
810 if (ARY_INST(i)->children !=NULL){
811 rec.name.index = v;
812 rec.inst = NULL;
813 pos = gl_search(ARY_INST(i)->children,(char *)&rec,(CmpFunc)CmpIntIndex);
814 if (pos) {
815 ptr = (struct ArrayChild *)gl_fetch(ARY_INST(i)->children,pos);
816 return ptr->inst;
817 }
818 } else {
819 ARY_INST(i)->children = gl_create(AVG_ARY_CHILDREN);
820 }
821 ptr = MakeNextInst(i,v,NULL,rhsinst,arginst);
822 gl_insert_sorted(ARY_INST(i)->children,(char *)ptr,(CmpFunc)CmpIntIndex);
823 return ptr->inst;
824 case ARRAY_ENUM_INST:
825 return NULL;
826 default:
827 Asc_Panic(2, NULL, "Wrong type passed to ForOrAddIntChild.\n");
828 exit(2);/* Needed to keep gcc from whining */
829 }
830 }
831
832 struct Instance *FindOrAddStrChild(struct Instance *i, symchar *sym,
833 struct Instance *rhsinst,
834 struct Instance *arginst)
835 {
836 struct ArrayChild rec,*ptr;
837 unsigned long pos;
838 switch(i->t) {
839 case ARRAY_ENUM_INST:
840 if (ARY_INST(i)->children !=NULL){
841 rec.name.str = sym;
842 rec.inst = NULL;
843 pos = gl_search(ARY_INST(i)->children,(char *)&rec,(CmpFunc)CmpStrIndex);
844 if (pos){
845 ptr = (struct ArrayChild *)gl_fetch(ARY_INST(i)->children,pos);
846 return ptr->inst;
847 }
848 } else {
849 ARY_INST(i)->children = gl_create(AVG_ARY_CHILDREN);
850 }
851 ptr = MakeNextInst(i,0,sym,rhsinst,arginst);
852 gl_insert_sorted(ARY_INST(i)->children,ptr,(CmpFunc)CmpStrIndex);
853 return ptr->inst;
854 case ARRAY_INT_INST:
855 return NULL;
856 default:
857 Asc_Panic(2, NULL, "Wrong type passed to ForOrAddStrChild.\n");
858 exit(2);/* Needed to keep gcc from whining */
859 }
860 }
861
862 static
863 int RealCmpArrayInsts(struct ArrayInstance *, struct ArrayInstance *);
864
865 /* This is not exported because it is not a strict comparator.
866 * It's more or less a shallow type compatibility check only.
867 * It expects a little sanity.
868 */
869 static
870 int CmpArrayInstances(struct Instance *i1, struct Instance *i2)
871 {
872 if (i1==i2) {
873 return 0;
874 }
875 if (i1==NULL) {
876 return -1;
877 }
878 if (i2==NULL) {
879 return 1;
880 }
881 if (InstanceKind(INST(i1))!=InstanceKind(INST(i2))) {
882 return 1;
883 }
884 if (IsArrayInstance(i1)) {
885 return RealCmpArrayInsts(ARY_INST(i1),ARY_INST(i2));
886 }
887 if (IsConstantInstance(i1)) {
888 return CmpAtomValues(i1,i2);
889 }
890 if (InstanceKind(i1)==MODEL_INST || IsAtomicInstance(i1)) {
891 return ((InstanceTypeDesc(i1)!=InstanceTypeDesc(i2)) ? 1 : 0);
892 }
893 /* relations/whens/logrels have no decent comparisons */
894 return 0;
895 }
896 /* recursive part, ultimately depth first, top down. */
897 static
898 int RealCmpArrayInsts(struct ArrayInstance *a1, struct ArrayInstance *a2)
899 {
900 unsigned long c,len;
901 struct gl_list_t *cl1, *cl2;
902 register struct ArrayChild *ac1, *ac2;
903 int cmp;
904
905 if (a1==a2) {
906 return 0;
907 }
908 if (a1==NULL) {
909 return -1;
910 }
911 if (a2==NULL) {
912 return 1;
913 }
914 if (InstanceKind(INST(a1))!=InstanceKind(INST(a2))) {
915 return 1;
916 }
917 cl1 = a1->children;
918 cl2 = a2->children;
919 if (gl_length(cl1) != gl_length(cl2)) {
920 return ((gl_length(cl1) > gl_length(cl2)) ? -1 : 1);
921 }
922 len = gl_length(cl1);
923 if (a1->t == ARRAY_ENUM_INST) {
924 for (c=1; c <= len; c++) {
925 ac1 = CAC(gl_fetch(cl1,c));
926 ac2 = CAC(gl_fetch(cl2,c));
927 cmp = CmpStrIndex(ac1,ac2);
928 if (cmp != 0) {
929 return cmp;
930 }
931 cmp = CmpArrayInstances(ac1->inst, ac2->inst);
932 if (cmp != 0) {
933 return cmp;
934 }
935 }
936 } else {
937 for (c=1; c <= len; c++) {
938 ac1 = CAC(gl_fetch(cl1,c));
939 ac2 = CAC(gl_fetch(cl2,c));
940 cmp = CmpIntIndex(ac1,ac2);
941 if (cmp != 0) {
942 return cmp;
943 }
944 cmp = CmpArrayInstances(ac1->inst, ac2->inst);
945 if (cmp != 0) {
946 return cmp;
947 }
948 }
949 }
950 return 0;
951 }
952
953 int CmpArrayInsts(struct Instance *a1, struct Instance *a2)
954 {
955 if (a1==a2) {
956 return 0;
957 }
958 if (a1==NULL) {
959 return -1;
960 }
961 if (a2==NULL) {
962 return 1;
963 }
964 if (GetArrayBaseType(ARY_INST(a1)->desc) !=
965 GetArrayBaseType(ARY_INST(a2)->desc)) {
966 return 1;
967 }
968 return RealCmpArrayInsts(ARY_INST(a1),ARY_INST(a2));
969 }

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