picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

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:
Mlib/tags | 40++++++++++++++++++++--------------------
Msrc/main.c | 8+++++---
Msrc64/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