PackageFunctions


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