ghc/interpreter/modules.c

   1 /* -*- mode: hugs-c; -*- */
   2 /* --------------------------------------------------------------------------
   3  * Import-Export 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: modules.c,v $
  10  * $Revision: 1.2 $
  11  * $Date: 1998/12/02 13:22:21 $
  12  * ------------------------------------------------------------------------*/
  13
  14 #include "prelude.h"
  15 #include "storage.h"
  16 #include "static.h"
  17 #include "errors.h"
  18 #include "link.h"
  19 #include "modules.h"
  20
  21 /* --------------------------------------------------------------------------
  22  * local function prototypes:
  23  * ------------------------------------------------------------------------*/
  24
  25 static Name  local lookupName           Args((Text,List));
  26 static List  local checkSubentities     Args((List,List,List,String,Text));
  27 static List  local checkExportTycon     Args((List,Text,Cell,Tycon));
  28 static List  local checkExportClass     Args((List,Text,Cell,Class));
  29 static List  local checkExport          Args((List,Text,Cell));
  30 static List  local checkImportEntity    Args((List,Module,Cell));
  31 static List  local resolveImportList    Args((Module,Cell));
  32
  33 static Void  local importName           Args((Module,Name));
  34 static Void  local importTycon          Args((Module,Tycon));
  35 static Void  local importClass          Args((Module,Class));
  36
  37 /* --------------------------------------------------------------------------
  38  * Static analysis of modules:
  39  * ------------------------------------------------------------------------*/
  40
  41 Void startModule(nm)                             /* switch to a new module */
  42 Cell nm; {
  43     Module m;
  44     if (!isCon(nm)) internal("startModule");
  45     if (isNull(m = findModule(textOf(nm)))) {
  46         m = newModule(textOf(nm));
  47     } else if (m != modulePreludeHugs) {
  48         ERRMSG(0) "Module \"%s\" already loaded", textToStr(textOf(nm))
  49         EEND;
  50     }
  51     setCurrModule(m);
  52 }
  53
  54 Void setExportList(exps)              /* Add export list to current module */
  55 List exps; {
  56     module(currentModule).exports = exps;
  57 }
  58
  59 Void addQualImport(orig,new)         /* Add to qualified import list       */
  60 Cell orig;     /* Original name of module                                  */
  61 Cell new;  {   /* Name module is called within this module (or NIL)        */
  62     module(currentModule).qualImports =
  63         cons(pair(isNull(new)?orig:new,orig),module(currentModule).qualImports);
  64 }
  65
  66 Void addUnqualImport(mod,entities)     /* Add to unqualified import list   */
  67 Cell mod;         /* Name of module                                        */
  68 List entities;  { /* List of entity names                                  */
  69     unqualImports = cons(pair(mod,entities),unqualImports);
  70 }
  71
  72 Void checkQualImport(i)                /* Process qualified import         */
  73 Pair i; {
  74     Module m = findModid(snd(i));
  75     if (isNull(m)) {
  76         ERRMSG(0) "Module \"%s\" not previously loaded",
  77             textToStr(textOf(snd(i)))
  78         EEND;
  79     }
  80     snd(i)=m;
  81 }
  82
  83 Void checkUnqualImport(i)              /* Process unqualified import       */
  84 Pair i; {
  85     Module m = findModid(fst(i));
  86     if (isNull(m)) {
  87         ERRMSG(0) "Module \"%s\" not previously loaded",
  88             textToStr(textOf(fst(i)))
  89         EEND;
  90     }
  91     fst(i)=m;
  92 }
  93
  94 static Name local lookupName(t,nms)     /* find text t in list of Names     */
  95 Text t;
  96 List nms; { /* :: [Name] */
  97     for(; nonNull(nms); nms=tl(nms)) {
  98         if (t == name(hd(nms)).text)
  99             return hd(nms);
 100     }
 101     return NIL;
 102 }
 103
 104 static List local checkSubentities(imports,named,wanted,description,textParent)
 105 List   imports;
 106 List   named;                 /* :: [ Q?(Var|Con)(Id|Op) ]                  */
 107 List   wanted;                /* :: [Name]                                  */
 108 String description;           /* "<constructor>|<member> of <type>|<class>" */
 109 Text   textParent; {
 110     for(; nonNull(named); named=tl(named)) {
 111         Pair x = hd(named);
 112         /* ToDo: ignores qualifier; doesn't check that entity is in scope */
 113         Text t = isPair(snd(x)) ? qtextOf(x) : textOf(x);
 114         Name n = lookupName(t,wanted);
 115         if (isNull(n)) {
 116             ERRMSG(0) "Entity \"%s\" is not a %s \"%s\"",
 117                 textToStr(t),
 118                 description,
 119                 textToStr(textParent)
 120             EEND;
 121         }
 122         imports = cons(n,imports);
 123     }
 124     return imports;
 125 }
 126
 127 static List local checkImportEntity(imports,exporter,entity)
 128 List   imports; /* Accumulated list of things to import */
 129 Module exporter;
 130 Cell   entity; { /* Entry from import list */
 131     List oldImports = imports;
 132     Text t  = isIdent(entity) ? textOf(entity) : textOf(fst(entity));
 133     List es = module(exporter).exports;
 134     for(; nonNull(es); es=tl(es)) {
 135         Cell e = hd(es); /* :: Entity | (Entity, NIL|DOTDOT) */
 136         if (isPair(e)) {
 137             Cell f = fst(e);
 138             if (isTycon(f)) {
 139                 if (tycon(f).text == t) {
 140                     imports = cons(f,imports);
 141                     if (!isIdent(entity)) {
 142                         switch (tycon(f).what) {
 143                         case NEWTYPE:
 144                         case DATATYPE:
 145                                 if (DOTDOT == snd(entity)) {
 146                                     imports=revDupOnto(tycon(f).defn,imports);
 147                                 } else {
 148                                     imports=checkSubentities(imports,snd(entity),tycon(f).defn,"constructor of type",t);
 149                                 }
 150                                 break;
 151                         default:;
 152                                 /* deliberate fall thru */
 153                         }
 154                     }
 155                 }
 156             } else if (isClass(f)) {
 157                 if (cclass(f).text == t) {
 158                     imports = cons(f,imports);
 159                     if (!isIdent(entity)) {
 160                         if (DOTDOT == snd(entity)) {
 161                             return revDupOnto(cclass(f).members,imports);
 162                         } else {
 163                             return checkSubentities(imports,snd(entity),cclass(f).members,"member of class",t);
 164                         }
 165                     }
 166                 }
 167             } else {
 168                 internal("checkImportEntity2");
 169             }
 170         } else if (isName(e)) {
 171             if (isIdent(entity) && name(e).text == t) {
 172                 imports = cons(e,imports);
 173             }
 174         } else {
 175             internal("checkImportEntity3");
 176         }
 177     }
 178     if (imports == oldImports) {
 179         ERRMSG(0) "Unknown entity \"%s\" imported from module \"%s\"",
 180             textToStr(t),
 181             textToStr(module(exporter ).text)
 182         EEND;
 183     }
 184     return imports;
 185 }
 186
 187 static List local resolveImportList(m,impList)
 188 Module m;  /* exporting module */
 189 Cell   impList; {
 190     List imports = NIL;
 191     if (DOTDOT == impList) {
 192         List es = module(m).exports;
 193         for(; nonNull(es); es=tl(es)) {
 194             Cell e = hd(es);
 195             if (isName(e)) {
 196                 imports = cons(e,imports);
 197             } else {
 198                 Cell c = fst(e);
 199                 List subentities = NIL;
 200                 imports = cons(c,imports);
 201                 if (isTycon(c)
 202                     && (tycon(c).what == DATATYPE
 203                         || tycon(c).what == NEWTYPE))
 204                     subentities = tycon(c).defn;
 205                 else if (isClass(c))
 206                     subentities = cclass(c).members;
 207                 if (DOTDOT == snd(e)) {
 208                     imports = revDupOnto(subentities,imports);
 209                 }
 210             }
 211         }
 212     } else {
 213         map1Accum(checkImportEntity,imports,m,impList);
 214     }
 215     return imports;
 216 }
 217
 218 Void checkImportList(thisModule,importSpec)  /* Import a module unqualified */
 219 Module thisModule;
 220 Pair   importSpec; {
 221     Module m       = fst(importSpec);
 222     Cell   impList = snd(importSpec);
 223
 224     List   imports = NIL; /* entities we want to import */
 225     List   hidden  = NIL; /* entities we want to hide   */
 226
 227     if (m == thisModule) {
 228         ERRMSG(0) "Module \"%s\" recursively imports itself",
 229             textToStr(module(m).text)
 230         EEND;
 231     }
 232     if (isPair(impList) && HIDDEN == fst(impList)) {
 233         /* Somewhat inefficient - but obviously correct:
 234          * imports = importsOf("module Foo") `setDifference` hidden;
 235          */
 236         hidden  = resolveImportList(m, snd(impList));
 237         imports = resolveImportList(m, DOTDOT);
 238     } else {
 239         imports = resolveImportList(m, impList);
 240     }
 241     for(; nonNull(imports); imports=tl(imports)) {
 242         Cell e = hd(imports);
 243         if (!cellIsMember(e,hidden))
 244             importEntity(m,e);
 245     }
 246     /* ToDo: hang onto the imports list for processing export list entries
 247      * of the form "module Foo"
 248      */
 249 }
 250
 251 Void importEntity(source,e)
 252 Module source;
 253 Cell e; {
 254     switch (whatIs(e)) {
 255     case NAME  : importName(source,e);
 256             break;
 257     case TYCON : importTycon(source,e);
 258             break;
 259     case CLASS : importClass(source,e);
 260             break;
 261     default: internal("importEntity");
 262     }
 263 }
 264
 265 static Void local importName(source,n)
 266 Module source;
 267 Name n; {
 268     Name clash = addName(n);
 269     if (nonNull(clash) && clash!=n) {
 270         ERRMSG(0) "Entity \"%s\" imported from module \"%s\" already defined in module \"%s\"",
 271             textToStr(name(n).text),
 272             textToStr(module(source).text),
 273             textToStr(module(name(clash).mod).text)
 274         EEND;
 275     }
 276 }
 277
 278 static Void local importTycon(source,tc)
 279 Module source;
 280 Tycon tc; {
 281     Tycon clash=addTycon(tc);
 282     if (nonNull(clash) && clash!=tc) {
 283         ERRMSG(0) "Tycon \"%s\" imported from \"%s\" already defined in module \"%s\"",
 284             textToStr(tycon(tc).text),
 285             textToStr(module(source).text),
 286             textToStr(module(tycon(clash).mod).text)
 287         EEND;
 288     }
 289     if (nonNull(findClass(tycon(tc).text))) {
 290         ERRMSG(0) "Import of type constructor \"%s\" clashes with class in module \"%s\"",
 291             textToStr(tycon(tc).text),
 292             textToStr(module(tycon(tc).mod).text)
 293         EEND;
 294     }
 295 }
 296
 297 static Void local importClass(source,c)
 298 Module source;
 299 Class c; {
 300     Class clash=addClass(c);
 301     if (nonNull(clash) && clash!=c) {
 302         ERRMSG(0) "Class \"%s\" imported from \"%s\" already defined in module \"%s\"",
 303             textToStr(cclass(c).text),
 304             textToStr(module(source).text),
 305             textToStr(module(cclass(clash).mod).text)
 306         EEND;
 307     }
 308     if (nonNull(findTycon(cclass(c).text))) {
 309         ERRMSG(0) "Import of class \"%s\" clashes with type constructor in module \"%s\"",
 310             textToStr(cclass(c).text),
 311             textToStr(module(source).text)
 312         EEND;
 313     }
 314 }
 315
 316 static List local checkExportTycon(exports,mt,spec,tc)
 317 List  exports;
 318 Text  mt;
 319 Cell  spec;
 320 Tycon tc; {
 321     if (DOTDOT == spec || SYNONYM == tycon(tc).what) {
 322         return cons(pair(tc,DOTDOT), exports);
 323     } else {
 324         return cons(pair(tc,NIL), exports);
 325     }
 326 }
 327
 328 static List local checkExportClass(exports,mt,spec,cl)
 329 List  exports;
 330 Text  mt;
 331 Class cl;
 332 Cell  spec; {
 333     if (DOTDOT == spec) {
 334         return cons(pair(cl,DOTDOT), exports);
 335     } else {
 336         return cons(pair(cl,NIL), exports);
 337     }
 338 }
 339
 340 static List local checkExport(exports,mt,e) /* Process entry in export list*/
 341 List exports;
 342 Text mt;
 343 Cell e; {
 344     if (isIdent(e)) {
 345         Cell export = NIL;
 346         List origExports = exports;
 347         if (nonNull(export=findQualName(0,e))) {
 348             exports=cons(export,exports);
 349         }
 350         if (isQCon(e) && nonNull(export=findQualTycon(e))) {
 351             exports = checkExportTycon(exports,mt,NIL,export);
 352         }
 353         if (isQCon(e) && nonNull(export=findQualClass(e))) {
 354             /* opaque class export */
 355             exports = checkExportClass(exports,mt,NIL,export);
 356         }
 357         if (exports == origExports) {
 358             ERRMSG(0) "Unknown entity \"%s\" exported from module \"%s\"",
 359                 identToStr(e),
 360                 textToStr(mt)
 361             EEND;
 362         }
 363         return exports;
 364     } else if (MODULEENT == fst(e)) {
 365         Module m = findModid(snd(e));
 366         /* ToDo: shouldn't allow export of module we didn't import */
 367         if (isNull(m)) {
 368             ERRMSG(0) "Unknown module \"%s\" exported from module \"%s\"",
 369                 textToStr(textOf(snd(e))),
 370                 textToStr(mt)
 371             EEND;
 372         }
 373         if (m == currentModule) {
 374             /* Exporting the current module exports local definitions */
 375             List xs;
 376             for(xs=module(m).classes; nonNull(xs); xs=tl(xs)) {
 377                 if (cclass(hd(xs)).mod==m)
 378                     exports = checkExportClass(exports,mt,DOTDOT,hd(xs));
 379             }
 380             for(xs=module(m).tycons; nonNull(xs); xs=tl(xs)) {
 381                 if (tycon(hd(xs)).mod==m)
 382                     exports = checkExportTycon(exports,mt,DOTDOT,hd(xs));
 383             }
 384             for(xs=module(m).names; nonNull(xs); xs=tl(xs)) {
 385                 if (name(hd(xs)).mod==m)
 386                     exports = cons(hd(xs),exports);
 387             }
 388         } else {
 389             /* Exporting other modules imports all things imported
 390              * unqualified from it.
 391              * ToDo: we reexport everything exported by a module -
 392              * whether we imported it or not.  This gives the wrong
 393              * result for "module M(module N) where import N(x)"
 394              */
 395             exports = revDupOnto(module(m).exports,exports);
 396         }
 397         return exports;
 398     } else {
 399         Cell ident = fst(e); /* class name or type name */
 400         Cell parts = snd(e); /* members or constructors */
 401         Cell nm;
 402         if (isQCon(ident) && nonNull(nm=findQualTycon(ident))) {
 403             switch (tycon(nm).what) {
 404             case SYNONYM:
 405                     if (DOTDOT!=parts) {
 406                         ERRMSG(0) "Explicit constructor list given for type synonym \"%s\" in export list of module \"%s\"",
 407                             identToStr(ident),
 408                             textToStr(mt)
 409                         EEND;
 410                     }
 411                     return cons(pair(nm,DOTDOT),exports);
 412             case RESTRICTSYN:
 413                     ERRMSG(0) "Transparent export of restricted type synonym \"%s\" in export list of module \"%s\"",
 414                         identToStr(ident),
 415                         textToStr(mt)
 416                     EEND;
 417                     return exports; /* Not reached */
 418             case NEWTYPE:
 419             case DATATYPE:
 420                     if (DOTDOT==parts) {
 421                         return cons(pair(nm,DOTDOT),exports);
 422                     } else {
 423                         exports = checkSubentities(exports,parts,tycon(nm).defn,
 424                                                    "constructor of type",
 425                                                    tycon(nm).text);
 426                         return cons(pair(nm,DOTDOT), exports);
 427                     }
 428             default:
 429                     internal("checkExport1");
 430             }
 431         } else if (isQCon(ident) && nonNull(nm=findQualClass(ident))) {
 432             if (DOTDOT == parts) {
 433                 return cons(pair(nm,DOTDOT),exports);
 434             } else {
 435                 exports = checkSubentities(exports,parts,cclass(nm).members,
 436                                            "member of class",cclass(nm).text);
 437                 return cons(pair(nm,DOTDOT), exports);
 438             }
 439         } else {
 440             ERRMSG(0) "Explicit export list given for non-class/datatype \"%s\" in export list of module \"%s\"",
 441                 identToStr(ident),
 442                 textToStr(mt)
 443             EEND;
 444         }
 445     }
 446 }
 447
 448 List checkExports(thisModule,exports)
 449 Module thisModule;
 450 List   exports; {
 451     Text   mt = module(thisModule).text;
 452     List   es = NIL;
 453
 454     map1Accum(checkExport,es,mt,exports);
 455
 456 #if DEBUG_MODULES
 457     for(xs=es; nonNull(xs); xs=tl(xs)) {
 458         printf(" %s", textToStr(textOfEntity(hd(xs))));
 459     }
 460 #endif
 461     return es;
 462 }
 463
 464 /*-------------------------------------------------------------------------*/
 465