commit 765717256bd12c7add80fbd2c854491a460a5bea
parent 657528d0737896b1d927616fb468bfe7cbef55ab
Author: Commit-Bot <unknown>
Date: Sun, 10 Oct 2010 07:43:48 +0000
Automatic commit from picoLisp.tgz, From: Sun, 10 Oct 2010 07:43:48 GMT
Diffstat:
17 files changed, 2013 insertions(+), 189 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* XXdec10 picoLisp-3.0.5
+ Ersatz PicoLisp (Java) version
Bug in (rd 'cnt)
* 30sep10 picoLisp-3.0.4
diff --git a/ReleaseNotes b/ReleaseNotes
@@ -1,4 +1,4 @@
-30sep10abu
+06oct10abu
(c) Software Lab. Alexander Burger
@@ -10,3 +10,5 @@ A. The 'pid' function was removed. This was announced in the previous version,
http://www.mail-archive.com/picolisp@software-lab.de/msg01949.html
+B. "Ersatz PicoLisp" (written in Java) was included for a first evaluation. For
+ further informations, please look at "ersatz/README".
diff --git a/doc/faq.html b/doc/faq.html
@@ -659,8 +659,13 @@ microcode levels) are s-expressions: The machine language is <i>Lisp</i>.
<p>PicoLisp is a pragmatic language. It doesn't check at runtime for all
possible error conditions which won't occur during normal usage. Such errors are
usually detected quickly at the first test run, and checking for them after that
-would just produce runtime overhead. It is recommended, though, to inspect the
-code periodically with <code><a href="refL.html#lint">lint</a></code>.
+would just produce runtime overhead.
+
+<p>Catching the segfault signals is also not a good idea, because the Lisp heap
+is most probably be damanged afterwards.
+
+<p>It is recommended, though, to inspect the code periodically with <code><a
+href="refL.html#lint">lint</a></code>.
<p><hr>
diff --git a/ersatz/Manifest b/ersatz/Manifest
@@ -0,0 +1 @@
+Main-Class: PicoLisp
diff --git a/ersatz/README b/ersatz/README
@@ -0,0 +1,47 @@
+10oct10abu
+(c) Software Lab. Alexander Burger
+
+
+ Ersatz PicoLisp
+ ===============
+
+Ersatz PicoLisp is a version of PicoLisp completely written in Java.
+
+It should be the last resort when there is no other way to run a "real"
+PicoLisp. Also, it may be used to bootstrap the 64-bit version, which requires a
+running PicoLisp to build from the sources.
+
+Performance is rather poor. It is 10 to 20 times slower, and uses much more
+memory. But efficiency was not a major goal. Instead, performance was often
+sacrificed in favor of simpler or more modular structures.
+
+There is no support for child processes ('fork'), interprocess communication
+('tell', 'hear', 'ipc' etc.), PLIO ('pr', 'rd' etc.) and databases (external
+symbols).
+
+
+ Invocation
+ ----------
+
+Ersatz PicoLisp can be started - analog to 'bin/picolisp' - as
+
+ $ ersatz/picolisp
+
+
+If absolutely no "bin/picolisp" can be build, you might install symbolic links
+in the "bin/" directory to Ersatz PicoLisp:
+
+ $ (cd bin; ln -s ../ersatz/picolisp && ln -s ../ersatz/picolisp.jar)
+
+
+ Building the JAR file
+ ---------------------
+
+The actual source files are
+
+ sys.src # The system
+ fun.src # Function definitions
+
+The PicoLisp script "mkJar" will read them, generate the Java source file
+"PicoLisp.java", compile that with 'javac', and pack the result into a JAR (Java
+Archive) file.
diff --git a/ersatz/fun.src b/ersatz/fun.src
@@ -0,0 +1,430 @@
+# 10oct10abu
+# (c) Software Lab. Alexander Burger
+
+# Ersatz PicoLisp Functions
+
+############ main ############
+# (args) -> flg
+args
+ return Env.Next < Env.ArgC? T : Nil;
+
+# (next) -> any
+next
+ return Env.Next < Env.ArgC? (Env.Arg = Env.Args[Env.Next++]) : Nil;
+
+# (arg ['cnt]) -> any
+arg
+ if ((x = ex.cdr()) instanceof Cell)
+ return (i = evInt(x)+Env.Next-1) >= 0 && i < Env.ArgC? Env.Args[i] : Nil;
+ return Env.Arg;
+
+# (rest) -> lst
+rest
+ for (x = Nil, i = Env.ArgC; --i >= Env.Next;)
+ x = new Cell(Env.Args[i], x);
+ return x;
+
+############ apply ############
+# (apply 'fun 'lst ['any ..]) -> any
+apply
+ w = (x = ex.cdr()).car().eval();
+ y = (x = x.cdr()).car().eval();
+ for (v = new Any[6], i = 0; (x = x.cdr()) instanceof Cell;)
+ v = append(v, i++, x.car().eval());
+ while (y instanceof Cell) {
+ v = append(v, i++, y.car());
+ y = y.cdr();
+ }
+ return w.apply(ex, false, v, i);
+
+# (pass 'fun ['any ..]) -> any
+pass
+ w = (x = ex.cdr()).car().eval();
+ for (v = new Any[6], i = 0; (x = x.cdr()) instanceof Cell;)
+ v = append(v, i++, x.car().eval());
+ for (j = Env.Next; j < Env.ArgC; ++j)
+ v = append(v, i++, Env.Args[j]);
+ return w.apply(ex, false, v, i);
+
+# (map 'fun 'lst ..) -> lst
+map
+ w = (x = ex.cdr()).car().eval();
+ if ((x = x.cdr()) instanceof Cell) {
+ v = new Any[6];
+ i = 0;
+ do
+ v = append(v, i++, x.car().eval());
+ while ((x = x.cdr()) instanceof Cell);
+ while ((y = v[0]) instanceof Cell) {
+ x = w.apply(ex, false, v, i);
+ for (j = i; --j >= 0;)
+ v[j] = v[j].cdr();
+ }
+ }
+ return x;
+
+# (mapcar 'fun 'lst ..) -> lst
+mapcar
+ w = (x = ex.cdr()).car().eval();
+ z = Nil;
+ if ((x = x.cdr()) instanceof Cell) {
+ v = new Any[6];
+ i = 0;
+ do
+ v = append(v, i++, x.car().eval());
+ while ((x = x.cdr()) instanceof Cell);
+ if (!(v[0] instanceof Cell))
+ return z;
+ z = x = new Cell(w.apply(ex, true, v, i), Nil);
+ while (v[0].cdr() instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].cdr();
+ x = ((Cell)x).Cdr = new Cell(w.apply(ex, true, v, i), Nil);
+ }
+ }
+ return z;
+
+############ flow ############
+# (eval 'any ['cnt ['lst]]) -> any
+eval
+ if ((y = (x = ex.cdr()).car().eval()) instanceof Number)
+ return y;
+ if (!((x = x.cdr()) instanceof Cell) || Env.Bind == null)
+ return y.eval();
+ return evRun(true, y, evInt(x), x.cdr().car().eval());
+
+# (run 'any ['cnt ['lst]]) -> any
+run
+ if ((y = (x = ex.cdr()).car().eval()) instanceof Number)
+ return y;
+ if (!((x = x.cdr()) instanceof Cell) || Env.Bind == null)
+ return y.run();
+ return evRun(false, y, evInt(x), x.cdr().car().eval());
+
+# (de sym . any) -> sym
+de
+ x = ex.cdr();
+ redefine(ex, (Symbol)x.car(), x.cdr());
+ return ex.cdr().car();
+
+# (dm sym . fun|cls2) -> sym
+# (dm (sym . cls) . fun|cls2) -> sym
+# (dm (sym sym2 [. cls]) . fun|cls2) -> sym
+dm
+ if (!((x = ex.cdr()).car() instanceof Cell)) {
+ s = (Symbol)x.car();
+ w = Class.Val;
+ }
+ else {
+ s = (Symbol)x.car().car();
+ w = !((y = x.car()).cdr() instanceof Cell)? y.cdr() :
+ (y.cdr().cdr() == Nil? Class.Val : y.cdr().cdr()).get(y.cdr().car());
+ }
+ if (s != T)
+ redefine(ex, s, Meth.Val);
+ if (x.cdr() instanceof Symbol) {
+ y = ((Symbol)x.cdr()).Val;
+ for (;;) {
+ if (!(y instanceof Cell) || !(y.car() instanceof Cell))
+ err(ex, s, "Bad message");
+ if (y.car().car() == s) {
+ x = y.car();
+ break;
+ }
+ y = y.cdr();
+ }
+ }
+ for (y = ((Symbol)w).Val; y instanceof Cell && y.car() instanceof Cell; y = y.cdr())
+ if (y.car().car() == s) {
+ if (!equal(x.cdr(), y.cdr().car()))
+ redefMsg(s, w);
+ ((Cell)y.car()).Cdr = x.cdr();
+ putSrc(w, s);
+ return s;
+ }
+ ((Symbol)w).Val = x.car() instanceof Cell?
+ new Cell(new Cell(s, x.cdr()), ((Symbol)w).Val) :
+ new Cell(x, ((Symbol)w).Val);
+ putSrc(w, s);
+ return s;
+
+# (if 'any1 'any2 . prg) -> any
+if
+ if ((y = (x = ex.cdr()).car().eval()) == Nil)
+ return x.cdr().cdr().prog();
+ At.Val = y;
+ x = x.cdr();
+ return x.car().eval();
+
+# (while 'any . prg) -> any
+while
+ x = ex.cdr();
+ z = Nil;
+ while ((y = x.car().eval()) != Nil) {
+ At.Val = y;
+ z = x.cdr().prog();
+ }
+ return z;
+
+# (catch 'any . prg) -> any
+catch
+ new Catch(y = (x = ex.cdr()).car().eval(), Zero, Env);
+ try {return x.cdr().prog();}
+ catch (Throw e) {
+ if (y == e.Tag)
+ return e.Val;
+ throw e;
+ }
+ finally {Catch = Catch.Link;}
+
+# (throw 'sym 'any)
+throw
+ y = (x = ex.cdr()).car().eval();
+ throw new Throw(ex, y, x.cdr().car().eval());
+
+# (finally exe . prg) -> any
+finally
+ new Catch(null, y = (x = ex.cdr()).car(), Env);
+ z = x.cdr().prog();
+ y.eval();
+ Catch = Catch.Link;
+ return z;
+
+# (bye 'cnt|NIL)
+bye
+ x = ex.cdr().car().eval();
+ /* ... */
+ System.exit(x == Nil? 0 : ((Number)x).intValue());
+
+############ sym ############
+# (all ['T]) -> lst
+all
+ return all((x = ex.cdr().car().eval()) == Nil? Intern : Transient);
+
+# (==== ['sym ..]) -> NIL
+====
+ Transient.clear();
+ for (x = ex.cdr(); x instanceof Cell; x = x.cdr()) {
+ y = x.car().eval();
+ Transient.put(((Symbol)y).Name, (Symbol)y);
+ }
+ return Nil;
+
+# (set 'var 'any ..) -> any
+set
+ x = ex.cdr();
+ do {
+ y = x.car().eval();
+ y.set(z = (x = x.cdr()).car().eval());
+ } while ((x = x.cdr()) instanceof Cell);
+ return z;
+
+# (setq var 'any ..) -> any
+setq
+ x = ex.cdr();
+ do {
+ y = x.car();
+ y.set(z = (x = x.cdr()).car().eval());
+ } while ((x = x.cdr()) instanceof Cell);
+ return z;
+
+# (put 'sym1|lst ['sym2|cnt ..] 'sym|0 'any) -> any
+put
+ y = (x = ex.cdr()).car().eval();
+ for (x = x.cdr();;) {
+ z = x.car().eval();
+ if (!((x = x.cdr()).cdr() instanceof Cell))
+ return y.put(z, x.car().eval());
+ y = y.get(z);
+ }
+
+# (get 'sym1|lst ['sym2|cnt ..]) -> any
+get
+ y = (x = ex.cdr()).car().eval();
+ while ((x = x.cdr()) instanceof Cell)
+ y = y.get(x.car().eval());
+ return y;
+
+############ subr ############
+# (car 'var) -> any
+car
+ return ex.cdr().car().eval().car();
+
+# (cdr 'lst) -> any
+cdr
+ return ex.cdr().car().eval().cdr();
+
+# (cons 'any ['any ..]) -> lst
+cons
+ y = z = new Cell((x = ex.cdr()).car().eval(), Nil);
+ while ((x = x.cdr()).cdr() instanceof Cell)
+ y = ((Cell)y).Cdr = new Cell(x.car().eval(), Nil);
+ ((Cell)y).Cdr = x.car().eval();
+ return z;
+
+# (list 'any ['any ..]) -> lst
+list
+ y = z = new Cell((x = ex.cdr()).car().eval(), Nil);
+ while ((x = x.cdr()) instanceof Cell)
+ y = ((Cell)y).Cdr = new Cell(x.car().eval(), Nil);
+ return z;
+
+# (> 'any ..) -> flg
+>
+ y = (x = ex.cdr()).car().eval();
+ while ((x = x.cdr()) instanceof Cell) {
+ z = x.car().eval();
+ if (compare(y,z) <= 0)
+ return Nil;
+ y = z;
+ }
+ return T;
+
+############ big ############
+# (+ 'num ..) -> num
++
+ if ((y = (x = ex.cdr()).car().eval()) == Nil)
+ return Nil;
+ for (n = (Number)y; (x = x.cdr()) instanceof Cell; n = n.add((Number)y))
+ if ((y = x.car().eval()) == Nil)
+ return Nil;
+ return new Number(n.toByteArray());
+
+# (- 'num ..) -> num
+-
+ if ((y = (x = ex.cdr()).car().eval()) == Nil)
+ return Nil;
+ n = (Number)y;
+ if (!((x = x.cdr()) instanceof Cell))
+ return new Number(n.negate().toByteArray());
+ do {
+ if ((y = x.car().eval()) == Nil)
+ return Nil;
+ n = n.subtract((Number)y);
+ } while ((x = x.cdr()) instanceof Cell);
+ return new Number(n.toByteArray());
+
+# (inc 'num) -> num
+# (inc 'var ['num]) -> num
+inc
+ if ((y = (x = ex.cdr()).car().eval()) == Nil)
+ return Nil;
+ if (y instanceof Number)
+ return new Number(((Number)y).add(ONE).toByteArray());
+ if (!((x = x.cdr()) instanceof Cell)) {
+ if (y.car() == Nil)
+ return Nil;
+ y.set(z = new Number(((Number)y.car()).add(ONE).toByteArray()));
+ }
+ else {
+ z = x.car().eval();
+ if (y.car() == Nil || z == Nil)
+ return Nil;
+ y.set(z = new Number(((Number)y.car()).add((Number)z).toByteArray()));
+ }
+ return z;
+
+# (dec 'num) -> num
+# (dec 'var ['num]) -> num
+dec
+ if ((y = (x = ex.cdr()).car().eval()) == Nil)
+ return Nil;
+ if (y instanceof Number)
+ return new Number(((Number)y).subtract(ONE).toByteArray());
+ if (!((x = x.cdr()) instanceof Cell)) {
+ if (y.car() == Nil)
+ return Nil;
+ y.set(z = new Number(((Number)y.car()).subtract(ONE).toByteArray()));
+ }
+ else {
+ z = x.car().eval();
+ if (y.car() == Nil || z == Nil)
+ return Nil;
+ y.set(z = new Number(((Number)y.car()).subtract((Number)z).toByteArray()));
+ }
+ return z;
+
+# (* 'num ..) -> num
+*
+ if ((y = (x = ex.cdr()).car().eval()) == Nil)
+ return Nil;
+ for (n = (Number)y; (x = x.cdr()) instanceof Cell; n = n.multiply((Number)y))
+ if ((y = x.car().eval()) == Nil)
+ return Nil;
+ return new Number(n.toByteArray());
+
+# (*/ 'num1 ['num2 ..] 'num3) -> num
+*/
+ if ((y = (x = ex.cdr()).car().eval()) == Nil)
+ return Nil;
+ for (n = (Number)y; ; n = n.multiply((Number)y)) {
+ if ((y = (x = x.cdr()).car().eval()) == Nil)
+ return Nil;
+ if (!((x.cdr()) instanceof Cell))
+ return new Number(n.add(((Number)y).divide(Two)).divide((Number)y).toByteArray());
+ }
+
+# (/ 'num ..) -> num
+/
+ if ((y = (x = ex.cdr()).car().eval()) == Nil)
+ return Nil;
+ for (n = (Number)y; (x = x.cdr()) instanceof Cell; n = n.divide((Number)y))
+ if ((y = x.car().eval()) == Nil)
+ return Nil;
+ return new Number(n.toByteArray());
+
+# (% 'num ..) -> num
+%
+ if ((y = (x = ex.cdr()).car().eval()) == Nil)
+ return Nil;
+ for (n = (Number)y; (x = x.cdr()) instanceof Cell; n = n.remainder((Number)y))
+ if ((y = x.car().eval()) == Nil)
+ return Nil;
+ return new Number(n.toByteArray());
+
+# (>> 'cnt 'num) -> num
+>>
+ i = evInt(x = ex.cdr());
+ if ((y = x.cdr().car().eval()) == Nil)
+ return Nil;
+ return new Number(((Number)y).shiftRight(i).toByteArray());
+
+# (lt0 'any) -> num | NIL
+lt0
+ return (x = ex.cdr().car().eval()) instanceof Number && ((Number)x).compareTo(Zero) < 0? x : Nil;
+
+# (ge0 'any) -> num | NIL
+ge0
+ return (x = ex.cdr().car().eval()) instanceof Number && ((Number)x).compareTo(Zero) >= 0? x : Nil;
+
+# (gt0 'any) -> num | NIL
+gt0
+ return (x = ex.cdr().car().eval()) instanceof Number && ((Number)x).compareTo(Zero) > 0? x : Nil;
+
+# (abs 'num) -> num
+abs
+ return new Number(((Number)ex.cdr().car().eval()).abs().toByteArray());
+
+############ io ############
+# (load 'any ..) -> any
+load
+ x = ex.cdr();
+ do {
+ if ((y = x.car().eval()) != T)
+ y = load(ex, '>', y);
+ else
+ y = loadAll(ex);
+ } while ((x = x.cdr()) instanceof Cell);
+ return y;
+
+# (println 'any ..) -> any
+println
+ OutFile.print(y = (x = ex.cdr()).car().eval());
+ while ((x = x.cdr()) instanceof Cell) {
+ OutFile.space();
+ OutFile.print(y = x.car().eval());
+ }
+ OutFile.newline();
+ return y;
+
+# vi:et:ts=3:sw=3
diff --git a/ersatz/mkJar b/ersatz/mkJar
@@ -0,0 +1,52 @@
+#!../bin/picolisp ../lib.l
+# 06oct10abu
+# (c) Software Lab. Alexander Burger
+
+(load "@ext.l")
+
+# Build Ersatz PicoLisp
+
+(out "PicoLisp.java"
+ (in "sys.src"
+ (echo "<SYM>")
+ (let Cnt (read)
+ (in "fun.src"
+ (skip "#")
+ (loop
+ (let Name (line T)
+ (prinl
+ "mkSymbol(new Number(\""
+ (inc 'Cnt)
+ "\"), \""
+ Name
+ "\", Intern);" ) )
+ (while (= " " (car (line))))
+ (prin " ")
+ (NIL (skip "#")) ) ) )
+ (skip)
+ (echo "<FUN>")
+ (let (Cnt (read) Line)
+ (in "fun.src"
+ (skip "#")
+ (loop
+ (let Name (line T)
+ (prinl
+ "case "
+ (inc 'Cnt)
+ ": // "
+ Name ) )
+ (while (= " " (car (setq Line (line))))
+ (prinl " " Line) )
+ (prin " ")
+ (NIL (skip "#")) ) ) )
+ (skip)
+ (echo) ) )
+
+(when (call "javac" "-O" "-g:none" "PicoLisp.java")
+ (let Lst (filter '((F) (tail '`(chop ".class") (chop F))) (dir))
+ (apply call Lst "jar" "cmf" "Manifest" "picolisp.jar")
+ (apply call Lst "rm") ) )
+
+(bye)
+
+# vi:et:ts=3:sw=3
diff --git a/ersatz/picolisp b/ersatz/picolisp
@@ -0,0 +1,5 @@
+#!/bin/sh
+# 06oct10abu
+
+# Run Ersatz PicoLisp
+exec java -jar ${0%/*}/picolisp.jar "$@"
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/ersatz/sys.src b/ersatz/sys.src
@@ -0,0 +1,1273 @@
+// 10oct10abu
+// (c) Software Lab. Alexander Burger
+
+import java.io.*;
+import java.util.*;
+import java.math.*;
+
+/* Ersatz PicoLisp Interpreter (Poor Man's PicoLisp) */
+public class PicoLisp {
+ final static HashMap<String,Symbol> Intern = new HashMap<String,Symbol>();
+ final static HashMap<String,Symbol> Transient = new HashMap<String,Symbol>();
+
+ final static Number Zero = new Number(0);
+ final static Number One = new Number(1);
+ final static Number Two = new Number(2);
+
+ final static NilSym Nil = new NilSym();
+ final static Symbol T = mkSymbol(null, "T", Intern);
+ final static Symbol At = mkSymbol(Nil, "@", Intern);
+ final static Symbol At2 = mkSymbol(Nil, "@@", Intern);
+ final static Symbol At3 = mkSymbol(Nil, "@@@", Intern);
+ final static Symbol This = mkSymbol(Nil, "This", Intern);
+ final static Symbol Dbg = mkSymbol(Nil, "*Dbg", Intern);
+ final static Symbol Scl = mkSymbol(Zero, "*Scl", Intern);
+ final static Symbol Class = mkSymbol(Nil, "*Class", Intern);
+
+ final static Symbol Quote = mkSymbol(Zero, "quote", Intern);
+ final static Symbol Meth = mkSymbol(One, "meth", Intern);
+
+ final static PicoLispReader StdIn = new PicoLispReader(System.in);
+ final static PicoLispWriter StdOut = new PicoLispWriter(System.out);
+ final static PicoLispWriter StdErr = new PicoLispWriter(System.err);
+ final static String Delim = " \t\n\r\"'(),[]`~{}";
+
+ static Catch Catch;
+ static Env Env = new Env();
+ static PicoLispReader InFile = StdIn;
+ static PicoLispWriter OutFile = StdOut;
+ static Any TheCls, TheKey;
+ static String[] Argv;
+
+ public static void main(String[] argv) {
+ Argv = argv;
+ <SYM> 1
+ loadAll(null);
+ load(null, ':', Nil);
+ System.exit(0);
+ }
+
+ final static void unwind(Catch p) {
+ /* ... */
+ }
+
+ final static Any err(Any ex, Any x, String msg) {
+ if (ex != null) {
+ StdErr.Wr.print("!? ");
+ StdErr.print(ex);
+ StdErr.newline();
+ }
+ if (x != null)
+ msg = x + " -- " + msg;
+ throw new Error(msg);
+ }
+
+ final static void closeErr(IOException e) {err(null, null, e.toString());}
+
+ final static Any load(Any ex, char pr, Any x) {
+ if (x instanceof Symbol && ((Symbol)x).firstChar() == '-')
+ return ((Symbol)x).parse(true,null).eval();
+ Env.pushInFile(x.open(ex));
+ Transient.clear();
+ x = Nil;
+ for (;;) {
+ Any y;
+ if (InFile != StdIn)
+ y = InFile.read('\0');
+ else {
+ if (pr != '\0' && InFile.Chr == 0) {
+ OutFile.Wr.print(pr);
+ OutFile.space();
+ OutFile.Wr.flush();
+ }
+ y = InFile.read('\n');
+ if (InFile.Chr == '\n')
+ InFile.Chr = 0;
+ }
+ if (y == Nil)
+ break;
+ if (InFile != StdIn || InFile.Chr != 0 || pr == '\0')
+ x = y.eval();
+ else {
+ Any at = At.Val;
+ x = At.set(y.eval());
+ At3.set(At2.Val);
+ At2.set(at);
+ OutFile.Wr.print("-> ");
+ OutFile.Wr.flush();
+ OutFile.print(x);
+ OutFile.newline();
+ }
+ }
+ Env.popInFiles();
+ return x;
+ }
+
+ final static Any loadAll(Any ex) {
+ Any x = Nil;
+ while (Argv.length > 0 && !Argv[0].equals("-")) {
+ x = load(ex, '\0', new Symbol(null, Argv[0]));
+ String[] a = new String[Argv.length-1];
+ System.arraycopy(Argv, 1, a, 0, a.length);
+ Argv = a;
+ }
+ return x;
+ }
+
+ final static Any undefined(Any x, Any ex) {
+ OutFile.print(ex); /* ... */
+ OutFile.newline();
+ return err(ex, x, "Undefined");
+ }
+
+ final static Any[] append(Any[] a, int i, Any x) {
+ if (i == a.length) {
+ Any[] b = new Any[i*2];
+ System.arraycopy(a, 0, b, 0, i);
+ a = b;
+ }
+ a[i] = x;
+ return a;
+ }
+
+ final static Symbol mkSymbol(Any val) {return new Symbol(val, null);}
+
+ final static Symbol mkSymbol(Any val, String name, HashMap<String,Symbol> table) {
+ Symbol sym;
+ if ((sym = table.get(name)) == null) {
+ sym = new Symbol(val, name);
+ table.put(name, sym);
+ }
+ return sym;
+ }
+
+ final static Any all(HashMap<String,Symbol> table) {
+ Any x = Nil;
+ for (Iterator<Symbol> it = table.values().iterator(); it.hasNext();)
+ x = new Cell(it.next(), x);
+ return x;
+ }
+
+ final static void redefMsg(Any x, Any y) {
+ /* ... */
+ OutFile.Wr.print("# ");
+ OutFile.print(x);
+ if (y != null) {
+ OutFile.space();
+ OutFile.print(y);
+ }
+ OutFile.Wr.println(" redefined");
+ }
+
+ final static void putSrc(Any s, Any k) {
+ if (Dbg.Val != Nil && InFile != null && InFile.Name != null) {
+ Any x = new Cell(new Number(InFile.Src+1), mkSymbol(null, InFile.Name, Transient));
+ Any y = s.get(Dbg);
+ if (k == null) {
+ if (y == Nil)
+ s.put(Dbg, new Cell(x, Nil));
+ else
+ ((Cell)y).Car = x;
+ }
+ else if (y == Nil)
+ s.put(Dbg, new Cell(Nil, new Cell(x, Nil)));
+ else {
+ for (Any z = y.cdr(); z instanceof Cell; z = z.cdr())
+ if (z.car().car() == k) {
+ ((Cell)z.car()).Cdr = x;
+ return;
+ }
+ ((Cell)y).Cdr = new Cell(new Cell(k, x), y.cdr());
+ }
+ }
+ }
+
+ final static void redefine(Any ex, Symbol s, Any x) {
+ if (s.car() != Nil && s != s.car() && !equal(x, s.car()))
+ redefMsg(s, null);
+ s.Val = x;
+ putSrc(s, null);
+ }
+
+ final static int evInt(Any x) {return ((Number)x.car().eval()).intValue();}
+ final static long evLong(Any x) {return ((Number)x.car().eval()).longValue();}
+
+ final static Any circ(Any x) {
+ int m = 0;
+ Any[] mark = new Any[12];
+ for (;;) {
+ mark = append(mark, m++, x);
+ if (!((x = x.cdr()) instanceof Cell))
+ return null;
+ for (int i = 0; i < m; ++i)
+ if (mark[i] == x)
+ return x;
+ }
+ }
+
+ final static boolean equal(Any x, Any y) {
+ for (;;) {
+ if (x == y)
+ return true;
+ if (x == Nil || y == Nil)
+ return false;
+ if (x instanceof Number)
+ return x.equals(y);
+ if (x instanceof Symbol)
+ return y instanceof Symbol && ((Symbol)x).Name.equals(((Symbol)y).Name);
+ if (!(y instanceof Cell))
+ return false;
+ while (x.car() == Quote) {
+ if (y.car() != Quote)
+ return false;
+ if (x == x.cdr())
+ return y == y.cdr();
+ if (y == y.cdr())
+ return false;
+ if (!((x = x.cdr()) instanceof Cell))
+ return equal(x, y.cdr());
+ if (!((y = y.cdr()) instanceof Cell))
+ return false;
+ }
+ Any a = x;
+ Any b = y;
+ for (;;) {
+ if (!equal(x.car(), y.car()))
+ return false;
+ if (!((x = x.cdr()) instanceof Cell))
+ return equal(x, y.cdr());
+ if (!((y = y.cdr()) instanceof Cell))
+ return false;
+ if (x == a)
+ return y == b;
+ if (y == b)
+ return false;
+ }
+ }
+ }
+
+ final static int compare(Any x, Any y) {
+ if (x == y)
+ return 0;
+ if (x == Nil)
+ return -1;
+ if (x == T)
+ return +1;
+ if (x instanceof Number) {
+ if (!(y instanceof Number))
+ return y == Nil? +1 : -1;
+ return ((Number)x).compareTo((Number)y);
+ }
+ if (x instanceof Symbol) {
+ if (y instanceof Number || y == Nil)
+ return +1;
+ if (y instanceof Cell || y == T)
+ return -1;
+ String a = ((Symbol)x).Name;
+ String b = ((Symbol)y).Name;
+ if (a == null)
+ return b == null? x.hashCode() - y.hashCode() : -1;
+ if (b == null)
+ return +1;
+ return a.compareTo(b);
+ }
+ if (!(y instanceof Cell))
+ return y == T? -1 : +1;
+ Any a = x;
+ Any b = y;
+ for (;;) {
+ int n;
+ if ((n = compare(x.car(), y.car())) != 0)
+ return n;
+ if (!((x = x.cdr()) instanceof Cell))
+ return compare(x, y.cdr());
+ if (!((y = y.cdr()) instanceof Cell))
+ return y == T? -1 : +1;
+ if (x == a && y == b)
+ return 0;
+ }
+ }
+
+ final static Any evRun(boolean ev, Any ex, int cnt, Any lst) {
+ int i, j = cnt, n = 0;
+ Bind bnd = Env.Bind;
+ Symbol sym;
+ Any y, z;
+ do {
+ ++n;
+ i = bnd.Eswp;
+ bnd.Eswp -= cnt;
+ if (i == 0) {
+ for (i = 0; i < bnd.Cnt; i+= 2) {
+ sym = (Symbol)bnd.Data[i+1];
+ y = sym.Val;
+ sym.Val = bnd.Data[i];
+ bnd.Data[i] = y;
+ }
+ if (bnd.Data[1] == At && --j == 0)
+ break;
+ }
+ } while ((bnd = bnd.Link) != null);
+ if (!(lst instanceof Cell))
+ z = ev? ex.eval() : ex.run();
+ else {
+ bnd = new Bind();
+ do {
+ sym = (Symbol)lst.car();
+ bnd.add(sym.Val);
+ bnd.add(sym);
+ exclude:
+ for (bnd = Env.Bind, j = n; ;) {
+ for (i = 0; i < bnd.Cnt; i+= 2)
+ if (sym == bnd.Data[i+1]) {
+ sym.Val = bnd.Data[i];
+ break exclude;
+ }
+ if (--j == 0 || (bnd = bnd.Link) == null)
+ break;
+ }
+ } while ((lst = lst.cdr()) instanceof Cell);
+ Env.Bind = bnd;
+ z = ev? ex.eval() : ex.run();
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ ((Symbol)bnd.Data[i+1]).Val = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ }
+ do {
+ for (bnd = Env.Bind, i = n; --i != 0; bnd = bnd.Link);
+ if ((bnd.Eswp += cnt) == 0)
+ for (i = bnd.Cnt; (i -= 2) >= 0;) {
+ sym = (Symbol)bnd.Data[i+1];
+ y = sym.Val;
+ sym.Val = bnd.Data[i];
+ bnd.Data[i] = y;
+ }
+ } while (--n > 0);
+ return z;
+ }
+
+ final static Any evMethod(Any o, Any ex, Any x) {
+ int i;
+ Any t, y = ex.car();
+ Any cls = TheCls; Any key = TheKey;
+ Bind bnd = new Bind(); bnd.add(At.Val); bnd.add(At);
+ while (y instanceof Cell) {
+ bnd.add(x.car().eval()); // Save new value
+ bnd.add(y.car()); // and symbol
+ x = x.cdr();
+ y = y.cdr();
+ }
+ if (y == Nil || y != At) {
+ i = bnd.Cnt;
+ if (y != Nil) {
+ bnd.add(y.car()); // Save old value
+ bnd.add(y); // and symbol
+ y.set(x); // Set new value
+ }
+ do {
+ Symbol sym = (Symbol)bnd.Data[--i];
+ x = sym.Val;
+ sym.Val = bnd.Data[--i]; // Set new value
+ bnd.Data[i] = x; // Save old value
+ } while (i > 0);
+ bnd.add(This.Val);
+ bnd.add(This);
+ This.Val = o;
+ Env.Bind = bnd;
+ t = cls; cls = Env.Cls; Env.Cls = t;
+ t = key; key = Env.Key; Env.Key = t;
+ x = ex.cdr().prog();
+ }
+ else {
+ int next, argc, j = 0;
+ Any arg, args[], av[] = null;
+ if (x instanceof Cell) {
+ av = new Any[6];
+ do
+ av = append(av, j++, x.car().eval());
+ while ((x = x.cdr()) instanceof Cell);
+ }
+ next = Env.Next; Env.Next = 0;
+ argc = Env.ArgC; Env.ArgC = j;
+ arg = Env.Arg; Env.Arg = Nil;
+ args = Env.Args; Env.Args = av;
+ i = bnd.Cnt;
+ do {
+ Symbol sym = (Symbol)bnd.Data[--i];
+ x = sym.Val;
+ sym.Val = bnd.Data[--i]; // Set new value
+ bnd.Data[i] = x; // Save old value
+ } while (i > 0);
+ bnd.add(This.Val);
+ bnd.add(This);
+ This.Val = o;
+ Env.Bind = bnd;
+ t = cls; cls = Env.Cls; Env.Cls = t;
+ t = key; key = Env.Key; Env.Key = t;
+ x = ex.cdr().prog();
+ Env.Args = args;
+ Env.Arg = arg;
+ }
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ ((Symbol)bnd.Data[i+1]).Val = bnd.Data[i];
+ Env.Cls = cls; Env.Key = key;
+ Env.Bind = bnd.Link;
+ return x;
+ }
+
+ final static Any method(Any x) {
+ Any y, z;
+
+ if ((y = ((Symbol)x).Val) instanceof Cell) {
+ while ((z = y.car()) instanceof Cell) {
+ if (z.car() == TheKey)
+ return z.cdr();
+ if (!((y = y.cdr()) instanceof Cell))
+ return null;
+ }
+ do
+ if ((x = method((TheCls = y).car())) != null)
+ return x;
+ while ((y = y.cdr()) instanceof Cell);
+ }
+ return null;
+ }
+
+ /* Ersatz PicoLisp Reader */
+ final static class PicoLispReader {
+ PicoLispReader Link;
+ LineNumberReader Rd;
+ String Name;
+ char Eof1, Eof2;
+ int Chr, Src;
+
+ PicoLispReader(Reader rd, String name) {
+ Rd = new LineNumberReader(rd);
+ Name = name;
+ }
+
+ PicoLispReader(InputStream in) {
+ this(new InputStreamReader(in), null);
+ }
+
+ PicoLispReader(String s, char eof1, char eof2) {
+ this(new StringReader(s), null);
+ Eof1 = eof1;
+ Eof2 = eof2;
+ }
+
+ final void close() {
+ try {
+ if (this != StdIn)
+ Rd.close();
+ }
+ catch (IOException e) {closeErr(e);}
+ }
+
+ final void eofErr() {err(null, null, "EOF Overrun");}
+
+ final int get() {
+ try {
+ if ((Chr = Rd.read()) < 0) {
+ if ((Chr = Eof1) != '\0')
+ Eof1 = '\0';
+ else if ((Chr = Eof2) != '\0')
+ Eof2 = '\0';
+ else
+ Chr = -1;
+ }
+ return Chr;
+ }
+ catch (IOException e) {return -1;}
+ }
+
+ final int skip(int c) {
+ for (;;) {
+ if (Chr < 0)
+ return Chr;
+ while (Chr <= ' ') {
+ get();
+ if (Chr < 0)
+ return Chr;
+ }
+ if (Chr != c)
+ return Chr;
+ get();
+ if (c != '#' || Chr != '{') {
+ while (Chr != '\n') {
+ if (Chr < 0)
+ return Chr;
+ get();
+ }
+ }
+ else {
+ for (;;) {
+ get();
+ if (Chr < 0)
+ return Chr;
+ if (Chr == '}' && (get() == '#'))
+ break;
+ }
+ }
+ get();
+ }
+ }
+
+ final boolean testEsc() {
+ for (;;) {
+ if (Chr < 0)
+ return false;
+ if (Chr == '^') {
+ get();
+ if (Chr == '?')
+ Chr = 127;
+ else
+ Chr &= 0x1F;
+ return true;
+ }
+ if (Chr != '\\')
+ return true;
+ if (get() != '\n')
+ return true;
+ do
+ get();
+ while (Chr == ' ' || Chr == '\t');
+ }
+ }
+
+ final Any rdAtom(int c) {
+ StringBuilder sb = new StringBuilder();
+ sb.append((char)c);
+ while (Chr > 0 && Delim.indexOf(Chr) < 0) {
+ if (Chr == '\\')
+ get();
+ sb.append((char)Chr);
+ get();
+ }
+ String s = sb.toString();
+ if (s.equals("NIL"))
+ return Nil;
+ try {return new Number(s);}
+ catch (NumberFormatException e) {
+ return mkSymbol(Nil, s, Intern);
+ }
+ }
+
+ final Any rdList() {
+ Any x, res;
+ get();
+ for (;;) {
+ if (skip('#') == ')') {
+ get();
+ return Nil;
+ }
+ if (Chr == ']')
+ return Nil;
+ if (Chr != '~') {
+ res = x = new Cell(read0(false), Nil);
+ break;
+ }
+ get();
+ if ((res = x = read0(false).eval()) instanceof Cell) {
+ while (x.cdr() instanceof Cell)
+ x = x.cdr();
+ break;
+ }
+ }
+ for (;;) {
+ if (skip('#') == ')') {
+ get();
+ break;
+ }
+ if (Chr == ']')
+ break;
+ if (Chr == '.') {
+ get();
+ if (Delim.indexOf(Chr) >= 0) {
+ ((Cell)x).Cdr = skip('#')==')' || Chr==']'? res : read0(false);
+ if (skip('#') == ')')
+ get();
+ else if (Chr != ']')
+ err(null, x, "Bad dotted pair");
+ break;
+ }
+ x = ((Cell)x).Cdr = new Cell(rdAtom('.'), Nil);
+ }
+ else if (Chr != '~')
+ x = ((Cell)x).Cdr = new Cell(read0(false), Nil);
+ else {
+ get();
+ ((Cell)x).Cdr = read0(false).eval();
+ while (x.cdr() instanceof Cell)
+ x = x.cdr();
+ }
+ }
+ return res;
+ }
+
+ final Any read0(boolean top) {
+ Any x, y;
+ if (skip('#') < 0) {
+ if (top)
+ return Nil;
+ eofErr();
+ }
+ if (top && InFile != null)
+ InFile.Src = InFile.Rd.getLineNumber();
+ if (Chr == '(') {
+ x = rdList();
+ if (top && Chr == ']')
+ get();
+ return x;
+ }
+ if (Chr == '[') {
+ x = rdList();
+ if (Chr != ']')
+ err(null, x, "Super parentheses mismatch");
+ get();
+ return x;
+ }
+ if (Chr == '\'') {
+ get();
+ return new Cell(Quote, read0(false));
+ }
+ if (Chr == '`') {
+ get();
+ return read0(false).eval();
+ }
+ if (Chr == '"') {
+ get();
+ if (Chr == '"') {
+ get();
+ return Nil;
+ }
+ if (!testEsc())
+ eofErr();
+ StringBuilder sb = new StringBuilder();
+ sb.append((char)Chr);
+ while (get() != '"') {
+ if (!testEsc())
+ eofErr();
+ sb.append((char)Chr);
+ }
+ get();
+ return mkSymbol(null, sb.toString(), Transient);
+ }
+ if (Chr == ')' || Chr == ']' || Chr == '~')
+ err(null, null, "Bad input '" + (char)Chr + "' (" + Chr + ")");
+ if (Chr == '\\')
+ get();
+ int i = Chr;
+ get();
+ return rdAtom(i);
+ }
+
+ final Any read(int end) {
+ if (Chr == 0)
+ get();
+ if (Chr == end)
+ return Nil;
+ Any x = read0(true);
+ while (Chr != 0 && " \t)]".indexOf(Chr) >= 0)
+ get();
+ return x;
+ }
+ }
+
+ /* Ersatz PicoLisp Printer */
+ final static class PicoLispWriter {
+ PicoLispWriter Link;
+ PrintWriter Wr;
+
+ PicoLispWriter(OutputStream out) {Wr = new PrintWriter(out);}
+
+ final void close() {
+ if (this != StdOut && this != StdErr)
+ Wr.close();
+ }
+
+ final void print(Any x) {Wr.print(x.toString());}
+ final void space() {Wr.print(' ');}
+
+ final void newline() {
+ Wr.println();
+ Wr.flush();
+ }
+ }
+
+ /* Ersatz PicoLisp VM */
+ final static class Bind {
+ Bind Link;
+ Any[] Data;
+ int Cnt, Eswp;
+
+ Bind() {
+ Link = Env.Bind;
+ Data = new Any[6];
+ }
+
+ final void add(Any x) {Data = append(Data, Cnt++, x);}
+ }
+
+ final static class Env {
+ Env Link;
+ int Next, ArgC;
+ Bind Bind;
+ Any Arg, Args[], Cls, Key;
+ PicoLispReader InFiles;
+ PicoLispWriter OutFiles;
+
+ final void pushInFile(PicoLispReader in) {
+ in.Link = InFiles;
+ InFile = InFiles = in;
+ }
+
+ final void popInFiles() {
+ InFile.close();
+ InFile = InFiles = InFiles.Link;
+ }
+
+ final void pushOutFile(PicoLispWriter out) {
+ out.Link = OutFiles;
+ OutFile = OutFiles = out;
+ }
+ }
+
+ final static class Catch {
+ Catch Link;
+ Any Tag, Fin;
+ Env Env;
+
+ Catch(Any tag, Any fin, Env env) {
+ Tag = tag;
+ Fin = fin;
+ Env = env;
+ Link = Catch; Catch = this;
+ }
+ }
+
+ static final class Throw extends RuntimeException {
+ Any Tag, Val;
+
+ Throw(Any ex, Any tag, Any val) {
+ Tag = tag;
+ Val = val;
+ for (Catch p = Catch; p != null; p = p.Link)
+ if (p.Tag == T || p.Tag == tag) {
+ unwind(p);
+ return;
+ }
+ err(ex, tag, "Tag not found");
+ }
+ }
+
+ interface Any {
+ public Any set(Any val);
+ public Any put(Any key, Any val);
+ public Any get(Any key);
+ public Any car();
+ public Any cdr();
+ public Any eval();
+ public Any prog();
+ public Any run();
+ public Any call(Cell ex);
+ public Any func(Cell ex);
+ public Any apply(Cell ex, boolean cf, Any[] v, int n);
+ public PicoLispReader open(Any ex);
+ public String toString();
+ }
+
+ final static class Number extends BigInteger implements Any {
+ Number(String val) {super(val);}
+ Number(byte[] val) {super(val);}
+
+ Number(int i) {
+ super(new byte[] {(byte)(i>>24), (byte)(i>>16), (byte)(i>>8), (byte)i});
+ }
+
+ final public Any set(Any val) {return err(null, this, "Variable expected");}
+ final public Any put(Any key, Any val) {return err(null, this, "Symbol expected");}
+ final public Any get(Any key) {return err(null, this, "Symbol expected");}
+ final public Any car() {return err(null, this, "Variable expected");}
+ final public Any cdr() {return err(null, this, "List expected");}
+ final public Any eval() {return this;}
+ final public Any prog() {return err(null, this, "Can't execute");}
+ final public Any run() {return err(null, this, "Can't execute");}
+ final public Any call(Cell ex) {return ex;}
+
+ final public Any func(Cell ex) {
+ int i, j;
+ BigInteger n;
+ Symbol s;
+ Any[] v;
+ Any w, x, y, z;
+ switch(intValue()) {
+ case 0: // (quote . any) -> any
+ return ex.Cdr;
+ case 1: // (meth 'obj ['any ..]) -> any
+ z = (x = ex.cdr()).car().eval();
+ for (TheKey = ex.car(); ; TheKey = ((Symbol)TheKey).Val)
+ if (((Symbol)TheKey).Val instanceof Number) {
+ TheCls = null;
+ if ((y = method(z)) != null)
+ return evMethod(z, y, x.cdr());
+ err(ex, TheKey, "Bad message");
+ }
+ <FUN> 1
+ default:
+ return undefined(this, ex);
+ }
+ }
+
+ final public Any apply(Cell ex, boolean cf, Any[] v, int n) {
+ Any x, y = Nil;
+ if (n > 0) {
+ y = x = new Cell(mkSymbol(cf? v[0].car() : v[0]), Nil);
+ for (int i = 1; i < n; ++i)
+ x = ((Cell)x).Cdr = new Cell(mkSymbol(cf? v[i].car() : v[i]), Nil);
+ }
+ return func(new Cell(this, y));
+ }
+
+ final public PicoLispReader open(Any ex) {
+ err(ex, this, "Can't open");
+ return null;
+ }
+ }
+
+ final static class Symbol implements Any {
+ Any Val, Prop[];
+ String Name;
+
+ Symbol(Any val, String name) {
+ Val = val == null? this : val;
+ Name = name;
+ }
+
+ final public Any set(Any val) {return Val = val;}
+
+ final public Any put(Any key, Any val) {
+ if (key.equals(Zero))
+ Val = val;
+ else if (Prop != null) {
+ Any x;
+ int i = Prop.length, p = -1;
+ do {
+ if ((x = Prop[--i]) == null)
+ p = i;
+ else if (x instanceof Cell) {
+ if (key == x.cdr()) {
+ if (val == Nil)
+ Prop[i] = null;
+ else if (val == T)
+ Prop[i] = key;
+ else
+ x.set(val);
+ return val;
+ }
+ }
+ else if (key == x) {
+ if (val == Nil)
+ Prop[i] = null;
+ else if (val != T)
+ Prop[i] = new Cell(val, key);
+ return val;
+ }
+ } while (i != 0);
+ if (val != Nil) {
+ if (p < 0) {
+ Any[] a = new Any[(p = Prop.length) * 2];
+ System.arraycopy(Prop, 0, a, 0, p);
+ Prop = a;
+ }
+ Prop[p] = val != T? new Cell(val, key): key;
+ }
+ }
+ else if (val != Nil)
+ (Prop = new Any[3])[2] = val != T? new Cell(val, key) : key;
+ return val;
+ }
+
+ final public Any get(Any key) {
+ if (key.equals(Zero))
+ return Val;
+ if (Prop == null)
+ return Nil;
+ Any x;
+ int i = Prop.length;
+ do {
+ if ((x = Prop[--i]) != null) {
+ if (x instanceof Cell) {
+ if (key == x.cdr())
+ return x.car();
+ }
+ else if (key == x)
+ return T;
+ }
+ } while (i != 0);
+ return Nil;
+ }
+
+ final public Any car() {return Val;}
+ final public Any cdr() {return err(null, this, "List expected");}
+ final public Any eval() {return Val;}
+ final public Any prog() {return Val;}
+ final public Any run() {return Val;}
+
+ final public Any call(Cell ex) {
+ if (Val == Nil)
+ undefined(this, ex);
+ return Val.func(ex);
+ }
+
+ final public Any func(Cell ex) {return Val.func(ex);}
+
+ final public Any apply(Cell ex, boolean cf, Any[] v, int n) {
+ if (Val == Meth.Val) {
+ Any x, y, z, o = cf? v[0].car() : v[0];
+ TheCls = null; TheKey = this;
+ if ((z = method(o)) != null) {
+ int i;
+ Any cls = Env.Cls; Any key = Env.Key;
+ Env.Cls = TheCls; Env.Key = TheKey;
+ Bind bnd = new Bind(); bnd.add(At.Val); bnd.add(At);
+ for (x = z.car(), i = 0; x instanceof Cell; ++i) {
+ bnd.add((y = x.car()).car()); // Save value
+ bnd.add(y); // and symbol
+ y.set(i >= n? Nil : cf? v[i].car() : v[i]);
+ x = x.cdr();
+ }
+ if (x == Nil || x != At) {
+ if (x != Nil) {
+ bnd.add(x.car()); // Save value
+ bnd.add(x); // and symbol
+ x.set(Nil); // Set to NIL
+ }
+ bnd.add(This.Val);
+ bnd.add(This);
+ This.Val = o;
+ Env.Bind = bnd;
+ x = z.cdr().prog();
+ }
+ else {
+ int next, argc, j = 0;
+ Any arg, args[], av[] = null;
+ if (i < n) {
+ av = new Any[6];
+ do
+ av = append(av, j++, x.car().eval());
+ while (++i < n);
+ }
+ next = Env.Next; Env.Next = 0;
+ argc = Env.ArgC; Env.ArgC = j;
+ arg = Env.Arg; Env.Arg = Nil;
+ args = Env.Args; Env.Args = av;
+ bnd.add(This.Val);
+ bnd.add(This);
+ This.Val = o;
+ Env.Bind = bnd;
+ x = z.cdr().prog();
+ Env.Args = args;
+ Env.Arg = arg;
+ }
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ ((Symbol)bnd.Data[i+1]).Val = bnd.Data[i];
+ Env.Cls = cls; Env.Key = key;
+ Env.Bind = bnd.Link;
+ return x;
+ }
+ err(ex, o, "Bad object");
+ }
+ if (Val == Nil || Val == this)
+ undefined(this, ex);
+ return Val.apply(ex, cf, v, n);
+ }
+
+ final public PicoLispReader open(Any ex) {
+ try {
+ if (firstChar() == '+') {
+ /* ... */
+ }
+ return new PicoLispReader(new FileReader(Name), Name);
+ }
+ catch (IOException e) {
+ err(ex, this, "Can't open");
+ return null;
+ }
+ }
+
+ final public String toString() {
+ if (Name == null)
+ return "$" + hashCode();
+ if (Intern.get(Name) == this) {
+ if (Name.equals("."))
+ return "\\.";
+ StringBuilder sb = new StringBuilder();
+ for (int i = 0; i < Name.length(); ++i) {
+ char c = Name.charAt(i);
+ if (Delim.indexOf(c) >= 0)
+ sb.append('\\');
+ sb.append(c);
+ }
+ return sb.toString();
+ }
+ StringBuilder sb = new StringBuilder();
+ sb.append("\"");
+ for (int i = 0; i < Name.length(); ++i) {
+ char c = Name.charAt(i);
+ if (c == '\\' || c == '^' || c == '"')
+ sb.append('\\');
+ else if (c == 127)
+ {sb.append('^'); c = '?';}
+ else if (c < ' ')
+ {sb.append('^'); c |= 0x40;}
+ sb.append(c);
+ }
+ sb.append("\"");
+ return sb.toString();
+ }
+
+ final char firstChar() {
+ return Name == null? '\0' : Name.charAt(0);
+ }
+
+ final Any parse(boolean skp, Any s) {
+ PicoLispReader rd;
+ if (s == null)
+ rd = new PicoLispReader(Name, '\n', ']');
+ else
+ rd = new PicoLispReader(Name, '\0', '\0');
+ if (skp)
+ rd.get();
+ if (s == null)
+ return rd.rdList();
+ /* ... token() */
+ return Nil;
+ }
+ }
+
+ final static class NilSym implements Any {
+ final public Any set(Any val) {return err(null, this, "Protected symbol");}
+ final public Any put(Any key, Any val) {return err(null, this, "Protected symbol");}
+ final public Any get(Any key) {return this;}
+ final public Any car() {return this;}
+ final public Any cdr() {return this;}
+ final public Any eval() {return this;}
+ final public Any prog() {return this;}
+ final public Any run() {return this;}
+ final public Any call(Cell ex) {return undefined(this,ex);}
+ final public Any func(Cell ex) {return undefined(this,ex);}
+ final public Any apply(Cell ex, boolean cf, Any[] v, int n) {return undefined(this,ex);}
+ final public PicoLispReader open(Any ex) {return StdIn;}
+ final public String toString() {return "NIL";}
+ }
+
+ final static class Cell implements Any {
+ Any Car, Cdr;
+
+ Cell(Any car, Any cdr) {
+ Car = car;
+ Cdr = cdr;
+ }
+
+ final public Any set(Any val) {return Car = val;}
+ final public Any put(Any key, Any val) {return err(null, this, "Symbol expected");}
+
+ final public Any get(Any key) {
+ Any x, y = this;
+ if (key instanceof Number) {
+ int n = ((Number)key).intValue();
+ if (n > 0) {
+ while (--n != 0)
+ y = y.cdr();
+ return y.car();
+ }
+ if (n < 0) {
+ while (++n != 0)
+ y = y.cdr();
+ return y.cdr();
+ }
+ }
+ else
+ do
+ if ((x = y.car()) instanceof Cell && key == x.car())
+ return x.cdr();
+ while ((y = y.cdr()) instanceof Cell);
+ return Nil;
+ }
+
+ final public Any car() {return Car;}
+ final public Any cdr() {return Cdr;}
+ final public Any eval() {return Car.call(this);}
+
+ final public Any prog() {
+ Any x, y = this;
+ do
+ x = y.car().eval();
+ while ((y = y.cdr()) instanceof Cell);
+ return x;
+ }
+
+ final public Any run() {
+ Any x, y = this, at = At.Val;
+ do
+ x = y.car().eval();
+ while ((y = y.cdr()) instanceof Cell);
+ At.Val = at;
+ return x;
+ }
+
+ final public Any call(Cell ex) {return eval().func(ex);}
+
+ final public Any func(Cell ex) {
+ int i;
+ Any x = ex.Cdr;
+ Any y = Car;
+ Bind bnd = new Bind(); bnd.add(At.Val); bnd.add(At);
+ while (y instanceof Cell) {
+ bnd.add(x.car().eval()); // Save new value
+ bnd.add(y.car()); // and symbol
+ x = x.cdr();
+ y = y.cdr();
+ }
+ if (y == Nil || y != At) {
+ i = bnd.Cnt;
+ if (y != Nil) {
+ bnd.add(y.car()); // Save old value
+ bnd.add(y); // and symbol
+ y.set(x); // Set new value
+ }
+ do {
+ Symbol sym = (Symbol)bnd.Data[--i];
+ x = sym.Val;
+ sym.Val = bnd.Data[--i]; // Set new value
+ bnd.Data[i] = x; // Save old value
+ } while (i > 0);
+ Env.Bind = bnd;
+ x = Cdr.prog();
+ }
+ else {
+ int next, argc, j = 0;
+ Any arg, args[], av[] = null;
+ if (x instanceof Cell) {
+ av = new Any[6];
+ do
+ av = append(av, j++, x.car().eval());
+ while ((x = x.cdr()) instanceof Cell);
+ }
+ next = Env.Next; Env.Next = 0;
+ argc = Env.ArgC; Env.ArgC = j;
+ arg = Env.Arg; Env.Arg = Nil;
+ args = Env.Args; Env.Args = av;
+ i = bnd.Cnt;
+ do {
+ Symbol sym = (Symbol)bnd.Data[--i];
+ x = sym.Val;
+ sym.Val = bnd.Data[--i]; // Set new value
+ bnd.Data[i] = x; // Save old value
+ } while (i > 0);
+ Env.Bind = bnd;
+ x = Cdr.prog();
+ Env.Args = args;
+ Env.Arg = arg;
+ }
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ ((Symbol)bnd.Data[i+1]).Val = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+ }
+
+ final public Any apply(Cell ex, boolean cf, Any[] v, int n) {
+ int i;
+ Any x = Car;
+ Any y;
+ Bind bnd = new Bind(); bnd.add(At.Val); bnd.add(At);
+ for (i = 0; x instanceof Cell; ++i) {
+ bnd.add((y = x.car()).car()); // Save value
+ bnd.add(y); // and symbol
+ y.set(i >= n? Nil : cf? v[i].car() : v[i]);
+ x = x.cdr();
+ }
+ if (x == Nil || x != At) {
+ if (x != Nil) {
+ bnd.add(x.car()); // Save value
+ bnd.add(x); // and symbol
+ x.set(Nil); // Set to NIL
+ }
+ Env.Bind = bnd;
+ x = Cdr.prog();
+ }
+ else {
+ int next, argc, j = 0;
+ Any arg, args[], av[] = null;
+ if (i < n) {
+ av = new Any[6];
+ do
+ av = append(av, j++, x.car().eval());
+ while (++i < n);
+ }
+ next = Env.Next; Env.Next = 0;
+ argc = Env.ArgC; Env.ArgC = j;
+ arg = Env.Arg; Env.Arg = Nil;
+ args = Env.Args; Env.Args = av;
+ Env.Bind = bnd;
+ x = Cdr.prog();
+ Env.Args = args;
+ Env.Arg = arg;
+ }
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ ((Symbol)bnd.Data[i+1]).Val = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+ }
+
+ final public PicoLispReader open(Any ex) {
+ err(ex, this, "Can't open");
+ return null;
+ }
+
+ final public String toString() {
+ Any x, y;
+ StringBuilder sb;
+ if (Car == Quote && this != Cdr)
+ return "'" + Cdr.toString();
+ x = this;
+ sb = new StringBuilder();
+ sb.append('(');
+ if ((y = circ(x)) == null) {
+ for (;;) {
+ sb.append(x.car().toString());
+ if ((x = x.cdr()) == Nil)
+ break;
+ if (!(x instanceof Cell)) {
+ sb.append(" . ");
+ sb.append(x.toString());
+ break;
+ }
+ sb.append(' ');
+ }
+ }
+ else if (y == x) {
+ do {
+ sb.append(x.car().toString());
+ sb.append(' ');
+ } while (y != (x = x.cdr()));
+ sb.append('.');
+ }
+ else {
+ do {
+ sb.append(x.car().toString());
+ sb.append(' ');
+ } while (y != (x = x.cdr()));
+ sb.append(". (");
+ do {
+ sb.append(x.car().toString());
+ sb.append(' ');
+ } while (y != (x = x.cdr()));
+ sb.append(".)");
+ }
+ sb.append(')');
+ return sb.toString();
+ }
+ }
+}
diff --git a/lib/tags b/lib/tags
@@ -1,5 +1,5 @@
-! (2843 . "@src64/flow.l")
-$ (2945 . "@src64/flow.l")
+! (2851 . "@src64/flow.l")
+$ (2953 . "@src64/flow.l")
% (2570 . "@src64/big.l")
& (2791 . "@src64/big.l")
* (2389 . "@src64/big.l")
@@ -28,7 +28,7 @@ accept (139 . "@src64/net.l")
adr (613 . "@src64/main.l")
alarm (487 . "@src64/main.l")
all (772 . "@src64/sym.l")
-and (1617 . "@src64/flow.l")
+and (1625 . "@src64/flow.l")
any (3869 . "@src64/io.l")
append (1329 . "@src64/subr.l")
apply (597 . "@src64/apply.l")
@@ -38,15 +38,15 @@ argv (2864 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (2942 . "@src64/subr.l")
assoc (2907 . "@src64/subr.l")
-at (2102 . "@src64/flow.l")
+at (2110 . "@src64/flow.l")
atom (2372 . "@src64/subr.l")
-bind (1355 . "@src64/flow.l")
+bind (1363 . "@src64/flow.l")
bit? (2732 . "@src64/big.l")
-bool (1717 . "@src64/flow.l")
-box (815 . "@src64/flow.l")
+bool (1725 . "@src64/flow.l")
+box (823 . "@src64/flow.l")
box? (999 . "@src64/sym.l")
by (1553 . "@src64/apply.l")
-bye (3424 . "@src64/flow.l")
+bye (3432 . "@src64/flow.l")
caaaar (271 . "@src64/subr.l")
caaadr (288 . "@src64/subr.l")
caaar (99 . "@src64/subr.l")
@@ -61,10 +61,10 @@ caddar (409 . "@src64/subr.l")
cadddr (435 . "@src64/subr.l")
caddr (156 . "@src64/subr.l")
cadr (45 . "@src64/subr.l")
-call (3076 . "@src64/flow.l")
+call (3084 . "@src64/flow.l")
car (5 . "@src64/subr.l")
-case (1958 . "@src64/flow.l")
-catch (2458 . "@src64/flow.l")
+case (1966 . "@src64/flow.l")
+catch (2466 . "@src64/flow.l")
cd (2619 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
@@ -89,11 +89,11 @@ clip (1786 . "@src64/subr.l")
close (4257 . "@src64/io.l")
cmd (2846 . "@src64/main.l")
cnt (1297 . "@src64/apply.l")
-co (2540 . "@src64/flow.l")
+co (2548 . "@src64/flow.l")
commit (1496 . "@src64/db.l")
con (725 . "@src64/subr.l")
conc (781 . "@src64/subr.l")
-cond (1912 . "@src64/flow.l")
+cond (1920 . "@src64/flow.l")
connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
@@ -102,18 +102,18 @@ ctty (2644 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
date (2358 . "@src64/main.l")
dbck (2105 . "@src64/db.l")
-de (523 . "@src64/flow.l")
+de (531 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
-def (447 . "@src64/flow.l")
+def (455 . "@src64/flow.l")
default (1661 . "@src64/sym.l")
del (1852 . "@src64/sym.l")
delete (1392 . "@src64/subr.l")
delq (1443 . "@src64/subr.l")
diff (2563 . "@src64/subr.l")
dir (2777 . "@src64/main.l")
-dm (535 . "@src64/flow.l")
-do (2132 . "@src64/flow.l")
-e (2906 . "@src64/flow.l")
+dm (543 . "@src64/flow.l")
+do (2140 . "@src64/flow.l")
+e (2914 . "@src64/flow.l")
echo (4288 . "@src64/io.l")
env (625 . "@src64/main.l")
eof (3428 . "@src64/io.l")
@@ -123,22 +123,22 @@ eval (182 . "@src64/flow.l")
ext (5017 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
extern (900 . "@src64/sym.l")
-extra (1258 . "@src64/flow.l")
+extra (1266 . "@src64/flow.l")
extract (1102 . "@src64/apply.l")
fifo (1963 . "@src64/sym.l")
file (2724 . "@src64/main.l")
fill (3177 . "@src64/subr.l")
filter (1045 . "@src64/apply.l")
fin (2020 . "@src64/subr.l")
-finally (2516 . "@src64/flow.l")
+finally (2524 . "@src64/flow.l")
find (1206 . "@src64/apply.l")
fish (1497 . "@src64/apply.l")
flg? (2419 . "@src64/subr.l")
flip (1686 . "@src64/subr.l")
flush (4992 . "@src64/io.l")
fold (3343 . "@src64/sym.l")
-for (2221 . "@src64/flow.l")
-fork (3250 . "@src64/flow.l")
+for (2229 . "@src64/flow.l")
+fork (3258 . "@src64/flow.l")
format (2089 . "@src64/big.l")
free (2047 . "@src64/db.l")
from (3447 . "@src64/io.l")
@@ -157,24 +157,24 @@ hear (3130 . "@src64/io.l")
host (184 . "@src64/net.l")
id (1027 . "@src64/db.l")
idx (2037 . "@src64/sym.l")
-if (1798 . "@src64/flow.l")
-if2 (1817 . "@src64/flow.l")
-ifn (1858 . "@src64/flow.l")
+if (1806 . "@src64/flow.l")
+if2 (1825 . "@src64/flow.l")
+ifn (1866 . "@src64/flow.l")
in (4093 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2611 . "@src64/subr.l")
info (2681 . "@src64/main.l")
intern (875 . "@src64/sym.l")
-ipid (3195 . "@src64/flow.l")
-isa (952 . "@src64/flow.l")
-job (1422 . "@src64/flow.l")
+ipid (3203 . "@src64/flow.l")
+isa (960 . "@src64/flow.l")
+job (1430 . "@src64/flow.l")
journal (970 . "@src64/db.l")
key (3278 . "@src64/io.l")
-kill (3227 . "@src64/flow.l")
+kill (3235 . "@src64/flow.l")
last (2031 . "@src64/subr.l")
length (2687 . "@src64/subr.l")
-let (1472 . "@src64/flow.l")
-let? (1533 . "@src64/flow.l")
+let (1480 . "@src64/flow.l")
+let? (1541 . "@src64/flow.l")
lieu (1156 . "@src64/db.l")
line (3603 . "@src64/io.l")
lines (3756 . "@src64/io.l")
@@ -185,7 +185,7 @@ listen (151 . "@src64/net.l")
lit (157 . "@src64/flow.l")
load (4070 . "@src64/io.l")
lock (1184 . "@src64/db.l")
-loop (2164 . "@src64/flow.l")
+loop (2172 . "@src64/flow.l")
low? (3215 . "@src64/sym.l")
lowc (3245 . "@src64/sym.l")
lst? (2389 . "@src64/subr.l")
@@ -207,8 +207,8 @@ maxi (1395 . "@src64/apply.l")
member (2429 . "@src64/subr.l")
memq (2451 . "@src64/subr.l")
meta (3135 . "@src64/sym.l")
-meth (1080 . "@src64/flow.l")
-method (1044 . "@src64/flow.l")
+meth (1088 . "@src64/flow.l")
+method (1052 . "@src64/flow.l")
min (2343 . "@src64/subr.l")
mini (1446 . "@src64/apply.l")
mix (1251 . "@src64/subr.l")
@@ -217,15 +217,15 @@ n0 (2176 . "@src64/subr.l")
n== (2074 . "@src64/subr.l")
nT (2185 . "@src64/subr.l")
name (499 . "@src64/sym.l")
-nand (1652 . "@src64/flow.l")
+nand (1660 . "@src64/flow.l")
native (1366 . "@src64/main.l")
need (918 . "@src64/subr.l")
-new (826 . "@src64/flow.l")
+new (834 . "@src64/flow.l")
next (2226 . "@src64/main.l")
-nil (1735 . "@src64/flow.l")
-nond (1935 . "@src64/flow.l")
-nor (1673 . "@src64/flow.l")
-not (1725 . "@src64/flow.l")
+nil (1743 . "@src64/flow.l")
+nond (1943 . "@src64/flow.l")
+nor (1681 . "@src64/flow.l")
+not (1733 . "@src64/flow.l")
nth (685 . "@src64/subr.l")
num? (2400 . "@src64/subr.l")
off (1598 . "@src64/sym.l")
@@ -234,9 +234,9 @@ on (1583 . "@src64/sym.l")
onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
open (4219 . "@src64/io.l")
-opid (3211 . "@src64/flow.l")
+opid (3219 . "@src64/flow.l")
opt (2967 . "@src64/main.l")
-or (1633 . "@src64/flow.l")
+or (1641 . "@src64/flow.l")
out (4113 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
pair (2381 . "@src64/subr.l")
@@ -257,9 +257,9 @@ prinl (4930 . "@src64/io.l")
print (4956 . "@src64/io.l")
println (4987 . "@src64/io.l")
printsp (4972 . "@src64/io.l")
-prog (1753 . "@src64/flow.l")
-prog1 (1761 . "@src64/flow.l")
-prog2 (1778 . "@src64/flow.l")
+prog (1761 . "@src64/flow.l")
+prog1 (1769 . "@src64/flow.l")
+prog2 (1786 . "@src64/flow.l")
prop (2781 . "@src64/sym.l")
protect (532 . "@src64/main.l")
prove (3434 . "@src64/subr.l")
@@ -284,11 +284,11 @@ rewind (5000 . "@src64/io.l")
rollback (1890 . "@src64/db.l")
rot (848 . "@src64/subr.l")
rpc (5133 . "@src64/io.l")
-run (305 . "@src64/flow.l")
+run (313 . "@src64/flow.l")
sect (2515 . "@src64/subr.l")
seed (2944 . "@src64/big.l")
seek (1159 . "@src64/apply.l")
-send (1124 . "@src64/flow.l")
+send (1132 . "@src64/flow.l")
seq (1083 . "@src64/db.l")
set (1482 . "@src64/sym.l")
setq (1515 . "@src64/sym.l")
@@ -300,51 +300,51 @@ sp? (711 . "@src64/sym.l")
space (4934 . "@src64/io.l")
split (1579 . "@src64/subr.l")
stack (571 . "@src64/main.l")
-state (2002 . "@src64/flow.l")
+state (2010 . "@src64/flow.l")
stem (1976 . "@src64/subr.l")
str (3923 . "@src64/io.l")
str? (1013 . "@src64/sym.l")
strip (1563 . "@src64/subr.l")
sub? (1444 . "@src64/sym.l")
sum (1344 . "@src64/apply.l")
-super (1211 . "@src64/flow.l")
+super (1219 . "@src64/flow.l")
sym (3909 . "@src64/io.l")
sym? (2408 . "@src64/subr.l")
sync (3090 . "@src64/io.l")
-sys (3047 . "@src64/flow.l")
-t (1744 . "@src64/flow.l")
+sys (3055 . "@src64/flow.l")
+t (1752 . "@src64/flow.l")
tail (1898 . "@src64/subr.l")
tell (3162 . "@src64/io.l")
text (1272 . "@src64/sym.l")
-throw (2484 . "@src64/flow.l")
-tick (3163 . "@src64/flow.l")
+throw (2492 . "@src64/flow.l")
+tick (3171 . "@src64/flow.l")
till (3514 . "@src64/io.l")
time (2491 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
-try (1165 . "@src64/flow.l")
-type (905 . "@src64/flow.l")
+try (1173 . "@src64/flow.l")
+type (913 . "@src64/flow.l")
udp (268 . "@src64/net.l")
unify (3842 . "@src64/subr.l")
-unless (1894 . "@src64/flow.l")
-until (2078 . "@src64/flow.l")
+unless (1902 . "@src64/flow.l")
+until (2086 . "@src64/flow.l")
up (712 . "@src64/main.l")
upp? (3230 . "@src64/sym.l")
uppc (3294 . "@src64/sym.l")
-use (1566 . "@src64/flow.l")
+use (1574 . "@src64/flow.l")
usec (2596 . "@src64/main.l")
val (1463 . "@src64/sym.l")
version (2981 . "@src64/main.l")
wait (3052 . "@src64/io.l")
-when (1877 . "@src64/flow.l")
-while (2054 . "@src64/flow.l")
+when (1885 . "@src64/flow.l")
+while (2062 . "@src64/flow.l")
wipe (3090 . "@src64/sym.l")
-with (1323 . "@src64/flow.l")
+with (1331 . "@src64/flow.l")
wr (5117 . "@src64/io.l")
xchg (1538 . "@src64/sym.l")
-xor (1694 . "@src64/flow.l")
+xor (1702 . "@src64/flow.l")
x| (2871 . "@src64/big.l")
-yield (2698 . "@src64/flow.l")
+yield (2706 . "@src64/flow.l")
yoke (1187 . "@src64/subr.l")
zap (1063 . "@src64/sym.l")
zero (1631 . "@src64/sym.l")
diff --git a/src/io.c b/src/io.c
@@ -1,4 +1,4 @@
-/* 05oct10abu
+/* 07oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -1988,8 +1988,8 @@ any load(any ex, int pr, any x) {
return x;
}
rdOpen(ex, x, &f);
- doHide(Nil);
pushInFiles(&f);
+ doHide(Nil);
x = Nil;
for (;;) {
if (InFile != InFiles[STDIN_FILENO])
diff --git a/src/main.c b/src/main.c
@@ -1,4 +1,4 @@
-/* 22jul10abu
+/* 07oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -65,7 +65,7 @@ void bye(int n) {
}
void execError(char *s) {
- fprintf(stderr, "%s: can't exec\n", s);
+ fprintf(stderr, "%s: Can't exec\n", s);
exit(127);
}
diff --git a/src64/flow.l b/src64/flow.l
@@ -1,4 +1,4 @@
-# 30sep10abu
+# 08oct10abu
# (c) Software Lab. Alexander Burger
(code 'redefMsgEC)
@@ -184,120 +184,128 @@
ld X (E CDR) # Args
ld E (X) # Eval first
eval
- link
- push E # <L I> 'any'
- link
- ld X (X CDR) # X on rest
- atom X # Any?
- if nz # No
-10 eval # Evaluate 'any'
- drop
- pop X
- ret
- end
- null (EnvBind) # Bindings?
- jz 10 # No
- ld E (X) # Eval 'cnt'
- eval
- shr E 4 # Normalize
- push E # <L -I> 'cnt'
- push 0 # <L -II> 'n'
- ld E ((X CDR)) # Last argument
- eval # Exclusion list 'lst' in E
- push Y
- ld C (L -I) # Get 'cnt'
- ld Y (EnvBind) # and bindings
- do
- ld A (Y) # End of bindings in A
- inc (L -II) # Increment 'n'
- sub (Y -I) (L -I) # Decrement 'eswp' by 'cnt'
- if c # First pass
- add Y I
- do
- ld X (Y) # Next symbol
- xchg (X) (Y I) # Exchange symbol value with saved value
- add Y II
- cmp Y A # More?
- until eq # No
- cmp X At # Lambda frame?
- if eq # Yes
- dec C # Decrement local 'cnt'
- break z # Done
+ num E # 'any' is number?
+ if z # No
+ link
+ push E # <L I> 'any'
+ link
+ ld X (X CDR) # X on rest
+ atom X # Any?
+ if nz # No
+10 sym E # Symbolic?
+ if nz # Yes
+ ld E (E) # Get value
+ else
+ call evListE_E # Else evaluate expression
end
+ drop
+ pop X
+ ret
end
- ld Y (A I) # Bind link
- null Y # More bindings?
- until z # No
- atom E # Exclusion list?
- if nz # No
- ld E (L I) # Get 'any'
- eval # Evaluate it
- else
- push (EnvBind) # Build bind frame
- link
+ null (EnvBind) # Bindings?
+ jz 10 # No
+ ld E (X) # Eval 'cnt'
+ eval
+ shr E 4 # Normalize
+ push E # <L -I> 'cnt'
+ push 0 # <L -II> 'n'
+ ld E ((X CDR)) # Last argument
+ eval # Exclusion list 'lst' in E
+ push Y
+ ld C (L -I) # Get 'cnt'
+ ld Y (EnvBind) # and bindings
do
- ld X (E) # Next excluded symbol
- push (X) # Save in bind frame
- push X
- ld C (L -II) # Get 'n'
- ld Y (EnvBind) # Bindings
- do
- ld A (Y) # End of bindings in A
+ ld A (Y) # End of bindings in A
+ inc (L -II) # Increment 'n'
+ sub (Y -I) (L -I) # Decrement 'eswp' by 'cnt'
+ if c # First pass
add Y I
do
- cmp X (Y) # Found excluded symbol?
- if eq # Yes
- ld (X) (Y I) # Bind to found value
- jmp 20
- end
+ ld X (Y) # Next symbol
+ xchg (X) (Y I) # Exchange symbol value with saved value
add Y II
cmp Y A # More?
until eq # No
- dec C # Traversed 'n' frames?
- while nz # No
- ld Y (A I) # Bind link
- null Y # More bindings?
- until z # No
-20 ld E (E CDR)
- atom E # Exclusion list?
- until nz # No
- ld E ((L) I) # Get 'any'
- link
- ld (EnvBind) L # Close bind frame
- push 0 # Init env swap
- eval # Evaluate 'any'
- pop A # Drop env swap
- pop L # Get link
- do # Unbind excluded symbols
- pop X # Next symbol
- pop (X) # Restore value
- cmp S L # More?
- until eq # No
- pop L # Restore link
- pop (EnvBind) # Restore bind link
- end
- ld C (L -II) # Get 'n'
- do
- ld A C # in A
- ld Y (EnvBind) # Bindings
- do
- dec A # 'n-1' times
- while nz
- ld Y ((Y) I) # Follow link
- loop
- add (Y -I) (L -I) # Increment 'eswp' by 'cnt'
- if z # Last pass
- lea A ((Y) -II) # Last binding in A
+ cmp X At # Lambda frame?
+ if eq # Yes
+ dec C # Decrement local 'cnt'
+ break z # Done
+ end
+ end
+ ld Y (A I) # Bind link
+ null Y # More bindings?
+ until z # No
+ atom E # Exclusion list?
+ if nz # No
+ ld E (L I) # Get 'any'
+ eval # Evaluate it
+ else
+ push (EnvBind) # Build bind frame
+ link
do
- xchg ((A)) (A I) # Exchange next symbol value with saved value
- sub A II
- cmp A Y # More?
- until lt # No
+ ld X (E) # Next excluded symbol
+ push (X) # Save in bind frame
+ push X
+ ld C (L -II) # Get 'n'
+ ld Y (EnvBind) # Bindings
+ do
+ ld A (Y) # End of bindings in A
+ add Y I
+ do
+ cmp X (Y) # Found excluded symbol?
+ if eq # Yes
+ ld (X) (Y I) # Bind to found value
+ jmp 20
+ end
+ add Y II
+ cmp Y A # More?
+ until eq # No
+ dec C # Traversed 'n' frames?
+ while nz # No
+ ld Y (A I) # Bind link
+ null Y # More bindings?
+ until z # No
+20 ld E (E CDR)
+ atom E # Exclusion list?
+ until nz # No
+ ld E ((L) I) # Get 'any'
+ link
+ ld (EnvBind) L # Close bind frame
+ push 0 # Init env swap
+ eval # Evaluate 'any'
+ pop A # Drop env swap
+ pop L # Get link
+ do # Unbind excluded symbols
+ pop X # Next symbol
+ pop (X) # Restore value
+ cmp S L # More?
+ until eq # No
+ pop L # Restore link
+ pop (EnvBind) # Restore bind link
end
- dec C # Decrement 'n'
- until z # Done
- pop Y
- drop
+ ld C (L -II) # Get 'n'
+ do
+ ld A C # in A
+ ld Y (EnvBind) # Bindings
+ do
+ dec A # 'n-1' times
+ while nz
+ ld Y ((Y) I) # Follow link
+ loop
+ add (Y -I) (L -I) # Increment 'eswp' by 'cnt'
+ if z # Last pass
+ lea A ((Y) -II) # Last binding in A
+ do
+ xchg ((A)) (A I) # Exchange next symbol value with saved value
+ sub A II
+ cmp A Y # More?
+ until lt # No
+ end
+ dec C # Decrement 'n'
+ until z # Done
+ pop Y
+ drop
+ end
pop X
ret
@@ -360,12 +368,12 @@
until z # No
atom E # Exclusion list?
if nz # No
- ld X (L I) # Run 'any'
- sym X # Symbolic?
+ ld E (L I) # Run 'any'
+ sym E # Symbolic?
if nz # Yes
- ld E (X) # Get value
+ ld E (E) # Get value
else
- prog X # Execute
+ call runE_E # Execute
end
else
push (EnvBind) # Build bind frame
@@ -396,15 +404,15 @@
20 ld E (E CDR)
atom E # Exclusion list?
until nz # No
- ld X ((L) I) # Get 'any'
+ ld E ((L) I) # Get 'any'
link
ld (EnvBind) L # Close bind frame
push 0 # Init env swap
- sym X # 'any' symbolic?
+ sym E # 'any' symbolic?
if nz # Yes
- ld E (X) # Get value
+ ld E (E) # Get value
else
- prog X # Execute
+ call runE_E # Execute
end
pop A # Drop env swap
pop L # Get link
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 03oct10abu
+# 07oct10abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -4000,9 +4000,9 @@
sub S IV # InFrame
ld Y S
call rdOpenEXY
+ call pushInFilesY
ld E Nil # Close transient scope
call doHide
- call pushInFilesY
do
ld A ((InFiles)) # Get stdin
cmp A (InFile) # Reading from file?
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 15aug10abu
+# 07oct10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -196,7 +196,7 @@
cc fprintf((stderr) ExecErr (S))
ld E 127
jmp finishE
-: ExecErr asciz "%s: can't exec\\n"
+: ExecErr asciz "%s: Can't exec\\n"
# Install interrupting signal
(code 'iSignalCE)
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 03oct10abu
+# 10oct10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 4 2)
+(de *Version 3 0 4 3)
# vi:et:ts=3:sw=3
