01: /*
02: * Jatha - a Common LISP-compatible LISP library in Java.
03: * Copyright (C) 1997-2005 Micheal Scott Hewett
04: *
05: * This library is free software; you can redistribute it and/or
06: * modify it under the terms of the GNU Lesser General Public
07: * License as published by the Free Software Foundation; either
08: * version 2.1 of the License, or (at your option) any later version.
09: *
10: * This library is distributed in the hope that it will be useful,
11: * but WITHOUT ANY WARRANTY; without even the implied warranty of
12: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13: * Lesser General Public License for more details.
14: *
15: * You should have received a copy of the GNU Lesser General Public
16: * License along with this library; if not, write to the Free Software
17: * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18: *
19: *
20: * For further information, please contact Micheal Hewett at
21: * hewett@cs.stanford.edu
22: *
23: */
24: /**
25: * $Id: MakepackagePrimitive.java,v 1.6 2005/05/22 20:15:53 olagus Exp $
26: */package org.jatha.compile;
27:
28: import java.util.Map;
29:
30: import org.jatha.Jatha;
31: import org.jatha.dynatype.*;
32: import org.jatha.machine.*;
33:
34: import org.jatha.compile.args.*;
35:
36: /**
37: * <p>Creates a package with the associated information if no such package exists. Returns the package created.</p>
38: * <p>(make-package package-name &key nicknames use)</p>
39: * <p>package-name should be a symbol or string</p>
40: * <p>nicknames should be a list of symbols or strings</p>
41: * <p>use should also be a list of symbols or strings</p>
42: *
43: * @author <a href="mailto:Ola.Bini@itc.ki.se">Ola Bini</a>
44: * @version $Revision: 1.6 $
45: */
46: public class MakepackagePrimitive extends LispPrimitive {
47: private LambdaList args;
48:
49: private LispValue pckSym;
50: private LispValue nckKey;
51: private LispValue useKey;
52: private LispValue nckSym;
53: private LispValue useSym;
54:
55: public MakepackagePrimitive(final Jatha lisp) {
56: super (lisp, "MAKE-PACKAGE", 1, 5);
57: pckSym = lisp.EVAL.intern("PACKAGE-NAME");
58: nckSym = lisp.EVAL.intern("NICKNAMES");
59: useSym = lisp.EVAL.intern("USE");
60: nckKey = lisp.EVAL.intern(":NICKNAMES");
61: useKey = lisp.EVAL.intern(":USE");
62: args = new OrdinaryLambdaList(lisp);
63: args.getNormalArguments().add(new NormalArgument(pckSym));
64: args.getKeyArguments().put(nckKey,
65: new KeyArgument(nckSym, nckKey));
66: args.getKeyArguments().put(
67: useKey,
68: new KeyArgument(useSym, useKey, lisp.makeList(
69: lisp.QUOTE, lisp.makeList(lisp
70: .makeString("COMMON-LISP")))));
71: }
72:
73: public void Execute(final SECDMachine machine) {
74: final LispValue argsList = machine.S.pop();
75: final Map arguments = args.parse(argsList);
76: final LispValue name = (LispValue) arguments.get(pckSym);
77: final LispValue nick = (LispValue) arguments.get(nckSym);
78: final LispValue use = (LispValue) arguments.get(useSym);
79: machine.S.push(f_lisp.makePackage(name, nick, use));
80: machine.C.pop();
81: }
82:
83: // One to two evaluated args.
84: public LispValue CompileArgs(LispCompiler compiler,
85: SECDMachine machine, LispValue args, LispValue valueList,
86: LispValue code) throws CompilerException {
87: return compiler.compileArgsLeftToRight(args, valueList, f_lisp
88: .makeCons(machine.LIS, f_lisp.makeCons(args.length(),
89: code)));
90: }
91: }
|