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