ghc/interpreter/interface.c

   1
   2 /* --------------------------------------------------------------------------
   3  * GHC interface file processing for Hugs
   4  *
   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
   8  *
   9  * $RCSfile: interface.c,v $
  10  * $Revision: 1.27 $
  11  * $Date: 2000/02/04 13:41:00 $
  12  * ------------------------------------------------------------------------*/
  13
  14 #include "prelude.h"
  15 #include "storage.h"
  16 #include "backend.h"
  17 #include "connect.h"
  18 #include "errors.h"
  19 #include "link.h"
  20 #include "Assembler.h"  /* for wrapping GHC objects */
  21 #include "object.h"
  22
  23
  24 #define DEBUG_IFACE
  25 #define VERBOSE FALSE
  26
  27 extern void print ( Cell, Int );
  28
  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.
  34  *
  35  * The main trick here is how we deal with mutually recursive interface
  36  * files:
  37  *
  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).
  40  *
  41  * o Processing of declarations is split into two phases:
  42  *
  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.
  46  *
  47  *      This is done by the "addGHC*" functions.
  48  *
  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.
  52  *
  53  *      This is done by the "finishGHC*" functions which use the
  54  *      "fixup*" functions to assist them.
  55  *
  56  *   The interface between these two phases are the "ghc*Decls" which
  57  *   contain lists of decls that haven't been completed yet.
  58  *
  59  * ------------------------------------------------------------------------*/
  60
  61
  62 /*
  63 New comment, 991216, explaining roughly how it all works.
  64 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  65
  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:
  70
  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
  74     steps 1 .. 8 below.
  75
  76 1.  Throw away any entity not mentioned in the export lists.
  77
  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.
  83
  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.
  88
  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.
  93
  94     After step 4, the interfaces no longer contain anything
  95     unpalatable to Hugs.
  96
  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.
 101
 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*
 106     functions.
 107
 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.
 112
 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.
 118 */
 119
 120 /* --------------------------------------------------------------------------
 121  * local function prototypes:
 122  * ------------------------------------------------------------------------*/
 123
 124 static Void startGHCValue       Args((Int,VarId,Type));
 125 static Void finishGHCValue      Args((VarId));
 126
 127 static Void startGHCSynonym     Args((Int,Cell,List,Type));
 128 static Void finishGHCSynonym    Args((Tycon));
 129
 130 static Void  startGHCClass      Args((Int,List,Cell,List,List));
 131 static Class finishGHCClass     Args((Class));
 132
 133 static Inst startGHCInstance    Args((Int,List,Pair,VarId));
 134 static Void finishGHCInstance   Args((Inst));
 135
 136 static Void startGHCImports     Args((ConId,List));
 137 static Void finishGHCImports    Args((ConId,List));
 138
 139 static Void startGHCExports     Args((ConId,List));
 140 static Void finishGHCExports    Args((ConId,List));
 141
 142 static Void finishGHCModule     Args((Cell));
 143 static Void startGHCModule      Args((Text, Int, Text));
 144
 145 static Void startGHCDataDecl    Args((Int,List,Cell,List,List));
 146 static Void finishGHCDataDecl   ( ConId tyc );
 147
 148 static Void startGHCNewType     Args((Int,List,Cell,List,Cell));
 149 static Void finishGHCNewType    ( ConId tyc );
 150
 151
 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));
 156
 157
 158
 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 );
 163
 164 static List       ifTyvarsIn       Args((Type));
 165
 166 static Type       tvsToOffsets       Args((Int,Type,List));
 167 static Type       conidcellsToTycons Args((Int,Type));
 168
 169 static void*      lookupObjName ( char* );
 170
 171
 172
 173
 174
 175 /* --------------------------------------------------------------------------
 176  * Top-level interface processing
 177  * ------------------------------------------------------------------------*/
 178
 179 /* getIEntityName :: I_IMPORT..I_VALUE -> ConVarId | NIL */
 180 ConVarId getIEntityName ( Cell c )
 181 {
 182    switch (whatIs(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");
 194    }
 195 }
 196
 197
 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
 204    in the export lists.
 205 */
 206 Cell filterInterface ( Cell root,
 207                        Bool (*pred)(Cell,Cell),
 208                        Cell extraArgs,
 209                        Void (*dumpAction)(Cell) )
 210 {
 211    List tops;
 212    Cell iface       = unap(I_INTERFACE,root);
 213    List tops2       = NIL;
 214    List deleted_ids = NIL; /* :: [ConVarId] */
 215
 216    for (tops = zsnd(iface); nonNull(tops); tops=tl(tops)) {
 217       if (pred(hd(tops),extraArgs)) {
 218          tops2 = cons( hd(tops), tops2 );
 219       } else {
 220          ConVarId deleted_id = getIEntityName ( hd(tops) );
 221          if (nonNull(deleted_id))
 222             deleted_ids = cons ( deleted_id, deleted_ids );
 223          if (dumpAction)
 224             dumpAction ( hd(tops) );
 225       }
 226    }
 227    tops2 = reverse(tops2);
 228
 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);
 234          List exlist2 = NIL;
 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);
 241          }
 242          hd(tops) = ap(I_EXPORT,zpair(zfst(exdecl),exlist2));
 243       }
 244    }
 245
 246    return ap(I_INTERFACE, zpair(zfst(iface),tops2));
 247 }
 248
 249
 250 ZPair readInterface(String fname, Long fileSize)
 251 {
 252     List  tops;
 253     List  imports = NIL;
 254     ZPair iface   = parseInterface(fname,fileSize);
 255     assert (whatIs(iface)==I_INTERFACE);
 256
 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))); */
 264           }
 265        }
 266     return zpair(iface,imports);
 267 }
 268
 269
 270 /* getExportDeclsInIFace :: I_INTERFACE -> [I_EXPORT] */
 271 static List getExportDeclsInIFace ( Cell root )
 272 {
 273    Cell  iface   = unap(I_INTERFACE,root);
 274    List  decls   = zsnd(iface);
 275    List  exports = NIL;
 276    List  ds;
 277    for (ds=decls; nonNull(ds); ds=tl(ds))
 278       if (whatIs(hd(ds))==I_EXPORT)
 279          exports = cons(hd(ds), exports);
 280    return exports;
 281 }
 282
 283
 284
 285 static Bool isExportedIFaceEntity ( Cell ife, List exlist_list )
 286 {
 287    /* ife         :: I_IMPORT..I_VALUE                      */
 288    /* exlist_list :: [[ ConVarId | ((ConId, [ConVarId])) ]] */
 289    Text  tnm;
 290    List  exlist;
 291    List  t;
 292
 293    ConVarId ife_id = getIEntityName ( ife );
 294
 295    if (isNull(ife_id)) return TRUE;
 296
 297    tnm = textOf(ife_id);
 298
 299    /* for each export list ... */
 300    for (; nonNull(exlist_list); exlist_list=tl(exlist_list)) {
 301       exlist = hd(exlist_list);
 302
 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;
 311          } else {
 312             /* Single name in the list. */
 313             if (textOf(hd(t)) == tnm) goto retain;
 314          }
 315       }
 316
 317    }
 318    fprintf ( stderr, "     dump %s\n", textToStr(tnm) );
 319    return FALSE;
 320
 321  retain:
 322    fprintf ( stderr, "   retain %s\n", textToStr(tnm) );
 323    return TRUE;
 324 }
 325
 326
 327 static Bool isExportedAbstractly ( ConId ife_id, List exlist_list )
 328 {
 329    /* ife_id      :: ConId                                  */
 330    /* exlist_list :: [[ ConVarId | ((ConId, [ConVarId])) ]] */
 331    Text  tnm;
 332    List  exlist;
 333    List  t;
 334
 335    assert (isCon(ife_id));
 336    tnm = textOf(ife_id);
 337
 338    /* for each export list ... */
 339    for (; nonNull(exlist_list); exlist_list=tl(exlist_list)) {
 340       exlist = hd(exlist_list);
 341
 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;
 348          } else {
 349             if (textOf(hd(t)) == tnm) return TRUE;
 350          }
 351       }
 352    }
 353    internal("isExportedAbstractly");
 354    return FALSE; /*notreached*/
 355 }
 356
 357
 358 /* Remove entities not mentioned in any of the export lists. */
 359 static Cell deleteUnexportedIFaceEntities ( Cell root )
 360 {
 361    Cell  iface       = unap(I_INTERFACE,root);
 362    ConId iname       = zfst(iface);
 363    List  decls       = zsnd(iface);
 364    List  decls2      = NIL;
 365    List  exlist_list = NIL;
 366    List  t;
 367
 368    fprintf(stderr, "\ncleanIFace: %s\n", textToStr(textOf(iname)));
 369
 370    exlist_list = getExportDeclsInIFace ( root );
 371    /* exlist_list :: [I_EXPORT] */
 372
 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])) ]] */
 376
 377    if (isNull(exlist_list)) {
 378       ERRMSG(0) "Can't find any export lists in interface file"
 379       EEND;
 380    }
 381
 382    return filterInterface ( root, isExportedIFaceEntity,
 383                             exlist_list, NULL );
 384 }
 385
 386
 387 /* addTyconsAndClassesFromIFace :: I_INTERFACE -> [QualId] -> [QualId] */
 388 List addTyconsAndClassesFromIFace ( Cell root, List aktys )
 389 {
 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 );
 401       }
 402    }
 403    return aktys;
 404 }
 405
 406
 407 Void ifentityAllTypesKnown_dumpmsg ( Cell entity )
 408 {
 409    ConVarId id = getIEntityName ( entity );
 410    fprintf ( stderr,
 411              "dumping %s because of unknown type(s)\n",
 412              isNull(id) ? "(nameless entity?!)" : textToStr(textOf(id)) );
 413 }
 414
 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.
 419 */
 420 Bool ifentityAllTypesKnown ( Cell entity, ZPair aktys_mod )
 421 {
 422    List  t, u;
 423    List  aktys = zfst ( aktys_mod );
 424    ConId mod   = zsnd ( aktys_mod );
 425    switch (whatIs(entity)) {
 426       case I_IMPORT:
 427       case I_INSTIMPORT:
 428       case I_EXPORT:
 429       case I_FIXDECL:
 430          return TRUE;
 431       case I_INSTANCE: {
 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;
 438          return TRUE;
 439       }
 440       case I_TYPE:
 441          return allTypesKnown( zsel44(unap(I_TYPE,entity)), aktys,mod );
 442       case I_DATA: {
 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;
 451          return TRUE;
 452       }
 453       case I_NEWTYPE: {
 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;
 459          if (nonNull(constr)
 460              && !allTypesKnown(zsnd(constr),aktys,mod)) return FALSE;
 461          return TRUE;
 462       }
 463       case I_CLASS: {
 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;
 471          return TRUE;
 472       }
 473       case I_VALUE:
 474          return allTypesKnown( zthd3(unap(I_VALUE,entity)), aktys,mod );
 475       default:
 476          internal("ifentityAllTypesKnown");
 477    }
 478 }
 479
 480
 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.
 485 */
 486 Bool ifTypeDoesntRefUnknownTycon ( Cell entity, ZPair aktys_mod )
 487 {
 488    List  t, u;
 489    List  aktys = zfst ( aktys_mod );
 490    ConId mod   = zsnd ( aktys_mod );
 491    if (whatIs(entity) != I_TYPE) {
 492       return TRUE;
 493    } else {
 494       return allTypesKnown( zsel44(unap(I_TYPE,entity)), aktys,mod );
 495    }
 496 }
 497
 498 Void ifTypeDoesntRefUnknownTycon_dumpmsg ( Cell entity )
 499 {
 500    ConVarId id = getIEntityName ( entity );
 501    assert (whatIs(entity)==I_TYPE);
 502    assert (isCon(id));
 503    fprintf ( stderr,
 504              "dumping type %s because of unknown tycon(s)\n",
 505              textToStr(textOf(id)) );
 506 }
 507
 508
 509 /* abstractifyExport :: I_EXPORT -> ConId -> I_EXPORT
 510 */
 511 List abstractifyExDecl ( Cell root, ConId toabs )
 512 {
 513    ZPair exdecl = unap(I_EXPORT,root);
 514    List  exlist = zsnd(exdecl);
 515    List  res    = NIL;
 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 );
 521       } else {
 522          res = cons ( hd(exlist), res );
 523       }
 524    }
 525    return ap(I_EXPORT,zpair(zfst(exdecl),reverse(res)));
 526 }
 527
 528
 529 Void ppModule ( Text modt )
 530 {
 531    fflush(stderr); fflush(stdout);
 532    fprintf(stderr, "---------------- MODULE %s ----------------\n",
 533                    textToStr(modt) );
 534 }
 535
 536
 537 /* ifaces_outstanding holds a list of parsed interfaces
 538    for which we need to load objects and create symbol
 539    table entries.
 540
 541    Return TRUE if Prelude `elem` ifaces_outstanding, else FALSE.
 542 */
 543 Bool processInterfaces ( void )
 544 {
 545     List    tmp;
 546     List    xs;
 547     ZTriple tr;
 548     Cell    iface;
 549     Int     sizeObj;
 550     Text    nameObj;
 551     Text    mname;
 552     List    decls;
 553     Module  mod;
 554     List    all_known_types;
 555     Int     num_known_types;
 556     Bool    didPrelude;
 557     List    cls_list;
 558
 559     List ifaces       = NIL;  /* :: List I_INTERFACE */
 560     List iface_sizes  = NIL;  /* :: List Int         */
 561     List iface_onames = NIL;  /* :: List Text        */
 562
 563     if (isNull(ifaces_outstanding)) return FALSE;
 564
 565     fprintf ( stderr,
 566               "processInterfaces: %d interfaces to process\n",
 567               length(ifaces_outstanding) );
 568
 569     /* unzip3 ifaces_outstanding into ifaces, iface_sizes, iface_onames */
 570     for (xs = ifaces_outstanding; nonNull(xs); xs=tl(xs)) {
 571        ifaces       = cons ( zfst3(hd(xs)), ifaces       );
 572        iface_onames = cons ( zsnd3(hd(xs)), iface_onames );
 573        iface_sizes  = cons ( zthd3(hd(xs)), iface_sizes  );
 574     }
 575
 576     ifaces       = reverse(ifaces);
 577     iface_onames = reverse(iface_onames);
 578     iface_sizes  = reverse(iface_sizes);
 579
 580     /* Clean up interfaces -- dump non-exported value, class, type decls */
 581     for (xs = ifaces; nonNull(xs); xs = tl(xs))
 582        hd(xs) = deleteUnexportedIFaceEntities(hd(xs));
 583
 584
 585     /* Iteratively delete any type declarations which refer to unknown
 586        tycons.
 587     */
 588     num_known_types = 999999999;
 589     while (TRUE) {
 590        Int i;
 591
 592        /* Construct a list of all known tycons.  This is a list of QualIds.
 593           Unfortunately it also has to contain all known class names, since
 594           allTypesKnown cannot distinguish between tycons and classes -- a
 595           deficiency of the iface abs syntax.
 596        */
 597        all_known_types = getAllKnownTyconsAndClasses();
 598        for (xs = ifaces; nonNull(xs); xs=tl(xs))
 599           all_known_types = addTyconsAndClassesFromIFace ( hd(xs), all_known_types );
 600
 601        /* Have we reached a fixed point? */
 602        i = length(all_known_types);
 603        printf ( "\n============= %d known types =============\n", i );
 604        if (num_known_types == i) break;
 605        num_known_types = i;
 606
 607        /* Delete all entities which refer to unknown tycons. */
 608        for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
 609           ConId mod = zfst(unap(I_INTERFACE,hd(xs)));
 610           assert(nonNull(mod));
 611           hd(xs) = filterInterface ( hd(xs),
 612                                      ifTypeDoesntRefUnknownTycon,
 613                                      zpair(all_known_types,mod),
 614                                      ifTypeDoesntRefUnknownTycon_dumpmsg );
 615        }
 616     }
 617
 618     /* Now abstractify any datas and newtypes which refer to unknown tycons
 619        -- including, of course, the type decls just deleted.
 620     */
 621     for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
 622        List  absify = NIL;                      /* :: [ConId] */
 623        ZPair iface  = unap(I_INTERFACE,hd(xs)); /* ((ConId, [I_IMPORT..I_VALUE])) */
 624        ConId mod    = zfst(iface);
 625        List  aktys  = all_known_types;          /* just a renaming */
 626        List  es,t,u;
 627        List  exlist_list;
 628
 629        /* Compute into absify the list of all ConIds (tycons) we need to
 630           abstractify.
 631        */
 632        for (es = zsnd(iface); nonNull(es); es=tl(es)) {
 633           Cell ent      = hd(es);
 634           Bool allKnown = TRUE;
 635
 636           if (whatIs(ent)==I_DATA) {
 637              Cell data    = unap(I_DATA,ent);
 638              List ctx     = zsel25 ( data ); /* :: [((QConId,VarId))] */
 639              List constrs = zsel55 ( data ); /* :: [ ((ConId, [((Type,VarId,Int))] )) ] */
 640              for (t = ctx; nonNull(t); t=tl(t))
 641                 if (!allTypesKnown(zfst(hd(t)),aktys,mod)) allKnown = FALSE;
 642              for (t = constrs; nonNull(t); t=tl(t))
 643                 for (u = zsnd(hd(t)); nonNull(u); u=tl(u))
 644                     if (!allTypesKnown(zfst3(hd(u)),aktys,mod)) allKnown = FALSE;
 645           }
 646           else if (whatIs(ent)==I_NEWTYPE) {
 647              Cell  newty  = unap(I_NEWTYPE,ent);
 648              List  ctx    = zsel25(newty);    /* :: [((QConId,VarId))] */
 649              ZPair constr = zsel55 ( newty ); /* :: ((ConId,Type)) */
 650              for (t = ctx; nonNull(t); t=tl(t))
 651                 if (!allTypesKnown(zfst(hd(t)),aktys,mod)) allKnown = FALSE;
 652              if (!allTypesKnown(zsnd(constr),aktys,mod)) allKnown = FALSE;
 653           }
 654
 655           if (!allKnown) {
 656              absify = cons ( getIEntityName(ent), absify );
 657              fprintf ( stderr,
 658                        "abstractifying %s because it uses an unknown type\n",
 659                        textToStr(textOf(getIEntityName(ent))) );
 660           }
 661        }
 662
 663        /* mark in exports as abstract all names in absify (modifies iface) */
 664        for (; nonNull(absify); absify=tl(absify)) {
 665           ConId toAbs = hd(absify);
 666           for (es = zsnd(iface); nonNull(es); es=tl(es)) {
 667              if (whatIs(hd(es)) != I_EXPORT) continue;
 668              hd(es) = abstractifyExDecl ( hd(es), toAbs );
 669           }
 670        }
 671
 672        /* For each data/newtype in the export list marked as abstract,
 673           remove the constructor lists.  This catches all abstractification
 674           caused by the code above, and it also catches tycons which really
 675           were exported abstractly.
 676        */
 677
 678        exlist_list = getExportDeclsInIFace ( ap(I_INTERFACE,iface) );
 679        /* exlist_list :: [I_EXPORT] */
 680        for (t=exlist_list; nonNull(t); t=tl(t))
 681           hd(t) = zsnd(unap(I_EXPORT,hd(t)));
 682        /* exlist_list :: [[ ConVarId | ((ConId, [ConVarId])) ]] */
 683
 684        for (es = zsnd(iface); nonNull(es); es=tl(es)) {
 685           Cell ent = hd(es);
 686           if (whatIs(ent)==I_DATA
 687               && isExportedAbstractly ( getIEntityName(ent),
 688                                         exlist_list )) {
 689              Cell data = unap(I_DATA,ent);
 690              data = z5ble ( zsel15(data), zsel25(data), zsel35(data),
 691                             zsel45(data), NIL /* the constr list */ );
 692              hd(es) = ap(I_DATA,data);
 693 fprintf(stderr, "abstractify data %s\n", textToStr(textOf(getIEntityName(ent))) );
 694           }
 695           else if (whatIs(ent)==I_NEWTYPE
 696               && isExportedAbstractly ( getIEntityName(ent),
 697                                         exlist_list )) {
 698              Cell data = unap(I_NEWTYPE,ent);
 699              data = z5ble ( zsel15(data), zsel25(data), zsel35(data),
 700                             zsel45(data), NIL /* the constr-type pair */ );
 701              hd(es) = ap(I_NEWTYPE,data);
 702 fprintf(stderr, "abstractify newtype %s\n", textToStr(textOf(getIEntityName(ent))) );
 703           }
 704        }
 705
 706        /* We've finally finished mashing this iface.  Update the iface list. */
 707        hd(xs) = ap(I_INTERFACE,iface);
 708     }
 709
 710
 711     /* At this point, the interfaces are cleaned up so that no type, data or
 712        newtype defn refers to a non-existant type.  However, there still may
 713        be value defns, classes and instances which refer to unknown types.
 714        Delete iteratively until a fixed point is reached.
 715     */
 716     printf("\n");
 717
 718     num_known_types = 999999999;
 719     while (TRUE) {
 720        Int i;
 721
 722        /* Construct a list of all known tycons.  This is a list of QualIds.
 723           Unfortunately it also has to contain all known class names, since
 724           allTypesKnown cannot distinguish between tycons and classes -- a
 725           deficiency of the iface abs syntax.
 726        */
 727        all_known_types = getAllKnownTyconsAndClasses();
 728        for (xs = ifaces; nonNull(xs); xs=tl(xs))
 729           all_known_types = addTyconsAndClassesFromIFace ( hd(xs), all_known_types );
 730
 731        /* Have we reached a fixed point? */
 732        i = length(all_known_types);
 733        printf ( "\n------------- %d known types -------------\n", i );
 734        if (num_known_types == i) break;
 735        num_known_types = i;
 736
 737        /* Delete all entities which refer to unknown tycons. */
 738        for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
 739           ConId mod = zfst(unap(I_INTERFACE,hd(xs)));
 740           assert(nonNull(mod));
 741
 742           hd(xs) = filterInterface ( hd(xs),
 743                                      ifentityAllTypesKnown,
 744                                      zpair(all_known_types,mod),
 745                                      ifentityAllTypesKnown_dumpmsg );
 746        }
 747     }
 748
 749
 750     /* Allocate module table entries and read in object code. */
 751     for (xs=ifaces;
 752          nonNull(xs);
 753          xs=tl(xs), iface_sizes=tl(iface_sizes), iface_onames=tl(iface_onames)) {
 754        startGHCModule ( textOf(zfst(unap(I_INTERFACE,hd(xs)))),
 755                         intOf(hd(iface_sizes)),
 756                         hd(iface_onames) );
 757     }
 758     assert (isNull(iface_sizes));
 759     assert (isNull(iface_onames));
 760
 761
 762     /* Now work through the decl lists of the modules, and call the
 763        startGHC* functions on the entities.  This creates names in
 764        various tables but doesn't bind them to anything.
 765     */
 766
 767     for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
 768        iface   = unap(I_INTERFACE,hd(xs));
 769        mname   = textOf(zfst(iface));
 770        mod     = findModule(mname);
 771        if (isNull(mod)) internal("processInterfaces(4)");
 772        setCurrModule(mod);
 773        ppModule ( module(mod).text );
 774
 775        for (decls = zsnd(iface); nonNull(decls); decls = tl(decls)) {
 776           Cell decl = hd(decls);
 777           switch(whatIs(decl)) {
 778              case I_EXPORT: {
 779                 Cell exdecl = unap(I_EXPORT,decl);
 780                 startGHCExports ( zfst(exdecl), zsnd(exdecl) );
 781                 break;
 782              }
 783              case I_IMPORT: {
 784                 Cell imdecl = unap(I_IMPORT,decl);
 785                 startGHCImports ( zfst(imdecl), zsnd(imdecl) );
 786                 break;
 787              }
 788              case I_FIXDECL: {
 789                 break;
 790              }
 791              case I_INSTANCE: {
 792                 /* Trying to find the instance table location allocated by
 793                    startGHCInstance in subsequent processing is a nightmare, so
 794                    cache it on the tree.
 795                 */
 796                 Cell instance = unap(I_INSTANCE,decl);
 797                 Inst in = startGHCInstance ( zsel15(instance), zsel25(instance),
 798                                              zsel35(instance), zsel45(instance) );
 799                 hd(decls) = ap(I_INSTANCE,
 800                                z5ble( zsel15(instance), zsel25(instance),
 801                                       zsel35(instance), zsel45(instance), in ));
 802                 break;
 803              }
 804              case I_TYPE: {
 805                 Cell tydecl = unap(I_TYPE,decl);
 806                 startGHCSynonym ( zsel14(tydecl), zsel24(tydecl),
 807                                   zsel34(tydecl), zsel44(tydecl) );
 808                 break;
 809              }
 810              case I_DATA: {
 811                 Cell ddecl = unap(I_DATA,decl);
 812                 startGHCDataDecl ( zsel15(ddecl), zsel25(ddecl),
 813                                    zsel35(ddecl), zsel45(ddecl), zsel55(ddecl) );
 814                 break;
 815              }
 816              case I_NEWTYPE: {
 817                 Cell ntdecl = unap(I_NEWTYPE,decl);
 818                 startGHCNewType ( zsel15(ntdecl), zsel25(ntdecl),
 819                                   zsel35(ntdecl), zsel45(ntdecl),
 820                                   zsel55(ntdecl) );
 821                 break;
 822              }
 823              case I_CLASS: {
 824                 Cell klass = unap(I_CLASS,decl);
 825                 startGHCClass ( zsel15(klass), zsel25(klass),
 826                                 zsel35(klass), zsel45(klass),
 827                                 zsel55(klass) );
 828                 break;
 829              }
 830              case I_VALUE: {
 831                 Cell value = unap(I_VALUE,decl);
 832                 startGHCValue ( zfst3(value), zsnd3(value), zthd3(value) );
 833                 break;
 834              }
 835              default:
 836                 internal("processInterfaces(1)");
 837           }
 838        }
 839     }
 840
 841     fprintf(stderr, "\n=========================================================\n");
 842     fprintf(stderr, "=========================================================\n");
 843
 844     /* Traverse again the decl lists of the modules, this time
 845        calling the finishGHC* functions.  But don't process
 846        the export lists; those must wait for later.
 847     */
 848     didPrelude = FALSE;
 849     cls_list   = NIL;
 850     for (xs = ifaces; nonNull(xs); xs = tl(xs)) {
 851        iface   = unap(I_INTERFACE,hd(xs));
 852        mname   = textOf(zfst(iface));
 853        mod     = findModule(mname);
 854        if (isNull(mod)) internal("processInterfaces(3)");
 855        setCurrModule(mod);
 856        ppModule ( module(mod).text );
 857
 858        if (mname == textPrelude) didPrelude = TRUE;
 859
 860        for (decls = zsnd(iface); nonNull(decls); decls = tl(decls)) {
 861           Cell decl = hd(decls);
 862           switch(whatIs(decl)) {
 863              case I_EXPORT: {
 864                 break;
 865              }
 866              case I_IMPORT: {
 867                 break;
 868              }
 869              case I_FIXDECL: {
 870                 break;
 871              }
 872              case I_INSTANCE: {
 873                 Cell instance = unap(I_INSTANCE,decl);
 874                 finishGHCInstance ( zsel55(instance) );
 875                 break;
 876              }
 877              case I_TYPE: {
 878                 Cell tydecl = unap(I_TYPE,decl);
 879                 finishGHCSynonym ( zsel24(tydecl) );
 880                 break;
 881              }
 882              case I_DATA: {
 883                 Cell ddecl = unap(I_DATA,decl);
 884                 finishGHCDataDecl ( zsel35(ddecl) );
 885                 break;
 886              }
 887              case I_NEWTYPE: {
 888                 Cell ntdecl = unap(I_NEWTYPE,decl);
 889                 finishGHCNewType ( zsel35(ntdecl) );
 890                 break;
 891              }
 892              case I_CLASS: {
 893                 Cell  klass = unap(I_CLASS,decl);
 894                 Class cls   = finishGHCClass ( zsel35(klass) );
 895                 cls_list = cons(cls,cls_list);
 896                 break;
 897              }
 898              case I_VALUE: {
 899                 Cell value = unap(I_VALUE,decl);
 900                 finishGHCValue ( zsnd3(value) );
 901                 break;
 902              }
 903              default:
 904                 internal("processInterfaces(2)");
 905           }
 906        }
 907     }
 908     fprintf(stderr, "\n+++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n");
 909     fprintf(stderr, "+++++++++++++++++++++++++++++++++++++++++++++++++++++++++\n");
 910
 911     /* Build the module(m).export lists for each module, by running
 912        through the export lists in the iface.  Also, do the implicit
 913        'import Prelude' thing.  And finally, do the object code
 914        linking.
 915     */
 916     for (xs = ifaces; nonNull(xs); xs = tl(xs))
 917        finishGHCModule(hd(xs));
 918
 919     mapProc(visitClass,cls_list);
 920
 921     /* Finished! */
 922     ifaces_outstanding = NIL;
 923
 924     return didPrelude;
 925 }
 926
 927
 928 /* --------------------------------------------------------------------------
 929  * Modules
 930  * ------------------------------------------------------------------------*/
 931
 932 void startGHCModule_errMsg ( char* msg )
 933 {
 934    fprintf ( stderr, "object error: %s\n", msg );
 935 }
 936
 937 void* startGHCModule_clientLookup ( char* sym )
 938 {
 939    /* fprintf ( stderr, "CLIENTLOOKUP %s\n", sym ); */
 940    return lookupObjName ( sym );
 941 }
 942
 943 ObjectCode* startGHCModule_partial_load ( String objNm, Int objSz )
 944 {
 945    ObjectCode* oc
 946       = ocNew ( startGHCModule_errMsg,
 947                 startGHCModule_clientLookup,
 948                 objNm, objSz );
 949
 950     if (!oc) {
 951        ERRMSG(0) "Storage allocation for object file \"%s\" failed", objNm
 952        EEND;
 953     }
 954     if (!ocLoadImage(oc,VERBOSE)) {
 955        ERRMSG(0) "Reading of object file \"%s\" failed", objNm
 956        EEND;
 957     }
 958     if (!ocVerifyImage(oc,VERBOSE)) {
 959        ERRMSG(0) "Validation of object file \"%s\" failed", objNm
 960        EEND;
 961     }
 962     if (!ocGetNames(oc,0||VERBOSE)) {
 963        ERRMSG(0) "Reading of symbol names in object file \"%s\" failed", objNm
 964        EEND;
 965     }
 966     return oc;
 967 }
 968
 969 Void startGHCModule ( Text mname, Int sizeObj, Text nameObj )
 970 {
 971    List   xts;
 972    Module m = findModule(mname);
 973
 974    if (isNull(m)) {
 975       m = newModule(mname);
 976       fprintf ( stderr, "startGHCIface: name %16s   objsize %d\n",
 977                          textToStr(mname), sizeObj );
 978    } else {
 979       if (module(m).fake) {
 980          module(m).fake = FALSE;
 981       } else {
 982          ERRMSG(0) "Module \"%s\" already loaded", textToStr(mname)
 983          EEND;
 984       }
 985    }
 986
 987    /* Get hold of the primary object for the module. */
 988    module(m).object
 989       = startGHCModule_partial_load ( textToStr(nameObj), sizeObj );
 990
 991    /* and any extras ... */
 992    for (xts = module(m).objectExtraNames; nonNull(xts); xts=tl(xts)) {
 993       Int         size;
 994       ObjectCode* oc;
 995       Text        xtt = hd(xts);
 996       String      nm  = getExtraObjectInfo ( textToStr(nameObj),
 997                                              textToStr(xtt),
 998                                              &size );
 999       if (size == -1) {
1000          ERRMSG(0) "Can't find extra object file \"%s\"", nm
1001          EEND;
1002       }
1003       oc = startGHCModule_partial_load ( nm, size );
1004       oc->next = module(m).objectExtras;
1005       module(m).objectExtras = oc;
1006    }
1007 }
1008
1009
1010 /* For the module mod, augment both the export environment (.exports)
1011    and the eval environment (.names, .tycons, .classes)
1012    with the symbols mentioned in exlist.  We don't actually need
1013    to modify the names, tycons, classes or instances in the eval
1014    environment, since previous processing of the
1015    top-level decls in the iface should have done this already.
1016
1017    mn is the module mentioned in the export list; it is the "original"
1018    module for the symbols in the export list.  We should also record
1019    this info with the symbols, since references to object code need to
1020    refer to the original module in which a symbol was defined, rather
1021    than to some module it has been imported into and then re-exported.
1022
1023    We take the policy that if something mentioned in an export list
1024    can't be found in the symbol tables, it is simply ignored.  After all,
1025    previous processing of the iface syntax trees has already removed
1026    everything which Hugs can't handle, so if there is mention of these
1027    things still lurking in export lists somewhere, about the only thing
1028    to do is to ignore it.
1029
1030    Also do an implicit 'import Prelude' thingy for the module,
1031    if appropriate.
1032 */
1033
1034
1035 Void finishGHCModule ( Cell root )
1036 {
1037    /* root :: I_INTERFACE */
1038    Cell        iface       = unap(I_INTERFACE,root);
1039    ConId       iname       = zfst(iface);
1040    Module      mod         = findModule(textOf(iname));
1041    List        exlist_list = NIL;
1042    List        t;
1043    ObjectCode* oc;
1044
1045    fprintf(stderr, "begin finishGHCModule %s\n", textToStr(textOf(iname)));
1046
1047    if (isNull(mod)) internal("finishExports(1)");
1048    setCurrModule(mod);
1049
1050    exlist_list = getExportDeclsInIFace ( root );
1051    /* exlist_list :: [I_EXPORT] */
1052
1053    for (; nonNull(exlist_list); exlist_list=tl(exlist_list)) {
1054       ZPair exdecl = unap(I_EXPORT,hd(exlist_list));
1055       ConId exmod  = zfst(exdecl);
1056       List  exlist = zsnd(exdecl);
1057       /* exlist :: [ ConVarId | ((ConId, [ConVarId])) ] */
1058
1059       for (; nonNull(exlist); exlist=tl(exlist)) {
1060          Bool   abstract;
1061          List   subents;
1062          Cell   c;
1063          QualId q;
1064          Cell   ex = hd(exlist);
1065
1066          switch (whatIs(ex)) {
1067
1068             case VARIDCELL: /* variable */
1069                q = mkQualId(exmod,ex);
1070                c = findQualNameWithoutConsultingExportList ( q );
1071                if (isNull(c)) goto notfound;
1072                fprintf(stderr, "   var %s\n", textToStr(textOf(ex)) );
1073                module(mod).exports = cons(c, module(mod).exports);
1074                addName(c);
1075                break;
1076
1077             case CONIDCELL: /* non data tycon */
1078                q = mkQualId(exmod,ex);
1079                c = findQualTyconWithoutConsultingExportList ( q );
1080                if (isNull(c)) goto notfound;
1081                fprintf(stderr, "   type %s\n", textToStr(textOf(ex)) );
1082                module(mod).exports = cons(pair(c,NIL), module(mod).exports);
1083                addTycon(c);
1084                break;
1085
1086             case ZTUP2: /* data T = C1 ... Cn  or class C where f1 ... fn */
1087                subents = zsnd(ex);  /* :: [ConVarId] */
1088                ex      = zfst(ex);  /* :: ConId */
1089                q       = mkQualId(exmod,ex);
1090                c       = findQualTyconWithoutConsultingExportList ( q );
1091
1092                if (nonNull(c)) { /* data */
1093                   fprintf(stderr, "   data/newtype %s = { ", textToStr(textOf(ex)) );
1094                   assert(tycon(c).what == DATATYPE || tycon(c).what==NEWTYPE);
1095                   abstract = isNull(tycon(c).defn);
1096                   /* This data/newtype could be abstract even tho the export list
1097                      says to export it non-abstractly.  That happens if it was
1098                      imported from some other module and is now being re-exported,
1099                      and previous cleanup phases have abstractified it in the
1100                      original (defining) module.
1101                   */
1102                   if (abstract) {
1103                      module(mod).exports = cons(pair(c,NIL), module(mod).exports);
1104                      addTycon(c);
1105                      fprintf ( stderr, "(abstract) ");
1106                   } else {
1107                      module(mod).exports = cons(pair(c,DOTDOT), module(mod).exports);
1108                      addTycon(c);
1109                      for (; nonNull(subents); subents = tl(subents)) {
1110                         Cell ent2 = hd(subents);
1111                         assert(isCon(ent2) || isVar(ent2));
1112                                               /* isVar since could be a field name */
1113                         q = mkQualId(exmod,ent2);
1114                         c = findQualNameWithoutConsultingExportList ( q );
1115                         fprintf(stderr, "%s ", textToStr(name(c).text));
1116                         assert(nonNull(c));
1117                         /* module(mod).exports = cons(c, module(mod).exports); */
1118                         addName(c);
1119                      }
1120                   }
1121                   fprintf(stderr, "}\n" );
1122                } else { /* class */
1123                   q = mkQualId(exmod,ex);
1124                   c = findQualClassWithoutConsultingExportList ( q );
1125                   if (isNull(c)) goto notfound;
1126                   fprintf(stderr, "   class %s { ", textToStr(textOf(ex)) );
1127                   module(mod).exports = cons(pair(c,DOTDOT), module(mod).exports);
1128                   addClass(c);
1129                   for (; nonNull(subents); subents = tl(subents)) {
1130                      Cell ent2 = hd(subents);
1131                      assert(isVar(ent2));
1132                      q = mkQualId(exmod,ent2);
1133                      c = findQualNameWithoutConsultingExportList ( q );
1134                      fprintf(stderr, "%s ", textToStr(name(c).text));
1135                      if (isNull(c)) goto notfound;
1136                      /* module(mod).exports = cons(c, module(mod).exports); */
1137                      addName(c);
1138                   }
1139                   fprintf(stderr, "}\n" );
1140                }
1141                break;
1142
1143             default:
1144                internal("finishExports(2)");
1145
1146          } /* switch */
1147          continue;  /* so notfound: can be placed after this */
1148
1149         notfound:
1150          /* q holds what ain't found */
1151          assert(whatIs(q)==QUALIDENT);
1152          fprintf( stderr, "   ------ IGNORED: %s.%s\n",
1153                   textToStr(qmodOf(q)), textToStr(qtextOf(q)) );
1154          continue;
1155       }
1156    }
1157
1158 #if 0
1159    if (preludeLoaded) {
1160       /* do the implicit 'import Prelude' thing */
1161       List pxs = module(modulePrelude).exports;
1162       for (; nonNull(pxs); pxs=tl(pxs)) {
1163          Cell px = hd(pxs);
1164          again:
1165          switch (whatIs(px)) {
1166             case AP:
1167                px = fst(px);
1168                goto again;
1169             case NAME:
1170                module(mod).names = cons ( px, module(mod).names );
1171                break;
1172             case TYCON:
1173                module(mod).tycons = cons ( px, module(mod).tycons );
1174                break;
1175             case CLASS:
1176                module(mod).classes = cons ( px, module(mod).classes );
1177                break;
1178             default:
1179                fprintf(stderr, "finishGHCModule: unknown tag %d\n", whatIs(px));
1180                internal("finishGHCModule -- implicit import Prelude");
1181                break;
1182          }
1183       }
1184    }
1185 #endif
1186
1187    /* Last, but by no means least ... */
1188    if (!ocResolve(module(mod).object,0||VERBOSE))
1189       internal("finishGHCModule: object resolution failed");
1190
1191    for (oc=module(mod).objectExtras; oc; oc=oc->next) {
1192       if (!ocResolve(oc, 0||VERBOSE))
1193          internal("finishGHCModule: extra object resolution failed");
1194    }
1195 }
1196
1197
1198 /* --------------------------------------------------------------------------
1199  * Exports
1200  * ------------------------------------------------------------------------*/
1201
1202 Void startGHCExports ( ConId mn, List exlist )
1203 {
1204 #   ifdef DEBUG_IFACE
1205     printf("startGHCExports %s\n", textToStr(textOf(mn)) );
1206 #   endif
1207    /* Nothing to do. */
1208 }
1209
1210 Void finishGHCExports ( ConId mn, List exlist )
1211 {
1212 #   ifdef DEBUG_IFACE
1213     printf("finishGHCExports %s\n", textToStr(textOf(mn)) );
1214 #   endif
1215    /* Nothing to do. */
1216 }
1217
1218
1219 /* --------------------------------------------------------------------------
1220  * Imports
1221  * ------------------------------------------------------------------------*/
1222
1223 Void startGHCImports ( ConId mn, List syms )
1224 /* nm     the module to import from */
1225 /* syms   [ConId | VarId] -- the names to import */
1226 {
1227 #  ifdef DEBUG_IFACE
1228    printf("startGHCImports %s\n", textToStr(textOf(mn)) );
1229 #  endif
1230    /* Nothing to do. */
1231 }
1232
1233
1234 Void finishGHCImports ( ConId nm, List syms )
1235 /* nm     the module to import from */
1236 /* syms   [ConId | VarId] -- the names to import */
1237 {
1238 #  ifdef DEBUG_IFACE
1239    printf("finishGHCImports %s\n", textToStr(textOf(nm)) );
1240 #  endif
1241   /* Nothing to do. */
1242 }
1243
1244
1245 /* --------------------------------------------------------------------------
1246  * Vars (values)
1247  * ------------------------------------------------------------------------*/
1248
1249 /* convert a leading run of DICTAPs into Hugs' internal Qualtype form, viz:
1250    { C1 a } -> { C2 b } -> T            into
1251    ap(QUALTYPE, ( [(C1,a),(C2,b)], T ))
1252 */
1253 static Type dictapsToQualtype ( Type ty )
1254 {
1255    List pieces = NIL;
1256    List preds, dictaps;
1257
1258    /* break ty into pieces at the top-level arrows */
1259    while (isAp(ty) && isAp(fun(ty)) && fun(fun(ty))==typeArrow) {
1260       pieces = cons ( arg(fun(ty)), pieces );
1261       ty     = arg(ty);
1262    }
1263    pieces = cons ( ty, pieces );
1264    pieces = reverse ( pieces );
1265
1266    dictaps = NIL;
1267    while (nonNull(pieces) && whatIs(hd(pieces))==DICTAP) {
1268       dictaps = cons ( hd(pieces), dictaps );
1269       pieces = tl(pieces);
1270    }
1271
1272    /* dictaps holds the predicates, backwards */
1273    /* pieces holds the remainder of the type, forwards */
1274    assert(nonNull(pieces));
1275    pieces = reverse(pieces);
1276    ty = hd(pieces);
1277    pieces = tl(pieces);
1278    for (; nonNull(pieces); pieces=tl(pieces))
1279       ty = fn(hd(pieces),ty);
1280
1281    preds = NIL;
1282    for (; nonNull(dictaps); dictaps=tl(dictaps)) {
1283       Cell da = hd(dictaps);
1284       QualId cl = fst(unap(DICTAP,da));
1285       Cell   arg = snd(unap(DICTAP,da));
1286       preds = cons ( pair(cl,arg), preds );
1287    }
1288
1289    if (nonNull(preds)) ty = ap(QUAL, pair(preds,ty));
1290    return ty;
1291 }
1292
1293
1294
1295 void startGHCValue ( Int line, VarId vid, Type ty )
1296 {
1297     Name   n;
1298     List   tmp, tvs;
1299     Text   v = textOf(vid);
1300
1301 #   ifdef DEBUG_IFACE
1302     printf("begin startGHCValue %s\n", textToStr(v));
1303 #   endif
1304
1305     n = findName(v);
1306     if (nonNull(n)) {
1307         ERRMSG(0) "Attempt to redefine variable \"%s\"", textToStr(v)
1308         EEND;
1309     }
1310     n = newName(v,NIL);
1311
1312     ty = dictapsToQualtype(ty);
1313
1314     tvs = ifTyvarsIn(ty);
1315     for (tmp=tvs; nonNull(tmp); tmp=tl(tmp))
1316        hd(tmp) = zpair(hd(tmp),STAR);
1317     if (nonNull(tvs))
1318        ty = mkPolyType(tvsToKind(tvs),ty);
1319
1320     ty = tvsToOffsets(line,ty,tvs);
1321     name(n).type  = ty;
1322     name(n).arity = arityInclDictParams(ty);
1323     name(n).line  = line;
1324 }
1325
1326
1327 void finishGHCValue ( VarId vid )
1328 {
1329     Name n    = findName ( textOf(vid) );
1330     Int  line = name(n).line;
1331 #   ifdef DEBUG_IFACE
1332     fprintf(stderr, "begin finishGHCValue %s\n", textToStr(name(n).text) );
1333 #   endif
1334     assert(currentModule == name(n).mod);
1335     name(n).type = conidcellsToTycons(line,name(n).type);
1336 }
1337
1338
1339 /* --------------------------------------------------------------------------
1340  * Type synonyms
1341  * ------------------------------------------------------------------------*/
1342
1343 Void startGHCSynonym ( Int line, ConId tycon, List tvs, Type ty )
1344 {
1345     /* tycon :: ConId             */
1346     /* tvs   ::  [((VarId,Kind))] */
1347     /* ty    :: Type              */
1348     Text t = textOf(tycon);
1349 #   ifdef DEBUG_IFACE
1350     fprintf(stderr, "begin startGHCSynonym %s\n", textToStr(t) );
1351 #   endif
1352     if (nonNull(findTycon(t))) {
1353         ERRMSG(line) "Repeated definition of type constructor \"%s\"",
1354                      textToStr(t)
1355         EEND;
1356     } else {
1357         Tycon tc        = newTycon(t);
1358         tycon(tc).line  = line;
1359         tycon(tc).arity = length(tvs);
1360         tycon(tc).what  = SYNONYM;
1361         tycon(tc).kind  = tvsToKind(tvs);
1362
1363         /* prepare for finishGHCSynonym */
1364         tycon(tc).defn  = tvsToOffsets(line,ty,tvs);
1365     }
1366 }
1367
1368
1369 static Void  finishGHCSynonym ( ConId tyc )
1370 {
1371     Tycon tc   = findTycon(textOf(tyc));
1372     Int   line = tycon(tc).line;
1373 #   ifdef DEBUG_IFACE
1374     fprintf(stderr, "begin finishGHCSynonym %s\n", textToStr(textOf(tyc)) );
1375 #   endif
1376
1377     assert (currentModule == tycon(tc).mod);
1378     //    setCurrModule(tycon(tc).mod);
1379     tycon(tc).defn = conidcellsToTycons(line,tycon(tc).defn);
1380
1381     /* (ADR) ToDo: can't really do this until I've done all synonyms
1382      * and then I have to do them in order
1383      * tycon(tc).defn = fullExpand(ty);
1384      * (JRS) What?!?!  i don't understand
1385      */
1386 }
1387
1388
1389 /* --------------------------------------------------------------------------
1390  * Data declarations
1391  * ------------------------------------------------------------------------*/
1392
1393 Void startGHCDataDecl(line,ctx0,tycon,ktyvars,constrs0)
1394 Int   line;
1395 List  ctx0;      /* [((QConId,VarId))]                */
1396 Cell  tycon;     /* ConId                             */
1397 List  ktyvars;   /* [((VarId,Kind))]                  */
1398 List  constrs0;  /* [((ConId,[((Type,VarId,Int))]))]  */
1399                  /* The Text is an optional field name
1400                     The Int indicates strictness */
1401     /* ToDo: worry about being given a decl for (->) ?
1402      * and worry about qualidents for ()
1403      */
1404 {
1405     Type    ty, resTy, selTy, conArgTy;
1406     List    tmp, conArgs, sels, constrs, fields, tyvarsMentioned;
1407     List    ctx, ctx2;
1408     Triple  constr;
1409     Cell    conid;
1410     Pair    conArg, ctxElem;
1411     Text    conArgNm;
1412     Int     conArgStrictness;
1413
1414     Text t = textOf(tycon);
1415 #   ifdef DEBUG_IFACE
1416     fprintf(stderr, "begin startGHCDataDecl %s\n",textToStr(t));
1417 #   endif
1418
1419     if (nonNull(findTycon(t))) {
1420         ERRMSG(line) "Repeated definition of type constructor \"%s\"",
1421                      textToStr(t)
1422         EEND;
1423     } else {
1424         Tycon tc        = newTycon(t);
1425         tycon(tc).text  = t;
1426         tycon(tc).line  = line;
1427         tycon(tc).arity = length(ktyvars);
1428         tycon(tc).kind  = tvsToKind(ktyvars);
1429         tycon(tc).what  = DATATYPE;
1430
1431         /* a list to accumulate selectors in :: [((VarId,Type))] */
1432         sels = NIL;
1433
1434         /* make resTy the result type of the constr, T v1 ... vn */
1435         resTy = tycon;
1436         for (tmp=ktyvars; nonNull(tmp); tmp=tl(tmp))
1437            resTy = ap(resTy,zfst(hd(tmp)));
1438
1439         /* for each constructor ... */
1440         for (constrs=constrs0; nonNull(constrs); constrs=tl(constrs)) {
1441            constr = hd(constrs);
1442            conid  = zfst(constr);
1443            fields = zsnd(constr);
1444
1445            /* Build type of constr and handle any selectors found.
1446               Also collect up tyvars occurring in the constr's arg
1447               types, so we can throw away irrelevant parts of the
1448               context later.
1449            */
1450            ty = resTy;
1451            tyvarsMentioned = NIL;
1452            /* tyvarsMentioned :: [VarId] */
1453
1454            conArgs = reverse(fields);
1455            for (; nonNull(conArgs); conArgs=tl(conArgs)) {
1456               conArg           = hd(conArgs); /* (Type,Text) */
1457               conArgTy         = zfst3(conArg);
1458               conArgNm         = zsnd3(conArg);
1459               conArgStrictness = intOf(zthd3(conArg));
1460               tyvarsMentioned = dupListOnto(ifTyvarsIn(conArgTy),
1461                                             tyvarsMentioned);
1462               if (conArgStrictness > 0) conArgTy = bang(conArgTy);
1463               ty = fn(conArgTy,ty);
1464               if (nonNull(conArgNm)) {
1465                  /* a field name is mentioned too */
1466                  selTy = fn(resTy,conArgTy);
1467                  if (whatIs(tycon(tc).kind) != STAR)
1468                     selTy = pair(POLYTYPE,pair(tycon(tc).kind, selTy));
1469                  selTy = tvsToOffsets(line,selTy, ktyvars);
1470                  sels = cons( zpair(conArgNm,selTy), sels);
1471               }
1472            }
1473
1474            /* Now ty is the constructor's type, not including context.
1475               Throw away any parts of the context not mentioned in
1476               tyvarsMentioned, and use it to qualify ty.
1477            */
1478            ctx2 = NIL;
1479            for (ctx=ctx0; nonNull(ctx); ctx=tl(ctx)) {
1480               ctxElem = hd(ctx);
1481               /* ctxElem :: ((QConId,VarId)) */
1482               if (nonNull(cellIsMember(textOf(zsnd(ctxElem)),tyvarsMentioned)))
1483                  ctx2 = cons(ctxElem, ctx2);
1484            }
1485            if (nonNull(ctx2))
1486               ty = ap(QUAL,pair(ctx2,ty));
1487
1488            /* stick the tycon's kind on, if not simply STAR */
1489            if (whatIs(tycon(tc).kind) != STAR)
1490               ty = pair(POLYTYPE,pair(tycon(tc).kind, ty));
1491
1492            ty = tvsToOffsets(line,ty, ktyvars);
1493
1494            /* Finally, stick the constructor's type onto it. */
1495            hd(constrs) = ztriple(conid,fields,ty);
1496         }
1497
1498         /* Final result is that
1499            constrs :: [((ConId,[((Type,Text))],Type))]
1500                       lists the constructors and their types
1501            sels :: [((VarId,Type))]
1502                    lists the selectors and their types
1503         */
1504         tycon(tc).defn = startGHCConstrs(line,constrs0,sels);
1505     }
1506 }
1507
1508
1509 static List startGHCConstrs ( Int line, List cons, List sels )
1510 {
1511     /* cons :: [((ConId,[((Type,Text,Int))],Type))] */
1512     /* sels :: [((VarId,Type))]                     */
1513     /* returns [Name]                               */
1514     List cs, ss;
1515     Int  conNo = length(cons)>1 ? 1 : 0;
1516     for(cs=cons; nonNull(cs); cs=tl(cs), conNo++) {
1517         Name c  = startGHCConstr(line,conNo,hd(cs));
1518         hd(cs)  = c;
1519     }
1520     /* cons :: [Name] */
1521
1522     for(ss=sels; nonNull(ss); ss=tl(ss)) {
1523         hd(ss) = startGHCSel(line,hd(ss));
1524     }
1525     /* sels :: [Name] */
1526     return appendOnto(cons,sels);
1527 }
1528
1529
1530 static Name startGHCSel ( Int line, ZPair sel )
1531 {
1532     /* sel :: ((VarId, Type))  */
1533     Text t      = textOf(zfst(sel));
1534     Type type   = zsnd(sel);
1535
1536     Name n = findName(t);
1537     if (nonNull(n)) {
1538         ERRMSG(line) "Repeated definition for selector \"%s\"",
1539             textToStr(t)
1540         EEND;
1541     }
1542
1543     n              = newName(t,NIL);
1544     name(n).line   = line;
1545     name(n).number = SELNAME;
1546     name(n).arity  = 1;
1547     name(n).defn   = NIL;
1548     name(n).type = type;
1549     return n;
1550 }
1551
1552
1553 static Name startGHCConstr ( Int line, Int conNo, ZTriple constr )
1554 {
1555     /* constr :: ((ConId,[((Type,Text,Int))],Type)) */
1556     /* (ADR) ToDo: add rank2 annotation and existential annotation
1557      * these affect how constr can be used.
1558      */
1559     Text con   = textOf(zfst3(constr));
1560     Type type  = zthd3(constr);
1561     Int  arity = arityFromType(type);
1562     Name n = findName(con);     /* Allocate constructor fun name   */
1563     if (isNull(n)) {
1564         n = newName(con,NIL);
1565     } else if (name(n).defn!=PREDEFINED) {
1566         ERRMSG(line) "Repeated definition for constructor \"%s\"",
1567             textToStr(con)
1568         EEND;
1569     }
1570     name(n).arity  = arity;     /* Save constructor fun details    */
1571     name(n).line   = line;
1572     name(n).number = cfunNo(conNo);
1573     name(n).type   = type;
1574     return n;
1575 }
1576
1577
1578 static Void finishGHCDataDecl ( ConId tyc )
1579 {
1580     List  nms;
1581     Tycon tc = findTycon(textOf(tyc));
1582 #   ifdef DEBUG_IFACE
1583     printf ( "begin finishGHCDataDecl %s\n", textToStr(textOf(tyc)) );
1584 #   endif
1585     if (isNull(tc)) internal("finishGHCDataDecl");
1586
1587     for (nms=tycon(tc).defn; nonNull(nms); nms=tl(nms)) {
1588        Name n    = hd(nms);
1589        Int  line = name(n).line;
1590        assert(currentModule == name(n).mod);
1591        name(n).type = conidcellsToTycons(line,name(n).type);
1592     }
1593 }
1594
1595
1596 /* --------------------------------------------------------------------------
1597  * Newtype decls
1598  * ------------------------------------------------------------------------*/
1599
1600 Void startGHCNewType ( Int line, List ctx0,
1601                        ConId tycon, List tvs, Cell constr )
1602 {
1603     /* ctx0   :: [((QConId,VarId))]                */
1604     /* tycon  :: ConId                             */
1605     /* tvs    :: [((VarId,Kind))]                  */
1606     /* constr :: ((ConId,Type)) or NIL if abstract */
1607     List tmp;
1608     Type resTy;
1609     Text t = textOf(tycon);
1610 #   ifdef DEBUG_IFACE
1611     fprintf(stderr, "begin startGHCNewType %s\n", textToStr(t) );
1612 #   endif
1613     if (nonNull(findTycon(t))) {
1614         ERRMSG(line) "Repeated definition of type constructor \"%s\"",
1615                      textToStr(t)
1616         EEND;
1617     } else {
1618         Tycon tc        = newTycon(t);
1619         tycon(tc).line  = line;
1620         tycon(tc).arity = length(tvs);
1621         tycon(tc).what  = NEWTYPE;
1622         tycon(tc).kind  = tvsToKind(tvs);
1623         /* can't really do this until I've read in all synonyms */
1624
1625         if (isNull(constr)) {
1626            tycon(tc).defn = NIL;
1627         } else {
1628            /* constr :: ((ConId,Type)) */
1629            Text con   = textOf(zfst(constr));
1630            Type type  = zsnd(constr);
1631            Name n = findName(con);     /* Allocate constructor fun name   */
1632            if (isNull(n)) {
1633                n = newName(con,NIL);
1634            } else if (name(n).defn!=PREDEFINED) {
1635                ERRMSG(line) "Repeated definition for constructor \"%s\"",
1636                   textToStr(con)
1637                EEND;
1638            }
1639            name(n).arity  = 1;         /* Save constructor fun details    */
1640            name(n).line   = line;
1641            name(n).number = cfunNo(0);
1642            name(n).defn   = nameId;
1643            tycon(tc).defn = singleton(n);
1644
1645            /* make resTy the result type of the constr, T v1 ... vn */
1646            resTy = tycon;
1647            for (tmp=tvs; nonNull(tmp); tmp=tl(tmp))
1648               resTy = ap(resTy,zfst(hd(tmp)));
1649            type = fn(type,resTy);
1650            if (nonNull(ctx0))
1651               type = ap(QUAL,pair(ctx0,type));
1652            type = tvsToOffsets(line,type,tvs);
1653            name(n).type   = type;
1654         }
1655     }
1656 }
1657
1658
1659 static Void finishGHCNewType ( ConId tyc )
1660 {
1661     Tycon tc = findTycon(textOf(tyc));
1662 #   ifdef DEBUG_IFACE
1663     printf ( "begin finishGHCNewType %s\n", textToStr(textOf(tyc)) );
1664 #   endif
1665
1666     if (isNull(tc)) internal("finishGHCNewType");
1667
1668     if (isNull(tycon(tc).defn)) {
1669        /* it's an abstract type */
1670     }
1671     else if (length(tycon(tc).defn) == 1) {
1672        /* As we expect, has a single constructor */
1673        Name n    = hd(tycon(tc).defn);
1674        Int  line = name(n).line;
1675        assert(currentModule == name(n).mod);
1676        name(n).type = conidcellsToTycons(line,name(n).type);
1677     } else {
1678        internal("finishGHCNewType(2)");
1679     }
1680 }
1681
1682
1683 /* --------------------------------------------------------------------------
1684  * Class declarations
1685  * ------------------------------------------------------------------------*/
1686
1687 Void startGHCClass(line,ctxt,tc_name,kinded_tvs,mems0)
1688 Int   line;
1689 List  ctxt;       /* [((QConId, VarId))]   */
1690 ConId tc_name;    /* ConId                 */
1691 List  kinded_tvs; /* [((VarId, Kind))]     */
1692 List  mems0; {    /* [((VarId, Type))]     */
1693
1694     List mems;    /* [((VarId, Type))]     */
1695     List tvsInT;  /* [VarId] and then [((VarId,Kind))] */
1696     List tvs;     /* [((VarId,Kind))]      */
1697     List ns;      /* [Name]                */
1698     Int  mno;
1699
1700     ZPair kinded_tv = hd(kinded_tvs);
1701     Text ct         = textOf(tc_name);
1702     Pair newCtx     = pair(tc_name, zfst(kinded_tv));
1703 #   ifdef DEBUG_IFACE
1704     printf ( "begin startGHCClass %s\n", textToStr(ct) );
1705 #   endif
1706
1707     if (length(kinded_tvs) != 1) {
1708         ERRMSG(line) "Cannot presently handle multiparam type classes in ifaces"
1709         EEND;
1710     }
1711
1712     if (nonNull(findClass(ct))) {
1713         ERRMSG(line) "Repeated definition of class \"%s\"",
1714                      textToStr(ct)
1715         EEND;
1716     } else if (nonNull(findTycon(ct))) {
1717         ERRMSG(line) "\"%s\" used as both class and type constructor",
1718                      textToStr(ct)
1719         EEND;
1720     } else {
1721         Class nw              = newClass(ct);
1722         cclass(nw).text       = ct;
1723         cclass(nw).line       = line;
1724         cclass(nw).arity      = 1;
1725         cclass(nw).head       = ap(nw,mkOffset(0));
1726         cclass(nw).kinds      = singleton(STAR); /* absolutely no idea at all */
1727         cclass(nw).instances  = NIL;             /* what the kind should be   */
1728         cclass(nw).numSupers  = length(ctxt);
1729
1730         /* Kludge to map the single tyvar in the context to Offset 0.
1731            Need to do something better for multiparam type classes.
1732
1733         cclass(nw).supers     = tvsToOffsets(line,ctxt,
1734                                              singleton(pair(tv,STAR)));
1735         */
1736         cclass(nw).supers     = tvsToOffsets(line,ctxt,
1737                                              singleton(kinded_tv));
1738
1739
1740         for (mems=mems0; nonNull(mems); mems=tl(mems)) {
1741            ZPair mem  = hd(mems);
1742            Type  memT = zsnd(mem);
1743            Text  mnt  = textOf(zfst(mem));
1744            Name  mn;
1745
1746            /* Stick the new context on the member type */
1747            memT = dictapsToQualtype(memT);
1748            if (whatIs(memT)==POLYTYPE) internal("startGHCClass");
1749            if (whatIs(memT)==QUAL) {
1750               memT = pair(QUAL,
1751                           pair(cons(newCtx,fst(snd(memT))),snd(snd(memT))));
1752            } else {
1753               memT = pair(QUAL,
1754                           pair(singleton(newCtx),memT));
1755            }
1756
1757            /* Cook up a kind for the type. */
1758            tvsInT = ifTyvarsIn(memT);
1759            /* tvsInT :: [VarId] */
1760
1761            /* ToDo: maximally bogus */
1762            for (tvs=tvsInT; nonNull(tvs); tvs=tl(tvs))
1763               hd(tvs) = zpair(hd(tvs),STAR);
1764            /* tvsIntT :: [((VarId,STAR))] */
1765
1766            memT = mkPolyType(tvsToKind(tvsInT),memT);
1767            memT = tvsToOffsets(line,memT,tvsInT);
1768
1769            /* Park the type back on the member */
1770            mem = zpair(zfst(mem),memT);
1771
1772            /* Bind code to the member */
1773            mn = findName(mnt);
1774            if (nonNull(mn)) {
1775               ERRMSG(line)
1776                  "Repeated definition for class method \"%s\"",
1777                  textToStr(mnt)
1778               EEND;
1779            }
1780            mn = newName(mnt,NIL);
1781
1782            hd(mems) = mem;
1783         }
1784
1785         cclass(nw).members    = mems0;
1786         cclass(nw).numMembers = length(mems0);
1787
1788         /* (ADR) ToDo:
1789          * cclass(nw).dsels    = ?;
1790          * cclass(nm).defaults = ?;
1791          */
1792
1793         ns = NIL;
1794         for (mno=0; mno<cclass(nw).numSupers; mno++) {
1795            ns = cons(newDSel(nw,mno),ns);
1796         }
1797         cclass(nw).dsels = rev(ns);
1798     }
1799 }
1800
1801
1802 static Class finishGHCClass ( Tycon cls_tyc )
1803 {
1804     List  mems;
1805     Int   line;
1806     Int   ctr;
1807     Class nw = findClass ( textOf(cls_tyc) );
1808 #   ifdef DEBUG_IFACE
1809     printf ( "begin finishGHCClass %s\n", textToStr(cclass(nw).text) );
1810 #   endif
1811     if (isNull(nw)) internal("finishGHCClass");
1812
1813     line = cclass(nw).line;
1814     ctr  = - length(cclass(nw).members);
1815     assert (currentModule == cclass(nw).mod);
1816
1817     cclass(nw).level   = 0;  /* (ADR) ToDo: 1 + max (map level supers) */
1818     cclass(nw).head    = conidcellsToTycons(line,cclass(nw).head);
1819     cclass(nw).supers  = conidcellsToTycons(line,cclass(nw).supers);
1820     cclass(nw).members = conidcellsToTycons(line,cclass(nw).members);
1821
1822     for (mems=cclass(nw).members; nonNull(mems); mems=tl(mems)) {
1823        Pair mem = hd(mems); /* (VarId, Type) */
1824        Text txt = textOf(fst(mem));
1825        Type ty  = snd(mem);
1826        Name n   = findName(txt);
1827        assert(nonNull(n));
1828        name(n).line   = cclass(nw).line;
1829        name(n).type   = ty;
1830        name(n).number = ctr++;
1831        name(n).arity  = arityInclDictParams(name(n).type);
1832        hd(mems) = n;
1833     }
1834
1835     return nw;
1836 }
1837
1838
1839 /* --------------------------------------------------------------------------
1840  * Instances
1841  * ------------------------------------------------------------------------*/
1842
1843 Inst startGHCInstance (line,ktyvars,cls,var)
1844 Int   line;
1845 List  ktyvars; /* [((VarId,Kind))] */
1846 Type  cls;     /* Type  */
1847 VarId var; {   /* VarId */
1848     List tmp, tvs, ks, spec;
1849
1850     List xs1, xs2;
1851     Kind k;
1852
1853     Inst in = newInst();
1854 #   ifdef DEBUG_IFACE
1855     printf ( "begin startGHCInstance\n" );
1856 #   endif
1857
1858     tvs = ifTyvarsIn(cls);  /* :: [VarId] */
1859     /* tvs :: [VarId].
1860        The order of tvs is important for tvsToOffsets.
1861        tvs should be a permutation of ktyvars.  Fish the tyvar kinds
1862        out of ktyvars and attach them to tvs.
1863     */
1864     for (xs1=tvs; nonNull(xs1); xs1=tl(xs1)) {
1865        k = NIL;
1866        for (xs2=ktyvars; nonNull(xs2); xs2=tl(xs2))
1867           if (textOf(hd(xs1)) == textOf(zfst(hd(xs2))))
1868              k = zsnd(hd(xs2));
1869        if (isNull(k)) internal("startGHCInstance: finding kinds");
1870        hd(xs1) = zpair(hd(xs1),k);
1871     }
1872
1873     cls = tvsToOffsets(line,cls,tvs);
1874     spec = NIL;
1875     while (isAp(cls)) {
1876        spec = cons(fun(cls),spec);
1877        cls  = arg(cls);
1878     }
1879     spec = reverse(spec);
1880
1881     inst(in).line         = line;
1882     inst(in).implements   = NIL;
1883     inst(in).kinds        = simpleKind(length(tvs)); /* do this right */
1884     inst(in).specifics    = spec;
1885     inst(in).numSpecifics = length(spec);
1886     inst(in).head         = cls;
1887
1888     /* Figure out the name of the class being instanced, and store it
1889        at inst(in).c.  finishGHCInstance will resolve it to a real Class. */
1890     {
1891        Cell cl = inst(in).head;
1892        assert(whatIs(cl)==DICTAP);
1893        cl = unap(DICTAP,cl);
1894        cl = fst(cl);
1895        assert ( isQCon(cl) );
1896        inst(in).c = cl;
1897     }
1898
1899     {
1900         Name b         = newName( /*inventText()*/ textOf(var),NIL);
1901         name(b).line   = line;
1902         name(b).arity  = length(spec); /* unused? */ /* and surely wrong */
1903         name(b).number = DFUNNAME;
1904         inst(in).builder = b;
1905         /* bindNameToClosure(b, lookupGHCClosure(inst(in).mod,var)); */
1906     }
1907
1908     return in;
1909 }
1910
1911
1912 static Void finishGHCInstance ( Inst in )
1913 {
1914     Int    line;
1915     Class  c;
1916     Type   cls;
1917
1918 #   ifdef DEBUG_IFACE
1919     printf ( "begin finishGHCInstance\n" );
1920 #   endif
1921
1922     assert (nonNull(in));
1923     line = inst(in).line;
1924     assert (currentModule==inst(in).mod);
1925
1926     /* inst(in).c is, prior to finishGHCInstance, a ConId or Tuple,
1927        since startGHCInstance couldn't possibly have resolved it to
1928        a Class at that point.  We convert it to a Class now.
1929     */
1930     c = inst(in).c;
1931     assert(isQCon(c));
1932     c = findQualClassWithoutConsultingExportList(c);
1933     assert(nonNull(c));
1934     inst(in).c = c;
1935
1936     inst(in).head         = conidcellsToTycons(line,inst(in).head);
1937     inst(in).specifics    = conidcellsToTycons(line,inst(in).specifics);
1938     cclass(c).instances   = cons(in,cclass(c).instances);
1939 }
1940
1941
1942 /* --------------------------------------------------------------------------
1943  * Helper fns
1944  * ------------------------------------------------------------------------*/
1945
1946 /* This is called from the startGHC* functions.  It traverses a structure
1947    and converts varidcells, ie, type variables parsed by the interface
1948    parser, into Offsets, which is how Hugs wants to see them internally.
1949    The Offset for a type variable is determined by its place in the list
1950    passed as the second arg; the associated kinds are irrelevant.
1951
1952    ((t1,t2)) denotes the typed (z-)pair of t1 and t2.
1953 */
1954
1955 /* tvsToOffsets :: LineNo -> Type -> [((VarId,Kind))] -> Type */
1956 static Type tvsToOffsets(line,type,ktyvars)
1957 Int  line;
1958 Type type;
1959 List ktyvars; { /* [((VarId,Kind))] */
1960    switch (whatIs(type)) {
1961       case NIL:
1962       case TUPLE:
1963       case QUALIDENT:
1964       case CONIDCELL:
1965       case TYCON:
1966          return type;
1967       case ZTUP2: /* convert to the untyped representation */
1968          return ap( tvsToOffsets(line,zfst(type),ktyvars),
1969                     tvsToOffsets(line,zsnd(type),ktyvars) );
1970       case AP:
1971          return ap( tvsToOffsets(line,fun(type),ktyvars),
1972                     tvsToOffsets(line,arg(type),ktyvars) );
1973       case POLYTYPE:
1974          return mkPolyType (
1975                    polySigOf(type),
1976                    tvsToOffsets(line,monotypeOf(type),ktyvars)
1977                 );
1978          break;
1979       case QUAL:
1980          return pair(QUAL,pair(tvsToOffsets(line,fst(snd(type)),ktyvars),
1981                                tvsToOffsets(line,snd(snd(type)),ktyvars)));
1982       case DICTAP: /* bogus ?? */
1983          return ap(DICTAP, tvsToOffsets(line,snd(type),ktyvars));
1984       case UNBOXEDTUP:  /* bogus?? */
1985          return ap(UNBOXEDTUP, tvsToOffsets(line,snd(type),ktyvars));
1986       case BANG:  /* bogus?? */
1987          return ap(BANG, tvsToOffsets(line,snd(type),ktyvars));
1988       case VARIDCELL: /* Ha! some real work to do! */
1989        { Int i = 0;
1990          Text tv = textOf(type);
1991          for (; nonNull(ktyvars); i++,ktyvars=tl(ktyvars)) {
1992             Cell varid;
1993             Text tt;
1994             assert(isZPair(hd(ktyvars)));
1995             varid = zfst(hd(ktyvars));
1996             tt    = textOf(varid);
1997             if (tv == tt) return mkOffset(i);
1998          }
1999          ERRMSG(line) "Undefined type variable \"%s\"", textToStr(tv)
2000          EEND;
2001          break;
2002        }
2003       default:
2004          fprintf(stderr, "tvsToOffsets: unknown stuff %d\n", whatIs(type));
2005          print(type,20);
2006          fprintf(stderr,"\n");
2007          assert(0);
2008    }
2009    assert(0);
2010    return NIL; /* NOTREACHED */
2011 }
2012
2013
2014 /* This is called from the finishGHC* functions.  It traverses a structure
2015    and converts conidcells, ie, type constructors parsed by the interface
2016    parser, into Tycons (or Classes), which is how Hugs wants to see them
2017    internally.  Calls to this fn have to be deferred to the second phase
2018    of interface loading (finishGHC* rather than startGHC*) so that all relevant
2019    Tycons or Classes have been loaded into the symbol tables and can be
2020    looked up.
2021 */
2022 static Type conidcellsToTycons ( Int line, Type type )
2023 {
2024    switch (whatIs(type)) {
2025       case NIL:
2026       case OFFSET:
2027       case TYCON:
2028       case CLASS:
2029       case VARIDCELL:
2030       case TUPLE:
2031       case STAR:
2032          return type;
2033       case QUALIDENT:
2034        { Cell t;  /* Tycon or Class */
2035          Text m     = qmodOf(type);
2036          Module mod = findModule(m);
2037          if (isNull(mod)) {
2038             ERRMSG(line)
2039                "Undefined module in qualified name \"%s\"",
2040                identToStr(type)
2041             EEND;
2042             return NIL;
2043          }
2044          t = findQualTyconWithoutConsultingExportList(type);
2045          if (nonNull(t)) return t;
2046          t = findQualClassWithoutConsultingExportList(type);
2047          if (nonNull(t)) return t;
2048          ERRMSG(line)
2049               "Undefined qualified class or type \"%s\"",
2050               identToStr(type)
2051          EEND;
2052          return NIL;
2053        }
2054       case CONIDCELL:
2055        { Tycon tc;
2056          Class cl;
2057          cl = findQualClass(type);
2058          if (nonNull(cl)) return cl;
2059          if (textOf(type)==findText("[]"))
2060             /* a hack; magically qualify [] into PrelBase.[] */
2061             return conidcellsToTycons(line,
2062                                       mkQualId(mkCon(findText("PrelBase")),type));
2063          tc = findQualTycon(type);
2064          if (nonNull(tc)) return tc;
2065          ERRMSG(line)
2066              "Undefined class or type constructor \"%s\"",
2067              identToStr(type)
2068          EEND;
2069          return NIL;
2070        }
2071       case AP:
2072          return ap( conidcellsToTycons(line,fun(type)),
2073                     conidcellsToTycons(line,arg(type)) );
2074       case ZTUP2: /* convert to std pair */
2075          return ap( conidcellsToTycons(line,zfst(type)),
2076                     conidcellsToTycons(line,zsnd(type)) );
2077
2078       case POLYTYPE:
2079          return mkPolyType (
2080                    polySigOf(type),
2081                    conidcellsToTycons(line,monotypeOf(type))
2082                 );
2083          break;
2084       case QUAL:
2085          return pair(QUAL,pair(conidcellsToTycons(line,fst(snd(type))),
2086                                conidcellsToTycons(line,snd(snd(type)))));
2087       case DICTAP: /* :: ap(DICTAP, pair(Class,Type))
2088                       Not sure if this is really the right place to
2089                       convert it to the form Hugs wants, but will do so anyway.
2090                     */
2091          /* return ap(DICTAP, conidcellsToTycons(line, snd(type))); */
2092         {
2093            Class cl   = fst(unap(DICTAP,type));
2094            List  args = snd(unap(DICTAP,type));
2095            return
2096               conidcellsToTycons(line,pair(cl,args));
2097         }
2098       case UNBOXEDTUP:
2099          return ap(UNBOXEDTUP, conidcellsToTycons(line, snd(type)));
2100       case BANG:
2101          return ap(BANG, conidcellsToTycons(line, snd(type)));
2102       default:
2103          fprintf(stderr, "conidcellsToTycons: unknown stuff %d\n",
2104                  whatIs(type));
2105          print(type,20);
2106          fprintf(stderr,"\n");
2107          assert(0);
2108    }
2109    assert(0);
2110    return NIL; /* NOTREACHED */
2111 }
2112
2113
2114 /* Find out if a type mentions a type constructor not present in
2115    the supplied list of qualified tycons.
2116 */
2117 static Bool allTypesKnown ( Type  type,
2118                             List  aktys /* [QualId] */,
2119                             ConId thisMod )
2120 {
2121    switch (whatIs(type)) {
2122       case NIL:
2123       case OFFSET:
2124       case VARIDCELL:
2125       case TUPLE:
2126          return TRUE;
2127       case AP:
2128          return allTypesKnown(fun(type),aktys,thisMod)
2129                 && allTypesKnown(arg(type),aktys,thisMod);
2130       case ZTUP2:
2131          return allTypesKnown(zfst(type),aktys,thisMod)
2132                 && allTypesKnown(zsnd(type),aktys,thisMod);
2133       case DICTAP:
2134          return allTypesKnown(unap(DICTAP,type),aktys,thisMod);
2135
2136       case CONIDCELL:
2137         if (textOf(type)==findText("[]"))
2138             /* a hack; magically qualify [] into PrelBase.[] */
2139             type = mkQualId(mkCon(findText("PrelBase")),type); else
2140             type = mkQualId(thisMod,type);
2141          /* fall through */
2142       case QUALIDENT:
2143          if (isNull(qualidIsMember(type,aktys))) goto missing;
2144          return TRUE;
2145       case TYCON:
2146          return TRUE;
2147
2148       default:
2149          fprintf(stderr, "allTypesKnown: unknown stuff %d\n", whatIs(type));
2150          print(type,10);printf("\n");
2151          internal("allTypesKnown");
2152          return TRUE; /*notreached*/
2153    }
2154   missing:
2155    printf ( "allTypesKnown: unknown " ); print(type,10); printf("\n");
2156    return FALSE;
2157 }
2158
2159
2160 /* --------------------------------------------------------------------------
2161  * Utilities
2162  *
2163  * None of these do lookups or require that lookups have been resolved
2164  * so they can be performed while reading interfaces.
2165  * ------------------------------------------------------------------------*/
2166
2167 /* tvsToKind :: [((VarId,Kind))] -> Kinds */
2168 static Kinds tvsToKind(tvs)
2169 List tvs; { /* [((VarId,Kind))] */
2170     List  rs;
2171     Kinds r  = STAR;
2172     for (rs=reverse(tvs); nonNull(rs); rs=tl(rs)) {
2173         if (whatIs(hd(rs)) != ZTUP2) internal("tvsToKind(1)");
2174         if (whatIs(zfst(hd(rs))) != VARIDCELL) internal("tvsToKind(2)");
2175         r = ap(zsnd(hd(rs)),r);
2176     }
2177     return r;
2178 }
2179
2180
2181 static Int arityInclDictParams ( Type type )
2182 {
2183    Int arity = 0;
2184    if (isPolyType(type)) type = monotypeOf(type);
2185
2186    if (whatIs(type) == QUAL)
2187    {
2188       arity += length ( fst(snd(type)) );
2189       type = snd(snd(type));
2190    }
2191    while (isAp(type) && getHead(type)==typeArrow) {
2192       arity++;
2193       type = arg(type);
2194    }
2195    return arity;
2196 }
2197
2198 /* arity of a constructor with this type */
2199 static Int arityFromType(type)
2200 Type type; {
2201     Int arity = 0;
2202     if (isPolyType(type)) {
2203         type = monotypeOf(type);
2204     }
2205     if (whatIs(type) == QUAL) {
2206         type = snd(snd(type));
2207     }
2208     if (whatIs(type) == EXIST) {
2209         type = snd(snd(type));
2210     }
2211     if (whatIs(type)==RANK2) {
2212         type = snd(snd(type));
2213     }
2214     while (isAp(type) && getHead(type)==typeArrow) {
2215         arity++;
2216         type = arg(type);
2217     }
2218     return arity;
2219 }
2220
2221
2222 /* ifTyvarsIn :: Type -> [VarId]
2223    The returned list has no duplicates -- is a set.
2224 */
2225 static List ifTyvarsIn(type)
2226 Type type; {
2227     List vs = typeVarsIn(type,NIL,NIL,NIL);
2228     List vs2 = vs;
2229     for (; nonNull(vs2); vs2=tl(vs2))
2230        if (whatIs(hd(vs2)) != VARIDCELL)
2231           internal("ifTyvarsIn");
2232     return vs;
2233 }
2234
2235
2236
2237 /* --------------------------------------------------------------------------
2238  * General object symbol query stuff
2239  * ------------------------------------------------------------------------*/
2240
2241 #define EXTERN_SYMS                  \
2242       Sym(stg_gc_enter_1)            \
2243       Sym(stg_gc_noregs)             \
2244       Sym(stg_gc_seq_1)              \
2245       Sym(stg_gc_d1)                 \
2246       Sym(stg_gc_f1)                 \
2247       Sym(stg_chk_0)                 \
2248       Sym(stg_chk_1)                 \
2249       Sym(stg_gen_chk)               \
2250       Sym(stg_exit)                  \
2251       Sym(stg_update_PAP)            \
2252       Sym(stg_error_entry)           \
2253       Sym(__ap_2_upd_info)           \
2254       Sym(__ap_3_upd_info)           \
2255       Sym(__ap_4_upd_info)           \
2256       Sym(__ap_5_upd_info)           \
2257       Sym(__ap_6_upd_info)           \
2258       Sym(__sel_0_upd_info)          \
2259       Sym(__sel_1_upd_info)          \
2260       Sym(__sel_2_upd_info)          \
2261       Sym(__sel_3_upd_info)          \
2262       Sym(__sel_4_upd_info)          \
2263       Sym(__sel_5_upd_info)          \
2264       Sym(__sel_6_upd_info)          \
2265       Sym(__sel_7_upd_info)          \
2266       Sym(__sel_8_upd_info)          \
2267       Sym(__sel_9_upd_info)          \
2268       Sym(__sel_10_upd_info)         \
2269       Sym(__sel_11_upd_info)         \
2270       Sym(__sel_12_upd_info)         \
2271       Sym(MainRegTable)              \
2272       Sym(Upd_frame_info)            \
2273       Sym(seq_frame_info)            \
2274       Sym(CAF_BLACKHOLE_info)        \
2275       Sym(IND_STATIC_info)           \
2276       Sym(EMPTY_MVAR_info)           \
2277       Sym(MUT_ARR_PTRS_FROZEN_info)  \
2278       Sym(newCAF)                    \
2279       Sym(putMVarzh_fast)            \
2280       Sym(newMVarzh_fast)            \
2281       Sym(takeMVarzh_fast)           \
2282       Sym(catchzh_fast)              \
2283       Sym(raisezh_fast)              \
2284       Sym(delayzh_fast)              \
2285       Sym(yieldzh_fast)              \
2286       Sym(killThreadzh_fast)         \
2287       Sym(waitReadzh_fast)           \
2288       Sym(waitWritezh_fast)          \
2289       Sym(CHARLIKE_closure)          \
2290       Sym(INTLIKE_closure)           \
2291       Sym(suspendThread)             \
2292       Sym(resumeThread)              \
2293       Sym(stackOverflow)             \
2294       Sym(int2Integerzh_fast)        \
2295       Sym(stg_gc_unbx_r1)            \
2296       Sym(ErrorHdrHook)              \
2297       Sym(makeForeignObjzh_fast)     \
2298       Sym(__encodeDouble)            \
2299       Sym(decodeDoublezh_fast)       \
2300       Sym(isDoubleNaN)               \
2301       Sym(isDoubleInfinite)          \
2302       Sym(isDoubleDenormalized)      \
2303       Sym(isDoubleNegativeZero)      \
2304       Sym(__encodeFloat)             \
2305       Sym(decodeFloatzh_fast)        \
2306       Sym(isFloatNaN)                \
2307       Sym(isFloatInfinite)           \
2308       Sym(isFloatDenormalized)       \
2309       Sym(isFloatNegativeZero)       \
2310       Sym(__int_encodeFloat)         \
2311       Sym(__int_encodeDouble)        \
2312       Sym(mpz_cmp_si)                \
2313       Sym(mpz_cmp)                   \
2314       Sym(__mpn_gcd_1)               \
2315       Sym(gcdIntegerzh_fast)         \
2316       Sym(newArrayzh_fast)           \
2317       Sym(unsafeThawArrayzh_fast)    \
2318       Sym(newDoubleArrayzh_fast)     \
2319       Sym(newFloatArrayzh_fast)      \
2320       Sym(newAddrArrayzh_fast)       \
2321       Sym(newWordArrayzh_fast)       \
2322       Sym(newIntArrayzh_fast)        \
2323       Sym(newCharArrayzh_fast)       \
2324       Sym(newMutVarzh_fast)          \
2325       Sym(quotRemIntegerzh_fast)     \
2326       Sym(quotIntegerzh_fast)        \
2327       Sym(remIntegerzh_fast)         \
2328       Sym(divExactIntegerzh_fast)    \
2329       Sym(divModIntegerzh_fast)      \
2330       Sym(timesIntegerzh_fast)       \
2331       Sym(minusIntegerzh_fast)       \
2332       Sym(plusIntegerzh_fast)        \
2333       Sym(addr2Integerzh_fast)       \
2334       Sym(mkWeakzh_fast)             \
2335       Sym(prog_argv)                 \
2336       Sym(prog_argc)                 \
2337       Sym(resetNonBlockingFd)        \
2338                                      \
2339       /* needed by libHS_cbits */    \
2340       SymX(malloc)                   \
2341       Sym(__errno_location)          \
2342       SymX(close)                    \
2343       Sym(__xstat)                   \
2344       Sym(__fxstat)                  \
2345       Sym(__lxstat)                  \
2346       Sym(mkdir)                     \
2347       SymX(close)                    \
2348       Sym(opendir)                   \
2349       Sym(closedir)                  \
2350       Sym(readdir)                   \
2351       Sym(tcgetattr)                 \
2352       Sym(tcsetattr)                 \
2353       SymX(isatty)                   \
2354       SymX(read)                     \
2355       SymX(lseek)                    \
2356       SymX(write)                    \
2357       Sym(getrusage)                 \
2358       Sym(gettimeofday)              \
2359       SymX(realloc)                  \
2360       SymX(getcwd)                   \
2361       SymX(free)                     \
2362       SymX(strcpy)                   \
2363       SymX(select)                   \
2364       Sym(fcntl)                     \
2365       SymX(stderr)                   \
2366       SymX(fprintf)                  \
2367       SymX(exit)                     \
2368       Sym(open)                      \
2369       SymX(unlink)                   \
2370       SymX(memcpy)                   \
2371       SymX(memchr)                   \
2372       SymX(rmdir)                    \
2373       SymX(rename)                   \
2374       SymX(chdir)                    \
2375       Sym(localtime)                 \
2376       Sym(strftime)                  \
2377       SymX(vfork)                    \
2378       SymX(execl)                    \
2379       SymX(_exit)                    \
2380       Sym(waitpid)                   \
2381       Sym(tzname)                    \
2382       Sym(timezone)                  \
2383       Sym(mktime)                    \
2384       Sym(gmtime)                    \
2385
2386
2387 /* AJG Hack */
2388 #if 0
2389 #undef EXTERN_SYMS
2390 #define EXTERN_SYMS
2391 #endif
2392
2393 /* entirely bogus claims about types of these symbols */
2394 #define Sym(vvv)  extern int vvv;
2395 #define SymX(vvv) /* nothing */
2396 EXTERN_SYMS
2397 #undef Sym
2398 #undef SymX
2399
2400 #define Sym(vvv) { #vvv, &vvv },
2401 #define SymX(vvv) { #vvv, &vvv },
2402 OSym rtsTab[]
2403    = {
2404        EXTERN_SYMS
2405        {0,0}
2406      };
2407 #undef Sym
2408 #undef SymX
2409
2410 void* lookupObjName ( char* nm )
2411 {
2412    int    k;
2413    char*  pp;
2414    void*  a;
2415    Text   t;
2416    Module m;
2417    char   nm2[200];
2418
2419    nm2[199] = 0;
2420    strncpy(nm2,nm,200);
2421
2422    /*  first see if it's an RTS name */
2423    for (k = 0; rtsTab[k].nm; k++)
2424       if (0==strcmp(nm2,rtsTab[k].nm))
2425          return rtsTab[k].ad;
2426
2427    /* perhaps an extra-symbol ? */
2428    a = lookupOExtraTabName ( nm );
2429    if (a) return a;
2430
2431    /* if not an RTS name, look in the
2432       relevant module's object symbol table
2433    */
2434    pp = strchr(nm2, '_');
2435    if (!pp || !isupper(nm2[0])) goto not_found;
2436    *pp = 0;
2437    t = unZcodeThenFindText(nm2);
2438    m = findModule(t);
2439    if (isNull(m)) goto not_found;
2440
2441    a = lookupOTabName ( m, nm );  /* RATIONALISE */
2442    if (a) return a;
2443
2444   not_found:
2445    fprintf ( stderr,
2446              "lookupObjName: can't resolve name `%s'\n",
2447              nm );
2448 assert(4-4);
2449    return NULL;
2450 }
2451
2452
2453 int is_dynamically_loaded_code_or_rodata_ptr ( char* p )
2454 {
2455    OSectionKind sk = lookupSection(p);
2456    assert (sk != HUGS_SECTIONKIND_NOINFOAVAIL);
2457    return (sk == HUGS_SECTIONKIND_CODE_OR_RODATA);
2458 }
2459
2460
2461 int is_dynamically_loaded_rwdata_ptr ( char* p )
2462 {
2463    OSectionKind sk = lookupSection(p);
2464    assert (sk != HUGS_SECTIONKIND_NOINFOAVAIL);
2465    return (sk == HUGS_SECTIONKIND_RWDATA);
2466 }
2467
2468
2469 int is_not_dynamically_loaded_ptr ( char* p )
2470 {
2471    OSectionKind sk = lookupSection(p);
2472    assert (sk != HUGS_SECTIONKIND_NOINFOAVAIL);
2473    return (sk == HUGS_SECTIONKIND_OTHER);
2474 }
2475
2476
2477 /* --------------------------------------------------------------------------
2478  * Control:
2479  * ------------------------------------------------------------------------*/
2480
2481 Void interface(what)
2482 Int what; {
2483     switch (what) {
2484        case POSTPREL: break;
2485
2486        case PREPREL:
2487        case RESET:
2488           ifaces_outstanding  = NIL;
2489           break;
2490        case MARK:
2491           mark(ifaces_outstanding);
2492           break;
2493     }
2494 }
2495
2496 /*-------------------------------------------------------------------------*/