01: /*
02: * PackageError.java
03: *
04: * Copyright (C) 2003-2004 Peter Graves
05: * $Id: PackageError.java,v 1.12 2004/03/05 16:05:35 piso Exp $
06: *
07: * This program is free software; you can redistribute it and/or
08: * modify it under the terms of the GNU General Public License
09: * as published by the Free Software Foundation; either version 2
10: * of the License, or (at your option) any later version.
11: *
12: * This program is distributed in the hope that it will be useful,
13: * but WITHOUT ANY WARRANTY; without even the implied warranty of
14: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: * GNU General Public License for more details.
16: *
17: * You should have received a copy of the GNU General Public License
18: * along with this program; if not, write to the Free Software
19: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20: */
21:
22: package org.armedbear.lisp;
23:
24: public class PackageError extends LispError {
25: private final LispObject pkg;
26:
27: public PackageError(LispObject initArgs) throws ConditionThrowable {
28: LispObject pkg = NIL;
29: LispObject first, second;
30: while (initArgs != NIL) {
31: first = initArgs.car();
32: initArgs = initArgs.cdr();
33: second = initArgs.car();
34: initArgs = initArgs.cdr();
35: if (first == Keyword.PACKAGE)
36: pkg = second;
37: }
38: this .pkg = pkg;
39: }
40:
41: public PackageError(String message) {
42: super (message);
43: pkg = NIL;
44: }
45:
46: public LispObject typeOf() {
47: return Symbol.PACKAGE_ERROR;
48: }
49:
50: public LispClass classOf() {
51: return BuiltInClass.PACKAGE_ERROR;
52: }
53:
54: public LispObject typep(LispObject type) throws ConditionThrowable {
55: if (type == Symbol.PACKAGE_ERROR)
56: return T;
57: if (type == BuiltInClass.PACKAGE_ERROR)
58: return T;
59: return super .typep(type);
60: }
61:
62: // ### package-error-package
63: private static final Primitive1 PACKAGE_ERROR_PACKAGE = new Primitive1(
64: "package-error-package", "condition") {
65: public LispObject execute(LispObject arg)
66: throws ConditionThrowable {
67: try {
68: return ((PackageError) arg).pkg;
69: } catch (ClassCastException e) {
70: return signal(new TypeError(arg, Symbol.PACKAGE_ERROR));
71: }
72: }
73: };
74: }
|