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