KickJava   Java API By Example, From Geeks To Geeks.

Java > Open Source Codes > org > armedbear > lisp > Extensions


1 /*
2  * Extensions.java
3  *
4  * Copyright (C) 2002-2004 Peter Graves
5  * $Id: Extensions.java,v 1.28 2004/08/19 16:05:37 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 import java.net.Socket JavaDoc;
25
26 public final class Extensions extends Lisp
27 {
28     // ### neq
29 private static final Primitive2 NEQ =
30         new Primitive2("neq", PACKAGE_EXT, true)
31     {
32         public LispObject execute(LispObject first, LispObject second)
33             throws ConditionThrowable
34         {
35             return first != second ? T : NIL;
36         }
37     };
38
39     // ### memq item list => tail
40 private static final Primitive2 MEMQ =
41         new Primitive2("memq", PACKAGE_EXT, true)
42     {
43         public LispObject execute(LispObject item, LispObject list)
44             throws ConditionThrowable
45         {
46             LispObject tail = checkList(list);
47             while (tail != NIL) {
48                 if (item == tail.car())
49                     return tail;
50                 tail = tail.cdr();
51             }
52             return NIL;
53         }
54     };
55
56     // ### memql item list => tail
57 private static final Primitive2 MEMQL =
58         new Primitive2("memql", PACKAGE_EXT, true)
59     {
60         public LispObject execute(LispObject item, LispObject list)
61             throws ConditionThrowable
62         {
63             LispObject tail = checkList(list);
64             while (tail != NIL) {
65                 if (item.eql(tail.car()))
66                     return tail;
67                 tail = tail.cdr();
68             }
69             return NIL;
70         }
71     };
72
73     // ### special-variable-p
74 private static final Primitive1 SPECIAL_VARIABLE_P =
75         new Primitive1("special-variable-p", PACKAGE_EXT, true)
76     {
77         public LispObject execute(LispObject arg) throws ConditionThrowable
78         {
79             return arg.isSpecialVariable() ? T : NIL;
80         }
81     };
82
83     // ### charpos
84 // charpos stream => position
85 private static final Primitive1 CHARPOS =
86         new Primitive1("charpos", PACKAGE_EXT, true)
87     {
88         public LispObject execute(LispObject arg) throws ConditionThrowable
89         {
90             Stream stream = checkCharacterOutputStream(arg);
91             return new Fixnum(stream.getCharPos());
92         }
93     };
94
95     // ### %set-charpos
96 // %set-charpos stream newval => newval
97 private static final Primitive2 _SET_CHARPOS =
98         new Primitive2("%set-charpos", PACKAGE_SYS, false)
99     {
100         public LispObject execute(LispObject first, LispObject second)
101             throws ConditionThrowable
102         {
103             Stream stream = checkCharacterOutputStream(first);
104             stream.setCharPos(Fixnum.getValue(second));
105             return second;
106         }
107     };
108
109     // ### source
110 private static final Primitive1 SOURCE =
111         new Primitive1("source", PACKAGE_EXT, true)
112     {
113         public LispObject execute(LispObject arg) throws ConditionThrowable
114         {
115             return get(checkSymbol(arg), Symbol._SOURCE, NIL);
116         }
117     };
118
119     // ### source-file-position
120 private static final Primitive1 SOURCE_FILE_POSITION =
121         new Primitive1("source-file-position", PACKAGE_EXT, true)
122     {
123         public LispObject execute(LispObject arg) throws ConditionThrowable
124         {
125             LispObject obj = get(checkSymbol(arg), Symbol._SOURCE, NIL);
126             if (obj instanceof Cons)
127                 return obj.cdr();
128             return NIL;
129         }
130     };
131
132     // ### source-pathname
133 private static final Primitive1 SOURCE_PATHNAME =
134         new Primitive1("source-pathname", PACKAGE_EXT, true)
135     {
136         public LispObject execute(LispObject arg) throws ConditionThrowable
137         {
138             LispObject obj = get(checkSymbol(arg), Symbol._SOURCE, NIL);
139             if (obj instanceof Cons)
140                 return obj.car();
141             if (obj instanceof Pathname)
142                 return obj;
143             return NIL;
144         }
145     };
146
147     // ### exit
148 private static final Primitive0 EXIT =
149         new Primitive0("exit", PACKAGE_EXT, true)
150     {
151         public LispObject execute() throws ConditionThrowable
152         {
153             exit();
154             return LispThread.currentThread().nothing();
155         }
156     };
157
158     // ### quit
159 private static final Primitive0 QUIT =
160         new Primitive0("quit", PACKAGE_EXT, true)
161     {
162         public LispObject execute() throws ConditionThrowable
163         {
164             exit();
165             return LispThread.currentThread().nothing();
166         }
167     };
168 }
169
Popular Tags