//
// This file is part of the Jlisp implementation of Standard Lisp
// Copyright \u00a9 (C) Codemist Ltd, 1998-2000.
//
// A "cons" is an ordered pair. In ML terms it would be
// a bit like ('a * 'b)
import java.io.*;
public class Cons extends LispObject
{
static int consCount = 0;
// The left and right parts of a pair are called
// CAR and CDR
public Cons()
{
super(null, null);
}
public Cons(LispObject car, LispObject cdr)
{
super(car, cdr);
}
// Function calls are written as lists (fn a1 a2 ...)
LispObject eval() throws Exception
{ int n = 0;
try // So I can display a backtrace of my own
{ Symbol fname = null;
if (car instanceof Symbol)
{ fname = (Symbol)car;
if (fname.fn instanceof Macro)
{ LispObject r = fname.fn.op1(this); // use 1-arg version
return r.eval();
}
else if (fname.special != null)
{ return fname.special.op(cdr);
}
}
LispObject a;
for (a=cdr; !a.atom; a = a.cdr) n++;
if (fname != null)
{ switch (n)
{
case 0: return fname.fn.op0();
case 1: a = cdr.car.eval();
if (Specfn.progEvent != Specfn.NONE) return Jlisp.nil;
return fname.fn.op1(a);
case 2: a = cdr.car.eval();
if (Specfn.progEvent != Specfn.NONE) return Jlisp.nil;
LispObject b = cdr.cdr.car.eval();
if (Specfn.progEvent != Specfn.NONE) return Jlisp.nil;
return fname.fn.op2(a, b);
default:
LispObject [] args = new LispObject [n];
n = 0;
for (a=cdr;
!a.atom;
a = a.cdr)
{ args[n++] = a.car.eval();
if (Specfn.progEvent != Specfn.NONE) return Jlisp.nil;
}
return fname.fn.opn(args);
}
}
LispObject [] args = new LispObject [n];
n = 0;
for (a=cdr;
!a.atom;
a = a.cdr) args[n++] = a.car;
// Now the head of the list is not a symbol. The only
// other legal possibility is that it is a lambda-expression,
// so I should look for (lambda vars body ...)
if (!car.atom)
{ for (int i=0; i<n; i++)
{ args[i] = args[i].eval();
if (Specfn.progEvent != Specfn.NONE) return Jlisp.nil;
}
for (int i=0; i<n; i++) Fns.args[i] = args[i];
args = null;
return Fns.applyInner(car, n);
}
else return Jlisp.error("unknown form of expression for evaluation");
}
catch (ProgEvent e)
{ throw e;
}
catch (Exception e)
{ if (Jlisp.backtrace)
{ Jlisp.errprint("Evaluating: ");
this.errPrint();
Jlisp.errprintln();
}
throw e;
}
}
// Lists print as (a b c ... )
// and if a list ends in NIL then it is displayed with
// just a ")" at the end, otherwise the final atom is
// shown after a "."
void iprint()
{
LispObject x = this;
if ((currentFlags & noLineBreak) == 0 &&
currentOutput.column + 1 > currentOutput.lineLength)
currentOutput.println();
currentOutput.print("(");
if (x.car == null)
{ if ((currentFlags & noLineBreak) == 0 &&
currentOutput.column + 6 > currentOutput.lineLength)
currentOutput.println();
currentOutput.print("<null>");
}
else x.car.iprint();
x = x.cdr;
while (x != null && !x.atom)
{ if (car == null)
{ if ((currentFlags & noLineBreak) == 0 &&
currentOutput.column + 6 >= currentOutput.lineLength)
currentOutput.println();
else currentOutput.print(" ");
currentOutput.print("<null>");
}
else x.car.blankprint();
x = x.cdr;
}
if (x != Jlisp.nil)
{ if ((currentFlags & noLineBreak) == 0 &&
currentOutput.column + 1 >= currentOutput.lineLength)
currentOutput.println();
else currentOutput.print(" ");
currentOutput.print(".");
if (x == null)
{ if ((currentFlags & noLineBreak) == 0 &&
currentOutput.column + 6 >= currentOutput.lineLength)
currentOutput.println();
else currentOutput.print(" ");
currentOutput.print("<null>");
}
else x.blankprint();
}
if ((currentFlags & noLineBreak) == 0 &&
currentOutput.column + 1 > currentOutput.lineLength)
currentOutput.println();
currentOutput.print(")");
}
void blankprint()
{
if (currentOutput.column + 1 >= currentOutput.lineLength)
currentOutput.println();
else currentOutput.print(" ");
iprint();
}
LispObject copy()
{
LispObject a = this;
LispObject r = Jlisp.nil;
while (!a.atom)
{ r = new Cons(a.car.copy(), r);
a = a.cdr;
}
while (!r.atom)
{ LispObject w = r;
r = r.cdr;
w.cdr = a;
a = w;
}
return a;
}
public boolean lispequals(Object b)
{
if (!(b instanceof Cons)) return false;
LispObject a1 = this, b1 = (LispObject)b;
for (;;)
{ LispObject p1 = a1.car, q1 = b1.car;
if (!p1.lispequals(q1)) return false;
p1 = a1.cdr;
q1 = b1.cdr;
if (p1.atom) return p1.lispequals(q1);
if (q1.atom) return false;
a1 = p1;
b1 = q1;
}
}
// The idea used to hash Cons cells here is to accept that I have to
// drop through and do a recursive tree walk. But very deep trees
// and especially looped up structures would be a MENACE. So I truncate
// the search at a depth of "100" where each CAR direction link costs
// 10 and each CDR direction link costs only 1. The expectation is that
// this limits the total cost to O(1000) - bad but tolerable. When I
// exceed the limit I must hand back a fixed value. I use crude and
// not-thought-out arithmetic to combine hash-values of components.
// Note that if a tree contains vectors I will need to limit recursion
// through them too.
public int lisphashCode()
{
return lisphashCode(this, 100);
}
int lisphashCode(LispObject a, int n)
{ int r = 9990;
while (n >= 0 && !a.atom)
{ n--;
LispObject ca = a;
if (!ca.car.atom)
r = 169*r - lisphashCode(ca.car, n-10);
else r = 11213*r + ca.car.lisphashCode();
a = ca.cdr;
}
if (n < 0) return r + 212215;
else if (a instanceof LispVector)
return ((LispVector)a).lisphashCode(n-3)*0xfade0ff - r;
else return a.lisphashCode()*0xDe5ade + r;
}
void scan()
{
if (Jlisp.objects.contains(this)) // seen before?
{ if (!Jlisp.repeatedObjects.containsKey(this))
{ Jlisp.repeatedObjects.put(
this,
Jlisp.nil); // value is junk at this stage
}
}
else
{ Jlisp.objects.add(this);
Jlisp.stack.push(cdr);
Jlisp.stack.push(car);
}
}
void dump() throws IOException
{
Object w = Jlisp.repeatedObjects.get(this);
if (w != null &&
w instanceof Integer) putSharedRef(w); // processed before
else
{ if (w != null) // will be used again sometime
{ Jlisp.repeatedObjects.put(
this,
new Integer(Jlisp.sharedIndex++));
Jlisp.odump.write(X_STORE);
}
int n = 1;
boolean starred = false;
LispObject l = cdr;
Jlisp.spine[0] = car;
while (n < 16 &&
!l.atom &&
Jlisp.repeatedObjects.get(l) == null)
{ Jlisp.spine[n++] = l.car;
l = l.cdr;
}
if (n < 16 &&
Jlisp.specialNil && // ha ha be careful here
l == Jlisp.nil) // especially common case!
{ Jlisp.odump.write(X_LIST+n);
}
else
{ Jlisp.odump.write(X_LISTX+n-1);
starred = true;
}
for (int i=0; i<n; i++)
{ Jlisp.stack.push(Jlisp.spine[i]);
}
if (starred) Jlisp.stack.push(l);
}
}
}
// End of Cons.java