001: /*
002: * Extensions.java
003: *
004: * Copyright (C) 2002-2003 Peter Graves
005: * $Id: Extensions.java,v 1.6 2003/11/15 11:03:32 beedlem 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: // memq item list &key key test test-not => tail
028: private static final Primitive2 MEMQ = new Primitive2("memq",
029: PACKAGE_EXT, true) {
030: public LispObject execute(LispObject item, LispObject list)
031: throws ConditionThrowable {
032: LispObject tail = checkList(list);
033: while (tail != NIL) {
034: if (item == tail.car())
035: return tail;
036: tail = tail.cdr();
037: }
038: return NIL;
039: }
040: };
041:
042: // ### special-variable-p
043: private static final Primitive1 SPECIAL_VARIABLE_P = new Primitive1(
044: "special-variable-p", PACKAGE_EXT, true) {
045: public LispObject execute(LispObject arg)
046: throws ConditionThrowable {
047: return arg.isSpecialVariable() ? T : NIL;
048: }
049: };
050:
051: // ### charpos
052: // charpos stream => position
053: private static final Primitive1 CHARPOS = new Primitive1("charpos",
054: PACKAGE_EXT, true) {
055: public LispObject execute(LispObject arg)
056: throws ConditionThrowable {
057: if (arg instanceof CharacterOutputStream)
058: return new Fixnum(((CharacterOutputStream) arg)
059: .getCharPos());
060: throw new ConditionThrowable(new TypeError(arg,
061: "character output stream"));
062: }
063: };
064:
065: // ### %set-charpos
066: // %set-charpos stream newval => newval
067: private static final Primitive2 _SET_CHARPOS = new Primitive2(
068: "%set-charpos", PACKAGE_SYS, false) {
069: public LispObject execute(LispObject first, LispObject second)
070: throws ConditionThrowable {
071: if (first instanceof CharacterOutputStream) {
072: ((CharacterOutputStream) first).setCharPos(Fixnum
073: .getValue(second));
074: return second;
075: }
076: throw new ConditionThrowable(new TypeError(first,
077: "character output stream"));
078: }
079: };
080:
081: // ### make-socket
082: // make-socket host port => stream
083: private static final Primitive2 MAKE_SOCKET = new Primitive2(
084: "make-socket", PACKAGE_EXT, true) {
085: public LispObject execute(LispObject first, LispObject second)
086: throws ConditionThrowable {
087: String host = LispString.getValue(first);
088: int port = Fixnum.getValue(second);
089: try {
090: Socket socket = new Socket(host, port);
091: CharacterInputStream in = new CharacterInputStream(
092: socket.getInputStream());
093: CharacterOutputStream out = new CharacterOutputStream(
094: socket.getOutputStream());
095: return new TwoWayStream(in, out);
096: } catch (Exception e) {
097: throw new ConditionThrowable(new LispError(e
098: .getMessage()));
099: }
100: }
101: };
102:
103: // ### make-binary-socket
104: // make-binary-socket host port => stream
105: private static final Primitive2 MAKE_BINARY_SOCKET = new Primitive2(
106: "make-binary-socket", PACKAGE_EXT, true) {
107: public LispObject execute(LispObject first, LispObject second)
108: throws ConditionThrowable {
109: String host = LispString.getValue(first);
110: int port = Fixnum.getValue(second);
111: try {
112: Socket socket = new Socket(host, port);
113: BinaryInputStream in = new BinaryInputStream(socket
114: .getInputStream());
115: BinaryOutputStream out = new BinaryOutputStream(socket
116: .getOutputStream());
117: return new TwoWayStream(in, out);
118: } catch (Exception e) {
119: throw new ConditionThrowable(new LispError(e
120: .getMessage()));
121: }
122: }
123: };
124:
125: private static final Primitive0 EXIT = new Primitive0("exit",
126: PACKAGE_EXT, true) {
127: public LispObject execute() {
128: exit();
129: return LispThread.currentThread().nothing();
130: }
131: };
132:
133: private static final Primitive0 QUIT = new Primitive0("quit",
134: PACKAGE_EXT, true) {
135: public LispObject execute() {
136: exit();
137: return LispThread.currentThread().nothing();
138: }
139: };
140: }
|