//
// This file is part of the Jlisp implementation of Standard Lisp
// Copyright \u00a9 (C) Codemist Ltd, 1998-2000.
//
// Fns1.java
// Each built-in function is created wrapped in a class
// that is derived from BuiltinFunction.
import java.io.*;
import java.util.*;
import java.text.*;
import java.math.BigInteger;
import java.lang.reflect.*;
class Fns1
{
Object [][] builtins =
{
{"userjava", new UserJavaFn()},
{"acons", new AconsFn()},
{"append", new AppendFn()},
{"apply", new ApplyFn()},
{"apply0", new Apply0Fn()},
{"apply1", new Apply1Fn()},
{"apply2", new Apply2Fn()},
{"apply3", new Apply3Fn()},
{"assoc", new AssocFn()},
{"assoc**", new AssocStarStarFn()},
{"atom", new AtomFn()},
{"atsoc", new AtsocFn()},
{"batchp", new BatchpFn()},
{"binary_close_input", new Binary_close_inputFn()},
{"binary_close_output", new Binary_close_outputFn()},
{"binary_open_input", new Binary_open_inputFn()},
{"binary_open_output", new Binary_open_outputFn()},
{"binary_prin1", new Binary_prin1Fn()},
{"binary_prin2", new Binary_prin2Fn()},
{"binary_prin3", new Binary_prin3Fn()},
{"binary_prinbyte", new Binary_prinbyteFn()},
{"binary_princ", new Binary_princFn()},
{"binary_prinfloat", new Binary_prinfloatFn()},
{"binary_read2", new Binary_read2Fn()},
{"binary_read3", new Binary_read3Fn()},
{"binary_read4", new Binary_read4Fn()},
{"binary_readbyte", new Binary_readbyteFn()},
{"binary_readfloat", new Binary_readfloatFn()},
{"binary_select_input", new Binary_select_inputFn()},
{"binary_terpri", new Binary_terpriFn()},
{"binopen", new BinopenFn()},
{"boundp", new BoundpFn()},
{"bps-getv", new Bps_getvFn()},
{"bps-putv", new Bps_putvFn()},
{"bps-upbv", new Bps_upbvFn()},
{"bpsp", new BpspFn()},
{"break-loop", new Break_loopFn()},
{"byte-getv", new Byte_getvFn()},
{"bytecounts", new BytecountsFn()},
{"c_out", new C_outFn()},
{"caaaar", new CaaaarFn()},
{"caaadr", new CaaadrFn()},
{"caaar", new CaaarFn()},
{"caadar", new CaadarFn()},
{"caaddr", new CaaddrFn()},
{"caadr", new CaadrFn()},
{"caar", new CaarFn()},
{"cadaar", new CadaarFn()},
{"cadadr", new CadadrFn()},
{"cadar", new CadarFn()},
{"caddar", new CaddarFn()},
{"cadddr", new CadddrFn()},
{"caddr", new CaddrFn()},
{"cadr", new CadrFn()},
{"car", new CarFn()},
{"car*", new CarStarFn()},
{"carcheck", new CarcheckFn()},
{"catch", new CatchFn()},
{"cbrt", new CbrtFn()},
{"cdaaar", new CdaaarFn()},
{"cdaadr", new CdaadrFn()},
{"cdaar", new CdaarFn()},
{"cdadar", new CdadarFn()},
{"cdaddr", new CdaddrFn()},
{"cdadr", new CdadrFn()},
{"cdar", new CdarFn()},
{"cddaar", new CddaarFn()},
{"cddadr", new CddadrFn()},
{"cddar", new CddarFn()},
{"cdddar", new CdddarFn()},
{"cddddr", new CddddrFn()},
{"cdddr", new CdddrFn()},
{"cddr", new CddrFn()},
{"cdr", new CdrFn()},
{"char-code", new Char_codeFn()},
{"char-downcase", new Char_downcaseFn()},
{"char-upcase", new Char_upcaseFn()},
{"chdir", new ChdirFn()},
{"checkpoint", new CheckpointFn()},
{"cl-equal", new Cl_equalFn()},
{"close", new CloseFn()},
{"close-library", new Close_libraryFn()},
{"clrhash", new ClrhashFn()},
{"code-char", new Code_charFn()},
{"codep", new CodepFn()},
{"compress", new CompressFn()},
{"cons", new ConsFn()},
{"consp", new ConspFn()},
{"constantp", new ConstantpFn()},
{"contained", new ContainedFn()},
{"convert-to-evector", new Convert_to_evectorFn()},
{"copy", new CopyFn()},
{"copy-module", new Copy_moduleFn()},
{"create-directory", new Create_directoryFn()},
{"date", new DateFn()},
{"dated-name", new Dated_nameFn()},
{"datelessp", new DatelesspFn()},
{"datestamp", new DatestampFn()},
{"define-in-module", new Define_in_moduleFn()},
{"deflist", new DeflistFn()},
{"deleq", new DeleqFn()},
{"delete", new DeleteFn()},
{"delete-file", new Delete_fileFn()},
{"library-members", new Library_membersFn()},
{"delete-module", new Delete_moduleFn()},
{"demo-mode", new Demo_modeFn()},
{"digit", new DigitFn()},
{"directoryp", new DirectorypFn()},
{"dm", new DmFn()},
{"do", new DoFn()},
{"do*", new DoStarFn()},
{"dolist", new DolistFn()},
{"dotimes", new DotimesFn()},
{"double-execute", new Double_executeFn()},
{"egetv", new EgetvFn()},
{"eject", new EjectFn()},
{"enable-backtrace", new Enable_backtraceFn()},
{"endp", new EndpFn()},
{"eputv", new EputvFn()},
{"eq", new EqFn()},
{"eqcar", new EqcarFn()},
{"equalcar", new EqualcarFn()},
{"eql", new EqlFn()},
{"eqlhash", new EqlhashFn()},
{"equal", new EqualFn()},
{"iequal", new EqualFn()},
{"equalp", new EqualpFn()},
{"error", new ErrorFn()},
{"error1", new Error1Fn()},
{"errorset", new ErrorsetFn()},
{"eupbv", new EupbvFn()},
{"eval", new EvalFn()},
{"eval-when", new Eval_whenFn()},
{"evectorp", new EvectorpFn()},
{"evlis", new EvlisFn()},
{"expand", new ExpandFn()},
{"explode", new ExplodeFn()},
{"explodetostring", new ExplodetostringFn()},
{"explode2", new Explode2Fn()},
{"explode2lc", new Explode2lcFn()},
{"explode2lcn", new Explode2lcnFn()},
{"explode2n", new Explode2nFn()},
{"explode2uc", new Explode2ucFn()},
{"explode2ucn", new Explode2ucnFn()},
{"explodebinary", new ExplodebinaryFn()},
{"explodec", new ExplodecFn()},
{"explodecn", new ExplodecnFn()},
{"explodehex", new ExplodehexFn()},
{"exploden", new ExplodenFn()},
{"explodeoctal", new ExplodeoctalFn()},
{"fetch-url", new Fetch_urlFn()},
{"fgetv32", new Fgetv32Fn()},
{"fgetv64", new Fgetv64Fn()},
{"file-readablep", new File_readablepFn()},
{"file-writeablep", new File_writeablepFn()},
{"filedate", new FiledateFn()},
{"filep", new FilepFn()},
{"flag", new FlagFn()},
{"flagp", new FlagpFn()},
{"flagp**", new FlagpStarStarFn()},
{"flagpcar", new FlagpcarFn()},
{"fluid", new FluidFn()},
{"fluidp", new FluidpFn()},
{"flush", new FlushFn()},
{"format", new FormatFn()},
{"fp-evaluate", new Fp_evaluateFn()},
{"fputv32", new Fputv32Fn()},
{"fputv64", new Fputv64Fn()},
{"funcall", new FuncallFn()},
{"funcall*", new FuncallFn()},
{"gctime", new GctimeFn()},
{"gensym", new GensymFn()},
{"gensym1", new Gensym1Fn()},
{"gensym2", new Gensym2Fn()},
{"gensymp", new GensympFn()},
{"get", new GetFn()},
{"get*", new GetStarFn()},
{"get-current-directory", new Get_current_directoryFn()},
{"get-lisp-directory", new Get_lisp_directoryFn()},
{"getd", new GetdFn()},
{"getenv", new GetenvFn()},
{"gethash", new GethashFn()},
{"getv", new GetvFn()},
{"getv16", new Getv16Fn()},
{"getv32", new Getv32Fn()},
{"getv8", new Getv8Fn()},
{"global", new GlobalFn()},
{"globalp", new GlobalpFn()},
{"hash-table-p", new Hash_table_pFn()},
{"hashcontents", new HashcontentsFn()},
{"hashtagged-name", new Hashtagged_nameFn()},
{"help", new HelpFn()},
{"idp", new IdpFn()},
{"indirect", new IndirectFn()},
{"inorm", new InormFn()},
{"input-libraries", new Input_librariesFn()},
{"intern", new InternFn()},
{"intersection", new IntersectionFn()},
{"is-console", new Is_consoleFn()},
{"last", new LastFn()},
{"lastcar", new LastcarFn()},
{"lastpair", new LastpairFn()},
{"length", new LengthFn()},
{"lengthc", new LengthcFn()},
{"library-name", new Library_nameFn()},
{"linelength", new LinelengthFn()},
{"list", new ListFn()},
{"list*", new ListStarFn()},
{"list-directory", new List_directoryFn()},
{"list-modules", new List_modulesFn()},
{"list-to-string", new List_to_stringFn()},
{"list-to-symbol", new List_to_symbolFn()},
{"list2", new List2Fn()},
{"list2*", new List2StarFn()},
{"list3", new List3Fn()}
};
static Class c = null;
static Method m0 = null, m1 = null, m2 = null, mn = null;
class UserJavaFn extends BuiltinFunction
{
// To use this, prepare a new class
//
// public class UserJava
// { public static LispObject op1(LispObject a)
// { return ... }
// }
// with PUBLIC STATIC methods op0, op1, op2 and opn (not all need be
// provided). Compile it and put it where the system class loader can
// find it. Maybe merge it into the mai .jar file? Then
// (userjava <arg>)
// will call those methods for you, or if the class was not provided it
// will just return a complaint!
//
void ensureClassLoaded() throws Exception
{
if (c == null)
{ ClassLoader l = ClassLoader.getSystemClassLoader();
c = l.loadClass("UserJava");
Class lo = Class.forName("LispObject");
Class lov = (new LispObject [0]).getClass();
m0 = m1 = m2 = mn = null;
try
{ m0 = c.getMethod("op0",
new Class [] {});
}
catch (NoSuchMethodException nsm) {}
try
{ m1 = c.getMethod("op1",
new Class [] {lo});
}
catch (NoSuchMethodException nsm) {}
try
{ m2 = c.getMethod("op2",
new Class [] {lo, lo});
}
catch (NoSuchMethodException nsm) {}
try
{ mn = c.getMethod("opn",
new Class [] {lov});
}
catch (NoSuchMethodException nsm) {}
}
}
public LispObject op0() throws Exception
{
ensureClassLoaded();
if (m0 == null) return Jlisp.error("no 0-arg method in UserJava");
return (LispObject)m0.invoke(null, new LispObject [] {});
}
public LispObject op1(LispObject a) throws Exception
{
ensureClassLoaded();
if (m1 == null) return Jlisp.error("no 1-arg method in UserJava");
return (LispObject)m1.invoke(this, new LispObject [] {a});
}
public LispObject op2(LispObject a, LispObject b) throws Exception
{
ensureClassLoaded();
if (m2 == null) return Jlisp.error("no 2-arg method in UserJava");
return (LispObject)m2.invoke(this, new LispObject [] {a, b});
}
public LispObject opn(LispObject [] a) throws Exception
{
ensureClassLoaded();
if (mn == null) return Jlisp.error("no n-arg method in UserJava");
return (LispObject)mn.invoke(this, new LispObject [][] {a});
}
}
class AconsFn extends BuiltinFunction
{
public LispObject opn(LispObject [] args) throws Exception
{
if (args.length != 3)
return error("acons called with " + args.length +
" args when 3 were expected");
return new Cons(new Cons(args[0], args[1]), args[2]);
}
}
class AppendFn extends BuiltinFunction
{
public LispObject op0()
{ return Jlisp.nil; }
public LispObject op1(LispObject arg1)
{ return arg1; }
public LispObject op2(LispObject arg1, LispObject arg2)
{
LispObject r = Jlisp.nil;
while (!arg1.atom)
{ LispObject a = arg1;
r = new Cons(a.car, r);
arg1 = a.cdr;
}
while (!r.atom)
{ LispObject a = r;
r = a.cdr;
a.cdr = arg2;
arg2 = a;
}
return arg2;
}
public LispObject opn(LispObject [] args)
{
int n = args.length;
LispObject r = args[--n];
for (int i=n-1; i>=0; i--)
{ r = op2(args[i], r);
}
return r;
}
}
class ApplyFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return applySub(arg1, 0, Jlisp.nil);
}
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
return applySub(arg1, 0, arg2);
}
public LispObject opn(LispObject [] aa) throws Exception
{
int n = aa.length;
for (int i=1; i<n-1; i++) Fns.args[i-1] = aa[i];
return applySub(aa[0], n-2, aa[n-1]);
}
LispObject applySub(LispObject fn, int n, LispObject a) throws Exception
{
while (!a.atom)
{ Fns.args[n++] = a.car;
a = a.cdr;
}
if (!fn.atom) return Fns.applyInner(fn, n);
LispFunction f;
if (fn instanceof Symbol) f = ((Symbol)fn).fn;
else if (fn instanceof LispFunction) f = (LispFunction)fn;
else return Jlisp.error("not a function", fn);
switch (n)
{
case 0: return f.op0();
case 1: return f.op1(Fns.args[0]);
case 2: return f.op2(Fns.args[0], Fns.args[1]);
default:
LispObject [] v = new LispObject [n];
for (int i=0; i<n; i++) v[i] = Fns.args[i];
return f.opn(v);
}
}
}
class Apply0Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1 instanceof Symbol)
{ return ((Symbol)arg1).fn.op0();
}
else if (arg1 instanceof LispFunction)
{ return ((LispFunction)arg1).op0();
}
else return Fns.apply0(arg1);
}
}
class Apply1Fn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
if (arg1 instanceof Symbol)
{ return ((Symbol)arg1).fn.op1(arg2);
}
else if (arg1 instanceof LispFunction)
{ return ((LispFunction)arg1).op1(arg2);
}
return Fns.apply1(arg1, arg2);
}
}
class Apply2Fn extends BuiltinFunction
{
public LispObject opn(LispObject [] args) throws Exception
{
if (args.length != 3)
return error("apply2 called with " + args.length +
" args when 3 were expected");
LispObject arg1 = args[0];
if (arg1 instanceof Symbol)
{ return ((Symbol)arg1).fn.op2(args[1], args[2]);
}
else if (arg1 instanceof LispFunction)
{ return ((LispFunction)arg1).op2(args[1], args[2]);
}
else return Fns.apply2(arg1, args[1], args[2]);
}
}
class Apply3Fn extends BuiltinFunction
{
public LispObject opn(LispObject [] args) throws Exception
{
if (args.length != 4)
return error("apply3 called with " + args.length +
" args when 4 were expected");
LispObject arg1 = args[0];
LispObject [] n = new LispObject [3];
n[0] = args[1]; n[1] = args[2]; n[2] = args[3];
if (arg1 instanceof Symbol)
{ return ((Symbol)arg1).fn.opn(n);
}
else if (arg1 instanceof LispFunction)
{ return ((LispFunction)arg1).opn(n);
}
else return Fns.apply3(arg1, args[1], args[2], args[3]);
}
}
class AssocFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2)
{
while (!arg2.atom)
{ LispObject q = arg2.car;
arg2 = arg2.cdr;
if (q.atom) continue;
if (arg1.lispequals(q.car)) return q;
}
return Jlisp.nil;
}
}
class AssocStarStarFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2)
{
while (!arg2.atom)
{ LispObject q = arg2.car;
arg2 = arg2.cdr;
if (q.atom) continue;
if (arg1.lispequals(q.car)) return q;
}
return Jlisp.nil;
}
}
// like ML "fun atom (a :: b) = false | atom x = true;"
class AtomFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{ return arg1.atom ? Jlisp.lispTrue :
Jlisp.nil;
}
}
class AtsocFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
while (!arg2.atom)
{ LispObject p = arg2;
arg2 = p.cdr;
if (p.car.atom) continue;
LispObject q = p.car;
if (arg1 instanceof LispNumber && // @@@
arg1.lispequals(q.car)) return p.car; // @@@
else if (arg1 == q.car) return p.car;
}
return Jlisp.nil;
}
}
class BatchpFn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
if (Jlisp.interactivep) return Jlisp.nil;
else return Jlisp.lispTrue;
}
}
class Binary_close_inputFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_close_outputFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_open_inputFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_open_outputFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_prin1Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_prin2Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_prin3Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_prinbyteFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_princFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_prinfloatFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_read2Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_read3Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_read4Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_readbyteFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_readfloatFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_select_inputFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Binary_terpriFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class BinopenFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class BoundpFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1 instanceof Symbol &&
((Symbol)arg1).car/*value*/ != Jlisp.lit[Lit.undefined])
return Jlisp.lispTrue;
else return Jlisp.nil;
}
}
class Bps_getvFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
int n = arg2.intValue();
int b = ((Bytecode)arg1).bytecodes[n] & 0xff;
return LispInteger.valueOf(b);
}
}
class Bps_putvFn extends BuiltinFunction
{
public LispObject opn(LispObject [] args) throws Exception
{
if (args.length != 3)
return error("bps-putv called with " + args.length +
" args when 3 were expected");
int n = args[1].intValue();
int b = args[2].intValue();
((Bytecode)args[0]).bytecodes[n] = (byte)b;
return args[2];
}
}
class Bps_upbvFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
int n = ((Bytecode)arg1).bytecodes.length;
return LispInteger.valueOf(n-1);
}
}
class BpspFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{
if (arg1 instanceof Bytecode) return Jlisp.lispTrue;
else return Jlisp.nil;
}
}
class Break_loopFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Byte_getvFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
String s = ((LispString)arg1).string;
int n = arg2.intValue();
return LispInteger.valueOf((int)s.charAt(n));
}
}
class BytecountsFn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
return Jlisp.nil;
}
}
class C_outFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
// like ML "fun car (a :: b) = a;"
class CarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car of an atom");
else return arg1.car;
}
}
// like ML "fun cdr (a :: b) = b;"
class CdrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take cdr of an atom");
else return arg1.cdr;
}
}
class CaaaarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CaaadrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CaaarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CaadarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CaaddrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CaadrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CaarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CadaarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CadadrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CadarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CaddarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CadddrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CaddrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CadrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
return arg1;
}
}
class CarStarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{
if (!arg1.atom) return arg1.car;
return Jlisp.nil;
}
}
class CarcheckFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class CatchFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class CbrtFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
double a = ((LispFloat)arg1).value;
if (a == 0.0) return arg1;
else if (a > 0.0) return new LispFloat(Math.pow(a, 1.0/3.0));
else return new LispFloat(-Math.pow(-a, 1.0/3.0));
}
}
class CdaaarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CdaadrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CdaarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CdadarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CdaddrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CdadrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CdarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CddaarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CddadrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CddarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CdddarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.car;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CddddrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CdddrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class CddrFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
if (arg1.atom) return error("Attempt to take car/cdr of an atom");
arg1 = arg1.cdr;
return arg1;
}
}
class Char_codeFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Char_downcaseFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
char ch;
if (arg1 instanceof Symbol)
ch = ((Symbol)arg1).pname.charAt(0);
else if (arg1 instanceof LispInteger)
ch = (char)arg1.intValue();
else if (arg1 instanceof LispString)
ch = ((LispString)arg1).string.charAt(0);
else return error("bad arg for char-downcase");
byte [] bch = new byte [] { (byte)Character.toLowerCase(ch) };
return Symbol.intern(new String(bch));
}
}
class Char_upcaseFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
char ch;
if (arg1 instanceof Symbol)
ch = ((Symbol)arg1).pname.charAt(0);
else if (arg1 instanceof LispInteger)
ch = (char)arg1.intValue();
else if (arg1 instanceof LispString)
ch = ((LispString)arg1).string.charAt(0);
else return error("bad arg for char-upcase");
byte [] bch = new byte [] { (byte)Character.toUpperCase(ch) };
return Symbol.intern(new String(bch));
}
}
class ChdirFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class CheckpointFn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
return op1(Jlisp.nil);
}
public LispObject op1(LispObject arg1) throws Exception
{
return op2(arg1, Jlisp.nil);
}
public LispObject op2(LispObject arg1, LispObject arg2)
{
Jlisp.preserve(arg1, arg2);
return Jlisp.nil;
}
}
class Cl_equalFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class CloseFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1 instanceof LispStream)
{ ((LispStream)arg1).close();
}
return Jlisp.nil;
}
}
class Close_libraryFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class ClrhashFn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
((LispHash)Jlisp.lit[Lit.hashtab]).hash.clear();
return Jlisp.nil;
}
public LispObject op1(LispObject ht) throws Exception
{
((LispHash)ht).hash.clear();
return Jlisp.nil;
}
}
class Code_charFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class CodepFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1 instanceof BuiltinFunction) return Jlisp.lispTrue;
else return Jlisp.nil;
}
}
class CompressFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispObject save = Jlisp.lit[Lit.std_input].car/*value*/;
LispStream from = new ListReader(arg1);
LispObject r = Jlisp.nil;
try
{ Jlisp.lit[Lit.std_input].car/*value*/ = from;
r = Jlisp.read();
int c = from.readChar();
from.close();
// The next section is a pretty shameless hack to make REDUCE a bit
// more robust. If when I parse the input to COMPRESS I find something
// left over, I will take that as an indication that what the user
// intended was to have a symbol made up of all the characters in the
// input data (except that "!" gets treated as an escape (which is no
// longer needed, but which must be ignored)
if (c != -1)
{ StringBuffer s = new StringBuffer();
boolean escaped = false;
while (!arg1.atom)
{ LispObject k = arg1.car;
arg1 = arg1.cdr;
char ch;
if (k instanceof LispString)
ch = ((LispString)k).string.charAt(0);
else if (k instanceof LispInteger)
ch = (char)k.intValue();
else if (k instanceof Symbol)
ch = ((Symbol)k).pname.charAt(0);
else break;
if (!escaped && ch == '!')
{ escaped = true;
continue;
}
escaped = false;
s.append(ch);
}
return Symbol.intern(s.toString());
}
}
catch (Exception e)
{ Jlisp.errprintln(
"Error in compress: " + e.getMessage());
LispStream ee = // @@@
(LispStream)Jlisp.lit[Lit.err_output].car/*value*/;
e.printStackTrace(new PrintWriter(new WriterToLisp(ee)));
r = Jlisp.nil;
}
finally
{ Jlisp.lit[Lit.std_input].car/*value*/ = save;
}
return r;
}
}
// like ML "fun cons a b = a :: b;"
class ConsFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2)
{ return new Cons(arg1, arg2);
}
}
class ConspFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{ return arg1.atom ? Jlisp.nil :
Jlisp.lispTrue;
}
}
class ConstantpFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1 instanceof Symbol || !arg1.atom)
return Jlisp.nil;
else return Jlisp.lispTrue;
}
}
class ContainedFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Convert_to_evectorFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class CopyFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return arg1.copy();
}
}
class Copy_moduleFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1==Jlisp.nil) return arg1;
Fasl.startModule(arg1); // set up for output...
InputStream readerSave = Fasl.reader;
if (Fasl.openModule(arg1))
{ try
{ Fasl.writer.close();
}
finally
{ Fasl.writer = null;
Fasl.reader = readerSave;
}
return Jlisp.nil;
}
int c;
while ((c = Fasl.reader.read()) != -1) Fasl.writer.write(c);
try
{ Fasl.reader.close();
}
catch (Exception e)
{}
try
{ Fasl.writer.close();
}
finally
{ Fasl.writer = null;
Fasl.reader = readerSave;
}
return Jlisp.lispTrue;
}
}
class Create_directoryFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class DateFn extends BuiltinFunction
{
public LispObject op0()
{
Date now = new Date();
String s = DateFormat.getDateTimeInstance().format(now);
return new LispString(s);
}
}
class Dated_nameFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class DatelesspFn extends BuiltinFunction
{
public LispObject op2(LispObject a1, LispObject a2) throws Exception
{
String s1, s2;
s1 = ((LispString)a1).string;
s2 = ((LispString)a2).string;
Date d1, d2;
d1 = LispStream.dFormat.parse(s1, new ParsePosition(0));
d2 = LispStream.dFormat.parse(s2, new ParsePosition(0));
if (d1 == null || d2 == null) error("badly formatted date");
boolean res = d1.getTime() < d2.getTime();
return res ? Jlisp.lispTrue : Jlisp.nil;
}
}
class DatestampFn extends BuiltinFunction
{
public LispObject op0()
{
Date now = new Date();
return LispInteger.valueOf(now.getTime());
}
}
class Define_in_moduleFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
int n = arg1.intValue();
if (n < -1 || n > 0x3ffff) error("bad arg to define-in-module");
Fasl.defineInModule(n);
return Jlisp.nil;
}
}
class DeflistFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class DeleqFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
LispObject w = Jlisp.nil;
while (!arg2.atom)
{ LispObject a2 = arg2;
arg2 = a2.cdr;
if (arg1 instanceof LispNumber && // @@@
arg1.lispequals(a2.car)) break; // @@@
else if (a2.car == arg1) break;
w = new Cons(a2.car, w);
}
while (!w.atom)
{ LispObject cw = w;
w = cw.cdr;
cw.cdr = arg2;
arg2 = cw;
}
return arg2;
}
}
class DeleteFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2)
{
LispObject w = Jlisp.nil;
while (!arg2.atom)
{ LispObject a2 = arg2;
arg2 = a2.cdr;
if (arg1.lispequals(a2.car)) break;
w = new Cons(a2.car, w);
}
while (!w.atom)
{ LispObject cw = w;
w = cw.cdr;
cw.cdr = arg2;
arg2 = cw;
}
return arg2;
}
}
class Delete_fileFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
String s;
if (arg1 instanceof Symbol) s = ((Symbol)arg1).pname;
else if (arg1 instanceof LispString) s = ((LispString)arg1).string;
else return Jlisp.nil;
return LispStream.fileDelete(s);
}
}
class Library_membersFn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
if (Jlisp.outputImagePos < 0) return Jlisp.nil;
PDS z = Jlisp.images[Jlisp.outputImagePos];
if (z != null) return z.members();
return Jlisp.nil;
}
}
class Delete_moduleFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
Jlisp.println("++++ delete-module not coded yet"); // @@@
return Jlisp.nil;
}
}
class Demo_modeFn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
return Jlisp.nil;
}
}
class DigitFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (!(arg1 instanceof Symbol)) return Jlisp.nil;
Symbol s = (Symbol)arg1;
char ch = s.pname.charAt(0);
if (Character.isDigit(ch)) return Jlisp.lispTrue;
else return Jlisp.nil;
}
}
class DirectorypFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class DmFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class DoFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class DoStarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class DolistFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class DotimesFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Double_executeFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class EgetvFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class EjectFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Enable_backtraceFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class EndpFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{ if (arg1 == Jlisp.nil) return Jlisp.lispTrue;
else if (!arg1.atom) return Jlisp.nil;
else return error("ill-formed list detected by ENDP");
}
}
class EputvFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
// (eq a b) is true if a and b are the same thing
class EqFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2)
{
if (arg1 instanceof LispNumber) // @@@
return arg1.lispequals(arg2) ? Jlisp.lispTrue : Jlisp.nil; // @@@
else return arg1==arg2 ? Jlisp.lispTrue : Jlisp.nil;
}
}
class EqcarFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2)
{
if (arg1.atom) return Jlisp.nil;
arg1 = arg1.car;
if (arg1 instanceof LispNumber) // @@@
return arg1.lispequals(arg2) ? Jlisp.lispTrue : Jlisp.nil; // @@@
else return arg1==arg2 ? Jlisp.lispTrue : Jlisp.nil;
}
}
class EqualcarFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2)
{
if (!arg1.atom &&
(arg1.car == arg2 ||
arg1.car.lispequals(arg2))) return Jlisp.lispTrue;
else return Jlisp.nil;
}
}
class EqlFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class EqlhashFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class EqualFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2)
{
if (arg1 == arg2) return Jlisp.lispTrue;
return (arg1.lispequals(arg2) ?
Jlisp.lispTrue :
Jlisp.nil);
}
}
class EqualpFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class ErrorFn extends BuiltinFunction
{
public LispObject op1(LispObject a) throws Exception
{
return op2(LispInteger.valueOf(0), a);
}
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
if (Jlisp.headline)
{ Jlisp.errprintln();
Jlisp.errprint("+++++ Error ");
arg1.errPrint();
Jlisp.errprint(" ");
arg2.errPrint();
Jlisp.errprintln();
}
if (!arg1.atom) arg1 = LispInteger.valueOf(0);
Jlisp.errorCode = arg1;
return error("Error function called");
}
}
class Error1Fn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
if (!Jlisp.debugFlag) Jlisp.headline = Jlisp.backtrace = false;
return error("Error1 function called");
}
public LispObject op1(LispObject arg1) throws Exception
{
if (!Jlisp.debugFlag) Jlisp.headline = Jlisp.backtrace = false;
return error("Error1 function called");
}
}
class ErrorsetFn extends BuiltinFunction
{
public LispObject opn(LispObject [] args) throws Exception
{
if (args.length != 3)
return error("errorset called with " + args.length +
" arguments when 3 expected");
LispObject form = args[0];
boolean savehead = Jlisp.headline;
boolean saveback = Jlisp.backtrace;
try
{ Jlisp.headline = (args[1] != Jlisp.nil);
Jlisp.backtrace = (args[2] != Jlisp.nil);
// "-g" forces all errors to be noisy!
if (Jlisp.debugFlag)
{ Jlisp.headline = true;
Jlisp.backtrace = true;
}
Jlisp.errorCode = Jlisp.lispTrue; // gets reset by user error function
try
{ form = form.eval();
if (Specfn.progEvent != Specfn.NONE)
{ Specfn.progEvent = Specfn.NONE;
error("GO or RETURN out of context");
}
}
catch (Exception e)
{
if (e instanceof ProgEvent)
{ ProgEvent ep = (ProgEvent)e;
switch (ep.type)
{
case ProgEvent.STOP:
case ProgEvent.PRESERVE:
case ProgEvent.RESTART:
case ProgEvent.THROW:
throw e;
default:
break;
}
}
boolean head = Jlisp.headline;
boolean back = Jlisp.backtrace;
if (head || back)
Jlisp.errprintln();
if (e instanceof LispException)
{ LispException e1 = (LispException)e;
if (head)
{ Jlisp.errprint("+++++ Error: " + e1.message);
if (e1.details != null)
{ Jlisp.errprint(": ");
e1.details.errPrint();
}
Jlisp.errprintln();
}
}
else
{ if (head || back)
Jlisp.errprintln();
if (head)
{ String m = e.getMessage();
if (m == null) m = e.toString();
Jlisp.errprintln("+++++ Error: " + m);
}
}
if (back)
{ LispStream ee =
(LispStream)Jlisp.lit[Lit.err_output].car/*value*/;
e.printStackTrace(new PrintWriter(new WriterToLisp(ee)));
}
// I will return the atom that was the first argument in a user call to
// (error a b)
// if such is available. Otherwise I return T.
form = Jlisp.errorCode;
Jlisp.errorCode = Jlisp.lispTrue;
if (form == null | !form.atom) form = Jlisp.lispTrue;
return form;
}
}
finally
{ Jlisp.headline = savehead;
Jlisp.backtrace = saveback;
}
return new Cons(form, Jlisp.nil);
}
}
class EupbvFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class EvalFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
arg1 = arg1.eval();
if (Specfn.progEvent != Specfn.NONE)
{ Specfn.progEvent = Specfn.NONE;
return error("GO or RETURN out of context");
}
return arg1;
}
}
class Eval_whenFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class EvectorpFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class EvlisFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispObject r = Jlisp.nil;
while (!arg1.atom)
{ LispObject a1 = arg1;
r = new Cons(a1.car.eval(), r);
if (Specfn.progEvent != Specfn.NONE) return Jlisp.nil;
arg1 = a1.cdr;
}
arg1 = Jlisp.nil;
while (!r.atom)
{ LispObject a1 = r;
r = a1.cdr;
a1.cdr = arg1;
arg1 = a1;
}
return arg1;
}
}
class ExpandFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class ExplodeFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(true);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak+LispObject.printEscape);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class ExplodetostringFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return new LispString(Fns.explodeToString(arg1));
}
}
class Explode2Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(true);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class Explode2lcFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(true);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak+LispObject.printLower);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class Explode2lcnFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(false);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak+LispObject.printLower);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class Explode2nFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(false);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class Explode2ucFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(true);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak+LispObject.printUpper);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class Explode2ucnFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(false);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak+LispObject.printUpper);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class ExplodebinaryFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(true);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak+
LispObject.printEscape+
LispObject.printBinary);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class ExplodecFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(true);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class ExplodecnFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(false);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class ExplodehexFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(true);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak+
LispObject.printEscape+
LispObject.printHex);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class ExplodenFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(false);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak+LispObject.printEscape);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class ExplodeoctalFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream f = new LispExploder(true);
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak+
LispObject.printEscape+
LispObject.printOctal);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return Fns.reversip(f.exploded);
}
}
class Fetch_urlFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Fgetv32Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Fgetv64Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class File_readablepFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class File_writeablepFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class FiledateFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
String s;
if (arg1 instanceof Symbol) s = ((Symbol)arg1).pname;
else if (arg1 instanceof LispString) s = ((LispString)arg1).string;
else return Jlisp.nil;
return LispStream.fileDate(s);
}
}
class FilepFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
// use filedate(arg1) here.
String s;
if (arg1 instanceof Symbol) s = ((Symbol)arg1).pname;
else if (arg1 instanceof LispString) s = ((LispString)arg1).string;
else return Jlisp.nil;
return LispStream.fileDate(s);
}
}
class FlagFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
while (!arg1.atom)
{ LispObject p = arg1;
Symbol name = (Symbol)p.car;
arg1 = p.cdr;
Fns.put(name, arg2, Jlisp.lispTrue);
}
return arg1;
}
}
class FlagpFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
LispObject res = Fns.get(arg1, arg2);
if (res != Jlisp.nil) res = Jlisp.lispTrue;
return res;
}
}
class FlagpStarStarFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
LispObject res = Fns.get(arg1, arg2);
if (res != Jlisp.nil) res = Jlisp.lispTrue;
return res;
}
}
class FlagpcarFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
if (arg1.atom) return Jlisp.nil;
arg1 = arg1.car;
LispObject res = Fns.get(arg1, arg2);
if (res != Jlisp.nil) res = Jlisp.lispTrue;
return res;
}
}
class FluidFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class FluidpFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{
return Fns.get(arg1, Jlisp.lit[Lit.special]);
}
}
class FlushFn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
LispStream ee =
(LispStream)Jlisp.lit[Lit.std_output].car/*value*/;
ee.flush();
return Jlisp.nil;
}
public LispObject op1(LispObject arg1) throws Exception
{
LispStream ee = (LispStream)arg1;
ee.flush();
return Jlisp.nil;
}
}
class FormatFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Fp_evaluateFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Fputv32Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Fputv64Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class FuncallFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1 instanceof Symbol)
{ return ((Symbol)arg1).fn.op0();
}
else if (arg1 instanceof LispFunction)
{ return ((LispFunction)arg1).op0();
}
else return Fns.apply0(arg1);
}
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
if (arg1 instanceof Symbol)
{ return ((Symbol)arg1).fn.op1(arg2);
}
else if (arg1 instanceof LispFunction)
{ return ((LispFunction)arg1).op1(arg2);
}
else return Fns.apply1(arg1, arg2);
}
public LispObject opn(LispObject [] aa) throws Exception
{
int n = aa.length;
LispObject arg1 = aa[0];
if (n == 3)
{ if (arg1 instanceof Symbol)
{ return ((Symbol)arg1).fn.op2(aa[1], aa[2]);
}
else if (arg1 instanceof LispFunction)
{ return ((LispFunction)arg1).op2(aa[1], aa[2]);
}
else return error("function in funcall is invalid");
}
LispObject [] args = new LispObject [n-1];
for (int i = 0;i<n-1;i++)
{ args[i] = aa[i+1];
}
if (arg1 instanceof Symbol)
{ return ((Symbol)arg1).fn.opn(args);
}
else if (arg1 instanceof LispFunction)
{ return ((LispFunction)arg1).opn(args);
}
else return Fns.applyn(arg1, args);
}
}
class GctimeFn extends BuiltinFunction
{
// It is not at all obvious that I have any way to record GC time in a Java
// implementation of Lisp, so I will always return 0.
public LispObject op0()
{
return LispInteger.valueOf(0);
}
}
class GensymFn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
return new Gensym("G" + Fns.gensymCounter++);
}
}
class Gensym1Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return new Gensym(((Symbol)arg1).pname + Fns.gensymCounter++);
}
}
class Gensym2Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return new Gensym(((Symbol)arg1).pname);
}
}
class GensympFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1 instanceof Gensym) return Jlisp.lispTrue;
else return Jlisp.nil;
}
}
class GetFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
return Fns.get(arg1, arg2);
}
}
class GetStarFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
return Fns.get(arg1, arg2);
}
}
class Get_current_directoryFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Get_lisp_directoryFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class GetdFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (!(arg1 instanceof Symbol)) return Jlisp.nil;
Symbol name = (Symbol)arg1;
if (name.special != null)
return new Cons(Jlisp.lit[Lit.fexpr], name.special);
LispFunction fn = name.fn;
if (fn instanceof Undefined) return Jlisp.nil;
else if (fn instanceof Macro)
{ LispObject body = ((Macro)fn).body;
return new Cons(Jlisp.lit[Lit.macro], body);
}
else if (fn instanceof Interpreted)
{ LispObject body = ((Interpreted)fn).body;
return new Cons(Jlisp.lit[Lit.expr], body);
}
else return new Cons(Jlisp.lit[Lit.subr], fn);
}
}
class GetenvFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
String s;
if (arg1 instanceof Symbol) s = ((Symbol)arg1).pname;
else if (arg1 instanceof LispString) s = ((LispString)arg1).string;
else return Jlisp.nil;
try
{ String s2 = System.getProperty(s);
if (s2 == null) return Jlisp.nil;
else return new LispString(s2);
}
catch (SecurityException e)
{ return Jlisp.nil;
}
}
}
class GethashFn extends BuiltinFunction
{
public LispObject op1(LispObject key)
{
LispObject r = (LispObject)
((LispHash)Jlisp.lit[Lit.hashtab]).hash.get(key);
if (r == null) r = Jlisp.nil;
else r = new Cons(key, r); // as needed by REDUCE - apologies!
return r;
}
public LispObject op2(LispObject key, LispObject table)
{
LispHash h = (LispHash)table;
LispObject r = (LispObject)h.hash.get(key);
if (r == null) r = Jlisp.nil;
return r;
}
public LispObject opn(LispObject [] args) throws Exception
{
if (args.length != 3)
return error("gethash called with " + args.length +
"args when 1 to 3 expected");
LispObject key = args[0];
LispHash h = (LispHash)args[1];
LispObject defaultValue = args[2];
LispObject r = (LispObject)h.hash.get(key);
if (r == null) r = defaultValue;
return r;
}
}
static LispObject lispZero = LispInteger.valueOf(0); // GC safe here!
class GetvFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
if (!(arg1 instanceof LispVector))
return Jlisp.error("Not a vector in getv", arg1);
LispVector v = (LispVector)arg1;
int i = arg2.intValue();
arg1 = v.vec[i];
if (arg1 == null) return lispZero; // for benefit of oblist()!
else return arg1;
}
}
class Getv16Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Getv32Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Getv8Fn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class GlobalFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class GlobalpFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{
return Fns.get(arg1, Jlisp.lit[Lit.global]);
}
}
class Hash_table_pFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1 instanceof LispHash) return Jlisp.lispTrue;
else return Jlisp.nil;
}
}
class HashcontentsFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{
LispHash h = (LispHash)arg1;
LispObject r = Jlisp.nil;
if (h.flavour != 0)
{ for (Iterator k = h.hash.keySet().iterator(); k.hasNext();)
{ LispObject key = ((LispEqualObject)k.next()).value;
Object value = h.hash.get(key);
r = new Cons(
new Cons(key, (LispObject)value),
r);
}
}
else
{ for (Iterator k = h.hash.keySet().iterator(); k.hasNext();)
{ Object key = k.next();
Object value = h.hash.get(key);
r = new Cons(
new Cons((LispObject)key,
(LispObject)value),
r);
}
}
return r;
}
}
class Hashtagged_nameFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class HelpFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class IdpFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{ return arg1 instanceof Symbol ? Jlisp.lispTrue :
Jlisp.nil;
}
}
class IndirectFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class InormFn extends BuiltinFunction
{
public LispObject op2(LispObject la, LispObject lk) throws Exception
{
BigInteger a = la.bigIntValue();
int k = lk.intValue();
int r = 0;
if (a.signum() == 0) return error("zero argument to inorm");
while (!a.testBit(0))
{ r++;
a = a.shiftRight(1);
}
int n = a.bitLength(); // check later about negative cases!
if (n <= k)
return new Cons(LispInteger.valueOf(a), LispInteger.valueOf(r));
n = n - k; // number of bits to be lost
boolean neg = a.signum() < 0;
if (neg) a = a.negate();
boolean toRound = a.testBit(n-1);
a = a.shiftRight(n);
if (toRound) a = a.add(BigInteger.ONE);
while (!a.testBit(0))
{ r++;
a = a.shiftRight(1);
}
if (neg) a = a.negate();
return new Cons(LispInteger.valueOf(a), LispInteger.valueOf(r+n));
}
}
class Input_librariesFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class InternFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
if (arg1 instanceof LispString)
return Symbol.intern(((LispString)arg1).string);
else if (arg1 instanceof Symbol)
return Symbol.intern(((Symbol)arg1).pname);
else return error(
"Argument to intern should be a symbol or a string");
}
}
class IntersectionFn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2) throws Exception
{
LispObject r = Jlisp.nil;
while (!arg1.atom)
{ LispObject a1 = arg1;
LispObject a2 = arg2;
while (!a2.atom)
{ LispObject a2a = a2;
if (a2a.car.lispequals(a1.car)) break;
a2 = a2a.cdr;
}
if (!a2.atom) r = new Cons(a1.car, r);
arg1 = a1.cdr;
}
arg1 = Jlisp.nil;
while (!r.atom)
{ LispObject a1 = r;
r = a1.cdr;
a1.cdr = arg1;
arg1 = a1;
}
return arg1;
}
}
class Is_consoleFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class LastFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class LastcarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class LastpairFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispObject r = arg1;
while (!arg1.atom)
{ r = arg1;
arg1 = arg1.cdr;
}
return r;
}
}
class LengthFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{
int n = 0;
while (!arg1.atom)
{ n++;
arg1 = arg1.cdr;
}
return LispInteger.valueOf(n);
}
}
class LengthcFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1)
{
LispStream f = new LispCounter();
LispObject save = Jlisp.lit[Lit.std_output].car/*value*/;
try
{ Jlisp.lit[Lit.std_output].car/*value*/ = f;
arg1.print(LispObject.noLineBreak);
}
finally
{ Jlisp.lit[Lit.std_output].car/*value*/ = save;
}
return LispInteger.valueOf(f.column);
}
}
class LetStarFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class Library_nameFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class LinelengthFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
LispStream os = (LispStream)Jlisp.lit[Lit.std_output].car/*value*/;
int prev = os.lineLength;
if (arg1 instanceof LispInteger)
{ int n = arg1.intValue();
os.lineLength = n;
}
return LispInteger.valueOf(prev);
}
}
class ListFn extends BuiltinFunction
{
public LispObject op0() { return Jlisp.nil; }
public LispObject op1(LispObject arg1)
{ return new Cons(arg1, Jlisp.nil);
}
public LispObject op2(LispObject arg1, LispObject arg2)
{ return new Cons(arg1,
new Cons(arg2, Jlisp.nil));
}
public LispObject opn(LispObject [] args)
{
LispObject r = Jlisp.nil;
for (int i=args.length; i!=0;)
{ r = new Cons(args[--i], r);
}
return r;
}
}
class ListStarFn extends BuiltinFunction
{
public LispObject op0() { return Jlisp.nil; }
public LispObject op1(LispObject arg1)
{ return arg1;
}
public LispObject op2(LispObject arg1, LispObject arg2)
{ return new Cons(arg1, arg2);
}
public LispObject opn(LispObject [] args)
{
int i = args.length;
LispObject r = args[--i];
while (i != 0)
{ r = new Cons(args[--i], r);
}
return r;
}
}
class List_directoryFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
return error(name + " not yet implemented");
}
}
class List_modulesFn extends BuiltinFunction
{
public LispObject op0() throws Exception
{
for (int i=0; i<Jlisp.imageCount; i++)
{ PDS z = Jlisp.images[i];
if (z != null) z.print();
}
return Jlisp.nil;
}
}
class List_to_stringFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
StringBuffer s = new StringBuffer();
while (!arg1.atom)
{ LispObject c = arg1;
arg1 = c.cdr;
LispObject ch = c.car;
if (ch instanceof Symbol)
s.append(((Symbol)ch).pname.charAt(0));
else if (ch instanceof LispString)
s.append(((LispString)ch).string.charAt(0));
else if (ch instanceof LispInteger)
s.append((char)ch.intValue());
else return error("Illegal item in list handed to list-to-string");
}
return new LispString(s.toString());
}
}
class List_to_symbolFn extends BuiltinFunction
{
public LispObject op1(LispObject arg1) throws Exception
{
StringBuffer s = new StringBuffer();
while (!arg1.atom)
{ LispObject c = arg1;
arg1 = c.cdr;
LispObject ch = c.car;
if (ch instanceof Symbol)
s.append(((Symbol)ch).pname.charAt(0));
if (ch instanceof LispString)
s.append(((LispString)ch).string.charAt(0));
else if (ch instanceof LispInteger)
s.append((char)ch.intValue());
else return error("Illegal item in list handed to list-to-string");
}
return Symbol.intern(s.toString());
}
}
class List2Fn extends BuiltinFunction
{
public LispObject op2(LispObject arg1, LispObject arg2)
{
return new Cons(arg1, new Cons(arg2, Jlisp.nil));
}
}
class List2StarFn extends BuiltinFunction
{
public LispObject opn(LispObject [] args) throws Exception
{
if (args.length != 3)
return error("list2* called with " + args.length +
" args when 3 were expected");
else return new Cons(args[0], new Cons(args[1], args[2]));
}
}
class List3Fn extends BuiltinFunction
{
public LispObject opn(LispObject [] args) throws Exception
{
if (args.length != 3)
return error("list3 called with " + args.length +
" args when 3 were expected");
else return new Cons(args[0],
new Cons(args[1],
new Cons(args[2], Jlisp.nil)));
}
}
}
// end of Fns1.java