1 /* -*- mode: hugs-c; -*- */
2 /* --------------------------------------------------------------------------
3 * Import-Export processing for Hugs
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
9 * $RCSfile: modules.c,v $
11 * $Date: 1998/12/02 13:22:21 $
12 * ------------------------------------------------------------------------*/
21 /* --------------------------------------------------------------------------
22 * local function prototypes:
23 * ------------------------------------------------------------------------*/
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));
33 static Void local importName Args((Module,Name));
34 static Void local importTycon Args((Module,Tycon));
35 static Void local importClass Args((Module,Class));
37 /* --------------------------------------------------------------------------
38 * Static analysis of modules:
39 * ------------------------------------------------------------------------*/
41 Void startModule(nm) /* switch to a new module */
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))
54 Void setExportList(exps) /* Add export list to current module */
56 module(currentModule).exports = exps;
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);
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);
72 Void checkQualImport(i) /* Process qualified import */
74 Module m = findModid(snd(i));
76 ERRMSG(0) "Module \"%s\" not previously loaded",
77 textToStr(textOf(snd(i)))
83 Void checkUnqualImport(i) /* Process unqualified import */
85 Module m = findModid(fst(i));
87 ERRMSG(0) "Module \"%s\" not previously loaded",
88 textToStr(textOf(fst(i)))
94 static Name local lookupName(t,nms) /* find text t in list of Names */
96 List nms; { /* :: [Name] */
97 for(; nonNull(nms); nms=tl(nms)) {
98 if (t == name(hd(nms)).text)
104 static List local checkSubentities(imports,named,wanted,description,textParent)
106 List named; /* :: [ Q?(Var|Con)(Id|Op) ] */
107 List wanted; /* :: [Name] */
108 String description; /* "<constructor>|<member> of <type>|<class>" */
110 for(; nonNull(named); named=tl(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);
116 ERRMSG(0) "Entity \"%s\" is not a %s \"%s\"",
119 textToStr(textParent)
122 imports = cons(n,imports);
127 static List local checkImportEntity(imports,exporter,entity)
128 List imports; /* Accumulated list of things to import */
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) */
139 if (tycon(f).text == t) {
140 imports = cons(f,imports);
141 if (!isIdent(entity)) {
142 switch (tycon(f).what) {
145 if (DOTDOT == snd(entity)) {
146 imports=revDupOnto(tycon(f).defn,imports);
148 imports=checkSubentities(imports,snd(entity),tycon(f).defn,"constructor of type",t);
152 /* deliberate fall thru */
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);
163 return checkSubentities(imports,snd(entity),cclass(f).members,"member of class",t);
168 internal("checkImportEntity2");
170 } else if (isName(e)) {
171 if (isIdent(entity) && name(e).text == t) {
172 imports = cons(e,imports);
175 internal("checkImportEntity3");
178 if (imports == oldImports) {
179 ERRMSG(0) "Unknown entity \"%s\" imported from module \"%s\"",
181 textToStr(module(exporter ).text)
187 static List local resolveImportList(m,impList)
188 Module m; /* exporting module */
191 if (DOTDOT == impList) {
192 List es = module(m).exports;
193 for(; nonNull(es); es=tl(es)) {
196 imports = cons(e,imports);
199 List subentities = NIL;
200 imports = cons(c,imports);
202 && (tycon(c).what == DATATYPE
203 || tycon(c).what == NEWTYPE))
204 subentities = tycon(c).defn;
206 subentities = cclass(c).members;
207 if (DOTDOT == snd(e)) {
208 imports = revDupOnto(subentities,imports);
213 map1Accum(checkImportEntity,imports,m,impList);
218 Void checkImportList(thisModule,importSpec) /* Import a module unqualified */
221 Module m = fst(importSpec);
222 Cell impList = snd(importSpec);
224 List imports = NIL; /* entities we want to import */
225 List hidden = NIL; /* entities we want to hide */
227 if (m == thisModule) {
228 ERRMSG(0) "Module \"%s\" recursively imports itself",
229 textToStr(module(m).text)
232 if (isPair(impList) && HIDDEN == fst(impList)) {
233 /* Somewhat inefficient - but obviously correct:
234 * imports = importsOf("module Foo") `setDifference` hidden;
236 hidden = resolveImportList(m, snd(impList));
237 imports = resolveImportList(m, DOTDOT);
239 imports = resolveImportList(m, impList);
241 for(; nonNull(imports); imports=tl(imports)) {
242 Cell e = hd(imports);
243 if (!cellIsMember(e,hidden))
246 /* ToDo: hang onto the imports list for processing export list entries
247 * of the form "module Foo"
251 Void importEntity(source,e)
255 case NAME : importName(source,e);
257 case TYCON : importTycon(source,e);
259 case CLASS : importClass(source,e);
261 default: internal("importEntity");
265 static Void local importName(source,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)
278 static Void local importTycon(source,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)
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)
297 static Void local importClass(source,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)
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)
316 static List local checkExportTycon(exports,mt,spec,tc)
321 if (DOTDOT == spec || SYNONYM == tycon(tc).what) {
322 return cons(pair(tc,DOTDOT), exports);
324 return cons(pair(tc,NIL), exports);
328 static List local checkExportClass(exports,mt,spec,cl)
333 if (DOTDOT == spec) {
334 return cons(pair(cl,DOTDOT), exports);
336 return cons(pair(cl,NIL), exports);
340 static List local checkExport(exports,mt,e) /* Process entry in export list*/
346 List origExports = exports;
347 if (nonNull(export=findQualName(0,e))) {
348 exports=cons(export,exports);
350 if (isQCon(e) && nonNull(export=findQualTycon(e))) {
351 exports = checkExportTycon(exports,mt,NIL,export);
353 if (isQCon(e) && nonNull(export=findQualClass(e))) {
354 /* opaque class export */
355 exports = checkExportClass(exports,mt,NIL,export);
357 if (exports == origExports) {
358 ERRMSG(0) "Unknown entity \"%s\" exported from module \"%s\"",
364 } else if (MODULEENT == fst(e)) {
365 Module m = findModid(snd(e));
366 /* ToDo: shouldn't allow export of module we didn't import */
368 ERRMSG(0) "Unknown module \"%s\" exported from module \"%s\"",
369 textToStr(textOf(snd(e))),
373 if (m == currentModule) {
374 /* Exporting the current module exports local definitions */
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));
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));
384 for(xs=module(m).names; nonNull(xs); xs=tl(xs)) {
385 if (name(hd(xs)).mod==m)
386 exports = cons(hd(xs),exports);
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)"
395 exports = revDupOnto(module(m).exports,exports);
399 Cell ident = fst(e); /* class name or type name */
400 Cell parts = snd(e); /* members or constructors */
402 if (isQCon(ident) && nonNull(nm=findQualTycon(ident))) {
403 switch (tycon(nm).what) {
406 ERRMSG(0) "Explicit constructor list given for type synonym \"%s\" in export list of module \"%s\"",
411 return cons(pair(nm,DOTDOT),exports);
413 ERRMSG(0) "Transparent export of restricted type synonym \"%s\" in export list of module \"%s\"",
417 return exports; /* Not reached */
421 return cons(pair(nm,DOTDOT),exports);
423 exports = checkSubentities(exports,parts,tycon(nm).defn,
424 "constructor of type",
426 return cons(pair(nm,DOTDOT), exports);
429 internal("checkExport1");
431 } else if (isQCon(ident) && nonNull(nm=findQualClass(ident))) {
432 if (DOTDOT == parts) {
433 return cons(pair(nm,DOTDOT),exports);
435 exports = checkSubentities(exports,parts,cclass(nm).members,
436 "member of class",cclass(nm).text);
437 return cons(pair(nm,DOTDOT), exports);
440 ERRMSG(0) "Explicit export list given for non-class/datatype \"%s\" in export list of module \"%s\"",
448 List checkExports(thisModule,exports)
451 Text mt = module(thisModule).text;
454 map1Accum(checkExport,es,mt,exports);
457 for(xs=es; nonNull(xs); xs=tl(xs)) {
458 printf(" %s", textToStr(textOfEntity(hd(xs))));
464 /*-------------------------------------------------------------------------*/