source: branches/0.17.x/abcl/src/org/armedbear/lisp/PackageFunctions.java

Last change on this file was 12254, checked in by ehuelsmann, 16 years ago

Remove 'throws ConditionThrowable?' method annotations:

it's an unchecked exception now, so no need to declare it thrown.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.9 KB
Line 
1/*
2 * PackageFunctions.java
3 *
4 * Copyright (C) 2003-2005 Peter Graves
5 * $Id: PackageFunctions.java 12254 2009-11-06 20:07:54Z ehuelsmann $
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * 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 * As a special exception, the copyright holders of this library give you
22 * permission to link this library with independent modules to produce an
23 * executable, regardless of the license terms of these independent
24 * modules, and to copy and distribute the resulting executable under
25 * terms of your choice, provided that you also meet, for each linked
26 * independent module, the terms and conditions of the license of that
27 * module.  An independent module is a module which is not derived from
28 * or based on this library.  If you modify this library, you may extend
29 * this exception to your version of the library, but you are not
30 * obligated to do so.  If you do not wish to do so, delete this
31 * exception statement from your version.
32 */
33
34package org.armedbear.lisp;
35
36public final class PackageFunctions extends Lisp
37{
38    // ### packagep
39    // packagep object => generalized-boolean
40    private static final Primitive PACKAGEP = new Primitive("packagep", "object")
41    {
42        @Override
43        public LispObject execute(LispObject arg)
44        {
45            return arg instanceof Package ? T : NIL;
46        }
47    };
48
49    // ### package-name
50    // package-name package => nicknames
51    private static final Primitive PACKAGE_NAME =
52        new Primitive("package-name", "package")
53    {
54        @Override
55        public LispObject execute(LispObject arg)
56        {
57            return coerceToPackage(arg).NAME();
58        }
59    };
60
61    // ### package-nicknames
62    // package-nicknames package => nicknames
63    private static final Primitive PACKAGE_NICKNAMES =
64        new Primitive("package-nicknames", "package")
65    {
66        @Override
67        public LispObject execute(LispObject arg)
68        {
69            return coerceToPackage(arg).packageNicknames();
70        }
71    };
72
73    // ### package-use-list
74    // package-use-list package => use-list
75    private static final Primitive PACKAGE_USE_LIST =
76        new Primitive("package-use-list", "package")
77    {
78        @Override
79        public LispObject execute(LispObject arg)
80        {
81            return coerceToPackage(arg).getUseList();
82        }
83    };
84
85    // ### package-used-by-list
86    // package-used-by-list package => used-by-list
87    private static final Primitive PACKAGE_USED_BY_LIST =
88        new Primitive("package-used-by-list", "package")
89    {
90        @Override
91        public LispObject execute(LispObject arg)
92        {
93            return coerceToPackage(arg).getUsedByList();
94        }
95    };
96
97    // ### %import
98    // %import symbols &optional package => t
99    private static final Primitive _IMPORT =
100        new Primitive("%import", PACKAGE_SYS, false)
101    {
102        @Override
103        public LispObject execute(LispObject[] args)
104        {
105            if (args.length == 0 || args.length > 2)
106                return error(new WrongNumberOfArgumentsException(this));
107            LispObject symbols = args[0];
108            Package pkg =
109                args.length == 2 ? coerceToPackage(args[1]) : getCurrentPackage();
110            if (symbols.listp()) {
111                while (symbols != NIL) {
112                    pkg.importSymbol(checkSymbol(symbols.car()));
113                    symbols = symbols.cdr();
114                }
115            } else
116                pkg.importSymbol(checkSymbol(symbols));
117            return T;
118        }
119    };
120
121    // ### unexport
122    // unexport symbols &optional package => t
123    private static final Primitive UNEXPORT =
124        new Primitive("unexport", "symbols &optional package")
125    {
126        @Override
127        public LispObject execute(LispObject[] args)
128        {
129            if (args.length == 0 || args.length > 2)
130                return error(new WrongNumberOfArgumentsException(this));
131            LispObject symbols = args[0];
132            Package pkg =
133                args.length == 2 ? coerceToPackage(args[1]) : getCurrentPackage();
134            if (symbols.listp()) {
135                while (symbols != NIL) {
136                    pkg.unexport(checkSymbol(symbols.car()));
137                    symbols = symbols.cdr();
138                }
139            } else
140                pkg.unexport(checkSymbol(symbols));
141            return T;
142        }
143    };
144
145    // ### shadow
146    // shadow symbol-names &optional package => t
147    private static final Primitive SHADOW =
148        new Primitive("shadow", "symbol-names &optional package")
149    {
150        @Override
151        public LispObject execute(LispObject[] args)
152        {
153            if (args.length == 0 || args.length > 2)
154                return error(new WrongNumberOfArgumentsException(this));
155            LispObject symbols = args[0];
156            Package pkg =
157                args.length == 2 ? coerceToPackage(args[1]) : getCurrentPackage();
158            if (symbols.listp()) {
159                while (symbols != NIL) {
160                    pkg.shadow(javaString(symbols.car()));
161                    symbols = symbols.cdr();
162                }
163            } else
164                pkg.shadow(javaString(symbols));
165            return T;
166        }
167    };
168
169    // ### shadowing-import
170    // shadowing-import symbols &optional package => t
171    private static final Primitive SHADOWING_IMPORT =
172        new Primitive("shadowing-import", "symbols &optional package")
173    {
174        @Override
175        public LispObject execute(LispObject[] args)
176        {
177            if (args.length == 0 || args.length > 2)
178                return error(new WrongNumberOfArgumentsException(this));
179            LispObject symbols = args[0];
180            Package pkg =
181                args.length == 2 ? coerceToPackage(args[1]) : getCurrentPackage();
182            if (symbols.listp()) {
183                while (symbols != NIL) {
184                    pkg.shadowingImport(checkSymbol(symbols.car()));
185                    symbols = symbols.cdr();
186                }
187            } else
188                pkg.shadowingImport(checkSymbol(symbols));
189            return T;
190        }
191    };
192
193    // ### package-shadowing-symbols
194    // package-shadowing-symbols package => used-by-list
195    private static final Primitive PACKAGE_SHADOWING_SYMBOLS =
196        new Primitive("package-shadowing-symbols", "package")
197    {
198        @Override
199        public LispObject execute(LispObject arg)
200        {
201            return coerceToPackage(arg).getShadowingSymbols();
202        }
203    };
204
205    // ### delete-package
206    private static final Primitive DELETE_PACKAGE =
207        new Primitive("delete-package", "package")
208    {
209        @Override
210        public LispObject execute(LispObject arg)
211        {
212            return coerceToPackage(arg).delete() ? T : NIL;
213        }
214    };
215
216    // ### unuse-package
217    // unuse-package packages-to-unuse &optional package => t
218    private static final Primitive USE_PACKAGE =
219        new Primitive("unuse-package", "packages-to-unuse &optional package")
220    {
221        @Override
222        public LispObject execute(LispObject[] args)
223        {
224            if (args.length < 1 || args.length > 2)
225                return error(new WrongNumberOfArgumentsException(this));
226            Package pkg;
227            if (args.length == 2)
228                pkg = coerceToPackage(args[1]);
229            else
230                pkg = getCurrentPackage();
231            if (args[0] instanceof Cons) {
232                LispObject list = args[0];
233                while (list != NIL) {
234                    pkg.unusePackage(coerceToPackage(list.car()));
235                    list = list.cdr();
236                }
237            } else
238                pkg.unusePackage(coerceToPackage(args[0]));
239            return T;
240        }
241    };
242
243    // ### rename-package
244    // rename-package package new-name &optional new-nicknames => package-object
245    private static final Primitive RENAME_PACKAGE =
246        new Primitive("rename-package", "package new-name &optional new-nicknames")
247    {
248        @Override
249        public LispObject execute(LispObject[] args)
250        {
251            if (args.length < 2 || args.length > 3)
252                return error(new WrongNumberOfArgumentsException(this));
253            Package pkg = coerceToPackage(args[0]);
254            String newName = javaString(args[1]);
255            LispObject nicknames = args.length == 3 ? checkList(args[2]) : NIL;
256            pkg.rename(newName, nicknames);
257            return pkg;
258        }
259    };
260
261    private static final Primitive LIST_ALL_PACKAGES =
262        new Primitive("list-all-packages", "")
263    {
264        @Override
265        public LispObject execute()
266        {
267            return Packages.listAllPackages();
268        }
269    };
270
271    // ### %defpackage name nicknames size shadows shadowing-imports use
272    // imports interns exports doc-string => package
273    private static final Primitive _DEFPACKAGE =
274        new Primitive("%defpackage", PACKAGE_SYS, false)
275    {
276        @Override
277        public LispObject execute(LispObject[] args)
278        {
279            if (args.length != 10)
280                return error(new WrongNumberOfArgumentsException(this));
281            final String packageName = args[0].getStringValue();
282            LispObject nicknames = checkList(args[1]);
283            // FIXME size is ignored
284            // LispObject size = args[2];
285            LispObject shadows = checkList(args[3]);
286            LispObject shadowingImports = checkList(args[4]);
287            LispObject use = checkList(args[5]);
288            LispObject imports = checkList(args[6]);
289            LispObject interns = checkList(args[7]);
290            LispObject exports = checkList(args[8]);
291            // FIXME docString is ignored
292            // LispObject docString = args[9];
293            Package pkg = Packages.findPackage(packageName);
294            if (pkg != null)
295                return pkg;
296            if (nicknames != NIL) {
297                LispObject list = nicknames;
298                while (list != NIL) {
299                    String nick = javaString(list.car());
300                    if (Packages.findPackage(nick) != null) {
301                        return error(new PackageError("A package named " + nick +
302                                                       " already exists."));
303                    }
304                    list = list.cdr();
305                }
306            }
307            pkg = Packages.createPackage(packageName);
308            while (nicknames != NIL) {
309                LispObject string = nicknames.car().STRING();
310                pkg.addNickname(string.getStringValue());
311                nicknames = nicknames.cdr();
312            }
313            while (shadows != NIL) {
314                String symbolName = shadows.car().getStringValue();
315                pkg.shadow(symbolName);
316                shadows = shadows.cdr();
317            }
318            while (shadowingImports != NIL) {
319                LispObject si = shadowingImports.car();
320                Package otherPkg = coerceToPackage(si.car());
321                LispObject symbolNames = si.cdr();
322                while (symbolNames != NIL) {
323                    String symbolName = symbolNames.car().getStringValue();
324                    Symbol sym = otherPkg.findAccessibleSymbol(symbolName);
325                    if (sym != null)
326                        pkg.shadowingImport(sym);
327                    else
328                        return error(new LispError(symbolName +
329                                                    " not found in package " +
330                                                    otherPkg.getName() + "."));
331                    symbolNames = symbolNames.cdr();
332                }
333                shadowingImports = shadowingImports.cdr();
334            }
335            while (use != NIL) {
336                LispObject obj = use.car();
337                if (obj instanceof Package)
338                    pkg.usePackage((Package)obj);
339                else {
340                    LispObject string = obj.STRING();
341                    Package p = Packages.findPackage(string.getStringValue());
342                    if (p == null)
343                        return error(new LispError(obj.writeToString() +
344                                                    " is not the name of a package."));
345                    pkg.usePackage(p);
346                }
347                use = use.cdr();
348            }
349            while (imports != NIL) {
350                LispObject si = imports.car();
351                Package otherPkg = coerceToPackage(si.car());
352                LispObject symbolNames = si.cdr();
353                while (symbolNames != NIL) {
354                    String symbolName = symbolNames.car().getStringValue();
355                    Symbol sym = otherPkg.findAccessibleSymbol(symbolName);
356                    if (sym != null)
357                        pkg.importSymbol(sym);
358                    else
359                        return error(new LispError(symbolName +
360                                                    " not found in package " +
361                                                    otherPkg.getName() + "."));
362                    symbolNames = symbolNames.cdr();
363                }
364                imports = imports.cdr();
365            }
366            while (interns != NIL) {
367                String symbolName = interns.car().getStringValue();
368                pkg.intern(symbolName);
369                interns = interns.cdr();
370            }
371            while (exports != NIL) {
372                String symbolName = exports.car().getStringValue();
373                pkg.export(pkg.intern(symbolName));
374                exports = exports.cdr();
375            }
376            return pkg;
377        }
378    };
379}
Note: See TracBrowser for help on using the repository browser.