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

Last change on this file was 13999, checked in by rschlatte, 13 years ago

Introduce a "continue" restart for delete-package

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