picolisp

commit 4ef982db061eb433b8b7c2d3085c6f79116d721c
parent 9fb8978bdd977c816b2792df4ca8a34ab1d4fba6
Author: Alexander Burger <abu@software-lab.de>
Date:   Fri, 25 Feb 2011 10:18:19 +0100

Allow NIL limit in 'at'
Diffstat:
M
doc/refA.html
 | 
4
+++-
M
ersatz/fun.src
 | 
6
++++--
M
ersatz/picolisp.jar
 | 
0

M
lib/tags
 | 
38
+++++++++++++++++++-------------------
M
src/flow.c
 | 
6
++++--
M
src64/flow.l
 | 
8
+++++---

6 files changed, 35 insertions(+), 27 deletions(-)
diff --git a/doc/refA.html b/doc/refA.html
@@ -572,10 +572,12 @@ equal to <code>any</code>, or <code>NIL</code> if no match is found. See also
 -> NIL
 </code></pre>
 
-<dt><a name="at"><code>(at '(cnt1 . cnt2) . prg) -> any</code></a>
+<dt><a name="at"><code>(at '(cnt1 . cnt2|NIL) . prg) -> any</code></a>
 <dd>Increments <code>cnt1</code> (destructively), and returns <code>NIL</code>
 when it is less than <code>cnt2</code>. Otherwise, <code>cnt1</code> is reset to
 zero and <code>prg</code> is executed. Returns the result of <code>prg</code>.
+If <code>cnt2</code> is <code>NIL</code>, nothing is done, and <code>NIL</code>
+is returned immediately.
 
 <pre><code>
 : (do 11 (prin ".") (at (0 . 3) (prin "!")))
diff --git a/ersatz/fun.src b/ersatz/fun.src
@@ -1,4 +1,4 @@
-# 27jan11abu
+# 25feb11abu
 # (c) Software Lab. Alexander Burger
 
 # Ersatz PicoLisp Functions
@@ -1376,9 +1376,11 @@ do (n w x y)
 loop T
    return loop(ex.Cdr);
 
-# (at '(cnt1 . cnt2) . prg) -> any
+# (at '(cnt1 . cnt2|NIL) . prg) -> any
 at (num x)
    x = (ex = ex.Cdr).Car.eval();
+   if (x.Cdr == Nil)
+      return Nil;
    if ((num = ((Number)x.Car).add(One)).compare((Number)x.Cdr) < 0) {
       x.Car = num;
       return Nil;
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/tags b/lib/tags
@@ -1,5 +1,5 @@
-! (2855 . "@src64/flow.l")
-$ (2957 . "@src64/flow.l")
+! (2857 . "@src64/flow.l")
+$ (2959 . "@src64/flow.l")
 % (2570 . "@src64/big.l")
 & (2805 . "@src64/big.l")
 * (2389 . "@src64/big.l")
@@ -46,7 +46,7 @@ bool (1721 . "@src64/flow.l")
 box (822 . "@src64/flow.l")
 box? (999 . "@src64/sym.l")
 by (1669 . "@src64/apply.l")
-bye (3436 . "@src64/flow.l")
+bye (3438 . "@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 (3088 . "@src64/flow.l")
+call (3090 . "@src64/flow.l")
 car (5 . "@src64/subr.l")
 case (1962 . "@src64/flow.l")
-catch (2462 . "@src64/flow.l")
+catch (2464 . "@src64/flow.l")
 cd (2640 . "@src64/main.l")
 cdaaar (464 . "@src64/subr.l")
 cdaadr (487 . "@src64/subr.l")
@@ -90,7 +90,7 @@ clip (1795 . "@src64/subr.l")
 close (4267 . "@src64/io.l")
 cmd (2867 . "@src64/main.l")
 cnt (1413 . "@src64/apply.l")
-co (2544 . "@src64/flow.l")
+co (2546 . "@src64/flow.l")
 commit (1496 . "@src64/db.l")
 con (725 . "@src64/subr.l")
 conc (781 . "@src64/subr.l")
@@ -113,8 +113,8 @@ delq (1452 . "@src64/subr.l")
 diff (2585 . "@src64/subr.l")
 dir (2798 . "@src64/main.l")
 dm (543 . "@src64/flow.l")
-do (2136 . "@src64/flow.l")
-e (2918 . "@src64/flow.l")
+do (2138 . "@src64/flow.l")
+e (2920 . "@src64/flow.l")
 echo (4298 . "@src64/io.l")
 env (615 . "@src64/main.l")
 eof (3438 . "@src64/io.l")
@@ -131,15 +131,15 @@ file (2745 . "@src64/main.l")
 fill (3236 . "@src64/subr.l")
 filter (1161 . "@src64/apply.l")
 fin (2029 . "@src64/subr.l")
-finally (2520 . "@src64/flow.l")
+finally (2522 . "@src64/flow.l")
 find (1322 . "@src64/apply.l")
 fish (1613 . "@src64/apply.l")
 flg? (2441 . "@src64/subr.l")
 flip (1695 . "@src64/subr.l")
 flush (5003 . "@src64/io.l")
 fold (3343 . "@src64/sym.l")
-for (2225 . "@src64/flow.l")
-fork (3262 . "@src64/flow.l")
+for (2227 . "@src64/flow.l")
+fork (3264 . "@src64/flow.l")
 format (2089 . "@src64/big.l")
 free (2047 . "@src64/db.l")
 from (3457 . "@src64/io.l")
@@ -166,12 +166,12 @@ inc (2256 . "@src64/big.l")
 index (2633 . "@src64/subr.l")
 info (2702 . "@src64/main.l")
 intern (875 . "@src64/sym.l")
-ipid (3207 . "@src64/flow.l")
+ipid (3209 . "@src64/flow.l")
 isa (959 . "@src64/flow.l")
 job (1426 . "@src64/flow.l")
 journal (970 . "@src64/db.l")
 key (3290 . "@src64/io.l")
-kill (3239 . "@src64/flow.l")
+kill (3241 . "@src64/flow.l")
 last (2040 . "@src64/subr.l")
 le0 (2691 . "@src64/big.l")
 length (2737 . "@src64/subr.l")
@@ -187,7 +187,7 @@ listen (151 . "@src64/net.l")
 lit (157 . "@src64/flow.l")
 load (4080 . "@src64/io.l")
 lock (1184 . "@src64/db.l")
-loop (2168 . "@src64/flow.l")
+loop (2170 . "@src64/flow.l")
 low? (3215 . "@src64/sym.l")
 lowc (3245 . "@src64/sym.l")
 lst? (2411 . "@src64/subr.l")
@@ -236,7 +236,7 @@ on (1583 . "@src64/sym.l")
 onOff (1613 . "@src64/sym.l")
 one (1646 . "@src64/sym.l")
 open (4229 . "@src64/io.l")
-opid (3223 . "@src64/flow.l")
+opid (3225 . "@src64/flow.l")
 opt (2988 . "@src64/main.l")
 or (1637 . "@src64/flow.l")
 out (4123 . "@src64/io.l")
@@ -314,13 +314,13 @@ super (1218 . "@src64/flow.l")
 sym (3919 . "@src64/io.l")
 sym? (2430 . "@src64/subr.l")
 sync (3102 . "@src64/io.l")
-sys (3059 . "@src64/flow.l")
+sys (3061 . "@src64/flow.l")
 t (1748 . "@src64/flow.l")
 tail (1907 . "@src64/subr.l")
 tell (3174 . "@src64/io.l")
 text (1272 . "@src64/sym.l")
-throw (2488 . "@src64/flow.l")
-tick (3175 . "@src64/flow.l")
+throw (2490 . "@src64/flow.l")
+tick (3177 . "@src64/flow.l")
 till (3524 . "@src64/io.l")
 time (2512 . "@src64/main.l")
 touch (1049 . "@src64/sym.l")
@@ -347,7 +347,7 @@ wr (5128 . "@src64/io.l")
 xchg (1538 . "@src64/sym.l")
 xor (1698 . "@src64/flow.l")
 x| (2885 . "@src64/big.l")
-yield (2713 . "@src64/flow.l")
+yield (2715 . "@src64/flow.l")
 yoke (1196 . "@src64/subr.l")
 zap (1063 . "@src64/sym.l")
 zero (1631 . "@src64/sym.l")
diff --git a/src/flow.c b/src/flow.c
@@ -1,4 +1,4 @@
-/* 19oct10abu
+/* 25feb11abu
  * (c) Software Lab. Alexander Burger
  */
 
@@ -1164,12 +1164,14 @@ any doDo(any x) {
    }
 }
 
-// (at '(cnt1 . cnt2) . prg) -> any
+// (at '(cnt1 . cnt2|NIL) . prg) -> any
 any doAt(any ex) {
    any x;
 
    x = cdr(ex),  x = EVAL(car(x));
    NeedCell(ex,x);
+   if (isNil(cdr(x)))
+      return Nil;
    NeedCnt(ex,car(x));
    NeedCnt(ex,cdr(x));
    if (num(setDig(car(x), unDig(car(x))+2)) < unDig(cdr(x)))
diff --git a/src64/flow.l b/src64/flow.l
@@ -1,4 +1,4 @@
-# 17feb11abu
+# 25feb11abu
 # (c) Software Lab. Alexander Burger
 
 (code 'redefMsgEC)
@@ -2102,7 +2102,7 @@
    pop X
    ret
 
-# (at '(cnt1 . cnt2) . prg) -> any
+# (at '(cnt1 . cnt2|NIL) . prg) -> any
 (code 'doAt 2)
    push X
    push Y
@@ -2112,6 +2112,8 @@
    eval
    atom E  # Need cell
    jnz cellErrEX
+   cmp (E CDR) Nil  # CDR?
+   jeq 10  # No
    ld A (E)  # Get 'cnt1'
    cnt A  # Need short
    jz cntErrAX
@@ -2122,7 +2124,7 @@
    cmp A C  # Reached count?
    if lt  # No
       ld (E) A
-      ld E Nil
+10    ld E Nil
    else
       ld (E) ZERO
       ld Y (Y CDR)  # Run body