commit a6911033f74e76637a06ac3db7ad4ed667c1e879
parent 2ca21837b754f315062982ec606069f88ab84026
Author: Commit-Bot <unknown>
Date: Mon, 1 Nov 2010 07:51:36 +0000
Automatic commit from picoLisp.tgz, From: Mon, 01 Nov 2010 07:51:36 GMT
Diffstat:
29 files changed, 11656 insertions(+), 1135 deletions(-)
diff --git a/INSTALL b/INSTALL
@@ -1,4 +1,4 @@
-16mar10abu
+22oct10abu
(c) Software Lab. Alexander Burger
@@ -37,8 +37,8 @@ Please follow these steps:
Note that on the BSD family of operating systems, 'gmake' must be used
instead of 'make'.
-4. Optional (but recommended) are two symbolic links from /usr/lib and /usr/bin
- to the installation directory
+4. Optional (but recommended if you have permission to switch to root) are two
+ symbolic links from /usr/lib and /usr/bin to the installation directory
# ln -s /<installdir> /usr/lib/picolisp
# ln -s /usr/lib/picolisp/bin/picolisp /usr/bin/picolisp
diff --git a/doc/refL.html b/doc/refL.html
@@ -477,10 +477,10 @@ href="refF.html#for">for</a></code>.
-> done
</code></pre>
-<dt><a name="low?"><code>(low? 'any) -> sym | NIL</code></a>
-<dd>Returns <code>any</code> when the argument is a string (symbol) that starts
-with a lowercase character. See also <code><a
-href="refL.html#lowc">lowc</a></code>.
+<dt><a name="low?"><code>(low? 'any) -> sym | NIL</code></a> <dd>Returns
+<code>any</code> when the argument is a string (symbol) that starts with a
+lowercase character. See also <code><a href="refL.html#lowc">lowc</a></code> and
+<code><a href="refU.html#upp?">upp?</a></code>
<pre><code>
: (low? "a")
diff --git a/doc/refM.html b/doc/refM.html
@@ -407,7 +407,7 @@ href="refD.html#delq">delq</a></code> and <a href="ref.html#cmp">Comparing</a>.
<pre><code>
: (memq 'c '(a b c d e f))
-> (c d e f)
-: (memq (2) ((1) (2) (3)))
+: (memq (2) '((1) (2) (3)))
-> NIL
</code></pre>
diff --git a/doc/refU.html b/doc/refU.html
@@ -274,10 +274,10 @@ href="ref.html#dbase">Database</a></code>.
-> {3-1}
</code></pre>
-<dt><a name="upp?"><code>(upp? 'any) -> sym | NIL</code></a>
-<dd>Returns <code>any</code> when the argument is a string (symbol) that starts
-with an uppercase character. See also <code><a
-href="refU.html#uppc">uppc</a></code>.
+<dt><a name="upp?"><code>(upp? 'any) -> sym | NIL</code></a> <dd>Returns
+<code>any</code> when the argument is a string (symbol) that starts with an
+uppercase character. See also <code><a href="refU.html#uppc">uppc</a></code> and
+<code><a href="refL.html#low?">low?</a></code>
<pre><code>
: (upp? "A")
diff --git a/doc/tut.html b/doc/tut.html
@@ -12,6 +12,8 @@
<p align=right>(c) Software Lab. Alexander Burger
+<h3>About this document</h3>
+
<p>This document demonstrates some aspects of the PicoLisp system in detail and
example. For a general description of the PicoLisp kernel please look at the <a
href="ref.html">PicoLisp Reference</a>.
@@ -20,6 +22,8 @@ href="ref.html">PicoLisp Reference</a>.
Lisp (and programming in general). It concentrates on the specialties of
PicoLisp, and its differences to other Lisp dialects.
+<h3>Now let's start</h3>
+
<p>If not stated otherwise, all examples assume that PicoLisp was started in the
installation directory from the shell prompt as
@@ -34,44 +38,27 @@ terminate the interpreter and return to the shell at any time, by either hitting
the ENTER key (i.e. by entering an empty line), or by executing the function
<code><a href="refB.html#bye">(bye)</a></code>.
-<p>It is very helpful - though not absolutely necessary - when you know how to
-use the <code>vi</code> editor.
+<p>Please note that special handling is done during character input. This one
+is incompatible with <code>rlwrap</code> for example but is more powerful.
+<p><ul>
+<li><code>vi</code>-like command-line editing (typos fixes and history with ESC,
+<code>h</code>, <code>j</code>, <code>k</code> and <code>l</code> but not
+arrows),</li>
+<li>auto-formating (underlined) of double-quoted strings (don't try and struggle
+to make <code>"</code> appear).</li>
+</ul>
<p>We notice that some people try to use Emacs - or some other IDE - as a
front-end to the PicoLisp console. This is not recommended, because the PicoLisp
debugging environment will set the console (tty) to raw mode by itself and do
-some special handling during character input.
+the special handling seen above during character input.
<p>If you feel that you absolutely have to use an input front-end, please remove
the entry "@lib/led.l" from "dbg.l". Note that in this case, however, you will
not have the TAB symbol completion feature available during command line
editing.
-<p>We recommend that you have a terminal window open, and try the examples by
-yourself. You may either type them in, directly to the PicoLisp interpreter, or
-edit a separate source file (e.g. <code>"test.l"</code>) in a second terminal
-window and load it into PicoLisp with
-
-<pre><code>
-: (load "test.l")
-</code></pre>
-
-<p>each time you have modified and saved it.
-
-<p>Once a function is loaded from a source file, you can call 'vim' directly on
-that function with
-
-<pre><code>
-: (vi 'foo)
-</code></pre>
-
-<p>The function 'vi' opens the appropriate source file, and jumps to the right
-line where 'foo' is defined. When you modify it, you can simply call 'ld' to
-(re)load that source file
-
-<pre><code>
-: (ld)
-</code></pre>
+<h3>Table of content</h3>
<p>If you are new to PicoLisp, you might want to read the following sections in
the given order, as some of them assume knowledge about previous ones. Otherwise
@@ -101,6 +88,11 @@ just jump anywhere you are interested in.
console in interactive mode), evaluates it, and prints the result to the current
output channel. This is called a "read-eval-print-loop" (REPL).
+<h3>VI-like edition</h3>
+
+<p>It is very helpful - though not absolutely necessary - when you know how to
+use the <code>vi</code> editor.
+
<p>To alleviate the task of manual line input, a command line editor is provided
which is similar to (though much simpler than) the <code>readline</code> feature
of the <code>bash</code> shell. Only a subset of the <code>vi</code> mode is
@@ -115,7 +107,8 @@ key, and terminating them with the ENTER key. This is the <i>Insert Mode</i>.
<p>If you hit ESC, you get into <i>Command Mode</i>. Now you can navigate
horizontally in the current input line, or vertically in the history of
previously entered lines, with key commands borrowed from the <code>vi</code>
-editor. Note, however, that there is always only a single line visible.
+editor (only <code>h</code>, <code>j</code>, <code>k</code> and <code>l</code>
+and not arrows). Note, however, that there is always only a single line visible.
<p>Let's say you did some calculation
@@ -229,6 +222,13 @@ path names in the file system) matching the partial input are shown in sequence.
</ul>
+<h3>Behaviour of double-quoted strings</h3>
+
+Don't try to display " in the REPL, it may be removed and the string you
+wanted to quote will be underlined. Just close with another " keystroke.
+
+<h3>Conclusion</h3>
+
<p>Please take some time to experiment and to get used to command line editing.
It will make life much easier in the future :-)
@@ -239,7 +239,22 @@ It will make life much easier in the future :-)
<p>PicoLisp provides some functionality for inspecting pieces of data and code
within the running system.
-<p>Most commonly used is probably the <code><a
+<h3>Basic tools</h3>
+
+The really basic tools are of course available and their name alone is enough
+to know:
+<code><a href="refP.html#print">print</a></code>,
+<code><a href="refS.html#size">size</a></code>
+...
+
+<p>But you will appreciate some more powerful tools like:
+<p><ul><li><code><a href="refM.html#match">match</a></code>, a predicate which
+ compares S-expressions with bindable wildcards when matching,</li>
+</ul>
+
+<h3>Inspect a symbol with <i>show</i></h3>
+
+<p>The most commonly used tool is probably the <code><a
href="refS.html#show">show</a></code> function. It takes a symbolic argument,
and shows the symbol's name (if any), followed by its value cell, and then the
contents of the property list on the following lines.
@@ -274,6 +289,8 @@ A (This is the value) # (which is 'A' again)
-> A
</code></pre>
+<h3>Inspect and edit with <i>edit</i></h3>
+
<p>Similar to <code>show</code> is <code><a
href="refE.html#edit">edit</a></code>. It takes an arbitrary number of symbolic
arguments, writes them to a temporary file in a format similar to
@@ -310,38 +327,7 @@ repairs - modify the data (but only if you are really sure about what you are
doing, and don't forget to <code><a href="refC.html#commit">commit</a></code>
when you are done).
-<p><code><a href="refM.html#more">more</a></code> is a simple tool that displays
-the elements of a list one by one. It stops after each element and waits for
-input. If you just hit ENTER, <code>more</code> continues with the next element,
-otherwise (usually I type a dot (<code>.</code>) followed by ENTER) it
-terminates.
-
-<pre><code>
-: (more (1 2 3 4 5 6))
-1 # Hit ENTER
-2. # Hit '.' and ENTER
--> T # stopped
-</code></pre>
-
-<p>Optionally <code>more</code> takes a function as a second argument and
-applies that function to each element (instead of the default <code><a
-href="refP.html#print">print</a></code>). Here, often <code>show</code> or
-<code>pp</code> (see below) is used.
-
-<pre><code>
-: (more '(A B)) # Step through 'A' and 'B'
-A
-B
--> NIL
-: (more '(A B) show) # Step through 'A' and 'B' with 'show'
-A (This is the value) # showing 'A'
- key2 val2
- key1 val1
- # Hit ENTER
-B NIL # showing 'B'
- a A
--> NIL
-</code></pre>
+<h3>Built-in pretty print with <i>pp</i></h3>
<p>The <i>pretty-print</i> function <code><a href="refP.html#pp">pp</a></code>
takes a symbol that has a function defined (or two symbols that specify message
@@ -411,6 +397,43 @@ parenthesis is not on the same line
</ul>
+<h3>Inspect elements one by one with <i>more</i></h3>
+
+<p><code><a href="refM.html#more">more</a></code> is a simple tool that displays
+the elements of a list one by one. It stops after each element and waits for
+input. If you just hit ENTER, <code>more</code> continues with the next element,
+otherwise (usually I type a dot (<code>.</code>) followed by ENTER) it
+terminates.
+
+<pre><code>
+: (more (1 2 3 4 5 6))
+1 # Hit ENTER
+2. # Hit '.' and ENTER
+-> T # stopped
+</code></pre>
+
+<p>Optionally <code>more</code> takes a function as a second argument and
+applies that function to each element (instead of the default <code><a
+href="refP.html#print">print</a></code>). Here, often <code>show</code> or
+<code>pp</code> (see below) is used.
+
+<pre><code>
+: (more '(A B)) # Step through 'A' and 'B'
+A
+B
+-> NIL
+: (more '(A B) show) # Step through 'A' and 'B' with 'show'
+A (This is the value) # showing 'A'
+ key2 val2
+ key1 val1
+ # Hit ENTER
+B NIL # showing 'B'
+ a A
+-> NIL
+</code></pre>
+
+<h3>Search through available symbols with <i>what</i></h3>
+
<p>The <code><a href="refW.html#what">what</a></code> function returns a list of
all internal symbols in the system which match a given pattern (with
'<code>@</code>' wildcard characters).
@@ -420,6 +443,8 @@ all internal symbols in the system which match a given pattern (with
-> (prin print prinl print> printsp println)
</code></pre>
+<h3>Search through values or properties of symbols with <i>who</i></h3>
+
<p>The function <code><a href="refW.html#who">who</a></code> returns <i>"who
contains that"</i>, i.e. a list of symbols that contain a given argument
somewhere in their value or property list.
@@ -462,6 +487,8 @@ href="refM.html#match">match</a></code>):
(/ (- Dat (% (inc Dat) 7)) 7) )
</code></pre>
+<h3>Find what classes can accept a given message with <i>can</i></h3>
+
<p>The function <code><a href="refC.html#can">can</a></code> returns a list
which indicates which classes <i>can</i> accept a given message. Again, this
list is suitable for iteration with <code>pp</code>:
@@ -490,6 +517,8 @@ list is suitable for iteration with <code>pp</code>:
(and (<> Old Val) (delete Val Old)) )
</code></pre>
+<h3>Inspect dependencies with <i>dep</i></h3>
+
<p><code><a href="refD.html#dep">dep</a></code> shows the dependencies in a
class hierarchy. That is, for a given class it displays the tree of its
(super)class(es) above it, and the tree of its subclasses below it.
@@ -534,7 +563,10 @@ href="refR.html#+relation">+relation</a></code>, and has a single subclass
<p>Most of the time during programming is spent defining functions (or methods).
In the following we will concentrate on functions, but most will be true for
-methods as well except for using <code>dm</code> instead of <code>de</code>.
+methods as well except for using <code><a href="refD.html#dm">dm</a></code>
+instead of <code><a href="refD.html#de">de</a></code>.
+
+<h3>Functions with no argument</h3>
<p>The notorious "Hello world" function must be defined:
@@ -546,17 +578,20 @@ methods as well except for using <code>dm</code> instead of <code>de</code>.
<p>The <code>()</code> in the first line indicates a function without arguments.
The body of the function is in the second line, consisting of a single
-statement. The last line is the return value of <code>de</code>. From now on we
-will omit the return values of examples when they are unimportant.
+statement. The last line is the return value of <code>de</code>, which here is
+the defined symbol. From now on we will omit the return values of examples when
+they are unimportant.
-<p>You'll know that you can call this function as
+<p>Now you can call this function this way:
<pre><code>
: (hello)
Hello world
</code></pre>
-<p>A function with an argument might look this way:
+<h3>Functions with one argument</h3>
+
+<p>A function with an argument might be defined this way:
<pre><code>
: (de hello (X)
@@ -578,6 +613,8 @@ Hello world
Hello Alex
</code></pre>
+<h3>Preventing arguments evaluation and variable number of arguments</h3>
+
<p>Normally, PicoLisp evaluates the arguments before it passes them to a
function:
@@ -618,6 +655,8 @@ then bind all (unevaluated) arguments as a list to that parameter.
-> (A 2) # -> We get '(A 2)'
</code></pre>
+<h3>Mixing evaluated arguments and variable number of unevaluated arguments</h3>
+
<p>As a logical consequence, you can combine these principles. To define a
function with 2 evaluated and an arbitrary number of unevaluated arguments:
@@ -629,6 +668,8 @@ function with 2 evaluated and an arbitrary number of unevaluated arguments:
-> (1 2 (C D E)) # -> Get the value of 'A' and 'B' and the remaining list
</code></pre>
+<h3>Variable number of evaluated arguments</h3>
+
<p>More common, in fact, is the case where you want to pass an arbitrary number
of <i>evaluated</i> arguments to a function. For that, PicoLisp recognizes the
symbol <code>@</code> as a single atomic parameter and remembers all evaluated
@@ -662,8 +703,8 @@ numeric arguments, each on a line followed by its squared value:
<pre><code>
: (de foo @
- (while (args)
- (println (next) (* (arg) (arg))) ) )
+ (while (args) # Check if there are some args left
+ (println (next) (* (arg) (arg))) ) ) # Call the last arg (next) returned
: (foo (+ 2 3) (- 7 1) 1234 (* 9 9))
5 25
@@ -673,7 +714,21 @@ numeric arguments, each on a line followed by its squared value:
-> 6561
</code></pre>
-<p>Finally, it is possible to pass all these evaluated argument to another
+<p>This next example shows the behaviour of <code>args</code> and
+<code>rest</code>:
+
+<pre><code>
+: (de foo @
+ (while (args)
+ (next)
+ (println (arg) (args) (rest)) ) )
+: (foo 1 2 3)
+1 T (2 3)
+2 T (3)
+3 NIL NIL
+</code></pre>
+
+<p>Finally, it is possible to pass all these evaluated arguments to another
function, using <code><a href="refP.html#pass">pass</a></code>:
<pre><code>
@@ -1026,11 +1081,13 @@ fields. A typical way to import the contents of such a file is:
<h2><a name="script">Scripting</a></h2>
<p>There are two possibilities to get the PicoLisp interpreter into doing useful
-work: Via command line arguments, or as a stand-alone script.
+work: via command line arguments, or as a stand-alone script.
+
+<h3>Command line arguments for the PicoLisp interpreter</h3>
<p>The command line can specify either files for execution, or arbitrary Lisp
expressions for direct evaluation (see <code><a
-href="ref.html#invoc">Invocation</a></code>): If an argument starts with a
+href="ref.html#invoc">Invocation</a></code>): if an argument starts with a
hyphen, it is evaluated, otherwise <code><a
href="refL.html#load">load</a></code>ed as a file. A typical invocation might
look like:
@@ -1061,8 +1118,13 @@ script, which initializes the environment, does some bookkeeping and cleanup,
and calls the application with a proper command line. It is no problem if the
command line is long and complicated.
-<p>For small utility programs, however, this is overkill. It is better to write
-a single executable file using the mechanisms of "interpreter files": If the
+<p>For small utility programs, however, this is overkill. Enter full PicoLisp
+scripts.
+
+<h3>PicoLisp scripts</h3>
+
+It is better to write
+a single executable file using the mechanisms of "interpreter files". If the
first two characters in an executable file are "<code>#!</code>", the operating
system kernel will pass this file to an interpreter program whose pathname is
given in the first line (optionally followed by a single argument). This is fast
@@ -1090,6 +1152,8 @@ Then a simple hello-world script might look like:
interpreted, and you can still use that file as a normal command line argument
to PicoLisp (useful during debugging).
+<h3>Grab command line arguments from PicoLisp scripts</h3>
+
<p>The fact that a hyphen causes evaluation of command line arguments can be
used to simulate something like command line options. The following script
defines two functions <code>a</code> and <code>f</code>, and then calls
@@ -1139,6 +1203,8 @@ $ ./testOpts -af yyy
<p>cannot be achieved with this simple and general mechanism of command line
processing.
+<h3>Run scripts from arbitrary places on the host file system</h3>
+
<p>Utilities are typically used outside the context of the PicoLisp environment.
All examples above assumed that the current working directory is the PicoLisp
installation directory, which is usually all right for applications developed in
@@ -1196,6 +1262,35 @@ site, and prints it to standard output:
(bye)
</code></pre>
+<h3>Editing scripts</h3>
+
+<p>We recommend that you have a terminal window open, and try the examples by
+yourself. You may either type them in, directly to the PicoLisp interpreter, or
+edit a separate source file (e.g. <code>"test.l"</code>) in a second terminal
+window and load it into PicoLisp with
+
+<pre><code>
+: (load "test.l")
+</code></pre>
+
+<p>each time you have modified and saved it.
+
+<h3>Editing scripts with vi</h3>
+
+<p>Once a function is loaded from a source file, you can call 'vim' directly on
+that function with
+
+<pre><code>
+: (vi 'foo)
+</code></pre>
+
+<p>The function 'vi' opens the appropriate source file, and jumps to the right
+line where 'foo' is defined. When you modify it, you can simply call 'ld' to
+(re)load that source file
+
+<pre><code>
+: (ld)
+</code></pre>
<p><hr>
<h2><a name="oop">Objects and Classes</a></h2>
diff --git a/doc64/structures b/doc64/structures
@@ -1,4 +1,4 @@
-# 07jun10abu
+# 12oct10abu
# (c) Software Lab. Alexander Burger
@@ -191,13 +191,6 @@
+---- LINK <-- L <-- Apply
- Method frame:
- ^
- <II> cls |
- <I> key |
- LINK ----+ <-- Meth
-
-
Catch frame:
^
X |
diff --git a/erl b/erl
@@ -0,0 +1,2 @@
+#!/bin/sh
+exec ${0%/*}/ersatz/picolisp -"on *Dbg" ${0%/*}/lib.l @lib/misc.l @lib/pilog.l @lib/debug.l @lib/lint.l "$@"
diff --git a/ersatz/PicoLisp.java b/ersatz/PicoLisp.java
@@ -0,0 +1,6653 @@
+// 01nov10abu
+// (c) Software Lab. Alexander Burger
+
+import java.io.*;
+import java.net.*;
+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 byte MonLen[] = new byte[] {31,31,28,31,30,31,30,31,31,30,31,30,31};
+ final static byte Version[] = new byte[] {3,0,4,4};
+
+ 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 Run = mkSymbol(Nil, "*Run", Intern);
+ final static Symbol Up = mkSymbol(Nil, "^", Intern);
+ final static Symbol Err = mkSymbol(Nil, "*Err", Intern);
+ final static Symbol Msg = mkSymbol(Nil, "*Msg", Intern);
+ final static Symbol Uni = mkSymbol(Nil, "*Uni", Intern);
+ final static Symbol Bye = mkSymbol(Nil, "*Bye", Intern);
+
+ final static Symbol Quote = mkSymbol(Zero, "quote", Intern);
+ final static Symbol Meth = mkSymbol(One, "meth", Intern);
+
+ final static String Delim = " \t\n\r\"'(),[]`~{}";
+
+ static Catch Catch;
+ static Env Env = new Env();
+ static Process[] Pids = new Process[12];
+ static PicoLispReader[] InFiles = new PicoLispReader[12];
+ static PicoLispWriter[] OutFiles = new PicoLispWriter[12];
+ final static PicoLispReader StdIn = new PicoLispReader(System.in, 0);
+ final static PicoLispWriter StdOut = new PicoLispWriter(System.out, 1);
+ final static PicoLispWriter StdErr = new PicoLispWriter(System.err, 2);
+ static PicoLispReader InFile = StdIn;
+ static PicoLispWriter OutFile = StdOut;
+ static Any TheCls, TheKey, Penv, Pnl;
+ static String[] Argv;
+ static String Home;
+ static Calendar Cal;
+ static int MaxFun;
+ static long USec, Seed;
+ static boolean Break, Jam, B;
+ static Bind Brk;
+
+ public static void main(String[] argv) {
+ Argv = argv;
+ init();
+ mkSymbol(new Number("2"), "quit", Intern);
+ mkSymbol(new Number("3"), "args", Intern);
+ mkSymbol(new Number("4"), "next", Intern);
+ mkSymbol(new Number("5"), "arg", Intern);
+ mkSymbol(new Number("6"), "rest", Intern);
+ mkSymbol(new Number("7"), "date", Intern);
+ mkSymbol(new Number("8"), "time", Intern);
+ mkSymbol(new Number("9"), "usec", Intern);
+ mkSymbol(new Number("10"), "file", Intern);
+ mkSymbol(new Number("11"), "version", Intern);
+ mkSymbol(new Number("12"), "apply", Intern);
+ mkSymbol(new Number("13"), "pass", Intern);
+ mkSymbol(new Number("14"), "maps", Intern);
+ mkSymbol(new Number("15"), "map", Intern);
+ mkSymbol(new Number("16"), "mapc", Intern);
+ mkSymbol(new Number("17"), "maplist", Intern);
+ mkSymbol(new Number("18"), "mapcar", Intern);
+ mkSymbol(new Number("19"), "mapcon", Intern);
+ mkSymbol(new Number("20"), "mapcan", Intern);
+ mkSymbol(new Number("21"), "filter", Intern);
+ mkSymbol(new Number("22"), "extract", Intern);
+ mkSymbol(new Number("23"), "seek", Intern);
+ mkSymbol(new Number("24"), "find", Intern);
+ mkSymbol(new Number("25"), "pick", Intern);
+ mkSymbol(new Number("26"), "cnt", Intern);
+ mkSymbol(new Number("27"), "sum", Intern);
+ mkSymbol(new Number("28"), "maxi", Intern);
+ mkSymbol(new Number("29"), "mini", Intern);
+ mkSymbol(new Number("30"), "fish", Intern);
+ mkSymbol(new Number("31"), "by", Intern);
+ mkSymbol(new Number("32"), "as", Intern);
+ mkSymbol(new Number("33"), "lit", Intern);
+ mkSymbol(new Number("34"), "eval", Intern);
+ mkSymbol(new Number("35"), "run", Intern);
+ mkSymbol(new Number("36"), "def", Intern);
+ mkSymbol(new Number("37"), "de", Intern);
+ mkSymbol(new Number("38"), "dm", Intern);
+ mkSymbol(new Number("39"), "box", Intern);
+ mkSymbol(new Number("40"), "new", Intern);
+ mkSymbol(new Number("41"), "type", Intern);
+ mkSymbol(new Number("42"), "isa", Intern);
+ mkSymbol(new Number("43"), "method", Intern);
+ mkSymbol(new Number("44"), "send", Intern);
+ mkSymbol(new Number("45"), "try", Intern);
+ mkSymbol(new Number("46"), "super", Intern);
+ mkSymbol(new Number("47"), "extra", Intern);
+ mkSymbol(new Number("48"), "with", Intern);
+ mkSymbol(new Number("49"), "bind", Intern);
+ mkSymbol(new Number("50"), "job", Intern);
+ mkSymbol(new Number("51"), "let", Intern);
+ mkSymbol(new Number("52"), "let?", Intern);
+ mkSymbol(new Number("53"), "use", Intern);
+ mkSymbol(new Number("54"), "and", Intern);
+ mkSymbol(new Number("55"), "or", Intern);
+ mkSymbol(new Number("56"), "nand", Intern);
+ mkSymbol(new Number("57"), "nor", Intern);
+ mkSymbol(new Number("58"), "xor", Intern);
+ mkSymbol(new Number("59"), "bool", Intern);
+ mkSymbol(new Number("60"), "not", Intern);
+ mkSymbol(new Number("61"), "nil", Intern);
+ mkSymbol(new Number("62"), "t", Intern);
+ mkSymbol(new Number("63"), "prog", Intern);
+ mkSymbol(new Number("64"), "prog1", Intern);
+ mkSymbol(new Number("65"), "prog2", Intern);
+ mkSymbol(new Number("66"), "if", Intern);
+ mkSymbol(new Number("67"), "if2", Intern);
+ mkSymbol(new Number("68"), "ifn", Intern);
+ mkSymbol(new Number("69"), "when", Intern);
+ mkSymbol(new Number("70"), "unless", Intern);
+ mkSymbol(new Number("71"), "cond", Intern);
+ mkSymbol(new Number("72"), "nond", Intern);
+ mkSymbol(new Number("73"), "case", Intern);
+ mkSymbol(new Number("74"), "state", Intern);
+ mkSymbol(new Number("75"), "while", Intern);
+ mkSymbol(new Number("76"), "until", Intern);
+ mkSymbol(new Number("77"), "do", Intern);
+ mkSymbol(new Number("78"), "loop", Intern);
+ mkSymbol(new Number("79"), "at", Intern);
+ mkSymbol(new Number("80"), "for", Intern);
+ mkSymbol(new Number("81"), "catch", Intern);
+ mkSymbol(new Number("82"), "throw", Intern);
+ mkSymbol(new Number("83"), "finally", Intern);
+ mkSymbol(new Number("84"), "!", Intern);
+ mkSymbol(new Number("85"), "e", Intern);
+ mkSymbol(new Number("86"), "$", Intern);
+ mkSymbol(new Number("87"), "sys", Intern);
+ mkSymbol(new Number("88"), "call", Intern);
+ mkSymbol(new Number("89"), "ipid", Intern);
+ mkSymbol(new Number("90"), "opid", Intern);
+ mkSymbol(new Number("91"), "kill", Intern);
+ mkSymbol(new Number("92"), "bye", Intern);
+ mkSymbol(new Number("93"), "name", Intern);
+ mkSymbol(new Number("94"), "sp?", Intern);
+ mkSymbol(new Number("95"), "pat?", Intern);
+ mkSymbol(new Number("96"), "fun?", Intern);
+ mkSymbol(new Number("97"), "getd", Intern);
+ mkSymbol(new Number("98"), "all", Intern);
+ mkSymbol(new Number("99"), "intern", Intern);
+ mkSymbol(new Number("100"), "====", Intern);
+ mkSymbol(new Number("101"), "box?", Intern);
+ mkSymbol(new Number("102"), "str?", Intern);
+ mkSymbol(new Number("103"), "zap", Intern);
+ mkSymbol(new Number("104"), "chop", Intern);
+ mkSymbol(new Number("105"), "pack", Intern);
+ mkSymbol(new Number("106"), "glue", Intern);
+ mkSymbol(new Number("107"), "text", Intern);
+ mkSymbol(new Number("108"), "pre?", Intern);
+ mkSymbol(new Number("109"), "sub?", Intern);
+ mkSymbol(new Number("110"), "val", Intern);
+ mkSymbol(new Number("111"), "set", Intern);
+ mkSymbol(new Number("112"), "setq", Intern);
+ mkSymbol(new Number("113"), "xchg", Intern);
+ mkSymbol(new Number("114"), "on", Intern);
+ mkSymbol(new Number("115"), "off", Intern);
+ mkSymbol(new Number("116"), "onOff", Intern);
+ mkSymbol(new Number("117"), "zero", Intern);
+ mkSymbol(new Number("118"), "one", Intern);
+ mkSymbol(new Number("119"), "default", Intern);
+ mkSymbol(new Number("120"), "push", Intern);
+ mkSymbol(new Number("121"), "push1", Intern);
+ mkSymbol(new Number("122"), "pop", Intern);
+ mkSymbol(new Number("123"), "cut", Intern);
+ mkSymbol(new Number("124"), "del", Intern);
+ mkSymbol(new Number("125"), "queue", Intern);
+ mkSymbol(new Number("126"), "fifo", Intern);
+ mkSymbol(new Number("127"), "idx", Intern);
+ mkSymbol(new Number("128"), "lup", Intern);
+ mkSymbol(new Number("129"), "put", Intern);
+ mkSymbol(new Number("130"), "get", Intern);
+ mkSymbol(new Number("131"), "prop", Intern);
+ mkSymbol(new Number("132"), ";", Intern);
+ mkSymbol(new Number("133"), "=:", Intern);
+ mkSymbol(new Number("134"), ":", Intern);
+ mkSymbol(new Number("135"), "::", Intern);
+ mkSymbol(new Number("136"), "putl", Intern);
+ mkSymbol(new Number("137"), "getl", Intern);
+ mkSymbol(new Number("138"), "meta", Intern);
+ mkSymbol(new Number("139"), "low?", Intern);
+ mkSymbol(new Number("140"), "upp?", Intern);
+ mkSymbol(new Number("141"), "lowc", Intern);
+ mkSymbol(new Number("142"), "uppc", Intern);
+ mkSymbol(new Number("143"), "fold", Intern);
+ mkSymbol(new Number("144"), "car", Intern);
+ mkSymbol(new Number("145"), "cdr", Intern);
+ mkSymbol(new Number("146"), "caar", Intern);
+ mkSymbol(new Number("147"), "cadr", Intern);
+ mkSymbol(new Number("148"), "cdar", Intern);
+ mkSymbol(new Number("149"), "cddr", Intern);
+ mkSymbol(new Number("150"), "caaar", Intern);
+ mkSymbol(new Number("151"), "caadr", Intern);
+ mkSymbol(new Number("152"), "cadar", Intern);
+ mkSymbol(new Number("153"), "caddr", Intern);
+ mkSymbol(new Number("154"), "cdaar", Intern);
+ mkSymbol(new Number("155"), "cdadr", Intern);
+ mkSymbol(new Number("156"), "cddar", Intern);
+ mkSymbol(new Number("157"), "cdddr", Intern);
+ mkSymbol(new Number("158"), "caaaar", Intern);
+ mkSymbol(new Number("159"), "caaadr", Intern);
+ mkSymbol(new Number("160"), "caadar", Intern);
+ mkSymbol(new Number("161"), "caaddr", Intern);
+ mkSymbol(new Number("162"), "cadaar", Intern);
+ mkSymbol(new Number("163"), "cadadr", Intern);
+ mkSymbol(new Number("164"), "caddar", Intern);
+ mkSymbol(new Number("165"), "cadddr", Intern);
+ mkSymbol(new Number("166"), "cdaaar", Intern);
+ mkSymbol(new Number("167"), "cdaadr", Intern);
+ mkSymbol(new Number("168"), "cdadar", Intern);
+ mkSymbol(new Number("169"), "cdaddr", Intern);
+ mkSymbol(new Number("170"), "cddaar", Intern);
+ mkSymbol(new Number("171"), "cddadr", Intern);
+ mkSymbol(new Number("172"), "cdddar", Intern);
+ mkSymbol(new Number("173"), "cddddr", Intern);
+ mkSymbol(new Number("174"), "nth", Intern);
+ mkSymbol(new Number("175"), "con", Intern);
+ mkSymbol(new Number("176"), "cons", Intern);
+ mkSymbol(new Number("177"), "conc", Intern);
+ mkSymbol(new Number("178"), "circ", Intern);
+ mkSymbol(new Number("179"), "rot", Intern);
+ mkSymbol(new Number("180"), "list", Intern);
+ mkSymbol(new Number("181"), "need", Intern);
+ mkSymbol(new Number("182"), "range", Intern);
+ mkSymbol(new Number("183"), "full", Intern);
+ mkSymbol(new Number("184"), "make", Intern);
+ mkSymbol(new Number("185"), "made", Intern);
+ mkSymbol(new Number("186"), "chain", Intern);
+ mkSymbol(new Number("187"), "link", Intern);
+ mkSymbol(new Number("188"), "yoke", Intern);
+ mkSymbol(new Number("189"), "copy", Intern);
+ mkSymbol(new Number("190"), "mix", Intern);
+ mkSymbol(new Number("191"), "append", Intern);
+ mkSymbol(new Number("192"), "delete", Intern);
+ mkSymbol(new Number("193"), "delq", Intern);
+ mkSymbol(new Number("194"), "replace", Intern);
+ mkSymbol(new Number("195"), "strip", Intern);
+ mkSymbol(new Number("196"), "split", Intern);
+ mkSymbol(new Number("197"), "reverse", Intern);
+ mkSymbol(new Number("198"), "flip", Intern);
+ mkSymbol(new Number("199"), "trim", Intern);
+ mkSymbol(new Number("200"), "clip", Intern);
+ mkSymbol(new Number("201"), "head", Intern);
+ mkSymbol(new Number("202"), "tail", Intern);
+ mkSymbol(new Number("203"), "stem", Intern);
+ mkSymbol(new Number("204"), "fin", Intern);
+ mkSymbol(new Number("205"), "last", Intern);
+ mkSymbol(new Number("206"), "==", Intern);
+ mkSymbol(new Number("207"), "n==", Intern);
+ mkSymbol(new Number("208"), "=", Intern);
+ mkSymbol(new Number("209"), "<>", Intern);
+ mkSymbol(new Number("210"), "=0", Intern);
+ mkSymbol(new Number("211"), "=T", Intern);
+ mkSymbol(new Number("212"), "n0", Intern);
+ mkSymbol(new Number("213"), "nT", Intern);
+ mkSymbol(new Number("214"), "<", Intern);
+ mkSymbol(new Number("215"), "<=", Intern);
+ mkSymbol(new Number("216"), ">", Intern);
+ mkSymbol(new Number("217"), ">=", Intern);
+ mkSymbol(new Number("218"), "max", Intern);
+ mkSymbol(new Number("219"), "min", Intern);
+ mkSymbol(new Number("220"), "atom", Intern);
+ mkSymbol(new Number("221"), "pair", Intern);
+ mkSymbol(new Number("222"), "lst?", Intern);
+ mkSymbol(new Number("223"), "num?", Intern);
+ mkSymbol(new Number("224"), "sym?", Intern);
+ mkSymbol(new Number("225"), "flg?", Intern);
+ mkSymbol(new Number("226"), "member", Intern);
+ mkSymbol(new Number("227"), "memq", Intern);
+ mkSymbol(new Number("228"), "mmeq", Intern);
+ mkSymbol(new Number("229"), "sect", Intern);
+ mkSymbol(new Number("230"), "diff", Intern);
+ mkSymbol(new Number("231"), "index", Intern);
+ mkSymbol(new Number("232"), "offset", Intern);
+ mkSymbol(new Number("233"), "length", Intern);
+ mkSymbol(new Number("234"), "size", Intern);
+ mkSymbol(new Number("235"), "assoc", Intern);
+ mkSymbol(new Number("236"), "asoq", Intern);
+ mkSymbol(new Number("237"), "rank", Intern);
+ mkSymbol(new Number("238"), "match", Intern);
+ mkSymbol(new Number("239"), "fill", Intern);
+ mkSymbol(new Number("240"), "prove", Intern);
+ mkSymbol(new Number("241"), "->", Intern);
+ mkSymbol(new Number("242"), "unify", Intern);
+ mkSymbol(new Number("243"), "sort", Intern);
+ mkSymbol(new Number("244"), "format", Intern);
+ mkSymbol(new Number("245"), "+", Intern);
+ mkSymbol(new Number("246"), "-", Intern);
+ mkSymbol(new Number("247"), "inc", Intern);
+ mkSymbol(new Number("248"), "dec", Intern);
+ mkSymbol(new Number("249"), "*", Intern);
+ mkSymbol(new Number("250"), "*/", Intern);
+ mkSymbol(new Number("251"), "/", Intern);
+ mkSymbol(new Number("252"), "%", Intern);
+ mkSymbol(new Number("253"), ">>", Intern);
+ mkSymbol(new Number("254"), "lt0", Intern);
+ mkSymbol(new Number("255"), "ge0", Intern);
+ mkSymbol(new Number("256"), "gt0", Intern);
+ mkSymbol(new Number("257"), "abs", Intern);
+ mkSymbol(new Number("258"), "bit?", Intern);
+ mkSymbol(new Number("259"), "&", Intern);
+ mkSymbol(new Number("260"), "|", Intern);
+ mkSymbol(new Number("261"), "x|", Intern);
+ mkSymbol(new Number("262"), "seed", Intern);
+ mkSymbol(new Number("263"), "rand", Intern);
+ mkSymbol(new Number("264"), "path", Intern);
+ mkSymbol(new Number("265"), "read", Intern);
+ mkSymbol(new Number("266"), "char", Intern);
+ mkSymbol(new Number("267"), "skip", Intern);
+ mkSymbol(new Number("268"), "line", Intern);
+ mkSymbol(new Number("269"), "load", Intern);
+ mkSymbol(new Number("270"), "in", Intern);
+ mkSymbol(new Number("271"), "out", Intern);
+ mkSymbol(new Number("272"), "ctl", Intern);
+ mkSymbol(new Number("273"), "open", Intern);
+ mkSymbol(new Number("274"), "close", Intern);
+ mkSymbol(new Number("275"), "prin", Intern);
+ mkSymbol(new Number("276"), "prinl", Intern);
+ mkSymbol(new Number("277"), "space", Intern);
+ mkSymbol(new Number("278"), "print", Intern);
+ mkSymbol(new Number("279"), "printsp", Intern);
+ mkSymbol(new Number("280"), "println", Intern);
+ mkSymbol(new Number("281"), "flush", Intern);
+ mkSymbol(new Number("282"), "connect", Intern);
+ MaxFun = 282;
+ USec = System.nanoTime() / 1000;
+ for (boolean first = true; ; first = false) {
+ try {
+ if (first)
+ loadAll(null);
+ load(null, ':', Nil);
+ bye(0);
+ }
+ catch (Control e) {}
+ catch (Throwable e) {error(null, null, e.toString());}
+ }
+ }
+
+ final static void init() {
+ String s;
+ Home = "";
+ for (int i = 0; i < Argv.length; ++i)
+ if ((s = Argv[i]).charAt(0) != '-') {
+ if ((i = s.lastIndexOf('/')) >= 0 && !(i == 1 && s.charAt(0) == '.'))
+ Home = s.substring(0, i+1);
+ break;
+ }
+ }
+
+ final static Any bye(int n) {
+ if (!B) {
+ B = true;
+ unwind(null);
+ Bye.Car.prog();
+ }
+ System.exit(n);
+ return null; /* Brain-dead Java */
+ }
+
+ final static long initSeed(Any x) {
+ long n;
+ for (n = 0; x instanceof Cell; x = x.Cdr)
+ n += initSeed(x.Car);
+ if (x != Nil) {
+ if (x instanceof Number && ((Number)x).Big == null)
+ n += ((Number)x).Cnt;
+ else {
+ byte b[] = x instanceof Symbol? x.name().getBytes() : ((Number)x).Big.toByteArray();
+ for (int i = 0; i < b.length; ++i)
+ n += b[i];
+ }
+ }
+ return n;
+ }
+
+ final static Any date(int y, int m, int d) {
+ int n;
+
+ if (m<1 || m>12 || d<1 || d>MonLen[m] && (m!=2 || d!=29 || y%4!=0 || y%100==0 && y%400!=0))
+ return Nil;
+ n = (12*y + m - 3) / 12;
+ return new Number((4404*y+367*m-1094)/12 - 2*n + n/4 - n/100 + n/400 + d);
+ }
+
+ final static Any date(int n) {
+ int y = (100*n - 20) / 3652425;
+ n += (y - y/4);
+ y = (100*n - 20) / 36525;
+ n -= 36525*y / 100;
+ int m = (10*n - 5) / 306;
+ int d = (10*n - 306*m + 5) / 10;
+ if (m < 10)
+ m += 3;
+ else {
+ ++y;
+ m -= 9;
+ }
+ return new Cell(new Number(y), new Cell(new Number(m), new Cell(new Number(d), Nil)));
+ }
+
+ final static Any time(Calendar cal) {
+ return new Number(cal.get(Calendar.HOUR_OF_DAY) * 3600 + cal.get(Calendar.MINUTE) * 60 + cal.get(Calendar.SECOND));
+ }
+
+ final static Any time(int h, int m, int s) {
+ if (h < 0 || h > 23 || m < 0 || m > 59 || s < 0 || s > 60)
+ return Nil;
+ return new Number(h * 3600 + m * 60 + s);
+ }
+
+ final static char firstChar(Any s) {
+ String nm = s.name();
+ return nm.length() == 0? '\0' : nm.charAt(0);
+ }
+
+ final static String path(String s) {
+ if (s.length() > 0)
+ if (s.charAt(0) == '+') {
+ if (s.length() > 1 && s.charAt(1) == '@')
+ return "+" + Home + s.substring(1);
+ }
+ else if (s.charAt(0) == '@')
+ return Home + s.substring(1);
+ return s;
+ }
+
+ final static void unwind(Catch target) {
+ int i, j, n;
+ Bind p;
+ Catch q;
+ Any x, y;
+ while ((q = Catch) != null) {
+ while ((p = Env.Bind) != null) {
+ if ((i = p.Eswp) != 0) {
+ j = i; n = 0;
+ for (;;) {
+ ++n;
+ if (++j == 0 || (p = p.Link) == null)
+ break;
+ if (p.Eswp < i)
+ --j;
+ }
+ do {
+ for (p = Env.Bind, j = n; --j != 0; p = p.Link);
+ if ((p.Eswp -= i) >= 0) {
+ if (p.Eswp > 0)
+ p.Eswp = 0;
+ for (j = p.Cnt; (j -= 2) >= 0;) {
+ y = p.Data[j+1];
+ x = y.Car; y.Car = p.Data[j]; p.Data[j] = x;
+ }
+ }
+ } while (--n != 0);
+ }
+ if (Env.Bind == q.Env.Bind)
+ break;
+ if (Env.Bind.Eswp == 0)
+ for (i = Env.Bind.Cnt; (i -= 2) >= 0;)
+ Env.Bind.Data[i+1].Car = Env.Bind.Data[i];
+ Env.Bind = Env.Bind.Link;
+ }
+ while (Env.InFrames != q.Env.InFrames)
+ Env.popInFiles();
+ while (Env.OutFrames != q.Env.OutFrames)
+ Env.popOutFiles();
+ Env = q.Env;
+ q.Fin.eval();
+ Catch = q.Link;
+ if (q == target)
+ return;
+ }
+ while (Env.Bind != null) {
+ if (Env.Bind.Eswp == 0)
+ for (i = Env.Bind.Cnt; (i -= 2) >= 0;)
+ Env.Bind.Data[i+1].Car = Env.Bind.Data[i];
+ Env.Bind = Env.Bind.Link;
+ }
+ while (Env.InFrames != null)
+ Env.popInFiles();
+ while (Env.OutFrames != null)
+ Env.popOutFiles();
+ }
+
+ final static void error(Any ex, Any x, String msg) {
+ Up.Car = ex == null? Nil : ex;
+ if (msg.length() != 0) {
+ Msg.Car = mkStr(msg);
+ for (Catch p = Catch; p != null; p = p.Link) {
+ Any y = p.Tag;
+ if (y != null)
+ while (y instanceof Cell) {
+ if (msg.indexOf(y.Car.name()) >= 0)
+ throw new Control(ex, p.Tag, y.Car == Nil? Msg.Car : y.Car);
+ y = y.Cdr;
+ }
+ }
+ }
+ Env.pushOutFile(new OutFrame(OutFiles[2], 0));
+ if (InFile.Name != null)
+ StdErr.Wr.print('[' + InFile.Name + ':' + InFile.Src + "] ");
+ if (ex != null) {
+ StdErr.Wr.print("!? ");
+ StdErr.print(ex);
+ StdErr.newline();
+ }
+ if (x != null) {
+ StdErr.print(x);
+ StdErr.Wr.print(" -- ");
+ }
+ if (msg.length() != 0) {
+ StdErr.Wr.print(msg);
+ StdErr.newline();
+ if (Err.Car != Nil && !Jam) {
+ Jam = true;
+ Err.Car.prog();
+ Jam = false;
+ }
+ load(null, '?', Nil);
+ }
+ unwind(null);
+ Env.Args = null;
+ Env.Next = 0;
+ Env.Make = Env.Yoke = null;
+ }
+
+ final static Any err(Any ex, Any x, String msg) {
+ error(ex, x, msg);
+ throw new Control();
+ }
+
+ final static Any brkLoad(Any x) {
+ if (!Break) {
+ Break = true;
+ OutFile.Wr.flush();
+ Brk = new Bind();
+ Brk.add(Up.Car); Brk.add(Up); Up.Car = x;
+ Brk.add(Run.Car); Brk.add(Run); Run.Car = Nil;
+ Brk.add(At.Car); Brk.add(At);
+ Env.Bind = Brk;
+ Env.pushOutFile(new OutFrame(OutFiles[1], 0));
+ OutFile.print(x);
+ OutFile.newline();
+ load(null, '!', Nil);
+ Env.popOutFiles();
+ At.Car = Brk.Data[4];
+ Run.Car = Brk.Data[2];
+ x = Up.Car;
+ Up.Car = Brk.Data[0];
+ Env.Bind = Brk.Link;
+ Break = false;
+ }
+ return x;
+ }
+
+ final static void trace(int i, Any x, String s) {
+ if (i > 64)
+ i = 64;
+ while (--i >= 0)
+ StdErr.space();
+ if (x instanceof Symbol)
+ StdErr.print(x);
+ else {
+ StdErr.print(x.Car);
+ StdErr.space();
+ StdErr.print(x.Cdr);
+ StdErr.space();
+ StdErr.print(This.Car);
+ }
+ StdErr.Wr.print(s);
+ }
+
+ final static Any execError(Any x) {return err(null, x, "Can't execute");}
+ final static Any protError(Any x) {return err(null, x, "Protected symbol");}
+ final static Any symError(Any x) {return err(null, x, "Symbol expected");}
+ final static void needVar(Any ex, Any x) {if (x instanceof Number) err(ex, x, "Variable expected");}
+
+ final static void badFd(Any ex, Any x) {err(ex, x, "Bad FD");}
+ 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 && firstChar(x) == '-')
+ return ((Symbol)x).parse(true,null).eval();
+ Env.pushInFile(x.rdOpen(ex));
+ Transient.clear();
+ x = Nil;
+ for (;;) {
+ Any y;
+ if (InFile.Name != null)
+ 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.Name != null || InFile.Chr != 0 || pr == '\0')
+ x = y.eval();
+ else {
+ Any at = At.Car;
+ x = At.Car = y.eval();
+ At3.Car = At2.Car;
+ At2.Car = at;
+ OutFile.Wr.print("-> ");
+ OutFile.Wr.flush();
+ OutFile.print(x);
+ OutFile.newline();
+ }
+ }
+ Env.popInFiles();
+ Transient.clear();
+ return x;
+ }
+
+ final static Any loadAll(Any ex) {
+ Any x = Nil;
+ while (Argv.length > 0 && !Argv[0].equals("-")) {
+ x = load(ex, '\0', mkStr(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) {
+ 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 int allocPid() {
+ int i;
+ for (i = 2; Pids[i] != null; ++i) {
+ if (i == Pids.length) {
+ Process[] p = new Process[i*2];
+ System.arraycopy(Pids, 0, p, 0, i);
+ Pids = p;
+ break;
+ }
+ }
+ return i;
+ }
+
+ final static int allocFd() {
+ int i;
+ for (i = 3; InFiles[i] != null || OutFiles[i] != null; ++i) {
+ if (i == InFiles.length) {
+ PicoLispReader[] r = new PicoLispReader[i*2];
+ System.arraycopy(InFiles, 0, r, 0, i);
+ InFiles = r;
+ PicoLispWriter[] w = new PicoLispWriter[i*2];
+ System.arraycopy(OutFiles, 0, w, 0, i);
+ OutFiles = w;
+ break;
+ }
+ }
+ return i;
+ }
+
+ final static Any mkChar(char c) {return new Symbol(null, "" + c);}
+ final static Any mkStr(String nm) {return nm == null || nm.length() == 0? Nil : new Symbol(null, nm);}
+ final static Any mkStr(StringBuilder sb) {return mkStr(sb.toString());}
+ final static Symbol mkSymbol(Any val) {return new Symbol(val, null);}
+
+ final static Symbol mkSymbol(Any val, String nm, HashMap<String,Symbol> table) {
+ Symbol sym;
+ if ((sym = table.get(nm)) == null) {
+ sym = new Symbol(val, nm);
+ table.put(nm, sym);
+ }
+ return sym;
+ }
+
+ final static Any strToNum(String s, int scl) throws NumberFormatException {
+ if (s.length() != 0 && s.charAt(0) == '+')
+ s = s.substring(1);
+ if (s.indexOf('.') <= 0)
+ return new Number(s);
+ return new Number((new BigDecimal(s)).setScale(scl, RoundingMode.HALF_UP).unscaledValue());
+ }
+
+ final static Any strToAtom(String s) {
+ if (s.equals("NIL"))
+ return Nil;
+ try {return strToNum(s, ((Number)Scl.Car).Cnt);}
+ catch (NumberFormatException e) {return mkSymbol(Nil, s, Intern);}
+ }
+
+ final static Any format(Any z, int scl, Any x) {
+ char sep = '.', ign = '\0';
+ if (x instanceof Cell) {
+ sep = firstChar(x.Car.eval());
+ if ((x = x.Cdr) instanceof Cell)
+ ign = firstChar(x.Car.eval());
+ }
+ StringBuilder sb = new StringBuilder();
+ if (z instanceof Number) {
+ String s = z.toString();
+ if (s.charAt(0) == '-') {
+ sb.append('-');
+ s = s.substring(1);
+ }
+ if ((scl = s.length() - scl - 1) < 0) {
+ sb.append('0');
+ sb.append(sep);
+ while (scl < -1) {
+ sb.append('0');
+ ++scl;
+ }
+ }
+ for (int i = 0;;) {
+ sb.append(s.charAt(i++));
+ if (i == s.length())
+ return mkStr(sb);
+ if (scl == 0)
+ sb.append(sep);
+ else if (ign != '\0' && scl > 0 && scl % 3 == 0)
+ sb.append(ign);
+ --scl;
+ }
+ }
+ String s = z.name();
+ for (int i = 0; i < s.length(); ++i) {
+ char c = s.charAt(i);
+ if (c != ign)
+ sb.append(c == sep? '.' : c);
+ }
+ try {return strToNum(sb.toString(), scl);}
+ catch (NumberFormatException e) {return Nil;}
+ }
+
+ final static Any token(Any x, char c) {
+ if (InFile.Chr == 0)
+ InFile.get();
+ if (InFile.skip(c) < 0)
+ return null;
+ if (InFile.Chr == '"') {
+ InFile.get();
+ if (InFile.Chr == '"') {
+ InFile.get();
+ return Nil;
+ }
+ if (!InFile.testEsc())
+ return Nil;
+ StringBuilder sb = new StringBuilder();
+ sb.append((char)InFile.Chr);
+ while (InFile.get() != '"' && InFile.testEsc())
+ sb.append((char)InFile.Chr);
+ InFile.get();
+ return mkStr(sb);
+ }
+ if (InFile.Chr >= '0' && InFile.Chr <= '9') {
+ StringBuilder sb = new StringBuilder();
+ sb.append((char)InFile.Chr);
+ while (InFile.get() >= '0' && InFile.Chr <= '9' || InFile.Chr == '.')
+ sb.append((char)InFile.Chr);
+ return strToAtom(sb.toString());
+ }
+ String s = x.name();
+ if (InFile.Chr >= 'A' && InFile.Chr <= 'Z' || InFile.Chr == '\\' || InFile.Chr >= 'a' && InFile.Chr <= 'z' || s.indexOf(InFile.Chr) >= 0) {
+ if (InFile.Chr == '\\')
+ InFile.get();
+ StringBuilder sb = new StringBuilder();
+ sb.append((char)InFile.Chr);
+ while (InFile.get() >= '0' && InFile.Chr <= '9' || InFile.Chr >= 'A' && InFile.Chr <= 'Z' || InFile.Chr == '\\' || InFile.Chr >= 'a' && InFile.Chr <= 'z' || s.indexOf(InFile.Chr) >= 0) {
+ if (InFile.Chr == '\\')
+ InFile.get();
+ sb.append((char)InFile.Chr);
+ }
+ s = sb.toString();
+ return s.equals("NIL")? Nil : mkSymbol(Nil, s, Intern);
+ }
+ return mkChar((char)InFile.get());
+ }
+
+ final static Any fish(Any ex, Any foo, Any[] v, Any res) {
+ if (foo.apply(ex, false, v, 1) != Nil)
+ return new Cell(v[0], res);
+ if (v[0] instanceof Cell) {
+ Any x = v[0];
+ if ((v[0] = x.Cdr) != Nil)
+ res = fish(ex, foo, v, res);
+ v[0] = x.Car;
+ res = fish(ex, foo, v, res);
+ v[0] = x;
+ }
+ return res;
+ }
+
+ 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 Any meta(Any x, Any y) {
+ Any z;
+ for (; x instanceof Cell; x = x.Cdr)
+ if (x.Car instanceof Symbol && ((z = x.Car.get(y)) != Nil || (z = meta(x.Car.Car, y)) != Nil))
+ return z;
+ return Nil;
+ }
+
+ final static boolean isa(Any cls, Any x) {
+ Any z;
+ z = x = x.Car;
+ while (x instanceof Cell) {
+ if (!(x.Car instanceof Cell)) {
+ while (x.Car instanceof Symbol) {
+ if (cls == x.Car || isa(cls, x.Car))
+ return true;
+ if (!((x = x.Cdr) instanceof Cell) || z == x)
+ return false;
+ }
+ return false;
+ }
+ if (z == (x = x.Cdr))
+ return false;
+ }
+ return false;
+ }
+
+ final static void redefMsg(Any x, Any y) {
+ StdErr.Wr.print("# ");
+ StdErr.print(x);
+ if (y != null) {
+ StdErr.space();
+ StdErr.print(y);
+ }
+ StdErr.Wr.println(" redefined");
+ StdErr.Wr.flush();
+ }
+
+ final static void putSrc(Symbol s, Any k) {
+ if (Dbg.Car != Nil && InFile != null && InFile.Name != null) {
+ Any x = new Cell(new Number(InFile.Src), mkSymbol(null, InFile.Name, Transient));
+ Any y = s.get(Dbg);
+ if (k == null) {
+ if (y == Nil)
+ s.put(Dbg, new Cell(x, Nil));
+ else
+ 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) {
+ z.Car.Cdr = x;
+ return;
+ }
+ y.Cdr = new Cell(new Cell(k, x), y.Cdr);
+ }
+ }
+ }
+
+ final static void redefine(Symbol s, Any x) {
+ if (s.Car != Nil && s != s.Car && !x.equal(s.Car))
+ redefMsg(s, null);
+ s.Car = x;
+ putSrc(s, null);
+ }
+
+ final static int xInt(Any x) {return ((Number)x).Cnt;}
+ final static int evInt(Any ex) {return ((Number)ex.Car.eval()).Cnt;}
+ final static long evLong(Any ex) {return ((Number)ex.Car.eval()).longValue();}
+ final static String evString(Any ex) {return ex.Car.eval().name();}
+
+ 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 Any fill(Any x, Any s) {
+ Any y, z;
+ if (x instanceof Number || x == Nil)
+ return null;
+ if (x instanceof Symbol)
+ return (s==Nil? x!=At && firstChar(x)=='@' : memq(x,s)!=null)? x.Car : null;
+ if ((y = fill(x.Car, s)) != null) {
+ z = fill(x.Cdr, s);
+ return new Cell(y, z == null? x.Cdr : z);
+ }
+ if ((y = fill(x.Cdr, s)) != null)
+ return new Cell(x.Car, y);
+ return null;
+ }
+
+ final static boolean isBlank(Any x) {
+ if (x != Nil) {
+ if (!(x instanceof Symbol))
+ return false;
+ String s = x.name();
+ if (s != null)
+ for (int i = 0; i < s.length(); ++i)
+ if (s.charAt(i) > ' ')
+ return false;
+ }
+ return true;
+ }
+
+ final static Any funq(Any x) {
+ Any y;
+ if (x instanceof Symbol)
+ return Nil;
+ if (x instanceof Number)
+ return ((Number)x).Big == null && ((Number)x).Cnt <= MaxFun? x : Nil;
+ for (y = x.Cdr; y instanceof Cell; y = y.Cdr) {
+ if (y == x)
+ return Nil;
+ if (y.Car instanceof Cell) {
+ if (y.Car.Car instanceof Number) {
+ if (y.Cdr instanceof Cell)
+ return Nil;
+ }
+ else if (y.Car.Car == Nil || y.Car.Car == T)
+ return Nil;
+ }
+ else if (y.Cdr != Nil)
+ return Nil;
+ }
+ if (y != Nil)
+ return Nil;
+ if ((x = x.Car) == Nil)
+ return T;
+ for (y = x; y instanceof Cell;)
+ if (y.Car instanceof Number || y.Car instanceof Cell || y.Car == Nil || y.Car == T || x == (y = y.Cdr))
+ return Nil;
+ return y instanceof Number || y == T? Nil : x;
+ }
+
+ final static Any trim(Any x) {
+ Any y;
+ if (!(x instanceof Cell))
+ return x;
+ if ((y = trim(x.Cdr)) == Nil && isBlank(x.Car))
+ return Nil;
+ return new Cell(x.Car, y);
+ }
+
+ final static Any nCdr(int n, Any x) {
+ while (--n >= 0)
+ x = x.Cdr;
+ return x;
+ }
+
+ final static Any nth(int n, Any x) {
+ if (--n < 0)
+ return Nil;
+ return nCdr(n,x);
+ }
+
+ final static Any sort(Any ex, Any lst, Any foo) {
+ Any x = lst, l = Nil, r = Nil, c = Nil;
+ do {
+ int i = foo == Nil? lst.Car.compare(x.Car) : foo.apply(ex, false, new Any[] {x.Car, lst.Car}, 2) == Nil? -1 : 1;
+ if (i > 0)
+ l = new Cell(x.Car, l);
+ else if (i < 0)
+ r = new Cell(x.Car, r);
+ else
+ c = new Cell(x.Car, c);
+ } while ((x = x.Cdr) instanceof Cell);
+ if ((lst = l) instanceof Cell) {
+ if (l.Cdr instanceof Cell)
+ for (lst = l = sort(ex, l, foo); (l = l.Cdr).Cdr instanceof Cell;);
+ if (c instanceof Cell)
+ for (l.Cdr = c; (l = l.Cdr).Cdr instanceof Cell;);
+ }
+ else if ((lst = c) instanceof Cell)
+ for (l = c; l.Cdr instanceof Cell; l = l.Cdr);
+ else
+ return sort(ex, r, foo);
+ if (r instanceof Cell)
+ l.Cdr = r.Cdr instanceof Cell? sort(ex, r, foo) : r;
+ return lst;
+ }
+
+ final static Any consIdx(Any x, Any y) {
+ if (x.Cdr.Cdr instanceof Cell)
+ y = consIdx(x.Cdr.Cdr, y);
+ y = new Cell(x.Car, y);
+ return x.Cdr.Car instanceof Cell? consIdx(x.Cdr.Car, y) : y;
+ }
+
+ final static Any idx(Any var, Any key, int flg) {
+ Any x, y, z, p, tree, tos;
+ boolean ad;
+ int i;
+ if (key == null)
+ return var.Car instanceof Cell? consIdx(var.Car, Nil) : Nil;
+ if (!((x = var.Car) instanceof Cell)) {
+ if (flg > 0)
+ var.Car = new Cell(key, Nil);
+ return Nil;
+ }
+ p = var;
+ ad = true;
+ for (;;) {
+ if ((i = key.compare(x.Car)) == 0) {
+ if (flg < 0) {
+ if (!(x.Cdr.Car instanceof Cell)) {
+ if (ad)
+ p.Car = x.Cdr.Cdr;
+ else
+ p.Cdr = x.Cdr.Cdr;
+ }
+ else if (!((y = x.Cdr.Cdr) instanceof Cell)) {
+ if (ad)
+ p.Car = x.Cdr.Car;
+ else
+ p.Cdr = x.Cdr.Car;
+ }
+ else if (!((z = y.Cdr.Car) instanceof Cell)) {
+ x.Car = y.Car;
+ x.Cdr.Cdr = y.Cdr.Cdr;
+ }
+ else {
+ while (z.Cdr.Car instanceof Cell)
+ z = (y = z).Cdr.Car;
+ x.Car = z.Car;
+ y.Cdr.Car = z.Cdr.Cdr;
+ }
+ }
+ return x;
+ }
+ if (!(x.Cdr instanceof Cell)) {
+ if (flg > 0)
+ x.Cdr = i < 0? new Cell(new Cell(key, Nil), Nil) : new Cell(Nil, new Cell(key, Nil));
+ return Nil;
+ }
+ if (i < 0) {
+ if (!(x.Cdr.Car instanceof Cell)) {
+ if (flg > 0)
+ x.Cdr.Car = new Cell(key, Nil);
+ return Nil;
+ }
+ p = x.Cdr; ad = true;
+ x = p.Car;
+ }
+ else {
+ if (!(x.Cdr.Cdr instanceof Cell)) {
+ if (flg > 0)
+ x.Cdr.Cdr = new Cell(key, Nil);
+ return Nil;
+ }
+ p = x.Cdr; ad = false;
+ x = p.Cdr;
+ }
+ }
+ }
+
+ final static Any consLup(Any x, Any y, Any from, Any to) {
+ if (x instanceof Cell) {
+ if (x.Car == T)
+ return consLup(x.Cdr.Car, y, from, to);
+ if (!(x.Car instanceof Cell))
+ return consLup(x.Cdr.Cdr, y, from, to);
+ if (to.compare(x.Car.Car) >= 0) {
+ y = consLup(x.Cdr.Cdr, y, from, to);
+ if (from.compare(x.Car.Car) <= 0) {
+ y = new Cell(x.Car, y);
+ return consLup(x.Cdr.Car, y, from, to);
+ }
+ }
+ if (from.compare(x.Car.Car) <= 0)
+ return consLup(x.Cdr.Car, y, from, to);
+ }
+ return y;
+ }
+
+ final static Any member(Any x, Any y) {
+ Any z = y;
+
+ while (y instanceof Cell) {
+ if (x.equal(y.Car))
+ return y;
+ if (z == (y = y.Cdr))
+ return null;
+ }
+ return y == Nil || !x.equal(y)? null : y;
+ }
+
+ final static Any memq(Any x, Any y) {
+ Any z = y;
+
+ while (y instanceof Cell) {
+ if (x == y.Car)
+ return y;
+ if (z == (y = y.Cdr))
+ return null;
+ }
+ return y == Nil || x != y? null : y;
+ }
+
+ final static int indx(Any x, Any y) {
+ int i = 1;
+ Any z = y;
+
+ while (y instanceof Cell) {
+ if (x.equal(y.Car))
+ return i;
+ ++i;
+ if (z == (y = y.Cdr))
+ return 0;
+ }
+ return 0;
+ }
+
+ final static boolean match(Any p, Any d) {
+ Any x;
+ for (;;) {
+ if (!(p instanceof Cell)) {
+ if (p instanceof Symbol && firstChar(p) == '@') {
+ p.Car = d;
+ return true;
+ }
+ return p.equal(d);
+ }
+ if ((x = p.Car) instanceof Symbol && firstChar(x) == '@') {
+ if (!(d instanceof Cell)) {
+ if (d.equal(p.Cdr)) {
+ x.Car = Nil;
+ return true;
+ }
+ return false;
+ }
+ if (match(p.Cdr, d.Cdr)) {
+ x.Car = new Cell(d.Car, Nil);
+ return true;
+ }
+ if (match(p.Cdr, d)) {
+ x.Car = Nil;
+ return true;
+ }
+ if (match(p, d.Cdr)) {
+ x.Car = new Cell(d.Car, x.Car);
+ return true;
+ }
+ }
+ if (!(d instanceof Cell) || !match(x, d.Car))
+ return false;
+ p = p.Cdr;
+ d = d.Cdr;
+ }
+ }
+
+ final static boolean unify(Number n1, Any x1, Number n2, Any x2) {
+ lookup1:
+ while (x1 instanceof Symbol && firstChar(x1) == '@') {
+ for (Any x = Penv; x.Car instanceof Cell; x = x.Cdr)
+ if (n1.Cnt == ((Number)x.Car.Car.Car).Cnt && x1 == x.Car.Car.Cdr) {
+ n1 = (Number)x.Car.Cdr.Car;
+ x1 = x.Car.Cdr.Cdr;
+ continue lookup1;
+ }
+ break;
+ }
+ lookup2:
+ while (x2 instanceof Symbol && firstChar(x2) == '@') {
+ for (Any x = Penv; x.Car instanceof Cell; x = x.Cdr)
+ if (n2.Cnt == ((Number)x.Car.Car.Car).Cnt && x2 == x.Car.Car.Cdr) {
+ n2 = (Number)x.Car.Cdr.Car;
+ x2 = x.Car.Cdr.Cdr;
+ continue lookup2;
+ }
+ break;
+ }
+ if (n1.Cnt == n2.Cnt && x1.equal(x2))
+ return true;
+ if (x1 instanceof Symbol && firstChar(x1) == '@') {
+ if (x1 != At) {
+ Penv = new Cell(new Cell(new Cell(n1,x1), Nil), Penv);
+ Penv.Car.Cdr = new Cell(n2,x2);
+ }
+ return true;
+ }
+ if (x2 instanceof Symbol && firstChar(x2) == '@') {
+ if (x2 != At) {
+ Penv = new Cell(new Cell(new Cell(n2,x2), Nil), Penv);
+ Penv.Car.Cdr = new Cell(n1,x1);
+ }
+ return true;
+ }
+ if (!(x1 instanceof Cell) || !(x2 instanceof Cell))
+ return x1.equal(x2);
+ Any env = Penv;
+ if (unify(n1, x1.Car, n2, x2.Car) && unify(n1, x1.Cdr, n2, x2.Cdr))
+ return true;
+ Penv = env;
+ return false;
+ }
+
+ final static Any lup(Number n, Any x) {
+ lup:
+ while (x instanceof Symbol && firstChar(x) == '@') {
+ for (Any y = Penv; y.Car instanceof Cell; y = y.Cdr)
+ if (n.Cnt == ((Number)y.Car.Car.Car).Cnt && x == y.Car.Car.Cdr) {
+ n = (Number)y.Car.Cdr.Car;
+ x = y.Car.Cdr.Cdr;
+ continue lup;
+ }
+ break;
+ }
+ return x instanceof Cell? new Cell(lup(n, x.Car), lup(n, x.Cdr)) : x;
+ }
+
+ final static Any lookup(Number n, Any x) {
+ return (x = lup(n,x)) instanceof Symbol && firstChar(x) == '@'? Nil : x;
+ }
+
+ final static Any uniFill(Any x) {
+ if (x instanceof Number)
+ return x;
+ if (x instanceof Symbol)
+ return lup((Number)Pnl.Car, x);
+ return new Cell(uniFill(x.Car), uniFill(x.Cdr));
+ }
+
+ final static Any evRun(boolean ev, Any x, int cnt, Any lst) {
+ int i, j = cnt, n = 0;
+ Bind b, bnd = Env.Bind;
+ Any s, y, z;
+ do {
+ ++n;
+ i = bnd.Eswp;
+ bnd.Eswp -= cnt;
+ if (i == 0) {
+ for (i = 0; i < bnd.Cnt; i+= 2) {
+ s = bnd.Data[i+1];
+ y = s.Car;
+ s.Car = 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? x.eval() : x.run();
+ else {
+ bnd = new Bind();
+ do {
+ s = lst.Car;
+ bnd.add(s.Car);
+ bnd.add(s);
+ exclude:
+ for (b = Env.Bind, j = n; ;) {
+ for (i = 0; i < b.Cnt; i+= 2)
+ if (s == b.Data[i+1]) {
+ s.Car = b.Data[i];
+ break exclude;
+ }
+ if (--j == 0 || (b = b.Link) == null)
+ break;
+ }
+ } while ((lst = lst.Cdr) instanceof Cell);
+ Env.Bind = bnd;
+ z = ev? x.eval() : x.run();
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = 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;) {
+ s = bnd.Data[i+1];
+ y = s.Car;
+ s.Car = 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 y = ex.Car;
+ Any cls = TheCls, key = TheKey;
+ Bind bnd = new Bind(); bnd.add(At.Car); 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.Car = x; // Set new value
+ }
+ do {
+ y = bnd.Data[--i];
+ x = y.Car;
+ y.Car = bnd.Data[--i]; // Set new value
+ bnd.Data[i] = x; // Save old value
+ } while (i > 0);
+ bnd.add(This.Car);
+ bnd.add(This);
+ This.Car = o;
+ Env.Bind = bnd;
+ y = cls; cls = Env.Cls; Env.Cls = y;
+ y = key; key = Env.Key; Env.Key = y;
+ 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 {
+ y = bnd.Data[--i];
+ x = y.Car;
+ y.Car = bnd.Data[--i]; // Set new value
+ bnd.Data[i] = x; // Save old value
+ } while (i > 0);
+ bnd.add(This.Car);
+ bnd.add(This);
+ This.Car = o;
+ Env.Bind = bnd;
+ y = cls; cls = Env.Cls; Env.Cls = y;
+ y = key; key = Env.Key; Env.Key = y;
+ x = ex.Cdr.prog();
+ Env.Args = args;
+ Env.Arg = arg;
+ }
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ Env.Cls = cls; Env.Key = key;
+ return x;
+ }
+
+ final static Any method(Any x) {
+ Any y, z;
+ if ((y = x.Car) 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;
+ }
+
+ final static Any extra(Any x) {
+ Any y;
+ for (x = x.Car; x.Car instanceof Cell; x = x.Cdr);
+ while (x instanceof Cell) {
+ if (x == Env.Cls || (y = extra(x.Car)) == null) {
+ while ((x = x.Cdr) instanceof Cell)
+ if ((y = method((TheCls = x).Car)) != null)
+ return y;
+ return null;
+ }
+ if (y != null && y != T)
+ return y;
+ x = x.Cdr;
+ }
+ return T;
+ }
+
+ final static Any loop(Any x) {
+ Any a, y, z;
+ for (;;) {
+ y = x;
+ do {
+ if ((z = y.Car) instanceof Cell) {
+ if (z.Car == Nil) {
+ if ((a = (z = z.Cdr).Car.eval()) == Nil)
+ return z.Cdr.prog();
+ At.Car = a;
+ }
+ else if (z.Car == T) {
+ if ((a = (z = z.Cdr).Car.eval()) != Nil) {
+ At.Car = a;
+ return z.Cdr.prog();
+ }
+ }
+ else
+ z.eval();
+ }
+ } while ((y = y.Cdr) instanceof Cell);
+ }
+ }
+
+ /* Ersatz PicoLisp Reader */
+ final static class InFrame {
+ InFrame Link;
+ PicoLispReader Rd;
+ int Pid;
+
+ InFrame(PicoLispReader rd, int pid) {
+ Link = Env.InFrames;
+ Rd = rd;
+ Pid = pid;
+ }
+ }
+
+ final static class PicoLispReader {
+ LineNumberReader Rd;
+ String Name;
+ char Eof1, Eof2;
+ int Fd, Chr, Src;
+
+ PicoLispReader(Reader rd, String nm, int fd) {
+ Rd = new LineNumberReader(rd);
+ Name = nm;
+ if (fd < 0)
+ fd = allocFd();
+ InFiles[Fd = fd] = this;
+ }
+
+ PicoLispReader(InputStream in, int fd) {
+ this(new InputStreamReader(in), null, fd);
+ }
+
+ PicoLispReader(String s, char eof1, char eof2) {
+ this(new StringReader(s), null, -1);
+ Eof1 = eof1;
+ Eof2 = eof2;
+ }
+
+ final void close() {
+ try {
+ InFiles[Fd] = null;
+ 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 boolean eol() {
+ if (Chr < 0)
+ return true;
+ if (Chr == '\n') {
+ Chr = 0;
+ return true;
+ }
+ if (Chr == '\r') {
+ get();
+ if (Chr == '\n')
+ Chr = 0;
+ return true;
+ }
+ return false;
+ }
+
+ 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();
+ }
+ return strToAtom(sb.toString());
+ }
+
+ 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) {
+ x.Cdr = skip('#')==')' || Chr==']'? res : read0(false);
+ if (skip('#') == ')')
+ get();
+ else if (Chr != ']')
+ err(null, x, "Bad dotted pair");
+ break;
+ }
+ x = x.Cdr = new Cell(rdAtom('.'), Nil);
+ }
+ else if (Chr != '~')
+ x = x.Cdr = new Cell(read0(false), Nil);
+ else {
+ get();
+ 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() + 1;
+ 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 (y = idx(Uni, x = read0(false), 1)) instanceof Cell? y.Car : x;
+ }
+ 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 OutFrame {
+ OutFrame Link;
+ PicoLispWriter Wr;
+ int Pid;
+
+ OutFrame(PicoLispWriter wr, int pid) {
+ Link = Env.OutFrames;
+ Wr = wr;
+ Pid = pid;
+ }
+ }
+
+ final static class PicoLispWriter {
+ PrintWriter Wr;
+ String Name;
+ int Fd;
+
+ PicoLispWriter(PrintWriter wr, String nm, int fd) {
+ Wr = wr;
+ Name = nm;
+ if (fd < 0)
+ fd = allocFd();
+ OutFiles[Fd = fd] = this;
+ }
+
+ PicoLispWriter(OutputStream out, int fd) {
+ this(new PrintWriter(out), null, fd);
+ }
+
+ final void close() {
+ OutFiles[Fd] = null;
+ 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[12];
+ }
+
+ final void add(Any x) {Data = append(Data, Cnt++, x);}
+ }
+
+ final static class Env {
+ int Next, ArgC, Trace;
+ Bind Bind;
+ Any Arg, Args[], Cls, Key, Make, Yoke;
+ InFrame InFrames;
+ OutFrame OutFrames;
+
+ Env() {}
+
+ Env(Env env) {
+ Next = env.Next; ArgC = env.ArgC; Trace = env.Trace;
+ Bind = env.Bind;
+ Arg = env.Arg; Args = env.Args;
+ Cls = env.Cls; Key = env.Key;
+ Make = env.Make; Yoke = env.Yoke;
+ InFrames = env.InFrames; OutFrames = env.OutFrames;
+ }
+
+ final void pushInFile(InFrame in) {
+ InFrames = in;
+ InFile = InFiles[in.Rd.Fd];
+ }
+
+ final void popInFiles() {
+ if (InFrames.Pid != 0) {
+ InFile.close();
+ if (InFrames.Pid > 1) {
+ try {
+ if (Pids[InFrames.Pid].waitFor() != 0)
+ err(null, null, "Pipe read close error");
+ Pids[InFrames.Pid] = null;
+ }
+ catch (InterruptedException e) {} //#! sighandler()
+ }
+ }
+ InFile = (InFrames = InFrames.Link) == null? StdIn : InFiles[InFrames.Rd.Fd];
+ }
+
+ final void pushOutFile(OutFrame out) {
+ OutFrames = out;
+ OutFile = OutFiles[out.Wr.Fd];
+ }
+
+ final void popOutFiles() {
+ if (OutFrames.Pid != 0) {
+ OutFile.close();
+ if (OutFrames.Pid > 1) {
+ try {
+ if (Pids[OutFrames.Pid].waitFor() != 0)
+ err(null, null, "Pipe write close error");
+ Pids[OutFrames.Pid] = null;
+ }
+ catch (InterruptedException e) {} //#! sighandler()
+ }
+ }
+ OutFile = (OutFrames = OutFrames.Link) == null? StdOut : OutFiles[OutFrames.Wr.Fd];
+ }
+ }
+
+ final static class Catch {
+ Catch Link;
+ Any Tag, Fin;
+ Env Env;
+
+ Catch(Any tag, Any fin, Env env) {
+ Tag = tag;
+ Fin = fin;
+ Env = new Env(env);
+ Link = Catch; Catch = this;
+ }
+ }
+
+ final static class Control extends RuntimeException {
+ Any Tag, Val;
+
+ Control() {}
+
+ Control(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");
+ }
+ }
+
+ static abstract class Any {
+ Any Car, Cdr;
+
+ abstract Any put(Any key, Any val);
+ abstract Any get(Any key);
+ abstract Any prop(Any key);
+ abstract Any putl(Any lst);
+ abstract Any getl();
+ abstract Any eval();
+ abstract Any prog();
+ abstract Any run();
+ abstract Any call(Any ex);
+ abstract Any func(Any ex);
+ abstract Any apply(Any ex, boolean cf, Any[] v, int n);
+ abstract boolean equal(Any x);
+ abstract int compare(Any x);
+ abstract long length();
+ abstract long size();
+ abstract InFrame rdOpen(Any ex);
+ abstract OutFrame wrOpen(Any ex);
+ abstract String name();
+ }
+
+ final static class Number extends Any {
+ int Cnt;
+ BigInteger Big;
+
+ Number(int i) {Cnt = i;}
+
+ Number(long n) {
+ if (n >= Integer.MIN_VALUE && n <= Integer.MAX_VALUE)
+ Cnt = (int)n;
+ else
+ Big = new BigInteger(new byte[] {(byte)(n>>56), (byte)(n>>48), (byte)(n>>40), (byte)(n>>32), (byte)(n>>24), (byte)(n>>16), (byte)(n>>8), (byte)n});
+ }
+
+ Number(BigInteger b) {
+ if (b.bitLength() < 32)
+ Cnt = b.intValue();
+ else
+ Big = b;
+ }
+
+ Number(String s) {
+ try {Cnt = Integer.parseInt(s);}
+ catch (NumberFormatException e) {Big = new BigInteger(s);}
+ }
+
+ final long longValue() {return Big == null? Cnt : Big.longValue();}
+
+ final static BigInteger big(int i) {
+ return new BigInteger(new byte[] {(byte)(i>>24), (byte)(i>>16), (byte)(i>>8), (byte)i});
+ }
+
+ final Any put(Any key, Any val) {return symError(this);}
+ final Any get(Any key) {return symError(this);}
+ final Any prop(Any key) {return symError(this);}
+ final Any putl(Any lst) {return symError(this);}
+ final Any getl() {return symError(this);}
+ final Any eval() {return this;}
+ final Any prog() {return execError(this);}
+ final Any run() {return execError(this);}
+ final Any call(Any ex) {return ex;}
+
+ final Any func(Any ex) {
+ try {
+ switch(Cnt) {
+ case 0: // (quote . any) -> any
+ return ex.Cdr;
+ case 1: // (meth 'obj ['any ..]) -> any
+ return doMeth(ex);
+ case 2: // quit
+ return do2(ex);
+ case 3: // args
+ return Env.Next < Env.ArgC? T : Nil;
+ case 4: // next
+ return do4(ex);
+ case 5: // arg
+ return do5(ex);
+ case 6: // rest
+ return do6(ex);
+ case 7: // date
+ return do7(ex);
+ case 8: // time
+ return do8(ex);
+ case 9: // usec
+ return do9(ex);
+ case 10: // file
+ return do10(ex);
+ case 11: // version
+ return do11(ex);
+ case 12: // apply
+ return do12(ex);
+ case 13: // pass
+ return do13(ex);
+ case 14: // maps
+ return do14(ex);
+ case 15: // map
+ return do15(ex);
+ case 16: // mapc
+ return do16(ex);
+ case 17: // maplist
+ return do17(ex);
+ case 18: // mapcar
+ return do18(ex);
+ case 19: // mapcon
+ return do19(ex);
+ case 20: // mapcan
+ return do20(ex);
+ case 21: // filter
+ return do21(ex);
+ case 22: // extract
+ return do22(ex);
+ case 23: // seek
+ return do23(ex);
+ case 24: // find
+ return do24(ex);
+ case 25: // pick
+ return do25(ex);
+ case 26: // cnt
+ return do26(ex);
+ case 27: // sum
+ return do27(ex);
+ case 28: // maxi
+ return do28(ex);
+ case 29: // mini
+ return do29(ex);
+ case 30: // fish
+ return do30(ex);
+ case 31: // by
+ return do31(ex);
+ case 32: // as
+ return do32(ex);
+ case 33: // lit
+ return do33(ex);
+ case 34: // eval
+ return do34(ex);
+ case 35: // run
+ return do35(ex);
+ case 36: // def
+ return do36(ex);
+ case 37: // de
+ return do37(ex);
+ case 38: // dm
+ return do38(ex);
+ case 39: // box
+ return do39(ex);
+ case 40: // new
+ return do40(ex);
+ case 41: // type
+ return do41(ex);
+ case 42: // isa
+ return do42(ex);
+ case 43: // method
+ return do43(ex);
+ case 44: // send
+ return do44(ex);
+ case 45: // try
+ return do45(ex);
+ case 46: // super
+ return do46(ex);
+ case 47: // extra
+ return do47(ex);
+ case 48: // with
+ return do48(ex);
+ case 49: // bind
+ return do49(ex);
+ case 50: // job
+ return do50(ex);
+ case 51: // let
+ return do51(ex);
+ case 52: // let?
+ return do52(ex);
+ case 53: // use
+ return do53(ex);
+ case 54: // and
+ return do54(ex);
+ case 55: // or
+ return do55(ex);
+ case 56: // nand
+ return do56(ex);
+ case 57: // nor
+ return do57(ex);
+ case 58: // xor
+ return do58(ex);
+ case 59: // bool
+ return do59(ex);
+ case 60: // not
+ return do60(ex);
+ case 61: // nil
+ return do61(ex);
+ case 62: // t
+ return do62(ex);
+ case 63: // prog
+ return ex.Cdr.prog();
+ case 64: // prog1
+ return do64(ex);
+ case 65: // prog2
+ return do65(ex);
+ case 66: // if
+ return do66(ex);
+ case 67: // if2
+ return do67(ex);
+ case 68: // ifn
+ return do68(ex);
+ case 69: // when
+ return do69(ex);
+ case 70: // unless
+ return do70(ex);
+ case 71: // cond
+ return do71(ex);
+ case 72: // nond
+ return do72(ex);
+ case 73: // case
+ return do73(ex);
+ case 74: // state
+ return do74(ex);
+ case 75: // while
+ return do75(ex);
+ case 76: // until
+ return do76(ex);
+ case 77: // do
+ return do77(ex);
+ case 78: // loop
+ return loop(ex.Cdr);
+ case 79: // at
+ return do79(ex);
+ case 80: // for
+ return do80(ex);
+ case 81: // catch
+ return do81(ex);
+ case 82: // throw
+ return do82(ex);
+ case 83: // finally
+ return do83(ex);
+ case 84: // !
+ return do84(ex);
+ case 85: // e
+ return do85(ex);
+ case 86: // $
+ return do86(ex);
+ case 87: // sys
+ return do87(ex);
+ case 88: // call
+ return do88(ex);
+ case 89: // ipid
+ return do89(ex);
+ case 90: // opid
+ return do90(ex);
+ case 91: // kill
+ return do91(ex);
+ case 92: // bye
+ return do92(ex);
+ case 93: // name
+ return do93(ex);
+ case 94: // sp?
+ return do94(ex);
+ case 95: // pat?
+ return do95(ex);
+ case 96: // fun?
+ return do96(ex);
+ case 97: // getd
+ return do97(ex);
+ case 98: // all
+ return do98(ex);
+ case 99: // intern
+ return do99(ex);
+ case 100: // ====
+ return do100(ex);
+ case 101: // box?
+ return do101(ex);
+ case 102: // str?
+ return do102(ex);
+ case 103: // zap
+ return do103(ex);
+ case 104: // chop
+ return do104(ex);
+ case 105: // pack
+ return do105(ex);
+ case 106: // glue
+ return do106(ex);
+ case 107: // text
+ return do107(ex);
+ case 108: // pre?
+ return do108(ex);
+ case 109: // sub?
+ return do109(ex);
+ case 110: // val
+ return ex.Cdr.Car.eval().Car;
+ case 111: // set
+ return do111(ex);
+ case 112: // setq
+ return do112(ex);
+ case 113: // xchg
+ return do113(ex);
+ case 114: // on
+ return do114(ex);
+ case 115: // off
+ return do115(ex);
+ case 116: // onOff
+ return do116(ex);
+ case 117: // zero
+ return do117(ex);
+ case 118: // one
+ return do118(ex);
+ case 119: // default
+ return do119(ex);
+ case 120: // push
+ return do120(ex);
+ case 121: // push1
+ return do121(ex);
+ case 122: // pop
+ return do122(ex);
+ case 123: // cut
+ return do123(ex);
+ case 124: // del
+ return do124(ex);
+ case 125: // queue
+ return do125(ex);
+ case 126: // fifo
+ return do126(ex);
+ case 127: // idx
+ return do127(ex);
+ case 128: // lup
+ return do128(ex);
+ case 129: // put
+ return do129(ex);
+ case 130: // get
+ return do130(ex);
+ case 131: // prop
+ return do131(ex);
+ case 132: // ;
+ return do132(ex);
+ case 133: // =:
+ return do133(ex);
+ case 134: // :
+ return do134(ex);
+ case 135: // ::
+ return do135(ex);
+ case 136: // putl
+ return do136(ex);
+ case 137: // getl
+ return do137(ex);
+ case 138: // meta
+ return do138(ex);
+ case 139: // low?
+ return do139(ex);
+ case 140: // upp?
+ return do140(ex);
+ case 141: // lowc
+ return do141(ex);
+ case 142: // uppc
+ return do142(ex);
+ case 143: // fold
+ return do143(ex);
+ case 144: // car
+ return ex.Cdr.Car.eval().Car;
+ case 145: // cdr
+ return ex.Cdr.Car.eval().Cdr;
+ case 146: // caar
+ return ex.Cdr.Car.eval().Car.Car;
+ case 147: // cadr
+ return ex.Cdr.Car.eval().Cdr.Car;
+ case 148: // cdar
+ return ex.Cdr.Car.eval().Car.Cdr;
+ case 149: // cddr
+ return ex.Cdr.Car.eval().Cdr.Cdr;
+ case 150: // caaar
+ return do150(ex);
+ case 151: // caadr
+ return do151(ex);
+ case 152: // cadar
+ return do152(ex);
+ case 153: // caddr
+ return do153(ex);
+ case 154: // cdaar
+ return do154(ex);
+ case 155: // cdadr
+ return do155(ex);
+ case 156: // cddar
+ return do156(ex);
+ case 157: // cdddr
+ return do157(ex);
+ case 158: // caaaar
+ return do158(ex);
+ case 159: // caaadr
+ return do159(ex);
+ case 160: // caadar
+ return do160(ex);
+ case 161: // caaddr
+ return do161(ex);
+ case 162: // cadaar
+ return do162(ex);
+ case 163: // cadadr
+ return do163(ex);
+ case 164: // caddar
+ return do164(ex);
+ case 165: // cadddr
+ return do165(ex);
+ case 166: // cdaaar
+ return do166(ex);
+ case 167: // cdaadr
+ return do167(ex);
+ case 168: // cdadar
+ return do168(ex);
+ case 169: // cdaddr
+ return do169(ex);
+ case 170: // cddaar
+ return do170(ex);
+ case 171: // cddadr
+ return do171(ex);
+ case 172: // cdddar
+ return do172(ex);
+ case 173: // cddddr
+ return do173(ex);
+ case 174: // nth
+ return do174(ex);
+ case 175: // con
+ return do175(ex);
+ case 176: // cons
+ return do176(ex);
+ case 177: // conc
+ return do177(ex);
+ case 178: // circ
+ return do178(ex);
+ case 179: // rot
+ return do179(ex);
+ case 180: // list
+ return do180(ex);
+ case 181: // need
+ return do181(ex);
+ case 182: // range
+ return do182(ex);
+ case 183: // full
+ return do183(ex);
+ case 184: // make
+ return do184(ex);
+ case 185: // made
+ return do185(ex);
+ case 186: // chain
+ return do186(ex);
+ case 187: // link
+ return do187(ex);
+ case 188: // yoke
+ return do188(ex);
+ case 189: // copy
+ return do189(ex);
+ case 190: // mix
+ return do190(ex);
+ case 191: // append
+ return do191(ex);
+ case 192: // delete
+ return do192(ex);
+ case 193: // delq
+ return do193(ex);
+ case 194: // replace
+ return do194(ex);
+ case 195: // strip
+ return do195(ex);
+ case 196: // split
+ return do196(ex);
+ case 197: // reverse
+ return do197(ex);
+ case 198: // flip
+ return do198(ex);
+ case 199: // trim
+ return do199(ex);
+ case 200: // clip
+ return do200(ex);
+ case 201: // head
+ return do201(ex);
+ case 202: // tail
+ return do202(ex);
+ case 203: // stem
+ return do203(ex);
+ case 204: // fin
+ return do204(ex);
+ case 205: // last
+ return do205(ex);
+ case 206: // ==
+ return do206(ex);
+ case 207: // n==
+ return do207(ex);
+ case 208: // =
+ return do208(ex);
+ case 209: // <>
+ return do209(ex);
+ case 210: // =0
+ return do210(ex);
+ case 211: // =T
+ return do211(ex);
+ case 212: // n0
+ return do212(ex);
+ case 213: // nT
+ return do213(ex);
+ case 214: // <
+ return do214(ex);
+ case 215: // <=
+ return do215(ex);
+ case 216: // >
+ return do216(ex);
+ case 217: // >=
+ return do217(ex);
+ case 218: // max
+ return do218(ex);
+ case 219: // min
+ return do219(ex);
+ case 220: // atom
+ return do220(ex);
+ case 221: // pair
+ return do221(ex);
+ case 222: // lst?
+ return do222(ex);
+ case 223: // num?
+ return do223(ex);
+ case 224: // sym?
+ return do224(ex);
+ case 225: // flg?
+ return do225(ex);
+ case 226: // member
+ return do226(ex);
+ case 227: // memq
+ return do227(ex);
+ case 228: // mmeq
+ return do228(ex);
+ case 229: // sect
+ return do229(ex);
+ case 230: // diff
+ return do230(ex);
+ case 231: // index
+ return do231(ex);
+ case 232: // offset
+ return do232(ex);
+ case 233: // length
+ return do233(ex);
+ case 234: // size
+ return do234(ex);
+ case 235: // assoc
+ return do235(ex);
+ case 236: // asoq
+ return do236(ex);
+ case 237: // rank
+ return do237(ex);
+ case 238: // match
+ return do238(ex);
+ case 239: // fill
+ return do239(ex);
+ case 240: // prove
+ return do240(ex);
+ case 241: // ->
+ return do241(ex);
+ case 242: // unify
+ return do242(ex);
+ case 243: // sort
+ return do243(ex);
+ case 244: // format
+ return do244(ex);
+ case 245: // +
+ return do245(ex);
+ case 246: // -
+ return do246(ex);
+ case 247: // inc
+ return do247(ex);
+ case 248: // dec
+ return do248(ex);
+ case 249: // *
+ return do249(ex);
+ case 250: // */
+ return do250(ex);
+ case 251: // /
+ return do251(ex);
+ case 252: // %
+ return do252(ex);
+ case 253: // >>
+ return do253(ex);
+ case 254: // lt0
+ return do254(ex);
+ case 255: // ge0
+ return do255(ex);
+ case 256: // gt0
+ return do256(ex);
+ case 257: // abs
+ return do257(ex);
+ case 258: // bit?
+ return do258(ex);
+ case 259: // &
+ return do259(ex);
+ case 260: // |
+ return do260(ex);
+ case 261: // x|
+ return do261(ex);
+ case 262: // seed
+ return do262(ex);
+ case 263: // rand
+ return do263(ex);
+ case 264: // path
+ return do264(ex);
+ case 265: // read
+ return do265(ex);
+ case 266: // char
+ return do266(ex);
+ case 267: // skip
+ return do267(ex);
+ case 268: // line
+ return do268(ex);
+ case 269: // load
+ return do269(ex);
+ case 270: // in
+ return do270(ex);
+ case 271: // out
+ return do271(ex);
+ case 272: // ctl
+ return do272(ex);
+ case 273: // open
+ return do273(ex);
+ case 274: // close
+ return do274(ex);
+ case 275: // prin
+ return do275(ex);
+ case 276: // prinl
+ return do276(ex);
+ case 277: // space
+ return do277(ex);
+ case 278: // print
+ return do278(ex);
+ case 279: // printsp
+ return do279(ex);
+ case 280: // println
+ return do280(ex);
+ case 281: // flush
+ return do281(ex);
+ case 282: // connect
+ return do282(ex);
+ default:
+ return undefined(this, ex);
+ }
+ }
+ catch (Throwable e) {
+ if (e instanceof Control)
+ throw (Control)e;
+ return err(ex, null, e.toString());
+ }
+ }
+
+ final static Any doMeth(Any ex) {
+ Any x, y, z;
+ z = (x = ex.Cdr).Car.eval();
+ for (TheKey = ex.Car; ; TheKey = TheKey.Car)
+ if (TheKey.Car instanceof Number) {
+ TheCls = null;
+ if ((y = method(z)) != null)
+ return evMethod(z, y, x.Cdr);
+ err(ex, TheKey, "Bad message");
+ }
+ }
+
+ final static Any do2(Any ex) { // quit
+ String str;
+ str = evString(ex = ex.Cdr);
+ return err(null, (ex = ex.Cdr) instanceof Cell? ex.Car.eval() : null, str);
+ }
+
+ final static Any do4(Any ex) { // next
+ return Env.Next < Env.ArgC? (Env.Arg = Env.Args[Env.Next++]) : Nil;
+ }
+
+ final static Any do5(Any ex) { // arg
+ int i;
+ if (ex.Cdr instanceof Cell)
+ return (i = evInt(ex.Cdr)+Env.Next-1) >= 0 && i < Env.ArgC? Env.Args[i] : Nil;
+ return Env.Arg;
+ }
+
+ final static Any do6(Any ex) { // rest
+ int i;
+ Any x;
+ for (x = Nil, i = Env.ArgC; --i >= Env.Next;)
+ x = new Cell(Env.Args[i], x);
+ return x;
+ }
+
+ final static Any do7(Any ex) { // date
+ int i, j;
+ Any x, z;
+ if (!((x = ex.Cdr) instanceof Cell)) {
+ Cal = new GregorianCalendar();
+ return date(Cal.get(Calendar.YEAR), Cal.get(Calendar.MONTH)+1, Cal.get(Calendar.DATE));
+ }
+ if ((z = x.Car.eval()) == T) {
+ Cal = new GregorianCalendar(TimeZone.getTimeZone("GMT"));
+ return date(Cal.get(Calendar.YEAR), Cal.get(Calendar.MONTH)+1, Cal.get(Calendar.DATE));
+ }
+ if (z == Nil)
+ return Nil;
+ if (z instanceof Cell)
+ return date(xInt(z.Car), xInt(z.Cdr.Car), xInt(z.Cdr.Cdr.Car));
+ i = xInt(z);
+ if (!((x = x.Cdr) instanceof Cell))
+ return date(i);
+ j = evInt(x);
+ return date(i, j, evInt(x.Cdr));
+ }
+
+ final static Any do8(Any ex) { // time
+ int i, j;
+ Any x, z;
+ if (!((x = ex.Cdr) instanceof Cell))
+ return time(new GregorianCalendar());
+ if ((z = x.Car.eval()) == T)
+ return time(Cal);
+ if (z == Nil)
+ return Nil;
+ if (z instanceof Cell)
+ return time(xInt(z.Car), xInt(z.Cdr.Car), z.Cdr.Cdr instanceof Cell? xInt(z.Cdr.Cdr.Car) : 0);
+ i = xInt(z);
+ if (!((x = x.Cdr) instanceof Cell))
+ return new Cell(new Number(i / 3600), new Cell(new Number(i / 60 % 60), new Cell(new Number(i % 60), Nil)));
+ j = evInt(x);
+ return time(i, j, x.Cdr instanceof Cell? evInt(x.Cdr) : 0);
+ }
+
+ final static Any do9(Any ex) { // usec
+ return new Number(System.nanoTime()/1000 - USec);
+ }
+
+ final static Any do10(Any ex) { // file
+ int i;
+ Any x;
+ if (InFile.Name == null)
+ return Nil;
+ x = new Number(InFile.Src);
+ if ((i = InFile.Name.lastIndexOf('/')) >= 0)
+ return new Cell(mkStr(InFile.Name.substring(0, i+1)), new Cell(mkStr(InFile.Name.substring(i+1)), x));
+ return new Cell(mkStr("./"), new Cell(mkStr(InFile.Name), x));
+ }
+
+ final static Any do11(Any ex) { // version
+ int i;
+ Any x;
+ if (ex.Cdr.Car.eval() == Nil) {
+ for (i = 0; i < 4; ++i)
+ OutFile.Wr.print(Version[i] + (i == 3? "-" : "."));
+ OutFile.Wr.println("J");
+ OutFile.Wr.flush();
+ }
+ for (x = Nil, i = 4; --i >= 0;)
+ x = new Cell(new Number(Version[i]), x);
+ return x;
+ }
+
+ final static Any do12(Any ex) { // apply
+ int i;
+ Any w, x, y;
+ Any[] v;
+ 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);
+ }
+
+ final static Any do13(Any ex) { // pass
+ int i, j;
+ Any w, x;
+ Any[] v;
+ 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);
+ }
+
+ final static Any do14(Any ex) { // maps
+ int i, j, k;
+ Any w, x, y;
+ Symbol s;
+ Any[] v;
+ w = (x = ex.Cdr).Car.eval();
+ if ((y = (x = x.Cdr).Car.eval()) == Nil || (s = (Symbol)y).Prop == null)
+ return Nil;
+ v = new Any[6];
+ i = 1;
+ append(v, 0, null);
+ while ((x = x.Cdr) instanceof Cell)
+ v = append(v, i++, x.Car.eval());
+ k = s.Prop.length;
+ do
+ if ((x = s.Prop[--k]) != null) {
+ v[0] = new Cell(x,Nil);
+ x = w.apply(ex, true, v, i);
+ for (j = i; --j > 0;)
+ v[j] = v[j].Cdr;
+ }
+ while (k != 0);
+ return x;
+ }
+
+ final static Any do15(Any ex) { // map
+ int i, j;
+ Any w, x, y;
+ Any[] v;
+ 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;
+ }
+
+ final static Any do16(Any ex) { // mapc
+ int i, j;
+ Any w, x, y;
+ Any[] v;
+ 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, true, v, i);
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return x;
+ }
+
+ final static Any do17(Any ex) { // maplist
+ int i, j;
+ Any w, x, z;
+ Any[] v;
+ 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, false, v, i), Nil);
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ x = x.Cdr = new Cell(w.apply(ex, false, v, i), Nil);
+ }
+ }
+ return z;
+ }
+
+ final static Any do18(Any ex) { // mapcar
+ int i, j;
+ Any w, x, z;
+ Any[] v;
+ 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 = x.Cdr = new Cell(w.apply(ex, true, v, i), Nil);
+ }
+ }
+ return z;
+ }
+
+ final static Any do19(Any ex) { // mapcon
+ int i, j;
+ Any w, x, z;
+ Any[] v;
+ 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;
+ while (!((x = w.apply(ex, false, v, i)) instanceof Cell)) {
+ if (!(v[0].Cdr instanceof Cell))
+ return z;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ z = x;
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ while (x.Cdr instanceof Cell)
+ x = x.Cdr;
+ x.Cdr = w.apply(ex, false, v, i);
+ }
+ }
+ return z;
+ }
+
+ final static Any do20(Any ex) { // mapcan
+ int i, j;
+ Any w, x, z;
+ Any[] v;
+ 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;
+ while (!((x = w.apply(ex, true, v, i)) instanceof Cell)) {
+ if (!(v[0].Cdr instanceof Cell))
+ return z;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ z = x;
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ while (x.Cdr instanceof Cell)
+ x = x.Cdr;
+ x.Cdr = w.apply(ex, true, v, i);
+ }
+ }
+ return z;
+ }
+
+ final static Any do21(Any ex) { // filter
+ int i, j;
+ Any w, x, z;
+ Any[] v;
+ 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;
+ while (w.apply(ex, true, v, i) == Nil) {
+ if (!(v[0].Cdr instanceof Cell))
+ return z;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ z = x = new Cell(v[0].Car, Nil);
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ if (w.apply(ex, true, v, i) != Nil)
+ x = x.Cdr = new Cell(v[0].Car, Nil);
+ }
+ }
+ return z;
+ }
+
+ final static Any do22(Any ex) { // extract
+ int i, j;
+ Any w, x, y, z;
+ Any[] v;
+ 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;
+ while ((y = w.apply(ex, true, v, i)) == Nil) {
+ if (!(v[0].Cdr instanceof Cell))
+ return z;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ z = x = new Cell(y, Nil);
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ if ((y = w.apply(ex, true, v, i)) != Nil)
+ x = x.Cdr = new Cell(y, Nil);
+ }
+ }
+ return z;
+ }
+
+ final static Any do23(Any ex) { // seek
+ int i, j;
+ Any w, x;
+ Any[] v;
+ 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 (v[0] instanceof Cell) {
+ if (w.apply(ex, false, v, i) != Nil)
+ return v[0];
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return Nil;
+ }
+
+ final static Any do24(Any ex) { // find
+ int i, j;
+ Any w, x;
+ Any[] v;
+ 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 (v[0] instanceof Cell) {
+ if (w.apply(ex, true, v, i) != Nil)
+ return v[0].Car;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return Nil;
+ }
+
+ final static Any do25(Any ex) { // pick
+ int i, j;
+ Any w, x;
+ Any[] v;
+ 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 (v[0] instanceof Cell) {
+ if ((x = w.apply(ex, true, v, i)) != Nil)
+ return x;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return Nil;
+ }
+
+ final static Any do26(Any ex) { // cnt
+ int i, j;
+ long n;
+ Any w, x;
+ Any[] v;
+ w = (x = ex.Cdr).Car.eval();
+ n = 0;
+ 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 (v[0] instanceof Cell) {
+ if (w.apply(ex, true, v, i) != Nil)
+ ++n;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return new Number(n);
+ }
+
+ final static Any do27(Any ex) { // sum
+ int i, j;
+ Any w, x, y;
+ Number num;
+ Any[] v;
+ w = (x = ex.Cdr).Car.eval();
+ num = Zero;
+ 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 (v[0] instanceof Cell) {
+ if ((y = w.apply(ex, true, v, i)) instanceof Number)
+ num = num.add((Number)y);
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return num;
+ }
+
+ final static Any do28(Any ex) { // maxi
+ int i, j;
+ Any w, x, y, z;
+ Any[] v;
+ w = (x = ex.Cdr).Car.eval();
+ y = 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);
+ while (v[0] instanceof Cell) {
+ if ((x = w.apply(ex, true, v, i)).compare(y) > 0) {
+ z = v[0].Car;
+ y = x;
+ }
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return z;
+ }
+
+ final static Any do29(Any ex) { // mini
+ int i, j;
+ Any w, x, y, z;
+ Any[] v;
+ w = (x = ex.Cdr).Car.eval();
+ y = T;
+ 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);
+ while (v[0] instanceof Cell) {
+ if ((x = w.apply(ex, true, v, i)).compare(y) < 0) {
+ z = v[0].Car;
+ y = x;
+ }
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return z;
+ }
+
+ final static Any do30(Any ex) { // fish
+ Any w;
+ Any[] v;
+ w = ex.Cdr.Car.eval();
+ (v = new Any[1])[0] = ex.Cdr.Cdr.Car.eval();
+ return fish(ex, w, v, Nil);
+ }
+
+ final static Any do31(Any ex) { // by
+ int i, j;
+ Any w, x, y, z;
+ Any[] v;
+ w = (x = ex.Cdr).Car.eval();
+ y = (x = x.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);
+ z = x = new Cell(new Cell(w.apply(ex, true, v, i), v[0].Car), Nil);
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ x = x.Cdr = new Cell(new Cell(w.apply(ex, true, v, i), v[0].Car), Nil);
+ }
+ v[0] = z;
+ z = y.apply(ex, false, v, 1);
+ for (x = z; x instanceof Cell; x = x.Cdr)
+ x.Car = x.Car.Cdr;
+ }
+ return z;
+ }
+
+ final static Any do32(Any ex) { // as
+ return ex.Cdr.Car.eval() == Nil? Nil : ex.Cdr.Cdr;
+ }
+
+ final static Any do33(Any ex) { // lit
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Number || x == Nil || x == T || x instanceof Cell && x.Car instanceof Number? x : new Cell(Quote, x);
+ }
+
+ final static Any do34(Any ex) { // eval
+ Any y;
+ if ((y = (ex = ex.Cdr).Car.eval()) instanceof Number)
+ return y;
+ if (ex.Cdr == Nil || Env.Bind == null)
+ return y.eval();
+ return evRun(true, y, evInt(ex.Cdr), ex.Cdr.Cdr.Car.eval());
+ }
+
+ final static Any do35(Any ex) { // run
+ Any y;
+ if ((y = (ex = ex.Cdr).Car.eval()) instanceof Number)
+ return y;
+ if (ex.Cdr == Nil || Env.Bind == null)
+ return y.run();
+ return evRun(false, y, evInt(ex.Cdr), ex.Cdr.Cdr.Car.eval());
+ }
+
+ final static Any do36(Any ex) { // def
+ Any w, x, y;
+ Symbol s;
+ s = (Symbol)(ex = ex.Cdr).Car.eval();
+ x = (ex = ex.Cdr).Car.eval();
+ if (ex.Cdr == Nil) {
+ if (s.Car != Nil && s.Car != s && !x.equal(s.Car))
+ redefMsg(s, null);
+ s.Car = x;
+ putSrc(s, null);
+ }
+ else {
+ y = ex.Cdr.Car.eval();
+ if ((w = s.get(x)) != Nil && !x.equal(w))
+ redefMsg(s,x);
+ s.put(x,y);
+ putSrc(s,x);
+ }
+ return s;
+ }
+
+ final static Any do37(Any ex) { // de
+ ex = ex.Cdr;
+ redefine((Symbol)ex.Car, ex.Cdr);
+ return ex.Car;
+ }
+
+ final static Any do38(Any ex) { // dm
+ Any x, y;
+ Symbol s, t;
+ if (!((x = ex.Cdr).Car instanceof Cell)) {
+ s = (Symbol)x.Car;
+ t = (Symbol)Class.Car;
+ }
+ else {
+ s = (Symbol)x.Car.Car;
+ t = (Symbol)
+ (!((y = x.Car).Cdr instanceof Cell)?
+ y.Cdr :
+ (y.Cdr.Cdr == Nil? Class.Car : y.Cdr.Cdr).get(y.Cdr.Car) );
+ }
+ if (s != T)
+ redefine(s, Meth.Car);
+ if (x.Cdr instanceof Symbol) {
+ y = x.Cdr.Car;
+ 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 = t.Car; y instanceof Cell && y.Car instanceof Cell; y = y.Cdr)
+ if (y.Car.Car == s) {
+ if (!x.Cdr.equal(y.Cdr.Car))
+ redefMsg(s, t);
+ y.Car.Cdr = x.Cdr;
+ putSrc(t, s);
+ return s;
+ }
+ t.Car = x.Car instanceof Cell?
+ new Cell(new Cell(s, x.Cdr), t.Car) :
+ new Cell(x, t.Car);
+ putSrc(t, s);
+ return s;
+ }
+
+ final static Any do39(Any ex) { // box
+ return mkSymbol(ex.Cdr.Car.eval());
+ }
+
+ final static Any do40(Any ex) { // new
+ Any x;
+ Symbol s;
+ s = mkSymbol((ex = ex.Cdr).Car.eval());
+ TheKey = T; TheCls = null;
+ if ((x = method(s)) != null)
+ evMethod(s, x, ex.Cdr);
+ else {
+ while ((ex = ex.Cdr) != Nil) {
+ x = ex.Car.eval();
+ s.put(x, (ex = ex.Cdr).Car.eval());
+ }
+ }
+ return s;
+ }
+
+ final static Any do41(Any ex) { // type
+ Any x, y, z;
+ if ((x = ex.Cdr.Car.eval()) instanceof Symbol) {
+ z = x = x.Car;
+ while (x instanceof Cell) {
+ if (!(x.Car instanceof Cell)) {
+ y = x;
+ while (x.Car instanceof Symbol) {
+ if (!((x = x.Cdr) instanceof Cell))
+ return x == Nil? y : Nil;
+ if (z == x)
+ return Nil;
+ }
+ return Nil;
+ }
+ if (z == (x = x.Cdr))
+ return Nil;
+ }
+ }
+ return Nil;
+ }
+
+ final static Any do42(Any ex) { // isa
+ Any x, y;
+ x = (ex = ex.Cdr).Car.eval();
+ if ((y = ex.Cdr.Car.eval()) instanceof Symbol) {
+ if (x instanceof Symbol)
+ return isa(x,y)? y : Nil;
+ while (x instanceof Cell) {
+ if (!isa(x.Car, y))
+ return Nil;
+ x = x.Cdr;
+ }
+ return y;
+ }
+ return Nil;
+ }
+
+ final static Any do43(Any ex) { // method
+ Any x, y;
+ x = (ex = ex.Cdr).Car.eval();
+ y = ex.Cdr.Car.eval();
+ TheKey = x;
+ return (x = method(y)) == null? Nil : x;
+ }
+
+ final static Any do44(Any ex) { // send
+ Any x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ z = (x = x.Cdr).Car.eval();
+ TheKey = y; TheCls = null;
+ if ((y = method(z)) == null)
+ err(ex, TheKey, "Bad message");
+ return evMethod(z, y, x.Cdr);
+ }
+
+ final static Any do45(Any ex) { // try
+ Any x, y;
+ x = (ex = ex.Cdr).Car.eval();
+ if ((y = (ex = ex.Cdr).Car.eval()) instanceof Symbol) {
+ TheKey = x; TheCls = null;
+ if ((x = method(y)) != null)
+ return evMethod(y, x, ex.Cdr);
+ }
+ return Nil;
+ }
+
+ final static Any do46(Any ex) { // super
+ Any w, x, y, z;
+ TheKey = Env.Key;
+ x = Env.Cls == null? This.Car : Env.Cls.Car.Car;
+ while (x.Car instanceof Cell)
+ x = x.Cdr;
+ for (;;) {
+ if (!(x instanceof Cell))
+ err(ex, TheKey, "Bad super");
+ if ((y = method((TheCls = x).Car)) != null) {
+ z = Env.Cls; Env.Cls = TheCls;
+ w = Env.Key; Env.Key = TheKey;
+ x = y.func(ex);
+ Env.Key = w; Env.Cls = z;
+ return x;
+ }
+ x = x.Cdr;
+ }
+ }
+
+ final static Any do47(Any ex) { // extra
+ Any x, y, z;
+ TheKey = Env.Key;
+ if ((x = extra(This.Car)) == null || x == T)
+ err(ex, TheKey, "Bad extra");
+ y = Env.Cls; Env.Cls = TheCls;
+ z = Env.Key; Env.Key = TheKey;
+ x = x.func(ex);
+ Env.Key = z; Env.Cls = y;
+ return x;
+ }
+
+ final static Any do48(Any ex) { // with
+ Any x;
+ Bind bnd;
+ if ((x = ex.Cdr.Car.eval()) != Nil) {
+ (bnd = new Bind()).add(This.Car);
+ bnd.add(This);
+ This.Car = x;
+ Env.Bind = bnd;
+ x = ex.Cdr.Cdr.prog();
+ This.Car = bnd.Data[0];
+ }
+ return x;
+ }
+
+ final static Any do49(Any ex) { // bind
+ int i;
+ Any x, y, z;
+ Bind bnd;
+ if ((y = (x = ex.Cdr).Car.eval()) == Nil)
+ return x.Cdr.prog();
+ bnd = new Bind();
+ if (y instanceof Symbol) {
+ bnd.add(y.Car);
+ bnd.add(y);
+ }
+ else {
+ do {
+ if (y.Car instanceof Symbol) {
+ bnd.add(y.Car.Car);
+ bnd.add(y.Car);
+ }
+ else {
+ z = y.Car.Car;
+ bnd.add(z.Car);
+ bnd.add(z);
+ z.Car = y.Car.Cdr;
+ }
+ } while ((y = y.Cdr) instanceof Cell);
+ }
+ Env.Bind = bnd;
+ x = x.Cdr.prog();
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+ }
+
+ final static Any do50(Any ex) { // job
+ int i;
+ Any w, x, y, z;
+ Bind bnd;
+ bnd = new Bind();
+ for (z = y = (x = ex.Cdr).Car.eval(); y instanceof Cell; y = y.Cdr) {
+ w = y.Car.Car;
+ bnd.add(w.Car);
+ bnd.add(w);
+ w.Car = y.Car.Cdr;
+ }
+ Env.Bind = bnd;
+ x = x.Cdr.prog();
+ for (i = 0; z instanceof Cell; i += 2, z = z.Cdr) {
+ w = z.Car.Car;
+ z.Car.Cdr = w.Car;
+ w.Car = bnd.Data[i];
+ }
+ Env.Bind = bnd.Link;
+ return x;
+ }
+
+ final static Any do51(Any ex) { // let
+ int i;
+ Any x, y, z;
+ Bind bnd;
+ bnd = new Bind();
+ if ((y = (x = ex.Cdr).Car) instanceof Symbol) {
+ bnd.add(y.Car);
+ bnd.add(y);
+ y.Car = (x = x.Cdr).Car.eval();
+ }
+ else {
+ do {
+ z = y.Car;
+ bnd.add(z.Car);
+ bnd.add(z);
+ z.Car = (y = y.Cdr).Car.eval();
+ } while ((y = y.Cdr) instanceof Cell);
+ }
+ Env.Bind = bnd;
+ x = x.Cdr.prog();
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+ }
+
+ final static Any do52(Any ex) { // let?
+ Any x, y, z;
+ Bind bnd;
+ z = (x = ex.Cdr).Car;
+ if ((y = (x = x.Cdr).Car.eval()) != Nil) {
+ (bnd = new Bind()).add(z.Car);
+ bnd.add(z);
+ z.Car = y;
+ Env.Bind = bnd;
+ y = x.Cdr.prog();
+ z.Car = bnd.Data[0];
+ }
+ return y;
+ }
+
+ final static Any do53(Any ex) { // use
+ int i;
+ Any x, y;
+ Bind bnd;
+ bnd = new Bind();
+ if ((y = (x = ex.Cdr).Car) instanceof Symbol) {
+ bnd.add(y.Car);
+ bnd.add(y);
+ }
+ else {
+ do {
+ bnd.add(y.Car.Car);
+ bnd.add(y.Car);
+ } while ((y = y.Cdr) instanceof Cell);
+ }
+ Env.Bind = bnd;
+ x = x.Cdr.prog();
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+ }
+
+ final static Any do54(Any ex) { // and
+ Any w;
+ ex = ex.Cdr;
+ do {
+ if ((w = ex.Car.eval()) == Nil)
+ return Nil;
+ At.Car = w;
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return w;
+ }
+
+ final static Any do55(Any ex) { // or
+ Any w;
+ ex = ex.Cdr;
+ do
+ if ((w = ex.Car.eval()) != Nil)
+ return At.Car = w;
+ while ((ex = ex.Cdr) instanceof Cell);
+ return Nil;
+ }
+
+ final static Any do56(Any ex) { // nand
+ Any w;
+ ex = ex.Cdr;
+ do {
+ if ((w = ex.Car.eval()) == Nil)
+ return T;
+ At.Car = w;
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return Nil;
+ }
+
+ final static Any do57(Any ex) { // nor
+ Any w;
+ ex = ex.Cdr;
+ do
+ if ((w = ex.Car.eval()) != Nil) {
+ At.Car = w;
+ return Nil;
+ }
+ while ((ex = ex.Cdr) instanceof Cell);
+ return T;
+ }
+
+ final static Any do58(Any ex) { // xor
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ x = x.Cdr.Car.eval();
+ return y == Nil ^ x == Nil? T : Nil;
+ }
+
+ final static Any do59(Any ex) { // bool
+ return ex.Cdr.Car.eval() == Nil? Nil : T;
+ }
+
+ final static Any do60(Any ex) { // not
+ Any w;
+ if ((w = ex.Cdr.Car.eval()) == Nil)
+ return T;
+ At.Car = w;
+ return Nil;
+ }
+
+ final static Any do61(Any ex) { // nil
+ ex.Cdr.prog();
+ return Nil;
+ }
+
+ final static Any do62(Any ex) { // t
+ ex.Cdr.prog();
+ return T;
+ }
+
+ final static Any do64(Any ex) { // prog1
+ Any w;
+ w = At.Car = ex.Cdr.Car.eval();
+ ex.Cdr.Cdr.prog();
+ return w;
+ }
+
+ final static Any do65(Any ex) { // prog2
+ Any w;
+ (ex = ex.Cdr).Car.eval();
+ w = At.Car = (ex = ex.Cdr).Car.eval();
+ ex.Cdr.prog();
+ return w;
+ }
+
+ final static Any do66(Any ex) { // if
+ Any w;
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil)
+ return ex.Cdr.Cdr.prog();
+ At.Car = w;
+ return ex.Cdr.Car.eval();
+ }
+
+ final static Any do67(Any ex) { // if2
+ Any w;
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil) {
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil)
+ return ex.Cdr.Cdr.Cdr.Cdr.prog();
+ At.Car = w;
+ return ex.Cdr.Cdr.Cdr.Car.eval();
+ }
+ At.Car = w;
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil)
+ return ex.Cdr.Cdr.Car.eval();
+ At.Car = w;
+ return ex.Cdr.Car.eval();
+ }
+
+ final static Any do68(Any ex) { // ifn
+ Any w;
+ if ((w = (ex = ex.Cdr).Car.eval()) != Nil) {
+ At.Car = w;
+ return ex.Cdr.Cdr.prog();
+ }
+ return ex.Cdr.Car.eval();
+ }
+
+ final static Any do69(Any ex) { // when
+ Any w;
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ At.Car = w;
+ return ex.Cdr.prog();
+ }
+
+ final static Any do70(Any ex) { // unless
+ Any w;
+ if ((w = (ex = ex.Cdr).Car.eval()) != Nil)
+ return Nil;
+ At.Car = w;
+ return ex.Cdr.prog();
+ }
+
+ final static Any do71(Any ex) { // cond
+ Any w;
+ while ((ex = ex.Cdr) instanceof Cell)
+ if ((w = ex.Car.Car.eval()) != Nil) {
+ At.Car = w;
+ return ex.Car.Cdr.prog();
+ }
+ return Nil;
+ }
+
+ final static Any do72(Any ex) { // nond
+ Any w;
+ while ((ex = ex.Cdr) instanceof Cell) {
+ if ((w = ex.Car.Car.eval()) == Nil)
+ return ex.Car.Cdr.prog();
+ At.Car = w;
+ }
+ return Nil;
+ }
+
+ final static Any do73(Any ex) { // case
+ Any x, y;
+ At.Car = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell) {
+ x = ex.Car; y = x.Car;
+ if (y == T || At.Car.equal(y))
+ return x.Cdr.prog();
+ if (y instanceof Cell) {
+ do
+ if (At.Car.equal(y.Car))
+ return x.Cdr.prog();
+ while ((y = y.Cdr) instanceof Cell);
+ }
+ }
+ return Nil;
+ }
+
+ final static Any do74(Any ex) { // state
+ Any w, x, y, z;
+ z = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell) {
+ y = x.Car;
+ if (y.Car == T || memq(z.Car, y.Car) != null) {
+ y = y.Cdr;
+ if ((w = y.Car.eval()) != Nil) {
+ At.Car = z.Car = w;
+ return y.Cdr.prog();
+ }
+ }
+ }
+ return Nil;
+ }
+
+ final static Any do75(Any ex) { // while
+ Any w, x, y;
+ x = (ex = ex.Cdr).Car;
+ ex = ex.Cdr;
+ y = Nil;
+ while ((w = x.eval()) != Nil) {
+ At.Car = w;
+ y = ex.prog();
+ }
+ return y;
+ }
+
+ final static Any do76(Any ex) { // until
+ Any w, x, y;
+ x = (ex = ex.Cdr).Car;
+ ex = ex.Cdr;
+ y = Nil;
+ while ((w = x.eval()) == Nil)
+ y = ex.prog();
+ At.Car = w;
+ return y;
+ }
+
+ final static Any do77(Any ex) { // do
+ long n;
+ Any w, x, y;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ if (!(x instanceof Number))
+ return loop(ex.Cdr);
+ for (ex = ex.Cdr, y = Nil, n = ((Number)x).longValue(); --n >= 0;) {
+ x = ex;
+ do {
+ if (!((y = x.Car) instanceof Cell))
+ y = y.eval();
+ else if (y.Car == Nil) {
+ if ((w = (y = y.Cdr).Car.eval()) == Nil)
+ return y.Cdr.prog();
+ At.Car = w;
+ y = Nil;
+ }
+ else if (y.Car == T) {
+ if ((w = (y = y.Cdr).Car.eval()) != Nil) {
+ At.Car = w;
+ return y.Cdr.prog();
+ }
+ y = Nil;
+ }
+ else
+ y = y.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ }
+ return y;
+ }
+
+ final static Any do79(Any ex) { // at
+ Any x;
+ Number num;
+ x = (ex = ex.Cdr).Car.eval();
+ if ((num = ((Number)x.Car).add(One)).compare((Number)x.Cdr) < 0) {
+ x.Car = num;
+ return Nil;
+ }
+ x.Car = Zero;
+ return ex.Cdr.prog();
+ }
+
+ final static Any do80(Any ex) { // for
+ int i;
+ Any w, x, y, z;
+ Bind bnd;
+ bnd = new Bind();
+ if (!((y = (ex = ex.Cdr).Car) instanceof Cell) || !(y.Cdr instanceof Cell)) {
+ if (!(y instanceof Cell)) {
+ bnd.add(y.Car);
+ bnd.add(y);
+ }
+ else {
+ bnd.add(y.Cdr.Car);
+ bnd.add(y.Cdr);
+ bnd.add((z = y.Car).Car);
+ bnd.add(z);
+ z.Car = Zero;
+ }
+ Env.Bind = bnd;
+ if ((z = (ex = ex.Cdr).Car.eval()) instanceof Number)
+ bnd.Data[1].Car = Zero;
+ for1:
+ for (y = Nil;;) {
+ if (z instanceof Number) {
+ if (((Number)(bnd.Data[1].Car = ((Number)bnd.Data[1].Car).add(One))).compare((Number)z) > 0)
+ break;
+ }
+ else {
+ if (!(z instanceof Cell))
+ break;
+ bnd.Data[1].Car = z.Car;
+ if (!((z = z.Cdr) instanceof Cell))
+ z = Nil;
+ }
+ if (bnd.Cnt == 4)
+ bnd.Data[3].Car = ((Number)bnd.Data[3].Car).add(One);
+ x = ex.Cdr;
+ do {
+ if (!((y = x.Car) instanceof Cell))
+ y = y.eval();
+ else if (y.Car == Nil) {
+ if ((w = (y = y.Cdr).Car.eval()) == Nil) {
+ y = y.Cdr.prog();
+ break for1;
+ }
+ At.Car = w;
+ y = Nil;
+ }
+ else if (y.Car == T) {
+ if ((w = (y = y.Cdr).Car.eval()) != Nil) {
+ At.Car = w;
+ y = y.Cdr.prog();
+ break for1;
+ }
+ y = Nil;
+ }
+ else
+ y = y.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ }
+ }
+ else {
+ if (!((z = y.Car) instanceof Cell)) {
+ bnd.add(z.Car);
+ bnd.add(z);
+ }
+ else {
+ bnd.add(z.Cdr.Car);
+ bnd.add(z.Cdr);
+ bnd.add((z = z.Car).Car);
+ bnd.add(z);
+ z.Car = Zero;
+ }
+ Env.Bind = bnd;
+ bnd.Data[1].Car = (y = y.Cdr).Car.eval();
+ z = y.Cdr;
+ for2:
+ for (y = Nil; (w = z.Car.eval()) != Nil;) {
+ At.Car = w;
+ if (bnd.Cnt == 4)
+ bnd.Data[3].Car = ((Number)bnd.Data[3].Car).add(One);
+ x = ex.Cdr;
+ do {
+ if (!((y = x.Car) instanceof Cell))
+ y = y.eval();
+ else if (y.Car == Nil) {
+ if ((w = (y = y.Cdr).Car.eval()) == Nil) {
+ y = y.Cdr.prog();
+ break for2;
+ }
+ At.Car = w;
+ y = Nil;
+ }
+ else if (y.Car == T) {
+ if ((w = (y = y.Cdr).Car.eval()) != Nil) {
+ At.Car = w;
+ y = y.Cdr.prog();
+ break for2;
+ }
+ y = Nil;
+ }
+ else
+ y = y.eval();
+ if (z.Cdr instanceof Cell)
+ bnd.Data[1].Car = z.Cdr.prog();
+ } while ((x = x.Cdr) instanceof Cell);
+ }
+ }
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return y;
+ }
+
+ final static Any do81(Any ex) { // catch
+ Any x, y;
+ new Catch(y = (x = ex.Cdr).Car.eval(), Zero, Env);
+ try {
+ x = x.Cdr.prog();
+ Catch = Catch.Link;
+ return x;
+ }
+ catch (Control e) {
+ if (y == e.Tag)
+ return e.Val;
+ throw e;
+ }
+ catch (RuntimeException e) {
+ if (y instanceof Cell && e.toString().indexOf(y.Car.name()) >= 0)
+ return y.Car;
+ throw e;
+ }
+ }
+
+ final static Any do82(Any ex) { // throw
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ throw new Control(ex, y, x.Cdr.Car.eval());
+ }
+
+ final static Any do83(Any ex) { // finally
+ Any x, y;
+ new Catch(null, y = (x = ex.Cdr).Car, Env);
+ x = x.Cdr.prog();
+ y.eval();
+ Catch = Catch.Link;
+ return x;
+ }
+
+ final static Any do84(Any ex) { // !
+ Any x;
+ x = ex.Cdr;
+ if (Dbg.Car != Nil)
+ x = brkLoad(x);
+ return x.eval();
+ }
+
+ final static Any do85(Any ex) { // e
+ Any w, x, y, z;
+ if (!Break)
+ err(ex, null, "No Break");
+ w = Dbg.Car; Dbg.Car = Nil;
+ x = At.Car; At.Car = Brk.Data[4];
+ y = Run.Car; Run.Car = Brk.Data[2];
+ InFrame in = Env.InFrames; Env.popInFiles();
+ OutFrame out = Env.OutFrames; Env.popOutFiles();
+ z = ex.Cdr instanceof Cell? ex.Cdr.prog() : Up.Car.eval();
+ OutFile.Wr.flush();
+ Env.pushOutFile(out);
+ Env.pushInFile(in);
+ Dbg.Car = w;
+ At.Car = x;
+ Run.Car = y;
+ return z;
+ }
+
+ final static Any do86(Any ex) { // $
+ int i;
+ Any x;
+ ex = ex.Cdr;
+ if (Dbg.Car == Nil)
+ return ex.Cdr.Cdr.prog();
+ trace(++Env.Trace, ex.Car, " :");
+ for (x = ex.Cdr.Car; x instanceof Cell; x = x.Cdr) {
+ StdErr.space();
+ StdErr.print(x.Car.Car);
+ }
+ if (x != Nil) {
+ if (x != At) {
+ StdErr.space();
+ StdErr.print(x.Car);
+ }
+ else
+ for (i = Env.Next; i < Env.ArgC; ++i) {
+ StdErr.space();
+ StdErr.print(Env.Args[i]);
+ }
+ }
+ StdErr.newline();
+ x = ex.Cdr.Cdr.prog();
+ trace(Env.Trace--, ex.Car, " = ");
+ StdErr.print(x);
+ StdErr.newline();
+ return x;
+ }
+
+ final static Any do87(Any ex) { // sys
+ return mkStr(System.getenv(evString(ex.Cdr)));
+ }
+
+ final static Any do88(Any ex) { // call
+ int i, j;
+ Any x;
+ j = (int)(x = ex.Cdr).length();
+ String[] cmd = new String[j];
+ for (i = 0; i < j; ++i) {
+ cmd[i] = x.Car.eval().name();
+ x = x.Cdr;
+ }
+ try {i = Runtime.getRuntime().exec(cmd).waitFor();}
+ catch (IOException e) {System.err.println(cmd[0] + ": Can't exec");}
+ catch (InterruptedException e) {} //#! sighandler()
+ return i == 0? T : Nil;
+ }
+
+ final static Any do89(Any ex) { // ipid
+ return Env.InFrames != null && Env.InFrames.Pid > 1? new Number(Env.InFrames.Pid) : Nil;
+ }
+
+ final static Any do90(Any ex) { // opid
+ return Env.OutFrames != null && Env.OutFrames.Pid > 1? new Number(Env.OutFrames.Pid) : Nil;
+ }
+
+ final static Any do91(Any ex) { // kill
+ int i;
+ if (Pids[i = evInt(ex = ex.Cdr)] == null)
+ return Nil;
+ if ((ex = ex.Cdr) instanceof Cell && evInt(ex) == 0)
+ return T;
+ Pids[i].destroy();
+ return T;
+ }
+
+ final static Any do92(Any ex) { // bye
+ Any x;
+ x = ex.Cdr.Car.eval();
+ return bye(x == Nil? 0 : ((Number)x).Cnt);
+ }
+
+ final static Any do93(Any ex) { // name
+ Any x, y;
+ Symbol s;
+ y = (x = ex.Cdr).Car.eval();
+ if (!((x = x.Cdr) instanceof Cell))
+ return mkStr(y.name());
+ if ((s = ((Symbol)y)).Name != null && Intern.get(s.Name) == s)
+ err(ex, s, "Can't rename");
+ ((Symbol)(x = x.Car.eval())).Name = s.Name;
+ return s;
+ }
+
+ final static Any do94(Any ex) { // sp?
+ return isBlank(ex.Cdr.Car.eval())? T : Nil;
+ }
+
+ final static Any do95(Any ex) { // pat?
+ Any x;
+ return ((x = ex.Cdr.Car.eval()) instanceof Symbol) && firstChar(x) == '@'? x : Nil;
+ }
+
+ final static Any do96(Any ex) { // fun?
+ return funq(ex.Cdr.Car.eval());
+ }
+
+ final static Any do97(Any ex) { // getd
+ Any x;
+ if (!((x = ex.Cdr.Car.eval()) instanceof Symbol))
+ return Nil;
+ return funq(x.Car) != Nil? x.Car : Nil; // ... reflection
+ }
+
+ final static Any do98(Any ex) { // all
+ return all(ex.Cdr.Car.eval() == Nil? Intern : Transient);
+ }
+
+ final static Any do99(Any ex) { // intern
+ Symbol s, t;
+ String str;
+ s = (Symbol)ex.Cdr.Car.eval();
+ if ((str = s.name()).length() == 0 || str.equals("NIL"))
+ return Nil;
+ if ((t = Intern.get(str)) != null)
+ return t;
+ Intern.put(str, s);
+ return s;
+ }
+
+ final static Any do100(Any ex) { // ====
+ Any x, y;
+ 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;
+ }
+
+ final static Any do101(Any ex) { // box?
+ Any x;
+ return ((x = ex.Cdr.Car.eval()) instanceof Symbol) && x.name().length() == 0? x : Nil;
+ }
+
+ final static Any do102(Any ex) { // str?
+ Any x;
+ return ((x = ex.Cdr.Car.eval()) instanceof Symbol) && Intern.get(x.name()) == null? x : Nil;
+ }
+
+ final static Any do103(Any ex) { // zap
+ Symbol s;
+ s = (Symbol)ex.Cdr.Car.eval();
+ Intern.remove(s.name());
+ return s;
+ }
+
+ final static Any do104(Any ex) { // chop
+ Any x, y;
+ String str;
+ x = ex.Cdr.Car.eval();
+ if (!(x instanceof Cell)) {
+ str = x.name();
+ if (str.length() == 0)
+ return Nil;
+ y = x = new Cell(mkChar(str.charAt(0)), Nil);
+ for (int i = 1; i < str.length(); ++i)
+ y = y.Cdr = new Cell(mkChar(str.charAt(i)), Nil);
+ }
+ return x;
+ }
+
+ final static Any do105(Any ex) { // pack
+ StringBuilder sb;
+ sb = new StringBuilder();
+ for (ex = ex.Cdr; ex instanceof Cell; ex = ex.Cdr)
+ sb.append(evString(ex));
+ return mkStr(sb);
+ }
+
+ final static Any do106(Any ex) { // glue
+ Any x, y;
+ StringBuilder sb;
+ x = ex.Cdr.Car.eval();
+ if (!((y = ex.Cdr.Cdr.Car.eval()) instanceof Cell))
+ return y;
+ for (sb = new StringBuilder(), sb.append(y.Car.name()); (y = y.Cdr) instanceof Cell;) {
+ sb.append(x.name());
+ sb.append(y.Car.name());
+ }
+ return mkStr(sb);
+ }
+
+ final static Any do107(Any ex) { // text
+ int i, j, k;
+ char c;
+ String str;
+ StringBuilder sb;
+ Any[] v;
+ str = evString(ex = ex.Cdr);
+ v = new Any[6];
+ i = 0;
+ while ((ex = ex.Cdr) instanceof Cell)
+ v = append(v, i++, ex.Car.eval());
+ sb = new StringBuilder();
+ k = str.length();
+ for (j = 0; j < k; ++j)
+ if ((c = str.charAt(j)) != '@')
+ sb.append(c);
+ else if (++j == k)
+ break;
+ else if ((c = str.charAt(j)) == '@')
+ sb.append('@');
+ else if (c >= '1') {
+ if ((c -= '1') > 8)
+ c -= 7;
+ if (i > c)
+ sb.append(v[c].name());
+ }
+ return mkStr(sb);
+ }
+
+ final static Any do108(Any ex) { // pre?
+ Any x;
+ String str;
+ str = evString(ex = ex.Cdr);
+ return (x = ex.Cdr.Car.eval()).name().startsWith(str)? x : Nil;
+ }
+
+ final static Any do109(Any ex) { // sub?
+ Any x;
+ String str;
+ str = evString(ex = ex.Cdr);
+ return (x = ex.Cdr.Car.eval()).name().indexOf(str) >= 0? x : Nil;
+ }
+
+ final static Any do111(Any ex) { // set
+ Any x, y;
+ x = ex.Cdr;
+ do {
+ y = x.Car.eval();
+ needVar(ex, y);
+ y.Car = (x = x.Cdr).Car.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ return y.Car;
+ }
+
+ final static Any do112(Any ex) { // setq
+ Any x, y;
+ x = ex.Cdr;
+ do {
+ y = x.Car;
+ needVar(ex, y);
+ y.Car = (x = x.Cdr).Car.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ return y.Car;
+ }
+
+ final static Any do113(Any ex) { // xchg
+ Any w, x, y, z;
+ x = ex.Cdr;
+ do {
+ needVar(ex, y = x.Car.eval());
+ needVar(ex, z = (x = x.Cdr).Car.eval());
+ w = y.Car; y.Car = z.Car; z.Car = w;
+ } while ((x = x.Cdr) instanceof Cell);
+ return w;
+ }
+
+ final static Any do114(Any ex) { // on
+ Any x;
+ x = ex.Cdr;
+ do
+ x.Car.Car = T;
+ while ((x = x.Cdr) instanceof Cell);
+ return T;
+ }
+
+ final static Any do115(Any ex) { // off
+ Any x;
+ x = ex.Cdr;
+ do
+ x.Car.Car = Nil;
+ while ((x = x.Cdr) instanceof Cell);
+ return Nil;
+ }
+
+ final static Any do116(Any ex) { // onOff
+ Any x, y;
+ x = ex.Cdr;
+ do
+ y = x.Car.Car = x.Car.Car == Nil? T : Nil;
+ while ((x = x.Cdr) instanceof Cell);
+ return y;
+ }
+
+ final static Any do117(Any ex) { // zero
+ Any x;
+ x = ex.Cdr;
+ do
+ x.Car.Car = Zero;
+ while ((x = x.Cdr) instanceof Cell);
+ return Zero;
+ }
+
+ final static Any do118(Any ex) { // one
+ Any x;
+ x = ex.Cdr;
+ do
+ x.Car.Car = One;
+ while ((x = x.Cdr) instanceof Cell);
+ return One;
+ }
+
+ final static Any do119(Any ex) { // default
+ Any x, y;
+ x = ex.Cdr;
+ do {
+ y = x.Car;
+ x = x.Cdr;
+ needVar(ex, y);
+ if (y.Car == Nil)
+ y.Car = x.Car.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ return y.Car;
+ }
+
+ final static Any do120(Any ex) { // push
+ Any x, y, z;
+ needVar(ex, y = (x = ex.Cdr).Car.eval());
+ do
+ y.Car = new Cell(z = (x = x.Cdr).Car.eval(), y.Car);
+ while (x.Cdr instanceof Cell);
+ return z;
+ }
+
+ final static Any do121(Any ex) { // push1
+ Any x, y, z;
+ needVar(ex, y = (x = ex.Cdr).Car.eval());
+ do
+ if (member(z = (x = x.Cdr).Car.eval(), y.Car) == null)
+ y.Car = new Cell(z, y.Car);
+ while (x.Cdr instanceof Cell);
+ return z;
+ }
+
+ final static Any do122(Any ex) { // pop
+ Any x, y;
+ needVar(ex, x = ex.Cdr.Car.eval());
+ if ((y = x.Car) instanceof Cell) {
+ x.Car = x.Car.Cdr;
+ y = y.Car;
+ }
+ return y;
+ }
+
+ final static Any do123(Any ex) { // cut
+ long n;
+ Any x, y, z;
+ if ((n = evLong(ex.Cdr)) <= 0)
+ return Nil;
+ needVar(ex, x = ex.Cdr.Cdr.Car.eval());
+ if (x.Car instanceof Cell) {
+ z = y = new Cell(x.Car.Car, Nil);
+ while ((x.Car = x.Car.Cdr) instanceof Cell && --n != 0)
+ y = y.Cdr = new Cell(x.Car.Car, Nil);
+ return z;
+ }
+ return x.Car;
+ }
+
+ final static Any do124(Any ex) { // del
+ Any w, lst, x, y, z;
+ w = ex.Cdr.Car.eval();
+ needVar(ex, x = ex.Cdr.Cdr.Car.eval());
+ if ((lst = x.Car) instanceof Cell) {
+ if (w.equal(lst.Car))
+ return x.Car = lst.Cdr;
+ for (z = y = new Cell(lst.Car, Nil); (lst = lst.Cdr) instanceof Cell; y = y.Cdr = new Cell(lst.Car, Nil))
+ if (w.equal(lst.Car)) {
+ y.Cdr = lst.Cdr;
+ return x.Car = z;
+ }
+ }
+ return x.Car;
+ }
+
+ final static Any do125(Any ex) { // queue
+ Any x, y;
+ needVar(ex, x = ex.Cdr.Car.eval());
+ y = ex.Cdr.Cdr.Car.eval();
+ if (!(x.Car instanceof Cell))
+ x.Car = new Cell(y, Nil);
+ else {
+ for (x = x.Car; x.Cdr instanceof Cell; x = x.Cdr);
+ x.Cdr = new Cell(y, Nil);
+ }
+ return y;
+ }
+
+ final static Any do126(Any ex) { // fifo
+ Any x, y, z, lst;
+ needVar(ex, y = (x = ex.Cdr).Car.eval());
+ if ((x = x.Cdr) instanceof Cell) {
+ z = x.Car.eval();
+ if ((lst = y.Car) instanceof Cell)
+ y.Car = lst = lst.Cdr = new Cell(z, lst.Cdr);
+ else {
+ lst = y.Car = new Cell(z, Nil);
+ lst.Cdr = lst;
+ }
+ while ((x = x.Cdr) instanceof Cell)
+ y.Car = lst = lst.Cdr = new Cell(z = x.Car.eval(), lst.Cdr);
+ return z;
+ }
+ if (!((lst = y.Car) instanceof Cell))
+ return Nil;
+ if (lst == lst.Cdr) {
+ z = lst.Car;
+ y.Car = Nil;
+ }
+ else {
+ z = lst.Cdr.Car;
+ lst.Cdr = lst.Cdr.Cdr;
+ }
+ return z;
+ }
+
+ final static Any do127(Any ex) { // idx
+ Any x, y;
+ needVar(ex, x = (ex = ex.Cdr).Car.eval());
+ if (!((ex = ex.Cdr) instanceof Cell))
+ return idx(x, null, 0);
+ y = ex.Car.eval();
+ return idx(x, y, ex.Cdr instanceof Cell? (ex.Cdr.Car.eval() == Nil? -1 : +1) : 0);
+ }
+
+ final static Any do128(Any ex) { // lup
+ int i;
+ Any x, y, z;
+ x = (ex = ex.Cdr).Car.eval();
+ y = (ex = ex.Cdr).Car.eval();
+ if ((z = ex.Cdr.Car.eval()) != Nil)
+ return consLup(x, Nil, y, z);
+ while (x instanceof Cell) {
+ if (x.Car == T)
+ x = x.Cdr.Car;
+ else if (!(x.Car instanceof Cell))
+ x = x.Cdr.Cdr;
+ else if ((i = y.compare(x.Car.Car)) == 0)
+ return x.Car;
+ else
+ x = i < 0? x.Cdr.Car : x.Cdr.Cdr;
+ }
+ return Nil;
+ }
+
+ final static Any do129(Any ex) { // put
+ Any x, y;
+ x = (ex = ex.Cdr).Car.eval();
+ for (;;) {
+ y = (ex = ex.Cdr).Car.eval();
+ if (!(ex.Cdr.Cdr instanceof Cell))
+ return x.put(y, ex.Cdr.Car.eval());
+ x = x.get(y);
+ }
+ }
+
+ final static Any do130(Any ex) { // get
+ Any x;
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.get(ex.Car.eval());
+ return x;
+ }
+
+ final static Any do131(Any ex) { // prop
+ Any x;
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr).Cdr instanceof Cell)
+ x = x.get(ex.Car.eval());
+ return x.prop(ex.Car.eval());
+ }
+
+ final static Any do132(Any ex) { // ;
+ Any x;
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.get(ex.Car);
+ return x;
+ }
+
+ final static Any do133(Any ex) { // =:
+ Any x, y;
+ for (x = This.Car;;) {
+ y = (ex = ex.Cdr).Car;
+ if (!(ex.Cdr.Cdr instanceof Cell))
+ return x.put(y, ex.Cdr.Car.eval());
+ x = x.get(y);
+ }
+ }
+
+ final static Any do134(Any ex) { // :
+ Any x;
+ x = This.Car;
+ do
+ x = x.get((ex = ex.Cdr).Car);
+ while (ex.Cdr instanceof Cell);
+ return x;
+ }
+
+ final static Any do135(Any ex) { // ::
+ Any x;
+ x = This.Car;
+ while ((ex = ex.Cdr).Cdr instanceof Cell)
+ x = x.get(ex.Car);
+ return x.prop(ex.Car);
+ }
+
+ final static Any do136(Any ex) { // putl
+ Any x;
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr).Cdr instanceof Cell)
+ x = x.get(ex.Car.eval());
+ return x.putl(ex.Car.eval());
+ }
+
+ final static Any do137(Any ex) { // getl
+ Any x;
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.get(ex.Car.eval());
+ return x.getl();
+ }
+
+ final static Any do138(Any ex) { // meta
+ Any x, y;
+ if ((x = (ex = ex.Cdr).Car.eval()) instanceof Symbol)
+ x = x.Car;
+ for (x = meta(x, (ex = ex.Cdr).Car.eval()); (ex = ex.Cdr) instanceof Cell;)
+ x = x.get(ex.Car.eval());
+ return x;
+ }
+
+ final static Any do139(Any ex) { // low?
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Symbol && Character.isLowerCase(firstChar(x))? x : Nil;
+ }
+
+ final static Any do140(Any ex) { // upp?
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Symbol && Character.isUpperCase(firstChar(x))? x : Nil;
+ }
+
+ final static Any do141(Any ex) { // lowc
+ int i, j;
+ Any x;
+ String str;
+ StringBuilder sb;
+ if (!((x = ex.Cdr.Car.eval()) instanceof Symbol) || (j = (str = x.name()).length()) == 0)
+ return x;
+ sb = new StringBuilder();
+ for (i = 0; i < j; ++i)
+ sb.append(Character.toLowerCase(str.charAt(i)));
+ return mkStr(sb);
+ }
+
+ final static Any do142(Any ex) { // uppc
+ int i, j;
+ Any x;
+ String str;
+ StringBuilder sb;
+ if (!((x = ex.Cdr.Car.eval()) instanceof Symbol) || (j = (str = x.name()).length()) == 0)
+ return x;
+ sb = new StringBuilder();
+ for (i = 0; i < j; ++i)
+ sb.append(Character.toUpperCase(str.charAt(i)));
+ return mkStr(sb);
+ }
+
+ final static Any do143(Any ex) { // fold
+ int i, j, k;
+ char c;
+ Any x;
+ String str;
+ StringBuilder sb;
+ if (!((x = (ex = ex.Cdr).Car.eval()) instanceof Symbol) || (j = (str = x.name()).length()) == 0)
+ return x;
+ for (i = 0; !Character.isLetterOrDigit(c = str.charAt(i));)
+ if (++i == j)
+ return Nil;
+ k = (ex = ex.Cdr) instanceof Cell? evInt(ex) : 24;
+ sb = new StringBuilder();
+ sb.append(Character.toLowerCase(c));
+ while (++i < j)
+ if (Character.isLetterOrDigit(c = str.charAt(i))) {
+ if (--k == 0)
+ break;
+ sb.append(Character.toLowerCase(c));
+ }
+ return mkStr(sb);
+ }
+
+ final static Any do150(Any ex) { // caaar
+ return ex.Cdr.Car.eval().Car.Car.Car;
+ }
+
+ final static Any do151(Any ex) { // caadr
+ return ex.Cdr.Car.eval().Cdr.Car.Car;
+ }
+
+ final static Any do152(Any ex) { // cadar
+ return ex.Cdr.Car.eval().Car.Cdr.Car;
+ }
+
+ final static Any do153(Any ex) { // caddr
+ return ex.Cdr.Car.eval().Cdr.Cdr.Car;
+ }
+
+ final static Any do154(Any ex) { // cdaar
+ return ex.Cdr.Car.eval().Car.Car.Cdr;
+ }
+
+ final static Any do155(Any ex) { // cdadr
+ return ex.Cdr.Car.eval().Cdr.Car.Cdr;
+ }
+
+ final static Any do156(Any ex) { // cddar
+ return ex.Cdr.Car.eval().Car.Cdr.Cdr;
+ }
+
+ final static Any do157(Any ex) { // cdddr
+ return ex.Cdr.Car.eval().Cdr.Cdr.Cdr;
+ }
+
+ final static Any do158(Any ex) { // caaaar
+ return ex.Cdr.Car.eval().Car.Car.Car.Car;
+ }
+
+ final static Any do159(Any ex) { // caaadr
+ return ex.Cdr.Car.eval().Cdr.Car.Car.Car;
+ }
+
+ final static Any do160(Any ex) { // caadar
+ return ex.Cdr.Car.eval().Car.Cdr.Car.Car;
+ }
+
+ final static Any do161(Any ex) { // caaddr
+ return ex.Cdr.Car.eval().Cdr.Cdr.Car.Car;
+ }
+
+ final static Any do162(Any ex) { // cadaar
+ return ex.Cdr.Car.eval().Car.Car.Cdr.Car;
+ }
+
+ final static Any do163(Any ex) { // cadadr
+ return ex.Cdr.Car.eval().Cdr.Car.Cdr.Car;
+ }
+
+ final static Any do164(Any ex) { // caddar
+ return ex.Cdr.Car.eval().Car.Cdr.Cdr.Car;
+ }
+
+ final static Any do165(Any ex) { // cadddr
+ return ex.Cdr.Car.eval().Cdr.Cdr.Cdr.Car;
+ }
+
+ final static Any do166(Any ex) { // cdaaar
+ return ex.Cdr.Car.eval().Car.Car.Car.Cdr;
+ }
+
+ final static Any do167(Any ex) { // cdaadr
+ return ex.Cdr.Car.eval().Cdr.Car.Car.Cdr;
+ }
+
+ final static Any do168(Any ex) { // cdadar
+ return ex.Cdr.Car.eval().Car.Cdr.Car.Cdr;
+ }
+
+ final static Any do169(Any ex) { // cdaddr
+ return ex.Cdr.Car.eval().Cdr.Cdr.Car.Cdr;
+ }
+
+ final static Any do170(Any ex) { // cddaar
+ return ex.Cdr.Car.eval().Car.Car.Cdr.Cdr;
+ }
+
+ final static Any do171(Any ex) { // cddadr
+ return ex.Cdr.Car.eval().Cdr.Car.Cdr.Cdr;
+ }
+
+ final static Any do172(Any ex) { // cdddar
+ return ex.Cdr.Car.eval().Car.Cdr.Cdr.Cdr;
+ }
+
+ final static Any do173(Any ex) { // cddddr
+ return ex.Cdr.Car.eval().Cdr.Cdr.Cdr.Cdr;
+ }
+
+ final static Any do174(Any ex) { // nth
+ Any x;
+ x = (ex = ex.Cdr).Car.eval();
+ for (;;) {
+ if (!(x instanceof Cell))
+ return x;
+ x = nth(evInt(ex = ex.Cdr), x);
+ if (ex.Cdr == Nil)
+ return x;
+ x = x.Car;
+ }
+ }
+
+ final static Any do175(Any ex) { // con
+ Any x;
+ x = ex.Cdr.Car.eval();
+ return x.Cdr = ex.Cdr.Cdr.Car.eval();
+ }
+
+ final static Any do176(Any ex) { // cons
+ Any x, y;
+ y = x = new Cell((ex = ex.Cdr).Car.eval(), Nil);
+ while ((ex = ex.Cdr).Cdr instanceof Cell)
+ x = x.Cdr = new Cell(ex.Car.eval(), Nil);
+ x.Cdr = ex.Car.eval();
+ return y;
+ }
+
+ final static Any do177(Any ex) { // conc
+ Any x, y, z;
+ z = x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell) {
+ if (!(x instanceof Cell))
+ z = x = ex.Car.eval();
+ else {
+ while ((y = x.Cdr) instanceof Cell)
+ x = y;
+ x.Cdr = ex.Car.eval();
+ }
+ }
+ return z;
+ }
+
+ final static Any do178(Any ex) { // circ
+ Any x, y;
+ y = x = new Cell((ex = ex.Cdr).Car.eval(), Nil);
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.Cdr = new Cell(ex.Car.eval(), Nil);
+ x.Cdr = y;
+ return y;
+ }
+
+ final static Any do179(Any ex) { // rot
+ int i;
+ Any w, x, y, z;
+ w = y = (ex = ex.Cdr).Car.eval();
+ if (w instanceof Cell) {
+ i = ex.Cdr == Nil? 0 : evInt(ex.Cdr);
+ x = y.Car;
+ while (--i != 0 && (y = y.Cdr) instanceof Cell && y != w) {
+ z = y.Car; y.Car = x; x = z;
+ }
+ w.Car = x;
+ }
+ return w;
+ }
+
+ final static Any do180(Any ex) { // list
+ Any x, y;
+ x = y = new Cell((ex = ex.Cdr).Car.eval(), Nil);
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.Cdr = new Cell(ex.Car.eval(), Nil);
+ return y;
+ }
+
+ final static Any do181(Any ex) { // need
+ long n;
+ Any x, y, z;
+ n = evLong(ex = ex.Cdr);
+ z = (ex = ex.Cdr).Car.eval();
+ y = ex.Cdr.Car.eval();
+ x = z;
+ if (n > 0)
+ for (n -= x.length(); n > 0; --n)
+ z = new Cell(y,z);
+ else if (n != 0) {
+ if (!(x instanceof Cell))
+ z = x = new Cell(y,Nil);
+ else
+ while (x.Cdr instanceof Cell) {
+ ++n; x = x.Cdr;
+ }
+ while (++n < 0)
+ x = x.Cdr = new Cell(y,Nil);
+ }
+ return z;
+ }
+
+ final static Any do182(Any ex) { // range
+ Any x, y;
+ Number num;
+ num = (Number)(y = (x = ex.Cdr).Car.eval());
+ Number end = (Number)(x = x.Cdr).Car.eval();
+ Number inc = (x = x.Cdr.Car.eval()) == Nil? One : (Number)x;
+ x = y = new Cell(y, Nil);
+ if (end.compare(num) >= 0)
+ while (end.compare(num = num.add(inc)) >= 0)
+ x = x.Cdr = new Cell(num, Nil);
+ else
+ while (end.compare(num = num.sub(inc)) <= 0)
+ x = x.Cdr = new Cell(num, Nil);
+ return y;
+ }
+
+ final static Any do183(Any ex) { // full
+ Any x;
+ for (x = ex.Cdr.Car.eval(); x instanceof Cell; x = x.Cdr)
+ if (x.Car == Nil)
+ return Nil;
+ return T;
+ }
+
+ final static Any do184(Any ex) { // make
+ Any x, y, z;
+ x = Env.Make; Env.Make = Nil;
+ y = Env.Yoke; Env.Yoke = Nil;
+ ex.Cdr.prog();
+ z = Env.Yoke;
+ Env.Yoke = y;
+ Env.Make = x;
+ return z;
+ }
+
+ final static Any do185(Any ex) { // made
+ Any x;
+ if ((x = ex.Cdr) instanceof Cell) {
+ Env.Yoke = x.Car.eval();
+ x = x.Cdr;
+ if (!((x = x.Car.eval()) instanceof Cell))
+ for (x = Env.Yoke; (x = x.Cdr).Cdr instanceof Cell;);
+ Env.Make = x;
+ }
+ return Env.Yoke;
+ }
+
+ final static Any do186(Any ex) { // chain
+ Any x, y;
+ ex = ex.Cdr;
+ do {
+ x = ex.Car.eval();
+ if (Env.Make != Nil)
+ Env.Make = Env.Make.Cdr = x;
+ else
+ Env.Yoke = Env.Make = x;
+ while ((y = Env.Make.Cdr) instanceof Cell)
+ Env.Make = y;
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return x;
+ }
+
+ final static Any do187(Any ex) { // link
+ Any x;
+ ex = ex.Cdr;
+ do {
+ x = ex.Car.eval();
+ if (Env.Make != Nil)
+ Env.Make = Env.Make.Cdr = new Cell(x, Nil);
+ else
+ Env.Yoke = Env.Make = new Cell(x, Nil);
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return x;
+ }
+
+ final static Any do188(Any ex) { // yoke
+ Any x;
+ ex = ex.Cdr;
+ do {
+ x = ex.Car.eval();
+ Env.Yoke = new Cell(x, Env.Yoke);
+ if (Env.Make == Nil)
+ Env.Make = Env.Yoke;
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return x;
+ }
+
+ final static Any do189(Any ex) { // copy
+ Any w, x, y, z;
+ if (!((x = ex.Cdr.Car.eval()) instanceof Cell))
+ return x;
+ for (w = y = new Cell(x.Car, (z = x).Cdr); (x = y.Cdr) instanceof Cell; y = y.Cdr = new Cell(x.Car, x.Cdr))
+ if (x == z) {
+ y.Cdr = w;
+ break;
+ }
+ return w;
+ }
+
+ final static Any do190(Any ex) { // mix
+ Any x, y, z;
+ if (!((y = (ex = ex.Cdr).Car.eval()) instanceof Cell) && y != Nil)
+ return y;
+ if (!((ex = ex.Cdr) instanceof Cell))
+ return Nil;
+ z = x = new Cell(ex.Car instanceof Number? nth(xInt(ex.Car), y).Car : ex.Car.eval(), Nil);
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.Cdr = new Cell(ex.Car instanceof Number? nth(xInt(ex.Car), y).Car : ex.Car.eval(), Nil);
+ return z;
+ }
+
+ final static Any do191(Any ex) { // append
+ Any x, y, z;
+ for (ex = ex.Cdr; (z = ex.Cdr) instanceof Cell; ex = z) {
+ if ((x = ex.Car.eval()) instanceof Cell) {
+ z = y = new Cell(x.Car, x.Cdr);
+ while ((x = y.Cdr) instanceof Cell)
+ y = y.Cdr = new Cell(x.Car, x.Cdr);
+ while ((ex = ex.Cdr).Cdr instanceof Cell) {
+ for (x = ex.Car.eval(); x instanceof Cell; x = y.Cdr)
+ y = y.Cdr = new Cell(x.Car, x.Cdr);
+ y.Cdr = x;
+ }
+ y.Cdr = ex.Car.eval();
+ return z;
+ }
+ }
+ return ex.Car.eval();
+ }
+
+ final static Any do192(Any ex) { // delete
+ Any w, x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ if (!((x = x.Cdr.Car.eval()) instanceof Cell))
+ return x;
+ if (y.equal(x.Car))
+ return x.Cdr;
+ w = z = new Cell(x.Car, Nil);
+ while ((x = x.Cdr) instanceof Cell) {
+ if (y.equal(x.Car)) {
+ z.Cdr = x.Cdr;
+ return w;
+ }
+ z = z.Cdr = new Cell(x.Car, Nil);
+ }
+ z.Cdr = x;
+ return w;
+ }
+
+ final static Any do193(Any ex) { // delq
+ Any w, x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ if (!((x = x.Cdr.Car.eval()) instanceof Cell))
+ return x;
+ if (y == x.Car)
+ return x.Cdr;
+ w = z = new Cell(x.Car, Nil);
+ while ((x = x.Cdr) instanceof Cell) {
+ if (y == x.Car) {
+ z.Cdr = x.Cdr;
+ return w;
+ }
+ z = z.Cdr = new Cell(x.Car, Nil);
+ }
+ z.Cdr = x;
+ return w;
+ }
+
+ final static Any do194(Any ex) { // replace
+ int i, j;
+ Any w, x, y, z;
+ Any[] v;
+ if (!((y = (x = ex.Cdr).Car.eval()) instanceof Cell))
+ return y;
+ for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell; ++i)
+ v = append(v, i, x.Car.eval());
+ for (x = y.Car, j = 0; j < i; j += 2)
+ if (x.equal(v[j])) {
+ x = v[j+1];
+ break;
+ }
+ for (w = z = new Cell(x, Nil); (y = y.Cdr) instanceof Cell; z = z.Cdr = new Cell(x, Nil))
+ for (x = y.Car, j = 0; j < i; j += 2)
+ if (x.equal(v[j])) {
+ x = v[j+1];
+ break;
+ }
+ z.Cdr = y;
+ return w;
+ }
+
+ final static Any do195(Any ex) { // strip
+ Any x;
+ for (x = ex.Cdr.Car.eval(); x instanceof Cell && x.Car == Quote && x != x.Cdr; x = x.Cdr);
+ return x;
+ }
+
+ final static Any do196(Any ex) { // split
+ int i, j;
+ Any x, y, z;
+ Any[] v;
+ if (!((z = (x = ex.Cdr).Car.eval()) instanceof Cell))
+ return z;
+ for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell; ++i)
+ v = append(v, i, x.Car.eval());
+ Any res = x = Nil;
+ Any sub = y = Nil;
+ spl:
+ do {
+ for (j = 0; j < i; ++j) {
+ if (z.Car.equal(v[j])) {
+ if (x == Nil)
+ x = res = new Cell(sub, Nil);
+ else
+ x = x.Cdr = new Cell(sub, Nil);
+ y = sub = Nil;
+ continue spl;
+ }
+ }
+ if (y == Nil)
+ y = sub = new Cell(z.Car, Nil);
+ else
+ y = y.Cdr = new Cell(z.Car, Nil);
+ } while ((z = z.Cdr) instanceof Cell);
+ y = new Cell(sub, Nil);
+ if (x == Nil)
+ return y;
+ x.Cdr = y;
+ return res;
+ }
+
+ final static Any do197(Any ex) { // reverse
+ Any x, y;
+ x = ex.Cdr.Car.eval();
+ for (y = Nil; x instanceof Cell; x = x.Cdr)
+ y = new Cell(x.Car, y);
+ return y;
+ }
+
+ final static Any do198(Any ex) { // flip
+ int i;
+ Any x, y, z;
+ if (!((y = (ex = ex.Cdr).Car.eval()) instanceof Cell) || !((z = y.Cdr) instanceof Cell))
+ return y;
+ if (ex.Cdr == Nil) {
+ y.Cdr = Nil;
+ for (;;) {
+ x = z.Cdr; z.Cdr = y;
+ if (!(x instanceof Cell))
+ return z;
+ y = z; z = x;
+ }
+ }
+ if ((i = evInt(ex.Cdr) - 1) <= 0)
+ return y;
+ y.Cdr = z.Cdr; z.Cdr = y;
+ while (--i != 0 && (x = y.Cdr) instanceof Cell) {
+ y.Cdr = x.Cdr; x.Cdr = z; z = x;
+ }
+ return z;
+ }
+
+ final static Any do199(Any ex) { // trim
+ return trim(ex.Cdr.Car.eval());
+ }
+
+ final static Any do200(Any ex) { // clip
+ Any x;
+ for (x = ex.Cdr.Car.eval(); x instanceof Cell && isBlank(x.Car); x = x.Cdr);
+ return trim(x);
+ }
+
+ final static Any do201(Any ex) { // head
+ int i;
+ Any x, y, z;
+ if ((z = (x = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ x = x.Cdr.Car.eval();
+ if (z instanceof Cell) {
+ if (x instanceof Cell) {
+ for (y = z; y.Car.equal(x.Car); x = x.Cdr)
+ if (!((y = y.Cdr) instanceof Cell))
+ return z;
+ }
+ return Nil;
+ }
+ if ((i = xInt(z)) == 0)
+ return Nil;
+ if (!(x instanceof Cell))
+ return x;
+ if (i < 0 && (i += x.length()) <= 0)
+ return Nil;
+ z = y = new Cell(x.Car, Nil);
+ while (--i != 0 && (x = x.Cdr) instanceof Cell)
+ y = y.Cdr = new Cell(x.Car, Nil);
+ return z;
+ }
+
+ final static Any do202(Any ex) { // tail
+ int i;
+ Any x, y, z;
+ if ((z = (x = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ x = x.Cdr.Car.eval();
+ if (z instanceof Cell) {
+ if (x instanceof Cell) {
+ do
+ if (x.equal(z))
+ return z;
+ while ((x = x.Cdr) instanceof Cell);
+ }
+ return Nil;
+ }
+ if ((i = xInt(z)) == 0)
+ return Nil;
+ if (!(x instanceof Cell))
+ return x;
+ if (i < 0)
+ return nth(1 - i, x);
+ for (y = x.Cdr; --i != 0; y = y.Cdr)
+ if (!(y instanceof Cell))
+ return x;
+ while (y instanceof Cell) {
+ x = x.Cdr; y = y.Cdr;
+ }
+ return x;
+ }
+
+ final static Any do203(Any ex) { // stem
+ int i, j;
+ Any x, y;
+ Any[] v;
+ y = (x = ex.Cdr).Car.eval();
+ for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell; ++i)
+ v = append(v, i, x.Car.eval());
+ for (x = y; x instanceof Cell; x = x.Cdr)
+ for (j = 0; j < i; ++j)
+ if (x.Car.equal(v[j])) {
+ y = x.Cdr;
+ break;
+ }
+ return y;
+ }
+
+ final static Any do204(Any ex) { // fin
+ Any x;
+ for (x = ex.Cdr.Car.eval(); x instanceof Cell; x = x.Cdr);
+ return x;
+ }
+
+ final static Any do205(Any ex) { // last
+ Any x;
+ if (!((x = ex.Cdr.Car.eval()) instanceof Cell))
+ return x;
+ while (x.Cdr instanceof Cell)
+ x = x.Cdr;
+ return x.Car;
+ }
+
+ final static Any do206(Any ex) { // ==
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell)
+ if (y != x.Car.eval())
+ return Nil;
+ return T;
+ }
+
+ final static Any do207(Any ex) { // n==
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell)
+ if (y != x.Car.eval())
+ return T;
+ return Nil;
+ }
+
+ final static Any do208(Any ex) { // =
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell)
+ if (!y.equal(x.Car.eval()))
+ return Nil;
+ return T;
+ }
+
+ final static Any do209(Any ex) { // <>
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell)
+ if (!y.equal(x.Car.eval()))
+ return T;
+ return Nil;
+ }
+
+ final static Any do210(Any ex) { // =0
+ Any x;
+ return ex.Cdr.Car.eval().equal(Zero)? Zero : Nil;
+ }
+
+ final static Any do211(Any ex) { // =T
+ return T == ex.Cdr.Car.eval()? T : Nil;
+ }
+
+ final static Any do212(Any ex) { // n0
+ return ex.Cdr.Car.eval().equal(Zero)? Nil : T;
+ }
+
+ final static Any do213(Any ex) { // nT
+ return T == ex.Cdr.Car.eval()? Nil : T;
+ }
+
+ final static Any do214(Any ex) { // <
+ Any x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell) {
+ z = x.Car.eval();
+ if (y.compare(z) >= 0)
+ return Nil;
+ y = z;
+ }
+ return T;
+ }
+
+ final static Any do215(Any ex) { // <=
+ Any x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell) {
+ z = x.Car.eval();
+ if (y.compare(z) > 0)
+ return Nil;
+ y = z;
+ }
+ return T;
+ }
+
+ final static Any do216(Any ex) { // >
+ Any x, y;
+ x = (ex = ex.Cdr).Car.eval();
+ while (ex.Cdr instanceof Cell) {
+ y = (ex = ex.Cdr).Car.eval();
+ if (x.compare(y) <= 0)
+ return Nil;
+ x = y;
+ }
+ return T;
+ }
+
+ final static Any do217(Any ex) { // >=
+ Any x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell) {
+ z = x.Car.eval();
+ if (y.compare(z) < 0)
+ return Nil;
+ y = z;
+ }
+ return T;
+ }
+
+ final static Any do218(Any ex) { // max
+ Any x, y;
+ for (y = (ex = ex.Cdr).Car.eval(); (ex = ex.Cdr) instanceof Cell;)
+ if ((x = ex.Car.eval()).compare(y) > 0)
+ y = x;
+ return y;
+ }
+
+ final static Any do219(Any ex) { // min
+ Any x, y;
+ for (y = (ex = ex.Cdr).Car.eval(); (ex = ex.Cdr) instanceof Cell;)
+ if ((x = ex.Car.eval()).compare(y) < 0)
+ y = x;
+ return y;
+ }
+
+ final static Any do220(Any ex) { // atom
+ return ex.Cdr.Car.eval() instanceof Cell? Nil : T;
+ }
+
+ final static Any do221(Any ex) { // pair
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Cell? x : Nil;
+ }
+
+ final static Any do222(Any ex) { // lst?
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Cell || x == Nil? T : Nil;
+ }
+
+ final static Any do223(Any ex) { // num?
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Number? x : Nil;
+ }
+
+ final static Any do224(Any ex) { // sym?
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Symbol || x == Nil? T : Nil;
+ }
+
+ final static Any do225(Any ex) { // flg?
+ Any x;
+ return (x = ex.Cdr.Car.eval()) == Nil || x == T? T : Nil;
+ }
+
+ final static Any do226(Any ex) { // member
+ Any x;
+ x = (ex = ex.Cdr).Car.eval();
+ return (x = member(x, ex.Cdr.Car.eval())) == null? Nil : x;
+ }
+
+ final static Any do227(Any ex) { // memq
+ Any x;
+ x = (ex = ex.Cdr).Car.eval();
+ return (x = memq(x, ex.Cdr.Car.eval())) == null? Nil : x;
+ }
+
+ final static Any do228(Any ex) { // mmeq
+ Any x, y, z;
+ x = (ex = ex.Cdr).Car.eval();
+ for (y = (ex = ex.Cdr).Car.eval(); x instanceof Cell; x = x.Cdr)
+ if ((z = memq(x.Car, y)) != null)
+ return x;
+ return Nil;
+ }
+
+ final static Any do229(Any ex) { // sect
+ Any w, x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ z = x.Cdr.Car.eval();
+ w = x = Nil;
+ while (y instanceof Cell) {
+ if (member(y.Car, z) != null)
+ if (x == Nil)
+ x = w = new Cell(y.Car, Nil);
+ else
+ x = x.Cdr = new Cell(y.Car, Nil);
+ y = y.Cdr;
+ }
+ return w;
+ }
+
+ final static Any do230(Any ex) { // diff
+ Any w, x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ z = x.Cdr.Car.eval();
+ w = x = Nil;
+ while (y instanceof Cell) {
+ if (member(y.Car, z) == null)
+ if (x == Nil)
+ x = w = new Cell(y.Car, Nil);
+ else
+ x = x.Cdr = new Cell(y.Car, Nil);
+ y = y.Cdr;
+ }
+ return w;
+ }
+
+ final static Any do231(Any ex) { // index
+ int i;
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ return (i = indx(y, x.Cdr.Car.eval())) == 0? Nil : new Number(i);
+ }
+
+ final static Any do232(Any ex) { // offset
+ int i;
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ x = x.Cdr.Car.eval();
+ for (i = 1; x instanceof Cell; ++i, x = x.Cdr)
+ if (x.equal(y))
+ return new Number(i);
+ return Nil;
+ }
+
+ final static Any do233(Any ex) { // length
+ long n;
+ return (n = ex.Cdr.Car.eval().length()) >= 0? new Number(n) : T;
+ }
+
+ final static Any do234(Any ex) { // size
+ return new Number(ex.Cdr.Car.eval().size());
+ }
+
+ final static Any do235(Any ex) { // assoc
+ Any x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ x = x.Cdr.Car.eval();
+ for (; x instanceof Cell; x = x.Cdr)
+ if ((z = x.Car) instanceof Cell && y.equal(z.Car))
+ return z;
+ return Nil;
+ }
+
+ final static Any do236(Any ex) { // asoq
+ Any x, y, z;
+ y = (x = ex.Cdr).Car.eval();
+ x = x.Cdr.Car.eval();
+ for (; x instanceof Cell; x = x.Cdr)
+ if ((z = x.Car) instanceof Cell && y == z.Car)
+ return z;
+ return Nil;
+ }
+
+ final static Any do237(Any ex) { // rank
+ Any w, x, y, z;
+ w = (x = ex.Cdr).Car.eval();
+ y = (x = x.Cdr).Car.eval();
+ z = Nil;
+ if (x.Cdr.Car.eval() == Nil)
+ for (; y instanceof Cell; y = y.Cdr) {
+ if ((x = y.Car) instanceof Cell && x.Car.compare(w) > 0)
+ break;
+ z = y;
+ }
+ else
+ for (; y instanceof Cell; y = y.Cdr) {
+ if ((x = y.Car) instanceof Cell && w.compare(x.Car) > 0)
+ break;
+ z = y;
+ }
+ return z.Car;
+ }
+
+ final static Any do238(Any ex) { // match
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ return match(y, x.Cdr.Car.eval())? T : Nil;
+ }
+
+ final static Any do239(Any ex) { // fill
+ Any x, y;
+ y = (x = ex.Cdr).Car.eval();
+ return (x = fill(y, x.Cdr.Car.eval())) == null? y : x;
+ }
+
+ final static Any do240(Any ex) { // prove
+ int i;
+ Any x, y;
+ if (!((y = (ex = ex.Cdr).Car.eval()) instanceof Cell))
+ return Nil;
+ Any dbg = ex.Cdr.Car.eval(), at = At.Car, envSave = Penv, nlSave = Pnl;
+ Penv = y.Car.Car; y.Car = y.Car.Cdr;
+ Any n = Penv.Car; Penv = Penv.Cdr;
+ Pnl = Penv.Car; Penv = Penv.Cdr;
+ Any alt = Penv.Car; Penv = Penv.Cdr;
+ Any tp1 = Penv.Car; Penv = Penv.Cdr;
+ Any tp2 = Penv.Car; Penv = Penv.Cdr;
+ Any e = Nil;
+ while (tp1 instanceof Cell || tp2 instanceof Cell) {
+ if (alt instanceof Cell) {
+ e = Penv;
+ if (!unify((Number)Pnl.Car, tp1.Car.Cdr, (Number)n, alt.Car.Car)) {
+ if (!((alt = alt.Cdr) instanceof Cell)) {
+ Penv = y.Car.Car; y.Car = y.Car.Cdr;
+ n = Penv.Car; Penv = Penv.Cdr;
+ Pnl = Penv.Car; Penv = Penv.Cdr;
+ alt = Penv.Car; Penv = Penv.Cdr;
+ tp1 = Penv.Car; Penv = Penv.Cdr;
+ tp2 = Penv.Car; Penv = Penv.Cdr;
+ }
+ }
+ else {
+ if (dbg != Nil && memq(tp1.Car.Car, dbg) != null) {
+ OutFile.Wr.print(indx(alt.Car, tp1.Car.Car.get(T)));
+ OutFile.space();
+ OutFile.print(uniFill(tp1.Car));
+ OutFile.newline();
+ }
+ if (alt.Cdr instanceof Cell)
+ y.Car =
+ new Cell(
+ new Cell(n,
+ new Cell(Pnl,
+ new Cell(alt.Cdr,
+ new Cell(tp1, new Cell(tp2, e)) ) ) ),
+ y.Car );
+ Pnl = new Cell(n, Pnl);
+ n = ((Number)n).add(One);
+ tp2 = new Cell(tp1.Cdr, tp2);
+ tp1 = alt.Car.Cdr;
+ alt = Nil;
+ }
+ }
+ else if (!((x = tp1) instanceof Cell)) {
+ tp1 = tp2.Car;
+ tp2 = tp2.Cdr;
+ Pnl = Pnl.Cdr;
+ }
+ else if (x.Car == T) {
+ while (y.Car instanceof Cell && ((Number)y.Car.Car.Car).Cnt >= ((Number)Pnl.Car).Cnt)
+ y.Car = y.Car.Cdr;
+ tp1 = x.Cdr;
+ }
+ else if (x.Car.Car instanceof Number) {
+ e = x.Car.Cdr.eval();
+ for (i = ((Number)x.Car.Car).Cnt, x = Pnl; --i > 0;)
+ x = x.Cdr;
+ Pnl = new Cell(x.Car, Pnl);
+ tp2 = new Cell(tp1.Cdr, tp2);
+ tp1 = e;
+ }
+ else if (x.Car.Car instanceof Symbol && firstChar(x.Car.Car) == '@') {
+ if ((e = x.Car.Cdr.eval()) != Nil && unify((Number)Pnl.Car, x.Car.Car, (Number)Pnl.Car, e))
+ tp1 = x.Cdr;
+ else {
+ Penv = y.Car.Car; y.Car = y.Car.Cdr;
+ n = Penv.Car; Penv = Penv.Cdr;
+ Pnl = Penv.Car; Penv = Penv.Cdr;
+ alt = Penv.Car; Penv = Penv.Cdr;
+ tp1 = Penv.Car; Penv = Penv.Cdr;
+ tp2 = Penv.Car; Penv = Penv.Cdr;
+ }
+ }
+ else if (!((alt = x.Car.Car.get(T)) instanceof Cell)) {
+ Penv = y.Car.Car; y.Car = y.Car.Cdr;
+ n = Penv.Car; Penv = Penv.Cdr;
+ Pnl = Penv.Car; Penv = Penv.Cdr;
+ alt = Penv.Car; Penv = Penv.Cdr;
+ tp1 = Penv.Car; Penv = Penv.Cdr;
+ tp2 = Penv.Car; Penv = Penv.Cdr;
+ }
+ }
+ for (e = Nil, x = Penv; x.Cdr instanceof Cell; x = x.Cdr)
+ if (x.Car.Car.Car.equal(Zero))
+ e = new Cell(new Cell(x.Car.Car.Cdr, lookup(Zero, x.Car.Car.Cdr)), e);
+ At.Car = at;
+ x = e instanceof Cell? e : Penv instanceof Cell? T : Nil;
+ Penv = envSave; Pnl = nlSave;
+ return x;
+ }
+
+ final static Any do241(Any ex) { // ->
+ int i;
+ Any x;
+ if (!(ex.Cdr.Cdr.Car instanceof Number))
+ return lookup((Number)Pnl.Car, ex.Cdr.Car);
+ for (i = ((Number)ex.Cdr.Cdr.Car).Cnt, x = Pnl; --i > 0;)
+ x = x.Cdr;
+ return lookup((Number)x.Car, ex.Cdr.Car);
+ }
+
+ final static Any do242(Any ex) { // unify
+ Any x;
+ x = ex.Cdr.Car.eval();
+ return unify((Number)Pnl.Cdr.Car, x, (Number)Pnl.Car, x)? Penv : Nil;
+ }
+
+ final static Any do243(Any ex) { // sort
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Cell && x.Cdr instanceof Cell? sort(ex, x, ex.Cdr.Cdr.Car.eval()) : x;
+ }
+
+ final static Any do244(Any ex) { // format
+ int i;
+ Any x, y;
+ x = (ex = ex.Cdr).Car.eval();
+ i = (y = (ex = ex.Cdr).Car.eval()) == Nil? 0 : ((Number)y).Cnt;
+ return format(x, i, ex.Cdr);
+ }
+
+ final static Any do245(Any ex) { // +
+ Any x;
+ Number num;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.add((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+ }
+
+ final static Any do246(Any ex) { // -
+ Any x;
+ Number num;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ num = (Number)x;
+ if (!(ex.Cdr instanceof Cell))
+ return num.neg();
+ do {
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ num = num.sub((Number)x);
+ } while (ex.Cdr instanceof Cell);
+ return num;
+ }
+
+ final static Any do247(Any ex) { // inc
+ Any x, y;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ if (x instanceof Number)
+ return ((Number)x).add(One);
+ if (!(ex.Cdr instanceof Cell)) {
+ if (x.Car == Nil)
+ return Nil;
+ x.Car = y = ((Number)x.Car).add(One);
+ }
+ else {
+ y = ex.Cdr.Car.eval();
+ if (x.Car == Nil || y == Nil)
+ return Nil;
+ x.Car = y = ((Number)x.Car).add((Number)y);
+ }
+ return y;
+ }
+
+ final static Any do248(Any ex) { // dec
+ Any x, y;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ if (x instanceof Number)
+ return ((Number)x).sub(One);
+ if (!(ex.Cdr instanceof Cell)) {
+ if (x.Car == Nil)
+ return Nil;
+ x.Car = y = ((Number)x.Car).sub(One);
+ }
+ else {
+ y = ex.Cdr.Car.eval();
+ if (x.Car == Nil || y == Nil)
+ return Nil;
+ x.Car = y = ((Number)x.Car).sub((Number)y);
+ }
+ return y;
+ }
+
+ final static Any do249(Any ex) { // *
+ Any x;
+ Number num;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.mul((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+ }
+
+ final static Any do250(Any ex) { // */
+ Any x;
+ Number num;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ; num = num.mul((Number)x)) {
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ if (!((ex.Cdr) instanceof Cell))
+ return num.add(((Number)x).div(Two)).div(((Number)x));
+ }
+ }
+
+ final static Any do251(Any ex) { // /
+ Any x;
+ Number num;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.div((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+ }
+
+ final static Any do252(Any ex) { // %
+ Any x;
+ Number num;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.rem((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+ }
+
+ final static Any do253(Any ex) { // >>
+ int i;
+ Any x;
+ i = evInt(ex = ex.Cdr);
+ if ((x = ex.Cdr.Car.eval()) == Nil)
+ return Nil;
+ return ((Number)x).shift(i);
+ }
+
+ final static Any do254(Any ex) { // lt0
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) < 0? x : Nil;
+ }
+
+ final static Any do255(Any ex) { // ge0
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) >= 0? x : Nil;
+ }
+
+ final static Any do256(Any ex) { // gt0
+ Any x;
+ return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) > 0? x : Nil;
+ }
+
+ final static Any do257(Any ex) { // abs
+ return ((Number)ex.Cdr.Car.eval()).abs();
+ }
+
+ final static Any do258(Any ex) { // bit?
+ Any x;
+ Number num;
+ num = (Number)(ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell)
+ if ((x = ex.Car.eval()) == Nil || !num.tst((Number)x))
+ return Nil;
+ return num;
+ }
+
+ final static Any do259(Any ex) { // &
+ Any x;
+ Number num;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.and((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+ }
+
+ final static Any do260(Any ex) { // |
+ Any x;
+ Number num;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.or((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+ }
+
+ final static Any do261(Any ex) { // x|
+ Any x;
+ Number num;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.xor((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+ }
+
+ final static Any do262(Any ex) { // seed
+ long n;
+ n = initSeed(ex.Cdr.Car.eval()) * 6364136223846793005L + 1;
+ return new Number(Seed = n);
+ }
+
+ final static Any do263(Any ex) { // rand
+ Any x;
+ Seed = Seed * 6364136223846793005L + 1;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return new Number(Seed);
+ if (x == T)
+ return (Seed & 0x100000000L) == 0? Nil : T;
+ return new Number(((Number)x).Cnt + (int)(Seed >>> 33) % (evInt(ex.Cdr) + 1 - ((Number)x).Cnt));
+ }
+
+ final static Any do264(Any ex) { // path
+ return mkStr(path(evString(ex.Cdr)));
+ }
+
+ final static Any do265(Any ex) { // read
+ Any x, y;
+ if (!((x = ex.Cdr) instanceof Cell))
+ x = InFile.read('\0');
+ else {
+ y = x.Car.eval();
+ if ((x = token(y, (x = x.Cdr.Car.eval()) == Nil? '\0' : firstChar(x))) == null)
+ x = Nil;
+ }
+ if (InFile.Name == null && InFile.Chr == '\n')
+ InFile.Chr = 0;
+ return x;
+ }
+
+ final static Any do266(Any ex) { // char
+ Any x;
+ if (!((ex = ex.Cdr) instanceof Cell)) {
+ if (InFile.Chr == 0)
+ InFile.get();
+ x = InFile.Chr < 0? Nil : mkChar((char)InFile.Chr);
+ InFile.get();
+ return x;
+ }
+ if ((x = ex.Car.eval()) instanceof Number)
+ return x.equals(Zero)? Nil : mkChar((char)((Number)x).Cnt);
+ return x == T? mkChar((char)0x10000) : new Number(firstChar(x));
+ }
+
+ final static Any do267(Any ex) { // skip
+ char c;
+ c = firstChar(ex.Cdr.Car.eval());
+ return InFile.skip(c) < 0? Nil : mkChar(c);
+ }
+
+ final static Any do268(Any ex) { // line
+ int i;
+ Any x, y, z;
+ StringBuilder sb;
+ if (InFile.Chr == 0)
+ InFile.get();
+ if (InFile.eol())
+ return Nil;
+ if (ex.Cdr.Car.eval() != Nil) {
+ sb = new StringBuilder();
+ do {
+ sb.append((char)InFile.Chr);
+ InFile.get();
+ } while (!InFile.eol());
+ return mkStr(sb);
+ }
+ for (x = y = new Cell(mkChar((char)InFile.Chr), Nil);;) {
+ InFile.get();
+ if (InFile.eol())
+ return x;
+ y = y.Cdr = new Cell(mkChar((char)InFile.Chr), Nil);
+ }
+ }
+
+ final static Any do269(Any ex) { // load
+ Any x, y;
+ 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;
+ }
+
+ final static Any do270(Any ex) { // in
+ Any x;
+ Env.pushInFile((x = ex.Cdr).Car.eval().rdOpen(ex));
+ x = x.Cdr.prog();
+ Env.popInFiles();
+ return x;
+ }
+
+ final static Any do271(Any ex) { // out
+ Any x;
+ Env.pushOutFile((x = ex.Cdr).Car.eval().wrOpen(ex));
+ x = x.Cdr.prog();
+ Env.popOutFiles();
+ return x;
+ }
+
+ final static Any do272(Any ex) { // ctl
+ return ex.Cdr.Cdr.prog(); // No locking
+ }
+
+ final static Any do273(Any ex) { // open
+ String str;
+ str = evString(ex.Cdr);
+ try {return new Number(new PicoLispReader(new FileReader(str), str, -1).Fd);}
+ catch (IOException e) {}
+ return Nil;
+ }
+
+ final static Any do274(Any ex) { // close
+ int i;
+ Any x;
+ if ((i = xInt(x = ex.Cdr.Car.eval())) >= 0 && i < InFiles.length) {
+ if (InFiles[i] != null) {
+ InFiles[i].close();
+ if (OutFiles[i] != null)
+ OutFiles[i].close();
+ return x;
+ }
+ if (OutFiles[i] != null) {
+ OutFiles[i].close();
+ return x;
+ }
+ }
+ return Nil;
+ }
+
+ final static Any do275(Any ex) { // prin
+ Any x, y;
+ for (y = Nil; (ex = ex.Cdr) instanceof Cell; OutFile.Wr.print((y = ex.Car.eval()).name()));
+ return y;
+ }
+
+ final static Any do276(Any ex) { // prinl
+ Any x, y;
+ for (y = Nil; (ex = ex.Cdr) instanceof Cell; OutFile.Wr.print((y = ex.Car.eval()).name()));
+ OutFile.newline();
+ return y;
+ }
+
+ final static Any do277(Any ex) { // space
+ int i;
+ Any x;
+ if ((x = ex.Cdr.Car.eval()) == Nil) {
+ OutFile.space();
+ return One;
+ }
+ for (i = xInt(x); i > 0; --i)
+ OutFile.space();
+ return x;
+ }
+
+ final static Any do278(Any ex) { // print
+ Any x, y;
+ OutFile.print(y = (x = ex.Cdr).Car.eval());
+ while ((x = x.Cdr) instanceof Cell) {
+ OutFile.space();
+ OutFile.print(y = x.Car.eval());
+ }
+ return y;
+ }
+
+ final static Any do279(Any ex) { // printsp
+ Any x, y;
+ x = ex.Cdr;
+ do {
+ OutFile.print(y = x.Car.eval());
+ OutFile.space();
+ } while ((x = x.Cdr) instanceof Cell);
+ return y;
+ }
+
+ final static Any do280(Any ex) { // println
+ Any x, y;
+ 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;
+ }
+
+ final static Any do281(Any ex) { // flush
+ return OutFile.Wr.checkError()? Nil : T;
+ }
+
+ final static Any do282(Any ex) { // connect
+ int i;
+ try {
+ Socket sock = new Socket(evString(ex.Cdr), evInt(ex.Cdr.Cdr));
+ i = new PicoLispReader(sock.getInputStream(), -1).Fd;
+ new PicoLispWriter(sock.getOutputStream(), i);
+ return new Number(i);
+ }
+ catch (IOException e) {}
+ return Nil;
+ }
+
+ final Any apply(Any 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 = x.Cdr = new Cell(mkSymbol(cf? v[i].Car : v[i]), Nil);
+ }
+ return func(new Cell(this, y));
+ }
+
+ final boolean equal(Any x) {
+ if (x == this)
+ return true;
+ if (!(x instanceof Number))
+ return false;
+ Number num = (Number)x;
+ if (Big == null)
+ return num.Big == null && Cnt == num.Cnt;
+ return Big == num.Big;
+ }
+
+ final int compare(Any x) {
+ if (x == this)
+ return 0;
+ if (x == Nil)
+ return +1;
+ if (!(x instanceof Number))
+ return -1;
+ Number num = (Number)x;
+ if (Big == null)
+ return num.Big == null? Cnt - num.Cnt : -1;
+ return Big.compareTo(num.Big);
+ }
+
+ final long length() {return (Big == null? Integer.toString(Cnt) : Big.toString()).length();}
+
+ final long size() {
+ if (Big == null) {
+ int n = 2 * (Cnt >= 0? Cnt : -Cnt);
+ if (n == 0)
+ return 1;
+ int i = 1;
+ while ((n >>= 8) != 0)
+ ++i;
+ return i;
+ }
+ return Big.toByteArray().length;
+ }
+
+ final InFrame rdOpen(Any ex) {
+ int i;
+ InFrame f;
+ if ((i = Cnt) < 0) {
+ for (f = Env.InFrames;;) {
+ if ((f = f.Link) == null)
+ badFd(ex, this);
+ if (++i == 0) {
+ i = f.Rd.Fd;
+ break;
+ }
+ }
+ }
+ if (i >= InFiles.length || InFiles[i] == null)
+ badFd(ex, this);
+ return new InFrame(InFiles[i],0);
+ }
+
+ final OutFrame wrOpen(Any ex) {
+ int i;
+ OutFrame f;
+ if ((i = Cnt) < 0) {
+ for (f = Env.OutFrames;;) {
+ if ((f = f.Link) == null)
+ badFd(ex, this);
+ if (++i == 0) {
+ i = f.Wr.Fd;
+ break;
+ }
+ }
+ }
+ if (i >= OutFiles.length || OutFiles[i] == null)
+ badFd(ex, this);
+ return new OutFrame(OutFiles[i],0);
+ }
+
+ final String name() {return Big == null? Integer.toString(Cnt) : Big.toString();}
+ final public String toString() {return name();}
+
+ final Number abs() {
+ if (Big == null) {
+ if (Cnt >= 0)
+ return this;
+ if (Cnt != Integer.MIN_VALUE)
+ return new Number(-Cnt);
+ return new Number(-(long)Cnt);
+ }
+ return new Number(Big.abs());
+ }
+
+ final Number neg() {
+ if (Big == null) {
+ if (Cnt != Integer.MIN_VALUE)
+ return new Number(-Cnt);
+ return new Number(-(long)Cnt);
+ }
+ return new Number(Big.negate());
+ }
+
+ final Number add(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt + (long)num.Cnt);
+ return new Number(big(Cnt).add(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.add(big(num.Cnt)));
+ return new Number(Big.add(num.Big));
+ }
+
+ final Number sub(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt - (long)num.Cnt);
+ return new Number(big(Cnt).subtract(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.subtract(big(num.Cnt)));
+ return new Number(Big.subtract(num.Big));
+ }
+
+ final Number mul(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt * (long)num.Cnt);
+ return new Number(big(Cnt).multiply(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.multiply(big(num.Cnt)));
+ return new Number(Big.multiply(num.Big));
+ }
+
+ final Number div(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt / (long)num.Cnt);
+ return new Number(big(Cnt).divide(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.divide(big(num.Cnt)));
+ return new Number(Big.divide(num.Big));
+ }
+
+ final Number rem(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt % (long)num.Cnt);
+ return new Number(big(Cnt).remainder(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.remainder(big(num.Cnt)));
+ return new Number(Big.remainder(num.Big));
+ }
+
+ final Number shift(int i) {
+ if (Big == null) {
+ if (i >= 0)
+ return new Number((long)Cnt >> i);
+ if (i > -32)
+ return new Number((long)Cnt << -i);
+ return new Number((new BigInteger(new byte[] {(byte)(Cnt>>24), (byte)(Cnt>>16), (byte)(Cnt>>8), (byte)Cnt})).shiftRight(i));
+ }
+ return new Number(Big.shiftRight(i));
+ }
+
+ final boolean tst(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return Cnt == (Cnt & num.Cnt);
+ BigInteger b = big(Cnt);
+ return b.equals(b.and(num.Big));
+ }
+ if (num.Big == null)
+ return Big.equals(Big.and(big(num.Cnt)));
+ return Big.equals(Big.and(num.Big));
+ }
+
+ final Number and(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt & (long)num.Cnt);
+ return new Number(big(Cnt).and(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.and(big(num.Cnt)));
+ return new Number(Big.and(num.Big));
+ }
+
+ final Number or(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt | (long)num.Cnt);
+ return new Number(big(Cnt).or(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.or(big(num.Cnt)));
+ return new Number(Big.or(num.Big));
+ }
+
+ final Number xor(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt ^ (long)num.Cnt);
+ return new Number(big(Cnt).xor(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.xor(big(num.Cnt)));
+ return new Number(Big.xor(num.Big));
+ }
+ }
+
+ final static class Symbol extends Any {
+ Any Prop[];
+ String Name;
+
+ Symbol(Any val, String nm) {
+ Car = val == null? this : val;
+ Name = nm;
+ }
+
+ final Any put(Any key, Any val) {
+ if (key.equal(Zero))
+ Car = 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.Car = 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 Any get(Any key) {
+ if (key.equal(Zero))
+ return Car;
+ 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 Any prop(Any key) {
+ 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;
+ }
+ else if (key == x)
+ return key;
+ }
+ } while (i != 0);
+ return Nil;
+ }
+
+ final Any putl(Any lst) {
+ Prop = new Any[6];
+ int i = 0;
+ for (Any y = lst; y instanceof Cell; y = y.Cdr)
+ Prop = append(Prop, i++, y.Car);
+ return lst;
+ }
+
+ final Any getl() {
+ Any x = Nil;
+ if (Prop != null)
+ for (int i = Prop.length; --i >= 0;)
+ if (Prop[i] != null)
+ x = new Cell(Prop[i], x);
+ return x;
+ }
+
+ final Any eval() {return Car;}
+ final Any prog() {return Car;}
+ final Any run() {return Car;}
+
+ final Any call(Any ex) {
+ if (Car == Nil)
+ undefined(this, ex);
+ return Car.func(ex);
+ }
+
+ final Any func(Any ex) {return Car.func(ex);}
+
+ final Any apply(Any ex, boolean cf, Any[] v, int n) {
+ if (Car == Meth.Car) {
+ 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.Car); 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.Car = 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.Car = Nil; // Set to NIL
+ }
+ bnd.add(This.Car);
+ bnd.add(This);
+ This.Car = 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.Car);
+ bnd.add(This);
+ This.Car = o;
+ Env.Bind = bnd;
+ x = z.Cdr.prog();
+ Env.Args = args;
+ Env.Arg = arg;
+ }
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ Env.Cls = cls; Env.Key = key;
+ return x;
+ }
+ err(ex, o, "Bad object");
+ }
+ if (Car == Nil || Car == this)
+ undefined(this, ex);
+ return Car.apply(ex, cf, v, n);
+ }
+
+ final boolean equal(Any x) {return this == x || (x instanceof Symbol) && Name.equals(((Symbol)x).Name);}
+
+ final int compare(Any x) {
+ if (x == this)
+ return 0;
+ if (this == T || x == Nil || x instanceof Number)
+ return +1;
+ if (x == T || x instanceof Cell)
+ return -1;
+ String a = Name;
+ String b = ((Symbol)x).Name;
+ if (a == null)
+ return b == null? hashCode() - x.hashCode() : -1;
+ if (b == null)
+ return +1;
+ return a.compareTo(b);
+ }
+
+ final long length() {return Name == null? 0 : Name.length();}
+ final long size() {return Name == null? 0 : Name.getBytes().length;}
+
+ final InFrame rdOpen(Any ex) {
+ try {
+ String nm = path(Name);
+ if (nm.charAt(0) == '+')
+ nm = nm.substring(1); // No file reader with "rw" mode
+ return new InFrame(new PicoLispReader(new FileReader(nm), nm, -1), 1);
+ }
+ catch (IOException e) {
+ err(ex, this, "Read open error");
+ return null;
+ }
+ }
+
+ final OutFrame wrOpen(Any ex) {
+ try {
+ String nm = path(Name);
+ if (nm.charAt(0) == '+')
+ return new OutFrame(new PicoLispWriter(new PrintWriter(new FileWriter(nm.substring(1), true)), nm, -1), 1);
+ return new OutFrame(new PicoLispWriter(new PrintWriter(nm), nm, -1), 1);
+ }
+ catch (IOException e) {
+ err(ex, this, "Write open error");
+ return null;
+ }
+ }
+
+ final String name() {return Name == null? "" : Name;}
+
+ 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 Any parse(boolean skp, Any s) {
+ Any x, y;
+ 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();
+ if ((x = token(s, '\0')) == null)
+ return Nil;
+ y = new Cell(x, Nil);
+ while ((x = token(s, '\0')) != null)
+ y = y.Cdr = new Cell(x, Nil);
+ return y;
+ }
+ }
+
+
+ final static class NilSym extends Any {
+ NilSym() {
+ Car = this;
+ Cdr = this;
+ }
+
+ final Any put(Any key, Any val) {return protError(this);}
+ final Any get(Any key) {return this;}
+ final Any prop(Any key) {return this;}
+ final Any putl(Any lst) {return protError(this);}
+ final Any getl() {return protError(this);}
+ final Any eval() {return this;}
+ final Any prog() {return this;}
+ final Any run() {return this;}
+ final Any call(Any ex) {return undefined(this,ex);}
+ final Any func(Any ex) {return undefined(this,ex);}
+ final Any apply(Any ex, boolean cf, Any[] v, int n) {return undefined(this,ex);}
+ final boolean equal(Any x) {return x == Nil;}
+ final int compare(Any x) {return x == this? 0 : -1;}
+ final long length() {return 0;}
+ final long size() {return 0;}
+ final InFrame rdOpen(Any ex) {return new InFrame(InFiles[0], 0);}
+ final OutFrame wrOpen(Any ex) {return new OutFrame(OutFiles[1], 0);}
+ final String name() {return "";}
+ final public String toString() {return "NIL";}
+ }
+
+ final static class Cell extends Any {
+ Cell(Any car, Any cdr) {
+ Car = car;
+ Cdr = cdr;
+ }
+
+ final Any put(Any key, Any val) {return symError(this);}
+
+ final Any get(Any key) {
+ Any x, y = this;
+ if (key instanceof Number) {
+ int n = ((Number)key).Cnt;
+ 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 Any prop(Any key) {return symError(this);}
+ final Any putl(Any lst) {return symError(this);}
+ final Any getl() {return symError(this);}
+ final Any eval() {return Car.call(this);}
+
+ final Any prog() {
+ Any ex;
+ for (ex = this; ex.Cdr != Nil; ex = ex.Cdr)
+ ex.Car.eval();
+ return ex.Car.eval();
+ }
+
+ final Any run() {
+ Any x, at = At.Car;
+ Any ex = this;
+ do
+ x = ex.Car.eval();
+ while ((ex = ex.Cdr) != Nil);
+ At.Car = at;
+ return x;
+ }
+
+ final Any call(Any ex) {return eval().func(ex);}
+
+ final Any func(Any ex) {
+ int i;
+ Any x, y;
+ Bind bnd = new Bind(); bnd.add(At.Car); bnd.add(At);
+ for (x = Car; x instanceof Cell; x = x.Cdr) {
+ bnd.add((ex = ex.Cdr).Car.eval()); // Save new value
+ bnd.add(x.Car); // and symbol
+ }
+ if (x == Nil || x != At) {
+ i = bnd.Cnt;
+ if (x != Nil) {
+ bnd.add(x.Car); // Save old value
+ bnd.add(x); // and symbol
+ x.Car = ex.Cdr; // Set new value
+ }
+ do {
+ y = bnd.Data[--i];
+ x = y.Car;
+ y.Car = 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 (ex.Cdr != Nil) {
+ av = new Any[6];
+ do
+ av = append(av, j++, (ex = ex.Cdr).Car.eval());
+ while (ex.Cdr != Nil);
+ }
+ 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 {
+ y = bnd.Data[--i];
+ x = y.Car;
+ y.Car = 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;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+ }
+
+ final Any apply(Any ex, boolean cf, Any[] v, int n) {
+ int i;
+ Any x, y;
+ Bind bnd = new Bind(); bnd.add(At.Car); bnd.add(At);
+ for (x = Car, i = 0; x instanceof Cell; ++i, x = x.Cdr) {
+ bnd.add((y = x.Car).Car); // Save value
+ bnd.add(y); // and symbol
+ y.Car = i >= n? Nil : cf? v[i].Car : v[i];
+ }
+ if (x == Nil || x != At) {
+ if (x != Nil) {
+ bnd.add(x.Car); // Save old value
+ bnd.add(x); // and symbol
+ x.Car = 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++, cf? v[i].Car : v[i]);
+ 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;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+ }
+
+ final boolean equal(Any x) {
+ if (!(x instanceof Cell))
+ return false;
+ Any y = this;
+ 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.Cdr instanceof Cell))
+ return x.Cdr.equal(y.Cdr);
+ x = x.Cdr;
+ if (!(y.Cdr instanceof Cell))
+ return false;
+ y = y;
+ }
+ Any a = x;
+ Any b = y;
+ for (;;) {
+ if (!x.Car.equal(y.Car))
+ return false;
+ if (!(x.Cdr instanceof Cell))
+ return x.Cdr.equal(y.Cdr);
+ x = x.Cdr;
+ if (!(y.Cdr instanceof Cell))
+ return false;
+ y = y.Cdr;
+ if (x == a)
+ return y == b;
+ if (y == b)
+ return false;
+ }
+ }
+
+ final int compare(Any x) {
+ if (x == this)
+ return 0;
+ if (x == T)
+ return -1;
+ if (!(x instanceof Cell))
+ return +1;
+ Any y = this;
+ Any a = this;
+ Any b = x;
+ for (;;) {
+ int n;
+ if ((n = y.Car.compare(x.Car)) != 0)
+ return n;
+ if (!((y = y.Cdr) instanceof Cell))
+ return y.compare(x.Cdr);
+ if (!((x = x.Cdr) instanceof Cell))
+ return x == T? -1 : +1;
+ if (y == a && x == b)
+ return 0;
+ }
+ }
+
+ final long length() {
+ long n = 1;
+ Any x = this;
+ while (x.Car == Quote) {
+ if (x == x.Cdr)
+ return -1;
+ if (!((x = x.Cdr) instanceof Cell))
+ return n;
+ ++n;
+ }
+ Any y = x;
+ while ((x = x.Cdr) instanceof Cell) {
+ if (x == y)
+ return -1;
+ ++n;
+ }
+ return n;
+ }
+
+ final long size() {return size(this);}
+ final long size(Any x) {
+ long n;
+ Any y;
+
+ n = 1;
+ while (x.Car == Quote) {
+ if (x == x.Cdr || !((x = x.Cdr) instanceof Cell))
+ return n;
+ ++n;
+ }
+ for (y = x;;) {
+ if (x.Car instanceof Cell)
+ n += size(x.Car);
+ if (!((x = x.Cdr) instanceof Cell) || x == y)
+ break;
+ ++n;
+ }
+ return n;
+ }
+
+ final InFrame rdOpen(Any ex) {
+ try {
+ int len = (int)length();
+ String[] cmd = new String[len];
+ Any x = this;
+ for (int i = 0; i < len; ++i) {
+ cmd[i] = x.Car.name();
+ x = x.Cdr;
+ }
+ int pid = allocPid();
+ return new InFrame(new PicoLispReader((Pids[pid] = Runtime.getRuntime().exec(cmd)).getInputStream(), -1), pid);
+ }
+ catch (IOException e) {
+ err(ex, this, "Pipe read open error");
+ return null;
+ }
+ }
+
+ final OutFrame wrOpen(Any ex) {
+ try {
+ int len = (int)length();
+ String[] cmd = new String[len];
+ Any x = this;
+ for (int i = 0; i < len; ++i) {
+ cmd[i] = x.Car.name();
+ x = x.Cdr;
+ }
+ int pid = allocPid();
+ return new OutFrame(new PicoLispWriter((Pids[pid] = Runtime.getRuntime().exec(cmd)).getOutputStream(), -1), pid);
+ }
+ catch (IOException e) {
+ err(ex, this, "Pipe write open error");
+ return null;
+ }
+ }
+
+ final String name() {return Car.name() + Cdr.name();}
+
+ 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/ersatz/README b/ersatz/README
@@ -1,4 +1,4 @@
-10oct10abu
+30oct10abu
(c) Software Lab. Alexander Burger
@@ -11,13 +11,13 @@ 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.
+Performance is rather poor. It is 5 to 10 times slower, allocates a huge amount
+of memory at startup (600 MB vs. 3 MB), and needs 2.5 to 4 times the space for
+runtime Lisp data. 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).
+('tell', 'hear', 'ipc' etc.) and databases (external symbols).
Invocation
@@ -27,6 +27,9 @@ Ersatz PicoLisp can be started - analog to 'bin/picolisp' - as
$ ersatz/picolisp
+or, analog to 'dbg' with initial libraries and debugging environment
+
+ $ ./erl
If absolutely no "bin/picolisp" can be build, you might install symbolic links
in the "bin/" directory to Ersatz PicoLisp:
diff --git a/ersatz/fun.src b/ersatz/fun.src
@@ -1,433 +1,2980 @@
-# 10oct10abu
+# 01nov10abu
# (c) Software Lab. Alexander Burger
# Ersatz PicoLisp Functions
############ main ############
+# (quit ['any ['any]])
+quit (str)
+ str = evString(ex = ex.Cdr);
+ return err(null, (ex = ex.Cdr) instanceof Cell? ex.Car.eval() : null, str);
+
# (args) -> flg
-args
+args T
return Env.Next < Env.ArgC? T : Nil;
# (next) -> any
-next
+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;
+arg (i)
+ if (ex.Cdr instanceof Cell)
+ return (i = evInt(ex.Cdr)+Env.Next-1) >= 0 && i < Env.ArgC? Env.Args[i] : Nil;
return Env.Arg;
# (rest) -> lst
-rest
+rest (i x)
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);
+# (date ['T]) -> dat
+# (date 'dat) -> (y m d)
+# (date 'y 'm 'd) -> dat | NIL
+# (date '(y m d)) -> dat | NIL
+date (i j x z)
+ if (!((x = ex.Cdr) instanceof Cell)) {
+ Cal = new GregorianCalendar();
+ return date(Cal.get(Calendar.YEAR), Cal.get(Calendar.MONTH)+1, Cal.get(Calendar.DATE));
+ }
+ if ((z = x.Car.eval()) == T) {
+ Cal = new GregorianCalendar(TimeZone.getTimeZone("GMT"));
+ return date(Cal.get(Calendar.YEAR), Cal.get(Calendar.MONTH)+1, Cal.get(Calendar.DATE));
+ }
+ if (z == Nil)
+ return Nil;
+ if (z instanceof Cell)
+ return date(xInt(z.Car), xInt(z.Cdr.Car), xInt(z.Cdr.Cdr.Car));
+ i = xInt(z);
+ if (!((x = x.Cdr) instanceof Cell))
+ return date(i);
+ j = evInt(x);
+ return date(i, j, evInt(x.Cdr));
+
+# (time ['T]) -> tim
+# (time 'tim) -> (h m s)
+# (time 'h 'm ['s]) -> tim | NIL
+# (time '(h m [s])) -> tim | NIL
+time (i j x z)
+ if (!((x = ex.Cdr) instanceof Cell))
+ return time(new GregorianCalendar());
+ if ((z = x.Car.eval()) == T)
+ return time(Cal);
+ if (z == Nil)
+ return Nil;
+ if (z instanceof Cell)
+ return time(xInt(z.Car), xInt(z.Cdr.Car), z.Cdr.Cdr instanceof Cell? xInt(z.Cdr.Cdr.Car) : 0);
+ i = xInt(z);
+ if (!((x = x.Cdr) instanceof Cell))
+ return new Cell(new Number(i / 3600), new Cell(new Number(i / 60 % 60), new Cell(new Number(i % 60), Nil)));
+ j = evInt(x);
+ return time(i, j, x.Cdr instanceof Cell? evInt(x.Cdr) : 0);
+
+# (usec) -> num
+usec ()
+ return new Number(System.nanoTime()/1000 - USec);
+
+# (file) -> (sym1 sym2 . num) | NIL
+file (i x)
+ if (InFile.Name == null)
+ return Nil;
+ x = new Number(InFile.Src);
+ if ((i = InFile.Name.lastIndexOf('/')) >= 0)
+ return new Cell(mkStr(InFile.Name.substring(0, i+1)), new Cell(mkStr(InFile.Name.substring(i+1)), x));
+ return new Cell(mkStr("./"), new Cell(mkStr(InFile.Name), x));
+
+# (version ['flg]) -> lst
+version (i x)
+ if (ex.Cdr.Car.eval() == Nil) {
+ for (i = 0; i < 4; ++i)
+ OutFile.Wr.print(Version[i] + (i == 3? "-" : "."));
+ OutFile.Wr.println("J");
+ OutFile.Wr.flush();
+ }
+ for (x = Nil, i = 4; --i >= 0;)
+ x = new Cell(new Number(Version[i]), x);
+ return x;
+
+############ apply ############
+# (apply 'fun 'lst ['any ..]) -> any
+apply (i w x y v)
+ 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 (i j w x v)
+ 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);
+
+# (maps 'fun 'sym ['lst ..]) -> any
+maps (i j k w x y s v)
+ w = (x = ex.Cdr).Car.eval();
+ if ((y = (x = x.Cdr).Car.eval()) == Nil || (s = (Symbol)y).Prop == null)
+ return Nil;
+ v = new Any[6];
+ i = 1;
+ append(v, 0, null);
+ while ((x = x.Cdr) instanceof Cell)
+ v = append(v, i++, x.Car.eval());
+ k = s.Prop.length;
+ do
+ if ((x = s.Prop[--k]) != null) {
+ v[0] = new Cell(x,Nil);
+ x = w.apply(ex, true, v, i);
+ for (j = i; --j > 0;)
+ v[j] = v[j].Cdr;
+ }
+ while (k != 0);
+ return x;
+
+# (map 'fun 'lst ..) -> lst
+map (i j w x y v)
+ 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;
+
+# (mapc 'fun 'lst ..) -> any
+mapc (i j w x y v)
+ 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, true, v, i);
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return x;
+
+# (maplist 'fun 'lst ..) -> lst
+maplist (i j w x z v)
+ 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, false, v, i), Nil);
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ x = x.Cdr = new Cell(w.apply(ex, false, v, i), Nil);
+ }
+ }
+ return z;
+
+# (mapcar 'fun 'lst ..) -> lst
+mapcar (i j w x z v)
+ 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 = x.Cdr = new Cell(w.apply(ex, true, v, i), Nil);
+ }
+ }
+ return z;
+
+# (mapcon 'fun 'lst ..) -> lst
+mapcon (i j w x z v)
+ 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;
+ while (!((x = w.apply(ex, false, v, i)) instanceof Cell)) {
+ if (!(v[0].Cdr instanceof Cell))
+ return z;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ z = x;
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ while (x.Cdr instanceof Cell)
+ x = x.Cdr;
+ x.Cdr = w.apply(ex, false, v, i);
+ }
+ }
+ return z;
+
+# (mapcan 'fun 'lst ..) -> lst
+mapcan (i j w x z v)
+ 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;
+ while (!((x = w.apply(ex, true, v, i)) instanceof Cell)) {
+ if (!(v[0].Cdr instanceof Cell))
+ return z;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ z = x;
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ while (x.Cdr instanceof Cell)
+ x = x.Cdr;
+ x.Cdr = w.apply(ex, true, v, i);
+ }
+ }
+ return z;
+
+# (filter 'fun 'lst ..) -> lst
+filter (i j w x z v)
+ 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;
+ while (w.apply(ex, true, v, i) == Nil) {
+ if (!(v[0].Cdr instanceof Cell))
+ return z;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ z = x = new Cell(v[0].Car, Nil);
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ if (w.apply(ex, true, v, i) != Nil)
+ x = x.Cdr = new Cell(v[0].Car, Nil);
+ }
+ }
+ return z;
+
+# (extract 'fun 'lst ..) -> lst
+extract (i j w x y z v)
+ 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;
+ while ((y = w.apply(ex, true, v, i)) == Nil) {
+ if (!(v[0].Cdr instanceof Cell))
+ return z;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ z = x = new Cell(y, Nil);
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ if ((y = w.apply(ex, true, v, i)) != Nil)
+ x = x.Cdr = new Cell(y, Nil);
+ }
+ }
+ return z;
+
+# (seek 'fun 'lst ..) -> lst
+seek (i j w x v)
+ 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 (v[0] instanceof Cell) {
+ if (w.apply(ex, false, v, i) != Nil)
+ return v[0];
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return Nil;
+
+# (find 'fun 'lst ..) -> any
+find (i j w x v)
+ 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 (v[0] instanceof Cell) {
+ if (w.apply(ex, true, v, i) != Nil)
+ return v[0].Car;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return Nil;
+
+# (pick 'fun 'lst ..) -> any
+pick (i j w x v)
+ 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 (v[0] instanceof Cell) {
+ if ((x = w.apply(ex, true, v, i)) != Nil)
+ return x;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return Nil;
+
+# (cnt 'fun 'lst ..) -> cnt
+cnt (i j n w x v)
+ w = (x = ex.Cdr).Car.eval();
+ n = 0;
+ 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 (v[0] instanceof Cell) {
+ if (w.apply(ex, true, v, i) != Nil)
+ ++n;
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return new Number(n);
+
+# (sum 'fun 'lst ..) -> num
+sum (num i j w x y v)
+ w = (x = ex.Cdr).Car.eval();
+ num = Zero;
+ 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 (v[0] instanceof Cell) {
+ if ((y = w.apply(ex, true, v, i)) instanceof Number)
+ num = num.add((Number)y);
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return num;
+
+# (maxi 'fun 'lst ..) -> any
+maxi (i j w x y z v)
+ w = (x = ex.Cdr).Car.eval();
+ y = 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);
+ while (v[0] instanceof Cell) {
+ if ((x = w.apply(ex, true, v, i)).compare(y) > 0) {
+ z = v[0].Car;
+ y = x;
+ }
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return z;
+
+# (mini 'fun 'lst ..) -> any
+mini (i j w x y z v)
+ w = (x = ex.Cdr).Car.eval();
+ y = T;
+ 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);
+ while (v[0] instanceof Cell) {
+ if ((x = w.apply(ex, true, v, i)).compare(y) < 0) {
+ z = v[0].Car;
+ y = x;
+ }
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ }
+ }
+ return z;
+
+# (fish 'fun 'any) -> lst
+fish (w v)
+ w = ex.Cdr.Car.eval();
+ (v = new Any[1])[0] = ex.Cdr.Cdr.Car.eval();
+ return fish(ex, w, v, Nil);
+
+# (by 'fun1 'fun2 'lst ..) -> lst
+by (i j w x y z v)
+ w = (x = ex.Cdr).Car.eval();
+ y = (x = x.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);
+ z = x = new Cell(new Cell(w.apply(ex, true, v, i), v[0].Car), Nil);
+ while (v[0].Cdr instanceof Cell) {
+ for (j = i; --j >= 0;)
+ v[j] = v[j].Cdr;
+ x = x.Cdr = new Cell(new Cell(w.apply(ex, true, v, i), v[0].Car), Nil);
+ }
+ v[0] = z;
+ z = y.apply(ex, false, v, 1);
+ for (x = z; x instanceof Cell; x = x.Cdr)
+ x.Car = x.Car.Cdr;
+ }
+ return z;
+
+############ flow ############
+# (as 'any1 . any2) -> any2 | NIL
+as ()
+ return ex.Cdr.Car.eval() == Nil? Nil : ex.Cdr.Cdr;
+
+# (lit 'any) -> any
+lit (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Number || x == Nil || x == T || x instanceof Cell && x.Car instanceof Number? x : new Cell(Quote, x);
+
+# (eval 'any ['cnt ['lst]]) -> any
+eval (y)
+ if ((y = (ex = ex.Cdr).Car.eval()) instanceof Number)
+ return y;
+ if (ex.Cdr == Nil || Env.Bind == null)
+ return y.eval();
+ return evRun(true, y, evInt(ex.Cdr), ex.Cdr.Cdr.Car.eval());
+
+# (run 'any ['cnt ['lst]]) -> any
+run (y)
+ if ((y = (ex = ex.Cdr).Car.eval()) instanceof Number)
+ return y;
+ if (ex.Cdr == Nil || Env.Bind == null)
+ return y.run();
+ return evRun(false, y, evInt(ex.Cdr), ex.Cdr.Cdr.Car.eval());
+
+# (def 'sym 'any) -> sym
+# (def 'sym 'sym 'any) -> sym
+def (w x y s)
+ s = (Symbol)(ex = ex.Cdr).Car.eval();
+ x = (ex = ex.Cdr).Car.eval();
+ if (ex.Cdr == Nil) {
+ if (s.Car != Nil && s.Car != s && !x.equal(s.Car))
+ redefMsg(s, null);
+ s.Car = x;
+ putSrc(s, null);
+ }
+ else {
+ y = ex.Cdr.Car.eval();
+ if ((w = s.get(x)) != Nil && !x.equal(w))
+ redefMsg(s,x);
+ s.put(x,y);
+ putSrc(s,x);
+ }
+ return s;
+
+# (de sym . any) -> sym
+de ()
+ ex = ex.Cdr;
+ redefine((Symbol)ex.Car, ex.Cdr);
+ return ex.Car;
+
+# (dm sym . fun|cls2) -> sym
+# (dm (sym . cls) . fun|cls2) -> sym
+# (dm (sym sym2 [. cls]) . fun|cls2) -> sym
+dm (x y s t)
+ if (!((x = ex.Cdr).Car instanceof Cell)) {
+ s = (Symbol)x.Car;
+ t = (Symbol)Class.Car;
+ }
+ else {
+ s = (Symbol)x.Car.Car;
+ t = (Symbol)
+ (!((y = x.Car).Cdr instanceof Cell)?
+ y.Cdr :
+ (y.Cdr.Cdr == Nil? Class.Car : y.Cdr.Cdr).get(y.Cdr.Car) );
+ }
+ if (s != T)
+ redefine(s, Meth.Car);
+ if (x.Cdr instanceof Symbol) {
+ y = x.Cdr.Car;
+ 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 = t.Car; y instanceof Cell && y.Car instanceof Cell; y = y.Cdr)
+ if (y.Car.Car == s) {
+ if (!x.Cdr.equal(y.Cdr.Car))
+ redefMsg(s, t);
+ y.Car.Cdr = x.Cdr;
+ putSrc(t, s);
+ return s;
+ }
+ t.Car = x.Car instanceof Cell?
+ new Cell(new Cell(s, x.Cdr), t.Car) :
+ new Cell(x, t.Car);
+ putSrc(t, s);
+ return s;
+
+# (box 'any) -> sym
+box ()
+ return mkSymbol(ex.Cdr.Car.eval());
+
+# (new ['typ ['any ..]]) -> obj
+new (x s)
+ s = mkSymbol((ex = ex.Cdr).Car.eval());
+ TheKey = T; TheCls = null;
+ if ((x = method(s)) != null)
+ evMethod(s, x, ex.Cdr);
+ else {
+ while ((ex = ex.Cdr) != Nil) {
+ x = ex.Car.eval();
+ s.put(x, (ex = ex.Cdr).Car.eval());
+ }
+ }
+ return s;
+
+# (type 'any) -> lst
+type (x y z)
+ if ((x = ex.Cdr.Car.eval()) instanceof Symbol) {
+ z = x = x.Car;
+ while (x instanceof Cell) {
+ if (!(x.Car instanceof Cell)) {
+ y = x;
+ while (x.Car instanceof Symbol) {
+ if (!((x = x.Cdr) instanceof Cell))
+ return x == Nil? y : Nil;
+ if (z == x)
+ return Nil;
+ }
+ return Nil;
+ }
+ if (z == (x = x.Cdr))
+ return Nil;
+ }
+ }
+ return Nil;
+
+# (isa 'cls|typ 'any) -> obj | NIL
+isa (x y)
+ x = (ex = ex.Cdr).Car.eval();
+ if ((y = ex.Cdr.Car.eval()) instanceof Symbol) {
+ if (x instanceof Symbol)
+ return isa(x,y)? y : Nil;
+ while (x instanceof Cell) {
+ if (!isa(x.Car, y))
+ return Nil;
+ x = x.Cdr;
+ }
+ return y;
+ }
+ return Nil;
+
+# (method 'msg 'obj) -> fun
+method (x y)
+ x = (ex = ex.Cdr).Car.eval();
+ y = ex.Cdr.Car.eval();
+ TheKey = x;
+ return (x = method(y)) == null? Nil : x;
+
+# (send 'msg 'obj ['any ..]) -> any
+send (x y z)
+ y = (x = ex.Cdr).Car.eval();
+ z = (x = x.Cdr).Car.eval();
+ TheKey = y; TheCls = null;
+ if ((y = method(z)) == null)
+ err(ex, TheKey, "Bad message");
+ return evMethod(z, y, x.Cdr);
+
+# (try 'msg 'obj ['any ..]) -> any
+try (x y)
+ x = (ex = ex.Cdr).Car.eval();
+ if ((y = (ex = ex.Cdr).Car.eval()) instanceof Symbol) {
+ TheKey = x; TheCls = null;
+ if ((x = method(y)) != null)
+ return evMethod(y, x, ex.Cdr);
+ }
+ return Nil;
+
+# (super ['any ..]) -> any
+super (w x y z)
+ TheKey = Env.Key;
+ x = Env.Cls == null? This.Car : Env.Cls.Car.Car;
+ while (x.Car instanceof Cell)
+ x = x.Cdr;
+ for (;;) {
+ if (!(x instanceof Cell))
+ err(ex, TheKey, "Bad super");
+ if ((y = method((TheCls = x).Car)) != null) {
+ z = Env.Cls; Env.Cls = TheCls;
+ w = Env.Key; Env.Key = TheKey;
+ x = y.func(ex);
+ Env.Key = w; Env.Cls = z;
+ return x;
+ }
+ x = x.Cdr;
+ }
+
+# (extra ['any ..]) -> any
+extra (x y z)
+ TheKey = Env.Key;
+ if ((x = extra(This.Car)) == null || x == T)
+ err(ex, TheKey, "Bad extra");
+ y = Env.Cls; Env.Cls = TheCls;
+ z = Env.Key; Env.Key = TheKey;
+ x = x.func(ex);
+ Env.Key = z; Env.Cls = y;
+ return x;
+
+# (with 'sym . prg) -> any
+with (x bnd)
+ if ((x = ex.Cdr.Car.eval()) != Nil) {
+ (bnd = new Bind()).add(This.Car);
+ bnd.add(This);
+ This.Car = x;
+ Env.Bind = bnd;
+ x = ex.Cdr.Cdr.prog();
+ This.Car = bnd.Data[0];
+ }
+ return x;
+
+# (bind 'sym|lst . prg) -> any
+bind (i x y z bnd)
+ if ((y = (x = ex.Cdr).Car.eval()) == Nil)
+ return x.Cdr.prog();
+ bnd = new Bind();
+ if (y instanceof Symbol) {
+ bnd.add(y.Car);
+ bnd.add(y);
+ }
+ else {
+ do {
+ if (y.Car instanceof Symbol) {
+ bnd.add(y.Car.Car);
+ bnd.add(y.Car);
+ }
+ else {
+ z = y.Car.Car;
+ bnd.add(z.Car);
+ bnd.add(z);
+ z.Car = y.Car.Cdr;
+ }
+ } while ((y = y.Cdr) instanceof Cell);
+ }
+ Env.Bind = bnd;
+ x = x.Cdr.prog();
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+
+# (job 'lst . prg) -> any
+job (i w x y z bnd)
+ bnd = new Bind();
+ for (z = y = (x = ex.Cdr).Car.eval(); y instanceof Cell; y = y.Cdr) {
+ w = y.Car.Car;
+ bnd.add(w.Car);
+ bnd.add(w);
+ w.Car = y.Car.Cdr;
+ }
+ Env.Bind = bnd;
+ x = x.Cdr.prog();
+ for (i = 0; z instanceof Cell; i += 2, z = z.Cdr) {
+ w = z.Car.Car;
+ z.Car.Cdr = w.Car;
+ w.Car = bnd.Data[i];
+ }
+ Env.Bind = bnd.Link;
+ return x;
+
+# (let sym 'any . prg) -> any
+# (let (sym 'any ..) . prg) -> any
+let (i x y z bnd)
+ bnd = new Bind();
+ if ((y = (x = ex.Cdr).Car) instanceof Symbol) {
+ bnd.add(y.Car);
+ bnd.add(y);
+ y.Car = (x = x.Cdr).Car.eval();
+ }
+ else {
+ do {
+ z = y.Car;
+ bnd.add(z.Car);
+ bnd.add(z);
+ z.Car = (y = y.Cdr).Car.eval();
+ } while ((y = y.Cdr) instanceof Cell);
+ }
+ Env.Bind = bnd;
+ x = x.Cdr.prog();
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+
+# (let? sym 'any . prg) -> any
+let? (x y z bnd)
+ z = (x = ex.Cdr).Car;
+ if ((y = (x = x.Cdr).Car.eval()) != Nil) {
+ (bnd = new Bind()).add(z.Car);
+ bnd.add(z);
+ z.Car = y;
+ Env.Bind = bnd;
+ y = x.Cdr.prog();
+ z.Car = bnd.Data[0];
+ }
+ return y;
+
+# (use sym . prg) -> any
+# (use (sym ..) . prg) -> any
+use (i x y bnd)
+ bnd = new Bind();
+ if ((y = (x = ex.Cdr).Car) instanceof Symbol) {
+ bnd.add(y.Car);
+ bnd.add(y);
+ }
+ else {
+ do {
+ bnd.add(y.Car.Car);
+ bnd.add(y.Car);
+ } while ((y = y.Cdr) instanceof Cell);
+ }
+ Env.Bind = bnd;
+ x = x.Cdr.prog();
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return x;
+
+# (and 'any ..) -> any
+and (w)
+ ex = ex.Cdr;
+ do {
+ if ((w = ex.Car.eval()) == Nil)
+ return Nil;
+ At.Car = w;
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return w;
+
+# (or 'any ..) -> any
+or (w)
+ ex = ex.Cdr;
+ do
+ if ((w = ex.Car.eval()) != Nil)
+ return At.Car = w;
+ while ((ex = ex.Cdr) instanceof Cell);
+ return Nil;
+
+# (nand 'any ..) -> flg
+nand (w)
+ ex = ex.Cdr;
+ do {
+ if ((w = ex.Car.eval()) == Nil)
+ return T;
+ At.Car = w;
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return Nil;
+
+# (nor 'any ..) -> flg
+nor (w)
+ ex = ex.Cdr;
+ do
+ if ((w = ex.Car.eval()) != Nil) {
+ At.Car = w;
+ return Nil;
+ }
+ while ((ex = ex.Cdr) instanceof Cell);
+ return T;
+
+# (xor 'any 'any) -> flg
+xor (x y)
+ y = (x = ex.Cdr).Car.eval();
+ x = x.Cdr.Car.eval();
+ return y == Nil ^ x == Nil? T : Nil;
+
+# (bool 'any) -> flg
+bool ()
+ return ex.Cdr.Car.eval() == Nil? Nil : T;
+
+# (not 'any) -> flg
+not (w)
+ if ((w = ex.Cdr.Car.eval()) == Nil)
+ return T;
+ At.Car = w;
+ return Nil;
+
+# (nil . prg) -> NIL
+nil ()
+ ex.Cdr.prog();
+ return Nil;
+
+# (t . prg) -> T
+t ()
+ ex.Cdr.prog();
+ return T;
+
+# (prog . prg) -> any
+prog T
+ return ex.Cdr.prog();
+
+# (prog1 'any1 . prg) -> any1
+prog1 (w)
+ w = At.Car = ex.Cdr.Car.eval();
+ ex.Cdr.Cdr.prog();
+ return w;
+
+# (prog2 'any1 'any2 . prg) -> any2
+prog2 (w)
+ (ex = ex.Cdr).Car.eval();
+ w = At.Car = (ex = ex.Cdr).Car.eval();
+ ex.Cdr.prog();
+ return w;
+
+# (if 'any1 'any2 . prg) -> any
+if (w)
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil)
+ return ex.Cdr.Cdr.prog();
+ At.Car = w;
+ return ex.Cdr.Car.eval();
+
+# (if2 'any1 'any2 'any3 'any4 'any5 . prg) -> any
+if2 (w)
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil) {
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil)
+ return ex.Cdr.Cdr.Cdr.Cdr.prog();
+ At.Car = w;
+ return ex.Cdr.Cdr.Cdr.Car.eval();
+ }
+ At.Car = w;
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil)
+ return ex.Cdr.Cdr.Car.eval();
+ At.Car = w;
+ return ex.Cdr.Car.eval();
+
+# (ifn 'any1 'any2 . prg) -> any
+ifn (w)
+ if ((w = (ex = ex.Cdr).Car.eval()) != Nil) {
+ At.Car = w;
+ return ex.Cdr.Cdr.prog();
+ }
+ return ex.Cdr.Car.eval();
+
+# (when 'any . prg) -> any
+when (w)
+ if ((w = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ At.Car = w;
+ return ex.Cdr.prog();
+
+# (unless 'any . prg) -> any
+unless (w)
+ if ((w = (ex = ex.Cdr).Car.eval()) != Nil)
+ return Nil;
+ At.Car = w;
+ return ex.Cdr.prog();
+
+# (cond ('any1 . prg1) ('any2 . prg2) ..) -> any
+cond (w)
+ while ((ex = ex.Cdr) instanceof Cell)
+ if ((w = ex.Car.Car.eval()) != Nil) {
+ At.Car = w;
+ return ex.Car.Cdr.prog();
+ }
+ return Nil;
+
+# (nond ('any1 . prg1) ('any2 . prg2) ..) -> any
+nond (w)
+ while ((ex = ex.Cdr) instanceof Cell) {
+ if ((w = ex.Car.Car.eval()) == Nil)
+ return ex.Car.Cdr.prog();
+ At.Car = w;
+ }
+ return Nil;
+
+# (case 'any (any1 . prg1) (any2 . prg2) ..) -> any
+case (x y)
+ At.Car = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell) {
+ x = ex.Car; y = x.Car;
+ if (y == T || At.Car.equal(y))
+ return x.Cdr.prog();
+ if (y instanceof Cell) {
+ do
+ if (At.Car.equal(y.Car))
+ return x.Cdr.prog();
+ while ((y = y.Cdr) instanceof Cell);
+ }
+ }
+ return Nil;
+
+# (state 'var (sym|lst exe [. prg]) ..) -> any
+state (w x y z)
+ z = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell) {
+ y = x.Car;
+ if (y.Car == T || memq(z.Car, y.Car) != null) {
+ y = y.Cdr;
+ if ((w = y.Car.eval()) != Nil) {
+ At.Car = z.Car = w;
+ return y.Cdr.prog();
+ }
+ }
+ }
+ return Nil;
+
+# (while 'any . prg) -> any
+while (w x y)
+ x = (ex = ex.Cdr).Car;
+ ex = ex.Cdr;
+ y = Nil;
+ while ((w = x.eval()) != Nil) {
+ At.Car = w;
+ y = ex.prog();
+ }
+ return y;
+
+# (until 'any . prg) -> any
+until (w x y)
+ x = (ex = ex.Cdr).Car;
+ ex = ex.Cdr;
+ y = Nil;
+ while ((w = x.eval()) == Nil)
+ y = ex.prog();
+ At.Car = w;
+ return y;
+
+# (do 'flg|cnt ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+do (n w x y)
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ if (!(x instanceof Number))
+ return loop(ex.Cdr);
+ for (ex = ex.Cdr, y = Nil, n = ((Number)x).longValue(); --n >= 0;) {
+ x = ex;
+ do {
+ if (!((y = x.Car) instanceof Cell))
+ y = y.eval();
+ else if (y.Car == Nil) {
+ if ((w = (y = y.Cdr).Car.eval()) == Nil)
+ return y.Cdr.prog();
+ At.Car = w;
+ y = Nil;
+ }
+ else if (y.Car == T) {
+ if ((w = (y = y.Cdr).Car.eval()) != Nil) {
+ At.Car = w;
+ return y.Cdr.prog();
+ }
+ y = Nil;
+ }
+ else
+ y = y.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ }
+ return y;
+
+# (loop ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+loop T
+ return loop(ex.Cdr);
+
+# (at '(cnt1 . cnt2) . prg) -> any
+at (num x)
+ x = (ex = ex.Cdr).Car.eval();
+ if ((num = ((Number)x.Car).add(One)).compare((Number)x.Cdr) < 0) {
+ x.Car = num;
+ return Nil;
+ }
+ x.Car = Zero;
+ return ex.Cdr.prog();
+
+# (for sym 'num ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+# (for sym|(sym2 . sym) 'lst ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+# (for (sym|(sym2 . sym) 'any1 'any2 [. prg]) ['any | (NIL 'any . prg) | (T 'any . prg) ..]) -> any
+for (i w x y z bnd)
+ bnd = new Bind();
+ if (!((y = (ex = ex.Cdr).Car) instanceof Cell) || !(y.Cdr instanceof Cell)) {
+ if (!(y instanceof Cell)) {
+ bnd.add(y.Car);
+ bnd.add(y);
+ }
+ else {
+ bnd.add(y.Cdr.Car);
+ bnd.add(y.Cdr);
+ bnd.add((z = y.Car).Car);
+ bnd.add(z);
+ z.Car = Zero;
+ }
+ Env.Bind = bnd;
+ if ((z = (ex = ex.Cdr).Car.eval()) instanceof Number)
+ bnd.Data[1].Car = Zero;
+ for1:
+ for (y = Nil;;) {
+ if (z instanceof Number) {
+ if (((Number)(bnd.Data[1].Car = ((Number)bnd.Data[1].Car).add(One))).compare((Number)z) > 0)
+ break;
+ }
+ else {
+ if (!(z instanceof Cell))
+ break;
+ bnd.Data[1].Car = z.Car;
+ if (!((z = z.Cdr) instanceof Cell))
+ z = Nil;
+ }
+ if (bnd.Cnt == 4)
+ bnd.Data[3].Car = ((Number)bnd.Data[3].Car).add(One);
+ x = ex.Cdr;
+ do {
+ if (!((y = x.Car) instanceof Cell))
+ y = y.eval();
+ else if (y.Car == Nil) {
+ if ((w = (y = y.Cdr).Car.eval()) == Nil) {
+ y = y.Cdr.prog();
+ break for1;
+ }
+ At.Car = w;
+ y = Nil;
+ }
+ else if (y.Car == T) {
+ if ((w = (y = y.Cdr).Car.eval()) != Nil) {
+ At.Car = w;
+ y = y.Cdr.prog();
+ break for1;
+ }
+ y = Nil;
+ }
+ else
+ y = y.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ }
+ }
+ else {
+ if (!((z = y.Car) instanceof Cell)) {
+ bnd.add(z.Car);
+ bnd.add(z);
+ }
+ else {
+ bnd.add(z.Cdr.Car);
+ bnd.add(z.Cdr);
+ bnd.add((z = z.Car).Car);
+ bnd.add(z);
+ z.Car = Zero;
+ }
+ Env.Bind = bnd;
+ bnd.Data[1].Car = (y = y.Cdr).Car.eval();
+ z = y.Cdr;
+ for2:
+ for (y = Nil; (w = z.Car.eval()) != Nil;) {
+ At.Car = w;
+ if (bnd.Cnt == 4)
+ bnd.Data[3].Car = ((Number)bnd.Data[3].Car).add(One);
+ x = ex.Cdr;
+ do {
+ if (!((y = x.Car) instanceof Cell))
+ y = y.eval();
+ else if (y.Car == Nil) {
+ if ((w = (y = y.Cdr).Car.eval()) == Nil) {
+ y = y.Cdr.prog();
+ break for2;
+ }
+ At.Car = w;
+ y = Nil;
+ }
+ else if (y.Car == T) {
+ if ((w = (y = y.Cdr).Car.eval()) != Nil) {
+ At.Car = w;
+ y = y.Cdr.prog();
+ break for2;
+ }
+ y = Nil;
+ }
+ else
+ y = y.eval();
+ if (z.Cdr instanceof Cell)
+ bnd.Data[1].Car = z.Cdr.prog();
+ } while ((x = x.Cdr) instanceof Cell);
+ }
+ }
+ for (i = bnd.Cnt; (i -= 2) >= 0;)
+ bnd.Data[i+1].Car = bnd.Data[i];
+ Env.Bind = bnd.Link;
+ return y;
+
+# (catch 'any . prg) -> any
+catch (x y)
+ new Catch(y = (x = ex.Cdr).Car.eval(), Zero, Env);
+ try {
+ x = x.Cdr.prog();
+ Catch = Catch.Link;
+ return x;
+ }
+ catch (Control e) {
+ if (y == e.Tag)
+ return e.Val;
+ throw e;
+ }
+ catch (RuntimeException e) {
+ if (y instanceof Cell && e.toString().indexOf(y.Car.name()) >= 0)
+ return y.Car;
+ throw e;
+ }
+
+# (throw 'sym 'any)
+throw (x y)
+ y = (x = ex.Cdr).Car.eval();
+ throw new Control(ex, y, x.Cdr.Car.eval());
+
+# (finally exe . prg) -> any
+finally (x y)
+ new Catch(null, y = (x = ex.Cdr).Car, Env);
+ x = x.Cdr.prog();
+ y.eval();
+ Catch = Catch.Link;
+ return x;
+
+# (! . exe) -> any
+! (x)
+ x = ex.Cdr;
+ if (Dbg.Car != Nil)
+ x = brkLoad(x);
+ return x.eval();
+
+# (e . prg) -> any
+e (w x y z)
+ if (!Break)
+ err(ex, null, "No Break");
+ w = Dbg.Car; Dbg.Car = Nil;
+ x = At.Car; At.Car = Brk.Data[4];
+ y = Run.Car; Run.Car = Brk.Data[2];
+ InFrame in = Env.InFrames; Env.popInFiles();
+ OutFrame out = Env.OutFrames; Env.popOutFiles();
+ z = ex.Cdr instanceof Cell? ex.Cdr.prog() : Up.Car.eval();
+ OutFile.Wr.flush();
+ Env.pushOutFile(out);
+ Env.pushInFile(in);
+ Dbg.Car = w;
+ At.Car = x;
+ Run.Car = y;
+ return z;
+
+# ($ sym|lst lst . prg) -> any
+$ (i x)
+ ex = ex.Cdr;
+ if (Dbg.Car == Nil)
+ return ex.Cdr.Cdr.prog();
+ trace(++Env.Trace, ex.Car, " :");
+ for (x = ex.Cdr.Car; x instanceof Cell; x = x.Cdr) {
+ StdErr.space();
+ StdErr.print(x.Car.Car);
+ }
+ if (x != Nil) {
+ if (x != At) {
+ StdErr.space();
+ StdErr.print(x.Car);
+ }
+ else
+ for (i = Env.Next; i < Env.ArgC; ++i) {
+ StdErr.space();
+ StdErr.print(Env.Args[i]);
+ }
+ }
+ StdErr.newline();
+ x = ex.Cdr.Cdr.prog();
+ trace(Env.Trace--, ex.Car, " = ");
+ StdErr.print(x);
+ StdErr.newline();
+ return x;
+
+# (sys 'any) -> sym
+sys ()
+ return mkStr(System.getenv(evString(ex.Cdr)));
+
+# (call 'any ..) -> flg
+call (i j x)
+ j = (int)(x = ex.Cdr).length();
+ String[] cmd = new String[j];
+ for (i = 0; i < j; ++i) {
+ cmd[i] = x.Car.eval().name();
+ x = x.Cdr;
+ }
+ try {i = Runtime.getRuntime().exec(cmd).waitFor();}
+ catch (IOException e) {System.err.println(cmd[0] + ": Can't exec");}
+ catch (InterruptedException e) {} //#! sighandler()
+ return i == 0? T : Nil;
+
+# (ipid) -> pid | NIL
+ipid ()
+ return Env.InFrames != null && Env.InFrames.Pid > 1? new Number(Env.InFrames.Pid) : Nil;
+
+# (opid) -> pid | NIL
+opid ()
+ return Env.OutFrames != null && Env.OutFrames.Pid > 1? new Number(Env.OutFrames.Pid) : Nil;
+
+# (kill 'pid ['cnt]) -> flg
+kill (i)
+ if (Pids[i = evInt(ex = ex.Cdr)] == null)
+ return Nil;
+ if ((ex = ex.Cdr) instanceof Cell && evInt(ex) == 0)
+ return T;
+ Pids[i].destroy();
+ return T;
+
+# (bye 'cnt|NIL)
+bye (x)
+ x = ex.Cdr.Car.eval();
+ return bye(x == Nil? 0 : ((Number)x).Cnt);
+
+############ sym ############
+# (name 'sym ['sym2]) -> sym
+name (x y s)
+ y = (x = ex.Cdr).Car.eval();
+ if (!((x = x.Cdr) instanceof Cell))
+ return mkStr(y.name());
+ if ((s = ((Symbol)y)).Name != null && Intern.get(s.Name) == s)
+ err(ex, s, "Can't rename");
+ ((Symbol)(x = x.Car.eval())).Name = s.Name;
+ return s;
+
+# (sp? 'any) -> flg
+sp? ()
+ return isBlank(ex.Cdr.Car.eval())? T : Nil;
+
+# (pat? 'any) -> sym | NIL
+pat? (x)
+ return ((x = ex.Cdr.Car.eval()) instanceof Symbol) && firstChar(x) == '@'? x : Nil;
+
+# (fun? 'any) -> any
+fun? ()
+ return funq(ex.Cdr.Car.eval());
+
+# (getd 'any) -> fun | NIL
+getd (x)
+ if (!((x = ex.Cdr.Car.eval()) instanceof Symbol))
+ return Nil;
+ return funq(x.Car) != Nil? x.Car : Nil; // ... reflection
+
+# (all ['T]) -> lst
+all ()
+ return all(ex.Cdr.Car.eval() == Nil? Intern : Transient);
+
+# (intern 'sym) -> sym
+intern (s t str)
+ s = (Symbol)ex.Cdr.Car.eval();
+ if ((str = s.name()).length() == 0 || str.equals("NIL"))
+ return Nil;
+ if ((t = Intern.get(str)) != null)
+ return t;
+ Intern.put(str, s);
+ return s;
+
+# (==== ['sym ..]) -> NIL
+==== (x y)
+ 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;
+
+# (box? 'any) -> sym | NIL
+box? (x)
+ return ((x = ex.Cdr.Car.eval()) instanceof Symbol) && x.name().length() == 0? x : Nil;
+
+# (str? 'any) -> sym | NIL
+str? (x)
+ return ((x = ex.Cdr.Car.eval()) instanceof Symbol) && Intern.get(x.name()) == null? x : Nil;
+
+# (zap 'sym) -> sym
+zap (s)
+ s = (Symbol)ex.Cdr.Car.eval();
+ Intern.remove(s.name());
+ return s;
+
+# (chop 'any) -> lst
+chop (x y str)
+ x = ex.Cdr.Car.eval();
+ if (!(x instanceof Cell)) {
+ str = x.name();
+ if (str.length() == 0)
+ return Nil;
+ y = x = new Cell(mkChar(str.charAt(0)), Nil);
+ for (int i = 1; i < str.length(); ++i)
+ y = y.Cdr = new Cell(mkChar(str.charAt(i)), Nil);
+ }
+ return x;
+
+# (pack 'any ..) -> sym
+pack (sb)
+ sb = new StringBuilder();
+ for (ex = ex.Cdr; ex instanceof Cell; ex = ex.Cdr)
+ sb.append(evString(ex));
+ return mkStr(sb);
+
+# (glue 'any 'lst) -> sym
+glue (x y sb)
+ x = ex.Cdr.Car.eval();
+ if (!((y = ex.Cdr.Cdr.Car.eval()) instanceof Cell))
+ return y;
+ for (sb = new StringBuilder(), sb.append(y.Car.name()); (y = y.Cdr) instanceof Cell;) {
+ sb.append(x.name());
+ sb.append(y.Car.name());
+ }
+ return mkStr(sb);
+
+# (text 'any1 'any ..) -> sym
+text (i j k c str sb v)
+ str = evString(ex = ex.Cdr);
+ v = new Any[6];
+ i = 0;
+ while ((ex = ex.Cdr) instanceof Cell)
+ v = append(v, i++, ex.Car.eval());
+ sb = new StringBuilder();
+ k = str.length();
+ for (j = 0; j < k; ++j)
+ if ((c = str.charAt(j)) != '@')
+ sb.append(c);
+ else if (++j == k)
+ break;
+ else if ((c = str.charAt(j)) == '@')
+ sb.append('@');
+ else if (c >= '1') {
+ if ((c -= '1') > 8)
+ c -= 7;
+ if (i > c)
+ sb.append(v[c].name());
+ }
+ return mkStr(sb);
+
+# (pre? 'any1 'any2) -> any2 | NIL
+pre? (x str)
+ str = evString(ex = ex.Cdr);
+ return (x = ex.Cdr.Car.eval()).name().startsWith(str)? x : Nil;
+
+# (sub? 'any1 'any2) -> any2 | NIL
+sub? (x str)
+ str = evString(ex = ex.Cdr);
+ return (x = ex.Cdr.Car.eval()).name().indexOf(str) >= 0? x : Nil;
+
+# (val 'var) -> any
+val T
+ return ex.Cdr.Car.eval().Car;
+
+# (set 'var 'any ..) -> any
+set (x y)
+ x = ex.Cdr;
+ do {
+ y = x.Car.eval();
+ needVar(ex, y);
+ y.Car = (x = x.Cdr).Car.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ return y.Car;
+
+# (setq var 'any ..) -> any
+setq (x y)
+ x = ex.Cdr;
+ do {
+ y = x.Car;
+ needVar(ex, y);
+ y.Car = (x = x.Cdr).Car.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ return y.Car;
+
+# (xchg 'var 'var ..) -> any
+xchg (w x y z)
+ x = ex.Cdr;
+ do {
+ needVar(ex, y = x.Car.eval());
+ needVar(ex, z = (x = x.Cdr).Car.eval());
+ w = y.Car; y.Car = z.Car; z.Car = w;
+ } while ((x = x.Cdr) instanceof Cell);
+ return w;
+
+# (on var ..) -> T
+on (x)
+ x = ex.Cdr;
+ do
+ x.Car.Car = T;
+ while ((x = x.Cdr) instanceof Cell);
+ return T;
+
+# (off var ..) -> NIL
+off (x)
+ x = ex.Cdr;
+ do
+ x.Car.Car = Nil;
+ while ((x = x.Cdr) instanceof Cell);
+ return Nil;
+
+# (onOff var ..) -> flg
+onOff (x y)
+ x = ex.Cdr;
+ do
+ y = x.Car.Car = x.Car.Car == Nil? T : Nil;
+ while ((x = x.Cdr) instanceof Cell);
+ return y;
+
+# (zero var ..) -> 0
+zero (x)
+ x = ex.Cdr;
+ do
+ x.Car.Car = Zero;
+ while ((x = x.Cdr) instanceof Cell);
+ return Zero;
+
+# (one var ..) -> 1
+one (x)
+ x = ex.Cdr;
+ do
+ x.Car.Car = One;
+ while ((x = x.Cdr) instanceof Cell);
+ return One;
+
+# (default var 'any ..) -> any
+default (x y)
+ x = ex.Cdr;
+ do {
+ y = x.Car;
+ x = x.Cdr;
+ needVar(ex, y);
+ if (y.Car == Nil)
+ y.Car = x.Car.eval();
+ } while ((x = x.Cdr) instanceof Cell);
+ return y.Car;
+
+# (push 'var 'any ..) -> any
+push (x y z)
+ needVar(ex, y = (x = ex.Cdr).Car.eval());
+ do
+ y.Car = new Cell(z = (x = x.Cdr).Car.eval(), y.Car);
+ while (x.Cdr instanceof Cell);
+ return z;
+
+# (push1 'var 'any ..) -> any
+push1 (x y z)
+ needVar(ex, y = (x = ex.Cdr).Car.eval());
+ do
+ if (member(z = (x = x.Cdr).Car.eval(), y.Car) == null)
+ y.Car = new Cell(z, y.Car);
+ while (x.Cdr instanceof Cell);
+ return z;
+
+# (pop 'var) -> any
+pop (x y)
+ needVar(ex, x = ex.Cdr.Car.eval());
+ if ((y = x.Car) instanceof Cell) {
+ x.Car = x.Car.Cdr;
+ y = y.Car;
+ }
+ return y;
+
+# (cut 'cnt 'var) -> lst
+cut (n x y z)
+ if ((n = evLong(ex.Cdr)) <= 0)
+ return Nil;
+ needVar(ex, x = ex.Cdr.Cdr.Car.eval());
+ if (x.Car instanceof Cell) {
+ z = y = new Cell(x.Car.Car, Nil);
+ while ((x.Car = x.Car.Cdr) instanceof Cell && --n != 0)
+ y = y.Cdr = new Cell(x.Car.Car, Nil);
+ return z;
+ }
+ return x.Car;
+
+# (del 'any 'var) -> lst
+del (w lst x y z)
+ w = ex.Cdr.Car.eval();
+ needVar(ex, x = ex.Cdr.Cdr.Car.eval());
+ if ((lst = x.Car) instanceof Cell) {
+ if (w.equal(lst.Car))
+ return x.Car = lst.Cdr;
+ for (z = y = new Cell(lst.Car, Nil); (lst = lst.Cdr) instanceof Cell; y = y.Cdr = new Cell(lst.Car, Nil))
+ if (w.equal(lst.Car)) {
+ y.Cdr = lst.Cdr;
+ return x.Car = z;
+ }
+ }
+ return x.Car;
+
+# (queue 'var 'any) -> any
+queue (x y)
+ needVar(ex, x = ex.Cdr.Car.eval());
+ y = ex.Cdr.Cdr.Car.eval();
+ if (!(x.Car instanceof Cell))
+ x.Car = new Cell(y, Nil);
+ else {
+ for (x = x.Car; x.Cdr instanceof Cell; x = x.Cdr);
+ x.Cdr = new Cell(y, Nil);
+ }
+ return y;
+
+# (fifo 'var ['any ..]) -> any
+fifo (x y z lst)
+ needVar(ex, y = (x = ex.Cdr).Car.eval());
+ if ((x = x.Cdr) instanceof Cell) {
+ z = x.Car.eval();
+ if ((lst = y.Car) instanceof Cell)
+ y.Car = lst = lst.Cdr = new Cell(z, lst.Cdr);
+ else {
+ lst = y.Car = new Cell(z, Nil);
+ lst.Cdr = lst;
+ }
+ while ((x = x.Cdr) instanceof Cell)
+ y.Car = lst = lst.Cdr = new Cell(z = x.Car.eval(), lst.Cdr);
+ return z;
+ }
+ if (!((lst = y.Car) instanceof Cell))
+ return Nil;
+ if (lst == lst.Cdr) {
+ z = lst.Car;
+ y.Car = Nil;
+ }
+ else {
+ z = lst.Cdr.Car;
+ lst.Cdr = lst.Cdr.Cdr;
+ }
+ return z;
+
+# (idx 'var 'any 'flg) -> lst
+# (idx 'var 'any) -> lst
+# (idx 'var) -> lst
+idx (x y)
+ needVar(ex, x = (ex = ex.Cdr).Car.eval());
+ if (!((ex = ex.Cdr) instanceof Cell))
+ return idx(x, null, 0);
+ y = ex.Car.eval();
+ return idx(x, y, ex.Cdr instanceof Cell? (ex.Cdr.Car.eval() == Nil? -1 : +1) : 0);
+
+# (lup 'lst 'any) -> lst
+# (lup 'lst 'any 'any2) -> lst
+lup (i x y z)
+ x = (ex = ex.Cdr).Car.eval();
+ y = (ex = ex.Cdr).Car.eval();
+ if ((z = ex.Cdr.Car.eval()) != Nil)
+ return consLup(x, Nil, y, z);
+ while (x instanceof Cell) {
+ if (x.Car == T)
+ x = x.Cdr.Car;
+ else if (!(x.Car instanceof Cell))
+ x = x.Cdr.Cdr;
+ else if ((i = y.compare(x.Car.Car)) == 0)
+ return x.Car;
+ else
+ x = i < 0? x.Cdr.Car : x.Cdr.Cdr;
+ }
+ return Nil;
+
+# (put 'sym1|lst ['sym2|cnt ..] 'sym|0 'any) -> any
+put (x y)
+ x = (ex = ex.Cdr).Car.eval();
+ for (;;) {
+ y = (ex = ex.Cdr).Car.eval();
+ if (!(ex.Cdr.Cdr instanceof Cell))
+ return x.put(y, ex.Cdr.Car.eval());
+ x = x.get(y);
+ }
+
+# (get 'sym1|lst ['sym2|cnt ..]) -> any
+get (x)
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.get(ex.Car.eval());
+ return x;
+
+# (prop 'sym1|lst ['sym2|cnt ..] 'sym) -> lst|sym
+prop (x)
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr).Cdr instanceof Cell)
+ x = x.get(ex.Car.eval());
+ return x.prop(ex.Car.eval());
+
+# (; 'sym1|lst [sym2|cnt ..]) -> any
+; (x)
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.get(ex.Car);
+ return x;
+
+# (=: sym|0 [sym1|cnt .. sym2|0] 'any) -> any
+=: (x y)
+ for (x = This.Car;;) {
+ y = (ex = ex.Cdr).Car;
+ if (!(ex.Cdr.Cdr instanceof Cell))
+ return x.put(y, ex.Cdr.Car.eval());
+ x = x.get(y);
+ }
+
+# (: sym|0 [sym1|cnt ..]) -> any
+: (x)
+ x = This.Car;
+ do
+ x = x.get((ex = ex.Cdr).Car);
+ while (ex.Cdr instanceof Cell);
+ return x;
+
+# (:: sym|0 [sym1|cnt .. sym2]) -> lst|sym
+:: (x)
+ x = This.Car;
+ while ((ex = ex.Cdr).Cdr instanceof Cell)
+ x = x.get(ex.Car);
+ return x.prop(ex.Car);
+
+# (putl 'sym1|lst1 ['sym2|cnt ..] 'lst) -> lst
+putl (x)
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr).Cdr instanceof Cell)
+ x = x.get(ex.Car.eval());
+ return x.putl(ex.Car.eval());
+
+# (getl 'sym1|lst1 ['sym2|cnt ..]) -> lst
+getl (x)
+ x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.get(ex.Car.eval());
+ return x.getl();
+
+# (meta 'obj|typ 'sym ['sym2|cnt ..]) -> any
+meta (x y)
+ if ((x = (ex = ex.Cdr).Car.eval()) instanceof Symbol)
+ x = x.Car;
+ for (x = meta(x, (ex = ex.Cdr).Car.eval()); (ex = ex.Cdr) instanceof Cell;)
+ x = x.get(ex.Car.eval());
+ return x;
+
+# (low? 'any) -> sym | NIL
+low? (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Symbol && Character.isLowerCase(firstChar(x))? x : Nil;
+
+# (upp? 'any) -> sym | NIL
+upp? (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Symbol && Character.isUpperCase(firstChar(x))? x : Nil;
+
+# (lowc 'any) -> any
+lowc (i j x str sb)
+ if (!((x = ex.Cdr.Car.eval()) instanceof Symbol) || (j = (str = x.name()).length()) == 0)
+ return x;
+ sb = new StringBuilder();
+ for (i = 0; i < j; ++i)
+ sb.append(Character.toLowerCase(str.charAt(i)));
+ return mkStr(sb);
+
+# (uppc 'any) -> any
+uppc (i j x str sb)
+ if (!((x = ex.Cdr.Car.eval()) instanceof Symbol) || (j = (str = x.name()).length()) == 0)
+ return x;
+ sb = new StringBuilder();
+ for (i = 0; i < j; ++i)
+ sb.append(Character.toUpperCase(str.charAt(i)));
+ return mkStr(sb);
+
+# (fold 'any ['cnt]) -> sym
+fold (i j k x str c sb)
+ if (!((x = (ex = ex.Cdr).Car.eval()) instanceof Symbol) || (j = (str = x.name()).length()) == 0)
+ return x;
+ for (i = 0; !Character.isLetterOrDigit(c = str.charAt(i));)
+ if (++i == j)
+ return Nil;
+ k = (ex = ex.Cdr) instanceof Cell? evInt(ex) : 24;
+ sb = new StringBuilder();
+ sb.append(Character.toLowerCase(c));
+ while (++i < j)
+ if (Character.isLetterOrDigit(c = str.charAt(i))) {
+ if (--k == 0)
+ break;
+ sb.append(Character.toLowerCase(c));
+ }
+ return mkStr(sb);
+
+############ subr ############
+# (Car -> any
+car T
+ return ex.Cdr.Car.eval().Car;
+
+# (cdr 'lst) -> any
+cdr T
+ return ex.Cdr.Car.eval().Cdr;
+
+caar T
+ return ex.Cdr.Car.eval().Car.Car;
+
+cadr T
+ return ex.Cdr.Car.eval().Cdr.Car;
+
+cdar T
+ return ex.Cdr.Car.eval().Car.Cdr;
+
+cddr T
+ return ex.Cdr.Car.eval().Cdr.Cdr;
+
+caaar ()
+ return ex.Cdr.Car.eval().Car.Car.Car;
+
+caadr ()
+ return ex.Cdr.Car.eval().Cdr.Car.Car;
+
+cadar ()
+ return ex.Cdr.Car.eval().Car.Cdr.Car;
+
+caddr ()
+ return ex.Cdr.Car.eval().Cdr.Cdr.Car;
+
+cdaar ()
+ return ex.Cdr.Car.eval().Car.Car.Cdr;
+
+cdadr ()
+ return ex.Cdr.Car.eval().Cdr.Car.Cdr;
+
+cddar ()
+ return ex.Cdr.Car.eval().Car.Cdr.Cdr;
+
+cdddr ()
+ return ex.Cdr.Car.eval().Cdr.Cdr.Cdr;
+
+caaaar ()
+ return ex.Cdr.Car.eval().Car.Car.Car.Car;
+
+caaadr ()
+ return ex.Cdr.Car.eval().Cdr.Car.Car.Car;
+
+caadar ()
+ return ex.Cdr.Car.eval().Car.Cdr.Car.Car;
+
+caaddr ()
+ return ex.Cdr.Car.eval().Cdr.Cdr.Car.Car;
+
+cadaar ()
+ return ex.Cdr.Car.eval().Car.Car.Cdr.Car;
+
+cadadr ()
+ return ex.Cdr.Car.eval().Cdr.Car.Cdr.Car;
+
+caddar ()
+ return ex.Cdr.Car.eval().Car.Cdr.Cdr.Car;
+
+cadddr ()
+ return ex.Cdr.Car.eval().Cdr.Cdr.Cdr.Car;
+
+cdaaar ()
+ return ex.Cdr.Car.eval().Car.Car.Car.Cdr;
+
+cdaadr ()
+ return ex.Cdr.Car.eval().Cdr.Car.Car.Cdr;
+
+cdadar ()
+ return ex.Cdr.Car.eval().Car.Cdr.Car.Cdr;
+
+cdaddr ()
+ return ex.Cdr.Car.eval().Cdr.Cdr.Car.Cdr;
+
+cddaar ()
+ return ex.Cdr.Car.eval().Car.Car.Cdr.Cdr;
+
+cddadr ()
+ return ex.Cdr.Car.eval().Cdr.Car.Cdr.Cdr;
+
+cdddar ()
+ return ex.Cdr.Car.eval().Car.Cdr.Cdr.Cdr;
+
+cddddr ()
+ return ex.Cdr.Car.eval().Cdr.Cdr.Cdr.Cdr;
+
+# (nth 'lst 'cnt ..) -> lst
+nth (x)
+ x = (ex = ex.Cdr).Car.eval();
+ for (;;) {
+ if (!(x instanceof Cell))
+ return x;
+ x = nth(evInt(ex = ex.Cdr), x);
+ if (ex.Cdr == Nil)
+ return x;
+ x = x.Car;
+ }
+
+# (con 'lst 'any) -> any
+con (x)
+ x = ex.Cdr.Car.eval();
+ return x.Cdr = ex.Cdr.Cdr.Car.eval();
+
+# (cons 'any ['any ..]) -> lst
+cons (x y)
+ y = x = new Cell((ex = ex.Cdr).Car.eval(), Nil);
+ while ((ex = ex.Cdr).Cdr instanceof Cell)
+ x = x.Cdr = new Cell(ex.Car.eval(), Nil);
+ x.Cdr = ex.Car.eval();
+ return y;
+
+# (conc 'lst ..) -> lst
+conc (x y z)
+ z = x = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell) {
+ if (!(x instanceof Cell))
+ z = x = ex.Car.eval();
+ else {
+ while ((y = x.Cdr) instanceof Cell)
+ x = y;
+ x.Cdr = ex.Car.eval();
+ }
+ }
+ return z;
+
+# (circ 'any ..) -> lst
+circ (x y)
+ y = x = new Cell((ex = ex.Cdr).Car.eval(), Nil);
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.Cdr = new Cell(ex.Car.eval(), Nil);
+ x.Cdr = y;
+ return y;
+
+# (rot 'lst ['cnt]) -> lst
+rot (i w x y z)
+ w = y = (ex = ex.Cdr).Car.eval();
+ if (w instanceof Cell) {
+ i = ex.Cdr == Nil? 0 : evInt(ex.Cdr);
+ x = y.Car;
+ while (--i != 0 && (y = y.Cdr) instanceof Cell && y != w) {
+ z = y.Car; y.Car = x; x = z;
+ }
+ w.Car = x;
+ }
+ return w;
+
+# (list 'any ['any ..]) -> lst
+list (x y)
+ x = y = new Cell((ex = ex.Cdr).Car.eval(), Nil);
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.Cdr = new Cell(ex.Car.eval(), Nil);
+ return y;
+
+# (need 'cnt ['lst ['any]]) -> lst
+need (n x y z)
+ n = evLong(ex = ex.Cdr);
+ z = (ex = ex.Cdr).Car.eval();
+ y = ex.Cdr.Car.eval();
+ x = z;
+ if (n > 0)
+ for (n -= x.length(); n > 0; --n)
+ z = new Cell(y,z);
+ else if (n != 0) {
+ if (!(x instanceof Cell))
+ z = x = new Cell(y,Nil);
+ else
+ while (x.Cdr instanceof Cell) {
+ ++n; x = x.Cdr;
+ }
+ while (++n < 0)
+ x = x.Cdr = new Cell(y,Nil);
+ }
+ return z;
+
+# (range 'num1 'num2 ['num3]) -> lst
+range (num x y)
+ num = (Number)(y = (x = ex.Cdr).Car.eval());
+ Number end = (Number)(x = x.Cdr).Car.eval();
+ Number inc = (x = x.Cdr.Car.eval()) == Nil? One : (Number)x;
+ x = y = new Cell(y, Nil);
+ if (end.compare(num) >= 0)
+ while (end.compare(num = num.add(inc)) >= 0)
+ x = x.Cdr = new Cell(num, Nil);
+ else
+ while (end.compare(num = num.sub(inc)) <= 0)
+ x = x.Cdr = new Cell(num, Nil);
+ return y;
+
+# (full 'any) -> bool
+full (x)
+ for (x = ex.Cdr.Car.eval(); x instanceof Cell; x = x.Cdr)
+ if (x.Car == Nil)
+ return Nil;
+ return T;
+
+# (make .. [(made 'lst ..)] .. [(link 'any ..)] ..) -> any
+make (x y z)
+ x = Env.Make; Env.Make = Nil;
+ y = Env.Yoke; Env.Yoke = Nil;
+ ex.Cdr.prog();
+ z = Env.Yoke;
+ Env.Yoke = y;
+ Env.Make = x;
+ return z;
+
+# (made ['lst1 ['lst2]]) -> lst
+made (x)
+ if ((x = ex.Cdr) instanceof Cell) {
+ Env.Yoke = x.Car.eval();
+ x = x.Cdr;
+ if (!((x = x.Car.eval()) instanceof Cell))
+ for (x = Env.Yoke; (x = x.Cdr).Cdr instanceof Cell;);
+ Env.Make = x;
+ }
+ return Env.Yoke;
+
+# (chain 'lst ..) -> lst
+chain (x y)
+ ex = ex.Cdr;
+ do {
+ x = ex.Car.eval();
+ if (Env.Make != Nil)
+ Env.Make = Env.Make.Cdr = x;
+ else
+ Env.Yoke = Env.Make = x;
+ while ((y = Env.Make.Cdr) instanceof Cell)
+ Env.Make = y;
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return x;
+
+# (link 'any ..) -> any
+link (x)
+ ex = ex.Cdr;
+ do {
+ x = ex.Car.eval();
+ if (Env.Make != Nil)
+ Env.Make = Env.Make.Cdr = new Cell(x, Nil);
+ else
+ Env.Yoke = Env.Make = new Cell(x, Nil);
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return x;
+
+# (yoke 'any ..) -> any
+yoke (x)
+ ex = ex.Cdr;
+ do {
+ x = ex.Car.eval();
+ Env.Yoke = new Cell(x, Env.Yoke);
+ if (Env.Make == Nil)
+ Env.Make = Env.Yoke;
+ } while ((ex = ex.Cdr) instanceof Cell);
+ return x;
+
+# (copy 'any) -> any
+copy (w x y z)
+ if (!((x = ex.Cdr.Car.eval()) instanceof Cell))
+ return x;
+ for (w = y = new Cell(x.Car, (z = x).Cdr); (x = y.Cdr) instanceof Cell; y = y.Cdr = new Cell(x.Car, x.Cdr))
+ if (x == z) {
+ y.Cdr = w;
+ break;
+ }
+ return w;
-# (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);
+# (mix 'lst cnt|'any ..) -> lst
+mix (x y z)
+ if (!((y = (ex = ex.Cdr).Car.eval()) instanceof Cell) && y != Nil)
+ return y;
+ if (!((ex = ex.Cdr) instanceof Cell))
+ return Nil;
+ z = x = new Cell(ex.Car instanceof Number? nth(xInt(ex.Car), y).Car : ex.Car.eval(), Nil);
+ while ((ex = ex.Cdr) instanceof Cell)
+ x = x.Cdr = new Cell(ex.Car instanceof Number? nth(xInt(ex.Car), y).Car : ex.Car.eval(), Nil);
+ return z;
-# (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();
+# (append 'lst ..) -> lst
+append (x y z)
+ for (ex = ex.Cdr; (z = ex.Cdr) instanceof Cell; ex = z) {
+ if ((x = ex.Car.eval()) instanceof Cell) {
+ z = y = new Cell(x.Car, x.Cdr);
+ while ((x = y.Cdr) instanceof Cell)
+ y = y.Cdr = new Cell(x.Car, x.Cdr);
+ while ((ex = ex.Cdr).Cdr instanceof Cell) {
+ for (x = ex.Car.eval(); x instanceof Cell; x = y.Cdr)
+ y = y.Cdr = new Cell(x.Car, x.Cdr);
+ y.Cdr = x;
+ }
+ y.Cdr = ex.Car.eval();
+ return z;
}
}
- return x;
+ return ex.Car.eval();
-# (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);
+# (delete 'any 'lst) -> lst
+delete (w x y z)
+ y = (x = ex.Cdr).Car.eval();
+ if (!((x = x.Cdr.Car.eval()) instanceof Cell))
+ return x;
+ if (y.equal(x.Car))
+ return x.Cdr;
+ w = z = new Cell(x.Car, Nil);
+ while ((x = x.Cdr) instanceof Cell) {
+ if (y.equal(x.Car)) {
+ z.Cdr = x.Cdr;
+ return w;
}
+ z = z.Cdr = new Cell(x.Car, Nil);
}
- return z;
+ z.Cdr = x;
+ return w;
-############ flow ############
-# (eval 'any ['cnt ['lst]]) -> any
-eval
- if ((y = (x = ex.cdr()).car().eval()) instanceof Number)
+# (delq 'any 'lst) -> lst
+delq (w x y z)
+ y = (x = ex.Cdr).Car.eval();
+ if (!((x = x.Cdr.Car.eval()) instanceof Cell))
+ return x;
+ if (y == x.Car)
+ return x.Cdr;
+ w = z = new Cell(x.Car, Nil);
+ while ((x = x.Cdr) instanceof Cell) {
+ if (y == x.Car) {
+ z.Cdr = x.Cdr;
+ return w;
+ }
+ z = z.Cdr = new Cell(x.Car, Nil);
+ }
+ z.Cdr = x;
+ return w;
+
+# (replace 'lst 'any1 'any2 ..) -> lst
+replace (i j w x y z v)
+ if (!((y = (x = ex.Cdr).Car.eval()) instanceof Cell))
return y;
- if (!((x = x.cdr()) instanceof Cell) || Env.Bind == null)
- return y.eval();
- return evRun(true, y, evInt(x), x.cdr().car().eval());
+ for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell; ++i)
+ v = append(v, i, x.Car.eval());
+ for (x = y.Car, j = 0; j < i; j += 2)
+ if (x.equal(v[j])) {
+ x = v[j+1];
+ break;
+ }
+ for (w = z = new Cell(x, Nil); (y = y.Cdr) instanceof Cell; z = z.Cdr = new Cell(x, Nil))
+ for (x = y.Car, j = 0; j < i; j += 2)
+ if (x.equal(v[j])) {
+ x = v[j+1];
+ break;
+ }
+ z.Cdr = y;
+ return w;
-# (run 'any ['cnt ['lst]]) -> any
-run
- if ((y = (x = ex.cdr()).car().eval()) instanceof Number)
+# (strip 'any) -> any
+strip (x)
+ for (x = ex.Cdr.Car.eval(); x instanceof Cell && x.Car == Quote && x != x.Cdr; x = x.Cdr);
+ return x;
+
+# (split 'lst 'any ..) -> lst
+split (i j x y z v)
+ if (!((z = (x = ex.Cdr).Car.eval()) instanceof Cell))
+ return z;
+ for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell; ++i)
+ v = append(v, i, x.Car.eval());
+ Any res = x = Nil;
+ Any sub = y = Nil;
+spl:
+ do {
+ for (j = 0; j < i; ++j) {
+ if (z.Car.equal(v[j])) {
+ if (x == Nil)
+ x = res = new Cell(sub, Nil);
+ else
+ x = x.Cdr = new Cell(sub, Nil);
+ y = sub = Nil;
+ continue spl;
+ }
+ }
+ if (y == Nil)
+ y = sub = new Cell(z.Car, Nil);
+ else
+ y = y.Cdr = new Cell(z.Car, Nil);
+ } while ((z = z.Cdr) instanceof Cell);
+ y = new Cell(sub, Nil);
+ if (x == Nil)
return y;
- if (!((x = x.cdr()) instanceof Cell) || Env.Bind == null)
- return y.run();
- return evRun(false, y, evInt(x), x.cdr().car().eval());
+ x.Cdr = y;
+ return res;
-# (de sym . any) -> sym
-de
- x = ex.cdr();
- redefine(ex, (Symbol)x.car(), x.cdr());
- return ex.cdr().car();
+# (reverse 'lst) -> lst
+reverse (x y)
+ x = ex.Cdr.Car.eval();
+ for (y = Nil; x instanceof Cell; x = x.Cdr)
+ y = new Cell(x.Car, y);
+ return y;
-# (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;
+# (flip 'lst ['cnt])) -> lst
+flip (i x y z)
+ if (!((y = (ex = ex.Cdr).Car.eval()) instanceof Cell) || !((z = y.Cdr) instanceof Cell))
+ return y;
+ if (ex.Cdr == Nil) {
+ y.Cdr = Nil;
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();
+ x = z.Cdr; z.Cdr = y;
+ if (!(x instanceof Cell))
+ return z;
+ y = z; z = x;
}
}
- 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 ((i = evInt(ex.Cdr) - 1) <= 0)
+ return y;
+ y.Cdr = z.Cdr; z.Cdr = y;
+ while (--i != 0 && (x = y.Cdr) instanceof Cell) {
+ y.Cdr = x.Cdr; x.Cdr = z; z = x;
+ }
+ return z;
-# (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();
+# (trim 'lst) -> lst
+trim ()
+ return trim(ex.Cdr.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();
+# (clip 'lst) -> lst
+clip (x)
+ for (x = ex.Cdr.Car.eval(); x instanceof Cell && isBlank(x.Car); x = x.Cdr);
+ return trim(x);
+
+# (head 'cnt|lst 'lst) -> lst
+head (i x y z)
+ if ((z = (x = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ x = x.Cdr.Car.eval();
+ if (z instanceof Cell) {
+ if (x instanceof Cell) {
+ for (y = z; y.Car.equal(x.Car); x = x.Cdr)
+ if (!((y = y.Cdr) instanceof Cell))
+ return z;
+ }
+ return Nil;
}
+ if ((i = xInt(z)) == 0)
+ return Nil;
+ if (!(x instanceof Cell))
+ return x;
+ if (i < 0 && (i += x.length()) <= 0)
+ return Nil;
+ z = y = new Cell(x.Car, Nil);
+ while (--i != 0 && (x = x.Cdr) instanceof Cell)
+ y = y.Cdr = new Cell(x.Car, Nil);
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;
+# (tail 'cnt|lst 'lst) -> lst
+tail (i x y z)
+ if ((z = (x = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ x = x.Cdr.Car.eval();
+ if (z instanceof Cell) {
+ if (x instanceof Cell) {
+ do
+ if (x.equal(z))
+ return z;
+ while ((x = x.Cdr) instanceof Cell);
+ }
+ return Nil;
+ }
+ if ((i = xInt(z)) == 0)
+ return Nil;
+ if (!(x instanceof Cell))
+ return x;
+ if (i < 0)
+ return nth(1 - i, x);
+ for (y = x.Cdr; --i != 0; y = y.Cdr)
+ if (!(y instanceof Cell))
+ return x;
+ while (y instanceof Cell) {
+ x = x.Cdr; y = y.Cdr;
}
- finally {Catch = Catch.Link;}
+ return x;
-# (throw 'sym 'any)
-throw
- y = (x = ex.cdr()).car().eval();
- throw new Throw(ex, y, x.cdr().car().eval());
+# (stem 'lst 'any ..) -> lst
+stem (i j x y v)
+ y = (x = ex.Cdr).Car.eval();
+ for (v = new Any[6], i = 0; (x = x.Cdr) instanceof Cell; ++i)
+ v = append(v, i, x.Car.eval());
+ for (x = y; x instanceof Cell; x = x.Cdr)
+ for (j = 0; j < i; ++j)
+ if (x.Car.equal(v[j])) {
+ y = x.Cdr;
+ break;
+ }
+ return y;
-# (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;
+# (fin 'any) -> num|sym
+fin (x)
+ for (x = ex.Cdr.Car.eval(); x instanceof Cell; x = x.Cdr);
+ return x;
-# (bye 'cnt|NIL)
-bye
- x = ex.cdr().car().eval();
- /* ... */
- System.exit(x == Nil? 0 : ((Number)x).intValue());
+# (last 'lst) -> any
+last (x)
+ if (!((x = ex.Cdr.Car.eval()) instanceof Cell))
+ return x;
+ while (x.Cdr instanceof Cell)
+ x = x.Cdr;
+ return x.Car;
-############ sym ############
-# (all ['T]) -> lst
-all
- return all((x = ex.cdr().car().eval()) == Nil? Intern : Transient);
+# (== 'any ..) -> flg
+== (x y)
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell)
+ if (y != x.Car.eval())
+ return Nil;
+ return T;
-# (==== ['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);
- }
+# (n== 'any ..) -> flg
+n== (x y)
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell)
+ if (y != x.Car.eval())
+ return T;
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;
+# (= 'any ..) -> flg
+= (x y)
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell)
+ if (!y.equal(x.Car.eval()))
+ return Nil;
+ return T;
-# (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;
+# (<> 'any ..) -> flg
+<> (x y)
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell)
+ if (!y.equal(x.Car.eval()))
+ return T;
+ return Nil;
-# (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);
- }
+# (=0 'any) -> 0 | NIL
+=0 (x)
+ return ex.Cdr.Car.eval().equal(Zero)? Zero : Nil;
-# (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;
+# (=T 'any) -> flg
+=T ()
+ return T == ex.Cdr.Car.eval()? T : Nil;
-############ subr ############
-# (car 'var) -> any
-car
- return ex.cdr().car().eval().car();
+# (n0 'any) -> flg
+n0 ()
+ return ex.Cdr.Car.eval().equal(Zero)? Nil : T;
-# (cdr 'lst) -> any
-cdr
- return ex.cdr().car().eval().cdr();
+# (nT 'any) -> flg
+nT ()
+ return T == ex.Cdr.Car.eval()? Nil : T;
-# (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;
+# (< 'any ..) -> flg
+< (x y z)
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell) {
+ z = x.Car.eval();
+ if (y.compare(z) >= 0)
+ return Nil;
+ y = z;
+ }
+ return T;
-# (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
+<= (x y z)
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell) {
+ z = x.Car.eval();
+ if (y.compare(z) > 0)
+ return Nil;
+ y = z;
+ }
+ return T;
# (> 'any ..) -> flg
->
- y = (x = ex.cdr()).car().eval();
- while ((x = x.cdr()) instanceof Cell) {
- z = x.car().eval();
- if (compare(y,z) <= 0)
+> (x y)
+ x = (ex = ex.Cdr).Car.eval();
+ while (ex.Cdr instanceof Cell) {
+ y = (ex = ex.Cdr).Car.eval();
+ if (x.compare(y) <= 0)
+ return Nil;
+ x = y;
+ }
+ return T;
+
+# (>= 'any ..) -> flg
+>= (x y z)
+ y = (x = ex.Cdr).Car.eval();
+ while ((x = x.Cdr) instanceof Cell) {
+ z = x.Car.eval();
+ if (y.compare(z) < 0)
return Nil;
y = z;
}
return T;
+# (max 'any ..) -> any
+max (x y)
+ for (y = (ex = ex.Cdr).Car.eval(); (ex = ex.Cdr) instanceof Cell;)
+ if ((x = ex.Car.eval()).compare(y) > 0)
+ y = x;
+ return y;
+
+# (min 'any ..) -> any
+min (x y)
+ for (y = (ex = ex.Cdr).Car.eval(); (ex = ex.Cdr) instanceof Cell;)
+ if ((x = ex.Car.eval()).compare(y) < 0)
+ y = x;
+ return y;
+
+# (atom 'any) -> flg
+atom ()
+ return ex.Cdr.Car.eval() instanceof Cell? Nil : T;
+
+# (pair 'any) -> any
+pair (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Cell? x : Nil;
+
+# (lst? 'any) -> flg
+lst? (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Cell || x == Nil? T : Nil;
+
+# (num? 'any) -> num | NIL
+num? (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Number? x : Nil;
+
+# (sym? 'any) -> flg
+sym? (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Symbol || x == Nil? T : Nil;
+
+# (flg? 'any) -> flg
+flg? (x)
+ return (x = ex.Cdr.Car.eval()) == Nil || x == T? T : Nil;
+
+# (member 'any 'lst) -> any
+member (x)
+ x = (ex = ex.Cdr).Car.eval();
+ return (x = member(x, ex.Cdr.Car.eval())) == null? Nil : x;
+
+# (memq 'any 'lst) -> any
+memq (x)
+ x = (ex = ex.Cdr).Car.eval();
+ return (x = memq(x, ex.Cdr.Car.eval())) == null? Nil : x;
+
+# (mmeq 'lst 'lst) -> any
+mmeq (x y z)
+ x = (ex = ex.Cdr).Car.eval();
+ for (y = (ex = ex.Cdr).Car.eval(); x instanceof Cell; x = x.Cdr)
+ if ((z = memq(x.Car, y)) != null)
+ return x;
+ return Nil;
+
+# (sect 'lst 'lst) -> lst
+sect (w x y z)
+ y = (x = ex.Cdr).Car.eval();
+ z = x.Cdr.Car.eval();
+ w = x = Nil;
+ while (y instanceof Cell) {
+ if (member(y.Car, z) != null)
+ if (x == Nil)
+ x = w = new Cell(y.Car, Nil);
+ else
+ x = x.Cdr = new Cell(y.Car, Nil);
+ y = y.Cdr;
+ }
+ return w;
+
+# (diff 'lst 'lst) -> lst
+diff (w x y z)
+ y = (x = ex.Cdr).Car.eval();
+ z = x.Cdr.Car.eval();
+ w = x = Nil;
+ while (y instanceof Cell) {
+ if (member(y.Car, z) == null)
+ if (x == Nil)
+ x = w = new Cell(y.Car, Nil);
+ else
+ x = x.Cdr = new Cell(y.Car, Nil);
+ y = y.Cdr;
+ }
+ return w;
+
+# (index 'any 'lst) -> cnt | NIL
+index (i x y)
+ y = (x = ex.Cdr).Car.eval();
+ return (i = indx(y, x.Cdr.Car.eval())) == 0? Nil : new Number(i);
+
+# (offset 'lst1 'lst2) -> cnt | NIL
+offset (i x y)
+ y = (x = ex.Cdr).Car.eval();
+ x = x.Cdr.Car.eval();
+ for (i = 1; x instanceof Cell; ++i, x = x.Cdr)
+ if (x.equal(y))
+ return new Number(i);
+ return Nil;
+
+# (length 'any) -> cnt | T
+length (n)
+ return (n = ex.Cdr.Car.eval().length()) >= 0? new Number(n) : T;
+
+# (size 'any) -> cnt
+size ()
+ return new Number(ex.Cdr.Car.eval().size());
+
+# (assoc 'any 'lst) -> lst
+assoc (x y z)
+ y = (x = ex.Cdr).Car.eval();
+ x = x.Cdr.Car.eval();
+ for (; x instanceof Cell; x = x.Cdr)
+ if ((z = x.Car) instanceof Cell && y.equal(z.Car))
+ return z;
+ return Nil;
+
+# (asoq 'any 'lst) -> lst
+asoq (x y z)
+ y = (x = ex.Cdr).Car.eval();
+ x = x.Cdr.Car.eval();
+ for (; x instanceof Cell; x = x.Cdr)
+ if ((z = x.Car) instanceof Cell && y == z.Car)
+ return z;
+ return Nil;
+
+# (rank 'any 'lst ['flg]) -> lst
+rank (w x y z)
+ w = (x = ex.Cdr).Car.eval();
+ y = (x = x.Cdr).Car.eval();
+ z = Nil;
+ if (x.Cdr.Car.eval() == Nil)
+ for (; y instanceof Cell; y = y.Cdr) {
+ if ((x = y.Car) instanceof Cell && x.Car.compare(w) > 0)
+ break;
+ z = y;
+ }
+ else
+ for (; y instanceof Cell; y = y.Cdr) {
+ if ((x = y.Car) instanceof Cell && w.compare(x.Car) > 0)
+ break;
+ z = y;
+ }
+ return z.Car;
+
+# (match 'lst1 'lst2) -> flg
+match (x y)
+ y = (x = ex.Cdr).Car.eval();
+ return match(y, x.Cdr.Car.eval())? T : Nil;
+
+# (fill 'any ['sym|lst]) -> any
+fill (x y)
+ y = (x = ex.Cdr).Car.eval();
+ return (x = fill(y, x.Cdr.Car.eval())) == null? y : x;
+
+# (prove 'lst ['lst]) -> lst
+prove (i x y)
+ if (!((y = (ex = ex.Cdr).Car.eval()) instanceof Cell))
+ return Nil;
+ Any dbg = ex.Cdr.Car.eval(), at = At.Car, envSave = Penv, nlSave = Pnl;
+ Penv = y.Car.Car; y.Car = y.Car.Cdr;
+ Any n = Penv.Car; Penv = Penv.Cdr;
+ Pnl = Penv.Car; Penv = Penv.Cdr;
+ Any alt = Penv.Car; Penv = Penv.Cdr;
+ Any tp1 = Penv.Car; Penv = Penv.Cdr;
+ Any tp2 = Penv.Car; Penv = Penv.Cdr;
+ Any e = Nil;
+ while (tp1 instanceof Cell || tp2 instanceof Cell) {
+ if (alt instanceof Cell) {
+ e = Penv;
+ if (!unify((Number)Pnl.Car, tp1.Car.Cdr, (Number)n, alt.Car.Car)) {
+ if (!((alt = alt.Cdr) instanceof Cell)) {
+ Penv = y.Car.Car; y.Car = y.Car.Cdr;
+ n = Penv.Car; Penv = Penv.Cdr;
+ Pnl = Penv.Car; Penv = Penv.Cdr;
+ alt = Penv.Car; Penv = Penv.Cdr;
+ tp1 = Penv.Car; Penv = Penv.Cdr;
+ tp2 = Penv.Car; Penv = Penv.Cdr;
+ }
+ }
+ else {
+ if (dbg != Nil && memq(tp1.Car.Car, dbg) != null) {
+ OutFile.Wr.print(indx(alt.Car, tp1.Car.Car.get(T)));
+ OutFile.space();
+ OutFile.print(uniFill(tp1.Car));
+ OutFile.newline();
+ }
+ if (alt.Cdr instanceof Cell)
+ y.Car =
+ new Cell(
+ new Cell(n,
+ new Cell(Pnl,
+ new Cell(alt.Cdr,
+ new Cell(tp1, new Cell(tp2, e)) ) ) ),
+ y.Car );
+ Pnl = new Cell(n, Pnl);
+ n = ((Number)n).add(One);
+ tp2 = new Cell(tp1.Cdr, tp2);
+ tp1 = alt.Car.Cdr;
+ alt = Nil;
+ }
+ }
+ else if (!((x = tp1) instanceof Cell)) {
+ tp1 = tp2.Car;
+ tp2 = tp2.Cdr;
+ Pnl = Pnl.Cdr;
+ }
+ else if (x.Car == T) {
+ while (y.Car instanceof Cell && ((Number)y.Car.Car.Car).Cnt >= ((Number)Pnl.Car).Cnt)
+ y.Car = y.Car.Cdr;
+ tp1 = x.Cdr;
+ }
+ else if (x.Car.Car instanceof Number) {
+ e = x.Car.Cdr.eval();
+ for (i = ((Number)x.Car.Car).Cnt, x = Pnl; --i > 0;)
+ x = x.Cdr;
+ Pnl = new Cell(x.Car, Pnl);
+ tp2 = new Cell(tp1.Cdr, tp2);
+ tp1 = e;
+ }
+ else if (x.Car.Car instanceof Symbol && firstChar(x.Car.Car) == '@') {
+ if ((e = x.Car.Cdr.eval()) != Nil && unify((Number)Pnl.Car, x.Car.Car, (Number)Pnl.Car, e))
+ tp1 = x.Cdr;
+ else {
+ Penv = y.Car.Car; y.Car = y.Car.Cdr;
+ n = Penv.Car; Penv = Penv.Cdr;
+ Pnl = Penv.Car; Penv = Penv.Cdr;
+ alt = Penv.Car; Penv = Penv.Cdr;
+ tp1 = Penv.Car; Penv = Penv.Cdr;
+ tp2 = Penv.Car; Penv = Penv.Cdr;
+ }
+ }
+ else if (!((alt = x.Car.Car.get(T)) instanceof Cell)) {
+ Penv = y.Car.Car; y.Car = y.Car.Cdr;
+ n = Penv.Car; Penv = Penv.Cdr;
+ Pnl = Penv.Car; Penv = Penv.Cdr;
+ alt = Penv.Car; Penv = Penv.Cdr;
+ tp1 = Penv.Car; Penv = Penv.Cdr;
+ tp2 = Penv.Car; Penv = Penv.Cdr;
+ }
+ }
+ for (e = Nil, x = Penv; x.Cdr instanceof Cell; x = x.Cdr)
+ if (x.Car.Car.Car.equal(Zero))
+ e = new Cell(new Cell(x.Car.Car.Cdr, lookup(Zero, x.Car.Car.Cdr)), e);
+ At.Car = at;
+ x = e instanceof Cell? e : Penv instanceof Cell? T : Nil;
+ Penv = envSave; Pnl = nlSave;
+ return x;
+
+# (-> sym [num]) -> any
+-> (i x)
+ if (!(ex.Cdr.Cdr.Car instanceof Number))
+ return lookup((Number)Pnl.Car, ex.Cdr.Car);
+ for (i = ((Number)ex.Cdr.Cdr.Car).Cnt, x = Pnl; --i > 0;)
+ x = x.Cdr;
+ return lookup((Number)x.Car, ex.Cdr.Car);
+
+# (unify 'any) -> lst
+unify (x)
+ x = ex.Cdr.Car.eval();
+ return unify((Number)Pnl.Cdr.Car, x, (Number)Pnl.Car, x)? Penv : Nil;
+
+# (sort 'lst ['fun]) -> lst
+sort (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Cell && x.Cdr instanceof Cell? sort(ex, x, ex.Cdr.Cdr.Car.eval()) : x;
+
############ big ############
+# (format 'num ['cnt ['sym1 ['sym2]]]) -> sym
+# (format 'sym|lst ['cnt ['sym1 ['sym2]]]) -> num
+format (i x y)
+ x = (ex = ex.Cdr).Car.eval();
+ i = (y = (ex = ex.Cdr).Car.eval()) == Nil? 0 : ((Number)y).Cnt;
+ return format(x, i, ex.Cdr);
+
# (+ 'num ..) -> num
-+
- if ((y = (x = ex.cdr()).car().eval()) == Nil)
++ (num x)
+ if ((x = (ex = 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)
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.add((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
return Nil;
- return new Number(n.toByteArray());
+ return num;
# (- 'num ..) -> num
--
- if ((y = (x = ex.cdr()).car().eval()) == Nil)
+- (num x)
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
return Nil;
- n = (Number)y;
- if (!((x = x.cdr()) instanceof Cell))
- return new Number(n.negate().toByteArray());
+ num = (Number)x;
+ if (!(ex.Cdr instanceof Cell))
+ return num.neg();
do {
- if ((y = x.car().eval()) == Nil)
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
return Nil;
- n = n.subtract((Number)y);
- } while ((x = x.cdr()) instanceof Cell);
- return new Number(n.toByteArray());
+ num = num.sub((Number)x);
+ } while (ex.Cdr instanceof Cell);
+ return num;
# (inc 'num) -> num
# (inc 'var ['num]) -> num
-inc
- if ((y = (x = ex.cdr()).car().eval()) == Nil)
+inc (x y)
+ if ((x = (ex = 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)
+ if (x instanceof Number)
+ return ((Number)x).add(One);
+ if (!(ex.Cdr instanceof Cell)) {
+ if (x.Car == Nil)
return Nil;
- y.set(z = new Number(((Number)y.car()).add(ONE).toByteArray()));
+ x.Car = y = ((Number)x.Car).add(One);
}
else {
- z = x.car().eval();
- if (y.car() == Nil || z == Nil)
+ y = ex.Cdr.Car.eval();
+ if (x.Car == Nil || y == Nil)
return Nil;
- y.set(z = new Number(((Number)y.car()).add((Number)z).toByteArray()));
+ x.Car = y = ((Number)x.Car).add((Number)y);
}
- return z;
+ return y;
# (dec 'num) -> num
# (dec 'var ['num]) -> num
-dec
- if ((y = (x = ex.cdr()).car().eval()) == Nil)
+dec (x y)
+ if ((x = (ex = 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)
+ if (x instanceof Number)
+ return ((Number)x).sub(One);
+ if (!(ex.Cdr instanceof Cell)) {
+ if (x.Car == Nil)
return Nil;
- y.set(z = new Number(((Number)y.car()).subtract(ONE).toByteArray()));
+ x.Car = y = ((Number)x.Car).sub(One);
}
else {
- z = x.car().eval();
- if (y.car() == Nil || z == Nil)
+ y = ex.Cdr.Car.eval();
+ if (x.Car == Nil || y == Nil)
return Nil;
- y.set(z = new Number(((Number)y.car()).subtract((Number)z).toByteArray()));
+ x.Car = y = ((Number)x.Car).sub((Number)y);
}
- return z;
+ return y;
# (* 'num ..) -> num
-*
- if ((y = (x = ex.cdr()).car().eval()) == Nil)
+* (num x)
+ if ((x = (ex = 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)
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.mul((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
return Nil;
- return new Number(n.toByteArray());
+ return num;
# (*/ 'num1 ['num2 ..] 'num3) -> num
-*/
- if ((y = (x = ex.cdr()).car().eval()) == Nil)
+*/ (num x)
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
return Nil;
- for (n = (Number)y; ; n = n.multiply((Number)y)) {
- if ((y = (x = x.cdr()).car().eval()) == Nil)
+ for (num = (Number)x; ; num = num.mul((Number)x)) {
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
return Nil;
- if (!((x.cdr()) instanceof Cell))
- return new Number(n.add(((Number)y).divide(Two)).divide((Number)y).toByteArray());
+ if (!((ex.Cdr) instanceof Cell))
+ return num.add(((Number)x).div(Two)).div(((Number)x));
}
# (/ 'num ..) -> num
-/
- if ((y = (x = ex.cdr()).car().eval()) == Nil)
+/ (num x)
+ if ((x = (ex = 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)
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.div((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
return Nil;
- return new Number(n.toByteArray());
+ return num;
# (% 'num ..) -> num
-%
- if ((y = (x = ex.cdr()).car().eval()) == Nil)
+% (num x)
+ if ((x = (ex = 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)
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.rem((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
return Nil;
- return new Number(n.toByteArray());
+ return num;
# (>> 'cnt 'num) -> num
->>
- i = evInt(x = ex.cdr());
- if ((y = x.cdr().car().eval()) == Nil)
+>> (i x)
+ i = evInt(ex = ex.Cdr);
+ if ((x = ex.Cdr.Car.eval()) == Nil)
return Nil;
- return new Number(((Number)y).shiftRight(i).toByteArray());
+ return ((Number)x).shift(i);
# (lt0 'any) -> num | NIL
-lt0
- return (x = ex.cdr().car().eval()) instanceof Number && ((Number)x).compareTo(Zero) < 0? x : Nil;
+lt0 (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) < 0? x : Nil;
# (ge0 'any) -> num | NIL
-ge0
- return (x = ex.cdr().car().eval()) instanceof Number && ((Number)x).compareTo(Zero) >= 0? x : Nil;
+ge0 (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) >= 0? x : Nil;
# (gt0 'any) -> num | NIL
-gt0
- return (x = ex.cdr().car().eval()) instanceof Number && ((Number)x).compareTo(Zero) > 0? x : Nil;
+gt0 (x)
+ return (x = ex.Cdr.Car.eval()) instanceof Number && x.compare(Zero) > 0? x : Nil;
# (abs 'num) -> num
-abs
- return new Number(((Number)ex.cdr().car().eval()).abs().toByteArray());
+abs ()
+ return ((Number)ex.Cdr.Car.eval()).abs();
+
+# (bit? 'num ..) -> num | NIL
+bit? (num x)
+ num = (Number)(ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell)
+ if ((x = ex.Car.eval()) == Nil || !num.tst((Number)x))
+ return Nil;
+ return num;
+
+# (& 'num ..) -> num
+& (num x)
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.and((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+
+# (| 'num ..) -> num
+| (num x)
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.or((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+
+# (x| 'num ..) -> num
+x| (num x)
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ for (num = (Number)x; ex.Cdr instanceof Cell; num = num.xor((Number)x))
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return Nil;
+ return num;
+
+# (seed 'any) -> cnt
+seed (n)
+ n = initSeed(ex.Cdr.Car.eval()) * 6364136223846793005L + 1;
+ return new Number(Seed = n);
+
+# (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
+rand (x)
+ Seed = Seed * 6364136223846793005L + 1;
+ if ((x = (ex = ex.Cdr).Car.eval()) == Nil)
+ return new Number(Seed);
+ if (x == T)
+ return (Seed & 0x100000000L) == 0? Nil : T;
+ return new Number(((Number)x).Cnt + (int)(Seed >>> 33) % (evInt(ex.Cdr) + 1 - ((Number)x).Cnt));
############ io ############
# (path 'any) -> sym
-path
+path ()
+ return mkStr(path(evString(ex.Cdr)));
+
+# (read ['sym1 ['sym2]]) -> any
+read (x y)
+ if (!((x = ex.Cdr) instanceof Cell))
+ x = InFile.read('\0');
+ else {
+ y = x.Car.eval();
+ if ((x = token(y, (x = x.Cdr.Car.eval()) == Nil? '\0' : firstChar(x))) == null)
+ x = Nil;
+ }
+ if (InFile.Name == null && InFile.Chr == '\n')
+ InFile.Chr = 0;
+ return x;
+
+# (char) -> sym
+# (char 'cnt) -> sym
+# (char T) -> sym
+# (char 'sym) -> cnt
+char (x)
+ if (!((ex = ex.Cdr) instanceof Cell)) {
+ if (InFile.Chr == 0)
+ InFile.get();
+ x = InFile.Chr < 0? Nil : mkChar((char)InFile.Chr);
+ InFile.get();
+ return x;
+ }
+ if ((x = ex.Car.eval()) instanceof Number)
+ return x.equals(Zero)? Nil : mkChar((char)((Number)x).Cnt);
+ return x == T? mkChar((char)0x10000) : new Number(firstChar(x));
+
+# (skip ['any]) -> sym
+skip (c)
+ c = firstChar(ex.Cdr.Car.eval());
+ return InFile.skip(c) < 0? Nil : mkChar(c);
+
+# (line 'flg) -> lst|sym
+line (i x y z sb)
+ if (InFile.Chr == 0)
+ InFile.get();
+ if (InFile.eol())
+ return Nil;
+ if (ex.Cdr.Car.eval() != Nil) {
+ sb = new StringBuilder();
+ do {
+ sb.append((char)InFile.Chr);
+ InFile.get();
+ } while (!InFile.eol());
+ return mkStr(sb);
+ }
+ for (x = y = new Cell(mkChar((char)InFile.Chr), Nil);;) {
+ InFile.get();
+ if (InFile.eol())
+ return x;
+ y = y.Cdr = new Cell(mkChar((char)InFile.Chr), Nil);
+ }
# (load 'any ..) -> any
-load
- x = ex.cdr();
+load (x y)
+ x = ex.Cdr;
do {
- if ((y = x.car().eval()) != T)
+ if ((y = x.Car.eval()) != T)
y = load(ex, '>', y);
else
y = loadAll(ex);
- } while ((x = x.cdr()) instanceof Cell);
+ } while ((x = x.Cdr) instanceof Cell);
+ return y;
+
+# (in 'any . prg) -> any
+in (x)
+ Env.pushInFile((x = ex.Cdr).Car.eval().rdOpen(ex));
+ x = x.Cdr.prog();
+ Env.popInFiles();
+ return x;
+
+# (out 'any . prg) -> any
+out (x)
+ Env.pushOutFile((x = ex.Cdr).Car.eval().wrOpen(ex));
+ x = x.Cdr.prog();
+ Env.popOutFiles();
+ return x;
+
+# (ctl 'sym . prg) -> any
+ctl ()
+ return ex.Cdr.Cdr.prog(); // No locking
+
+# (open 'any) -> cnt | NIL
+open (str)
+ str = evString(ex.Cdr);
+ try {return new Number(new PicoLispReader(new FileReader(str), str, -1).Fd);}
+ catch (IOException e) {}
+ return Nil;
+
+# (close 'cnt) -> cnt | NIL
+close (i x)
+ if ((i = xInt(x = ex.Cdr.Car.eval())) >= 0 && i < InFiles.length) {
+ if (InFiles[i] != null) {
+ InFiles[i].close();
+ if (OutFiles[i] != null)
+ OutFiles[i].close();
+ return x;
+ }
+ if (OutFiles[i] != null) {
+ OutFiles[i].close();
+ return x;
+ }
+ }
+ return Nil;
+
+# (prin 'any ..) -> any
+prin (x y)
+ for (y = Nil; (ex = ex.Cdr) instanceof Cell; OutFile.Wr.print((y = ex.Car.eval()).name()));
+ return y;
+
+# (prinl 'any ..) -> any
+prinl (x y)
+ for (y = Nil; (ex = ex.Cdr) instanceof Cell; OutFile.Wr.print((y = ex.Car.eval()).name()));
+ OutFile.newline();
+ return y;
+
+# (space ['cnt]) -> cnt
+space (i x)
+ if ((x = ex.Cdr.Car.eval()) == Nil) {
+ OutFile.space();
+ return One;
+ }
+ for (i = xInt(x); i > 0; --i)
+ OutFile.space();
+ return x;
+
+# (print 'any ..) -> any
+print (x y)
+ OutFile.print(y = (x = ex.Cdr).Car.eval());
+ while ((x = x.Cdr) instanceof Cell) {
+ OutFile.space();
+ OutFile.print(y = x.Car.eval());
+ }
+ return y;
+
+# (printsp 'any ..) -> any
+printsp (x y)
+ x = ex.Cdr;
+ do {
+ OutFile.print(y = x.Car.eval());
+ OutFile.space();
+ } 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) {
+println (x y)
+ OutFile.print(y = (x = ex.Cdr).Car.eval());
+ while ((x = x.Cdr) instanceof Cell) {
OutFile.space();
- OutFile.print(y = x.car().eval());
+ OutFile.print(y = x.Car.eval());
}
OutFile.newline();
return y;
+# (flush) -> flg
+flush ()
+ return OutFile.Wr.checkError()? Nil : T;
+
+############ net ############
+# (connect 'any 'cnt) -> cnt | NIL
+connect (i)
+ try {
+ Socket sock = new Socket(evString(ex.Cdr), evInt(ex.Cdr.Cdr));
+ i = new PicoLispReader(sock.getInputStream(), -1).Fd;
+ new PicoLispWriter(sock.getOutputStream(), i);
+ return new Number(i);
+ }
+ catch (IOException e) {}
+ return Nil;
+
# vi:et:ts=3:sw=3
diff --git a/ersatz/mkJar b/ersatz/mkJar
@@ -1,43 +1,87 @@
#!../bin/picolisp ../lib.l
-# 06oct10abu
+# 29oct10abu
# (c) Software Lab. Alexander Burger
-(load "@ext.l")
+(load "@ext.l" "@src64/version.l")
# Build Ersatz PicoLisp
+(de local (Vars Typ Lst)
+ (when (filter '((S) (memq S Lst)) Vars)
+ (prinl " " Typ " " (glue ", " @) ";") ) )
+
(out "PicoLisp.java"
(in "sys.src"
+ (echo "<VERSION>")
+ (prin (glue "," *Version))
(echo "<SYM>")
(let Cnt (read)
(in "fun.src"
(skip "#")
(loop
- (let Name (line T)
+ (let Name (till " " T)
(prinl
"mkSymbol(new Number(\""
(inc 'Cnt)
"\"), \""
Name
"\", Intern);" ) )
- (while (= " " (car (line))))
+ (while (line))
(prin " ")
- (NIL (skip "#")) ) ) )
+ (NIL (skip "#")) ) )
+ (prinl "MaxFun = " Cnt ";")
+ (prin " ") )
(skip)
(echo "<FUN>")
- (let (Cnt (read) Line)
+ (let Cnt (read)
(in "fun.src"
(skip "#")
(loop
- (let Name (line T)
+ (let (Name (till " " T) Vars (read))
+ (line)
(prinl
"case "
(inc 'Cnt)
": // "
- Name ) )
- (while (= " " (car (setq Line (line))))
- (prinl " " Line) )
- (prin " ")
+ Name )
+ (if (=T Vars)
+ (while (line)
+ (prinl " " @) )
+ (prinl " " "return do" Cnt "(ex);")
+ (while (line)) ) )
+ (prin " ")
+ (NIL (skip "#")) ) ) )
+ (skip)
+ (echo "<DEF>")
+ (let Cnt (read)
+ (in "fun.src"
+ (skip "#")
+ (loop
+ (inc 'Cnt)
+ (let (Name (till " " T) Vars (read))
+ (line)
+ (if (=T Vars)
+ (while (line))
+ (prinl
+ "final static Any do"
+ Cnt
+ "(Any ex) { // "
+ Name )
+ (local Vars "int" '(i j k))
+ (local Vars "char" '(c))
+ (local Vars "long" '(n))
+ (local Vars "Any" '(w x y z lst))
+ (local Vars "Symbol" '(s t))
+ (local Vars "Number" '(num))
+ (local Vars "String" '(str txt))
+ (local Vars "StringBuilder" '(sb))
+ (local Vars "Any[]" '(v))
+ (local Vars "Bind" '(bnd))
+ (while (line)
+ (prinl " " @) )
+ (prinl " }")
+ (prinl)
+ (prin " ") ) )
(NIL (skip "#")) ) ) )
(skip)
(echo) ) )
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/ersatz/sys.src b/ersatz/sys.src
@@ -1,7 +1,8 @@
-// 10oct10abu
+// 01nov10abu
// (c) Software Lab. Alexander Burger
import java.io.*;
+import java.net.*;
import java.util.*;
import java.math.*;
@@ -9,6 +10,8 @@ import java.math.*;
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 byte MonLen[] = new byte[] {31,31,28,31,30,31,30,31,31,30,31,30,31};
+ final static byte Version[] = new byte[] {<VERSION>};
final static Number Zero = new Number(0);
final static Number One = new Number(1);
@@ -23,34 +26,57 @@ public class PicoLisp {
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 Run = mkSymbol(Nil, "*Run", Intern);
+ final static Symbol Up = mkSymbol(Nil, "^", Intern);
+ final static Symbol Err = mkSymbol(Nil, "*Err", Intern);
+ final static Symbol Msg = mkSymbol(Nil, "*Msg", Intern);
+ final static Symbol Uni = mkSymbol(Nil, "*Uni", Intern);
+ final static Symbol Bye = mkSymbol(Nil, "*Bye", 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 Process[] Pids = new Process[12];
+ static PicoLispReader[] InFiles = new PicoLispReader[12];
+ static PicoLispWriter[] OutFiles = new PicoLispWriter[12];
+ final static PicoLispReader StdIn = new PicoLispReader(System.in, 0);
+ final static PicoLispWriter StdOut = new PicoLispWriter(System.out, 1);
+ final static PicoLispWriter StdErr = new PicoLispWriter(System.err, 2);
static PicoLispReader InFile = StdIn;
static PicoLispWriter OutFile = StdOut;
- static Any TheCls, TheKey;
+ static Any TheCls, TheKey, Penv, Pnl;
static String[] Argv;
static String Home;
+ static Calendar Cal;
+ static int MaxFun;
+ static long USec, Seed;
+ static boolean Break, Jam, B;
+ static Bind Brk;
public static void main(String[] argv) {
Argv = argv;
init();
<SYM> 1
- loadAll(null);
- load(null, ':', Nil);
- System.exit(0);
+ USec = System.nanoTime() / 1000;
+ for (boolean first = true; ; first = false) {
+ try {
+ if (first)
+ loadAll(null);
+ load(null, ':', Nil);
+ bye(0);
+ }
+ catch (Control e) {}
+ catch (Throwable e) {error(null, null, e.toString());}
+ }
}
final static void init() {
String s;
+ Home = "";
for (int i = 0; i < Argv.length; ++i)
if ((s = Argv[i]).charAt(0) != '-') {
if ((i = s.lastIndexOf('/')) >= 0 && !(i == 1 && s.charAt(0) == '.'))
@@ -59,42 +85,245 @@ public class PicoLisp {
}
}
- final static String path(String s) {
- if (s.charAt(0) == '+') {
- if (s.charAt(1) == '@')
- return "+" + Home + s.substring(1);
+ final static Any bye(int n) {
+ if (!B) {
+ B = true;
+ unwind(null);
+ Bye.Car.prog();
+ }
+ System.exit(n);
+ return null; /* Brain-dead Java */
+ }
+
+ final static long initSeed(Any x) {
+ long n;
+ for (n = 0; x instanceof Cell; x = x.Cdr)
+ n += initSeed(x.Car);
+ if (x != Nil) {
+ if (x instanceof Number && ((Number)x).Big == null)
+ n += ((Number)x).Cnt;
+ else {
+ byte b[] = x instanceof Symbol? x.name().getBytes() : ((Number)x).Big.toByteArray();
+ for (int i = 0; i < b.length; ++i)
+ n += b[i];
+ }
}
- else if (s.charAt(0) == '@')
- return Home + s.substring(1);
+ return n;
+ }
+
+ final static Any date(int y, int m, int d) {
+ int n;
+
+ if (m<1 || m>12 || d<1 || d>MonLen[m] && (m!=2 || d!=29 || y%4!=0 || y%100==0 && y%400!=0))
+ return Nil;
+ n = (12*y + m - 3) / 12;
+ return new Number((4404*y+367*m-1094)/12 - 2*n + n/4 - n/100 + n/400 + d);
+ }
+
+ final static Any date(int n) {
+ int y = (100*n - 20) / 3652425;
+ n += (y - y/4);
+ y = (100*n - 20) / 36525;
+ n -= 36525*y / 100;
+ int m = (10*n - 5) / 306;
+ int d = (10*n - 306*m + 5) / 10;
+ if (m < 10)
+ m += 3;
+ else {
+ ++y;
+ m -= 9;
+ }
+ return new Cell(new Number(y), new Cell(new Number(m), new Cell(new Number(d), Nil)));
+ }
+
+ final static Any time(Calendar cal) {
+ return new Number(cal.get(Calendar.HOUR_OF_DAY) * 3600 + cal.get(Calendar.MINUTE) * 60 + cal.get(Calendar.SECOND));
+ }
+
+ final static Any time(int h, int m, int s) {
+ if (h < 0 || h > 23 || m < 0 || m > 59 || s < 0 || s > 60)
+ return Nil;
+ return new Number(h * 3600 + m * 60 + s);
+ }
+
+ final static char firstChar(Any s) {
+ String nm = s.name();
+ return nm.length() == 0? '\0' : nm.charAt(0);
+ }
+
+ final static String path(String s) {
+ if (s.length() > 0)
+ if (s.charAt(0) == '+') {
+ if (s.length() > 1 && s.charAt(1) == '@')
+ return "+" + Home + s.substring(1);
+ }
+ else if (s.charAt(0) == '@')
+ return Home + s.substring(1);
return s;
}
- final static void unwind(Catch p) {
- /* ... */
+ final static void unwind(Catch target) {
+ int i, j, n;
+ Bind p;
+ Catch q;
+ Any x, y;
+ while ((q = Catch) != null) {
+ while ((p = Env.Bind) != null) {
+ if ((i = p.Eswp) != 0) {
+ j = i; n = 0;
+ for (;;) {
+ ++n;
+ if (++j == 0 || (p = p.Link) == null)
+ break;
+ if (p.Eswp < i)
+ --j;
+ }
+ do {
+ for (p = Env.Bind, j = n; --j != 0; p = p.Link);
+ if ((p.Eswp -= i) >= 0) {
+ if (p.Eswp > 0)
+ p.Eswp = 0;
+ for (j = p.Cnt; (j -= 2) >= 0;) {
+ y = p.Data[j+1];
+ x = y.Car; y.Car = p.Data[j]; p.Data[j] = x;
+ }
+ }
+ } while (--n != 0);
+ }
+ if (Env.Bind == q.Env.Bind)
+ break;
+ if (Env.Bind.Eswp == 0)
+ for (i = Env.Bind.Cnt; (i -= 2) >= 0;)
+ Env.Bind.Data[i+1].Car = Env.Bind.Data[i];
+ Env.Bind = Env.Bind.Link;
+ }
+ while (Env.InFrames != q.Env.InFrames)
+ Env.popInFiles();
+ while (Env.OutFrames != q.Env.OutFrames)
+ Env.popOutFiles();
+ Env = q.Env;
+ q.Fin.eval();
+ Catch = q.Link;
+ if (q == target)
+ return;
+ }
+ while (Env.Bind != null) {
+ if (Env.Bind.Eswp == 0)
+ for (i = Env.Bind.Cnt; (i -= 2) >= 0;)
+ Env.Bind.Data[i+1].Car = Env.Bind.Data[i];
+ Env.Bind = Env.Bind.Link;
+ }
+ while (Env.InFrames != null)
+ Env.popInFiles();
+ while (Env.OutFrames != null)
+ Env.popOutFiles();
}
- final static Any err(Any ex, Any x, String msg) {
+ final static void error(Any ex, Any x, String msg) {
+ Up.Car = ex == null? Nil : ex;
+ if (msg.length() != 0) {
+ Msg.Car = mkStr(msg);
+ for (Catch p = Catch; p != null; p = p.Link) {
+ Any y = p.Tag;
+ if (y != null)
+ while (y instanceof Cell) {
+ if (msg.indexOf(y.Car.name()) >= 0)
+ throw new Control(ex, p.Tag, y.Car == Nil? Msg.Car : y.Car);
+ y = y.Cdr;
+ }
+ }
+ }
+ Env.pushOutFile(new OutFrame(OutFiles[2], 0));
+ if (InFile.Name != null)
+ StdErr.Wr.print('[' + InFile.Name + ':' + InFile.Src + "] ");
if (ex != null) {
StdErr.Wr.print("!? ");
StdErr.print(ex);
StdErr.newline();
}
- if (x != null)
- msg = x + " -- " + msg;
- throw new Error(msg);
+ if (x != null) {
+ StdErr.print(x);
+ StdErr.Wr.print(" -- ");
+ }
+ if (msg.length() != 0) {
+ StdErr.Wr.print(msg);
+ StdErr.newline();
+ if (Err.Car != Nil && !Jam) {
+ Jam = true;
+ Err.Car.prog();
+ Jam = false;
+ }
+ load(null, '?', Nil);
+ }
+ unwind(null);
+ Env.Args = null;
+ Env.Next = 0;
+ Env.Make = Env.Yoke = null;
}
+ final static Any err(Any ex, Any x, String msg) {
+ error(ex, x, msg);
+ throw new Control();
+ }
+
+ final static Any brkLoad(Any x) {
+ if (!Break) {
+ Break = true;
+ OutFile.Wr.flush();
+ Brk = new Bind();
+ Brk.add(Up.Car); Brk.add(Up); Up.Car = x;
+ Brk.add(Run.Car); Brk.add(Run); Run.Car = Nil;
+ Brk.add(At.Car); Brk.add(At);
+ Env.Bind = Brk;
+ Env.pushOutFile(new OutFrame(OutFiles[1], 0));
+ OutFile.print(x);
+ OutFile.newline();
+ load(null, '!', Nil);
+ Env.popOutFiles();
+ At.Car = Brk.Data[4];
+ Run.Car = Brk.Data[2];
+ x = Up.Car;
+ Up.Car = Brk.Data[0];
+ Env.Bind = Brk.Link;
+ Break = false;
+ }
+ return x;
+ }
+
+ final static void trace(int i, Any x, String s) {
+ if (i > 64)
+ i = 64;
+ while (--i >= 0)
+ StdErr.space();
+ if (x instanceof Symbol)
+ StdErr.print(x);
+ else {
+ StdErr.print(x.Car);
+ StdErr.space();
+ StdErr.print(x.Cdr);
+ StdErr.space();
+ StdErr.print(This.Car);
+ }
+ StdErr.Wr.print(s);
+ }
+
+ final static Any execError(Any x) {return err(null, x, "Can't execute");}
+ final static Any protError(Any x) {return err(null, x, "Protected symbol");}
+ final static Any symError(Any x) {return err(null, x, "Symbol expected");}
+ final static void needVar(Any ex, Any x) {if (x instanceof Number) err(ex, x, "Variable expected");}
+
+ final static void badFd(Any ex, Any x) {err(ex, x, "Bad FD");}
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() == '-')
+ if (x instanceof Symbol && firstChar(x) == '-')
return ((Symbol)x).parse(true,null).eval();
- Env.pushInFile(x.open(ex));
+ Env.pushInFile(x.rdOpen(ex));
Transient.clear();
x = Nil;
for (;;) {
Any y;
- if (InFile != StdIn)
+ if (InFile.Name != null)
y = InFile.read('\0');
else {
if (pr != '\0' && InFile.Chr == 0) {
@@ -108,13 +337,13 @@ public class PicoLisp {
}
if (y == Nil)
break;
- if (InFile != StdIn || InFile.Chr != 0 || pr == '\0')
+ if (InFile.Name != null || 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);
+ Any at = At.Car;
+ x = At.Car = y.eval();
+ At3.Car = At2.Car;
+ At2.Car = at;
OutFile.Wr.print("-> ");
OutFile.Wr.flush();
OutFile.print(x);
@@ -122,13 +351,14 @@ public class PicoLisp {
}
}
Env.popInFiles();
+ Transient.clear();
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]));
+ x = load(ex, '\0', mkStr(Argv[0]));
String[] a = new String[Argv.length-1];
System.arraycopy(Argv, 1, a, 0, a.length);
Argv = a;
@@ -137,8 +367,6 @@ public class PicoLisp {
}
final static Any undefined(Any x, Any ex) {
- OutFile.print(ex); /* ... */
- OutFile.newline();
return err(ex, x, "Undefined");
}
@@ -152,17 +380,165 @@ public class PicoLisp {
return a;
}
+ final static int allocPid() {
+ int i;
+ for (i = 2; Pids[i] != null; ++i) {
+ if (i == Pids.length) {
+ Process[] p = new Process[i*2];
+ System.arraycopy(Pids, 0, p, 0, i);
+ Pids = p;
+ break;
+ }
+ }
+ return i;
+ }
+
+ final static int allocFd() {
+ int i;
+ for (i = 3; InFiles[i] != null || OutFiles[i] != null; ++i) {
+ if (i == InFiles.length) {
+ PicoLispReader[] r = new PicoLispReader[i*2];
+ System.arraycopy(InFiles, 0, r, 0, i);
+ InFiles = r;
+ PicoLispWriter[] w = new PicoLispWriter[i*2];
+ System.arraycopy(OutFiles, 0, w, 0, i);
+ OutFiles = w;
+ break;
+ }
+ }
+ return i;
+ }
+
+ final static Any mkChar(char c) {return new Symbol(null, "" + c);}
+ final static Any mkStr(String nm) {return nm == null || nm.length() == 0? Nil : new Symbol(null, nm);}
+ final static Any mkStr(StringBuilder sb) {return mkStr(sb.toString());}
final static Symbol mkSymbol(Any val) {return new Symbol(val, null);}
- final static Symbol mkSymbol(Any val, String name, HashMap<String,Symbol> table) {
+ final static Symbol mkSymbol(Any val, String nm, HashMap<String,Symbol> table) {
Symbol sym;
- if ((sym = table.get(name)) == null) {
- sym = new Symbol(val, name);
- table.put(name, sym);
+ if ((sym = table.get(nm)) == null) {
+ sym = new Symbol(val, nm);
+ table.put(nm, sym);
}
return sym;
}
+ final static Any strToNum(String s, int scl) throws NumberFormatException {
+ if (s.length() != 0 && s.charAt(0) == '+')
+ s = s.substring(1);
+ if (s.indexOf('.') <= 0)
+ return new Number(s);
+ return new Number((new BigDecimal(s)).setScale(scl, RoundingMode.HALF_UP).unscaledValue());
+ }
+
+ final static Any strToAtom(String s) {
+ if (s.equals("NIL"))
+ return Nil;
+ try {return strToNum(s, ((Number)Scl.Car).Cnt);}
+ catch (NumberFormatException e) {return mkSymbol(Nil, s, Intern);}
+ }
+
+ final static Any format(Any z, int scl, Any x) {
+ char sep = '.', ign = '\0';
+ if (x instanceof Cell) {
+ sep = firstChar(x.Car.eval());
+ if ((x = x.Cdr) instanceof Cell)
+ ign = firstChar(x.Car.eval());
+ }
+ StringBuilder sb = new StringBuilder();
+ if (z instanceof Number) {
+ String s = z.toString();
+ if (s.charAt(0) == '-') {
+ sb.append('-');
+ s = s.substring(1);
+ }
+ if ((scl = s.length() - scl - 1) < 0) {
+ sb.append('0');
+ sb.append(sep);
+ while (scl < -1) {
+ sb.append('0');
+ ++scl;
+ }
+ }
+ for (int i = 0;;) {
+ sb.append(s.charAt(i++));
+ if (i == s.length())
+ return mkStr(sb);
+ if (scl == 0)
+ sb.append(sep);
+ else if (ign != '\0' && scl > 0 && scl % 3 == 0)
+ sb.append(ign);
+ --scl;
+ }
+ }
+ String s = z.name();
+ for (int i = 0; i < s.length(); ++i) {
+ char c = s.charAt(i);
+ if (c != ign)
+ sb.append(c == sep? '.' : c);
+ }
+ try {return strToNum(sb.toString(), scl);}
+ catch (NumberFormatException e) {return Nil;}
+ }
+
+ final static Any token(Any x, char c) {
+ if (InFile.Chr == 0)
+ InFile.get();
+ if (InFile.skip(c) < 0)
+ return null;
+ if (InFile.Chr == '"') {
+ InFile.get();
+ if (InFile.Chr == '"') {
+ InFile.get();
+ return Nil;
+ }
+ if (!InFile.testEsc())
+ return Nil;
+ StringBuilder sb = new StringBuilder();
+ sb.append((char)InFile.Chr);
+ while (InFile.get() != '"' && InFile.testEsc())
+ sb.append((char)InFile.Chr);
+ InFile.get();
+ return mkStr(sb);
+ }
+ if (InFile.Chr >= '0' && InFile.Chr <= '9') {
+ StringBuilder sb = new StringBuilder();
+ sb.append((char)InFile.Chr);
+ while (InFile.get() >= '0' && InFile.Chr <= '9' || InFile.Chr == '.')
+ sb.append((char)InFile.Chr);
+ return strToAtom(sb.toString());
+ }
+ String s = x.name();
+ if (InFile.Chr >= 'A' && InFile.Chr <= 'Z' || InFile.Chr == '\\' || InFile.Chr >= 'a' && InFile.Chr <= 'z' || s.indexOf(InFile.Chr) >= 0) {
+ if (InFile.Chr == '\\')
+ InFile.get();
+ StringBuilder sb = new StringBuilder();
+ sb.append((char)InFile.Chr);
+ while (InFile.get() >= '0' && InFile.Chr <= '9' || InFile.Chr >= 'A' && InFile.Chr <= 'Z' || InFile.Chr == '\\' || InFile.Chr >= 'a' && InFile.Chr <= 'z' || s.indexOf(InFile.Chr) >= 0) {
+ if (InFile.Chr == '\\')
+ InFile.get();
+ sb.append((char)InFile.Chr);
+ }
+ s = sb.toString();
+ return s.equals("NIL")? Nil : mkSymbol(Nil, s, Intern);
+ }
+ return mkChar((char)InFile.get());
+ }
+
+ final static Any fish(Any ex, Any foo, Any[] v, Any res) {
+ if (foo.apply(ex, false, v, 1) != Nil)
+ return new Cell(v[0], res);
+ if (v[0] instanceof Cell) {
+ Any x = v[0];
+ if ((v[0] = x.Cdr) != Nil)
+ res = fish(ex, foo, v, res);
+ v[0] = x.Car;
+ res = fish(ex, foo, v, res);
+ v[0] = x;
+ }
+ return res;
+ }
+
final static Any all(HashMap<String,Symbol> table) {
Any x = Nil;
for (Iterator<Symbol> it = table.values().iterator(); it.hasNext();)
@@ -170,56 +546,85 @@ public class PicoLisp {
return x;
}
+ final static Any meta(Any x, Any y) {
+ Any z;
+ for (; x instanceof Cell; x = x.Cdr)
+ if (x.Car instanceof Symbol && ((z = x.Car.get(y)) != Nil || (z = meta(x.Car.Car, y)) != Nil))
+ return z;
+ return Nil;
+ }
+
+ final static boolean isa(Any cls, Any x) {
+ Any z;
+ z = x = x.Car;
+ while (x instanceof Cell) {
+ if (!(x.Car instanceof Cell)) {
+ while (x.Car instanceof Symbol) {
+ if (cls == x.Car || isa(cls, x.Car))
+ return true;
+ if (!((x = x.Cdr) instanceof Cell) || z == x)
+ return false;
+ }
+ return false;
+ }
+ if (z == (x = x.Cdr))
+ return false;
+ }
+ return false;
+ }
+
final static void redefMsg(Any x, Any y) {
- /* ... */
- OutFile.Wr.print("# ");
- OutFile.print(x);
+ StdErr.Wr.print("# ");
+ StdErr.print(x);
if (y != null) {
- OutFile.space();
- OutFile.print(y);
+ StdErr.space();
+ StdErr.print(y);
}
- OutFile.Wr.println(" redefined");
+ StdErr.Wr.println(" redefined");
+ StdErr.Wr.flush();
}
- 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));
+ final static void putSrc(Symbol s, Any k) {
+ if (Dbg.Car != Nil && InFile != null && InFile.Name != null) {
+ Any x = new Cell(new Number(InFile.Src), 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;
+ 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;
+ for (Any z = y.Cdr; z instanceof Cell; z = z.Cdr)
+ if (z.Car.Car == k) {
+ z.Car.Cdr = x;
return;
}
- ((Cell)y).Cdr = new Cell(new Cell(k, x), y.cdr());
+ 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()))
+ final static void redefine(Symbol s, Any x) {
+ if (s.Car != Nil && s != s.Car && !x.equal(s.Car))
redefMsg(s, null);
- s.Val = x;
+ s.Car = 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 int xInt(Any x) {return ((Number)x).Cnt;}
+ final static int evInt(Any ex) {return ((Number)ex.Car.eval()).Cnt;}
+ final static long evLong(Any ex) {return ((Number)ex.Car.eval()).longValue();}
+ final static String evString(Any ex) {return ex.Car.eval().name();}
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))
+ if (!((x = x.Cdr) instanceof Cell))
return null;
for (int i = 0; i < m; ++i)
if (mark[i] == x)
@@ -227,103 +632,365 @@ public class PicoLisp {
}
}
- 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))
+ final static Any fill(Any x, Any s) {
+ Any y, z;
+ if (x instanceof Number || x == Nil)
+ return null;
+ if (x instanceof Symbol)
+ return (s==Nil? x!=At && firstChar(x)=='@' : memq(x,s)!=null)? x.Car : null;
+ if ((y = fill(x.Car, s)) != null) {
+ z = fill(x.Cdr, s);
+ return new Cell(y, z == null? x.Cdr : z);
+ }
+ if ((y = fill(x.Cdr, s)) != null)
+ return new Cell(x.Car, y);
+ return null;
+ }
+
+ final static boolean isBlank(Any x) {
+ if (x != Nil) {
+ if (!(x instanceof Symbol))
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;
+ String s = x.name();
+ if (s != null)
+ for (int i = 0; i < s.length(); ++i)
+ if (s.charAt(i) > ' ')
+ return false;
+ }
+ return true;
+ }
+
+ final static Any funq(Any x) {
+ Any y;
+ if (x instanceof Symbol)
+ return Nil;
+ if (x instanceof Number)
+ return ((Number)x).Big == null && ((Number)x).Cnt <= MaxFun? x : Nil;
+ for (y = x.Cdr; y instanceof Cell; y = y.Cdr) {
+ if (y == x)
+ return Nil;
+ if (y.Car instanceof Cell) {
+ if (y.Car.Car instanceof Number) {
+ if (y.Cdr instanceof Cell)
+ return Nil;
+ }
+ else if (y.Car.Car == Nil || y.Car.Car == T)
+ return Nil;
}
+ else if (y.Cdr != Nil)
+ return Nil;
}
+ if (y != Nil)
+ return Nil;
+ if ((x = x.Car) == Nil)
+ return T;
+ for (y = x; y instanceof Cell;)
+ if (y.Car instanceof Number || y.Car instanceof Cell || y.Car == Nil || y.Car == T || x == (y = y.Cdr))
+ return Nil;
+ return y instanceof Number || y == T? Nil : x;
+ }
+
+ final static Any trim(Any x) {
+ Any y;
+ if (!(x instanceof Cell))
+ return x;
+ if ((y = trim(x.Cdr)) == Nil && isBlank(x.Car))
+ return Nil;
+ return new Cell(x.Car, y);
+ }
+
+ final static Any nCdr(int n, Any x) {
+ while (--n >= 0)
+ x = x.Cdr;
+ return x;
}
- 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);
+ final static Any nth(int n, Any x) {
+ if (--n < 0)
+ return Nil;
+ return nCdr(n,x);
+ }
+
+ final static Any sort(Any ex, Any lst, Any foo) {
+ Any x = lst, l = Nil, r = Nil, c = Nil;
+ do {
+ int i = foo == Nil? lst.Car.compare(x.Car) : foo.apply(ex, false, new Any[] {x.Car, lst.Car}, 2) == Nil? -1 : 1;
+ if (i > 0)
+ l = new Cell(x.Car, l);
+ else if (i < 0)
+ r = new Cell(x.Car, r);
+ else
+ c = new Cell(x.Car, c);
+ } while ((x = x.Cdr) instanceof Cell);
+ if ((lst = l) instanceof Cell) {
+ if (l.Cdr instanceof Cell)
+ for (lst = l = sort(ex, l, foo); (l = l.Cdr).Cdr instanceof Cell;);
+ if (c instanceof Cell)
+ for (l.Cdr = c; (l = l.Cdr).Cdr instanceof Cell;);
}
- 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);
+ else if ((lst = c) instanceof Cell)
+ for (l = c; l.Cdr instanceof Cell; l = l.Cdr);
+ else
+ return sort(ex, r, foo);
+ if (r instanceof Cell)
+ l.Cdr = r.Cdr instanceof Cell? sort(ex, r, foo) : r;
+ return lst;
+ }
+
+ final static Any consIdx(Any x, Any y) {
+ if (x.Cdr.Cdr instanceof Cell)
+ y = consIdx(x.Cdr.Cdr, y);
+ y = new Cell(x.Car, y);
+ return x.Cdr.Car instanceof Cell? consIdx(x.Cdr.Car, y) : y;
+ }
+
+ final static Any idx(Any var, Any key, int flg) {
+ Any x, y, z, p, tree, tos;
+ boolean ad;
+ int i;
+ if (key == null)
+ return var.Car instanceof Cell? consIdx(var.Car, Nil) : Nil;
+ if (!((x = var.Car) instanceof Cell)) {
+ if (flg > 0)
+ var.Car = new Cell(key, Nil);
+ return Nil;
}
- if (!(y instanceof Cell))
- return y == T? -1 : +1;
- Any a = x;
- Any b = y;
+ p = var;
+ ad = true;
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)
+ if ((i = key.compare(x.Car)) == 0) {
+ if (flg < 0) {
+ if (!(x.Cdr.Car instanceof Cell)) {
+ if (ad)
+ p.Car = x.Cdr.Cdr;
+ else
+ p.Cdr = x.Cdr.Cdr;
+ }
+ else if (!((y = x.Cdr.Cdr) instanceof Cell)) {
+ if (ad)
+ p.Car = x.Cdr.Car;
+ else
+ p.Cdr = x.Cdr.Car;
+ }
+ else if (!((z = y.Cdr.Car) instanceof Cell)) {
+ x.Car = y.Car;
+ x.Cdr.Cdr = y.Cdr.Cdr;
+ }
+ else {
+ while (z.Cdr.Car instanceof Cell)
+ z = (y = z).Cdr.Car;
+ x.Car = z.Car;
+ y.Cdr.Car = z.Cdr.Cdr;
+ }
+ }
+ return x;
+ }
+ if (!(x.Cdr instanceof Cell)) {
+ if (flg > 0)
+ x.Cdr = i < 0? new Cell(new Cell(key, Nil), Nil) : new Cell(Nil, new Cell(key, Nil));
+ return Nil;
+ }
+ if (i < 0) {
+ if (!(x.Cdr.Car instanceof Cell)) {
+ if (flg > 0)
+ x.Cdr.Car = new Cell(key, Nil);
+ return Nil;
+ }
+ p = x.Cdr; ad = true;
+ x = p.Car;
+ }
+ else {
+ if (!(x.Cdr.Cdr instanceof Cell)) {
+ if (flg > 0)
+ x.Cdr.Cdr = new Cell(key, Nil);
+ return Nil;
+ }
+ p = x.Cdr; ad = false;
+ x = p.Cdr;
+ }
+ }
+ }
+
+ final static Any consLup(Any x, Any y, Any from, Any to) {
+ if (x instanceof Cell) {
+ if (x.Car == T)
+ return consLup(x.Cdr.Car, y, from, to);
+ if (!(x.Car instanceof Cell))
+ return consLup(x.Cdr.Cdr, y, from, to);
+ if (to.compare(x.Car.Car) >= 0) {
+ y = consLup(x.Cdr.Cdr, y, from, to);
+ if (from.compare(x.Car.Car) <= 0) {
+ y = new Cell(x.Car, y);
+ return consLup(x.Cdr.Car, y, from, to);
+ }
+ }
+ if (from.compare(x.Car.Car) <= 0)
+ return consLup(x.Cdr.Car, y, from, to);
+ }
+ return y;
+ }
+
+ final static Any member(Any x, Any y) {
+ Any z = y;
+
+ while (y instanceof Cell) {
+ if (x.equal(y.Car))
+ return y;
+ if (z == (y = y.Cdr))
+ return null;
+ }
+ return y == Nil || !x.equal(y)? null : y;
+ }
+
+ final static Any memq(Any x, Any y) {
+ Any z = y;
+
+ while (y instanceof Cell) {
+ if (x == y.Car)
+ return y;
+ if (z == (y = y.Cdr))
+ return null;
+ }
+ return y == Nil || x != y? null : y;
+ }
+
+ final static int indx(Any x, Any y) {
+ int i = 1;
+ Any z = y;
+
+ while (y instanceof Cell) {
+ if (x.equal(y.Car))
+ return i;
+ ++i;
+ if (z == (y = y.Cdr))
return 0;
}
+ return 0;
}
- final static Any evRun(boolean ev, Any ex, int cnt, Any lst) {
+ final static boolean match(Any p, Any d) {
+ Any x;
+ for (;;) {
+ if (!(p instanceof Cell)) {
+ if (p instanceof Symbol && firstChar(p) == '@') {
+ p.Car = d;
+ return true;
+ }
+ return p.equal(d);
+ }
+ if ((x = p.Car) instanceof Symbol && firstChar(x) == '@') {
+ if (!(d instanceof Cell)) {
+ if (d.equal(p.Cdr)) {
+ x.Car = Nil;
+ return true;
+ }
+ return false;
+ }
+ if (match(p.Cdr, d.Cdr)) {
+ x.Car = new Cell(d.Car, Nil);
+ return true;
+ }
+ if (match(p.Cdr, d)) {
+ x.Car = Nil;
+ return true;
+ }
+ if (match(p, d.Cdr)) {
+ x.Car = new Cell(d.Car, x.Car);
+ return true;
+ }
+ }
+ if (!(d instanceof Cell) || !match(x, d.Car))
+ return false;
+ p = p.Cdr;
+ d = d.Cdr;
+ }
+ }
+
+ final static boolean unify(Number n1, Any x1, Number n2, Any x2) {
+ lookup1:
+ while (x1 instanceof Symbol && firstChar(x1) == '@') {
+ for (Any x = Penv; x.Car instanceof Cell; x = x.Cdr)
+ if (n1.Cnt == ((Number)x.Car.Car.Car).Cnt && x1 == x.Car.Car.Cdr) {
+ n1 = (Number)x.Car.Cdr.Car;
+ x1 = x.Car.Cdr.Cdr;
+ continue lookup1;
+ }
+ break;
+ }
+ lookup2:
+ while (x2 instanceof Symbol && firstChar(x2) == '@') {
+ for (Any x = Penv; x.Car instanceof Cell; x = x.Cdr)
+ if (n2.Cnt == ((Number)x.Car.Car.Car).Cnt && x2 == x.Car.Car.Cdr) {
+ n2 = (Number)x.Car.Cdr.Car;
+ x2 = x.Car.Cdr.Cdr;
+ continue lookup2;
+ }
+ break;
+ }
+ if (n1.Cnt == n2.Cnt && x1.equal(x2))
+ return true;
+ if (x1 instanceof Symbol && firstChar(x1) == '@') {
+ if (x1 != At) {
+ Penv = new Cell(new Cell(new Cell(n1,x1), Nil), Penv);
+ Penv.Car.Cdr = new Cell(n2,x2);
+ }
+ return true;
+ }
+ if (x2 instanceof Symbol && firstChar(x2) == '@') {
+ if (x2 != At) {
+ Penv = new Cell(new Cell(new Cell(n2,x2), Nil), Penv);
+ Penv.Car.Cdr = new Cell(n1,x1);
+ }
+ return true;
+ }
+ if (!(x1 instanceof Cell) || !(x2 instanceof Cell))
+ return x1.equal(x2);
+ Any env = Penv;
+ if (unify(n1, x1.Car, n2, x2.Car) && unify(n1, x1.Cdr, n2, x2.Cdr))
+ return true;
+ Penv = env;
+ return false;
+ }
+
+ final static Any lup(Number n, Any x) {
+ lup:
+ while (x instanceof Symbol && firstChar(x) == '@') {
+ for (Any y = Penv; y.Car instanceof Cell; y = y.Cdr)
+ if (n.Cnt == ((Number)y.Car.Car.Car).Cnt && x == y.Car.Car.Cdr) {
+ n = (Number)y.Car.Cdr.Car;
+ x = y.Car.Cdr.Cdr;
+ continue lup;
+ }
+ break;
+ }
+ return x instanceof Cell? new Cell(lup(n, x.Car), lup(n, x.Cdr)) : x;
+ }
+
+ final static Any lookup(Number n, Any x) {
+ return (x = lup(n,x)) instanceof Symbol && firstChar(x) == '@'? Nil : x;
+ }
+
+ final static Any uniFill(Any x) {
+ if (x instanceof Number)
+ return x;
+ if (x instanceof Symbol)
+ return lup((Number)Pnl.Car, x);
+ return new Cell(uniFill(x.Car), uniFill(x.Cdr));
+ }
+
+ final static Any evRun(boolean ev, Any x, int cnt, Any lst) {
int i, j = cnt, n = 0;
- Bind bnd = Env.Bind;
- Symbol sym;
- Any y, z;
+ Bind b, bnd = Env.Bind;
+ Any s, 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];
+ s = bnd.Data[i+1];
+ y = s.Car;
+ s.Car = bnd.Data[i];
bnd.Data[i] = y;
}
if (bnd.Data[1] == At && --j == 0)
@@ -331,37 +998,37 @@ public class PicoLisp {
}
} while ((bnd = bnd.Link) != null);
if (!(lst instanceof Cell))
- z = ev? ex.eval() : ex.run();
+ z = ev? x.eval() : x.run();
else {
bnd = new Bind();
do {
- sym = (Symbol)lst.car();
- bnd.add(sym.Val);
- bnd.add(sym);
+ s = lst.Car;
+ bnd.add(s.Car);
+ bnd.add(s);
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];
+ for (b = Env.Bind, j = n; ;) {
+ for (i = 0; i < b.Cnt; i+= 2)
+ if (s == b.Data[i+1]) {
+ s.Car = b.Data[i];
break exclude;
}
- if (--j == 0 || (bnd = bnd.Link) == null)
+ if (--j == 0 || (b = b.Link) == null)
break;
}
- } while ((lst = lst.cdr()) instanceof Cell);
+ } while ((lst = lst.Cdr) instanceof Cell);
Env.Bind = bnd;
- z = ev? ex.eval() : ex.run();
+ z = ev? x.eval() : x.run();
for (i = bnd.Cnt; (i -= 2) >= 0;)
- ((Symbol)bnd.Data[i+1]).Val = bnd.Data[i];
+ bnd.Data[i+1].Car = 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];
+ s = bnd.Data[i+1];
+ y = s.Car;
+ s.Car = bnd.Data[i];
bnd.Data[i] = y;
}
} while (--n > 0);
@@ -370,35 +1037,35 @@ public class PicoLisp {
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);
+ Any y = ex.Car;
+ Any cls = TheCls, key = TheKey;
+ Bind bnd = new Bind(); bnd.add(At.Car); 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();
+ 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.Car); // Save old value
bnd.add(y); // and symbol
- y.set(x); // Set new value
+ y.Car = x; // Set new value
}
do {
- Symbol sym = (Symbol)bnd.Data[--i];
- x = sym.Val;
- sym.Val = bnd.Data[--i]; // Set new value
+ y = bnd.Data[--i];
+ x = y.Car;
+ y.Car = bnd.Data[--i]; // Set new value
bnd.Data[i] = x; // Save old value
} while (i > 0);
- bnd.add(This.Val);
+ bnd.add(This.Car);
bnd.add(This);
- This.Val = o;
+ This.Car = o;
Env.Bind = bnd;
- t = cls; cls = Env.Cls; Env.Cls = t;
- t = key; key = Env.Key; Env.Key = t;
- x = ex.cdr().prog();
+ y = cls; cls = Env.Cls; Env.Cls = y;
+ y = key; key = Env.Key; Env.Key = y;
+ x = ex.Cdr.prog();
}
else {
int next, argc, j = 0;
@@ -406,8 +1073,8 @@ public class PicoLisp {
if (x instanceof Cell) {
av = new Any[6];
do
- av = append(av, j++, x.car().eval());
- while ((x = x.cdr()) instanceof Cell);
+ 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;
@@ -415,73 +1082,127 @@ public class PicoLisp {
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
+ y = bnd.Data[--i];
+ x = y.Car;
+ y.Car = bnd.Data[--i]; // Set new value
bnd.Data[i] = x; // Save old value
} while (i > 0);
- bnd.add(This.Val);
+ bnd.add(This.Car);
bnd.add(This);
- This.Val = o;
+ This.Car = o;
Env.Bind = bnd;
- t = cls; cls = Env.Cls; Env.Cls = t;
- t = key; key = Env.Key; Env.Key = t;
- x = ex.cdr().prog();
+ y = cls; cls = Env.Cls; Env.Cls = y;
+ y = key; key = Env.Key; Env.Key = y;
+ 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;
+ bnd.Data[i+1].Car = bnd.Data[i];
Env.Bind = bnd.Link;
+ Env.Cls = cls; Env.Key = key;
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))
+ if ((y = x.Car) 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)
+ if ((x = method((TheCls = y).Car)) != null)
return x;
- while ((y = y.cdr()) instanceof Cell);
+ while ((y = y.Cdr) instanceof Cell);
}
return null;
}
+ final static Any extra(Any x) {
+ Any y;
+ for (x = x.Car; x.Car instanceof Cell; x = x.Cdr);
+ while (x instanceof Cell) {
+ if (x == Env.Cls || (y = extra(x.Car)) == null) {
+ while ((x = x.Cdr) instanceof Cell)
+ if ((y = method((TheCls = x).Car)) != null)
+ return y;
+ return null;
+ }
+ if (y != null && y != T)
+ return y;
+ x = x.Cdr;
+ }
+ return T;
+ }
+
+ final static Any loop(Any x) {
+ Any a, y, z;
+ for (;;) {
+ y = x;
+ do {
+ if ((z = y.Car) instanceof Cell) {
+ if (z.Car == Nil) {
+ if ((a = (z = z.Cdr).Car.eval()) == Nil)
+ return z.Cdr.prog();
+ At.Car = a;
+ }
+ else if (z.Car == T) {
+ if ((a = (z = z.Cdr).Car.eval()) != Nil) {
+ At.Car = a;
+ return z.Cdr.prog();
+ }
+ }
+ else
+ z.eval();
+ }
+ } while ((y = y.Cdr) instanceof Cell);
+ }
+ }
+
/* Ersatz PicoLisp Reader */
+ final static class InFrame {
+ InFrame Link;
+ PicoLispReader Rd;
+ int Pid;
+
+ InFrame(PicoLispReader rd, int pid) {
+ Link = Env.InFrames;
+ Rd = rd;
+ Pid = pid;
+ }
+ }
+
final static class PicoLispReader {
- PicoLispReader Link;
LineNumberReader Rd;
String Name;
char Eof1, Eof2;
- int Chr, Src;
+ int Fd, Chr, Src;
- PicoLispReader(Reader rd, String name) {
+ PicoLispReader(Reader rd, String nm, int fd) {
Rd = new LineNumberReader(rd);
- Name = name;
+ Name = nm;
+ if (fd < 0)
+ fd = allocFd();
+ InFiles[Fd = fd] = this;
}
- PicoLispReader(InputStream in) {
- this(new InputStreamReader(in), null);
+ PicoLispReader(InputStream in, int fd) {
+ this(new InputStreamReader(in), null, fd);
}
PicoLispReader(String s, char eof1, char eof2) {
- this(new StringReader(s), null);
+ this(new StringReader(s), null, -1);
Eof1 = eof1;
Eof2 = eof2;
}
final void close() {
try {
- if (this != StdIn)
- Rd.close();
+ InFiles[Fd] = null;
+ Rd.close();
}
catch (IOException e) {closeErr(e);}
}
@@ -491,9 +1212,9 @@ public class PicoLisp {
final int get() {
try {
if ((Chr = Rd.read()) < 0) {
- if ((Chr = Eof1) != '\0')
+ if ((Chr = Eof1) != 0)
Eof1 = '\0';
- else if ((Chr = Eof2) != '\0')
+ else if ((Chr = Eof2) != 0)
Eof2 = '\0';
else
Chr = -1;
@@ -503,6 +1224,22 @@ public class PicoLisp {
catch (IOException e) {return -1;}
}
+ final boolean eol() {
+ if (Chr < 0)
+ return true;
+ if (Chr == '\n') {
+ Chr = 0;
+ return true;
+ }
+ if (Chr == '\r') {
+ get();
+ if (Chr == '\n')
+ Chr = 0;
+ return true;
+ }
+ return false;
+ }
+
final int skip(int c) {
for (;;) {
if (Chr < 0)
@@ -566,13 +1303,7 @@ public class PicoLisp {
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);
- }
+ return strToAtom(sb.toString());
}
final Any rdList() {
@@ -591,8 +1322,8 @@ public class PicoLisp {
}
get();
if ((res = x = read0(false).eval()) instanceof Cell) {
- while (x.cdr() instanceof Cell)
- x = x.cdr();
+ while (x.Cdr instanceof Cell)
+ x = x.Cdr;
break;
}
}
@@ -606,22 +1337,22 @@ public class PicoLisp {
if (Chr == '.') {
get();
if (Delim.indexOf(Chr) >= 0) {
- ((Cell)x).Cdr = skip('#')==')' || Chr==']'? res : read0(false);
+ 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);
+ x = x.Cdr = new Cell(rdAtom('.'), Nil);
}
else if (Chr != '~')
- x = ((Cell)x).Cdr = new Cell(read0(false), Nil);
+ x = x.Cdr = new Cell(read0(false), Nil);
else {
get();
- ((Cell)x).Cdr = read0(false).eval();
- while (x.cdr() instanceof Cell)
- x = x.cdr();
+ x.Cdr = read0(false).eval();
+ while (x.Cdr instanceof Cell)
+ x = x.Cdr;
}
}
return res;
@@ -635,7 +1366,7 @@ public class PicoLisp {
eofErr();
}
if (top && InFile != null)
- InFile.Src = InFile.Rd.getLineNumber();
+ InFile.Src = InFile.Rd.getLineNumber() + 1;
if (Chr == '(') {
x = rdList();
if (top && Chr == ']')
@@ -653,6 +1384,10 @@ public class PicoLisp {
get();
return new Cell(Quote, read0(false));
}
+ if (Chr == ',') {
+ get();
+ return (y = idx(Uni, x = read0(false), 1)) instanceof Cell? y.Car : x;
+ }
if (Chr == '`') {
get();
return read0(false).eval();
@@ -697,15 +1432,38 @@ public class PicoLisp {
}
/* Ersatz PicoLisp Printer */
+ final static class OutFrame {
+ OutFrame Link;
+ PicoLispWriter Wr;
+ int Pid;
+
+ OutFrame(PicoLispWriter wr, int pid) {
+ Link = Env.OutFrames;
+ Wr = wr;
+ Pid = pid;
+ }
+ }
+
final static class PicoLispWriter {
- PicoLispWriter Link;
PrintWriter Wr;
+ String Name;
+ int Fd;
+
+ PicoLispWriter(PrintWriter wr, String nm, int fd) {
+ Wr = wr;
+ Name = nm;
+ if (fd < 0)
+ fd = allocFd();
+ OutFiles[Fd = fd] = this;
+ }
- PicoLispWriter(OutputStream out) {Wr = new PrintWriter(out);}
+ PicoLispWriter(OutputStream out, int fd) {
+ this(new PrintWriter(out), null, fd);
+ }
final void close() {
- if (this != StdOut && this != StdErr)
- Wr.close();
+ OutFiles[Fd] = null;
+ Wr.close();
}
final void print(Any x) {Wr.print(x.toString());}
@@ -725,33 +1483,68 @@ public class PicoLisp {
Bind() {
Link = Env.Bind;
- Data = new Any[6];
+ Data = new Any[12];
}
final void add(Any x) {Data = append(Data, Cnt++, x);}
}
final static class Env {
- Env Link;
- int Next, ArgC;
+ int Next, ArgC, Trace;
Bind Bind;
- Any Arg, Args[], Cls, Key;
- PicoLispReader InFiles;
- PicoLispWriter OutFiles;
+ Any Arg, Args[], Cls, Key, Make, Yoke;
+ InFrame InFrames;
+ OutFrame OutFrames;
+
+ Env() {}
+
+ Env(Env env) {
+ Next = env.Next; ArgC = env.ArgC; Trace = env.Trace;
+ Bind = env.Bind;
+ Arg = env.Arg; Args = env.Args;
+ Cls = env.Cls; Key = env.Key;
+ Make = env.Make; Yoke = env.Yoke;
+ InFrames = env.InFrames; OutFrames = env.OutFrames;
+ }
- final void pushInFile(PicoLispReader in) {
- in.Link = InFiles;
- InFile = InFiles = in;
+ final void pushInFile(InFrame in) {
+ InFrames = in;
+ InFile = InFiles[in.Rd.Fd];
}
final void popInFiles() {
- InFile.close();
- InFile = InFiles = InFiles.Link;
+ if (InFrames.Pid != 0) {
+ InFile.close();
+ if (InFrames.Pid > 1) {
+ try {
+ if (Pids[InFrames.Pid].waitFor() != 0)
+ err(null, null, "Pipe read close error");
+ Pids[InFrames.Pid] = null;
+ }
+ catch (InterruptedException e) {} //#! sighandler()
+ }
+ }
+ InFile = (InFrames = InFrames.Link) == null? StdIn : InFiles[InFrames.Rd.Fd];
}
- final void pushOutFile(PicoLispWriter out) {
- out.Link = OutFiles;
- OutFile = OutFiles = out;
+ final void pushOutFile(OutFrame out) {
+ OutFrames = out;
+ OutFile = OutFiles[out.Wr.Fd];
+ }
+
+ final void popOutFiles() {
+ if (OutFrames.Pid != 0) {
+ OutFile.close();
+ if (OutFrames.Pid > 1) {
+ try {
+ if (Pids[OutFrames.Pid].waitFor() != 0)
+ err(null, null, "Pipe write close error");
+ Pids[OutFrames.Pid] = null;
+ }
+ catch (InterruptedException e) {} //#! sighandler()
+ }
+ }
+ OutFile = (OutFrames = OutFrames.Link) == null? StdOut : OutFiles[OutFrames.Wr.Fd];
}
}
@@ -763,15 +1556,17 @@ public class PicoLisp {
Catch(Any tag, Any fin, Env env) {
Tag = tag;
Fin = fin;
- Env = env;
+ Env = new Env(env);
Link = Catch; Catch = this;
}
}
- static final class Throw extends RuntimeException {
+ final static class Control extends RuntimeException {
Any Tag, Val;
- Throw(Any ex, Any tag, Any val) {
+ Control() {}
+
+ Control(Any ex, Any tag, Any val) {
Tag = tag;
Val = val;
for (Catch p = Catch; p != null; p = p.Link)
@@ -783,94 +1578,335 @@ public class PicoLisp {
}
}
- 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);
+ static abstract class Any {
+ Any Car, Cdr;
+
+ abstract Any put(Any key, Any val);
+ abstract Any get(Any key);
+ abstract Any prop(Any key);
+ abstract Any putl(Any lst);
+ abstract Any getl();
+ abstract Any eval();
+ abstract Any prog();
+ abstract Any run();
+ abstract Any call(Any ex);
+ abstract Any func(Any ex);
+ abstract Any apply(Any ex, boolean cf, Any[] v, int n);
+ abstract boolean equal(Any x);
+ abstract int compare(Any x);
+ abstract long length();
+ abstract long size();
+ abstract InFrame rdOpen(Any ex);
+ abstract OutFrame wrOpen(Any ex);
+ abstract String name();
+ }
+
+ final static class Number extends Any {
+ int Cnt;
+ BigInteger Big;
+
+ Number(int i) {Cnt = i;}
+
+ Number(long n) {
+ if (n >= Integer.MIN_VALUE && n <= Integer.MAX_VALUE)
+ Cnt = (int)n;
+ else
+ Big = new BigInteger(new byte[] {(byte)(n>>56), (byte)(n>>48), (byte)(n>>40), (byte)(n>>32), (byte)(n>>24), (byte)(n>>16), (byte)(n>>8), (byte)n});
+ }
+
+ Number(BigInteger b) {
+ if (b.bitLength() < 32)
+ Cnt = b.intValue();
+ else
+ Big = b;
+ }
+
+ Number(String s) {
+ try {Cnt = Integer.parseInt(s);}
+ catch (NumberFormatException e) {Big = new BigInteger(s);}
+ }
+
+ final long longValue() {return Big == null? Cnt : Big.longValue();}
+
+ final static BigInteger big(int i) {
+ return new BigInteger(new byte[] {(byte)(i>>24), (byte)(i>>16), (byte)(i>>8), (byte)i});
+ }
+
+ final Any put(Any key, Any val) {return symError(this);}
+ final Any get(Any key) {return symError(this);}
+ final Any prop(Any key) {return symError(this);}
+ final Any putl(Any lst) {return symError(this);}
+ final Any getl() {return symError(this);}
+ final Any eval() {return this;}
+ final Any prog() {return execError(this);}
+ final Any run() {return execError(this);}
+ final Any call(Any ex) {return ex;}
+
+ final Any func(Any ex) {
+ try {
+ switch(Cnt) {
+ case 0: // (quote . any) -> any
+ return ex.Cdr;
+ case 1: // (meth 'obj ['any ..]) -> any
+ return doMeth(ex);
+ <FUN> 1
+ default:
+ return undefined(this, ex);
+ }
+ }
+ catch (Throwable e) {
+ if (e instanceof Control)
+ throw (Control)e;
+ return err(ex, null, e.toString());
}
}
- final public Any apply(Cell ex, boolean cf, Any[] v, int n) {
+ final static Any doMeth(Any ex) {
+ Any x, y, z;
+ z = (x = ex.Cdr).Car.eval();
+ for (TheKey = ex.Car; ; TheKey = TheKey.Car)
+ if (TheKey.Car instanceof Number) {
+ TheCls = null;
+ if ((y = method(z)) != null)
+ return evMethod(z, y, x.Cdr);
+ err(ex, TheKey, "Bad message");
+ }
+ }
+
+ <DEF> 1
+
+ final Any apply(Any 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);
+ 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);
+ x = 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 boolean equal(Any x) {
+ if (x == this)
+ return true;
+ if (!(x instanceof Number))
+ return false;
+ Number num = (Number)x;
+ if (Big == null)
+ return num.Big == null && Cnt == num.Cnt;
+ return Big == num.Big;
+ }
+
+ final int compare(Any x) {
+ if (x == this)
+ return 0;
+ if (x == Nil)
+ return +1;
+ if (!(x instanceof Number))
+ return -1;
+ Number num = (Number)x;
+ if (Big == null)
+ return num.Big == null? Cnt - num.Cnt : -1;
+ return Big.compareTo(num.Big);
+ }
+
+ final long length() {return (Big == null? Integer.toString(Cnt) : Big.toString()).length();}
+
+ final long size() {
+ if (Big == null) {
+ int n = 2 * (Cnt >= 0? Cnt : -Cnt);
+ if (n == 0)
+ return 1;
+ int i = 1;
+ while ((n >>= 8) != 0)
+ ++i;
+ return i;
+ }
+ return Big.toByteArray().length;
+ }
+
+ final InFrame rdOpen(Any ex) {
+ int i;
+ InFrame f;
+ if ((i = Cnt) < 0) {
+ for (f = Env.InFrames;;) {
+ if ((f = f.Link) == null)
+ badFd(ex, this);
+ if (++i == 0) {
+ i = f.Rd.Fd;
+ break;
+ }
+ }
+ }
+ if (i >= InFiles.length || InFiles[i] == null)
+ badFd(ex, this);
+ return new InFrame(InFiles[i],0);
+ }
+
+ final OutFrame wrOpen(Any ex) {
+ int i;
+ OutFrame f;
+ if ((i = Cnt) < 0) {
+ for (f = Env.OutFrames;;) {
+ if ((f = f.Link) == null)
+ badFd(ex, this);
+ if (++i == 0) {
+ i = f.Wr.Fd;
+ break;
+ }
+ }
+ }
+ if (i >= OutFiles.length || OutFiles[i] == null)
+ badFd(ex, this);
+ return new OutFrame(OutFiles[i],0);
+ }
+
+ final String name() {return Big == null? Integer.toString(Cnt) : Big.toString();}
+ final public String toString() {return name();}
+
+ final Number abs() {
+ if (Big == null) {
+ if (Cnt >= 0)
+ return this;
+ if (Cnt != Integer.MIN_VALUE)
+ return new Number(-Cnt);
+ return new Number(-(long)Cnt);
+ }
+ return new Number(Big.abs());
+ }
+
+ final Number neg() {
+ if (Big == null) {
+ if (Cnt != Integer.MIN_VALUE)
+ return new Number(-Cnt);
+ return new Number(-(long)Cnt);
+ }
+ return new Number(Big.negate());
+ }
+
+ final Number add(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt + (long)num.Cnt);
+ return new Number(big(Cnt).add(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.add(big(num.Cnt)));
+ return new Number(Big.add(num.Big));
+ }
+
+ final Number sub(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt - (long)num.Cnt);
+ return new Number(big(Cnt).subtract(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.subtract(big(num.Cnt)));
+ return new Number(Big.subtract(num.Big));
+ }
+
+ final Number mul(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt * (long)num.Cnt);
+ return new Number(big(Cnt).multiply(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.multiply(big(num.Cnt)));
+ return new Number(Big.multiply(num.Big));
+ }
+
+ final Number div(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt / (long)num.Cnt);
+ return new Number(big(Cnt).divide(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.divide(big(num.Cnt)));
+ return new Number(Big.divide(num.Big));
+ }
+
+ final Number rem(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt % (long)num.Cnt);
+ return new Number(big(Cnt).remainder(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.remainder(big(num.Cnt)));
+ return new Number(Big.remainder(num.Big));
+ }
+
+ final Number shift(int i) {
+ if (Big == null) {
+ if (i >= 0)
+ return new Number((long)Cnt >> i);
+ if (i > -32)
+ return new Number((long)Cnt << -i);
+ return new Number((new BigInteger(new byte[] {(byte)(Cnt>>24), (byte)(Cnt>>16), (byte)(Cnt>>8), (byte)Cnt})).shiftRight(i));
+ }
+ return new Number(Big.shiftRight(i));
+ }
+
+ final boolean tst(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return Cnt == (Cnt & num.Cnt);
+ BigInteger b = big(Cnt);
+ return b.equals(b.and(num.Big));
+ }
+ if (num.Big == null)
+ return Big.equals(Big.and(big(num.Cnt)));
+ return Big.equals(Big.and(num.Big));
+ }
+
+ final Number and(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt & (long)num.Cnt);
+ return new Number(big(Cnt).and(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.and(big(num.Cnt)));
+ return new Number(Big.and(num.Big));
+ }
+
+ final Number or(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt | (long)num.Cnt);
+ return new Number(big(Cnt).or(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.or(big(num.Cnt)));
+ return new Number(Big.or(num.Big));
+ }
+
+ final Number xor(Number num) {
+ if (Big == null) {
+ if (num.Big == null)
+ return new Number((long)Cnt ^ (long)num.Cnt);
+ return new Number(big(Cnt).xor(num.Big));
+ }
+ if (num.Big == null)
+ return new Number(Big.xor(big(num.Cnt)));
+ return new Number(Big.xor(num.Big));
}
}
- final static class Symbol implements Any {
- Any Val, Prop[];
+ final static class Symbol extends Any {
+ Any Prop[];
String Name;
- Symbol(Any val, String name) {
- Val = val == null? this : val;
- Name = name;
+ Symbol(Any val, String nm) {
+ Car = val == null? this : val;
+ Name = nm;
}
- final public Any set(Any val) {return Val = val;}
-
- final public Any put(Any key, Any val) {
- if (key.equals(Zero))
- Val = val;
+ final Any put(Any key, Any val) {
+ if (key.equal(Zero))
+ Car = val;
else if (Prop != null) {
Any x;
int i = Prop.length, p = -1;
@@ -878,13 +1914,13 @@ public class PicoLisp {
if ((x = Prop[--i]) == null)
p = i;
else if (x instanceof Cell) {
- if (key == x.cdr()) {
+ if (key == x.Cdr) {
if (val == Nil)
Prop[i] = null;
else if (val == T)
Prop[i] = key;
else
- x.set(val);
+ x.Car = val;
return val;
}
}
@@ -910,9 +1946,9 @@ public class PicoLisp {
return val;
}
- final public Any get(Any key) {
- if (key.equals(Zero))
- return Val;
+ final Any get(Any key) {
+ if (key.equal(Zero))
+ return Car;
if (Prop == null)
return Nil;
Any x;
@@ -920,8 +1956,8 @@ public class PicoLisp {
do {
if ((x = Prop[--i]) != null) {
if (x instanceof Cell) {
- if (key == x.cdr())
- return x.car();
+ if (key == x.Cdr)
+ return x.Car;
}
else if (key == x)
return T;
@@ -930,46 +1966,79 @@ public class PicoLisp {
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 Any prop(Any key) {
+ 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;
+ }
+ else if (key == x)
+ return key;
+ }
+ } while (i != 0);
+ return Nil;
+ }
- final public Any call(Cell ex) {
- if (Val == Nil)
+ final Any putl(Any lst) {
+ Prop = new Any[6];
+ int i = 0;
+ for (Any y = lst; y instanceof Cell; y = y.Cdr)
+ Prop = append(Prop, i++, y.Car);
+ return lst;
+ }
+
+ final Any getl() {
+ Any x = Nil;
+ if (Prop != null)
+ for (int i = Prop.length; --i >= 0;)
+ if (Prop[i] != null)
+ x = new Cell(Prop[i], x);
+ return x;
+ }
+
+ final Any eval() {return Car;}
+ final Any prog() {return Car;}
+ final Any run() {return Car;}
+
+ final Any call(Any ex) {
+ if (Car == Nil)
undefined(this, ex);
- return Val.func(ex);
+ return Car.func(ex);
}
- final public Any func(Cell ex) {return Val.func(ex);}
+ final Any func(Any ex) {return Car.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];
+ final Any apply(Any ex, boolean cf, Any[] v, int n) {
+ if (Car == Meth.Car) {
+ 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
+ Bind bnd = new Bind(); bnd.add(At.Car); 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();
+ y.Car = 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.Car); // Save value
bnd.add(x); // and symbol
- x.set(Nil); // Set to NIL
+ x.Car = Nil; // Set to NIL
}
- bnd.add(This.Val);
+ bnd.add(This.Car);
bnd.add(This);
- This.Val = o;
+ This.Car = o;
Env.Bind = bnd;
- x = z.cdr().prog();
+ x = z.Cdr.prog();
}
else {
int next, argc, j = 0;
@@ -977,48 +2046,83 @@ public class PicoLisp {
if (i < n) {
av = new Any[6];
do
- av = append(av, j++, x.car().eval());
+ 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.Car);
bnd.add(This);
- This.Val = o;
+ This.Car = o;
Env.Bind = bnd;
- x = z.cdr().prog();
+ 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;
+ bnd.Data[i+1].Car = bnd.Data[i];
Env.Bind = bnd.Link;
+ Env.Cls = cls; Env.Key = key;
return x;
}
err(ex, o, "Bad object");
}
- if (Val == Nil || Val == this)
+ if (Car == Nil || Car == this)
undefined(this, ex);
- return Val.apply(ex, cf, v, n);
+ return Car.apply(ex, cf, v, n);
}
- final public PicoLispReader open(Any ex) {
+ final boolean equal(Any x) {return this == x || (x instanceof Symbol) && Name.equals(((Symbol)x).Name);}
+
+ final int compare(Any x) {
+ if (x == this)
+ return 0;
+ if (this == T || x == Nil || x instanceof Number)
+ return +1;
+ if (x == T || x instanceof Cell)
+ return -1;
+ String a = Name;
+ String b = ((Symbol)x).Name;
+ if (a == null)
+ return b == null? hashCode() - x.hashCode() : -1;
+ if (b == null)
+ return +1;
+ return a.compareTo(b);
+ }
+
+ final long length() {return Name == null? 0 : Name.length();}
+ final long size() {return Name == null? 0 : Name.getBytes().length;}
+
+ final InFrame rdOpen(Any ex) {
try {
String nm = path(Name);
- if (firstChar() == '+') {
- /* ... */
- }
- return new PicoLispReader(new FileReader(nm), nm);
+ if (nm.charAt(0) == '+')
+ nm = nm.substring(1); // No file reader with "rw" mode
+ return new InFrame(new PicoLispReader(new FileReader(nm), nm, -1), 1);
}
catch (IOException e) {
- err(ex, this, "Can't open");
+ err(ex, this, "Read open error");
return null;
}
}
+ final OutFrame wrOpen(Any ex) {
+ try {
+ String nm = path(Name);
+ if (nm.charAt(0) == '+')
+ return new OutFrame(new PicoLispWriter(new PrintWriter(new FileWriter(nm.substring(1), true)), nm, -1), 1);
+ return new OutFrame(new PicoLispWriter(new PrintWriter(nm), nm, -1), 1);
+ }
+ catch (IOException e) {
+ err(ex, this, "Write open error");
+ return null;
+ }
+ }
+
+ final String name() {return Name == null? "" : Name;}
+
final public String toString() {
if (Name == null)
return "$" + hashCode();
@@ -1050,11 +2154,8 @@ public class PicoLisp {
return sb.toString();
}
- final char firstChar() {
- return Name == null? '\0' : Name.charAt(0);
- }
-
final Any parse(boolean skp, Any s) {
+ Any x, y;
PicoLispReader rd;
if (s == null)
rd = new PicoLispReader(Name, '\n', ']');
@@ -1064,106 +2165,117 @@ public class PicoLisp {
rd.get();
if (s == null)
return rd.rdList();
- /* ... token() */
- return Nil;
+ if ((x = token(s, '\0')) == null)
+ return Nil;
+ y = new Cell(x, Nil);
+ while ((x = token(s, '\0')) != null)
+ y = y.Cdr = new Cell(x, Nil);
+ return y;
}
}
- 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 static class NilSym extends Any {
+ NilSym() {
+ Car = this;
+ Cdr = this;
+ }
+
+ final Any put(Any key, Any val) {return protError(this);}
+ final Any get(Any key) {return this;}
+ final Any prop(Any key) {return this;}
+ final Any putl(Any lst) {return protError(this);}
+ final Any getl() {return protError(this);}
+ final Any eval() {return this;}
+ final Any prog() {return this;}
+ final Any run() {return this;}
+ final Any call(Any ex) {return undefined(this,ex);}
+ final Any func(Any ex) {return undefined(this,ex);}
+ final Any apply(Any ex, boolean cf, Any[] v, int n) {return undefined(this,ex);}
+ final boolean equal(Any x) {return x == Nil;}
+ final int compare(Any x) {return x == this? 0 : -1;}
+ final long length() {return 0;}
+ final long size() {return 0;}
+ final InFrame rdOpen(Any ex) {return new InFrame(InFiles[0], 0);}
+ final OutFrame wrOpen(Any ex) {return new OutFrame(OutFiles[1], 0);}
+ final String name() {return "";}
final public String toString() {return "NIL";}
}
- final static class Cell implements Any {
- Any Car, Cdr;
-
+ final static class Cell extends Any {
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 Any put(Any key, Any val) {return symError(this);}
- final public Any get(Any key) {
+ final Any get(Any key) {
Any x, y = this;
if (key instanceof Number) {
- int n = ((Number)key).intValue();
+ int n = ((Number)key).Cnt;
if (n > 0) {
while (--n != 0)
- y = y.cdr();
- return y.car();
+ y = y.Cdr;
+ return y.Car;
}
if (n < 0) {
while (++n != 0)
- y = y.cdr();
- return y.cdr();
+ 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);
+ 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 Any prop(Any key) {return symError(this);}
+ final Any putl(Any lst) {return symError(this);}
+ final Any getl() {return symError(this);}
+ final 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 Any prog() {
+ Any ex;
+ for (ex = this; ex.Cdr != Nil; ex = ex.Cdr)
+ ex.Car.eval();
+ return ex.Car.eval();
}
- final public Any run() {
- Any x, y = this, at = At.Val;
+ final Any run() {
+ Any x, at = At.Car;
+ Any ex = this;
do
- x = y.car().eval();
- while ((y = y.cdr()) instanceof Cell);
- At.Val = at;
+ x = ex.Car.eval();
+ while ((ex = ex.Cdr) != Nil);
+ At.Car = at;
return x;
}
- final public Any call(Cell ex) {return eval().func(ex);}
+ final Any call(Any ex) {return eval().func(ex);}
- final public Any func(Cell ex) {
+ final Any func(Any 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) {
+ Any x, y;
+ Bind bnd = new Bind(); bnd.add(At.Car); bnd.add(At);
+ for (x = Car; x instanceof Cell; x = x.Cdr) {
+ bnd.add((ex = ex.Cdr).Car.eval()); // Save new value
+ bnd.add(x.Car); // and symbol
+ }
+ if (x == Nil || x != 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
+ if (x != Nil) {
+ bnd.add(x.Car); // Save old value
+ bnd.add(x); // and symbol
+ x.Car = ex.Cdr; // Set new value
}
do {
- Symbol sym = (Symbol)bnd.Data[--i];
- x = sym.Val;
- sym.Val = bnd.Data[--i]; // Set new value
+ y = bnd.Data[--i];
+ x = y.Car;
+ y.Car = bnd.Data[--i]; // Set new value
bnd.Data[i] = x; // Save old value
} while (i > 0);
Env.Bind = bnd;
@@ -1172,11 +2284,11 @@ public class PicoLisp {
else {
int next, argc, j = 0;
Any arg, args[], av[] = null;
- if (x instanceof Cell) {
+ if (ex.Cdr != Nil) {
av = new Any[6];
do
- av = append(av, j++, x.car().eval());
- while ((x = x.cdr()) instanceof Cell);
+ av = append(av, j++, (ex = ex.Cdr).Car.eval());
+ while (ex.Cdr != Nil);
}
next = Env.Next; Env.Next = 0;
argc = Env.ArgC; Env.ArgC = j;
@@ -1184,9 +2296,9 @@ public class PicoLisp {
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
+ y = bnd.Data[--i];
+ x = y.Car;
+ y.Car = bnd.Data[--i]; // Set new value
bnd.Data[i] = x; // Save old value
} while (i > 0);
Env.Bind = bnd;
@@ -1195,27 +2307,25 @@ public class PicoLisp {
Env.Arg = arg;
}
for (i = bnd.Cnt; (i -= 2) >= 0;)
- ((Symbol)bnd.Data[i+1]).Val = bnd.Data[i];
+ bnd.Data[i+1].Car = bnd.Data[i];
Env.Bind = bnd.Link;
return x;
}
- final public Any apply(Cell ex, boolean cf, Any[] v, int n) {
+ final Any apply(Any 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
+ Any x, y;
+ Bind bnd = new Bind(); bnd.add(At.Car); bnd.add(At);
+ for (x = Car, i = 0; x instanceof Cell; ++i, x = x.Cdr) {
+ 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();
+ y.Car = i >= n? Nil : cf? v[i].Car : v[i];
}
if (x == Nil || x != At) {
if (x != Nil) {
- bnd.add(x.car()); // Save value
+ bnd.add(x.Car); // Save old value
bnd.add(x); // and symbol
- x.set(Nil); // Set to NIL
+ x.Car = Nil; // Set to NIL
}
Env.Bind = bnd;
x = Cdr.prog();
@@ -1226,7 +2336,7 @@ public class PicoLisp {
if (i < n) {
av = new Any[6];
do
- av = append(av, j++, x.car().eval());
+ av = append(av, j++, cf? v[i].Car : v[i]);
while (++i < n);
}
next = Env.Next; Env.Next = 0;
@@ -1239,16 +2349,148 @@ public class PicoLisp {
Env.Arg = arg;
}
for (i = bnd.Cnt; (i -= 2) >= 0;)
- ((Symbol)bnd.Data[i+1]).Val = bnd.Data[i];
+ bnd.Data[i+1].Car = bnd.Data[i];
Env.Bind = bnd.Link;
return x;
}
- final public PicoLispReader open(Any ex) {
- err(ex, this, "Can't open");
- return null;
+ final boolean equal(Any x) {
+ if (!(x instanceof Cell))
+ return false;
+ Any y = this;
+ 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.Cdr instanceof Cell))
+ return x.Cdr.equal(y.Cdr);
+ x = x.Cdr;
+ if (!(y.Cdr instanceof Cell))
+ return false;
+ y = y;
+ }
+ Any a = x;
+ Any b = y;
+ for (;;) {
+ if (!x.Car.equal(y.Car))
+ return false;
+ if (!(x.Cdr instanceof Cell))
+ return x.Cdr.equal(y.Cdr);
+ x = x.Cdr;
+ if (!(y.Cdr instanceof Cell))
+ return false;
+ y = y.Cdr;
+ if (x == a)
+ return y == b;
+ if (y == b)
+ return false;
+ }
}
+ final int compare(Any x) {
+ if (x == this)
+ return 0;
+ if (x == T)
+ return -1;
+ if (!(x instanceof Cell))
+ return +1;
+ Any y = this;
+ Any a = this;
+ Any b = x;
+ for (;;) {
+ int n;
+ if ((n = y.Car.compare(x.Car)) != 0)
+ return n;
+ if (!((y = y.Cdr) instanceof Cell))
+ return y.compare(x.Cdr);
+ if (!((x = x.Cdr) instanceof Cell))
+ return x == T? -1 : +1;
+ if (y == a && x == b)
+ return 0;
+ }
+ }
+
+ final long length() {
+ long n = 1;
+ Any x = this;
+ while (x.Car == Quote) {
+ if (x == x.Cdr)
+ return -1;
+ if (!((x = x.Cdr) instanceof Cell))
+ return n;
+ ++n;
+ }
+ Any y = x;
+ while ((x = x.Cdr) instanceof Cell) {
+ if (x == y)
+ return -1;
+ ++n;
+ }
+ return n;
+ }
+
+ final long size() {return size(this);}
+ final long size(Any x) {
+ long n;
+ Any y;
+
+ n = 1;
+ while (x.Car == Quote) {
+ if (x == x.Cdr || !((x = x.Cdr) instanceof Cell))
+ return n;
+ ++n;
+ }
+ for (y = x;;) {
+ if (x.Car instanceof Cell)
+ n += size(x.Car);
+ if (!((x = x.Cdr) instanceof Cell) || x == y)
+ break;
+ ++n;
+ }
+ return n;
+ }
+
+ final InFrame rdOpen(Any ex) {
+ try {
+ int len = (int)length();
+ String[] cmd = new String[len];
+ Any x = this;
+ for (int i = 0; i < len; ++i) {
+ cmd[i] = x.Car.name();
+ x = x.Cdr;
+ }
+ int pid = allocPid();
+ return new InFrame(new PicoLispReader((Pids[pid] = Runtime.getRuntime().exec(cmd)).getInputStream(), -1), pid);
+ }
+ catch (IOException e) {
+ err(ex, this, "Pipe read open error");
+ return null;
+ }
+ }
+
+ final OutFrame wrOpen(Any ex) {
+ try {
+ int len = (int)length();
+ String[] cmd = new String[len];
+ Any x = this;
+ for (int i = 0; i < len; ++i) {
+ cmd[i] = x.Car.name();
+ x = x.Cdr;
+ }
+ int pid = allocPid();
+ return new OutFrame(new PicoLispWriter((Pids[pid] = Runtime.getRuntime().exec(cmd)).getOutputStream(), -1), pid);
+ }
+ catch (IOException e) {
+ err(ex, this, "Pipe write open error");
+ return null;
+ }
+ }
+
+ final String name() {return Car.name() + Cdr.name();}
+
final public String toString() {
Any x, y;
StringBuilder sb;
@@ -1259,8 +2501,8 @@ public class PicoLisp {
sb.append('(');
if ((y = circ(x)) == null) {
for (;;) {
- sb.append(x.car().toString());
- if ((x = x.cdr()) == Nil)
+ sb.append(x.Car.toString());
+ if ((x = x.Cdr) == Nil)
break;
if (!(x instanceof Cell)) {
sb.append(" . ");
@@ -1272,21 +2514,21 @@ public class PicoLisp {
}
else if (y == x) {
do {
- sb.append(x.car().toString());
+ sb.append(x.Car.toString());
sb.append(' ');
- } while (y != (x = x.cdr()));
+ } while (y != (x = x.Cdr));
sb.append('.');
}
else {
do {
- sb.append(x.car().toString());
+ sb.append(x.Car.toString());
sb.append(' ');
- } while (y != (x = x.cdr()));
+ } while (y != (x = x.Cdr));
sb.append(". (");
do {
- sb.append(x.car().toString());
+ sb.append(x.Car.toString());
sb.append(' ');
- } while (y != (x = x.cdr()));
+ } while (y != (x = x.Cdr));
sb.append(".)");
}
sb.append(')');
diff --git a/lib/tags b/lib/tags
@@ -1,5 +1,5 @@
-! (2851 . "@src64/flow.l")
-$ (2953 . "@src64/flow.l")
+! (2841 . "@src64/flow.l")
+$ (2943 . "@src64/flow.l")
% (2570 . "@src64/big.l")
& (2791 . "@src64/big.l")
* (2389 . "@src64/big.l")
@@ -28,25 +28,25 @@ accept (139 . "@src64/net.l")
adr (613 . "@src64/main.l")
alarm (487 . "@src64/main.l")
all (772 . "@src64/sym.l")
-and (1625 . "@src64/flow.l")
+and (1621 . "@src64/flow.l")
any (3869 . "@src64/io.l")
append (1329 . "@src64/subr.l")
-apply (597 . "@src64/apply.l")
+apply (591 . "@src64/apply.l")
arg (2243 . "@src64/main.l")
args (2219 . "@src64/main.l")
argv (2864 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (2942 . "@src64/subr.l")
assoc (2907 . "@src64/subr.l")
-at (2110 . "@src64/flow.l")
+at (2106 . "@src64/flow.l")
atom (2372 . "@src64/subr.l")
-bind (1363 . "@src64/flow.l")
+bind (1359 . "@src64/flow.l")
bit? (2732 . "@src64/big.l")
-bool (1725 . "@src64/flow.l")
-box (823 . "@src64/flow.l")
+bool (1721 . "@src64/flow.l")
+box (822 . "@src64/flow.l")
box? (999 . "@src64/sym.l")
-by (1553 . "@src64/apply.l")
-bye (3432 . "@src64/flow.l")
+by (1547 . "@src64/apply.l")
+bye (3422 . "@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 (3084 . "@src64/flow.l")
+call (3074 . "@src64/flow.l")
car (5 . "@src64/subr.l")
-case (1966 . "@src64/flow.l")
-catch (2466 . "@src64/flow.l")
+case (1962 . "@src64/flow.l")
+catch (2462 . "@src64/flow.l")
cd (2619 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
@@ -88,12 +88,12 @@ circ (816 . "@src64/subr.l")
clip (1786 . "@src64/subr.l")
close (4257 . "@src64/io.l")
cmd (2846 . "@src64/main.l")
-cnt (1297 . "@src64/apply.l")
-co (2548 . "@src64/flow.l")
+cnt (1291 . "@src64/apply.l")
+co (2544 . "@src64/flow.l")
commit (1496 . "@src64/db.l")
con (725 . "@src64/subr.l")
conc (781 . "@src64/subr.l")
-cond (1920 . "@src64/flow.l")
+cond (1916 . "@src64/flow.l")
connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
@@ -112,8 +112,8 @@ delq (1443 . "@src64/subr.l")
diff (2563 . "@src64/subr.l")
dir (2777 . "@src64/main.l")
dm (543 . "@src64/flow.l")
-do (2140 . "@src64/flow.l")
-e (2914 . "@src64/flow.l")
+do (2136 . "@src64/flow.l")
+e (2904 . "@src64/flow.l")
echo (4288 . "@src64/io.l")
env (625 . "@src64/main.l")
eof (3428 . "@src64/io.l")
@@ -123,28 +123,28 @@ eval (182 . "@src64/flow.l")
ext (5017 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
extern (900 . "@src64/sym.l")
-extra (1266 . "@src64/flow.l")
-extract (1102 . "@src64/apply.l")
+extra (1263 . "@src64/flow.l")
+extract (1096 . "@src64/apply.l")
fifo (1963 . "@src64/sym.l")
file (2724 . "@src64/main.l")
fill (3177 . "@src64/subr.l")
-filter (1045 . "@src64/apply.l")
+filter (1039 . "@src64/apply.l")
fin (2020 . "@src64/subr.l")
-finally (2524 . "@src64/flow.l")
-find (1206 . "@src64/apply.l")
-fish (1497 . "@src64/apply.l")
+finally (2520 . "@src64/flow.l")
+find (1200 . "@src64/apply.l")
+fish (1491 . "@src64/apply.l")
flg? (2419 . "@src64/subr.l")
flip (1686 . "@src64/subr.l")
flush (4992 . "@src64/io.l")
fold (3343 . "@src64/sym.l")
-for (2229 . "@src64/flow.l")
-fork (3258 . "@src64/flow.l")
+for (2225 . "@src64/flow.l")
+fork (3248 . "@src64/flow.l")
format (2089 . "@src64/big.l")
free (2047 . "@src64/db.l")
from (3447 . "@src64/io.l")
full (1066 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
-gc (439 . "@src64/gc.l")
+gc (429 . "@src64/gc.l")
ge0 (2691 . "@src64/big.l")
get (2750 . "@src64/sym.l")
getd (742 . "@src64/sym.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 (1806 . "@src64/flow.l")
-if2 (1825 . "@src64/flow.l")
-ifn (1866 . "@src64/flow.l")
+if (1802 . "@src64/flow.l")
+if2 (1821 . "@src64/flow.l")
+ifn (1862 . "@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 (3203 . "@src64/flow.l")
-isa (960 . "@src64/flow.l")
-job (1430 . "@src64/flow.l")
+ipid (3193 . "@src64/flow.l")
+isa (959 . "@src64/flow.l")
+job (1426 . "@src64/flow.l")
journal (970 . "@src64/db.l")
key (3278 . "@src64/io.l")
-kill (3235 . "@src64/flow.l")
+kill (3225 . "@src64/flow.l")
last (2031 . "@src64/subr.l")
length (2687 . "@src64/subr.l")
-let (1480 . "@src64/flow.l")
-let? (1541 . "@src64/flow.l")
+let (1476 . "@src64/flow.l")
+let? (1537 . "@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 (2172 . "@src64/flow.l")
+loop (2168 . "@src64/flow.l")
low? (3215 . "@src64/sym.l")
lowc (3245 . "@src64/sym.l")
lst? (2389 . "@src64/subr.l")
@@ -193,39 +193,39 @@ lt0 (2680 . "@src64/big.l")
lup (2226 . "@src64/sym.l")
made (1098 . "@src64/subr.l")
make (1079 . "@src64/subr.l")
-map (733 . "@src64/apply.l")
-mapc (775 . "@src64/apply.l")
-mapcan (985 . "@src64/apply.l")
-mapcar (871 . "@src64/apply.l")
-mapcon (925 . "@src64/apply.l")
-maplist (817 . "@src64/apply.l")
-maps (674 . "@src64/apply.l")
+map (727 . "@src64/apply.l")
+mapc (769 . "@src64/apply.l")
+mapcan (979 . "@src64/apply.l")
+mapcar (865 . "@src64/apply.l")
+mapcon (919 . "@src64/apply.l")
+maplist (811 . "@src64/apply.l")
+maps (668 . "@src64/apply.l")
mark (1965 . "@src64/db.l")
match (3062 . "@src64/subr.l")
max (2314 . "@src64/subr.l")
-maxi (1395 . "@src64/apply.l")
+maxi (1389 . "@src64/apply.l")
member (2429 . "@src64/subr.l")
memq (2451 . "@src64/subr.l")
meta (3135 . "@src64/sym.l")
-meth (1088 . "@src64/flow.l")
-method (1052 . "@src64/flow.l")
+meth (1087 . "@src64/flow.l")
+method (1051 . "@src64/flow.l")
min (2343 . "@src64/subr.l")
-mini (1446 . "@src64/apply.l")
+mini (1440 . "@src64/apply.l")
mix (1251 . "@src64/subr.l")
mmeq (2479 . "@src64/subr.l")
n0 (2176 . "@src64/subr.l")
n== (2074 . "@src64/subr.l")
nT (2185 . "@src64/subr.l")
name (499 . "@src64/sym.l")
-nand (1660 . "@src64/flow.l")
+nand (1656 . "@src64/flow.l")
native (1366 . "@src64/main.l")
need (918 . "@src64/subr.l")
-new (834 . "@src64/flow.l")
+new (833 . "@src64/flow.l")
next (2226 . "@src64/main.l")
-nil (1743 . "@src64/flow.l")
-nond (1943 . "@src64/flow.l")
-nor (1681 . "@src64/flow.l")
-not (1733 . "@src64/flow.l")
+nil (1739 . "@src64/flow.l")
+nond (1939 . "@src64/flow.l")
+nor (1677 . "@src64/flow.l")
+not (1729 . "@src64/flow.l")
nth (685 . "@src64/subr.l")
num? (2400 . "@src64/subr.l")
off (1598 . "@src64/sym.l")
@@ -234,17 +234,17 @@ on (1583 . "@src64/sym.l")
onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
open (4219 . "@src64/io.l")
-opid (3219 . "@src64/flow.l")
+opid (3209 . "@src64/flow.l")
opt (2967 . "@src64/main.l")
-or (1641 . "@src64/flow.l")
+or (1637 . "@src64/flow.l")
out (4113 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
pair (2381 . "@src64/subr.l")
-pass (638 . "@src64/apply.l")
+pass (632 . "@src64/apply.l")
pat? (720 . "@src64/sym.l")
path (1229 . "@src64/io.l")
peek (3335 . "@src64/io.l")
-pick (1253 . "@src64/apply.l")
+pick (1247 . "@src64/apply.l")
pipe (4134 . "@src64/io.l")
poll (3222 . "@src64/io.l")
pool (648 . "@src64/db.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 (1761 . "@src64/flow.l")
-prog1 (1769 . "@src64/flow.l")
-prog2 (1786 . "@src64/flow.l")
+prog (1757 . "@src64/flow.l")
+prog1 (1765 . "@src64/flow.l")
+prog2 (1782 . "@src64/flow.l")
prop (2781 . "@src64/sym.l")
protect (532 . "@src64/main.l")
prove (3434 . "@src64/subr.l")
@@ -287,8 +287,8 @@ rpc (5133 . "@src64/io.l")
run (313 . "@src64/flow.l")
sect (2515 . "@src64/subr.l")
seed (2944 . "@src64/big.l")
-seek (1159 . "@src64/apply.l")
-send (1132 . "@src64/flow.l")
+seek (1153 . "@src64/apply.l")
+send (1131 . "@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 (2010 . "@src64/flow.l")
+state (2006 . "@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 (1219 . "@src64/flow.l")
+sum (1338 . "@src64/apply.l")
+super (1218 . "@src64/flow.l")
sym (3909 . "@src64/io.l")
sym? (2408 . "@src64/subr.l")
sync (3090 . "@src64/io.l")
-sys (3055 . "@src64/flow.l")
-t (1752 . "@src64/flow.l")
+sys (3045 . "@src64/flow.l")
+t (1748 . "@src64/flow.l")
tail (1898 . "@src64/subr.l")
tell (3162 . "@src64/io.l")
text (1272 . "@src64/sym.l")
-throw (2492 . "@src64/flow.l")
-tick (3171 . "@src64/flow.l")
+throw (2488 . "@src64/flow.l")
+tick (3161 . "@src64/flow.l")
till (3514 . "@src64/io.l")
time (2491 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
-try (1173 . "@src64/flow.l")
-type (913 . "@src64/flow.l")
+try (1172 . "@src64/flow.l")
+type (912 . "@src64/flow.l")
udp (268 . "@src64/net.l")
unify (3842 . "@src64/subr.l")
-unless (1902 . "@src64/flow.l")
-until (2086 . "@src64/flow.l")
+unless (1898 . "@src64/flow.l")
+until (2082 . "@src64/flow.l")
up (712 . "@src64/main.l")
upp? (3230 . "@src64/sym.l")
uppc (3294 . "@src64/sym.l")
-use (1574 . "@src64/flow.l")
+use (1570 . "@src64/flow.l")
usec (2596 . "@src64/main.l")
val (1463 . "@src64/sym.l")
version (2981 . "@src64/main.l")
wait (3052 . "@src64/io.l")
-when (1885 . "@src64/flow.l")
-while (2062 . "@src64/flow.l")
+when (1881 . "@src64/flow.l")
+while (2058 . "@src64/flow.l")
wipe (3090 . "@src64/sym.l")
-with (1331 . "@src64/flow.l")
+with (1327 . "@src64/flow.l")
wr (5117 . "@src64/io.l")
xchg (1538 . "@src64/sym.l")
-xor (1702 . "@src64/flow.l")
+xor (1698 . "@src64/flow.l")
x| (2871 . "@src64/big.l")
-yield (2706 . "@src64/flow.l")
+yield (2699 . "@src64/flow.l")
yoke (1187 . "@src64/subr.l")
zap (1063 . "@src64/sym.l")
zero (1631 . "@src64/sym.l")
diff --git a/src/apply.c b/src/apply.c
@@ -1,4 +1,4 @@
-/* 05oct10abu
+/* 12oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -54,19 +54,17 @@ any apply(any ex, any foo, bool cf, int n, cell *p) {
o = cf? car(data(p[0])) : data(p[0]);
NeedSym(ex,o);
Fetch(ex,o);
- TheKey = foo, TheCls = Nil;
+ TheCls = NULL, TheKey = foo;
if (expr = method(o)) {
int i;
- methFrame m;
+ any cls = Env.cls, key = Env.key;
struct { // bindFrame
struct bindFrame *link;
int i, cnt;
struct {any sym; any val;} bnd[length(x = car(expr))+3];
} f;
- m.link = Env.meth;
- m.key = TheKey;
- m.cls = TheCls;
+ Env.cls = TheCls, Env.key = TheKey;
f.link = Env.bind, Env.bind = (bindFrame*)&f;
f.i = 0;
f.cnt = 1, f.bnd[0].sym = At, f.bnd[0].val = val(At);
@@ -80,7 +78,6 @@ any apply(any ex, any foo, bool cf, int n, cell *p) {
f.bnd[f.cnt].sym = This;
f.bnd[f.cnt++].val = val(This);
val(This) = o;
- Env.meth = &m;
x = prog(cdr(expr));
}
else if (x != At) {
@@ -88,7 +85,6 @@ any apply(any ex, any foo, bool cf, int n, cell *p) {
f.bnd[f.cnt].sym = This;
f.bnd[f.cnt++].val = val(This);
val(This) = o;
- Env.meth = &m;
x = prog(cdr(expr));
}
else {
@@ -103,7 +99,6 @@ any apply(any ex, any foo, bool cf, int n, cell *p) {
f.bnd[f.cnt].sym = This;
f.bnd[f.cnt++].val = val(This);
val(This) = o;
- Env.meth = &m;
x = prog(cdr(expr));
if (cnt)
drop(c[cnt-1]);
@@ -112,7 +107,7 @@ any apply(any ex, any foo, bool cf, int n, cell *p) {
while (--f.cnt >= 0)
val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
Env.bind = f.link;
- Env.meth = Env.meth->link;
+ Env.cls = cls, Env.key = key;
return x;
}
err(ex, o, "Bad object");
diff --git a/src/flow.c b/src/flow.c
@@ -1,4 +1,4 @@
-/* 30sep10abu
+/* 19oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -290,16 +290,13 @@ any doDm(any ex) {
/* Evaluate method invocation */
static any evMethod(any o, any expr, any x) {
any y = car(expr);
- methFrame m;
+ any cls = TheCls, key = TheKey;
struct { // bindFrame
struct bindFrame *link;
int i, cnt;
struct {any sym; any val;} bnd[length(y)+3];
} f;
- m.link = Env.meth;
- m.key = TheKey;
- m.cls = TheCls;
f.link = Env.bind, Env.bind = (bindFrame*)&f;
f.i = sizeof(f.bnd) / (2*sizeof(any)) - 2;
f.cnt = 1, f.bnd[0].sym = At, f.bnd[0].val = val(At);
@@ -315,7 +312,8 @@ static any evMethod(any o, any expr, any x) {
f.bnd[f.i].val = x;
}
f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o;
- Env.meth = &m;
+ y = cls, cls = Env.cls; Env.cls = y;
+ y = key, key = Env.key; Env.key = y;
x = prog(cdr(expr));
}
else if (y != At) {
@@ -326,7 +324,8 @@ static any evMethod(any o, any expr, any x) {
f.bnd[f.i].val = x;
}
f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o;
- Env.meth = &m;
+ y = cls, cls = Env.cls; Env.cls = y;
+ y = key, key = Env.key; Env.key = y;
x = prog(cdr(expr));
}
else {
@@ -344,7 +343,8 @@ static any evMethod(any o, any expr, any x) {
n = Env.next, Env.next = cnt;
arg = Env.arg, Env.arg = c;
f.bnd[f.cnt].sym = This, f.bnd[f.cnt++].val = val(This), val(This) = o;
- Env.meth = &m;
+ y = cls, cls = Env.cls; Env.cls = y;
+ y = key, key = Env.key; Env.key = y;
x = prog(cdr(expr));
if (cnt)
drop(c[cnt-1]);
@@ -353,7 +353,7 @@ static any evMethod(any o, any expr, any x) {
while (--f.cnt >= 0)
val(f.bnd[f.cnt].sym) = f.bnd[f.cnt].val;
Env.bind = f.link;
- Env.meth = Env.meth->link;
+ Env.cls = cls, Env.key = key;
return x;
}
@@ -388,7 +388,7 @@ any doNew(any ex) {
x = cdr(ex);
if (isCell(y = EVAL(car(x))))
- Push(c1, consSym(Nil,Nil));
+ Push(c1, consSym(y,Nil));
else {
if (isNil(y))
data(c1) = consSym(Nil,Nil);
@@ -401,10 +401,9 @@ any doNew(any ex) {
mkExt(data(c1));
}
Save(c1);
- x = cdr(x), y = EVAL(car(x));
+ x = cdr(x), val(data(c1)) = EVAL(car(x));
}
- val(data(c1)) = y;
- TheKey = T, TheCls = Nil;
+ TheKey = T, TheCls = NULL;
if (y = method(data(c1)))
evMethod(data(c1), y, cdr(x));
else {
@@ -514,7 +513,7 @@ any doMeth(any ex) {
if (!isSym(TheKey))
err(ex, TheKey, "Bad message");
if (isNum(val(TheKey))) {
- TheCls = Nil;
+ TheCls = NULL;
if (y = method(data(c1))) {
x = evMethod(data(c1), y, cdr(x));
drop(c1);
@@ -535,7 +534,7 @@ any doSend(any ex) {
x = cdr(x), Push(c2, EVAL(car(x)));
NeedSym(ex,data(c2));
Fetch(ex,data(c2));
- TheKey = data(c1), TheCls = Nil;
+ TheKey = data(c1), TheCls = NULL;
if (y = method(data(c2))) {
x = evMethod(data(c2), y, cdr(x));
drop(c1);
@@ -558,7 +557,7 @@ any doTry(any ex) {
return Nil;
db(ex,data(c2),1);
}
- TheKey = data(c1), TheCls = Nil;
+ TheKey = data(c1), TheCls = NULL;
if (y = method(data(c2))) {
x = evMethod(data(c2), y, cdr(x));
drop(c1);
@@ -571,19 +570,18 @@ any doTry(any ex) {
// (super ['any ..]) -> any
any doSuper(any ex) {
- any x, y;
- methFrame m;
+ any x, y, cls, key;
- m.key = TheKey = Env.meth->key;
- x = val(isNil(Env.meth->cls)? val(This) : car(Env.meth->cls));
+ TheKey = Env.key;
+ x = val(Env.cls? car(Env.cls) : val(This));
while (isCell(car(x)))
x = cdr(x);
while (isCell(x)) {
if (y = method(car(TheCls = x))) {
- m.cls = TheCls;
- m.link = Env.meth, Env.meth = &m;
+ cls = Env.cls, Env.cls = TheCls;
+ key = Env.key, Env.key = TheKey;
x = evExpr(y, cdr(ex));
- Env.meth = Env.meth->link;
+ Env.key = key, Env.cls = cls;
return x;
}
x = cdr(x);
@@ -596,7 +594,7 @@ static any extra(any x) {
for (x = val(x); isCell(car(x)); x = cdr(x));
while (isCell(x)) {
- if (x == Env.meth->cls || !(y = extra(car(x)))) {
+ if (x == Env.cls || !(y = extra(car(x)))) {
while (isCell(x = cdr(x)))
if (y = method(car(TheCls = x)))
return y;
@@ -611,15 +609,14 @@ static any extra(any x) {
// (extra ['any ..]) -> any
any doExtra(any ex) {
- any x, y;
- methFrame m;
+ any x, y, cls, key;
- m.key = TheKey = Env.meth->key;
+ TheKey = Env.key;
if ((y = extra(val(This))) && num(y) != 1) {
- m.cls = TheCls;
- m.link = Env.meth, Env.meth = &m;
+ cls = Env.cls, Env.cls = TheCls;
+ key = Env.key, Env.key = TheKey;
x = evExpr(y, cdr(ex));
- Env.meth = Env.meth->link;
+ Env.key = key, Env.cls = cls;
return x;
}
err(ex, TheKey, "Bad extra");
@@ -692,7 +689,6 @@ any doBind(any ex) {
any doJob(any ex) {
any x = cdr(ex);
any y = EVAL(car(x));
- any z;
cell c1;
struct { // bindFrame
struct bindFrame *link;
@@ -709,13 +705,13 @@ any doJob(any ex) {
val(caar(y)) = cdar(y);
++f.cnt, y = cdr(y);
}
- z = prog(cdr(x));
+ x = prog(cdr(x));
for (f.cnt = 0, y = Pop(c1); isCell(y); ++f.cnt, y = cdr(y)) {
cdar(y) = val(caar(y));
val(caar(y)) = f.bnd[f.cnt].val;
}
Env.bind = f.link;
- return z;
+ return x;
}
// (let sym 'any . prg) -> any
@@ -812,8 +808,7 @@ any doAnd(any x) {
if (isNil(a = EVAL(car(x))))
return Nil;
val(At) = a;
- }
- while (isCell(x = cdr(x)));
+ } while (isCell(x = cdr(x)));
return a;
}
@@ -838,8 +833,7 @@ any doNand(any x) {
if (isNil(a = EVAL(car(x))))
return T;
val(At) = a;
- }
- while (isCell(x = cdr(x)));
+ } while (isCell(x = cdr(x)));
return Nil;
}
@@ -848,12 +842,12 @@ any doNor(any x) {
any a;
x = cdr(x);
- do {
+ do
if (!isNil(a = EVAL(car(x)))) {
val(At) = a;
return Nil;
}
- } while (isCell(x = cdr(x)));
+ while (isCell(x = cdr(x)));
return T;
}
diff --git a/src/gc.c b/src/gc.c
@@ -1,4 +1,4 @@
-/* 19may10abu
+/* 12oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -48,8 +48,6 @@ static void gc(long c) {
mark(((catchFrame*)p)->tag);
mark(((catchFrame*)p)->fin);
}
- for (p = (any)Env.meth; p; p = (any)((methFrame*)p)->link)
- mark(((methFrame*)p)->key), mark(((methFrame*)p)->cls);
for (i = 0; i < EHASH; ++i)
for (p = Extern[i]; isCell(p); p = (any)(num(p->cdr) & ~1))
if (num(val(p->car)) & 1) {
diff --git a/src/io.c b/src/io.c
@@ -1,4 +1,4 @@
-/* 07oct10abu
+/* 14oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -1237,7 +1237,7 @@ any token(any x, int c) {
while (Env.get(), Chr != '"' && testEsc())
byteSym(Chr, &i, &y);
Env.get();
- return consStr(y = Pop(c1));
+ return consStr(Pop(c1));
}
if (Chr >= '0' && Chr <= '9') {
i = 0, Push(c1, y = box(Chr));
diff --git a/src/main.c b/src/main.c
@@ -1,4 +1,4 @@
-/* 07oct10abu
+/* 12oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -523,7 +523,6 @@ void err(any ex, any x, char *fmt, ...) {
}
unwind(NULL);
Env.stack = NULL;
- Env.meth = NULL;
Env.protect = Env.trace = 0;
Env.next = -1;
Env.task = Nil;
@@ -567,7 +566,7 @@ void unwind(catchFrame *catch) {
while (q = CatchPtr) {
while (p = Env.bind) {
- if ((i = Env.bind->i) < 0) {
+ if ((i = p->i) < 0) {
j = i, n = 0;
while (++n, ++j && (p = p->link))
if (p->i >= 0 || p->i < i)
diff --git a/src/pico.h b/src/pico.h
@@ -1,4 +1,4 @@
-/* 03oct10abu
+/* 15oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -75,11 +75,6 @@ typedef struct bindFrame {
struct {any sym; any val;} bnd[1];
} bindFrame;
-typedef struct methFrame {
- struct methFrame *link;
- any key, cls;
-} methFrame;
-
typedef struct inFile {
int fd, ix, cnt, next;
int line, src;
@@ -120,9 +115,8 @@ typedef struct parseFrame {
typedef struct stkEnv {
cell *stack, *arg;
bindFrame *bind;
- methFrame *meth;
int next, protect, trace;
- any task, *make, *yoke;
+ any cls, key, task, *make, *yoke;
inFrame *inFrames;
outFrame *outFrames;
ctlFrame *ctlFrames;
diff --git a/src/subr.c b/src/subr.c
@@ -1,4 +1,4 @@
-/* 07nov09abu
+/* 22oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -535,11 +535,8 @@ any doAppend(any x) {
while (isCell(y = cdr(z)))
z = cdr(z) = cons(car(y), cdr(y));
while (isCell(cdr(x = cdr(x)))) {
- y = EVAL(car(x));
- while (isCell(y)) {
+ for (y = EVAL(car(x)); isCell(y); y = cdr(z))
z = cdr(z) = cons(car(y), cdr(y));
- y = cdr(z);
- }
cdr(z) = y;
}
cdr(z) = EVAL(car(x));
@@ -620,22 +617,18 @@ any doReplace(any x) {
Save(c1);
for (i = 0; i < n; ++i)
x = cdr(x), Push(c[i], EVAL(car(x)));
- for (i = 0; i < n; i += 2)
- if (equal(car(data(c1)), data(c[i]))) {
+ for (x = car(data(c1)), i = 0; i < n; i += 2)
+ if (equal(x, data(c[i]))) {
x = data(c[i+1]);
- goto rpl1;
+ break;
}
- x = car(data(c1));
-rpl1:
Push(c2, y = cons(x,Nil));
while (isCell(data(c1) = cdr(data(c1)))) {
- for (i = 0; i < n; i += 2)
- if (equal(car(data(c1)), data(c[i]))) {
+ for (x = car(data(c1)), i = 0; i < n; i += 2)
+ if (equal(x, data(c[i]))) {
x = data(c[i+1]);
- goto rpl2;
+ break;
}
- x = car(data(c1));
- rpl2:
y = cdr(y) = cons(x, Nil);
}
cdr(y) = data(c1);
@@ -1025,11 +1018,9 @@ any doMax(any x) {
cell c1;
x = cdr(x), Push(c1, EVAL(car(x)));
- while (isCell(x = cdr(x))) {
- y = EVAL(car(x));
- if (compare(y, data(c1)) > 0)
+ while (isCell(x = cdr(x)))
+ if (compare(y = EVAL(car(x)), data(c1)) > 0)
data(c1) = y;
- }
return Pop(c1);
}
@@ -1039,11 +1030,9 @@ any doMin(any x) {
cell c1;
x = cdr(x), Push(c1, EVAL(car(x)));
- while (isCell(x = cdr(x))) {
- y = EVAL(car(x));
- if (compare(y, data(c1)) < 0)
+ while (isCell(x = cdr(x)))
+ if (compare(y = EVAL(car(x)), data(c1)) < 0)
data(c1) = y;
- }
return Pop(c1);
}
@@ -1159,9 +1148,7 @@ any doIndex(any x) {
x = cdr(x), Push(c1, EVAL(car(x)));
x = cdr(x), x = EVAL(car(x));
- if (n = indx(Pop(c1), x))
- return boxCnt(n);
- return Nil;
+ return (n = indx(Pop(c1), x))? boxCnt(n) : Nil;
}
// (offset 'lst1 'lst2) -> cnt | NIL
@@ -1298,11 +1285,9 @@ any doRank(any x) {
x = cdr(x), Push(c2, y = EVAL(car(x)));
x = cdr(x), x = EVAL(car(x));
Rank = Pop(c1);
- if (!isCell(y))
- return Nil;
- if (isNil(x))
- return rank1(y, length(y)) ?: Nil;
- return rank2(y, length(y)) ?: Nil;
+ if (isCell(y))
+ return (isNil(x)? rank1(y, length(y)) : rank2(y, length(y))) ?: Nil;
+ return Nil;
}
/* Pattern matching */
@@ -1338,7 +1323,7 @@ bool match(any p, any d) {
return YES;
}
}
- if (!isCell(d) || !(match(x, car(d))))
+ if (!isCell(d) || !match(x, car(d)))
return NO;
p = cdr(p);
d = cdr(d);
@@ -1364,9 +1349,7 @@ static any fill(any x, any s) {
if (isNum(x))
return NULL;
if (isSym(x))
- return
- (isNil(s)? x!=At && firstByte(x)=='@' : memq(x,s)!=NULL)?
- val(x) : NULL;
+ return (isNil(s)? x!=At && firstByte(x)=='@' : memq(x,s)!=NULL)? val(x) : NULL;
if (y = fill(car(x),s)) {
Push(c1,y);
y = fill(cdr(x),s);
diff --git a/src/sym.c b/src/sym.c
@@ -1,4 +1,4 @@
-/* 24jun09abu
+/* 25oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -784,8 +784,10 @@ any doFifo(any ex) {
y = EVAL(car(x));
if (isCell(z = val(data(c1))))
val(data(c1)) = z = cdr(z) = cons(y,cdr(z));
- else
- cdr(z) = z = val(data(c1)) = cons(y,Nil);
+ else {
+ z = val(data(c1)) = cons(y,Nil);
+ cdr(z) = z;
+ }
while (isCell(x = cdr(x)))
val(data(c1)) = z = cdr(z) = cons(y = EVAL(car(x)), cdr(z));
}
diff --git a/src64/apply.l b/src64/apply.l
@@ -1,4 +1,4 @@
-# 10jun10abu
+# 12oct10abu
# (c) Software Lab. Alexander Burger
(code 'applyXYZ_E 0)
@@ -165,13 +165,13 @@
push Z # Save arg pointers
push Y
ld Y C # 'msg'
- ld Z Nil # No classes
+ ld Z 0 # No classes
call methodEY_FCYZ # Found?
jne msgErrYX # No
- xchg Z (S I) # 'cls'
- xchg Y (S) # 'key'
- push (EnvMeth) # Method frame
- ld (EnvMeth) S
+ ld (S I) (EnvCls) # 'cls'
+ ld (S) (EnvKey) # 'key'
+ ld (EnvCls) Z # Set new
+ ld (EnvKey) Y # 'key'
ld X (C) # Parameter list in X
push (EnvBind) # Build bind frame
link
@@ -211,9 +211,8 @@
until eq # No
pop L # Restore link
pop (EnvBind) # Restore bind link
- pop (EnvMeth) # and method link
- pop A # Drop frame
- pop A
+ pop (EnvKey) # 'key'
+ pop (EnvCls) # and 'cls'
pop X
ret
end
@@ -237,9 +236,8 @@
until eq # No
pop L # Restore link
pop (EnvBind) # Restore bind link
- pop (EnvMeth) # and method link
- pop A # Drop frame
- pop A
+ pop (EnvKey) # 'key'
+ pop (EnvCls) # and 'cls'
pop X
ret
end
@@ -283,9 +281,8 @@
until eq # No
pop L # Restore link
pop (EnvBind) # Restore bind link
- pop (EnvMeth) # and method link
- pop A # Drop frame
- pop A
+ pop (EnvKey) # 'key'
+ pop (EnvCls) # and 'cls'
pop X
ret
end
@@ -464,10 +461,10 @@
ld Z Nil # No classes
call methodEY_FCYZ # Found?
jne msgErrYX # No
- xchg Z (S I) # 'cls'
- xchg Y (S) # 'key'
- push (EnvMeth) # Method frame
- ld (EnvMeth) S
+ ld (S I) (EnvCls) # 'cls'
+ ld (S) (EnvKey) # 'key'
+ ld (EnvCls) Z # Set new
+ ld (EnvKey) Y # 'key'
ld X (C) # Parameter list in X
push (EnvBind) # Build bind frame
link
@@ -507,9 +504,8 @@
until eq # No
pop L # Restore link
pop (EnvBind) # Restore bind link
- pop (EnvMeth) # and method link
- pop A # Drop frame
- pop A
+ pop (EnvKey) # 'key'
+ pop (EnvCls) # and 'cls'
pop X
ret
end
@@ -533,9 +529,8 @@
until eq # No
pop L # Restore link
pop (EnvBind) # Restore bind link
- pop (EnvMeth) # and method link
- pop A # Drop frame
- pop A
+ pop (EnvKey) # 'key'
+ pop (EnvCls) # and 'cls'
pop X
ret
end
@@ -579,9 +574,8 @@
until eq # No
pop L # Restore link
pop (EnvBind) # Restore bind link
- pop (EnvMeth) # and method link
- pop A # Drop frame
- pop A
+ pop (EnvKey) # 'key'
+ pop (EnvCls) # and 'cls'
pop X
ret
end
diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l
@@ -1,4 +1,4 @@
-# 30aug10abu
+# 12oct10abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -179,6 +179,10 @@
(prinst Cmd "%al" (byteVal Dst)) )
((or (pre? "%" Dst) (pre? "%" Dst2))
(prinst Cmd Dst2 Dst) )
+ ((sub? "%r10" Dst2)
+ (prinst "mov" Dst "%r11")
+ (prinst Cmd "%r11" Dst2)
+ (prinst "mov" "%r11" Dst) )
(T
(prinst "mov" Dst "%r10")
(prinst Cmd "%r10" Dst2)
diff --git a/src64/err.l b/src64/err.l
@@ -1,4 +1,4 @@
-# 11jun10abu
+# 12oct10abu
# (c) Software Lab. Alexander Burger
# Debug print routine
@@ -154,7 +154,6 @@
ld (EnvTask) Nil
ld (EnvArgs) 0
ld (EnvNext) 0
- ld (EnvMeth) 0
ld (EnvMake) 0
ld (EnvYoke) 0
ld (EnvTrace) 0
@@ -191,26 +190,25 @@
ld Z ((Z) I) # Follow link
null Z # Any?
while nz # Yes
- cmp (Z -I) A # Env swap nesting?
+ cmp (Z -I) C # Env swap nesting?
if lt # Yes
dec A # Adjust
end
loop
do
- ld A E # Get 'n'
- ld Z Y # Bindings
+ ld Z Y # Get bindings
+ ld A E # and 'n'
do
dec A # 'n-1' times
while nz
ld Z ((Z) I) # Follow link
loop
- ld A (Z) # End of bindings in A
sub (Z -I) C # Increment 'eswp' by absolute first eswp
- if gt # Overflowed
- ld (Z -I) 0 # Reset
- end
if ge # Last pass
- sub A II
+ if gt # Overflowed
+ ld (Z -I) 0 # Reset
+ end
+ lea A ((Z) -II) # End of bindings in A
do
xchg ((A)) (A I) # Exchange next symbol value with saved value
sub A II
diff --git a/src64/flow.l b/src64/flow.l
@@ -1,4 +1,4 @@
-# 08oct10abu
+# 12oct10abu
# (c) Software Lab. Alexander Burger
(code 'redefMsgEC)
@@ -641,9 +641,8 @@
# Apply METH in C to X, with object A
(code 'evMethodACXYZ_E 0)
- push Z # 'cls'
- push Y # 'key'
- push (EnvMeth) # <(L) II> Method frame
+ push Z # <(L) III> 'cls'
+ push Y # <(L) II> 'key'
ld Y (C) # Parameter list in Y
ld Z (C CDR) # Body in Z
push (EnvBind) # Build bind frame
@@ -679,7 +678,8 @@
link
ld (EnvBind) L # Close bind frame
push 0 # Init env swap
- lea (EnvMeth) ((L) II) # and method frame
+ xchg (EnvCls) ((L) III) # 'cls'
+ xchg (EnvKey) ((L) II) # 'key'
prog Z # Run body
pop A # Drop env swap
pop L # Get link
@@ -690,9 +690,8 @@
until eq # No
pop L # Restore link
pop (EnvBind) # Restore bind link
- pop (EnvMeth) # and method link
- pop A # Drop frame
- pop A
+ pop (EnvKey) # 'key'
+ pop (EnvCls) # and 'cls'
ret
end
# Non-NIL parameter
@@ -714,7 +713,8 @@
link
ld (EnvBind) L # Close bind frame
push 0 # Init env swap
- lea (EnvMeth) ((L) II) # and method frame
+ xchg (EnvCls) ((L) III) # 'cls'
+ xchg (EnvKey) ((L) II) # 'key'
prog Z # Run body
pop A # Drop env swap
pop L # Get link
@@ -725,9 +725,8 @@
until eq # No
pop L # Restore link
pop (EnvBind) # Restore bind link
- pop (EnvMeth) # and method link
- pop A # Drop frame
- pop A
+ pop (EnvKey) # 'key'
+ pop (EnvCls) # and 'cls'
ret
end
# Evaluated argument list
@@ -754,7 +753,8 @@
link # Close varArgs frame
end
ld (EnvBind) Y # Close bind frame
- lea (EnvMeth) ((Y) II) # and method frame
+ xchg (EnvCls) ((L) III) # 'cls'
+ xchg (EnvKey) ((L) II) # 'key'
ld C (Y) # End of bindings in C
add Y I
do
@@ -782,9 +782,8 @@
until eq # No
pop L # Restore link
pop (EnvBind) # Restore bind link
- pop (EnvMeth) # and method link
- pop A # Drop frame
- pop A
+ pop (EnvKey) # 'key'
+ pop (EnvCls) # and 'cls'
ret
(code 'methodEY_FCYZ 0)
@@ -881,7 +880,7 @@
ld X (Y CDR) # Keep args in X
ld E A # Object
ld Y TSym # Search for initial method
- ld Z Nil # No classes
+ ld Z 0 # No classes
call methodEY_FCYZ # Found?
if eq # Yes
ld A (L II) # 'obj'
@@ -1113,7 +1112,7 @@
jz msgErrYX
cnt (Y) # Value numeric?
if nz # Yes
- ld Z Nil # No classes
+ ld Z 0 # No classes
call methodEY_FCYZ # Found?
jne msgErrYX # No
ld A (L I) # Get 'obj'
@@ -1158,7 +1157,7 @@
end
ld X (Y CDR) # Keep args in X
ld Y (L II) # Get 'msg'
- ld Z Nil # No classes
+ ld Z 0 # No classes
call methodEY_FCYZ # Found?
jne msgErrYX # No
ld A (L I) # Get 'obj'
@@ -1201,7 +1200,7 @@
end
ld X (Y CDR) # Keep args in X
ld Y (L II) # Get 'msg'
- ld Z Nil # No classes
+ ld Z 0 # No classes
call methodEY_FCYZ # Found?
if eq # Yes
ld A (L I) # Get 'obj'
@@ -1221,10 +1220,9 @@
push Y
push Z
push E # Save expression
- ld A (EnvMeth) # Method frame
- ld Y (A I) # 'key'
- ld X (A II) # 'cls'
- cmp X Nil # Any?
+ ld X (EnvCls) # 'cls'
+ ld Y (EnvKey) # 'key'
+ null X # Any?
ldnz X (X) # Yes: First class
ldz X (This) # No: 'This'
ld X (X) # Get class definition
@@ -1241,14 +1239,13 @@
call methodEY_FCYZ # Found?
if eq # Yes
pop E # Get expression
- push Z # 'cls'
- push Y # 'key'
- push (EnvMeth) # Build method frame
- ld (EnvMeth) S
+ push (EnvCls) # 'cls'
+ push (EnvKey) # 'key'
+ ld (EnvCls) Z # Set new
+ ld (EnvKey) Y
call evExprCE_E # Evaluate expression
- pop (EnvMeth) # Restore method link
- pop A # Drop frame
- pop A
+ pop (EnvKey)
+ pop (EnvCls)
pop Z
pop Y
pop X
@@ -1268,19 +1265,18 @@
push Y
push Z
push E # Save expression
- ld Y ((EnvMeth) I) # Get 'key'
+ ld Y (EnvKey) # Get 'key'
ld X (This) # Current object
call extraXY_FCYZ # Locate extra method
if eq
pop E # Get expression
- push Z # 'cls'
- push Y # 'key'
- push (EnvMeth) # Build method frame
- ld (EnvMeth) S
+ push (EnvCls) # 'cls'
+ push (EnvKey) # 'key'
+ ld (EnvCls) Z # Set new
+ ld (EnvKey) Y
call evExprCE_E # Evaluate expression
- pop (EnvMeth) # Restore method link
- pop A # Drop frame
- pop A
+ pop (EnvKey)
+ pop (EnvCls)
pop Z
pop Y
pop X
@@ -1302,7 +1298,7 @@
do
atom X # Classes?
while z # Yes
- cmp X ((EnvMeth) II) # Hit current 'cls' list?
+ cmp X (EnvCls) # Hit current 'cls' list?
if eq # Yes
10 do
ld X (X CDR) # Locate method in extra classes
@@ -2608,9 +2604,6 @@
ld X EnvCtlFrames # Pointer to control frames
ld C (Z (pack III "+(EnvCtlFrames-EnvCo)")) # Local control frames
call joinLocalCX # Join locals
- ld X EnvMeth # Pointer to method frames
- ld C (Z (pack III "+(EnvMeth-EnvCo)")) # Local method frames
- call joinLocalCX # Join locals
ld X EnvApply # Local apply stack
do
null (X) # Any?
@@ -2768,9 +2761,6 @@
lea X ((A) I) # Get link
loop
ld (X) 0 # Cut off
- ld X EnvMeth # Pointer to method frames
- ld C (Z (pack III "+(EnvMeth-EnvCo)")) # Local method frames
- call cutLocalCX # Cut off locals
ld X EnvCtlFrames # Pointer to control frames
ld C (Z (pack III "+(EnvCtlFrames-EnvCo)")) # Local control frames
call cutLocalCX # Cut off locals
diff --git a/src64/gc.l b/src64/gc.l
@@ -1,4 +1,4 @@
-# 28jul10abu
+# 12oct10abu
# (c) Software Lab. Alexander Burger
# Mark data
@@ -126,16 +126,6 @@
call markE
ld Y (Y) # Next frame
loop
- ld Y (EnvMeth) # Method frames
- do
- null Y # Any?
- while ne # Yes
- ld E (Y I) # Mark 'key'
- call markE
- ld E (Y II) # Mark 'cls'
- call markE
- ld Y (Y) # Next frame
- loop
ld Y (Stack0) # Search through stack segments
ld C (Stacks) # Segment bitmask
do
diff --git a/src64/glob.l b/src64/glob.l
@@ -1,4 +1,4 @@
-# 30sep10abu
+# 12oct10abu
# (c) Software Lab. Alexander Burger
(data 'Globals 0)
@@ -582,8 +582,9 @@
: EnvCtlFrames word 0 # <VI> Control frames
: EnvArgs word 0 # Varargs frame
: EnvNext word 0 # Next vararg
+: EnvCls word 0 # Method class
+: EnvKey word 0 # Method key
: EnvApply word 0 # Apply frames
-: EnvMeth word 0 # Method frames
: EnvMake word 0 # 'make' env
: EnvYoke word 0
: EnvParseX word 0 # Parser status
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 10oct10abu
+# 01nov10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 4 3)
+(de *Version 3 0 4 4)
# vi:et:ts=3:sw=3
