commit eb37bc9703be0487641f0340492fea9402512a1b
parent 41693ab7a04bf821052b902eedc21cc829503f42
Author: Alexander Burger <abu@software-lab.de>
Date: Tue, 1 Mar 2011 11:59:35 +0100
T Simplified equal()
Diffstat:
6 files changed, 69 insertions(+), 77 deletions(-)
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/ersatz/sys.src b/ersatz/sys.src
@@ -1,4 +1,4 @@
-// 06feb11abu
+// 01mar11abu
// (c) Software Lab. Alexander Burger
import java.util.*;
@@ -2623,18 +2623,17 @@ public class PicoLisp {
final boolean equal(Any x) {
if (!(x instanceof Cell))
return false;
+ if (!x.Car.equal(Car))
+ return false;
HashSet<Any> mark = new HashSet<Any>();
Any y = this, a = x, b = y;
for (;;) {
- if (!x.Car.equal(y.Car))
- return false;
if (!(x.Cdr instanceof Cell))
return x.Cdr.equal(y.Cdr);
if (!(y.Cdr instanceof Cell))
return false;
- mark.add(x); x = x.Cdr;
- mark.add(y); y = y.Cdr;
- if (mark.contains(x) || mark.contains(y)) {
+ mark.add(x); x = x.Cdr; y = y.Cdr;
+ if (mark.contains(x)) {
for (;;) {
if (a == x)
return b == y;
@@ -2643,6 +2642,8 @@ public class PicoLisp {
a = a.Cdr; b = b.Cdr;
}
}
+ if (!x.Car.equal(y.Car))
+ return false;
}
}
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 (2264 . "@src64/main.l")
-args (2240 . "@src64/main.l")
-argv (2885 . "@src64/main.l")
+arg (2258 . "@src64/main.l")
+args (2234 . "@src64/main.l")
+argv (2879 . "@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 (2640 . "@src64/main.l")
+cd (2634 . "@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 (2867 . "@src64/main.l")
+cmd (2861 . "@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 (2665 . "@src64/main.l")
+ctty (2659 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
-date (2379 . "@src64/main.l")
+date (2373 . "@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 (2798 . "@src64/main.l")
+dir (2792 . "@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 (1375 . "@src64/main.l")
+errno (1369 . "@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 (2745 . "@src64/main.l")
+file (2739 . "@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 (2702 . "@src64/main.l")
+info (2696 . "@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 (1942 . "@src64/main.l")
+lisp (1936 . "@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 (1383 . "@src64/main.l")
+native (1377 . "@src64/main.l")
need (919 . "@src64/subr.l")
new (833 . "@src64/flow.l")
-next (2247 . "@src64/main.l")
+next (2241 . "@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 (2988 . "@src64/main.l")
+opt (2982 . "@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 (2629 . "@src64/main.l")
+pwd (2623 . "@src64/main.l")
queue (1920 . "@src64/sym.l")
-quit (1092 . "@src64/main.l")
+quit (1086 . "@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 (2293 . "@src64/main.l")
+rest (2287 . "@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 (2512 . "@src64/main.l")
+time (2506 . "@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 (2617 . "@src64/main.l")
+usec (2611 . "@src64/main.l")
val (1463 . "@src64/sym.l")
-version (3002 . "@src64/main.l")
+version (2996 . "@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
@@ -1,4 +1,4 @@
-/* 18jan11abu
+/* 01mar11abu
* (c) Software Lab. Alexander Burger
*/
@@ -370,6 +370,9 @@ any circ(any x) {
/* Comparisons */
bool equal(any x, any y) {
+ any a, b;
+ bool res;
+
for (;;) {
if (x == y)
return YES;
@@ -377,54 +380,48 @@ bool equal(any x, any y) {
if (!isNum(y) || unDig(x) != unDig(y))
return NO;
x = cdr(numCell(x)), y = cdr(numCell(y));
+ continue;
}
- else if (isSym(x)) {
+ if (isSym(x)) {
if (!isSym(y) || !isNum(x = name(x)) || !isNum(y = name(y)))
return NO;
+ continue;
}
- else if (!isCell(y))
+ if (!isCell(y))
return NO;
- else {
- any a = x, b = y;
- bool res = NO;
-
- for (;;) {
- if (!equal(car(x), car(y)))
- break;
- if (!isCell(cdr(x))) {
- res = equal(cdr(x), cdr(y));
- break;
- }
- if (!isCell(cdr(y)))
- break;
- *(word*)&car(x) |= 1, x = cdr(x);
- *(word*)&car(y) |= 1, y = cdr(y);
- if (num(car(x)) & 1 || num(car(y)) & 1) {
- for (;;) {
- if (a == x) {
- res = b == y;
- break;
- }
- if (b == y) {
- res = NO;
- break;
- }
- *(word*)&car(a) &= ~1, a = cdr(a);
- *(word*)&car(b) &= ~1, b = cdr(b);
+ a = x, b = y;
+ res = NO;
+ for (;;) {
+ if (!equal(car(x), car(y)))
+ break;
+ if (!isCell(cdr(x))) {
+ res = equal(cdr(x), cdr(y));
+ break;
+ }
+ if (!isCell(cdr(y)))
+ break;
+ *(word*)&car(x) |= 1, x = cdr(x), y = cdr(y);
+ if (num(car(x)) & 1) {
+ for (;;) {
+ if (a == x) {
+ res = b == y;
+ break;
+ }
+ if (b == y) {
+ res = NO;
+ break;
}
- do {
- *(word*)&car(a) &= ~1, a = cdr(a);
- *(word*)&car(b) &= ~1, b = cdr(b);
- } while (a != x);
- return res;
+ *(word*)&car(a) &= ~1, a = cdr(a), b = cdr(b);
}
+ do
+ *(word*)&car(a) &= ~1, a = cdr(a), b = cdr(b);
+ while (a != x);
+ return res;
}
- while (a != x) {
- *(word*)&car(a) &= ~1, a = cdr(a);
- *(word*)&car(b) &= ~1, b = cdr(b);
- }
- return res;
}
+ while (a != x)
+ *(word*)&car(a) &= ~1, a = cdr(a), b = cdr(b);
+ return res;
}
}
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 26feb11abu
+# 01mar11abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -859,13 +859,10 @@
break nz # Yes: 'ne'
or (A) 1 # Mark
ld A (A CDR)
- or (E) 1
ld E (E CDR)
test (A) 1 # Detected circularity?
- jnz 10 # Yes
- test (E) 1
if nz
-10 do
+ do
cmp X A # Skip non-circular parts
if eq # Done?
cmp Y E # Set result
@@ -878,14 +875,12 @@
end
off (X) 1 # Unmark
ld X (X CDR)
- off (Y) 1
ld Y (Y CDR)
loop
push F # Save result
do
off (X) 1 # Unmark circular part
ld X (X CDR)
- off (Y) 1
ld Y (Y CDR)
cmp X A
until eq
@@ -901,7 +896,6 @@
while ne
off (X) 1 # Unmark
ld X (X CDR)
- off (Y) 1
ld Y (Y CDR)
loop
pop F # Get result
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 28feb11abu
+# 01mar11abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 5 18)
+(de *Version 3 0 5 19)
# vi:et:ts=3:sw=3
