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.23 $
  11  * $Date: 2000/01/07 16:56:47 $
  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     /* convert a leading run of DICTAPs into Hugs' internal Qualtype form, viz:
1308        { C1 a } -> { C2 b } -> T            into
1309        ap(QUALTYPE, ( [(C1,a),(C2,b)], T ))
1310     */
1311     ty = dictapsToQualtype(ty);
1312
1313     tvs = ifTyvarsIn(ty);
1314     for (tmp=tvs; nonNull(tmp); tmp=tl(tmp))
1315        hd(tmp) = zpair(hd(tmp),STAR);
1316     if (nonNull(tvs))
1317        ty = mkPolyType(tvsToKind(tvs),ty);
1318
1319     ty = tvsToOffsets(line,ty,tvs);
1320     name(n).type  = ty;
1321     name(n).arity = arityInclDictParams(ty);
1322     name(n).line  = line;
1323 }
1324
1325
1326 void finishGHCValue ( VarId vid )
1327 {
1328     Name n    = findName ( textOf(vid) );
1329     Int  line = name(n).line;
1330 #   ifdef DEBUG_IFACE
1331     fprintf(stderr, "begin finishGHCValue %s\n", textToStr(name(n).text) );
1332 #   endif
1333     assert(currentModule == name(n).mod);
1334     name(n).type = conidcellsToTycons(line,name(n).type);
1335 }
1336
1337
1338 /* --------------------------------------------------------------------------
1339  * Type synonyms
1340  * ------------------------------------------------------------------------*/
1341
1342 Void startGHCSynonym ( Int line, ConId tycon, List tvs, Type ty )
1343 {
1344     /* tycon :: ConId             */
1345     /* tvs   ::  [((VarId,Kind))] */
1346     /* ty    :: Type              */
1347     Text t = textOf(tycon);
1348 #   ifdef DEBUG_IFACE
1349     fprintf(stderr, "begin startGHCSynonym %s\n", textToStr(t) );
1350 #   endif
1351     if (nonNull(findTycon(t))) {
1352         ERRMSG(line) "Repeated definition of type constructor \"%s\"",
1353                      textToStr(t)
1354         EEND;
1355     } else {
1356         Tycon tc        = newTycon(t);
1357         tycon(tc).line  = line;
1358         tycon(tc).arity = length(tvs);
1359         tycon(tc).what  = SYNONYM;
1360         tycon(tc).kind  = tvsToKind(tvs);
1361
1362         /* prepare for finishGHCSynonym */
1363         tycon(tc).defn  = tvsToOffsets(line,ty,tvs);
1364     }
1365 }
1366
1367
1368 static Void  finishGHCSynonym ( ConId tyc )
1369 {
1370     Tycon tc   = findTycon(textOf(tyc));
1371     Int   line = tycon(tc).line;
1372 #   ifdef DEBUG_IFACE
1373     fprintf(stderr, "begin finishGHCSynonym %s\n", textToStr(textOf(tyc)) );
1374 #   endif
1375
1376     assert (currentModule == tycon(tc).mod);
1377     //    setCurrModule(tycon(tc).mod);
1378     tycon(tc).defn = conidcellsToTycons(line,tycon(tc).defn);
1379
1380     /* (ADR) ToDo: can't really do this until I've done all synonyms
1381      * and then I have to do them in order
1382      * tycon(tc).defn = fullExpand(ty);
1383      * (JRS) What?!?!  i don't understand
1384      */
1385 }
1386
1387
1388 /* --------------------------------------------------------------------------
1389  * Data declarations
1390  * ------------------------------------------------------------------------*/
1391
1392 Void startGHCDataDecl(line,ctx0,tycon,ktyvars,constrs0)
1393 Int   line;
1394 List  ctx0;      /* [((QConId,VarId))]                */
1395 Cell  tycon;     /* ConId                             */
1396 List  ktyvars;   /* [((VarId,Kind))]                  */
1397 List  constrs0;  /* [((ConId,[((Type,VarId,Int))]))]  */
1398                  /* The Text is an optional field name
1399                     The Int indicates strictness */
1400     /* ToDo: worry about being given a decl for (->) ?
1401      * and worry about qualidents for ()
1402      */
1403 {
1404     Type    ty, resTy, selTy, conArgTy;
1405     List    tmp, conArgs, sels, constrs, fields, tyvarsMentioned;
1406     List    ctx, ctx2;
1407     Triple  constr;
1408     Cell    conid;
1409     Pair    conArg, ctxElem;
1410     Text    conArgNm;
1411     Int     conArgStrictness;
1412
1413     Text t = textOf(tycon);
1414 #   ifdef DEBUG_IFACE
1415     fprintf(stderr, "begin startGHCDataDecl %s\n",textToStr(t));
1416 #   endif
1417
1418     if (nonNull(findTycon(t))) {
1419         ERRMSG(line) "Repeated definition of type constructor \"%s\"",
1420                      textToStr(t)
1421         EEND;
1422     } else {
1423         Tycon tc        = newTycon(t);
1424         tycon(tc).text  = t;
1425         tycon(tc).line  = line;
1426         tycon(tc).arity = length(ktyvars);
1427         tycon(tc).kind  = tvsToKind(ktyvars);
1428         tycon(tc).what  = DATATYPE;
1429
1430         /* a list to accumulate selectors in :: [((VarId,Type))] */
1431         sels = NIL;
1432
1433         /* make resTy the result type of the constr, T v1 ... vn */
1434         resTy = tycon;
1435         for (tmp=ktyvars; nonNull(tmp); tmp=tl(tmp))
1436            resTy = ap(resTy,zfst(hd(tmp)));
1437
1438         /* for each constructor ... */
1439         for (constrs=constrs0; nonNull(constrs); constrs=tl(constrs)) {
1440            constr = hd(constrs);
1441            conid  = zfst(constr);
1442            fields = zsnd(constr);
1443
1444            /* Build type of constr and handle any selectors found.
1445               Also collect up tyvars occurring in the constr's arg
1446               types, so we can throw away irrelevant parts of the
1447               context later.
1448            */
1449            ty = resTy;
1450            tyvarsMentioned = NIL;
1451            /* tyvarsMentioned :: [VarId] */
1452
1453            conArgs = reverse(fields);
1454            for (; nonNull(conArgs); conArgs=tl(conArgs)) {
1455               conArg           = hd(conArgs); /* (Type,Text) */
1456               conArgTy         = zfst3(conArg);
1457               conArgNm         = zsnd3(conArg);
1458               conArgStrictness = intOf(zthd3(conArg));
1459               tyvarsMentioned = dupListOnto(ifTyvarsIn(conArgTy),
1460                                             tyvarsMentioned);
1461               if (conArgStrictness > 0) conArgTy = bang(conArgTy);
1462               ty = fn(conArgTy,ty);
1463               if (nonNull(conArgNm)) {
1464                  /* a field name is mentioned too */
1465                  selTy = fn(resTy,conArgTy);
1466                  if (whatIs(tycon(tc).kind) != STAR)
1467                     selTy = pair(POLYTYPE,pair(tycon(tc).kind, selTy));
1468                  selTy = tvsToOffsets(line,selTy, ktyvars);
1469                  sels = cons( zpair(conArgNm,selTy), sels);
1470               }
1471            }
1472
1473            /* Now ty is the constructor's type, not including context.
1474               Throw away any parts of the context not mentioned in
1475               tyvarsMentioned, and use it to qualify ty.
1476            */
1477            ctx2 = NIL;
1478            for (ctx=ctx0; nonNull(ctx); ctx=tl(ctx)) {
1479               ctxElem = hd(ctx);
1480               /* ctxElem :: ((QConId,VarId)) */
1481               if (nonNull(cellIsMember(textOf(zsnd(ctxElem)),tyvarsMentioned)))
1482                  ctx2 = cons(ctxElem, ctx2);
1483            }
1484            if (nonNull(ctx2))
1485               ty = ap(QUAL,pair(ctx2,ty));
1486
1487            /* stick the tycon's kind on, if not simply STAR */
1488            if (whatIs(tycon(tc).kind) != STAR)
1489               ty = pair(POLYTYPE,pair(tycon(tc).kind, ty));
1490
1491            ty = tvsToOffsets(line,ty, ktyvars);
1492
1493            /* Finally, stick the constructor's type onto it. */
1494            hd(constrs) = ztriple(conid,fields,ty);
1495         }
1496
1497         /* Final result is that
1498            constrs :: [((ConId,[((Type,Text))],Type))]
1499                       lists the constructors and their types
1500            sels :: [((VarId,Type))]
1501                    lists the selectors and their types
1502         */
1503         tycon(tc).defn = startGHCConstrs(line,constrs0,sels);
1504     }
1505 }
1506
1507
1508 static List startGHCConstrs ( Int line, List cons, List sels )
1509 {
1510     /* cons :: [((ConId,[((Type,Text,Int))],Type))] */
1511     /* sels :: [((VarId,Type))]                     */
1512     /* returns [Name]                               */
1513     List cs, ss;
1514     Int  conNo = length(cons)>1 ? 1 : 0;
1515     for(cs=cons; nonNull(cs); cs=tl(cs), conNo++) {
1516         Name c  = startGHCConstr(line,conNo,hd(cs));
1517         hd(cs)  = c;
1518     }
1519     /* cons :: [Name] */
1520
1521     for(ss=sels; nonNull(ss); ss=tl(ss)) {
1522         hd(ss) = startGHCSel(line,hd(ss));
1523     }
1524     /* sels :: [Name] */
1525     return appendOnto(cons,sels);
1526 }
1527
1528
1529 static Name startGHCSel ( Int line, ZPair sel )
1530 {
1531     /* sel :: ((VarId, Type))  */
1532     Text t      = textOf(zfst(sel));
1533     Type type   = zsnd(sel);
1534
1535     Name n = findName(t);
1536     if (nonNull(n)) {
1537         ERRMSG(line) "Repeated definition for selector \"%s\"",
1538             textToStr(t)
1539         EEND;
1540     }
1541
1542     n              = newName(t,NIL);
1543     name(n).line   = line;
1544     name(n).number = SELNAME;
1545     name(n).arity  = 1;
1546     name(n).defn   = NIL;
1547     name(n).type = type;
1548     return n;
1549 }
1550
1551
1552 static Name startGHCConstr ( Int line, Int conNo, ZTriple constr )
1553 {
1554     /* constr :: ((ConId,[((Type,Text,Int))],Type)) */
1555     /* (ADR) ToDo: add rank2 annotation and existential annotation
1556      * these affect how constr can be used.
1557      */
1558     Text con   = textOf(zfst3(constr));
1559     Type type  = zthd3(constr);
1560     Int  arity = arityFromType(type);
1561     Name n = findName(con);     /* Allocate constructor fun name   */
1562     if (isNull(n)) {
1563         n = newName(con,NIL);
1564     } else if (name(n).defn!=PREDEFINED) {
1565         ERRMSG(line) "Repeated definition for constructor \"%s\"",
1566             textToStr(con)
1567         EEND;
1568     }
1569     name(n).arity  = arity;     /* Save constructor fun details    */
1570     name(n).line   = line;
1571     name(n).number = cfunNo(conNo);
1572     name(n).type   = type;
1573     return n;
1574 }
1575
1576
1577 static Void finishGHCDataDecl ( ConId tyc )
1578 {
1579     List  nms;
1580     Tycon tc = findTycon(textOf(tyc));
1581 #   ifdef DEBUG_IFACE
1582     printf ( "begin finishGHCDataDecl %s\n", textToStr(textOf(tyc)) );
1583 #   endif
1584     if (isNull(tc)) internal("finishGHCDataDecl");
1585
1586     for (nms=tycon(tc).defn; nonNull(nms); nms=tl(nms)) {
1587        Name n    = hd(nms);
1588        Int  line = name(n).line;
1589        assert(currentModule == name(n).mod);
1590        name(n).type = conidcellsToTycons(line,name(n).type);
1591     }
1592 }
1593
1594
1595 /* --------------------------------------------------------------------------
1596  * Newtype decls
1597  * ------------------------------------------------------------------------*/
1598
1599 Void startGHCNewType ( Int line, List ctx0,
1600                        ConId tycon, List tvs, Cell constr )
1601 {
1602     /* ctx0   :: [((QConId,VarId))]                */
1603     /* tycon  :: ConId                             */
1604     /* tvs    :: [((VarId,Kind))]                  */
1605     /* constr :: ((ConId,Type)) or NIL if abstract */
1606     List tmp;
1607     Type resTy;
1608     Text t = textOf(tycon);
1609 #   ifdef DEBUG_IFACE
1610     fprintf(stderr, "begin startGHCNewType %s\n", textToStr(t) );
1611 #   endif
1612     if (nonNull(findTycon(t))) {
1613         ERRMSG(line) "Repeated definition of type constructor \"%s\"",
1614                      textToStr(t)
1615         EEND;
1616     } else {
1617         Tycon tc        = newTycon(t);
1618         tycon(tc).line  = line;
1619         tycon(tc).arity = length(tvs);
1620         tycon(tc).what  = NEWTYPE;
1621         tycon(tc).kind  = tvsToKind(tvs);
1622         /* can't really do this until I've read in all synonyms */
1623
1624         if (isNull(constr)) {
1625            tycon(tc).defn = NIL;
1626         } else {
1627            /* constr :: ((ConId,Type)) */
1628            Text con   = textOf(zfst(constr));
1629            Type type  = zsnd(constr);
1630            Name n = findName(con);     /* Allocate constructor fun name   */
1631            if (isNull(n)) {
1632                n = newName(con,NIL);
1633            } else if (name(n).defn!=PREDEFINED) {
1634                ERRMSG(line) "Repeated definition for constructor \"%s\"",
1635                   textToStr(con)
1636                EEND;
1637            }
1638            name(n).arity  = 1;         /* Save constructor fun details    */
1639            name(n).line   = line;
1640            name(n).number = cfunNo(0);
1641            name(n).defn   = nameId;
1642            tycon(tc).defn = singleton(n);
1643
1644            /* make resTy the result type of the constr, T v1 ... vn */
1645            resTy = tycon;
1646            for (tmp=tvs; nonNull(tmp); tmp=tl(tmp))
1647               resTy = ap(resTy,zfst(hd(tmp)));
1648            type = fn(type,resTy);
1649            if (nonNull(ctx0))
1650               type = ap(QUAL,pair(ctx0,type));
1651            type = tvsToOffsets(line,type,tvs);
1652            name(n).type   = type;
1653         }
1654     }
1655 }
1656
1657
1658 static Void finishGHCNewType ( ConId tyc )
1659 {
1660     Tycon tc = findTycon(textOf(tyc));
1661 #   ifdef DEBUG_IFACE
1662     printf ( "begin finishGHCNewType %s\n", textToStr(textOf(tyc)) );
1663 #   endif
1664
1665     if (isNull(tc)) internal("finishGHCNewType");
1666
1667     if (isNull(tycon(tc).defn)) {
1668        /* it's an abstract type */
1669     }
1670     else if (length(tycon(tc).defn) == 1) {
1671        /* As we expect, has a single constructor */
1672        Name n    = hd(tycon(tc).defn);
1673        Int  line = name(n).line;
1674        assert(currentModule == name(n).mod);
1675        name(n).type = conidcellsToTycons(line,name(n).type);
1676     } else {
1677        internal("finishGHCNewType(2)");
1678     }
1679 }
1680
1681
1682 /* --------------------------------------------------------------------------
1683  * Class declarations
1684  * ------------------------------------------------------------------------*/
1685
1686 Void startGHCClass(line,ctxt,tc_name,kinded_tvs,mems0)
1687 Int   line;
1688 List  ctxt;       /* [((QConId, VarId))]   */
1689 ConId tc_name;    /* ConId                 */
1690 List  kinded_tvs; /* [((VarId, Kind))]     */
1691 List  mems0; {    /* [((VarId, Type))]     */
1692
1693     List mems;    /* [((VarId, Type))]     */
1694     List tvsInT;  /* [VarId] and then [((VarId,Kind))] */
1695     List tvs;     /* [((VarId,Kind))]      */
1696
1697     ZPair kinded_tv = hd(kinded_tvs);
1698     Text ct         = textOf(tc_name);
1699     Pair newCtx     = pair(tc_name, zfst(kinded_tv));
1700 #   ifdef DEBUG_IFACE
1701     printf ( "begin startGHCClass %s\n", textToStr(ct) );
1702 #   endif
1703
1704     if (length(kinded_tvs) != 1) {
1705         ERRMSG(line) "Cannot presently handle multiparam type classes in ifaces"
1706         EEND;
1707     }
1708
1709     if (nonNull(findClass(ct))) {
1710         ERRMSG(line) "Repeated definition of class \"%s\"",
1711                      textToStr(ct)
1712         EEND;
1713     } else if (nonNull(findTycon(ct))) {
1714         ERRMSG(line) "\"%s\" used as both class and type constructor",
1715                      textToStr(ct)
1716         EEND;
1717     } else {
1718         Class nw              = newClass(ct);
1719         cclass(nw).text       = ct;
1720         cclass(nw).line       = line;
1721         cclass(nw).arity      = 1;
1722         cclass(nw).head       = ap(nw,mkOffset(0));
1723         cclass(nw).kinds      = singleton(STAR); /* absolutely no idea at all */
1724         cclass(nw).instances  = NIL;             /* what the kind should be   */
1725         cclass(nw).numSupers  = length(ctxt);
1726
1727         /* Kludge to map the single tyvar in the context to Offset 0.
1728            Need to do something better for multiparam type classes.
1729
1730         cclass(nw).supers     = tvsToOffsets(line,ctxt,
1731                                              singleton(pair(tv,STAR)));
1732         */
1733         cclass(nw).supers     = tvsToOffsets(line,ctxt,
1734                                              singleton(kinded_tv));
1735
1736
1737         for (mems=mems0; nonNull(mems); mems=tl(mems)) {
1738            ZPair mem  = hd(mems);
1739            Type  memT = zsnd(mem);
1740            Text  mnt  = textOf(zfst(mem));
1741            Name  mn;
1742
1743            /* Stick the new context on the member type */
1744            memT = dictapsToQualtype(memT);
1745            if (whatIs(memT)==POLYTYPE) internal("startGHCClass");
1746            if (whatIs(memT)==QUAL) {
1747               memT = pair(QUAL,
1748                           pair(cons(newCtx,fst(snd(memT))),snd(snd(memT))));
1749            } else {
1750               memT = pair(QUAL,
1751                           pair(singleton(newCtx),memT));
1752            }
1753
1754            /* Cook up a kind for the type. */
1755            tvsInT = ifTyvarsIn(memT);
1756            /* tvsInT :: [VarId] */
1757
1758            /* ToDo: maximally bogus */
1759            for (tvs=tvsInT; nonNull(tvs); tvs=tl(tvs))
1760               hd(tvs) = zpair(hd(tvs),STAR);
1761            /* tvsIntT :: [((VarId,STAR))] */
1762
1763            memT = mkPolyType(tvsToKind(tvsInT),memT);
1764            memT = tvsToOffsets(line,memT,tvsInT);
1765
1766            /* Park the type back on the member */
1767            mem = zpair(zfst(mem),memT);
1768
1769            /* Bind code to the member */
1770            mn = findName(mnt);
1771            if (nonNull(mn)) {
1772               ERRMSG(line)
1773                  "Repeated definition for class method \"%s\"",
1774                  textToStr(mnt)
1775               EEND;
1776            }
1777            mn = newName(mnt,NIL);
1778
1779            hd(mems) = mem;
1780         }
1781
1782         cclass(nw).members    = mems0;
1783         cclass(nw).numMembers = length(mems0);
1784
1785         /* (ADR) ToDo:
1786          * cclass(nw).dsels    = ?;
1787          * cclass(nw).dbuild   = ?;
1788          * cclass(nm).dcon     = ?;
1789          * cclass(nm).defaults = ?;
1790          */
1791     }
1792 }
1793
1794
1795 static Void finishGHCClass ( Tycon cls_tyc )
1796 {
1797     List  mems;
1798     Int   line;
1799     Int   ctr;
1800     Class nw = findClass ( textOf(cls_tyc) );
1801 #   ifdef DEBUG_IFACE
1802     printf ( "begin finishGHCClass %s\n", textToStr(cclass(nw).text) );
1803 #   endif
1804     if (isNull(nw)) internal("finishGHCClass");
1805
1806     line = cclass(nw).line;
1807     ctr  = - length(cclass(nw).members);
1808     assert (currentModule == cclass(nw).mod);
1809
1810     cclass(nw).level   = 0;  /* (ADR) ToDo: 1 + max (map level supers) */
1811     cclass(nw).head    = conidcellsToTycons(line,cclass(nw).head);
1812     cclass(nw).supers  = conidcellsToTycons(line,cclass(nw).supers);
1813     cclass(nw).members = conidcellsToTycons(line,cclass(nw).members);
1814
1815     for (mems=cclass(nw).members; nonNull(mems); mems=tl(mems)) {
1816        Pair mem = hd(mems); /* (VarId, Type) */
1817        Text txt = textOf(fst(mem));
1818        Type ty  = snd(mem);
1819        Name n   = findName(txt);
1820        assert(nonNull(n));
1821        name(n).line   = cclass(nw).line;
1822        name(n).type   = ty;
1823        name(n).number = ctr++;
1824        hd(mems) = n;
1825     }
1826 }
1827
1828
1829 /* --------------------------------------------------------------------------
1830  * Instances
1831  * ------------------------------------------------------------------------*/
1832
1833 Inst startGHCInstance (line,ktyvars,cls,var)
1834 Int   line;
1835 List  ktyvars; /* [((VarId,Kind))] */
1836 Type  cls;     /* Type  */
1837 VarId var; {   /* VarId */
1838     List tmp, tvs, ks, spec;
1839
1840     List xs1, xs2;
1841     Kind k;
1842
1843     Inst in = newInst();
1844 #   ifdef DEBUG_IFACE
1845     printf ( "begin startGHCInstance\n" );
1846 #   endif
1847
1848     tvs = ifTyvarsIn(cls);  /* :: [VarId] */
1849     /* tvs :: [VarId].
1850        The order of tvs is important for tvsToOffsets.
1851        tvs should be a permutation of ktyvars.  Fish the tyvar kinds
1852        out of ktyvars and attach them to tvs.
1853     */
1854     for (xs1=tvs; nonNull(xs1); xs1=tl(xs1)) {
1855        k = NIL;
1856        for (xs2=ktyvars; nonNull(xs2); xs2=tl(xs2))
1857           if (textOf(hd(xs1)) == textOf(zfst(hd(xs2))))
1858              k = zsnd(hd(xs2));
1859        if (isNull(k)) internal("startGHCInstance: finding kinds");
1860        hd(xs1) = zpair(hd(xs1),k);
1861     }
1862
1863     cls = tvsToOffsets(line,cls,tvs);
1864     spec = NIL;
1865     while (isAp(cls)) {
1866        spec = cons(fun(cls),spec);
1867        cls  = arg(cls);
1868     }
1869     spec = reverse(spec);
1870
1871     inst(in).line         = line;
1872     inst(in).implements   = NIL;
1873     inst(in).kinds        = simpleKind(length(tvs)); /* do this right */
1874     inst(in).specifics    = spec;
1875     inst(in).numSpecifics = length(spec);
1876     inst(in).head         = cls;
1877
1878     /* Figure out the name of the class being instanced, and store it
1879        at inst(in).c.  finishGHCInstance will resolve it to a real Class. */
1880     {
1881        Cell cl = inst(in).head;
1882        assert(whatIs(cl)==DICTAP);
1883        cl = unap(DICTAP,cl);
1884        cl = fst(cl);
1885        assert ( isQCon(cl) );
1886        inst(in).c = cl;
1887     }
1888
1889 #if 0
1890     Is this still needed?
1891     {
1892         Name b         = newName(inventText(),NIL);
1893         name(b).line   = line;
1894         name(b).arity  = length(ctxt); /* unused? */
1895         name(b).number = DFUNNAME;
1896         inst(in).builder = b;
1897         bindNameToClosure(b, lookupGHCClosure(inst(in).mod,var));
1898     }
1899 #endif
1900     return in;
1901 }
1902
1903
1904 static Void finishGHCInstance ( Inst in )
1905 {
1906     Int    line;
1907     Class  c;
1908     Type   cls;
1909
1910 #   ifdef DEBUG_IFACE
1911     printf ( "begin finishGHCInstance\n" );
1912 #   endif
1913
1914     assert (nonNull(in));
1915     line = inst(in).line;
1916     assert (currentModule==inst(in).mod);
1917
1918     /* inst(in).c is, prior to finishGHCInstance, a ConId or Tuple,
1919        since startGHCInstance couldn't possibly have resolved it to
1920        a Class at that point.  We convert it to a Class now.
1921     */
1922     c = inst(in).c;
1923     assert(isQCon(c));
1924     c = findQualClassWithoutConsultingExportList(c);
1925     assert(nonNull(c));
1926     inst(in).c = c;
1927
1928     inst(in).head         = conidcellsToTycons(line,inst(in).head);
1929     inst(in).specifics    = conidcellsToTycons(line,inst(in).specifics);
1930     cclass(c).instances   = cons(in,cclass(c).instances);
1931 }
1932
1933
1934 /* --------------------------------------------------------------------------
1935  * Helper fns
1936  * ------------------------------------------------------------------------*/
1937
1938 /* This is called from the startGHC* functions.  It traverses a structure
1939    and converts varidcells, ie, type variables parsed by the interface
1940    parser, into Offsets, which is how Hugs wants to see them internally.
1941    The Offset for a type variable is determined by its place in the list
1942    passed as the second arg; the associated kinds are irrelevant.
1943
1944    ((t1,t2)) denotes the typed (z-)pair of t1 and t2.
1945 */
1946
1947 /* tvsToOffsets :: LineNo -> Type -> [((VarId,Kind))] -> Type */
1948 static Type tvsToOffsets(line,type,ktyvars)
1949 Int  line;
1950 Type type;
1951 List ktyvars; { /* [((VarId,Kind))] */
1952    switch (whatIs(type)) {
1953       case NIL:
1954       case TUPLE:
1955       case QUALIDENT:
1956       case CONIDCELL:
1957       case TYCON:
1958          return type;
1959       case ZTUP2: /* convert to the untyped representation */
1960          return ap( tvsToOffsets(line,zfst(type),ktyvars),
1961                     tvsToOffsets(line,zsnd(type),ktyvars) );
1962       case AP:
1963          return ap( tvsToOffsets(line,fun(type),ktyvars),
1964                     tvsToOffsets(line,arg(type),ktyvars) );
1965       case POLYTYPE:
1966          return mkPolyType (
1967                    polySigOf(type),
1968                    tvsToOffsets(line,monotypeOf(type),ktyvars)
1969                 );
1970          break;
1971       case QUAL:
1972          return pair(QUAL,pair(tvsToOffsets(line,fst(snd(type)),ktyvars),
1973                                tvsToOffsets(line,snd(snd(type)),ktyvars)));
1974       case DICTAP: /* bogus ?? */
1975          return ap(DICTAP, tvsToOffsets(line,snd(type),ktyvars));
1976       case UNBOXEDTUP:  /* bogus?? */
1977          return ap(UNBOXEDTUP, tvsToOffsets(line,snd(type),ktyvars));
1978       case BANG:  /* bogus?? */
1979          return ap(BANG, tvsToOffsets(line,snd(type),ktyvars));
1980       case VARIDCELL: /* Ha! some real work to do! */
1981        { Int i = 0;
1982          Text tv = textOf(type);
1983          for (; nonNull(ktyvars); i++,ktyvars=tl(ktyvars)) {
1984             Cell varid;
1985             Text tt;
1986             assert(isZPair(hd(ktyvars)));
1987             varid = zfst(hd(ktyvars));
1988             tt    = textOf(varid);
1989             if (tv == tt) return mkOffset(i);
1990          }
1991          ERRMSG(line) "Undefined type variable \"%s\"", textToStr(tv)
1992          EEND;
1993          break;
1994        }
1995       default:
1996          fprintf(stderr, "tvsToOffsets: unknown stuff %d\n", whatIs(type));
1997          print(type,20);
1998          fprintf(stderr,"\n");
1999          assert(0);
2000    }
2001    assert(0);
2002    return NIL; /* NOTREACHED */
2003 }
2004
2005
2006 /* This is called from the finishGHC* functions.  It traverses a structure
2007    and converts conidcells, ie, type constructors parsed by the interface
2008    parser, into Tycons (or Classes), which is how Hugs wants to see them
2009    internally.  Calls to this fn have to be deferred to the second phase
2010    of interface loading (finishGHC* rather than startGHC*) so that all relevant
2011    Tycons or Classes have been loaded into the symbol tables and can be
2012    looked up.
2013 */
2014 static Type conidcellsToTycons ( Int line, Type type )
2015 {
2016    switch (whatIs(type)) {
2017       case NIL:
2018       case OFFSET:
2019       case TYCON:
2020       case CLASS:
2021       case VARIDCELL:
2022       case TUPLE:
2023       case STAR:
2024          return type;
2025       case QUALIDENT:
2026        { Cell t;  /* Tycon or Class */
2027          Text m     = qmodOf(type);
2028          Module mod = findModule(m);
2029          if (isNull(mod)) {
2030             ERRMSG(line)
2031                "Undefined module in qualified name \"%s\"",
2032                identToStr(type)
2033             EEND;
2034             return NIL;
2035          }
2036          t = findQualTyconWithoutConsultingExportList(type);
2037          if (nonNull(t)) return t;
2038          t = findQualClassWithoutConsultingExportList(type);
2039          if (nonNull(t)) return t;
2040          ERRMSG(line)
2041               "Undefined qualified class or type \"%s\"",
2042               identToStr(type)
2043          EEND;
2044          return NIL;
2045        }
2046       case CONIDCELL:
2047        { Tycon tc;
2048          Class cl;
2049          cl = findQualClass(type);
2050          if (nonNull(cl)) return cl;
2051          if (textOf(type)==findText("[]"))
2052             /* a hack; magically qualify [] into PrelBase.[] */
2053             return conidcellsToTycons(line,
2054                                       mkQualId(mkCon(findText("PrelBase")),type));
2055          tc = findQualTycon(type);
2056          if (nonNull(tc)) return tc;
2057          ERRMSG(line)
2058              "Undefined class or type constructor \"%s\"",
2059              identToStr(type)
2060          EEND;
2061          return NIL;
2062        }
2063       case AP:
2064          return ap( conidcellsToTycons(line,fun(type)),
2065                     conidcellsToTycons(line,arg(type)) );
2066       case ZTUP2: /* convert to std pair */
2067          return ap( conidcellsToTycons(line,zfst(type)),
2068                     conidcellsToTycons(line,zsnd(type)) );
2069
2070       case POLYTYPE:
2071          return mkPolyType (
2072                    polySigOf(type),
2073                    conidcellsToTycons(line,monotypeOf(type))
2074                 );
2075          break;
2076       case QUAL:
2077          return pair(QUAL,pair(conidcellsToTycons(line,fst(snd(type))),
2078                                conidcellsToTycons(line,snd(snd(type)))));
2079       case DICTAP: /* :: ap(DICTAP, pair(Class,Type))
2080                       Not sure if this is really the right place to
2081                       convert it to the form Hugs wants, but will do so anyway.
2082                     */
2083          /* return ap(DICTAP, conidcellsToTycons(line, snd(type))); */
2084         {
2085            Class cl   = fst(unap(DICTAP,type));
2086            List  args = snd(unap(DICTAP,type));
2087            return
2088               conidcellsToTycons(line,pair(cl,args));
2089         }
2090       case UNBOXEDTUP:
2091          return ap(UNBOXEDTUP, conidcellsToTycons(line, snd(type)));
2092       case BANG:
2093          return ap(BANG, conidcellsToTycons(line, snd(type)));
2094       default:
2095          fprintf(stderr, "conidcellsToTycons: unknown stuff %d\n",
2096                  whatIs(type));
2097          print(type,20);
2098          fprintf(stderr,"\n");
2099          assert(0);
2100    }
2101    assert(0);
2102    return NIL; /* NOTREACHED */
2103 }
2104
2105
2106 /* Find out if a type mentions a type constructor not present in
2107    the supplied list of qualified tycons.
2108 */
2109 static Bool allTypesKnown ( Type  type,
2110                             List  aktys /* [QualId] */,
2111                             ConId thisMod )
2112 {
2113    switch (whatIs(type)) {
2114       case NIL:
2115       case OFFSET:
2116       case VARIDCELL:
2117       case TUPLE:
2118          return TRUE;
2119       case AP:
2120          return allTypesKnown(fun(type),aktys,thisMod)
2121                 && allTypesKnown(arg(type),aktys,thisMod);
2122       case ZTUP2:
2123          return allTypesKnown(zfst(type),aktys,thisMod)
2124                 && allTypesKnown(zsnd(type),aktys,thisMod);
2125       case DICTAP:
2126          return allTypesKnown(unap(DICTAP,type),aktys,thisMod);
2127
2128       case CONIDCELL:
2129         if (textOf(type)==findText("[]"))
2130             /* a hack; magically qualify [] into PrelBase.[] */
2131             type = mkQualId(mkCon(findText("PrelBase")),type); else
2132             type = mkQualId(thisMod,type);
2133          /* fall through */
2134       case QUALIDENT:
2135          if (isNull(qualidIsMember(type,aktys))) goto missing;
2136          return TRUE;
2137       case TYCON:
2138          return TRUE;
2139
2140       default:
2141          fprintf(stderr, "allTypesKnown: unknown stuff %d\n", whatIs(type));
2142          print(type,10);printf("\n");
2143          internal("allTypesKnown");
2144          return TRUE; /*notreached*/
2145    }
2146   missing:
2147    printf ( "allTypesKnown: unknown " ); print(type,10); printf("\n");
2148    return FALSE;
2149 }
2150
2151
2152 /* --------------------------------------------------------------------------
2153  * Utilities
2154  *
2155  * None of these do lookups or require that lookups have been resolved
2156  * so they can be performed while reading interfaces.
2157  * ------------------------------------------------------------------------*/
2158
2159 /* tvsToKind :: [((VarId,Kind))] -> Kinds */
2160 static Kinds tvsToKind(tvs)
2161 List tvs; { /* [((VarId,Kind))] */
2162     List  rs;
2163     Kinds r  = STAR;
2164     for (rs=reverse(tvs); nonNull(rs); rs=tl(rs)) {
2165         if (whatIs(hd(rs)) != ZTUP2) internal("tvsToKind(1)");
2166         if (whatIs(zfst(hd(rs))) != VARIDCELL) internal("tvsToKind(2)");
2167         r = ap(zsnd(hd(rs)),r);
2168     }
2169     return r;
2170 }
2171
2172
2173 static Int arityInclDictParams ( Type type )
2174 {
2175    Int arity = 0;
2176    if (isPolyType(type)) type = monotypeOf(type);
2177
2178    if (whatIs(type) == QUAL)
2179    {
2180       arity += length ( fst(snd(type)) );
2181       type = snd(snd(type));
2182    }
2183    while (isAp(type) && getHead(type)==typeArrow) {
2184       arity++;
2185       type = arg(type);
2186    }
2187    return arity;
2188 }
2189
2190 /* arity of a constructor with this type */
2191 static Int arityFromType(type)
2192 Type type; {
2193     Int arity = 0;
2194     if (isPolyType(type)) {
2195         type = monotypeOf(type);
2196     }
2197     if (whatIs(type) == QUAL) {
2198         type = snd(snd(type));
2199     }
2200     if (whatIs(type) == EXIST) {
2201         type = snd(snd(type));
2202     }
2203     if (whatIs(type)==RANK2) {
2204         type = snd(snd(type));
2205     }
2206     while (isAp(type) && getHead(type)==typeArrow) {
2207         arity++;
2208         type = arg(type);
2209     }
2210     return arity;
2211 }
2212
2213
2214 /* ifTyvarsIn :: Type -> [VarId]
2215    The returned list has no duplicates -- is a set.
2216 */
2217 static List ifTyvarsIn(type)
2218 Type type; {
2219     List vs = typeVarsIn(type,NIL,NIL,NIL);
2220     List vs2 = vs;
2221     for (; nonNull(vs2); vs2=tl(vs2))
2222        if (whatIs(hd(vs2)) != VARIDCELL)
2223           internal("ifTyvarsIn");
2224     return vs;
2225 }
2226
2227
2228
2229 /* --------------------------------------------------------------------------
2230  * General object symbol query stuff
2231  * ------------------------------------------------------------------------*/
2232
2233 #define EXTERN_SYMS                  \
2234       Sym(stg_gc_enter_1)            \
2235       Sym(stg_gc_noregs)             \
2236       Sym(stg_gc_seq_1)              \
2237       Sym(stg_gc_d1)                 \
2238       Sym(stg_gc_f1)                 \
2239       Sym(stg_chk_0)                 \
2240       Sym(stg_chk_1)                 \
2241       Sym(stg_gen_chk)               \
2242       Sym(stg_exit)                  \
2243       Sym(stg_update_PAP)            \
2244       Sym(stg_error_entry)           \
2245       Sym(__ap_2_upd_info)           \
2246       Sym(__ap_3_upd_info)           \
2247       Sym(__ap_4_upd_info)           \
2248       Sym(__ap_5_upd_info)           \
2249       Sym(__ap_6_upd_info)           \
2250       Sym(__sel_0_upd_info)          \
2251       Sym(__sel_1_upd_info)          \
2252       Sym(__sel_2_upd_info)          \
2253       Sym(__sel_3_upd_info)          \
2254       Sym(__sel_4_upd_info)          \
2255       Sym(__sel_5_upd_info)          \
2256       Sym(__sel_6_upd_info)          \
2257       Sym(__sel_7_upd_info)          \
2258       Sym(__sel_8_upd_info)          \
2259       Sym(__sel_9_upd_info)          \
2260       Sym(__sel_10_upd_info)         \
2261       Sym(__sel_11_upd_info)         \
2262       Sym(__sel_12_upd_info)         \
2263       Sym(MainRegTable)              \
2264       Sym(Upd_frame_info)            \
2265       Sym(seq_frame_info)            \
2266       Sym(CAF_BLACKHOLE_info)        \
2267       Sym(IND_STATIC_info)           \
2268       Sym(EMPTY_MVAR_info)           \
2269       Sym(MUT_ARR_PTRS_FROZEN_info)  \
2270       Sym(newCAF)                    \
2271       Sym(putMVarzh_fast)            \
2272       Sym(newMVarzh_fast)            \
2273       Sym(takeMVarzh_fast)           \
2274       Sym(catchzh_fast)              \
2275       Sym(raisezh_fast)              \
2276       Sym(delayzh_fast)              \
2277       Sym(yieldzh_fast)              \
2278       Sym(killThreadzh_fast)         \
2279       Sym(waitReadzh_fast)           \
2280       Sym(waitWritezh_fast)          \
2281       Sym(CHARLIKE_closure)          \
2282       Sym(INTLIKE_closure)           \
2283       Sym(suspendThread)             \
2284       Sym(resumeThread)              \
2285       Sym(stackOverflow)             \
2286       Sym(int2Integerzh_fast)        \
2287       Sym(stg_gc_unbx_r1)            \
2288       Sym(ErrorHdrHook)              \
2289       Sym(makeForeignObjzh_fast)     \
2290       Sym(__encodeDouble)            \
2291       Sym(decodeDoublezh_fast)       \
2292       Sym(isDoubleNaN)               \
2293       Sym(isDoubleInfinite)          \
2294       Sym(isDoubleDenormalized)      \
2295       Sym(isDoubleNegativeZero)      \
2296       Sym(__encodeFloat)             \
2297       Sym(decodeFloatzh_fast)        \
2298       Sym(isFloatNaN)                \
2299       Sym(isFloatInfinite)           \
2300       Sym(isFloatDenormalized)       \
2301       Sym(isFloatNegativeZero)       \
2302       Sym(__int_encodeFloat)         \
2303       Sym(__int_encodeDouble)        \
2304       Sym(mpz_cmp_si)                \
2305       Sym(mpz_cmp)                   \
2306       Sym(__mpn_gcd_1)               \
2307       Sym(gcdIntegerzh_fast)         \
2308       Sym(newArrayzh_fast)           \
2309       Sym(unsafeThawArrayzh_fast)    \
2310       Sym(newDoubleArrayzh_fast)     \
2311       Sym(newFloatArrayzh_fast)      \
2312       Sym(newAddrArrayzh_fast)       \
2313       Sym(newWordArrayzh_fast)       \
2314       Sym(newIntArrayzh_fast)        \
2315       Sym(newCharArrayzh_fast)       \
2316       Sym(newMutVarzh_fast)          \
2317       Sym(quotRemIntegerzh_fast)     \
2318       Sym(quotIntegerzh_fast)        \
2319       Sym(remIntegerzh_fast)         \
2320       Sym(divExactIntegerzh_fast)    \
2321       Sym(divModIntegerzh_fast)      \
2322       Sym(timesIntegerzh_fast)       \
2323       Sym(minusIntegerzh_fast)       \
2324       Sym(plusIntegerzh_fast)        \
2325       Sym(addr2Integerzh_fast)       \
2326       Sym(mkWeakzh_fast)             \
2327       Sym(prog_argv)                 \
2328       Sym(prog_argc)                 \
2329       Sym(resetNonBlockingFd)        \
2330                                      \
2331       /* needed by libHS_cbits */    \
2332       SymX(malloc)                   \
2333       Sym(__errno_location)          \
2334       SymX(close)                    \
2335       Sym(__xstat)                   \
2336       Sym(__fxstat)                  \
2337       Sym(__lxstat)                  \
2338       Sym(mkdir)                     \
2339       SymX(close)                    \
2340       Sym(opendir)                   \
2341       Sym(closedir)                  \
2342       Sym(readdir)                   \
2343       Sym(tcgetattr)                 \
2344       Sym(tcsetattr)                 \
2345       SymX(isatty)                   \
2346       SymX(read)                     \
2347       SymX(lseek)                    \
2348       SymX(write)                    \
2349       Sym(getrusage)                 \
2350       Sym(gettimeofday)              \
2351       SymX(realloc)                  \
2352       SymX(getcwd)                   \
2353       SymX(free)                     \
2354       SymX(strcpy)                   \
2355       SymX(select)                   \
2356       Sym(fcntl)                     \
2357       SymX(stderr)                   \
2358       SymX(fprintf)                  \
2359       SymX(exit)                     \
2360       Sym(open)                      \
2361       SymX(unlink)                   \
2362       SymX(memcpy)                   \
2363       SymX(memchr)                   \
2364       SymX(rmdir)                    \
2365       SymX(rename)                   \
2366       SymX(chdir)                    \
2367       Sym(localtime)                 \
2368       Sym(strftime)                  \
2369       SymX(vfork)                    \
2370       SymX(execl)                    \
2371       SymX(_exit)                    \
2372       Sym(waitpid)                   \
2373       Sym(tzname)                    \
2374       Sym(timezone)                  \
2375       Sym(mktime)                    \
2376       Sym(gmtime)                    \
2377
2378
2379 /* AJG Hack */
2380 #if 0
2381 #undef EXTERN_SYMS
2382 #define EXTERN_SYMS
2383 #endif
2384
2385 /* entirely bogus claims about types of these symbols */
2386 #define Sym(vvv)  extern int vvv;
2387 #define SymX(vvv) /* nothing */
2388 EXTERN_SYMS
2389 #undef Sym
2390 #undef SymX
2391
2392 #define Sym(vvv) { #vvv, &vvv },
2393 #define SymX(vvv) { #vvv, &vvv },
2394 OSym rtsTab[]
2395    = {
2396        EXTERN_SYMS
2397        {0,0}
2398      };
2399 #undef Sym
2400 #undef SymX
2401
2402 void* lookupObjName ( char* nm )
2403 {
2404    int    k;
2405    char*  pp;
2406    void*  a;
2407    Text   t;
2408    Module m;
2409    char   nm2[200];
2410
2411    nm2[199] = 0;
2412    strncpy(nm2,nm,200);
2413
2414    /*  first see if it's an RTS name */
2415    for (k = 0; rtsTab[k].nm; k++)
2416       if (0==strcmp(nm2,rtsTab[k].nm))
2417          return rtsTab[k].ad;
2418
2419    /* perhaps an extra-symbol ? */
2420    a = lookupOExtraTabName ( nm );
2421    if (a) return a;
2422
2423    /* if not an RTS name, look in the
2424       relevant module's object symbol table
2425    */
2426    pp = strchr(nm2, '_');
2427    if (!pp || !isupper(nm2[0])) goto not_found;
2428    *pp = 0;
2429    t = unZcodeThenFindText(nm2);
2430    m = findModule(t);
2431    if (isNull(m)) goto not_found;
2432
2433    a = lookupOTabName ( m, nm );  /* RATIONALISE */
2434    if (a) return a;
2435
2436   not_found:
2437    fprintf ( stderr,
2438              "lookupObjName: can't resolve name `%s'\n",
2439              nm );
2440 assert(4-4);
2441    return NULL;
2442 }
2443
2444
2445 int is_dynamically_loaded_code_or_rodata_ptr ( char* p )
2446 {
2447    OSectionKind sk = lookupSection(p);
2448    assert (sk != HUGS_SECTIONKIND_NOINFOAVAIL);
2449    return (sk == HUGS_SECTIONKIND_CODE_OR_RODATA);
2450 }
2451
2452
2453 int is_dynamically_loaded_rwdata_ptr ( char* p )
2454 {
2455    OSectionKind sk = lookupSection(p);
2456    assert (sk != HUGS_SECTIONKIND_NOINFOAVAIL);
2457    return (sk == HUGS_SECTIONKIND_RWDATA);
2458 }
2459
2460
2461 int is_not_dynamically_loaded_ptr ( char* p )
2462 {
2463    OSectionKind sk = lookupSection(p);
2464    assert (sk != HUGS_SECTIONKIND_NOINFOAVAIL);
2465    return (sk == HUGS_SECTIONKIND_OTHER);
2466 }
2467
2468
2469 /* --------------------------------------------------------------------------
2470  * Control:
2471  * ------------------------------------------------------------------------*/
2472
2473 Void interface(what)
2474 Int what; {
2475     switch (what) {
2476        case POSTPREL: break;
2477
2478        case PREPREL:
2479        case RESET:
2480           ifaces_outstanding  = NIL;
2481           break;
2482        case MARK:
2483           mark(ifaces_outstanding);
2484           break;
2485     }
2486 }
2487
2488 /*-------------------------------------------------------------------------*/