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

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