001: /*
002: * PackageFunctions.java
003: *
004: * Copyright (C) 2003-2004 Peter Graves
005: * $Id: PackageFunctions.java,v 1.27 2004/08/15 12:39:38 piso 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", "object") {
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", "package") {
039: public LispObject execute(LispObject arg)
040: throws ConditionThrowable {
041: String name = coerceToPackage(arg).getName();
042: return name != null ? new SimpleString(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", "package") {
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", "package") {
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", "package") {
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: "symbols &optional package") {
080: public LispObject execute(LispObject[] args)
081: throws ConditionThrowable {
082: if (args.length == 0 || args.length > 2)
083: return signal(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: "symbols &optional package") {
102: public LispObject execute(LispObject[] args)
103: throws ConditionThrowable {
104: if (args.length == 0 || args.length > 2)
105: return signal(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: "symbol-names &optional package") {
124: public LispObject execute(LispObject[] args)
125: throws ConditionThrowable {
126: if (args.length == 0 || args.length > 2)
127: return signal(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", "symbols &optional package") {
146: public LispObject execute(LispObject[] args)
147: throws ConditionThrowable {
148: if (args.length == 0 || args.length > 2)
149: return signal(new WrongNumberOfArgumentsException(this ));
150: LispObject symbols = args[0];
151: Package pkg = args.length == 2 ? coerceToPackage(args[1])
152: : getCurrentPackage();
153: if (symbols.listp()) {
154: while (symbols != NIL) {
155: pkg.shadowingImport(checkSymbol(symbols.car()));
156: symbols = symbols.cdr();
157: }
158: } else
159: pkg.shadowingImport(checkSymbol(symbols));
160: return T;
161: }
162: };
163:
164: // ### package-shadowing-symbols
165: // package-shadowing-symbols package => used-by-list
166: private static final Primitive1 PACKAGE_SHADOWING_SYMBOLS = new Primitive1(
167: "package-shadowing-symbols", "package") {
168: public LispObject execute(LispObject arg)
169: throws ConditionThrowable {
170: return coerceToPackage(arg).getShadowingSymbols();
171: }
172: };
173:
174: // ### delete-package
175: private static final Primitive1 DELETE_PACKAGE = new Primitive1(
176: "delete-package", "package") {
177: public LispObject execute(LispObject arg)
178: throws ConditionThrowable {
179: return coerceToPackage(arg).delete() ? T : NIL;
180: }
181: };
182:
183: // ### unuse-package
184: // unuse-package packages-to-unuse &optional package => t
185: private static final Primitive USE_PACKAGE = new Primitive(
186: "unuse-package", "packages-to-unuse &optional package") {
187: public LispObject execute(LispObject[] args)
188: throws ConditionThrowable {
189: if (args.length < 1 || args.length > 2)
190: return signal(new WrongNumberOfArgumentsException(this ));
191: Package pkg;
192: if (args.length == 2)
193: pkg = coerceToPackage(args[1]);
194: else
195: pkg = getCurrentPackage();
196: if (args[0] instanceof Cons) {
197: LispObject list = args[0];
198: while (list != NIL) {
199: pkg.unusePackage(coerceToPackage(list.car()));
200: list = list.cdr();
201: }
202: } else
203: pkg.unusePackage(coerceToPackage(args[0]));
204: return T;
205: }
206: };
207:
208: // ### rename-package
209: // rename-package package new-name &optional new-nicknames => package-object
210: private static final Primitive RENAME_PACKAGE = new Primitive(
211: "rename-package",
212: "package new-name &optional new-nicknames") {
213: public LispObject execute(LispObject[] args)
214: throws ConditionThrowable {
215: if (args.length < 2 || args.length > 3)
216: return signal(new WrongNumberOfArgumentsException(this ));
217: Package pkg = coerceToPackage(args[0]);
218: String newName = javaString(args[1]);
219: LispObject nicknames = args.length == 3 ? checkList(args[2])
220: : NIL;
221: pkg.rename(newName, nicknames);
222: return pkg;
223: }
224: };
225:
226: private static final Primitive0 LIST_ALL_PACKAGES = new Primitive0(
227: "list-all-packages", "") {
228: public LispObject execute() {
229: return Packages.listAllPackages();
230: }
231: };
232:
233: // ### %defpackage
234: // %defpackage name nicknames size shadows shadowing-imports use imports
235: // interns exports doc-string => package
236: private static final Primitive _DEFPACKAGE = new Primitive(
237: "%defpackage", PACKAGE_SYS, false) {
238: public LispObject execute(LispObject[] args)
239: throws ConditionThrowable {
240: if (args.length != 10)
241: return signal(new WrongNumberOfArgumentsException(this ));
242: final String packageName = args[0].getStringValue();
243: LispObject nicknames = checkList(args[1]);
244: LispObject size = args[2];
245: LispObject shadows = checkList(args[3]);
246: LispObject shadowingImports = checkList(args[4]);
247: LispObject use = checkList(args[5]);
248: LispObject imports = checkList(args[6]);
249: LispObject interns = checkList(args[7]);
250: LispObject exports = checkList(args[8]);
251: LispObject docString = args[9];
252: Package pkg = Packages.findPackage(packageName);
253: if (pkg != null)
254: return pkg;
255: if (nicknames != NIL) {
256: LispObject list = nicknames;
257: while (list != NIL) {
258: String nick = javaString(list.car());
259: if (Packages.findPackage(nick) != null) {
260: return signal(new PackageError(
261: "A package named " + nick
262: + " already exists."));
263: }
264: list = list.cdr();
265: }
266: }
267: pkg = Packages.createPackage(packageName);
268: while (nicknames != NIL) {
269: LispObject string = nicknames.car().STRING();
270: pkg.addNickname(string.getStringValue());
271: nicknames = nicknames.cdr();
272: }
273: while (shadows != NIL) {
274: String symbolName = shadows.car().getStringValue();
275: pkg.shadow(symbolName);
276: shadows = shadows.cdr();
277: }
278: while (shadowingImports != NIL) {
279: LispObject si = shadowingImports.car();
280: Package otherPkg = coerceToPackage(si.car());
281: LispObject symbolNames = si.cdr();
282: while (symbolNames != NIL) {
283: String symbolName = symbolNames.car()
284: .getStringValue();
285: Symbol sym = otherPkg
286: .findAccessibleSymbol(symbolName);
287: if (sym != null)
288: pkg.shadowingImport(sym);
289: else
290: return signal(new LispError(symbolName
291: + " not found in package "
292: + otherPkg.getName() + "."));
293: symbolNames = symbolNames.cdr();
294: }
295: shadowingImports = shadowingImports.cdr();
296: }
297: while (use != NIL) {
298: LispObject obj = use.car();
299: if (obj instanceof Package)
300: pkg.usePackage((Package) obj);
301: else {
302: LispObject string = obj.STRING();
303: Package p = Packages.findPackage(string
304: .getStringValue());
305: if (p == null)
306: return signal(new LispError(String.valueOf(obj)
307: + " is not the name of a package."));
308: pkg.usePackage(p);
309: }
310: use = use.cdr();
311: }
312: while (imports != NIL) {
313: LispObject si = imports.car();
314: Package otherPkg = coerceToPackage(si.car());
315: LispObject symbolNames = si.cdr();
316: while (symbolNames != NIL) {
317: String symbolName = symbolNames.car()
318: .getStringValue();
319: Symbol sym = otherPkg
320: .findAccessibleSymbol(symbolName);
321: if (sym != null)
322: pkg.importSymbol(sym);
323: else
324: return signal(new LispError(symbolName
325: + " not found in package "
326: + otherPkg.getName() + "."));
327: symbolNames = symbolNames.cdr();
328: }
329: imports = imports.cdr();
330: }
331: while (interns != NIL) {
332: String symbolName = interns.car().getStringValue();
333: pkg.intern(symbolName);
334: interns = interns.cdr();
335: }
336: while (exports != NIL) {
337: LispObject obj = exports.car();
338: String symbolName = exports.car().getStringValue();
339: pkg.export(pkg.intern(symbolName));
340: exports = exports.cdr();
341: }
342: return pkg;
343: }
344: };
345: }
|