2 /* --------------------------------------------------------------------------
3 * GHC interface file processing for Hugs
5 * Copyright (c) The University of Nottingham and Yale University, 1994-1997.
6 * All rights reserved. See NOTICE for details and conditions of use etc...
7 * Hugs version 1.4, December 1997
9 * $RCSfile: interface.c,v $
11 * $Date: 2000/01/07 15:31:12 $
12 * ------------------------------------------------------------------------*/
20 #include "Assembler.h" /* for wrapping GHC objects */
27 extern void print ( Cell, Int );
29 /* --------------------------------------------------------------------------
30 * (This comment is now out of date. JRS, 991216).
31 * The "addGHC*" functions act as "impedence matchers" between GHC
32 * interface files and Hugs. Their main job is to convert abstract
33 * syntax trees into Hugs' internal representations.
35 * The main trick here is how we deal with mutually recursive interface
38 * o As we read an import decl, we add it to a list of required imports
39 * (unless it's already loaded, of course).
41 * o Processing of declarations is split into two phases:
43 * 1) While reading the interface files, we construct all the Names,
44 * Tycons, etc declared in the interface file but we don't try to
45 * resolve references to any entities the declaration mentions.
47 * This is done by the "addGHC*" functions.
49 * 2) After reading all the interface files, we finish processing the
50 * declarations by resolving any references in the declarations
51 * and doing any other processing that may be required.
53 * This is done by the "finishGHC*" functions which use the
54 * "fixup*" functions to assist them.
56 * The interface between these two phases are the "ghc*Decls" which
57 * contain lists of decls that haven't been completed yet.
59 * ------------------------------------------------------------------------*/
63 New comment, 991216, explaining roughly how it all works.
64 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
66 Interfaces can contain references to unboxed types, and these need to
67 be handled carefully. The following is a summary of how the interface
68 loader now works. It is applied to groups of interfaces simultaneously,
69 viz, the entire Prelude at once:
71 0. Parse interfaces, chasing imports until a complete
72 strongly-connected-component of ifaces has been parsed.
73 All interfaces in this scc are processed together, in
76 1. Throw away any entity not mentioned in the export lists.
78 2. Delete type (not data or newtype) definitions which refer to
79 unknown types in their right hand sides. Because Hugs doesn't
80 know of any unboxed types, this has the side effect of removing
81 all type defns referring to unboxed types. Repeat step 2 until
82 a fixed point is reached.
84 3. Make abstract all data/newtype defns which refer to an unknown
85 type. eg, data Word = MkW Word# becomes data Word, because
86 Word# is unknown. Hugs is happy to know about abstract boxed
87 Words, but not about Word#s.
89 4. Step 2 could delete types referred to by values, instances and
90 classes. So filter all entities, and delete those referring to
91 unknown types _or_ classes. This could cause other entities
92 to become invalid, so iterate step 4 to a fixed point.
94 After step 4, the interfaces no longer contain anything
97 5. Steps 1-4 operate purely on the iface syntax trees. We now start
98 creating symbol table entries. First, create a module table
99 entry for each interface, and locate and read in the corresponding
100 object file. This is done by the startGHCModule function.
102 6. Traverse all interfaces. For each entity, create an entry in
103 the name, tycon, class or instance table, and fill in relevant
104 fields, but do not attempt to link tycon/class/instance/name uses
105 to their symbol table entries. This is done by the startGHC*
108 7. Revisit all symbol table entries created in step 6. We should
109 now be able to replace all references to tycons/classes/instances/
110 names with the relevant symbol table entries. This is done by
111 the finishGHC* functions.
113 8. Traverse all interfaces. For each iface, examine the export lists
114 and use it to build export lists in the module table. Do the
115 implicit 'import Prelude' thing if necessary. Finally, resolve
116 references in the object code for this module. This is done
117 by the finishGHCModule function.
120 /* --------------------------------------------------------------------------
121 * local function prototypes:
122 * ------------------------------------------------------------------------*/
124 static Void startGHCValue Args((Int,VarId,Type));
125 static Void finishGHCValue Args((VarId));
127 static Void startGHCSynonym Args((Int,Cell,List,Type));
128 static Void finishGHCSynonym Args((Tycon));
130 static Void startGHCClass Args((Int,List,Cell,List,List));
131 static Void finishGHCClass Args((Class));
133 static Inst startGHCInstance Args((Int,List,Pair,VarId));
134 static Void finishGHCInstance Args((Inst));
136 static Void startGHCImports Args((ConId,List));
137 static Void finishGHCImports Args((ConId,List));
139 static Void startGHCExports Args((ConId,List));
140 static Void finishGHCExports Args((ConId,List));
142 static Void finishGHCModule Args((Cell));
143 static Void startGHCModule Args((Text, Int, Text));
145 static Void startGHCDataDecl Args((Int,List,Cell,List,List));
146 static Void finishGHCDataDecl ( ConId tyc );
148 static Void startGHCNewType Args((Int,List,Cell,List,Cell));
149 static Void finishGHCNewType ( ConId tyc );
152 /* Supporting stuff for {start|finish}GHCDataDecl */
153 static List startGHCConstrs Args((Int,List,List));
154 static Name startGHCSel Args((Int,Pair));
155 static Name startGHCConstr Args((Int,Int,Triple));
159 static Kinds tvsToKind Args((List));
160 static Int arityFromType Args((Type));
161 static Int arityInclDictParams Args((Type));
162 static Bool allTypesKnown ( Type type, List aktys /* [QualId] */, ConId thisMod );
164 static List ifTyvarsIn Args((Type));
166 static Type tvsToOffsets Args((Int,Type,List));
167 static Type conidcellsToTycons Args((Int,Type));
169 static void* lookupObjName ( char* );
175 /* --------------------------------------------------------------------------
176 * Top-level interface processing
177 * ------------------------------------------------------------------------*/
179 /* getIEntityName :: I_IMPORT..I_VALUE -> ConVarId | NIL */
180 ConVarId getIEntityName ( Cell c )
183 case I_IMPORT: return NIL;
184 case I_INSTIMPORT: return NIL;
185 case I_EXPORT: return NIL;
186 case I_FIXDECL: return zthd3(unap(I_FIXDECL,c));
187 case I_INSTANCE: return NIL;
188 case I_TYPE: return zsel24(unap(I_TYPE,c));
189 case I_DATA: return zsel35(unap(I_DATA,c));
190 case I_NEWTYPE: return zsel35(unap(I_NEWTYPE,c));
191 case I_CLASS: return zsel35(unap(I_CLASS,c));
192 case I_VALUE: return zsnd3(unap(I_VALUE,c));
193 default: internal("getIEntityName");
198 /* Filter the contents of an interface, using the supplied predicate.
199 For flexibility, the predicate is passed as a second arg the value
200 extraArgs. This is a hack to get round the lack of partial applications
201 in C. Pred should not have any side effects. The dumpaction param
202 gives us the chance to print a message or some such for dumped items.
203 When a named entity is deleted, filterInterface also deletes the name
206 Cell filterInterface ( Cell root,
207 Bool (*pred)(Cell,Cell),
209 Void (*dumpAction)(Cell) )
212 Cell iface = unap(I_INTERFACE,root);
214 List deleted_ids = NIL; /* :: [ConVarId] */
216 for (tops = zsnd(iface); nonNull(tops); tops=tl(tops)) {
217 if (pred(hd(tops),extraArgs)) {
218 tops2 = cons( hd(tops), tops2 );
220 ConVarId deleted_id = getIEntityName ( hd(tops) );
221 if (nonNull(deleted_id))
222 deleted_ids = cons ( deleted_id, deleted_ids );
224 dumpAction ( hd(tops) );
227 tops2 = reverse(tops2);
229 /* Clean up the export list now. */
230 for (tops=tops2; nonNull(tops); tops=tl(tops)) {
231 if (whatIs(hd(tops))==I_EXPORT) {
232 Cell exdecl = unap(I_EXPORT,hd(tops));
233 List exlist = zsnd(exdecl);
235 for (; nonNull(exlist); exlist=tl(exlist)) {
236 Cell ex = hd(exlist);
237 ConVarId exid = isZPair(ex) ? zfst(ex) : ex;
238 assert (isCon(exid) || isVar(exid));
239 if (!varIsMember(textOf(exid),deleted_ids))
240 exlist2 = cons(ex, exlist2);
242 hd(tops) = ap(I_EXPORT,zpair(zfst(exdecl),exlist2));
246 return ap(I_INTERFACE, zpair(zfst(iface),tops2));
250 ZPair readInterface(String fname, Long fileSize)
254 ZPair iface = parseInterface(fname,fileSize);
255 assert (whatIs(iface)==I_INTERFACE);
257 for (tops = zsnd(unap(I_INTERFACE,iface)); nonNull(tops); tops=tl(tops))
258 if (whatIs(hd(tops)) == I_IMPORT) {
259 ZPair imp_decl = unap(I_IMPORT,hd(tops));
260 ConId m_to_imp = zfst(imp_decl);
261 if (textOf(m_to_imp) != findText("PrelGHC")) {
262 imports = cons(m_to_imp,imports);
263 /* fprintf(stderr, "add iface %s\n", textToStr(textOf(m_to_imp))); */
266 return zpair(iface,imports);
270 /* getExportDeclsInIFace :: I_INTERFACE -> [I_EXPORT] */
271 static List getExportDeclsInIFace ( Cell root )
273 Cell iface = unap(I_INTERFACE,root);
274 List decls = zsnd(iface);
277 for (ds=decls; nonNull(ds); ds=tl(ds))
278 if (whatIs(hd(ds))==I_EXPORT)
279 exports = cons(hd(ds), exports);
285 static Bool isExportedIFaceEntity ( Cell ife, List exlist_list )
287 /* ife :: I_IMPORT..I_VALUE */
288 /* exlist_list :: [[ ConVarId | ((ConId, [ConVarId])) ]] */
293 ConVarId ife_id = getIEntityName ( ife );
295 if (isNull(ife_id)) return TRUE;
297 tnm = textOf(ife_id);
299 /* for each export list ... */
300 for (; nonNull(exlist_list); exlist_list=tl(exlist_list)) {
301 exlist = hd(exlist_list);
303 /* for each entity in an export list ... */
304 for (t=exlist; nonNull(t); t=tl(t)) {
305 if (isZPair(hd(t))) {
306 /* A pair, which means an export entry
307 of the form ClassName(foo,bar). */
308 List subents = cons(zfst(hd(t)),zsnd(hd(t)));
309 for (; nonNull(subents); subents=tl(subents))
310 if (textOf(hd(subents)) == tnm) goto retain;
312 /* Single name in the list. */
313 if (textOf(hd(t)) == tnm) goto retain;
318 fprintf ( stderr, " dump %s\n", textToStr(tnm) );
322 fprintf ( stderr, " retain %s\n", textToStr(tnm) );
327 static Bool isExportedAbstractly ( ConId ife_id, List exlist_list )
329 /* ife_id :: ConId */
330 /* exlist_list :: [[ ConVarId | ((ConId, [ConVarId])) ]] */
335 assert (isCon(ife_id));
336 tnm = textOf(ife_id);
338 /* for each export list ... */
339 for (; nonNull(exlist_list); exlist_list=tl(exlist_list)) {
340 exlist = hd(exlist_list);
342 /* for each entity in an export list ... */
343 for (t=exlist; nonNull(t); t=tl(t)) {
344 if (isZPair(hd(t))) {
345 /* A pair, which means an export entry
346 of the form ClassName(foo,bar). */
347 if (textOf(zfst(hd(t))) == tnm) return FALSE;
349 if (textOf(hd(t)) == tnm) return TRUE;
353 internal("isExportedAbstractly");
354 return FALSE; /*notreached*/
358 /* Remove entities not mentioned in any of the export lists. */
359 static Cell deleteUnexportedIFaceEntities ( Cell root )
361 Cell iface = unap(I_INTERFACE,root);
362 ConId iname = zfst(iface);
363 List decls = zsnd(iface);
365 List exlist_list = NIL;
368 fprintf(stderr, "\ncleanIFace: %s\n", textToStr(textOf(iname)));
370 exlist_list = getExportDeclsInIFace ( root );
371 /* exlist_list :: [I_EXPORT] */
373 for (t=exlist_list; nonNull(t); t=tl(t))
374 hd(t) = zsnd(unap(I_EXPORT,hd(t)));
375 /* exlist_list :: [[ ConVarId | ((ConId, [ConVarId])) ]] */
377 if (isNull(exlist_list)) {
378 ERRMSG(0) "Can't find any export lists in interface file"
382 return filterInterface ( root, isExportedIFaceEntity,
387 /* addTyconsAndClassesFromIFace :: I_INTERFACE -> [QualId] -> [QualId] */
388 List addTyconsAndClassesFromIFace ( Cell root, List aktys )
390 Cell iface = unap(I_INTERFACE,root);
391 Text mname = textOf(zfst(iface));
392 List defns = zsnd(iface);
393 for (; nonNull(defns); defns = tl(defns)) {
394 Cell defn = hd(defns);
395 Cell what = whatIs(defn);
396 if (what==I_TYPE || what==I_DATA
397 || what==I_NEWTYPE || what==I_CLASS) {
398 QualId q = mkQCon ( mname, textOf(getIEntityName(defn)) );
399 if (!qualidIsMember ( q, aktys ))
400 aktys = cons ( q, aktys );
407 Void ifentityAllTypesKnown_dumpmsg ( Cell entity )
409 ConVarId id = getIEntityName ( entity );
411 "dumping %s because of unknown type(s)\n",
412 isNull(id) ? "(nameless entity?!)" : textToStr(textOf(id)) );
415 /* ifentityAllTypesKnown :: I_IMPORT..I_VALUE -> (([QualId], ConId)) -> Bool */
416 /* mod is the current module being processed -- so we can qualify unqual'd
417 names. Strange calling convention for aktys and mod is so we can call this
418 from filterInterface.
420 Bool ifentityAllTypesKnown ( Cell entity, ZPair aktys_mod )
423 List aktys = zfst ( aktys_mod );
424 ConId mod = zsnd ( aktys_mod );
425 switch (whatIs(entity)) {
432 Cell inst = unap(I_INSTANCE,entity);
433 List ctx = zsel25 ( inst ); /* :: [((QConId,VarId))] */
434 Type cls = zsel35 ( inst ); /* :: Type */
435 for (t = ctx; nonNull(t); t=tl(t))
436 if (!allTypesKnown(zfst(hd(t)),aktys,mod)) return FALSE;
437 if (!allTypesKnown(cls, aktys,mod)) return FALSE;
441 return allTypesKnown( zsel44(unap(I_TYPE,entity)), aktys,mod );
443 Cell data = unap(I_DATA,entity);
444 List ctx = zsel25 ( data ); /* :: [((QConId,VarId))] */
445 List constrs = zsel55 ( data ); /* :: [ ((ConId, [((Type,VarId,Int))] )) ] */
446 for (t = ctx; nonNull(t); t=tl(t))
447 if (!allTypesKnown(zfst(hd(t)),aktys,mod)) return FALSE;
448 for (t = constrs; nonNull(t); t=tl(t))
449 for (u = zsnd(hd(t)); nonNull(u); u=tl(u))
450 if (!allTypesKnown(zfst3(hd(u)),aktys,mod)) return FALSE;
454 Cell newty = unap(I_NEWTYPE,entity);
455 List ctx = zsel25(newty); /* :: [((QConId,VarId))] */
456 ZPair constr = zsel55 ( newty ); /* :: ((ConId,Type)) */
457 for (t = ctx; nonNull(t); t=tl(t))
458 if (!allTypesKnown(zfst(hd(t)),aktys,mod)) return FALSE;
460 && !allTypesKnown(zsnd(constr),aktys,mod)) return FALSE;
464 Cell klass = unap(I_CLASS,entity);
465 List ctx = zsel25(klass); /* :: [((QConId,VarId))] */
466 List sigs = zsel55(klass); /* :: [((VarId,Type))] */
467 for (t = ctx; nonNull(t); t=tl(t))
468 if (!allTypesKnown(zfst(hd(t)),aktys,mod)) return FALSE;
469 for (t = sigs; nonNull(t); t=tl(t))
470 if (!allTypesKnown(zsnd(hd(t)),aktys,mod)) return FALSE;
474 return allTypesKnown( zthd3(unap(I_VALUE,entity)), aktys,mod );
476 internal("ifentityAllTypesKnown");
481 /* ifTypeDoesntRefUnknownTycon :: I_IMPORT..I_VALUE -> (([QualId], ConId)) -> Bool */
482 /* mod is the current module being processed -- so we can qualify unqual'd
483 names. Strange calling convention for aktys and mod is so we can call this
484 from filterInterface.
486 Bool ifTypeDoesntRefUnknownTycon ( Cell entity, ZPair aktys_mod )
489 List aktys = zfst ( aktys_mod );
490 ConId mod = zsnd ( aktys_mod );
491 if (whatIs(entity) != I_TYPE) {
494 return allTypesKnown( zsel44(unap(I_TYPE,entity)), aktys,mod );
498 Void ifTypeDoesntRefUnknownTycon_dumpmsg ( Cell entity )
500 ConVarId id = getIEntityName ( entity );
501 assert (whatIs(entity)==I_TYPE);
504 "dumping type %s because of unknown tycon(s)\n",
505 textToStr(textOf(id)) );
509 /* abstractifyExport :: I_EXPORT -> ConId -> I_EXPORT
511 List abstractifyExDecl ( Cell root, ConId toabs )
513 ZPair exdecl = unap(I_EXPORT,root);
514 List exlist = zsnd(exdecl);
516 for (; nonNull(exlist); exlist = tl(exlist)) {
517 if (isZPair(hd(exlist))
518 && textOf(toabs) == textOf(zfst(hd(exlist)))) {
519 /* it's toabs, exported non-abstractly */
520 res = cons ( zfst(hd(exlist)), res );
522 res = cons ( hd(exlist), res );
525 return ap(I_EXPORT,zpair(zfst(exdecl),reverse(res)));
529 Void ppModule ( Text modt )
531 fflush(stderr); fflush(stdout);
532 fprintf(stderr, "---------------- MODULE %s ----------------\n",
537 /* ifaces_outstanding holds a list of parsed interfaces
538 for which we need to load objects and create symbol
541 Void processInterfaces ( void )
552 List all_known_types;
555 List ifaces = NIL; /* :: List I_INTERFACE */
556 List iface_sizes = NIL; /* :: List Int */
557 List iface_onames = NIL; /* :: List Text */
559 if (isNull(ifaces_outstanding)) return;
562 "processInterfaces: %d interfaces to process\n",
563 length(ifaces_outstanding) );
565 /* unzip3 ifaces_outstanding into ifaces, iface_sizes, iface_onames */
566 for (xs = ifaces_outstanding; nonNull(xs); xs=tl(xs)) {
567 ifaces = cons ( zfst3(hd(xs)), ifaces );
568 iface_onames = cons ( zsnd3(hd(xs)), iface_onames );
569 iface_sizes = cons ( zthd3(hd(xs)), iface_sizes );
572 ifaces = reverse(ifaces);
573 iface_onames = reverse(iface_onames);
574 iface_sizes = reverse(iface_sizes);
576 /* Clean up interfaces -- dump non-exported value, class, type decls */
577 for (xs = ifaces; nonNull(xs); xs = tl(xs))
578 hd(xs) = deleteUnexportedIFaceEntities(hd(xs));
581 /* Iteratively delete any type declarations which refer to unknown
584 num_known_types = 999999999;
588 /* Construct a list of all known tycons. This is a list of QualIds.
589 Unfortunately it also has to contain all known class names, since
590 allTypesKnown cannot distinguish between tycons and classes -- a
591 deficiency of the iface abs syntax.
593 all_known_types = getAllKnownTyconsAndClasses();
594 for (xs = ifaces; nonNull(xs); xs=tl(xs))
595 all_known_types = addTyconsAndClassesFromIFace ( hd(xs), all_known_types );
597 /* Have we reached a fixed point? */
598 i = length(all_known_types);
599 printf ( "\n============= %d known types =============\n", i );
600 if (num_known_types == i) break;
603 /* Delete all entities which refer to unknown tycons. */
604 for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
605 ConId mod = zfst(unap(I_INTERFACE,hd(xs)));
606 assert(nonNull(mod));
607 hd(xs) = filterInterface ( hd(xs),
608 ifTypeDoesntRefUnknownTycon,
609 zpair(all_known_types,mod),
610 ifTypeDoesntRefUnknownTycon_dumpmsg );
614 /* Now abstractify any datas and newtypes which refer to unknown tycons
615 -- including, of course, the type decls just deleted.
617 for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
618 List absify = NIL; /* :: [ConId] */
619 ZPair iface = unap(I_INTERFACE,hd(xs)); /* ((ConId, [I_IMPORT..I_VALUE])) */
620 ConId mod = zfst(iface);
621 List aktys = all_known_types; /* just a renaming */
625 /* Compute into absify the list of all ConIds (tycons) we need to
628 for (es = zsnd(iface); nonNull(es); es=tl(es)) {
630 Bool allKnown = TRUE;
632 if (whatIs(ent)==I_DATA) {
633 Cell data = unap(I_DATA,ent);
634 List ctx = zsel25 ( data ); /* :: [((QConId,VarId))] */
635 List constrs = zsel55 ( data ); /* :: [ ((ConId, [((Type,VarId,Int))] )) ] */
636 for (t = ctx; nonNull(t); t=tl(t))
637 if (!allTypesKnown(zfst(hd(t)),aktys,mod)) allKnown = FALSE;
638 for (t = constrs; nonNull(t); t=tl(t))
639 for (u = zsnd(hd(t)); nonNull(u); u=tl(u))
640 if (!allTypesKnown(zfst3(hd(u)),aktys,mod)) allKnown = FALSE;
642 else if (whatIs(ent)==I_NEWTYPE) {
643 Cell newty = unap(I_NEWTYPE,ent);
644 List ctx = zsel25(newty); /* :: [((QConId,VarId))] */
645 ZPair constr = zsel55 ( newty ); /* :: ((ConId,Type)) */
646 for (t = ctx; nonNull(t); t=tl(t))
647 if (!allTypesKnown(zfst(hd(t)),aktys,mod)) allKnown = FALSE;
648 if (!allTypesKnown(zsnd(constr),aktys,mod)) allKnown = FALSE;
652 absify = cons ( getIEntityName(ent), absify );
654 "abstractifying %s because it uses an unknown type\n",
655 textToStr(textOf(getIEntityName(ent))) );
659 /* mark in exports as abstract all names in absify (modifies iface) */
660 for (; nonNull(absify); absify=tl(absify)) {
661 ConId toAbs = hd(absify);
662 for (es = zsnd(iface); nonNull(es); es=tl(es)) {
663 if (whatIs(hd(es)) != I_EXPORT) continue;
664 hd(es) = abstractifyExDecl ( hd(es), toAbs );
668 /* For each data/newtype in the export list marked as abstract,
669 remove the constructor lists. This catches all abstractification
670 caused by the code above, and it also catches tycons which really
671 were exported abstractly.
674 exlist_list = getExportDeclsInIFace ( ap(I_INTERFACE,iface) );
675 /* exlist_list :: [I_EXPORT] */
676 for (t=exlist_list; nonNull(t); t=tl(t))
677 hd(t) = zsnd(unap(I_EXPORT,hd(t)));
678 /* exlist_list :: [[ ConVarId | ((ConId, [ConVarId])) ]] */
680 for (es = zsnd(iface); nonNull(es); es=tl(es)) {
682 if (whatIs(ent)==I_DATA
683 && isExportedAbstractly ( getIEntityName(ent),
685 Cell data = unap(I_DATA,ent);
686 data = z5ble ( zsel15(data), zsel25(data), zsel35(data),
687 zsel45(data), NIL /* the constr list */ );
688 hd(es) = ap(I_DATA,data);
689 fprintf(stderr, "abstractify data %s\n", textToStr(textOf(getIEntityName(ent))) );
691 else if (whatIs(ent)==I_NEWTYPE
692 && isExportedAbstractly ( getIEntityName(ent),
694 Cell data = unap(I_NEWTYPE,ent);
695 data = z5ble ( zsel15(data), zsel25(data), zsel35(data),
696 zsel45(data), NIL /* the constr-type pair */ );
697 hd(es) = ap(I_NEWTYPE,data);
698 fprintf(stderr, "abstractify newtype %s\n", textToStr(textOf(getIEntityName(ent))) );
702 /* We've finally finished mashing this iface. Update the iface list. */
703 hd(xs) = ap(I_INTERFACE,iface);
707 /* At this point, the interfaces are cleaned up so that no type, data or
708 newtype defn refers to a non-existant type. However, there still may
709 be value defns, classes and instances which refer to unknown types.
710 Delete iteratively until a fixed point is reached.
714 num_known_types = 999999999;
718 /* Construct a list of all known tycons. This is a list of QualIds.
719 Unfortunately it also has to contain all known class names, since
720 allTypesKnown cannot distinguish between tycons and classes -- a
721 deficiency of the iface abs syntax.
723 all_known_types = getAllKnownTyconsAndClasses();
724 for (xs = ifaces; nonNull(xs); xs=tl(xs))
725 all_known_types = addTyconsAndClassesFromIFace ( hd(xs), all_known_types );
727 /* Have we reached a fixed point? */
728 i = length(all_known_types);
729 printf ( "\n------------- %d known types -------------\n", i );
730 if (num_known_types == i) break;
733 /* Delete all entities which refer to unknown tycons. */
734 for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
735 ConId mod = zfst(unap(I_INTERFACE,hd(xs)));
736 assert(nonNull(mod));
738 hd(xs) = filterInterface ( hd(xs),
739 ifentityAllTypesKnown,
740 zpair(all_known_types,mod),
741 ifentityAllTypesKnown_dumpmsg );
746 /* Allocate module table entries and read in object code. */
749 xs=tl(xs), iface_sizes=tl(iface_sizes), iface_onames=tl(iface_onames)) {
750 startGHCModule ( textOf(zfst(unap(I_INTERFACE,hd(xs)))),
751 intOf(hd(iface_sizes)),
754 assert (isNull(iface_sizes));
755 assert (isNull(iface_onames));
758 /* Now work through the decl lists of the modules, and call the
759 startGHC* functions on the entities. This creates names in
760 various tables but doesn't bind them to anything.
763 for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
764 iface = unap(I_INTERFACE,hd(xs));
765 mname = textOf(zfst(iface));
766 mod = findModule(mname);
767 if (isNull(mod)) internal("processInterfaces(4)");
769 ppModule ( module(mod).text );
771 for (decls = zsnd(iface); nonNull(decls); decls = tl(decls)) {
772 Cell decl = hd(decls);
773 switch(whatIs(decl)) {
775 Cell exdecl = unap(I_EXPORT,decl);
776 startGHCExports ( zfst(exdecl), zsnd(exdecl) );
780 Cell imdecl = unap(I_IMPORT,decl);
781 startGHCImports ( zfst(imdecl), zsnd(imdecl) );
788 /* Trying to find the instance table location allocated by
789 startGHCInstance in subsequent processing is a nightmare, so
790 cache it on the tree.
792 Cell instance = unap(I_INSTANCE,decl);
793 Inst in = startGHCInstance ( zsel15(instance), zsel25(instance),
794 zsel35(instance), zsel45(instance) );
795 hd(decls) = ap(I_INSTANCE,
796 z5ble( zsel15(instance), zsel25(instance),
797 zsel35(instance), zsel45(instance), in ));
801 Cell tydecl = unap(I_TYPE,decl);
802 startGHCSynonym ( zsel14(tydecl), zsel24(tydecl),
803 zsel34(tydecl), zsel44(tydecl) );
807 Cell ddecl = unap(I_DATA,decl);
808 startGHCDataDecl ( zsel15(ddecl), zsel25(ddecl),
809 zsel35(ddecl), zsel45(ddecl), zsel55(ddecl) );
813 Cell ntdecl = unap(I_NEWTYPE,decl);
814 startGHCNewType ( zsel15(ntdecl), zsel25(ntdecl),
815 zsel35(ntdecl), zsel45(ntdecl),
820 Cell klass = unap(I_CLASS,decl);
821 startGHCClass ( zsel15(klass), zsel25(klass),
822 zsel35(klass), zsel45(klass),
827 Cell value = unap(I_VALUE,decl);
828 startGHCValue ( zfst3(value), zsnd3(value), zthd3(value) );
832 internal("processInterfaces(1)");
837 fprintf(stderr, "\n=========================================================\n");
838 fprintf(stderr, "=========================================================\n");
840 /* Traverse again the decl lists of the modules, this time
841 calling the finishGHC* functions. But don't process
842 the export lists; those must wait for later.
844 for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
845 iface = unap(I_INTERFACE,hd(xs));
846 mname = textOf(zfst(iface));
847 mod = findModule(mname);
848 if (isNull(mod)) internal("processInterfaces(3)");
850 ppModule ( module(mod).text );
852 for (decls = zsnd(iface); nonNull(decls); decls = tl(decls)) {
853 Cell decl = hd(decls);
854 switch(whatIs(decl)) {
865 Cell instance = unap(I_INSTANCE,decl);
866 finishGHCInstance ( zsel55(instance) );
870 Cell tydecl = unap(I_TYPE,decl);
871 finishGHCSynonym ( zsel24(tydecl) );
875 Cell ddecl = unap(I_DATA,decl);
876 finishGHCDataDecl ( zsel35(ddecl) );
880 Cell ntdecl = unap(I_NEWTYPE,decl);
881 finishGHCNewType ( zsel35(ntdecl) );
885 Cell klass = unap(I_CLASS,decl);
886 finishGHCClass ( zsel35(klass) );
890 Cell value = unap(I_VALUE,decl);
891 finishGHCValue ( zsnd3(value) );
895 internal("processInterfaces(2)");
899 fprintf(stderr, "\n+++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n");
900 fprintf(stderr, "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n");
902 /* Build the module(m).export lists for each module, by running
903 through the export lists in the iface. Also, do the implicit
904 'import Prelude' thing. And finally, do the object code
907 for (xs = ifaces; nonNull(xs); xs = tl(xs))
908 finishGHCModule(hd(xs));
911 ifaces_outstanding = NIL;
915 /* --------------------------------------------------------------------------
917 * ------------------------------------------------------------------------*/
919 void startGHCModule_errMsg ( char* msg )
921 fprintf ( stderr, "object error: %s\n", msg );
924 void* startGHCModule_clientLookup ( char* sym )
926 /* fprintf ( stderr, "CLIENTLOOKUP %s\n", sym ); */
927 return lookupObjName ( sym );
930 ObjectCode* startGHCModule_partial_load ( String objNm, Int objSz )
933 = ocNew ( startGHCModule_errMsg,
934 startGHCModule_clientLookup,
938 ERRMSG(0) "Storage allocation for object file \"%s\" failed", objNm
941 if (!ocLoadImage(oc,VERBOSE)) {
942 ERRMSG(0) "Reading of object file \"%s\" failed", objNm
945 if (!ocVerifyImage(oc,VERBOSE)) {
946 ERRMSG(0) "Validation of object file \"%s\" failed", objNm
949 if (!ocGetNames(oc,0||VERBOSE)) {
950 ERRMSG(0) "Reading of symbol names in object file \"%s\" failed", objNm
956 Void startGHCModule ( Text mname, Int sizeObj, Text nameObj )
959 Module m = findModule(mname);
962 m = newModule(mname);
963 fprintf ( stderr, "startGHCIface: name %16s objsize %d\n",
964 textToStr(mname), sizeObj );
966 if (module(m).fake) {
967 module(m).fake = FALSE;
969 ERRMSG(0) "Module \"%s\" already loaded", textToStr(mname)
974 /* Get hold of the primary object for the module. */
976 = startGHCModule_partial_load ( textToStr(nameObj), sizeObj );
978 /* and any extras ... */
979 for (xts = module(m).objectExtraNames; nonNull(xts); xts=tl(xts)) {
983 String nm = getExtraObjectInfo ( textToStr(nameObj),
987 ERRMSG(0) "Can't find extra object file \"%s\"", nm
990 oc = startGHCModule_partial_load ( nm, size );
991 oc->next = module(m).objectExtras;
992 module(m).objectExtras = oc;
997 /* For the module mod, augment both the export environment (.exports)
998 and the eval environment (.names, .tycons, .classes)
999 with the symbols mentioned in exlist. We don't actually need
1000 to modify the names, tycons, classes or instances in the eval
1001 environment, since previous processing of the
1002 top-level decls in the iface should have done this already.
1004 mn is the module mentioned in the export list; it is the "original"
1005 module for the symbols in the export list. We should also record
1006 this info with the symbols, since references to object code need to
1007 refer to the original module in which a symbol was defined, rather
1008 than to some module it has been imported into and then re-exported.
1010 We take the policy that if something mentioned in an export list
1011 can't be found in the symbol tables, it is simply ignored. After all,
1012 previous processing of the iface syntax trees has already removed
1013 everything which Hugs can't handle, so if there is mention of these
1014 things still lurking in export lists somewhere, about the only thing
1015 to do is to ignore it.
1017 Also do an implicit 'import Prelude' thingy for the module,
1022 Void finishGHCModule ( Cell root )
1024 /* root :: I_INTERFACE */
1025 Cell iface = unap(I_INTERFACE,root);
1026 ConId iname = zfst(iface);
1027 Module mod = findModule(textOf(iname));
1028 List exlist_list = NIL;
1032 fprintf(stderr, "begin finishGHCModule %s\n", textToStr(textOf(iname)));
1034 if (isNull(mod)) internal("finishExports(1)");
1037 exlist_list = getExportDeclsInIFace ( root );
1038 /* exlist_list :: [I_EXPORT] */
1040 for (; nonNull(exlist_list); exlist_list=tl(exlist_list)) {
1041 ZPair exdecl = unap(I_EXPORT,hd(exlist_list));
1042 ConId exmod = zfst(exdecl);
1043 List exlist = zsnd(exdecl);
1044 /* exlist :: [ ConVarId | ((ConId, [ConVarId])) ] */
1046 for (; nonNull(exlist); exlist=tl(exlist)) {
1051 Cell ex = hd(exlist);
1053 switch (whatIs(ex)) {
1055 case VARIDCELL: /* variable */
1056 q = mkQualId(exmod,ex);
1057 c = findQualNameWithoutConsultingExportList ( q );
1058 if (isNull(c)) goto notfound;
1059 fprintf(stderr, " var %s\n", textToStr(textOf(ex)) );
1060 module(mod).exports = cons(c, module(mod).exports);
1064 case CONIDCELL: /* non data tycon */
1065 q = mkQualId(exmod,ex);
1066 c = findQualTyconWithoutConsultingExportList ( q );
1067 if (isNull(c)) goto notfound;
1068 fprintf(stderr, " type %s\n", textToStr(textOf(ex)) );
1069 module(mod).exports = cons(pair(c,NIL), module(mod).exports);
1073 case ZTUP2: /* data T = C1 ... Cn or class C where f1 ... fn */
1074 subents = zsnd(ex); /* :: [ConVarId] */
1075 ex = zfst(ex); /* :: ConId */
1076 q = mkQualId(exmod,ex);
1077 c = findQualTyconWithoutConsultingExportList ( q );
1079 if (nonNull(c)) { /* data */
1080 fprintf(stderr, " data/newtype %s = { ", textToStr(textOf(ex)) );
1081 assert(tycon(c).what == DATATYPE || tycon(c).what==NEWTYPE);
1082 abstract = isNull(tycon(c).defn);
1083 /* This data/newtype could be abstract even tho the export list
1084 says to export it non-abstractly. That happens if it was
1085 imported from some other module and is now being re-exported,
1086 and previous cleanup phases have abstractified it in the
1087 original (defining) module.
1090 module(mod).exports = cons(pair(c,NIL), module(mod).exports);
1092 fprintf ( stderr, "(abstract) ");
1094 module(mod).exports = cons(pair(c,DOTDOT), module(mod).exports);
1096 for (; nonNull(subents); subents = tl(subents)) {
1097 Cell ent2 = hd(subents);
1098 assert(isCon(ent2) || isVar(ent2));
1099 /* isVar since could be a field name */
1100 q = mkQualId(exmod,ent2);
1101 c = findQualNameWithoutConsultingExportList ( q );
1102 fprintf(stderr, "%s ", textToStr(name(c).text));
1104 /* module(mod).exports = cons(c, module(mod).exports); */
1108 fprintf(stderr, "}\n" );
1109 } else { /* class */
1110 q = mkQualId(exmod,ex);
1111 c = findQualClassWithoutConsultingExportList ( q );
1112 if (isNull(c)) goto notfound;
1113 fprintf(stderr, " class %s { ", textToStr(textOf(ex)) );
1114 module(mod).exports = cons(pair(c,DOTDOT), module(mod).exports);
1116 for (; nonNull(subents); subents = tl(subents)) {
1117 Cell ent2 = hd(subents);
1118 assert(isVar(ent2));
1119 q = mkQualId(exmod,ent2);
1120 c = findQualNameWithoutConsultingExportList ( q );
1121 fprintf(stderr, "%s ", textToStr(name(c).text));
1122 if (isNull(c)) goto notfound;
1123 /* module(mod).exports = cons(c, module(mod).exports); */
1126 fprintf(stderr, "}\n" );
1131 internal("finishExports(2)");
1134 continue; /* so notfound: can be placed after this */
1137 /* q holds what ain't found */
1138 assert(whatIs(q)==QUALIDENT);
1139 fprintf( stderr, " ------ IGNORED: %s.%s\n",
1140 textToStr(qmodOf(q)), textToStr(qtextOf(q)) );
1146 if (preludeLoaded) {
1147 /* do the implicit 'import Prelude' thing */
1148 List pxs = module(modulePrelude).exports;
1149 for (; nonNull(pxs); pxs=tl(pxs)) {
1152 switch (whatIs(px)) {
1157 module(mod).names = cons ( px, module(mod).names );
1160 module(mod).tycons = cons ( px, module(mod).tycons );
1163 module(mod).classes = cons ( px, module(mod).classes );
1166 fprintf(stderr, "finishGHCModule: unknown tag %d\n", whatIs(px));
1167 internal("finishGHCModule -- implicit import Prelude");
1174 /* Last, but by no means least ... */
1175 if (!ocResolve(module(mod).object,0||VERBOSE))
1176 internal("finishGHCModule: object resolution failed");
1178 for (oc=module(mod).objectExtras; oc; oc=oc->next) {
1179 if (!ocResolve(oc, 0||VERBOSE))
1180 internal("finishGHCModule: extra object resolution failed");
1185 /* --------------------------------------------------------------------------
1187 * ------------------------------------------------------------------------*/
1189 Void startGHCExports ( ConId mn, List exlist )
1192 printf("startGHCExports %s\n", textToStr(textOf(mn)) );
1194 /* Nothing to do. */
1197 Void finishGHCExports ( ConId mn, List exlist )
1200 printf("finishGHCExports %s\n", textToStr(textOf(mn)) );
1202 /* Nothing to do. */
1206 /* --------------------------------------------------------------------------
1208 * ------------------------------------------------------------------------*/
1210 Void startGHCImports ( ConId mn, List syms )
1211 /* nm the module to import from */
1212 /* syms [ConId | VarId] -- the names to import */
1215 printf("startGHCImports %s\n", textToStr(textOf(mn)) );
1217 /* Nothing to do. */
1221 Void finishGHCImports ( ConId nm, List syms )
1222 /* nm the module to import from */
1223 /* syms [ConId | VarId] -- the names to import */
1226 printf("finishGHCImports %s\n", textToStr(textOf(nm)) );
1228 /* Nothing to do. */
1232 /* --------------------------------------------------------------------------
1234 * ------------------------------------------------------------------------*/
1236 /* convert a leading run of DICTAPs into Hugs' internal Qualtype form, viz:
1237 { C1 a } -> { C2 b } -> T into
1238 ap(QUALTYPE, ( [(C1,a),(C2,b)], T ))
1240 static Type dictapsToQualtype ( Type ty )
1243 List preds, dictaps;
1245 /* break ty into pieces at the top-level arrows */
1246 while (isAp(ty) && isAp(fun(ty)) && fun(fun(ty))==typeArrow) {
1247 pieces = cons ( arg(fun(ty)), pieces );
1250 pieces = cons ( ty, pieces );
1251 pieces = reverse ( pieces );
1254 while (nonNull(pieces) && whatIs(hd(pieces))==DICTAP) {
1255 dictaps = cons ( hd(pieces), dictaps );
1256 pieces = tl(pieces);
1259 /* dictaps holds the predicates, backwards */
1260 /* pieces holds the remainder of the type, forwards */
1261 assert(nonNull(pieces));
1262 pieces = reverse(pieces);
1264 pieces = tl(pieces);
1265 for (; nonNull(pieces); pieces=tl(pieces))
1266 ty = fn(hd(pieces),ty);
1269 for (; nonNull(dictaps); dictaps=tl(dictaps)) {
1270 Cell da = hd(dictaps);
1271 QualId cl = fst(unap(DICTAP,da));
1272 Cell arg = snd(unap(DICTAP,da));
1273 preds = cons ( pair(cl,arg), preds );
1276 if (nonNull(preds)) ty = ap(QUAL, pair(preds,ty));
1282 void startGHCValue ( Int line, VarId vid, Type ty )
1286 Text v = textOf(vid);
1289 printf("begin startGHCValue %s\n", textToStr(v));
1294 ERRMSG(0) "Attempt to redefine variable \"%s\"", textToStr(v)
1299 /* convert a leading run of DICTAPs into Hugs' internal Qualtype form, viz:
1300 { C1 a } -> { C2 b } -> T into
1301 ap(QUALTYPE, ( [(C1,a),(C2,b)], T ))
1303 ty = dictapsToQualtype(ty);
1305 tvs = ifTyvarsIn(ty);
1306 for (tmp=tvs; nonNull(tmp); tmp=tl(tmp))
1307 hd(tmp) = zpair(hd(tmp),STAR);
1309 ty = mkPolyType(tvsToKind(tvs),ty);
1311 ty = tvsToOffsets(line,ty,tvs);
1313 name(n).arity = arityInclDictParams(ty);
1314 name(n).line = line;
1318 void finishGHCValue ( VarId vid )
1320 Name n = findName ( textOf(vid) );
1321 Int line = name(n).line;
1323 fprintf(stderr, "begin finishGHCValue %s\n", textToStr(name(n).text) );
1325 assert(currentModule == name(n).mod);
1326 name(n).type = conidcellsToTycons(line,name(n).type);
1330 /* --------------------------------------------------------------------------
1332 * ------------------------------------------------------------------------*/
1334 Void startGHCSynonym ( Int line, ConId tycon, List tvs, Type ty )
1336 /* tycon :: ConId */
1337 /* tvs :: [((VarId,Kind))] */
1339 Text t = textOf(tycon);
1341 fprintf(stderr, "begin startGHCSynonym %s\n", textToStr(t) );
1343 if (nonNull(findTycon(t))) {
1344 ERRMSG(line) "Repeated definition of type constructor \"%s\"",
1348 Tycon tc = newTycon(t);
1349 tycon(tc).line = line;
1350 tycon(tc).arity = length(tvs);
1351 tycon(tc).what = SYNONYM;
1352 tycon(tc).kind = tvsToKind(tvs);
1354 /* prepare for finishGHCSynonym */
1355 tycon(tc).defn = tvsToOffsets(line,ty,tvs);
1360 static Void finishGHCSynonym ( ConId tyc )
1362 Tycon tc = findTycon(textOf(tyc));
1363 Int line = tycon(tc).line;
1365 fprintf(stderr, "begin finishGHCSynonym %s\n", textToStr(textOf(tyc)) );
1368 assert (currentModule == tycon(tc).mod);
1369 // setCurrModule(tycon(tc).mod);
1370 tycon(tc).defn = conidcellsToTycons(line,tycon(tc).defn);
1372 /* (ADR) ToDo: can't really do this until I've done all synonyms
1373 * and then I have to do them in order
1374 * tycon(tc).defn = fullExpand(ty);
1375 * (JRS) What?!?! i don't understand
1380 /* --------------------------------------------------------------------------
1382 * ------------------------------------------------------------------------*/
1384 Void startGHCDataDecl(line,ctx0,tycon,ktyvars,constrs0)
1386 List ctx0; /* [((QConId,VarId))] */
1387 Cell tycon; /* ConId */
1388 List ktyvars; /* [((VarId,Kind))] */
1389 List constrs0; /* [((ConId,[((Type,VarId,Int))]))] */
1390 /* The Text is an optional field name
1391 The Int indicates strictness */
1392 /* ToDo: worry about being given a decl for (->) ?
1393 * and worry about qualidents for ()
1396 Type ty, resTy, selTy, conArgTy;
1397 List tmp, conArgs, sels, constrs, fields, tyvarsMentioned;
1401 Pair conArg, ctxElem;
1403 Int conArgStrictness;
1405 Text t = textOf(tycon);
1407 fprintf(stderr, "begin startGHCDataDecl %s\n",textToStr(t));
1410 if (nonNull(findTycon(t))) {
1411 ERRMSG(line) "Repeated definition of type constructor \"%s\"",
1415 Tycon tc = newTycon(t);
1417 tycon(tc).line = line;
1418 tycon(tc).arity = length(ktyvars);
1419 tycon(tc).kind = tvsToKind(ktyvars);
1420 tycon(tc).what = DATATYPE;
1422 /* a list to accumulate selectors in :: [((VarId,Type))] */
1425 /* make resTy the result type of the constr, T v1 ... vn */
1427 for (tmp=ktyvars; nonNull(tmp); tmp=tl(tmp))
1428 resTy = ap(resTy,zfst(hd(tmp)));
1430 /* for each constructor ... */
1431 for (constrs=constrs0; nonNull(constrs); constrs=tl(constrs)) {
1432 constr = hd(constrs);
1433 conid = zfst(constr);
1434 fields = zsnd(constr);
1436 /* Build type of constr and handle any selectors found.
1437 Also collect up tyvars occurring in the constr's arg
1438 types, so we can throw away irrelevant parts of the
1442 tyvarsMentioned = NIL;
1443 /* tyvarsMentioned :: [VarId] */
1445 conArgs = reverse(fields);
1446 for (; nonNull(conArgs); conArgs=tl(conArgs)) {
1447 conArg = hd(conArgs); /* (Type,Text) */
1448 conArgTy = zfst3(conArg);
1449 conArgNm = zsnd3(conArg);
1450 conArgStrictness = intOf(zthd3(conArg));
1451 tyvarsMentioned = dupListOnto(ifTyvarsIn(conArgTy),
1453 if (conArgStrictness > 0) conArgTy = bang(conArgTy);
1454 ty = fn(conArgTy,ty);
1455 if (nonNull(conArgNm)) {
1456 /* a field name is mentioned too */
1457 selTy = fn(resTy,conArgTy);
1458 if (whatIs(tycon(tc).kind) != STAR)
1459 selTy = pair(POLYTYPE,pair(tycon(tc).kind, selTy));
1460 selTy = tvsToOffsets(line,selTy, ktyvars);
1461 sels = cons( zpair(conArgNm,selTy), sels);
1465 /* Now ty is the constructor's type, not including context.
1466 Throw away any parts of the context not mentioned in
1467 tyvarsMentioned, and use it to qualify ty.
1470 for (ctx=ctx0; nonNull(ctx); ctx=tl(ctx)) {
1472 /* ctxElem :: ((QConId,VarId)) */
1473 if (nonNull(cellIsMember(textOf(zsnd(ctxElem)),tyvarsMentioned)))
1474 ctx2 = cons(ctxElem, ctx2);
1477 ty = ap(QUAL,pair(ctx2,ty));
1479 /* stick the tycon's kind on, if not simply STAR */
1480 if (whatIs(tycon(tc).kind) != STAR)
1481 ty = pair(POLYTYPE,pair(tycon(tc).kind, ty));
1483 ty = tvsToOffsets(line,ty, ktyvars);
1485 /* Finally, stick the constructor's type onto it. */
1486 hd(constrs) = ztriple(conid,fields,ty);
1489 /* Final result is that
1490 constrs :: [((ConId,[((Type,Text))],Type))]
1491 lists the constructors and their types
1492 sels :: [((VarId,Type))]
1493 lists the selectors and their types
1495 tycon(tc).defn = startGHCConstrs(line,constrs0,sels);
1500 static List startGHCConstrs ( Int line, List cons, List sels )
1502 /* cons :: [((ConId,[((Type,Text,Int))],Type))] */
1503 /* sels :: [((VarId,Type))] */
1504 /* returns [Name] */
1506 Int conNo = length(cons)>1 ? 1 : 0;
1507 for(cs=cons; nonNull(cs); cs=tl(cs), conNo++) {
1508 Name c = startGHCConstr(line,conNo,hd(cs));
1511 /* cons :: [Name] */
1513 for(ss=sels; nonNull(ss); ss=tl(ss)) {
1514 hd(ss) = startGHCSel(line,hd(ss));
1516 /* sels :: [Name] */
1517 return appendOnto(cons,sels);
1521 static Name startGHCSel ( Int line, ZPair sel )
1523 /* sel :: ((VarId, Type)) */
1524 Text t = textOf(zfst(sel));
1525 Type type = zsnd(sel);
1527 Name n = findName(t);
1529 ERRMSG(line) "Repeated definition for selector \"%s\"",
1535 name(n).line = line;
1536 name(n).number = SELNAME;
1539 name(n).type = type;
1544 static Name startGHCConstr ( Int line, Int conNo, ZTriple constr )
1546 /* constr :: ((ConId,[((Type,Text,Int))],Type)) */
1547 /* (ADR) ToDo: add rank2 annotation and existential annotation
1548 * these affect how constr can be used.
1550 Text con = textOf(zfst3(constr));
1551 Type type = zthd3(constr);
1552 Int arity = arityFromType(type);
1553 Name n = findName(con); /* Allocate constructor fun name */
1555 n = newName(con,NIL);
1556 } else if (name(n).defn!=PREDEFINED) {
1557 ERRMSG(line) "Repeated definition for constructor \"%s\"",
1561 name(n).arity = arity; /* Save constructor fun details */
1562 name(n).line = line;
1563 name(n).number = cfunNo(conNo);
1564 name(n).type = type;
1569 static Void finishGHCDataDecl ( ConId tyc )
1572 Tycon tc = findTycon(textOf(tyc));
1574 printf ( "begin finishGHCDataDecl %s\n", textToStr(textOf(tyc)) );
1576 if (isNull(tc)) internal("finishGHCDataDecl");
1578 for (nms=tycon(tc).defn; nonNull(nms); nms=tl(nms)) {
1580 Int line = name(n).line;
1581 assert(currentModule == name(n).mod);
1582 name(n).type = conidcellsToTycons(line,name(n).type);
1587 /* --------------------------------------------------------------------------
1589 * ------------------------------------------------------------------------*/
1591 Void startGHCNewType ( Int line, List ctx0,
1592 ConId tycon, List tvs, Cell constr )
1594 /* ctx0 :: [((QConId,VarId))] */
1595 /* tycon :: ConId */
1596 /* tvs :: [((VarId,Kind))] */
1597 /* constr :: ((ConId,Type)) or NIL if abstract */
1600 Text t = textOf(tycon);
1602 fprintf(stderr, "begin startGHCNewType %s\n", textToStr(t) );
1604 if (nonNull(findTycon(t))) {
1605 ERRMSG(line) "Repeated definition of type constructor \"%s\"",
1609 Tycon tc = newTycon(t);
1610 tycon(tc).line = line;
1611 tycon(tc).arity = length(tvs);
1612 tycon(tc).what = NEWTYPE;
1613 tycon(tc).kind = tvsToKind(tvs);
1614 /* can't really do this until I've read in all synonyms */
1616 if (isNull(constr)) {
1617 tycon(tc).defn = NIL;
1619 /* constr :: ((ConId,Type)) */
1620 Text con = textOf(zfst(constr));
1621 Type type = zsnd(constr);
1622 Name n = findName(con); /* Allocate constructor fun name */
1624 n = newName(con,NIL);
1625 } else if (name(n).defn!=PREDEFINED) {
1626 ERRMSG(line) "Repeated definition for constructor \"%s\"",
1630 name(n).arity = 1; /* Save constructor fun details */
1631 name(n).line = line;
1632 name(n).number = cfunNo(0);
1633 name(n).defn = nameId;
1634 tycon(tc).defn = singleton(n);
1636 /* make resTy the result type of the constr, T v1 ... vn */
1638 for (tmp=tvs; nonNull(tmp); tmp=tl(tmp))
1639 resTy = ap(resTy,zfst(hd(tmp)));
1640 type = fn(type,resTy);
1642 type = ap(QUAL,pair(ctx0,type));
1643 type = tvsToOffsets(line,type,tvs);
1644 name(n).type = type;
1650 static Void finishGHCNewType ( ConId tyc )
1652 Tycon tc = findTycon(textOf(tyc));
1654 printf ( "begin finishGHCNewType %s\n", textToStr(textOf(tyc)) );
1657 if (isNull(tc)) internal("finishGHCNewType");
1659 if (isNull(tycon(tc).defn)) {
1660 /* it's an abstract type */
1662 else if (length(tycon(tc).defn) == 1) {
1663 /* As we expect, has a single constructor */
1664 Name n = hd(tycon(tc).defn);
1665 Int line = name(n).line;
1666 assert(currentModule == name(n).mod);
1667 name(n).type = conidcellsToTycons(line,name(n).type);
1669 internal("finishGHCNewType(2)");
1674 /* --------------------------------------------------------------------------
1675 * Class declarations
1676 * ------------------------------------------------------------------------*/
1678 Void startGHCClass(line,ctxt,tc_name,kinded_tvs,mems0)
1680 List ctxt; /* [((QConId, VarId))] */
1681 ConId tc_name; /* ConId */
1682 List kinded_tvs; /* [((VarId, Kind))] */
1683 List mems0; { /* [((VarId, Type))] */
1685 List mems; /* [((VarId, Type))] */
1686 List tvsInT; /* [VarId] and then [((VarId,Kind))] */
1687 List tvs; /* [((VarId,Kind))] */
1689 ZPair kinded_tv = hd(kinded_tvs);
1690 Text ct = textOf(tc_name);
1691 Pair newCtx = pair(tc_name, zfst(kinded_tv));
1693 printf ( "begin startGHCClass %s\n", textToStr(ct) );
1696 if (length(kinded_tvs) != 1) {
1697 ERRMSG(line) "Cannot presently handle multiparam type classes in ifaces"
1701 if (nonNull(findClass(ct))) {
1702 ERRMSG(line) "Repeated definition of class \"%s\"",
1705 } else if (nonNull(findTycon(ct))) {
1706 ERRMSG(line) "\"%s\" used as both class and type constructor",
1710 Class nw = newClass(ct);
1711 cclass(nw).text = ct;
1712 cclass(nw).line = line;
1713 cclass(nw).arity = 1;
1714 cclass(nw).head = ap(nw,mkOffset(0));
1715 cclass(nw).kinds = singleton(STAR); /* absolutely no idea at all */
1716 cclass(nw).instances = NIL; /* what the kind should be */
1717 cclass(nw).numSupers = length(ctxt);
1719 /* Kludge to map the single tyvar in the context to Offset 0.
1720 Need to do something better for multiparam type classes.
1722 cclass(nw).supers = tvsToOffsets(line,ctxt,
1723 singleton(pair(tv,STAR)));
1725 cclass(nw).supers = tvsToOffsets(line,ctxt,
1726 singleton(kinded_tv));
1729 for (mems=mems0; nonNull(mems); mems=tl(mems)) {
1730 ZPair mem = hd(mems);
1731 Type memT = zsnd(mem);
1732 Text mnt = textOf(zfst(mem));
1735 /* Stick the new context on the member type */
1736 if (whatIs(memT)==POLYTYPE) internal("startGHCClass");
1737 if (whatIs(memT)==QUAL) {
1739 pair(cons(newCtx,fst(snd(memT))),snd(snd(memT))));
1742 pair(singleton(newCtx),memT));
1745 /* Cook up a kind for the type. */
1746 tvsInT = ifTyvarsIn(memT);
1747 /* tvsInT :: [VarId] */
1749 /* ToDo: maximally bogus */
1750 for (tvs=tvsInT; nonNull(tvs); tvs=tl(tvs))
1751 hd(tvs) = zpair(hd(tvs),STAR);
1752 /* tvsIntT :: [((VarId,STAR))] */
1754 memT = mkPolyType(tvsToKind(tvsInT),memT);
1755 memT = tvsToOffsets(line,memT,tvsInT);
1757 /* Park the type back on the member */
1758 mem = zpair(zfst(mem),memT);
1760 /* Bind code to the member */
1764 "Repeated definition for class method \"%s\"",
1768 mn = newName(mnt,NIL);
1773 cclass(nw).members = mems0;
1774 cclass(nw).numMembers = length(mems0);
1777 * cclass(nw).dsels = ?;
1778 * cclass(nw).dbuild = ?;
1779 * cclass(nm).dcon = ?;
1780 * cclass(nm).defaults = ?;
1786 static Void finishGHCClass ( Tycon cls_tyc )
1791 Class nw = findClass ( textOf(cls_tyc) );
1793 printf ( "begin finishGHCClass %s\n", textToStr(cclass(nw).text) );
1795 if (isNull(nw)) internal("finishGHCClass");
1797 line = cclass(nw).line;
1798 ctr = - length(cclass(nw).members);
1799 assert (currentModule == cclass(nw).mod);
1801 cclass(nw).level = 0; /* (ADR) ToDo: 1 + max (map level supers) */
1802 cclass(nw).head = conidcellsToTycons(line,cclass(nw).head);
1803 cclass(nw).supers = conidcellsToTycons(line,cclass(nw).supers);
1804 cclass(nw).members = conidcellsToTycons(line,cclass(nw).members);
1806 for (mems=cclass(nw).members; nonNull(mems); mems=tl(mems)) {
1807 Pair mem = hd(mems); /* (VarId, Type) */
1808 Text txt = textOf(fst(mem));
1810 Name n = findName(txt);
1812 name(n).line = cclass(nw).line;
1814 name(n).number = ctr++;
1820 /* --------------------------------------------------------------------------
1822 * ------------------------------------------------------------------------*/
1824 Inst startGHCInstance (line,ktyvars,cls,var)
1826 List ktyvars; /* [((VarId,Kind))] */
1827 Type cls; /* Type */
1828 VarId var; { /* VarId */
1829 List tmp, tvs, ks, spec;
1834 Inst in = newInst();
1836 printf ( "begin startGHCInstance\n" );
1839 tvs = ifTyvarsIn(cls); /* :: [VarId] */
1841 The order of tvs is important for tvsToOffsets.
1842 tvs should be a permutation of ktyvars. Fish the tyvar kinds
1843 out of ktyvars and attach them to tvs.
1845 for (xs1=tvs; nonNull(xs1); xs1=tl(xs1)) {
1847 for (xs2=ktyvars; nonNull(xs2); xs2=tl(xs2))
1848 if (textOf(hd(xs1)) == textOf(zfst(hd(xs2))))
1850 if (isNull(k)) internal("startGHCInstance: finding kinds");
1851 hd(xs1) = zpair(hd(xs1),k);
1854 cls = tvsToOffsets(line,cls,tvs);
1857 spec = cons(fun(cls),spec);
1860 spec = reverse(spec);
1862 inst(in).line = line;
1863 inst(in).implements = NIL;
1864 inst(in).kinds = simpleKind(length(tvs)); /* do this right */
1865 inst(in).specifics = spec;
1866 inst(in).numSpecifics = length(spec);
1867 inst(in).head = cls;
1869 /* Figure out the name of the class being instanced, and store it
1870 at inst(in).c. finishGHCInstance will resolve it to a real Class. */
1872 Cell cl = inst(in).head;
1873 assert(whatIs(cl)==DICTAP);
1874 cl = unap(DICTAP,cl);
1876 assert ( isQCon(cl) );
1881 Is this still needed?
1883 Name b = newName(inventText(),NIL);
1884 name(b).line = line;
1885 name(b).arity = length(ctxt); /* unused? */
1886 name(b).number = DFUNNAME;
1887 inst(in).builder = b;
1888 bindNameToClosure(b, lookupGHCClosure(inst(in).mod,var));
1895 static Void finishGHCInstance ( Inst in )
1902 printf ( "begin finishGHCInstance\n" );
1905 assert (nonNull(in));
1906 line = inst(in).line;
1907 assert (currentModule==inst(in).mod);
1909 /* inst(in).c is, prior to finishGHCInstance, a ConId or Tuple,
1910 since startGHCInstance couldn't possibly have resolved it to
1911 a Class at that point. We convert it to a Class now.
1915 c = findQualClassWithoutConsultingExportList(c);
1919 inst(in).head = conidcellsToTycons(line,inst(in).head);
1920 inst(in).specifics = conidcellsToTycons(line,inst(in).specifics);
1921 cclass(c).instances = cons(in,cclass(c).instances);
1925 /* --------------------------------------------------------------------------
1927 * ------------------------------------------------------------------------*/
1929 /* This is called from the startGHC* functions. It traverses a structure
1930 and converts varidcells, ie, type variables parsed by the interface
1931 parser, into Offsets, which is how Hugs wants to see them internally.
1932 The Offset for a type variable is determined by its place in the list
1933 passed as the second arg; the associated kinds are irrelevant.
1935 ((t1,t2)) denotes the typed (z-)pair of t1 and t2.
1938 /* tvsToOffsets :: LineNo -> Type -> [((VarId,Kind))] -> Type */
1939 static Type tvsToOffsets(line,type,ktyvars)
1942 List ktyvars; { /* [((VarId,Kind))] */
1943 switch (whatIs(type)) {
1950 case ZTUP2: /* convert to the untyped representation */
1951 return ap( tvsToOffsets(line,zfst(type),ktyvars),
1952 tvsToOffsets(line,zsnd(type),ktyvars) );
1954 return ap( tvsToOffsets(line,fun(type),ktyvars),
1955 tvsToOffsets(line,arg(type),ktyvars) );
1959 tvsToOffsets(line,monotypeOf(type),ktyvars)
1963 return pair(QUAL,pair(tvsToOffsets(line,fst(snd(type)),ktyvars),
1964 tvsToOffsets(line,snd(snd(type)),ktyvars)));
1965 case DICTAP: /* bogus ?? */
1966 return ap(DICTAP, tvsToOffsets(line,snd(type),ktyvars));
1967 case UNBOXEDTUP: /* bogus?? */
1968 return ap(UNBOXEDTUP, tvsToOffsets(line,snd(type),ktyvars));
1969 case BANG: /* bogus?? */
1970 return ap(BANG, tvsToOffsets(line,snd(type),ktyvars));
1971 case VARIDCELL: /* Ha! some real work to do! */
1973 Text tv = textOf(type);
1974 for (; nonNull(ktyvars); i++,ktyvars=tl(ktyvars)) {
1977 assert(isZPair(hd(ktyvars)));
1978 varid = zfst(hd(ktyvars));
1980 if (tv == tt) return mkOffset(i);
1982 ERRMSG(line) "Undefined type variable \"%s\"", textToStr(tv)
1987 fprintf(stderr, "tvsToOffsets: unknown stuff %d\n", whatIs(type));
1989 fprintf(stderr,"\n");
1993 return NIL; /* NOTREACHED */
1997 /* This is called from the finishGHC* functions. It traverses a structure
1998 and converts conidcells, ie, type constructors parsed by the interface
1999 parser, into Tycons (or Classes), which is how Hugs wants to see them
2000 internally. Calls to this fn have to be deferred to the second phase
2001 of interface loading (finishGHC* rather than startGHC*) so that all relevant
2002 Tycons or Classes have been loaded into the symbol tables and can be
2005 static Type conidcellsToTycons ( Int line, Type type )
2007 switch (whatIs(type)) {
2017 { Cell t; /* Tycon or Class */
2018 Text m = qmodOf(type);
2019 Module mod = findModule(m);
2022 "Undefined module in qualified name \"%s\"",
2027 t = findQualTyconWithoutConsultingExportList(type);
2028 if (nonNull(t)) return t;
2029 t = findQualClassWithoutConsultingExportList(type);
2030 if (nonNull(t)) return t;
2032 "Undefined qualified class or type \"%s\"",
2040 cl = findQualClass(type);
2041 if (nonNull(cl)) return cl;
2042 if (textOf(type)==findText("[]"))
2043 /* a hack; magically qualify [] into PrelBase.[] */
2044 return conidcellsToTycons(line,
2045 mkQualId(mkCon(findText("PrelBase")),type));
2046 tc = findQualTycon(type);
2047 if (nonNull(tc)) return tc;
2049 "Undefined class or type constructor \"%s\"",
2055 return ap( conidcellsToTycons(line,fun(type)),
2056 conidcellsToTycons(line,arg(type)) );
2057 case ZTUP2: /* convert to std pair */
2058 return ap( conidcellsToTycons(line,zfst(type)),
2059 conidcellsToTycons(line,zsnd(type)) );
2064 conidcellsToTycons(line,monotypeOf(type))
2068 return pair(QUAL,pair(conidcellsToTycons(line,fst(snd(type))),
2069 conidcellsToTycons(line,snd(snd(type)))));
2070 case DICTAP: /* :: ap(DICTAP, pair(Class,Type))
2071 Not sure if this is really the right place to
2072 convert it to the form Hugs wants, but will do so anyway.
2074 /* return ap(DICTAP, conidcellsToTycons(line, snd(type))); */
2076 Class cl = fst(unap(DICTAP,type));
2077 List args = snd(unap(DICTAP,type));
2079 conidcellsToTycons(line,pair(cl,args));
2082 return ap(UNBOXEDTUP, conidcellsToTycons(line, snd(type)));
2084 return ap(BANG, conidcellsToTycons(line, snd(type)));
2086 fprintf(stderr, "conidcellsToTycons: unknown stuff %d\n",
2089 fprintf(stderr,"\n");
2093 return NIL; /* NOTREACHED */
2097 /* Find out if a type mentions a type constructor not present in
2098 the supplied list of qualified tycons.
2100 static Bool allTypesKnown ( Type type,
2101 List aktys /* [QualId] */,
2104 switch (whatIs(type)) {
2111 return allTypesKnown(fun(type),aktys,thisMod)
2112 && allTypesKnown(arg(type),aktys,thisMod);
2114 return allTypesKnown(zfst(type),aktys,thisMod)
2115 && allTypesKnown(zsnd(type),aktys,thisMod);
2117 return allTypesKnown(unap(DICTAP,type),aktys,thisMod);
2120 if (textOf(type)==findText("[]"))
2121 /* a hack; magically qualify [] into PrelBase.[] */
2122 type = mkQualId(mkCon(findText("PrelBase")),type); else
2123 type = mkQualId(thisMod,type);
2126 if (isNull(qualidIsMember(type,aktys))) goto missing;
2132 fprintf(stderr, "allTypesKnown: unknown stuff %d\n", whatIs(type));
2133 print(type,10);printf("\n");
2134 internal("allTypesKnown");
2135 return TRUE; /*notreached*/
2138 printf ( "allTypesKnown: unknown " ); print(type,10); printf("\n");
2143 /* --------------------------------------------------------------------------
2146 * None of these do lookups or require that lookups have been resolved
2147 * so they can be performed while reading interfaces.
2148 * ------------------------------------------------------------------------*/
2150 /* tvsToKind :: [((VarId,Kind))] -> Kinds */
2151 static Kinds tvsToKind(tvs)
2152 List tvs; { /* [((VarId,Kind))] */
2155 for (rs=reverse(tvs); nonNull(rs); rs=tl(rs)) {
2156 if (whatIs(hd(rs)) != ZTUP2) internal("tvsToKind(1)");
2157 if (whatIs(zfst(hd(rs))) != VARIDCELL) internal("tvsToKind(2)");
2158 r = ap(zsnd(hd(rs)),r);
2164 static Int arityInclDictParams ( Type type )
2167 if (isPolyType(type)) type = monotypeOf(type);
2169 if (whatIs(type) == QUAL)
2171 arity += length ( fst(snd(type)) );
2172 type = snd(snd(type));
2174 while (isAp(type) && getHead(type)==typeArrow) {
2181 /* arity of a constructor with this type */
2182 static Int arityFromType(type)
2185 if (isPolyType(type)) {
2186 type = monotypeOf(type);
2188 if (whatIs(type) == QUAL) {
2189 type = snd(snd(type));
2191 if (whatIs(type) == EXIST) {
2192 type = snd(snd(type));
2194 if (whatIs(type)==RANK2) {
2195 type = snd(snd(type));
2197 while (isAp(type) && getHead(type)==typeArrow) {
2205 /* ifTyvarsIn :: Type -> [VarId]
2206 The returned list has no duplicates -- is a set.
2208 static List ifTyvarsIn(type)
2210 List vs = typeVarsIn(type,NIL,NIL,NIL);
2212 for (; nonNull(vs2); vs2=tl(vs2))
2213 if (whatIs(hd(vs2)) != VARIDCELL)
2214 internal("ifTyvarsIn");
2220 /* --------------------------------------------------------------------------
2221 * General object symbol query stuff
2222 * ------------------------------------------------------------------------*/
2224 #define EXTERN_SYMS \
2225 Sym(stg_gc_enter_1) \
2226 Sym(stg_gc_noregs) \
2234 Sym(stg_update_PAP) \
2235 Sym(stg_error_entry) \
2236 Sym(__ap_2_upd_info) \
2237 Sym(__ap_3_upd_info) \
2238 Sym(__ap_4_upd_info) \
2239 Sym(__ap_5_upd_info) \
2240 Sym(__ap_6_upd_info) \
2241 Sym(__sel_0_upd_info) \
2242 Sym(__sel_1_upd_info) \
2243 Sym(__sel_2_upd_info) \
2244 Sym(__sel_3_upd_info) \
2245 Sym(__sel_4_upd_info) \
2246 Sym(__sel_5_upd_info) \
2247 Sym(__sel_6_upd_info) \
2248 Sym(__sel_7_upd_info) \
2249 Sym(__sel_8_upd_info) \
2250 Sym(__sel_9_upd_info) \
2251 Sym(__sel_10_upd_info) \
2252 Sym(__sel_11_upd_info) \
2253 Sym(__sel_12_upd_info) \
2255 Sym(Upd_frame_info) \
2256 Sym(seq_frame_info) \
2257 Sym(CAF_BLACKHOLE_info) \
2258 Sym(IND_STATIC_info) \
2259 Sym(EMPTY_MVAR_info) \
2260 Sym(MUT_ARR_PTRS_FROZEN_info) \
2262 Sym(putMVarzh_fast) \
2263 Sym(newMVarzh_fast) \
2264 Sym(takeMVarzh_fast) \
2269 Sym(killThreadzh_fast) \
2270 Sym(waitReadzh_fast) \
2271 Sym(waitWritezh_fast) \
2272 Sym(CHARLIKE_closure) \
2273 Sym(INTLIKE_closure) \
2274 Sym(suspendThread) \
2276 Sym(stackOverflow) \
2277 Sym(int2Integerzh_fast) \
2278 Sym(stg_gc_unbx_r1) \
2280 Sym(makeForeignObjzh_fast) \
2281 Sym(__encodeDouble) \
2282 Sym(decodeDoublezh_fast) \
2284 Sym(isDoubleInfinite) \
2285 Sym(isDoubleDenormalized) \
2286 Sym(isDoubleNegativeZero) \
2287 Sym(__encodeFloat) \
2288 Sym(decodeFloatzh_fast) \
2290 Sym(isFloatInfinite) \
2291 Sym(isFloatDenormalized) \
2292 Sym(isFloatNegativeZero) \
2293 Sym(__int_encodeFloat) \
2294 Sym(__int_encodeDouble) \
2298 Sym(gcdIntegerzh_fast) \
2299 Sym(newArrayzh_fast) \
2300 Sym(unsafeThawArrayzh_fast) \
2301 Sym(newDoubleArrayzh_fast) \
2302 Sym(newFloatArrayzh_fast) \
2303 Sym(newAddrArrayzh_fast) \
2304 Sym(newWordArrayzh_fast) \
2305 Sym(newIntArrayzh_fast) \
2306 Sym(newCharArrayzh_fast) \
2307 Sym(newMutVarzh_fast) \
2308 Sym(quotRemIntegerzh_fast) \
2309 Sym(quotIntegerzh_fast) \
2310 Sym(remIntegerzh_fast) \
2311 Sym(divExactIntegerzh_fast) \
2312 Sym(divModIntegerzh_fast) \
2313 Sym(timesIntegerzh_fast) \
2314 Sym(minusIntegerzh_fast) \
2315 Sym(plusIntegerzh_fast) \
2316 Sym(addr2Integerzh_fast) \
2317 Sym(mkWeakzh_fast) \
2320 Sym(resetNonBlockingFd) \
2322 /* needed by libHS_cbits */ \
2324 Sym(__errno_location) \
2376 /* entirely bogus claims about types of these symbols */
2377 #define Sym(vvv) extern int vvv;
2378 #define SymX(vvv) /* nothing */
2383 #define Sym(vvv) { #vvv, &vvv },
2384 #define SymX(vvv) { #vvv, &vvv },
2393 void* lookupObjName ( char* nm )
2403 strncpy(nm2,nm,200);
2405 /* first see if it's an RTS name */
2406 for (k = 0; rtsTab[k].nm; k++)
2407 if (0==strcmp(nm2,rtsTab[k].nm))
2408 return rtsTab[k].ad;
2410 /* perhaps an extra-symbol ? */
2411 a = lookupOExtraTabName ( nm );
2414 /* if not an RTS name, look in the
2415 relevant module's object symbol table
2417 pp = strchr(nm2, '_');
2418 if (!pp || !isupper(nm2[0])) goto not_found;
2420 t = unZcodeThenFindText(nm2);
2422 if (isNull(m)) goto not_found;
2424 a = lookupOTabName ( m, nm ); /* RATIONALISE */
2429 "lookupObjName: can't resolve name `%s'\n",
2436 int is_dynamically_loaded_code_or_rodata_ptr ( char* p )
2438 OSectionKind sk = lookupSection(p);
2439 assert (sk != HUGS_SECTIONKIND_NOINFOAVAIL);
2440 return (sk == HUGS_SECTIONKIND_CODE_OR_RODATA);
2444 int is_dynamically_loaded_rwdata_ptr ( char* p )
2446 OSectionKind sk = lookupSection(p);
2447 assert (sk != HUGS_SECTIONKIND_NOINFOAVAIL);
2448 return (sk == HUGS_SECTIONKIND_RWDATA);
2452 int is_not_dynamically_loaded_ptr ( char* p )
2454 OSectionKind sk = lookupSection(p);
2455 assert (sk != HUGS_SECTIONKIND_NOINFOAVAIL);
2456 return (sk == HUGS_SECTIONKIND_OTHER);
2460 /* --------------------------------------------------------------------------
2462 * ------------------------------------------------------------------------*/
2464 Void interface(what)
2467 case POSTPREL: break;
2471 ifaces_outstanding = NIL;
2474 mark(ifaces_outstanding);
2479 /*-------------------------------------------------------------------------*/