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