Artifact 223f061635bdc5b72cf329cc6928fda35cc1476cb3585d8d16e49559d630c20b:
- Executable file
r37/lisp/csl/jlisp/Cons.java
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 9177) [annotate] [blame] [check-ins using] [more...]
// // 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