commit 56da1448c5a39ee7ecbddcc60a8887842f6396ff
parent 049c60a8cf8905e6425a95c2a0cd4d6092023652
Author: Alexander Burger <abu@software-lab.de>
Date: Tue, 1 Mar 2011 13:47:41 +0100
Check for repeating circular lists
Diffstat:
5 files changed, 60 insertions(+), 26 deletions(-)
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/ersatz/sys.src b/ersatz/sys.src
@@ -2635,8 +2635,17 @@ public class PicoLisp {
mark.add(x); x = x.Cdr; y = y.Cdr;
if (mark.contains(x)) {
for (;;) {
- if (a == x)
- return b == y;
+ if (a == x) {
+ if (b != y)
+ return false;
+ for (;;) {
+ a = a.Cdr;
+ if ((b = b.Cdr) == y)
+ return a == x;
+ if (a == x)
+ return true;
+ }
+ }
if (b == y)
return false;
a = a.Cdr; b = b.Cdr;
diff --git a/lib/tags b/lib/tags
@@ -32,9 +32,9 @@ and (1621 . "@src64/flow.l")
any (3879 . "@src64/io.l")
append (1338 . "@src64/subr.l")
apply (713 . "@src64/apply.l")
-arg (2257 . "@src64/main.l")
-args (2233 . "@src64/main.l")
-argv (2878 . "@src64/main.l")
+arg (2270 . "@src64/main.l")
+args (2246 . "@src64/main.l")
+argv (2891 . "@src64/main.l")
as (146 . "@src64/flow.l")
asoq (3001 . "@src64/subr.l")
assoc (2966 . "@src64/subr.l")
@@ -65,7 +65,7 @@ call (3090 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1962 . "@src64/flow.l")
catch (2464 . "@src64/flow.l")
-cd (2633 . "@src64/main.l")
+cd (2646 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
cdaar (179 . "@src64/subr.l")
@@ -88,7 +88,7 @@ circ (816 . "@src64/subr.l")
circ? (2398 . "@src64/subr.l")
clip (1795 . "@src64/subr.l")
close (4267 . "@src64/io.l")
-cmd (2860 . "@src64/main.l")
+cmd (2873 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
co (2546 . "@src64/flow.l")
commit (1496 . "@src64/db.l")
@@ -99,9 +99,9 @@ connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1225 . "@src64/subr.l")
ctl (4207 . "@src64/io.l")
-ctty (2658 . "@src64/main.l")
+ctty (2671 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
-date (2372 . "@src64/main.l")
+date (2385 . "@src64/main.l")
dbck (2105 . "@src64/db.l")
de (531 . "@src64/flow.l")
dec (2323 . "@src64/big.l")
@@ -111,7 +111,7 @@ del (1852 . "@src64/sym.l")
delete (1401 . "@src64/subr.l")
delq (1452 . "@src64/subr.l")
diff (2585 . "@src64/subr.l")
-dir (2791 . "@src64/main.l")
+dir (2804 . "@src64/main.l")
dm (543 . "@src64/flow.l")
do (2138 . "@src64/flow.l")
e (2920 . "@src64/flow.l")
@@ -119,7 +119,7 @@ echo (4298 . "@src64/io.l")
env (615 . "@src64/main.l")
eof (3438 . "@src64/io.l")
eol (3429 . "@src64/io.l")
-errno (1368 . "@src64/main.l")
+errno (1381 . "@src64/main.l")
eval (182 . "@src64/flow.l")
ext (5028 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
@@ -127,7 +127,7 @@ extern (900 . "@src64/sym.l")
extra (1263 . "@src64/flow.l")
extract (1218 . "@src64/apply.l")
fifo (1963 . "@src64/sym.l")
-file (2738 . "@src64/main.l")
+file (2751 . "@src64/main.l")
fill (3236 . "@src64/subr.l")
filter (1161 . "@src64/apply.l")
fin (2029 . "@src64/subr.l")
@@ -164,7 +164,7 @@ ifn (1862 . "@src64/flow.l")
in (4103 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2633 . "@src64/subr.l")
-info (2695 . "@src64/main.l")
+info (2708 . "@src64/main.l")
intern (875 . "@src64/sym.l")
ipid (3209 . "@src64/flow.l")
isa (959 . "@src64/flow.l")
@@ -181,7 +181,7 @@ lieu (1156 . "@src64/db.l")
line (3613 . "@src64/io.l")
lines (3766 . "@src64/io.l")
link (1172 . "@src64/subr.l")
-lisp (1935 . "@src64/main.l")
+lisp (1948 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (157 . "@src64/flow.l")
@@ -220,10 +220,10 @@ n== (2083 . "@src64/subr.l")
nT (2194 . "@src64/subr.l")
name (499 . "@src64/sym.l")
nand (1656 . "@src64/flow.l")
-native (1376 . "@src64/main.l")
+native (1389 . "@src64/main.l")
need (919 . "@src64/subr.l")
new (833 . "@src64/flow.l")
-next (2240 . "@src64/main.l")
+next (2253 . "@src64/main.l")
nil (1739 . "@src64/flow.l")
nond (1939 . "@src64/flow.l")
nor (1677 . "@src64/flow.l")
@@ -237,7 +237,7 @@ onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
open (4229 . "@src64/io.l")
opid (3225 . "@src64/flow.l")
-opt (2981 . "@src64/main.l")
+opt (2994 . "@src64/main.l")
or (1637 . "@src64/flow.l")
out (4123 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
@@ -270,9 +270,9 @@ push (1688 . "@src64/sym.l")
push1 (1724 . "@src64/sym.l")
put (2698 . "@src64/sym.l")
putl (2950 . "@src64/sym.l")
-pwd (2622 . "@src64/main.l")
+pwd (2635 . "@src64/main.l")
queue (1920 . "@src64/sym.l")
-quit (1085 . "@src64/main.l")
+quit (1098 . "@src64/main.l")
quote (141 . "@src64/flow.l")
rand (2973 . "@src64/big.l")
range (997 . "@src64/subr.l")
@@ -281,7 +281,7 @@ raw (458 . "@src64/main.l")
rd (5045 . "@src64/io.l")
read (2573 . "@src64/io.l")
replace (1499 . "@src64/subr.l")
-rest (2286 . "@src64/main.l")
+rest (2299 . "@src64/main.l")
reverse (1674 . "@src64/subr.l")
rewind (5011 . "@src64/io.l")
rollback (1890 . "@src64/db.l")
@@ -322,7 +322,7 @@ text (1272 . "@src64/sym.l")
throw (2490 . "@src64/flow.l")
tick (3177 . "@src64/flow.l")
till (3524 . "@src64/io.l")
-time (2505 . "@src64/main.l")
+time (2518 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1755 . "@src64/subr.l")
try (1172 . "@src64/flow.l")
@@ -335,9 +335,9 @@ up (706 . "@src64/main.l")
upp? (3230 . "@src64/sym.l")
uppc (3294 . "@src64/sym.l")
use (1570 . "@src64/flow.l")
-usec (2610 . "@src64/main.l")
+usec (2623 . "@src64/main.l")
val (1463 . "@src64/sym.l")
-version (2995 . "@src64/main.l")
+version (3008 . "@src64/main.l")
wait (3064 . "@src64/io.l")
when (1881 . "@src64/flow.l")
while (2058 . "@src64/flow.l")
diff --git a/src/main.c b/src/main.c
@@ -404,7 +404,19 @@ bool equal(any x, any y) {
if (num(car(x)) & 1) {
for (;;) {
if (a == x) {
- res = b == y;
+ if (b == y) {
+ for (;;) {
+ a = cdr(a);
+ if ((b = cdr(b)) == y) {
+ res = a == x;
+ break;
+ }
+ if (a == x) {
+ res = YES;
+ break;
+ }
+ }
+ }
break;
}
if (b == y) {
diff --git a/src64/main.l b/src64/main.l
@@ -865,8 +865,21 @@
if nz
do
cmp X A # Skip non-circular parts
- if eq # Done?
- cmp Y E # Set result
+ if eq # Done
+ cmp Y E # Circular parts same length?
+ if eq # Perhaps
+ do
+ ld X (X CDR) # Compare
+ ld Y (Y CDR)
+ cmp Y E # End of second?
+ if eq # Yes
+ cmp X A # Also end of first?
+ break T
+ end
+ cmp X A # End of first?
+ break eq # Yes
+ loop
+ end
break T
end
cmp Y E
