picolisp

commit 3c61866756a2b997cd2197de3123d31510dd7b2e
parent d8c9b211f62ef0cbe88c896511f483e6faf908f7
Author: Commit-Bot <unknown>
Date:   Thu, 22 Jul 2010 05:07:51 +0000

Automatic commit from picoLisp.tgz, From: Thu, 22 Jul 2010 05:07:51 GMT
Diffstat:
M
lib/tags
 | 
40
++++++++++++++++++++--------------------
M
src/main.c
 | 
8
+++++---
M
src64/main.l
 | 
12
+++++++++---

3 files changed, 34 insertions(+), 26 deletions(-)
diff --git a/lib/tags b/lib/tags
@@ -32,9 +32,9 @@ and (1643 . "@src64/flow.l")
 any (3792 . "@src64/io.l")
 append (1329 . "@src64/subr.l")
 apply (597 . "@src64/apply.l")
-arg (2031 . "@src64/main.l")
-args (2007 . "@src64/main.l")
-argv (2652 . "@src64/main.l")
+arg (2037 . "@src64/main.l")
+args (2013 . "@src64/main.l")
+argv (2658 . "@src64/main.l")
 as (146 . "@src64/flow.l")
 asoq (2942 . "@src64/subr.l")
 assoc (2907 . "@src64/subr.l")
@@ -65,7 +65,7 @@ call (3102 . "@src64/flow.l")
 car (5 . "@src64/subr.l")
 case (1984 . "@src64/flow.l")
 catch (2484 . "@src64/flow.l")
-cd (2407 . "@src64/main.l")
+cd (2413 . "@src64/main.l")
 cdaaar (464 . "@src64/subr.l")
 cdaadr (487 . "@src64/subr.l")
 cdaar (179 . "@src64/subr.l")
@@ -87,7 +87,7 @@ chop (1093 . "@src64/sym.l")
 circ (816 . "@src64/subr.l")
 clip (1786 . "@src64/subr.l")
 close (4180 . "@src64/io.l")
-cmd (2634 . "@src64/main.l")
+cmd (2640 . "@src64/main.l")
 cnt (1297 . "@src64/apply.l")
 co (2566 . "@src64/flow.l")
 commit (1503 . "@src64/db.l")
@@ -98,9 +98,9 @@ connect (201 . "@src64/net.l")
 cons (747 . "@src64/subr.l")
 copy (1216 . "@src64/subr.l")
 ctl (4120 . "@src64/io.l")
-ctty (2432 . "@src64/main.l")
+ctty (2438 . "@src64/main.l")
 cut (1797 . "@src64/sym.l")
-date (2146 . "@src64/main.l")
+date (2152 . "@src64/main.l")
 dbck (2092 . "@src64/db.l")
 de (549 . "@src64/flow.l")
 dec (2323 . "@src64/big.l")
@@ -110,7 +110,7 @@ del (1852 . "@src64/sym.l")
 delete (1392 . "@src64/subr.l")
 delq (1443 . "@src64/subr.l")
 diff (2563 . "@src64/subr.l")
-dir (2565 . "@src64/main.l")
+dir (2571 . "@src64/main.l")
 dm (561 . "@src64/flow.l")
 do (2158 . "@src64/flow.l")
 e (2932 . "@src64/flow.l")
@@ -118,7 +118,7 @@ echo (4211 . "@src64/io.l")
 env (621 . "@src64/main.l")
 eof (3351 . "@src64/io.l")
 eol (3342 . "@src64/io.l")
-errno (1348 . "@src64/main.l")
+errno (1354 . "@src64/main.l")
 eval (208 . "@src64/flow.l")
 ext (4936 . "@src64/io.l")
 ext? (1034 . "@src64/sym.l")
@@ -126,7 +126,7 @@ extern (900 . "@src64/sym.l")
 extra (1284 . "@src64/flow.l")
 extract (1102 . "@src64/apply.l")
 fifo (1963 . "@src64/sym.l")
-file (2512 . "@src64/main.l")
+file (2518 . "@src64/main.l")
 fill (3177 . "@src64/subr.l")
 filter (1045 . "@src64/apply.l")
 fin (2020 . "@src64/subr.l")
@@ -163,7 +163,7 @@ ifn (1884 . "@src64/flow.l")
 in (4016 . "@src64/io.l")
 inc (2256 . "@src64/big.l")
 index (2611 . "@src64/subr.l")
