001: /*
002: * Extensions.java
003: *
004: * Copyright (C) 2002-2004 Peter Graves
005: * $Id: Extensions.java,v 1.28 2004/08/19 16:05:37 piso Exp $
006: *
007: * This program is free software; you can redistribute it and/or
008: * modify it under the terms of the GNU General Public License
009: * as published by the Free Software Foundation; either version 2
010: * of the License, or (at your option) any later version.
011: *
012: * This program is distributed in the hope that it will be useful,
013: * but WITHOUT ANY WARRANTY; without even the implied warranty of
014: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
015: * GNU General Public License for more details.
016: *
017: * You should have received a copy of the GNU General Public License
018: * along with this program; if not, write to the Free Software
019: * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
020: */
021:
022: package org.armedbear.lisp;
023:
024: import java.net.Socket;
025:
026: public final class Extensions extends Lisp {
027: // ### neq
028: private static final Primitive2 NEQ = new Primitive2("neq",
029: PACKAGE_EXT, true) {
030: public LispObject execute(LispObject first, LispObject second)
031: throws ConditionThrowable {
032: return first != second ? T : NIL;
033: }
034: };
035:
036: // ### memq item list => tail
037: private static final Primitive2 MEMQ = new Primitive2("memq",
038: PACKAGE_EXT, true) {
039: public LispObject execute(LispObject item, LispObject list)
040: throws ConditionThrowable {
041: LispObject tail = checkList(list);
042: while (tail != NIL) {
043: if (item == tail.car())
044: return tail;
045: tail = tail.cdr();
046: }
047: return NIL;
048: }
049: };
050:
051: // ### memql item list => tail
052: private static final Primitive2 MEMQL = new Primitive2("memql",
053: PACKAGE_EXT, true) {
054: public LispObject execute(LispObject item, LispObject list)
055: throws ConditionThrowable {
056: LispObject tail = checkList(list);
057: while (tail != NIL) {
058: if (item.eql(tail.car()))
059: return tail;
060: tail = tail.cdr();
061: }
062: return NIL;
063: }
064: };
065:
066: // ### special-variable-p
067: private static final Primitive1 SPECIAL_VARIABLE_P = new Primitive1(
068: "special-variable-p", PACKAGE_EXT, true) {
069: public LispObject execute(LispObject arg)
070: throws ConditionThrowable {
071: return arg.isSpecialVariable() ? T : NIL;
072: }
073: };
074:
075: // ### charpos
076: // charpos stream => position
077: private static final Primitive1 CHARPOS = new Primitive1("charpos",
078: PACKAGE_EXT, true) {
079: public LispObject execute(LispObject arg)
080: throws ConditionThrowable {
081: Stream stream = checkCharacterOutputStream(arg);
082: return new Fixnum(stream.getCharPos());
083: }
084: };
085:
086: // ### %set-charpos
087: // %set-charpos stream newval => newval
088: private static final Primitive2 _SET_CHARPOS = new Primitive2(
089: "%set-charpos", PACKAGE_SYS, false) {
090: public LispObject execute(LispObject first, LispObject second)
091: throws ConditionThrowable {
092: Stream stream = checkCharacterOutputStream(first);
093: stream.setCharPos(Fixnum.getValue(second));
094: return second;
095: }
096: };
097:
098: // ### source
099: private static final Primitive1 SOURCE = new Primitive1("source",
100: PACKAGE_EXT, true) {
101: public LispObject execute(LispObject arg)
102: throws ConditionThrowable {
103: return get(checkSymbol(arg), Symbol._SOURCE, NIL);
104: }
105: };
106:
107: // ### source-file-position
108: private static final Primitive1 SOURCE_FILE_POSITION = new Primitive1(
109: "source-file-position", PACKAGE_EXT, true) {
110: public LispObject execute(LispObject arg)
111: throws ConditionThrowable {
112: LispObject obj = get(checkSymbol(arg), Symbol._SOURCE, NIL);
113: if (obj instanceof Cons)
114: return obj.cdr();
115: return NIL;
116: }
117: };
118:
119: // ### source-pathname
120: private static final Primitive1 SOURCE_PATHNAME = new Primitive1(
121: "source-pathname", PACKAGE_EXT, true) {
122: public LispObject execute(LispObject arg)
123: throws ConditionThrowable {
124: LispObject obj = get(checkSymbol(arg), Symbol._SOURCE, NIL);
125: if (obj instanceof Cons)
126: return obj.car();
127: if (obj instanceof Pathname)
128: return obj;
129: return NIL;
130: }
131: };
132:
133: // ### exit
134: private static final Primitive0 EXIT = new Primitive0("exit",
135: PACKAGE_EXT, true) {
136: public LispObject execute() throws ConditionThrowable {
137: exit();
138: return LispThread.currentThread().nothing();
139: }
140: };
141:
142: // ### quit
143: private static final Primitive0 QUIT = new Primitive0("quit",
144: PACKAGE_EXT, true) {
145: public LispObject execute() throws ConditionThrowable {
146: exit();
147: return LispThread.currentThread().nothing();
148: }
149: };
150: }
|