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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 669 - (show annotations) (download) (as text)
Wed Jun 21 07:00:45 2006 UTC (14 years, 3 months ago) by johnpye
File MIME type: text/x-csrc
File size: 21949 byte(s)
Merged changes from DAE branch (revisions 702 to 819) back into trunk.
This adds the Integration API to the ASCEND solver (in base/generic).
Also provides pre-alpha support for 'IDA' from the SUNDIALS suite, a DAE solver.
Many other minor code clean-ups, including adoption of new 'ASC_NEW' and friends (to replace 'ascmalloc')
Added some very sketchy stuff providing 'DIFF(...)' syntax, although it is anticipated that this will be removed.
1 /* ex: set ts=8: */
2 /*
3 * Library Implementation
4 * by Tom Epperly
5 * Created: 1/15/89
6 * Version: $Revision: 1.28 $
7 * Version control file: $RCSfile: library.c,v $
8 * Date last modified: $Date: 1998/06/23 22:02:08 $
9 * Last modified by: $Author: ballan $
10 *
11 * This file is part of the Ascend Language Interpreter.
12 *
13 * Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
14 *
15 * The Ascend Language Interpreter is free software; you can redistribute
16 * it and/or modify it under the terms of the GNU General Public License as
17 * published by the Free Software Foundation; either version 2 of the
18 * License, or (at your option) any later version.
19 *
20 * The Ascend Language Interpreter is distributed in hope that it will be
21 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 * General Public License for more details.
24 *
25 * You should have received a copy of the GNU General Public License
26 * along with the program; if not, write to the Free Software Foundation,
27 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
28 * COPYING.
29 *
30 *
31 */
32
33 #include <utilities/ascConfig.h>
34 #include <utilities/ascMalloc.h>
35 #include "compiler.h"
36 #include "instance_enum.h"
37 #include "cmpfunc.h"
38 #include <general/list.h>
39 #include "compiler.h"
40 #include "symtab.h"
41 #include "notate.h"
42 #include "fractions.h"
43 #include "dimen.h"
44 #include "functype.h"
45 #include "expr_types.h"
46 #include "child.h"
47 #include "type_desc.h"
48 #include "type_descio.h"
49 #include "prototype.h"
50 #include "dump.h"
51 #include "typedef.h"
52 #include "module.h"
53 #include "library.h"
54
55 #ifndef lint
56 static CONST char LibraryRCSid[]="$Id: library.c,v 1.28 1998/06/23 22:02:08 ballan Exp $";
57 #endif
58
59 /*
60 * hashing on heap symbol pointer. SIZE must be 2^n (n even)
61 * and mask in LIBHASHINDEX must be 2^n - 1.
62 */
63 #define LIBRARYHASHSIZE (unsigned long)1024
64 /*
65 * hash function multiply, shift by 30 - n, and mask to SIZE.
66 */
67 #define LIBHASHINDEX(p) (((((long) (p))*1103515245) >> 20) & 1023)
68
69 /* these make an important optimization possible.
70 * The relation and when types must still be in the library,
71 * but heavy use clients can get the same pointers by
72 * FindRelationType and FindWhenType.
73 * AddType is responsible for maintaining these.
74 * These pointers should never change values except
75 * if the library is destroyed.
76 */
77 static struct TypeDescription *g_relation_type = NULL;
78 static struct TypeDescription *g_logrel_type = NULL;
79 static struct TypeDescription *g_dummy_type = NULL;
80 static struct TypeDescription *g_when_type = NULL;
81 static struct TypeDescription *g_set_type = NULL;
82 static struct TypeDescription *g_externalmodel_type = NULL;
83
84 /*
85 * array of symbol table entries we need.
86 */
87 static symchar *g_symbols[14];
88 #define G__SYMBOL_NAME g_symbols[0]
89 #define G__REAL_NAME g_symbols[1]
90 #define G__INTEGER_NAME g_symbols[2]
91 #define G__BOOLEAN_NAME g_symbols[3]
92 #define G__CON_SYMBOL_NAME g_symbols[4]
93 #define G__CON_REAL_NAME g_symbols[5]
94 #define G__CON_INTEGER_NAME g_symbols[6]
95 #define G__CON_BOOLEAN_NAME g_symbols[7]
96 #define G__SET_NAME g_symbols[8]
97 #define G__WHEN_NAME g_symbols[9]
98 #define G__REL_NAME g_symbols[10]
99 #define G__LOGREL_NAME g_symbols[11]
100 #define G__UNSELECTED g_symbols[12]
101 #define G__EXT_NAME g_symbols[13]
102
103 struct LibraryStructure {
104 struct LibraryStructure *next;
105 struct TypeDescription *type;
106 unsigned long open_count;
107 };
108
109 struct LibraryStructure *LibraryHashTable[LIBRARYHASHSIZE];
110
111 void InitializeLibrary(void)
112 {
113 unsigned c;
114 /* init hash */
115 for(c=0;c<LIBRARYHASHSIZE;LibraryHashTable[c++]=NULL); /* no body */
116 /* init reused symbols */
117 G__SYMBOL_NAME = GetBaseTypeName(symbol_type);
118 G__REAL_NAME = GetBaseTypeName(real_type);
119 G__INTEGER_NAME = GetBaseTypeName(integer_type);
120 G__BOOLEAN_NAME = GetBaseTypeName(boolean_type);
121 G__CON_SYMBOL_NAME = GetBaseTypeName(symbol_constant_type);
122 G__CON_REAL_NAME = GetBaseTypeName(real_constant_type);
123 G__CON_INTEGER_NAME = GetBaseTypeName(integer_constant_type);
124 G__CON_BOOLEAN_NAME = GetBaseTypeName(boolean_constant_type);
125 G__SET_NAME = GetBaseTypeName(set_type);
126 G__WHEN_NAME = GetBaseTypeName(when_type);
127 G__REL_NAME = GetBaseTypeName(relation_type);
128 G__LOGREL_NAME = GetBaseTypeName(logrel_type);
129 G__UNSELECTED = GetBaseTypeName(dummy_type);
130 /* odd cases */
131 G__EXT_NAME = GetBaseTypeName(model_type & patch_type);
132 }
133
134 struct TypeDescription *FindRelationType(void)
135 {
136 if (g_relation_type==NULL) {
137 FPRINTF(ASCERR,
138 "FindRelationType called before RELATION_DEFINITION set.\n");
139 FPRINTF(ASCERR,"You need a system.a4l or equivalent loaded.\n");
140 }
141 return g_relation_type;
142 }
143
144 struct TypeDescription *FindLogRelType(void)
145 {
146 /* probably should be an assert instead of this if */
147 if (g_logrel_type==NULL) {
148 FPRINTF(ASCERR,"FindLogRelType called before logrel defined.\n");
149 FPRINTF(ASCERR,"You need a system.a4l or equivalent loaded.\n");
150 }
151 return g_logrel_type;
152 }
153
154 struct TypeDescription *FindSetType(void)
155 {
156 /* probably should be an assert instead of this if */
157 if (g_set_type==NULL) {
158 FPRINTF(ASCERR,"FindSetType called before set defined.\n");
159 FPRINTF(ASCERR,"This is extremely odd!.\n");
160 }
161 return g_set_type;
162 }
163
164 struct TypeDescription *FindWhenType(void)
165 {
166 /* probably should be an assert instead of this if */
167 if (g_when_type==NULL) {
168 FPRINTF(ASCERR,"FindWhenType called before when defined.\n");
169 FPRINTF(ASCERR,"This is extremely odd!.\n");
170 }
171 return g_when_type;
172 }
173
174 struct TypeDescription *FindDummyType(void)
175 {
176 /* probably should be an assert instead of this if */
177 if (g_dummy_type==NULL) {
178 FPRINTF(ASCERR,"FinddummyType called before when defined.\n");
179 FPRINTF(ASCERR,"This is extremely odd!.\n");
180 }
181 return g_dummy_type;
182 }
183
184 struct TypeDescription *FindExternalType(void)
185 {
186 /* probably should be an assert instead of this if */
187 if (g_externalmodel_type==NULL) {
188 FPRINTF(ASCERR,"FindExternalType called before external defined.\n");
189 FPRINTF(ASCERR,"This is extremely odd!.\n");
190 }
191 return g_externalmodel_type;
192 }
193
194 struct TypeDescription *FindType(symchar *name)
195 {
196 struct LibraryStructure *ptr;
197
198 if (name==NULL) return NULL;
199 assert(AscFindSymbol(name) != NULL);
200 ptr = LibraryHashTable[LIBHASHINDEX(SCP(name))];
201 /*if(ptr==NULL){
202 CONSOLE_DEBUG("Found no values in the LibraryHashTable");
203 }*/
204 while (ptr!=NULL){
205 /* CONSOLE_DEBUG("Found a type '%s'...",SCP(GetName(ptr->type)) ); */
206 if (name == GetName(ptr->type)) { /* pointers == on table symbols */
207 assert((ptr->type->t & ERROR_KIND)==0);
208 return ptr->type;
209 }
210 ptr = ptr->next;
211 }
212 /* CONSOLE_DEBUG("Failed to locate '%s'", name); */
213 return NULL;
214 }
215
216 void DestroyLibrary(void)
217 {
218 register unsigned c;
219 register struct LibraryStructure *ptr,*next;
220 for(c=0;c<LIBRARYHASHSIZE;c++) {
221 if(LibraryHashTable[c]!=NULL){
222 ptr = LibraryHashTable[c];
223 while(ptr!=NULL){
224 DeleteTypeDesc(ptr->type);
225 next = ptr->next;
226 ascfree((char *)ptr);
227 ptr = next;
228 }
229 LibraryHashTable[c]=NULL;
230 }
231 }
232 DestroyTypedefRecycle();
233 g_externalmodel_type = NULL;
234 g_relation_type = NULL;
235 g_logrel_type = NULL;
236 g_dummy_type = NULL;
237 g_when_type = NULL;
238 g_set_type = NULL;
239 }
240
241
242 struct gl_list_t *FindFundamentalTypes(void)
243 {
244 register unsigned c;
245 register struct LibraryStructure *ptr,*next;
246 struct TypeDescription *d;
247 struct gl_list_t *fundies;
248
249 fundies = gl_create(40L);
250
251 for(c=0;c<LIBRARYHASHSIZE;c++) {
252 if(LibraryHashTable[c]!=NULL){
253 ptr = LibraryHashTable[c];
254 while(ptr!=NULL){
255 d = ptr->type;
256 if (GetModule(d)==NULL) {
257 gl_append_ptr(fundies,(VOIDPTR)d);
258 }
259 next = ptr->next;
260 ptr = next;
261 }
262 }
263 }
264 return fundies;
265 }
266
267 static int CmpDescNames(struct TypeDescription *desc1,
268 struct TypeDescription *desc2)
269 {
270 assert(desc1&&desc2);
271 return CmpSymchar(GetName(desc1),GetName(desc2));
272 }
273
274 static int CmpDescModNames(struct TypeDescription *desc1,
275 struct TypeDescription *desc2)
276 {
277 assert(desc1&&desc2);
278 return strcmp(Asc_ModuleName(GetModule(desc1)),
279 Asc_ModuleName(GetModule(desc2)));
280 }
281
282 static int CmpDescModPtrs(struct TypeDescription *desc1,
283 struct TypeDescription *desc2)
284 {
285 assert(desc1&&desc2);
286 return Asc_ModulesEqual(GetModule(desc1),GetModule(desc2));
287 }
288
289 static void ReplaceType(struct TypeDescription *desc,
290 struct LibraryStructure *ptr)
291 {
292 DeletePrototype(GetName(desc));
293 TrashType(GetName(desc));
294 DestroyNotesOnType(LibraryNote(),GetName(desc));
295 DeleteTypeDesc(ptr->type);
296 ptr->type = desc;
297 }
298
299 static
300 struct TypeDescription *EquivalentExists(struct TypeDescription *desc)
301 {
302 struct TypeDescription *old;
303 if (desc == NULL) {
304 return NULL;
305 }
306 old=FindType(GetName(desc));
307 if (old == NULL) {
308 return NULL;
309 }
310 if (TypesAreEquivalent(old,desc)) {
311 return old;
312 }
313 /* FPRINTF(ASCERR,"TYPE FOUND FOR %s BUT NOT EQUIV\n",GetName(desc)); */
314 return NULL;
315 }
316
317 int AddType(struct TypeDescription *desc)
318 {
319 unsigned long bucket;
320 struct TypeDescription *equiv;
321 struct LibraryStructure *ptr;
322
323 /* FPRINTF(ASCERR,"ADD TYPE '%s'...\n",GetName(desc)); */
324 assert(desc!=NULL);
325
326 equiv = EquivalentExists(desc);
327 if (equiv != NULL) {
328 CONSOLE_DEBUG("Keeping equivalent %s loaded from %s."
329 ,SCP(GetName(desc)),Asc_ModuleName(GetModule(equiv))
330 );
331 DeleteNewTypeDesc(desc);
332 return 0;
333 }
334
335 if (GetName(desc) == G__REL_NAME) {
336 g_relation_type = desc;
337 /* and we will assume this pointer will replace any current relationdef */
338 /* in the one case where it does not replace, we will have to reset it */
339 }
340 if (GetName(desc) == G__LOGREL_NAME) {
341 g_logrel_type = desc;
342 /* and we will assume this pointer will replace any current relationdef */
343 /* in the one case where it does not replace, we will have to reset it */
344 }
345 /* the following system types don't have a module associated.
346 * If there's a module, it can't be one of these that is being defined.
347 */
348 if (GetModule(desc) == NULL) {
349 if (GetName(desc) == G__WHEN_NAME) {
350 g_when_type = desc;
351 /* and we will assume this pointer will replace any current whendef */
352 /* in the one case where it does not replace, we will have to reset it */
353 }
354 if (GetName(desc) == G__UNSELECTED) {
355 g_dummy_type = desc;
356 /* and we will assume this pointer will replace any current whendef */
357 /* in the one case where it does not replace, we will have to reset it */
358 }
359 if (GetName(desc) == G__SET_NAME) {
360 g_set_type = desc;
361 /* and we will assume this pointer will replace any current set def */
362 /* in the one case where it does not replace, we will have to reset it */
363 }
364 if (GetName(desc) == G__EXT_NAME) {
365 g_externalmodel_type = desc;
366 /* and we will assume this pointer will replace any current extdef */
367 /* in the one case where it does not replace, we will have to reset it */
368 }
369 }
370 bucket = LIBHASHINDEX(SCP(GetName(desc)));
371 ptr = LibraryHashTable[bucket];
372 /* search for name collisions */
373 while (ptr) {
374
375 if (desc == ptr->type) {
376 /* FPRINTF(ASCERR,"...KEEPING OLD TYPE\n"); */
377 return 0;
378 }
379
380 if (GetName(desc) == GetName(ptr->type)) {
381 if (CmpDescModPtrs(desc,ptr->type)) {
382 if (Asc_ModuleTimesOpened(GetModule(desc)) <= ptr->open_count) {
383 FPRINTF(ASCERR,"Multiple definitions of type %s in module %s.\n",
384 SCP(GetName(desc)),Asc_ModuleName(GetModule(desc)));
385 FPRINTF(ASCERR," Overwriting previous definition.\n");
386 } else {
387 if (GetRefinement(desc) == GetRefinement(ptr->type)) {
388 /* here's the one cases */
389 if (GetName(desc) == G__REL_NAME) {
390 g_relation_type = ptr->type;
391 }
392 if (GetName(desc) == G__LOGREL_NAME) {
393 g_logrel_type = ptr->type;
394 }
395 if (GetModule(desc)==NULL) {
396 if (GetName(desc) == G__WHEN_NAME) {
397 g_when_type = ptr->type;
398 }
399 if (GetName(desc) == G__UNSELECTED) {
400 g_dummy_type = ptr->type;
401 }
402 if (GetName(desc) == G__SET_NAME) {
403 g_set_type = ptr->type;
404 }
405 if (GetName(desc) == G__EXT_NAME) {
406 g_externalmodel_type = ptr->type;
407 }
408 }
409 /* keep the old copy. */
410 DeleteNewTypeDesc(desc);
411 FPRINTF(ASCERR,"KEEPING OLD TYPE (DELETING)\n");
412 return 0;
413 } else {
414 ReplaceType(desc,ptr);
415 /* the thing this type refines has been modified so the */
416 /* library needs this new type definition */
417 }
418 FPRINTF(ASCERR,"ADDED (REPLACETYPE)\n");
419 return 1;
420 }
421 } else {
422 if ( CmpDescModNames(desc,ptr->type) != 0 ) {
423 FPRINTF(ASCERR,"Type definition of %s in module %s conflicts\n",
424 SCP(GetName(desc)), Asc_ModuleName(GetModule(desc)) );
425 FPRINTF(ASCERR,"with definition in module %s.\n",
426 Asc_ModuleName(GetModule(ptr->type)) );
427 FPRINTF(ASCERR," Overwriting previous definition.\n");
428 } else {
429 FPRINTF(ASCERR,"Updating %s.\n",SCP(GetName(ptr->type)));
430 }
431 }
432 ReplaceType(desc,ptr);
433 FPRINTF(ASCERR,"ADDING TYPE (REPLACETYPE 2)\n");
434 return 1;
435 }
436
437 ptr = ptr->next;
438 }
439
440 /* add new type to the head of the list */
441 ptr = (struct LibraryStructure *)ascmalloc(sizeof(struct LibraryStructure));
442 ptr->next = LibraryHashTable[bucket];
443 ptr->type = desc;
444 ptr->open_count = Asc_ModuleTimesOpened(GetModule(desc));
445 LibraryHashTable[bucket] = ptr;
446 /* FPRINTF(ASCERR,"ADDED TYPE '%s'\n",GetName(desc)); */
447 if(FindType(GetName(desc))==NULL){
448 FPRINTF(ASCERR,"UNABLE TO FIND TYPE '%s'\n",GetName(desc));
449 }else{
450 /* FPRINTF(ASCERR,"TYPE '%s' FOUND OK\n",GetName(desc)); */
451 }
452
453 return 1;
454 }
455
456 struct gl_list_t *DefinitionList(void)
457 {
458 struct gl_list_t *result;
459 register unsigned c;
460 register struct LibraryStructure *ptr;
461 result = gl_create(200L);
462 for(c=0;c<LIBRARYHASHSIZE;c++){
463 ptr = LibraryHashTable[c];
464 while(ptr){
465 if (GetBaseType(ptr->type)!=array_type)
466 gl_append_ptr(result,(VOIDPTR)ptr->type);
467 ptr = ptr->next;
468 }
469 }
470 gl_sort(result,(CmpFunc)CmpDescNames);
471 return result;
472 }
473
474 /*
475 * The following is so as not to export the library
476 * hashfunctions internals.
477 */
478 unsigned int CheckFundamental(symchar *f)
479 {
480 if (
481 (f==G__INTEGER_NAME) ||
482 (f==G__REAL_NAME) ||
483 (f==G__SYMBOL_NAME) ||
484 (f==G__BOOLEAN_NAME) ||
485 (f==G__SET_NAME) ||
486 (f==G__CON_BOOLEAN_NAME) ||
487 (f==G__CON_INTEGER_NAME) ||
488 (f==G__CON_REAL_NAME) ||
489 (f==G__CON_SYMBOL_NAME)
490 ) {
491 return 1;
492 } else {
493 return 0;
494 }
495 }
496
497
498 struct gl_list_t *Asc_TypeByModule(CONST struct module_t *m)
499 {
500 struct gl_list_t *result;
501 register unsigned c;
502 register struct LibraryStructure *ptr;
503 CONST struct module_t *modptr;
504
505 assert(m != NULL);
506 result = gl_create(20L);
507 for( c = 0; c < LIBRARYHASHSIZE; c++ ) {
508 ptr = LibraryHashTable[c];
509 while( ptr ) {
510 modptr = GetModule(ptr->type);
511 if (modptr != NULL) {
512 if((GetBaseType(ptr->type) != array_type) && (modptr == m)) {
513 gl_append_ptr(result,(VOIDPTR)ptr->type->name);
514 }
515 }
516 ptr = ptr->next;
517 }
518 }
519 return result;
520 }
521
522 /* sometimes there is too much confusion about parents and children !! */
523
524 struct gl_list_t *TypesThatRefineMe(symchar *name)
525 {
526 struct gl_list_t *result;
527 register unsigned c;
528 register struct LibraryStructure *ptr;
529 CONST struct TypeDescription *refdesc;
530 symchar *refname;
531
532 /*
533 * Actually, this is fairly efficient for atoms and base types,
534 * but for models it is inefficient.
535 */
536 assert(name!=NULL && AscFindSymbol(name) != NULL);
537 result = gl_create(40L);
538 for(c=0;c<LIBRARYHASHSIZE;c++){
539 ptr = LibraryHashTable[c];
540 while(ptr){
541 refdesc = GetRefinement(ptr->type);
542 if (refdesc != NULL) {
543 refname = GetName(refdesc);
544 if ( (GetBaseType(ptr->type) != array_type) &&
545 (refname == name)) {
546 gl_append_ptr(result,(VOIDPTR)ptr->type->name);
547 }
548 }
549 ptr = ptr->next;
550 }
551 }
552 return result;
553 }
554
555 /*
556 * returns a flat list of typenames that refine the type given
557 */
558 struct gl_list_t *AllTypesThatRefineMe_Flat(symchar *name)
559 {
560 struct gl_list_t *result;
561 register unsigned c;
562 register struct LibraryStructure *ptr;
563 struct TypeDescription *refdesc,*desc;
564 symchar *refname;
565
566 assert(name!=NULL && AscFindSymbol(name) != NULL);
567 desc=FindType(name);
568 if (!desc) { /* nobody home by that name */
569 result=gl_create(1L);
570 return result;
571 }
572 if (GetBaseType(desc)==model_type) {
573 result=gl_create(10L); /* probably only needs extension on components */
574 } else {
575 result=gl_create(200L); /* lots of atoms, usually */
576 }
577 for(c=0;c<LIBRARYHASHSIZE;c++){
578 ptr = LibraryHashTable[c];
579 while(ptr){
580 refdesc=ptr->type;
581 if (refdesc) {
582 if (MoreRefined(desc,refdesc)==refdesc && desc!=refdesc) {
583 refname = GetName(refdesc);
584 if ( GetBaseType(refdesc)!=array_type ) {
585 gl_append_ptr(result,(VOIDPTR)ptr->type->name);
586 }
587 }
588 }
589 ptr = ptr->next;
590 }
591 }
592 return result;
593 }
594
595 static
596 struct gl_list_t *AllTypesThatRefineMe_FlatType(struct TypeDescription *desc)
597 {
598 struct gl_list_t *result;
599 register unsigned c;
600 register struct LibraryStructure *ptr;
601 struct TypeDescription *refdesc;
602
603 if (!desc) { /* nobody home by that name */
604 result=gl_create(1L);
605 return result;
606 }
607 if (GetBaseType(desc)==model_type)
608 result=gl_create(10L); /* probably only needs extension on components */
609 else
610 result=gl_create(200L); /* lots of atoms, usually */
611 for(c=0;c<LIBRARYHASHSIZE;c++){
612 ptr = LibraryHashTable[c];
613 while(ptr){
614 refdesc=ptr->type;
615 if (refdesc) {
616 if (MoreRefined(desc,refdesc)==refdesc &&
617 desc!=refdesc) {
618 if ( GetBaseType(refdesc)!=array_type )
619 gl_append_ptr(result,(VOIDPTR)refdesc);
620 }
621 }
622 ptr = ptr->next;
623 }
624 }
625 return result;
626 }
627
628 /*
629 * fl is the list of children of not yet established heredity.
630 * hd is a HierarchyNode with desc and descendents list set, though
631 * the descendents list may be incomplete. fl will shrink if the head
632 * given has any direct descendents.
633 * This is horrendously inefficient for doing long (>20) lists.
634 * Breadth first searching.
635 */
636 static void EstablishPaternity(struct HierarchyNode *hd, struct gl_list_t *fl)
637 {
638 struct TypeDescription *desc=NULL;
639 unsigned long c,size,end;
640 struct HierarchyNode head, *child;
641 head=(*hd);
642 for (c=1; c <=gl_length(fl);) {
643 desc=(struct TypeDescription *)gl_fetch(fl,c);
644 if (GetRefinement(desc)==head.desc) {
645 /* squirrel away direct descendents and delete from fl. */
646 child=(struct HierarchyNode *)ascmalloc(sizeof(struct HierarchyNode));
647 child->desc=desc;
648 gl_append_ptr(head.descendents,(VOIDPTR)child);
649 gl_delete(fl,c,0); /* here's the horrendous bit */
650 } else {
651 /* indirect descendents pass over */
652 c++;
653 }
654 }
655 /* make lists for the found children */
656 size=head.descendents->capacity;
657 end=gl_length(head.descendents);
658 for ( c=1; c<=end; c++) {
659 child=(struct HierarchyNode *)gl_fetch(head.descendents,c);
660 child->descendents=gl_create(size);
661 if (gl_length(fl) >0) {
662 EstablishPaternity(child,fl);
663 } else {
664 size=2; /* everyone gets a list, even if fl empty. */
665 }
666 }
667 }
668
669 /*
670 * returns a HierarchyNode tree of types that refine the type given
671 */
672 struct HierarchyNode *AllTypesThatRefineMe_Tree(symchar *name)
673 {
674 struct gl_list_t *flatlist;
675 register unsigned c,end;
676 struct TypeDescription *refdesc,*desc;
677 struct HierarchyNode *head;
678
679 assert(name!=NULL && AscFindSymbol(name) != NULL);
680 desc = FindType(name);
681 if (!desc) return NULL; /* nobody home by that name */
682 head = (struct HierarchyNode *)ascmalloc(sizeof(struct HierarchyNode));
683 head->desc=desc;
684 if (GetBaseType(desc)==model_type) {
685 head->descendents=gl_create(10L);
686 /* probably only needs extension on components */
687 } else {
688 head->descendents=gl_create(200L);
689 /* lots of atoms, usually */
690 }
691 flatlist=AllTypesThatRefineMe_FlatType(desc);
692 EstablishPaternity(head,flatlist);
693 if ((end=gl_length(flatlist))>0) {
694 FPRINTF(ASCERR,"The following types in the current library\n");
695 FPRINTF(ASCERR,"refine old types refining %s\n",SCP(name));
696 FPRINTF(ASCERR,"that are no longer current. Use of these types.\n");
697 FPRINTF(ASCERR,"Current type (refines): replaced type:\n");
698 for (c=1;c<=end; c++) {
699 desc=(struct TypeDescription *)gl_fetch(flatlist,c);
700 if (desc!=NULL) {
701 FPRINTF(ASCERR,"%-30s",SCP(GetName(desc)));
702 if ((refdesc=GetRefinement(desc))!=NULL) {
703 FPRINTF(ASCERR,"%s\n",SCP(GetName(refdesc)));
704 } else {
705 FPRINTF(ASCERR,"%s\n","null_type_description!!");
706 }
707 }
708 }
709 }
710 gl_destroy(flatlist);
711 return head;
712 }
713
714 void DestroyHierarchyNode(struct HierarchyNode *head)
715 {
716 if (head) {
717 head->desc=NULL;
718 if (head->descendents) {
719 gl_iterate(head->descendents,(void (*)(VOIDPTR))DestroyHierarchyNode);
720 gl_destroy(head->descendents);
721 }
722 ascfree(head);
723 }
724 }
725
726 int IsTypeRefined(CONST struct TypeDescription *desc)
727 {
728 register unsigned c;
729 register struct LibraryStructure *ptr;
730 CONST struct TypeDescription *refdesc;
731
732 for(c=0;c<LIBRARYHASHSIZE;c++){
733 ptr = LibraryHashTable[c];
734 while(ptr){
735 refdesc= GetRefinement(ptr->type);
736 if (refdesc != NULL) {
737 if ((GetBaseType(ptr->type)!=array_type) &&
738 (desc==refdesc))
739 return 1;
740 }
741 ptr = ptr->next;
742 }
743 }
744 return 0; /* if here the type is not refined */
745 }
746

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