-info (2469 . "@src64/main.l")
+info (2475 . "@src64/main.l")
 intern (875 . "@src64/sym.l")
 ipid (3214 . "@src64/flow.l")
 isa (978 . "@src64/flow.l")
@@ -217,10 +217,10 @@ n== (2074 . "@src64/subr.l")
 nT (2185 . "@src64/subr.l")
 name (499 . "@src64/sym.l")
 nand (1678 . "@src64/flow.l")
-native (1356 . "@src64/main.l")
+native (1362 . "@src64/main.l")
 need (918 . "@src64/subr.l")
 new (852 . "@src64/flow.l")
-next (2014 . "@src64/main.l")
+next (2020 . "@src64/main.l")
 nil (1761 . "@src64/flow.l")
 nond (1961 . "@src64/flow.l")
 nor (1699 . "@src64/flow.l")
@@ -234,7 +234,7 @@ onOff (1613 . "@src64/sym.l")
 one (1646 . "@src64/sym.l")
 open (4142 . "@src64/io.l")
 opid (3230 . "@src64/flow.l")
-opt (2755 . "@src64/main.l")
+opt (2761 . "@src64/main.l")
 or (1659 . "@src64/flow.l")
 out (4036 . "@src64/io.l")
 pack (1144 . "@src64/sym.l")
@@ -267,9 +267,9 @@ push (1688 . "@src64/sym.l")
 push1 (1724 . "@src64/sym.l")
 put (2698 . "@src64/sym.l")
 putl (2950 . "@src64/sym.l")
-pwd (2396 . "@src64/main.l")
+pwd (2402 . "@src64/main.l")
 queue (1920 . "@src64/sym.l")
-quit (1065 . "@src64/main.l")
+quit (1071 . "@src64/main.l")
 quote (141 . "@src64/flow.l")
 rand (2959 . "@src64/big.l")
 range (988 . "@src64/subr.l")
@@ -278,7 +278,7 @@ raw (461 . "@src64/main.l")
 rd (4953 . "@src64/io.l")
 read (2530 . "@src64/io.l")
 replace (1490 . "@src64/subr.l")
-rest (2060 . "@src64/main.l")
+rest (2066 . "@src64/main.l")
 reverse (1665 . "@src64/subr.l")
 rewind (4919 . "@src64/io.l")
 rollback (1885 . "@src64/db.l")
@@ -319,7 +319,7 @@ text (1272 . "@src64/sym.l")
 throw (2510 . "@src64/flow.l")
 tick (3182 . "@src64/flow.l")
 till (3437 . "@src64/io.l")
-time (2279 . "@src64/main.l")
+time (2285 . "@src64/main.l")
 touch (1049 . "@src64/sym.l")
 trim (1746 . "@src64/subr.l")
 try (1191 . "@src64/flow.l")
@@ -332,9 +332,9 @@ up (708 . "@src64/main.l")
 upp? (3232 . "@src64/sym.l")
 uppc (3296 . "@src64/sym.l")
 use (1592 . "@src64/flow.l")
-usec (2384 . "@src64/main.l")
+usec (2390 . "@src64/main.l")
 val (1463 . "@src64/sym.l")
-version (2769 . "@src64/main.l")
+version (2775 . "@src64/main.l")
 wait (3016 . "@src64/io.l")
 when (1903 . "@src64/flow.l")
 while (2080 . "@src64/flow.l")
diff --git a/src/main.c b/src/main.c
@@ -1,4 +1,4 @@
-/* 21jul10abu
+/* 22jul10abu
  * (c) Software Lab. Alexander Burger
  */
 
@@ -405,8 +405,10 @@ bool equal(any x, any y) {
                return equal(x, cdr(y));
             if (!isCell(y = cdr(y)))
                return NO;
-            if (x == a && y == b)
-               return YES;
+            if (x == a)
+               return y == b;
+            if (y == b)
+               return NO;
          }
       }
    }
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 21jul10abu
+# 22jul10abu
 # (c) Software Lab. Alexander Burger
 
 ### Global return labels ###
@@ -874,9 +874,15 @@
       atom E  # E's CDR atomic?
       break nz  # Yes: 'ne'
       cmp A (S I)  # A circular?
-      break eq  # Yes: 'eq'
+      if eq  # Yes
+         cmp E (S)  # Return whether E is also circular
+         break T
+      end
       cmp E (S)  # E circular?
-      break eq  # Yes: 'eq'
+      if eq  # Yes
+         clrz
+         break T  # Yes: 'ne'
+      end
    loop
    pop A  # Drop list heads
    pop A