001: /*
002: * PackageFunctions.java
003: *
004: * Copyright (C) 2003 Peter Graves
005: * $Id: PackageFunctions.java,v 1.6 2003/11/15 11:03:35 beedlem Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: public final class PackageFunctions extends Lisp {
025: // ### packagep
026: // packagep object => generalized-boolean
027: private static final Primitive1 PACKAGEP = new Primitive1(
028: "packagep") {
029: public LispObject execute(LispObject arg)
030: throws ConditionThrowable {
031: return arg instanceof Package ? T : NIL;
032: }
033: };
034:
035: // ### package-name
036: // package-name package => nicknames
037: private static final Primitive1 PACKAGE_NAME = new Primitive1(
038: "package-name") {
039: public LispObject execute(LispObject arg)
040: throws ConditionThrowable {
041: String name = coerceToPackage(arg).getName();
042: return name != null ? new LispString(name) : NIL;
043: }
044: };
045:
046: // ### package-nicknames
047: // package-nicknames package => nicknames
048: private static final Primitive1 PACKAGE_NICKNAMES = new Primitive1(
049: "package-nicknames") {
050: public LispObject execute(LispObject arg)
051: throws ConditionThrowable {
052: return coerceToPackage(arg).packageNicknames();
053: }
054: };
055:
056: // ### package-use-list
057: // package-use-list package => use-list
058: private static final Primitive1 PACKAGE_USE_LIST = new Primitive1(
059: "package-use-list") {
060: public LispObject execute(LispObject arg)
061: throws ConditionThrowable {
062: return coerceToPackage(arg).getUseList();
063: }
064: };
065:
066: // ### package-used-by-list
067: // package-used-by-list package => used-by-list
068: private static final Primitive1 PACKAGE_USED_BY_LIST = new Primitive1(
069: "package-used-by-list") {
070: public LispObject execute(LispObject arg)
071: throws ConditionThrowable {
072: return coerceToPackage(arg).getUsedByList();
073: }
074: };
075:
076: // ### import
077: // import symbols &optional package => t
078: private static final Primitive IMPORT = new Primitive("import") {
079: public LispObject execute(LispObject[] args)
080: throws ConditionThrowable {
081: if (args.length == 0 || args.length > 2)
082: throw new ConditionThrowable(
083: new WrongNumberOfArgumentsException(this ));
084: LispObject symbols = args[0];
085: Package pkg = args.length == 2 ? coerceToPackage(args[1])
086: : getCurrentPackage();
087: if (symbols.listp()) {
088: while (symbols != NIL) {
089: pkg.importSymbol(checkSymbol(symbols.car()));
090: symbols = symbols.cdr();
091: }
092: } else
093: pkg.importSymbol(checkSymbol(symbols));
094: return T;
095: }
096: };
097:
098: // ### unexport
099: // unexport symbols &optional package => t
100: private static final Primitive UNEXPORT = new Primitive("unexport") {
101: public LispObject execute(LispObject[] args)
102: throws ConditionThrowable {
103: if (args.length == 0 || args.length > 2)
104: throw new ConditionThrowable(
105: new WrongNumberOfArgumentsException(this ));
106: LispObject symbols = args[0];
107: Package pkg = args.length == 2 ? coerceToPackage(args[1])
108: : getCurrentPackage();
109: if (symbols.listp()) {
110: while (symbols != NIL) {
111: pkg.unexport(checkSymbol(symbols.car()));
112: symbols = symbols.cdr();
113: }
114: } else
115: pkg.unexport(checkSymbol(symbols));
116: return T;
117: }
118: };
119:
120: // ### shadow
121: // shadow symbol-names &optional package => t
122: private static final Primitive SHADOW = new Primitive("shadow") {
123: public LispObject execute(LispObject[] args)
124: throws ConditionThrowable {
125: if (args.length == 0 || args.length > 2)
126: throw new ConditionThrowable(
127: new WrongNumberOfArgumentsException(this ));
128: LispObject symbols = args[0];
129: Package pkg = args.length == 2 ? coerceToPackage(args[1])
130: : getCurrentPackage();
131: if (symbols.listp()) {
132: while (symbols != NIL) {
133: pkg.shadow(javaString(symbols.car()));
134: symbols = symbols.cdr();
135: }
136: } else
137: pkg.shadow(javaString(symbols));
138: return T;
139: }
140: };
141:
142: // ### shadowing-import
143: // shadowing-import symbols &optional package => t
144: private static final Primitive SHADOWING_IMPORT = new Primitive(
145: "shadowing-import") {
146: public LispObject execute(LispObject[] args)
147: throws ConditionThrowable {
148: if (args.length == 0 || args.length > 2)
149: throw new ConditionThrowable(
150: new WrongNumberOfArgumentsException(this ));
151: LispObject symbols = args[0];
152: Package pkg = args.length == 2 ? coerceToPackage(args[1])
153: : getCurrentPackage();
154: if (symbols.listp()) {
155: while (symbols != NIL) {
156: pkg.shadowingImport(checkSymbol(symbols.car()));
157: symbols = symbols.cdr();
158: }
159: } else
160: pkg.shadowingImport(checkSymbol(symbols));
161: return T;
162: }
163: };
164:
165: // ### package-shadowing-symbols
166: // package-shadowing-symbols package => used-by-list
167: private static final Primitive1 PACKAGE_SHADOWING_SYMBOLS = new Primitive1(
168: "package-shadowing-symbols") {
169: public LispObject execute(LispObject arg)
170: throws ConditionThrowable {
171: return coerceToPackage(arg).getShadowingSymbols();
172: }
173: };
174:
175: // ### delete-package
176: private static final Primitive1 DELETE_PACKAGE = new Primitive1(
177: "delete-package") {
178: public LispObject execute(LispObject arg)
179: throws ConditionThrowable {
180: return coerceToPackage(arg).delete() ? T : NIL;
181: }
182: };
183:
184: // ### unuse-package
185: // unuse-package packages-to-unuse &optional package => t
186: private static final Primitive USE_PACKAGE = new Primitive(
187: "unuse-package") {
188: public LispObject execute(LispObject[] args)
189: throws ConditionThrowable {
190: if (args.length < 1 || args.length > 2)
191: throw new ConditionThrowable(
192: new WrongNumberOfArgumentsException(this ));
193: Package pkg;
194: if (args.length == 2)
195: pkg = coerceToPackage(args[1]);
196: else
197: pkg = getCurrentPackage();
198: if (args[0] instanceof Cons) {
199: LispObject list = args[0];
200: while (list != NIL) {
201: pkg.unusePackage(coerceToPackage(list.car()));
202: list = list.cdr();
203: }
204: } else
205: pkg.unusePackage(coerceToPackage(args[0]));
206: return T;
207: }
208: };
209:
210: // ### rename-package
211: // rename-package package new-name &optional new-nicknames => package-object
212: private static final Primitive RENAME_PACKAGE = new Primitive(
213: "rename-package") {
214: public LispObject execute(LispObject[] args)
215: throws ConditionThrowable {
216: if (args.length < 2 || args.length > 3)
217: throw new ConditionThrowable(
218: new WrongNumberOfArgumentsException(this ));
219: Package pkg = coerceToPackage(args[0]);
220: String newName = javaString(args[1]);
221: LispObject nicknames = args.length == 3 ? checkList(args[2])
222: : NIL;
223: pkg.rename(newName, nicknames);
224: return pkg;
225: }
226: };
227:
228: private static final Primitive0 LIST_ALL_PACKAGES = new Primitive0(
229: "list-all-packages") {
230: public LispObject execute() {
231: return Packages.listAllPackages();
232: }
233: };
234:
235: // ### %defpackage
236: // %defpackage name nicknames size shadows shadowing-imports use imports
237: // interns exports doc-string => package
238: private static final Primitive _DEFPACKAGE = new Primitive(
239: "%defpackage", PACKAGE_SYS, false) {
240: public LispObject execute(LispObject[] args)
241: throws ConditionThrowable {
242: if (args.length != 10)
243: throw new ConditionThrowable(
244: new WrongNumberOfArgumentsException(this ));
245: final String packageName = LispString.getValue(args[0]);
246: LispObject nicknames = checkList(args[1]);
247: LispObject size = args[2];
248: LispObject shadows = checkList(args[3]);
249: LispObject shadowingImports = checkList(args[4]);
250: LispObject use = checkList(args[5]);
251: LispObject imports = checkList(args[6]);
252: LispObject interns = checkList(args[7]);
253: LispObject exports = checkList(args[8]);
254: LispObject docString = args[9];
255:
256: Package pkg = Packages.findPackage(packageName);
257: if (pkg != null)
258: return pkg;
259:
260: if (nicknames != NIL) {
261: LispObject list = nicknames;
262: while (list != NIL) {
263: String nick = javaString(list.car());
264: if (Packages.findPackage(nick) != null) {
265: throw new ConditionThrowable(new PackageError(
266: "a package named " + nick
267: + " already exists"));
268: }
269: list = list.cdr();
270: }
271: }
272:
273: pkg = Packages.createPackage(packageName);
274:
275: while (nicknames != NIL) {
276: LispString string = string(nicknames.car());
277: pkg.addNickname(string.getValue());
278: nicknames = nicknames.cdr();
279: }
280:
281: while (shadows != NIL) {
282: String symbolName = LispString.getValue(shadows.car());
283: pkg.shadow(symbolName);
284: shadows = shadows.cdr();
285: }
286:
287: while (shadowingImports != NIL) {
288: LispObject si = shadowingImports.car();
289: Package otherPkg = coerceToPackage(si.car());
290: LispObject symbolNames = si.cdr();
291: while (symbolNames != NIL) {
292: String symbolName = LispString.getValue(symbolNames
293: .car());
294: Symbol sym = otherPkg
295: .findAccessibleSymbol(symbolName);
296: if (sym != null)
297: pkg.shadowingImport(sym);
298: else
299: throw new ConditionThrowable(new LispError(
300: symbolName + " not found in package "
301: + otherPkg.getName()));
302: symbolNames = symbolNames.cdr();
303: }
304: shadowingImports = shadowingImports.cdr();
305: }
306:
307: while (use != NIL) {
308: LispObject obj = use.car();
309: if (obj instanceof Package)
310: pkg.usePackage((Package) obj);
311: else {
312: LispString string = string(obj);
313: Package p = Packages.findPackage(string.getValue());
314: if (p == null)
315: throw new ConditionThrowable(
316: new LispError(
317: String.valueOf(obj)
318: + " is not the name of a package"));
319: pkg.usePackage(p);
320: }
321: use = use.cdr();
322: }
323:
324: while (imports != NIL) {
325: LispObject si = imports.car();
326: Package otherPkg = coerceToPackage(si.car());
327: LispObject symbolNames = si.cdr();
328: while (symbolNames != NIL) {
329: String symbolName = LispString.getValue(symbolNames
330: .car());
331: Symbol sym = otherPkg
332: .findAccessibleSymbol(symbolName);
333: if (sym != null)
334: pkg.importSymbol(sym);
335: else
336: throw new ConditionThrowable(new LispError(
337: symbolName + " not found in package "
338: + otherPkg.getName()));
339: symbolNames = symbolNames.cdr();
340: }
341: imports = imports.cdr();
342: }
343:
344: while (interns != NIL) {
345: String symbolName = LispString.getValue(interns.car());
346: pkg.intern(symbolName);
347: interns = interns.cdr();
348: }
349:
350: while (exports != NIL) {
351: LispObject obj = exports.car();
352: String symbolName = LispString.getValue(exports.car());
353: pkg.export(pkg.intern(symbolName));
354: exports = exports.cdr();
355: }
356:
357: return pkg;
358: }
359: };
360: }
|