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