File r37/lisp/csl/jlisp/Cons.java artifact 223f061635 part of check-in 3af273af29


//
// 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



REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]