commit a465541204cd91e790f470669c3777e54e43a7cc
parent ec4be8ed5c674ec8b9bf161d10058d0b345118ca
Author: Commit-Bot <unknown>
Date: Mon, 13 Dec 2010 08:14:21 +0000
Automatic commit from picoLisp.tgz, From: Mon, 13 Dec 2010 08:14:21 GMT
Diffstat:
9 files changed, 106 insertions(+), 81 deletions(-)
diff --git a/doc/ref.html b/doc/ref.html
@@ -1013,7 +1013,7 @@ code-pointer directly:
-> 6
: ((quote . 67318096) 1 2 3)
-> 6
-: ((quote . 1234) (1 2 3))
+: ((quote . 1234) (1 2 3))
Segmentation fault
</code></pre>
diff --git a/doc/refN.html b/doc/refN.html
@@ -199,11 +199,13 @@ numeric return value. All numbers in this context should not be larger than 60
bits (signed). See also <code><a href="refL.html#lisp">lisp</a></code>.
<dt><a name="need"><code>(need 'cnt ['lst ['any]]) -> lst</code></a>
+<dt><code>(need 'cnt ['num|sym]) -> lst</code>
<dd>Produces a list of at least <code>cnt</code> elements. When called without
optional arguments, a list of <code>cnt</code> <code>NIL</code>'s is returned.
When <code>lst</code> is given, it is extended to the left (if <code>cnt</code>
is positive) or (destructively) to the right (if <code>cnt</code> is negative)
-with <code>any</code> elements. See also <code><a
+with <code>any</code> elements. In the second form, a list of <code>cnt</code>
+atomic values is returned. See also <code><a
href="refR.html#range">range</a></code>.
<pre><code>
@@ -215,6 +217,8 @@ href="refR.html#range">range</a></code>.
-> (a b c NIL NIL)
: (need 5 '(a b c) " ") # String alignment
-> (" " " " a b c)
+: (need 7 0)
+-> (0 0 0 0 0 0 0)
</code></pre>
<dt><a name="new"><code>(new ['flg|num] ['typ ['any ..]]) -> obj</code></a>
diff --git a/ersatz/fun.src b/ersatz/fun.src
@@ -1,4 +1,4 @@
-# 07dec10abu
+# 13dec10abu
# (c) Software Lab. Alexander Burger
# Ersatz PicoLisp Functions
@@ -2265,10 +2265,15 @@ list (x y)
return y;
# (need 'cnt ['lst ['any]]) -> lst
+# (need 'cnt ['num|sym]) -> lst
need (n x y z)
n = evLong(ex = ex.Cdr);
- z = (ex = ex.Cdr).Car.eval();
- y = ex.Cdr.Car.eval();
+ if ((z = (ex = ex.Cdr).Car.eval()) instanceof Cell || z == Nil)
+ y = ex.Cdr.Car.eval();
+ else {
+ y = z;
+ z = Nil;
+ }
x = z;
if (n > 0)
for (n -= x.length(); n > 0; --n)
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/tags b/lib/tags
@@ -6,22 +6,22 @@ $ (2943 . "@src64/flow.l")
*/ (2446 . "@src64/big.l")
+ (2171 . "@src64/big.l")
- (2209 . "@src64/big.l")
--> (3870 . "@src64/subr.l")
+-> (3879 . "@src64/subr.l")
/ (2511 . "@src64/big.l")
: (2898 . "@src64/sym.l")
:: (2922 . "@src64/sym.l")
; (2824 . "@src64/sym.l")
-< (2194 . "@src64/subr.l")
-<= (2224 . "@src64/subr.l")
-<> (2131 . "@src64/subr.l")
-= (2102 . "@src64/subr.l")
-=0 (2160 . "@src64/subr.l")
+< (2203 . "@src64/subr.l")
+<= (2233 . "@src64/subr.l")
+<> (2140 . "@src64/subr.l")
+= (2111 . "@src64/subr.l")
+=0 (2169 . "@src64/subr.l")
=: (2853 . "@src64/sym.l")
-== (2046 . "@src64/subr.l")
+== (2055 . "@src64/subr.l")
==== (967 . "@src64/sym.l")
-=T (2168 . "@src64/subr.l")
-> (2254 . "@src64/subr.l")
->= (2284 . "@src64/subr.l")
+=T (2177 . "@src64/subr.l")
+> (2263 . "@src64/subr.l")
+>= (2293 . "@src64/subr.l")
>> (2625 . "@src64/big.l")
abs (2715 . "@src64/big.l")
accept (139 . "@src64/net.l")
@@ -30,16 +30,16 @@ alarm (487 . "@src64/main.l")
all (772 . "@src64/sym.l")
and (1621 . "@src64/flow.l")
any (3870 . "@src64/io.l")
-append (1329 . "@src64/subr.l")
+append (1338 . "@src64/subr.l")
apply (591 . "@src64/apply.l")
arg (2270 . "@src64/main.l")
args (2246 . "@src64/main.l")
argv (2891 . "@src64/main.l")
as (146 . "@src64/flow.l")
-asoq (2992 . "@src64/subr.l")
-assoc (2957 . "@src64/subr.l")
+asoq (3001 . "@src64/subr.l")
+assoc (2966 . "@src64/subr.l")
at (2106 . "@src64/flow.l")
-atom (2372 . "@src64/subr.l")
+atom (2381 . "@src64/subr.l")
bind (1359 . "@src64/flow.l")
bit? (2732 . "@src64/big.l")
bool (1721 . "@src64/flow.l")
@@ -81,12 +81,12 @@ cddddr (652 . "@src64/subr.l")
cdddr (245 . "@src64/subr.l")
cddr (79 . "@src64/subr.l")
cdr (17 . "@src64/subr.l")
-chain (1132 . "@src64/subr.l")
+chain (1141 . "@src64/subr.l")
char (3352 . "@src64/io.l")
chop (1093 . "@src64/sym.l")
circ (816 . "@src64/subr.l")
-circ? (2389 . "@src64/subr.l")
-clip (1786 . "@src64/subr.l")
+circ? (2398 . "@src64/subr.l")
+clip (1795 . "@src64/subr.l")
close (4258 . "@src64/io.l")
cmd (2873 . "@src64/main.l")
cnt (1291 . "@src64/apply.l")
@@ -97,7 +97,7 @@ conc (781 . "@src64/subr.l")
cond (1916 . "@src64/flow.l")
connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
-copy (1216 . "@src64/subr.l")
+copy (1225 . "@src64/subr.l")
ctl (4198 . "@src64/io.l")
ctty (2671 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
@@ -108,9 +108,9 @@ dec (2323 . "@src64/big.l")
def (455 . "@src64/flow.l")
default (1661 . "@src64/sym.l")
del (1852 . "@src64/sym.l")
-delete (1392 . "@src64/subr.l")
-delq (1443 . "@src64/subr.l")
-diff (2576 . "@src64/subr.l")
+delete (1401 . "@src64/subr.l")
+delq (1452 . "@src64/subr.l")
+diff (2585 . "@src64/subr.l")
dir (2804 . "@src64/main.l")
dm (543 . "@src64/flow.l")
do (2136 . "@src64/flow.l")
@@ -128,14 +128,14 @@ extra (1263 . "@src64/flow.l")
extract (1096 . "@src64/apply.l")
fifo (1963 . "@src64/sym.l")
file (2751 . "@src64/main.l")
-fill (3227 . "@src64/subr.l")
+fill (3236 . "@src64/subr.l")
filter (1039 . "@src64/apply.l")
-fin (2020 . "@src64/subr.l")
+fin (2029 . "@src64/subr.l")
finally (2520 . "@src64/flow.l")
find (1200 . "@src64/apply.l")
fish (1491 . "@src64/apply.l")
-flg? (2432 . "@src64/subr.l")
-flip (1686 . "@src64/subr.l")
+flg? (2441 . "@src64/subr.l")
+flip (1695 . "@src64/subr.l")
flush (4994 . "@src64/io.l")
fold (3343 . "@src64/sym.l")
for (2225 . "@src64/flow.l")
@@ -143,7 +143,7 @@ fork (3248 . "@src64/flow.l")
format (2089 . "@src64/big.l")
free (2047 . "@src64/db.l")
from (3448 . "@src64/io.l")
-full (1066 . "@src64/subr.l")
+full (1075 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
gc (429 . "@src64/gc.l")
ge0 (2691 . "@src64/big.l")
@@ -152,7 +152,7 @@ getd (742 . "@src64/sym.l")
getl (3032 . "@src64/sym.l")
glue (1234 . "@src64/sym.l")
gt0 (2702 . "@src64/big.l")
-head (1807 . "@src64/subr.l")
+head (1816 . "@src64/subr.l")
heap (542 . "@src64/main.l")
hear (3131 . "@src64/io.l")
host (184 . "@src64/net.l")
@@ -163,7 +163,7 @@ if2 (1821 . "@src64/flow.l")
ifn (1862 . "@src64/flow.l")
in (4094 . "@src64/io.l")
inc (2256 . "@src64/big.l")
-index (2624 . "@src64/subr.l")
+index (2633 . "@src64/subr.l")
info (2708 . "@src64/main.l")
intern (875 . "@src64/sym.l")
ipid (3193 . "@src64/flow.l")
@@ -172,14 +172,14 @@ job (1426 . "@src64/flow.l")
journal (970 . "@src64/db.l")
key (3279 . "@src64/io.l")
kill (3225 . "@src64/flow.l")
-last (2031 . "@src64/subr.l")
-length (2728 . "@src64/subr.l")
+last (2040 . "@src64/subr.l")
+length (2737 . "@src64/subr.l")
let (1476 . "@src64/flow.l")
let? (1537 . "@src64/flow.l")
lieu (1156 . "@src64/db.l")
line (3604 . "@src64/io.l")
lines (3757 . "@src64/io.l")
-link (1163 . "@src64/subr.l")
+link (1172 . "@src64/subr.l")
lisp (1948 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
@@ -189,11 +189,11 @@ lock (1184 . "@src64/db.l")
loop (2168 . "@src64/flow.l")
low? (3215 . "@src64/sym.l")
lowc (3245 . "@src64/sym.l")
-lst? (2402 . "@src64/subr.l")
+lst? (2411 . "@src64/subr.l")
lt0 (2680 . "@src64/big.l")
lup (2226 . "@src64/sym.l")
-made (1098 . "@src64/subr.l")
-make (1079 . "@src64/subr.l")
+made (1107 . "@src64/subr.l")
+make (1088 . "@src64/subr.l")
map (727 . "@src64/apply.l")
mapc (769 . "@src64/apply.l")
mapcan (979 . "@src64/apply.l")
@@ -202,25 +202,25 @@ mapcon (919 . "@src64/apply.l")
maplist (811 . "@src64/apply.l")
maps (668 . "@src64/apply.l")
mark (1965 . "@src64/db.l")
-match (3112 . "@src64/subr.l")
-max (2314 . "@src64/subr.l")
+match (3121 . "@src64/subr.l")
+max (2323 . "@src64/subr.l")
maxi (1389 . "@src64/apply.l")
-member (2442 . "@src64/subr.l")
-memq (2464 . "@src64/subr.l")
+member (2451 . "@src64/subr.l")
+memq (2473 . "@src64/subr.l")
meta (3135 . "@src64/sym.l")
meth (1087 . "@src64/flow.l")
method (1051 . "@src64/flow.l")
-min (2343 . "@src64/subr.l")
+min (2352 . "@src64/subr.l")
mini (1440 . "@src64/apply.l")
-mix (1251 . "@src64/subr.l")
-mmeq (2492 . "@src64/subr.l")
-n0 (2176 . "@src64/subr.l")
-n== (2074 . "@src64/subr.l")
-nT (2185 . "@src64/subr.l")
+mix (1260 . "@src64/subr.l")
+mmeq (2501 . "@src64/subr.l")
+n0 (2185 . "@src64/subr.l")
+n== (2083 . "@src64/subr.l")
+nT (2194 . "@src64/subr.l")
name (499 . "@src64/sym.l")
nand (1656 . "@src64/flow.l")
native (1393 . "@src64/main.l")
-need (918 . "@src64/subr.l")
+need (919 . "@src64/subr.l")
new (833 . "@src64/flow.l")
next (2253 . "@src64/main.l")
nil (1739 . "@src64/flow.l")
@@ -228,9 +228,9 @@ nond (1939 . "@src64/flow.l")
nor (1677 . "@src64/flow.l")
not (1729 . "@src64/flow.l")
nth (685 . "@src64/subr.l")
-num? (2413 . "@src64/subr.l")
+num? (2422 . "@src64/subr.l")
off (1598 . "@src64/sym.l")
-offset (2664 . "@src64/subr.l")
+offset (2673 . "@src64/subr.l")
on (1583 . "@src64/sym.l")
onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
@@ -240,7 +240,7 @@ opt (2994 . "@src64/main.l")
or (1637 . "@src64/flow.l")
out (4114 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
-pair (2381 . "@src64/subr.l")
+pair (2390 . "@src64/subr.l")
pass (632 . "@src64/apply.l")
pat? (720 . "@src64/sym.l")
path (1230 . "@src64/io.l")
@@ -258,13 +258,13 @@ prinl (4932 . "@src64/io.l")
print (4958 . "@src64/io.l")
println (4989 . "@src64/io.l")
printsp (4974 . "@src64/io.l")
-prior (2700 . "@src64/subr.l")
+prior (2709 . "@src64/subr.l")
prog (1757 . "@src64/flow.l")
prog1 (1765 . "@src64/flow.l")
prog2 (1782 . "@src64/flow.l")
prop (2781 . "@src64/sym.l")
protect (532 . "@src64/main.l")
-prove (3484 . "@src64/subr.l")
+prove (3493 . "@src64/subr.l")
push (1688 . "@src64/sym.l")
push1 (1724 . "@src64/sym.l")
put (2698 . "@src64/sym.l")
@@ -274,20 +274,20 @@ queue (1920 . "@src64/sym.l")
quit (1102 . "@src64/main.l")
quote (141 . "@src64/flow.l")
rand (2959 . "@src64/big.l")
-range (988 . "@src64/subr.l")
-rank (3020 . "@src64/subr.l")
+range (997 . "@src64/subr.l")
+rank (3029 . "@src64/subr.l")
raw (465 . "@src64/main.l")
rd (5036 . "@src64/io.l")
read (2562 . "@src64/io.l")
-replace (1490 . "@src64/subr.l")
+replace (1499 . "@src64/subr.l")
rest (2299 . "@src64/main.l")
-reverse (1665 . "@src64/subr.l")
+reverse (1674 . "@src64/subr.l")
rewind (5002 . "@src64/io.l")
rollback (1890 . "@src64/db.l")
rot (848 . "@src64/subr.l")
rpc (5135 . "@src64/io.l")
run (313 . "@src64/flow.l")
-sect (2528 . "@src64/subr.l")
+sect (2537 . "@src64/subr.l")
seed (2944 . "@src64/big.l")
seek (1153 . "@src64/apply.l")
send (1131 . "@src64/flow.l")
@@ -295,27 +295,27 @@ seq (1083 . "@src64/db.l")
set (1482 . "@src64/sym.l")
setq (1515 . "@src64/sym.l")
sigio (503 . "@src64/main.l")
-size (2793 . "@src64/subr.l")
+size (2802 . "@src64/subr.l")
skip (3406 . "@src64/io.l")
-sort (3919 . "@src64/subr.l")
+sort (3928 . "@src64/subr.l")
sp? (711 . "@src64/sym.l")
space (4936 . "@src64/io.l")
-split (1579 . "@src64/subr.l")
+split (1588 . "@src64/subr.l")
stack (571 . "@src64/main.l")
state (2006 . "@src64/flow.l")
-stem (1976 . "@src64/subr.l")
+stem (1985 . "@src64/subr.l")
str (3924 . "@src64/io.l")
str? (1013 . "@src64/sym.l")
-strip (1563 . "@src64/subr.l")
+strip (1572 . "@src64/subr.l")
sub? (1444 . "@src64/sym.l")
sum (1338 . "@src64/apply.l")
super (1218 . "@src64/flow.l")
sym (3910 . "@src64/io.l")
-sym? (2421 . "@src64/subr.l")
+sym? (2430 . "@src64/subr.l")
sync (3091 . "@src64/io.l")
sys (3045 . "@src64/flow.l")
t (1748 . "@src64/flow.l")
-tail (1898 . "@src64/subr.l")
+tail (1907 . "@src64/subr.l")
tell (3163 . "@src64/io.l")
text (1272 . "@src64/sym.l")
throw (2488 . "@src64/flow.l")
@@ -323,11 +323,11 @@ tick (3161 . "@src64/flow.l")
till (3515 . "@src64/io.l")
time (2518 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
-trim (1746 . "@src64/subr.l")
+trim (1755 . "@src64/subr.l")
try (1172 . "@src64/flow.l")
type (912 . "@src64/flow.l")
udp (268 . "@src64/net.l")
-unify (3892 . "@src64/subr.l")
+unify (3901 . "@src64/subr.l")
unless (1898 . "@src64/flow.l")
until (2082 . "@src64/flow.l")
up (716 . "@src64/main.l")
@@ -347,7 +347,7 @@ xchg (1538 . "@src64/sym.l")
xor (1698 . "@src64/flow.l")
x| (2871 . "@src64/big.l")
yield (2699 . "@src64/flow.l")
-yoke (1187 . "@src64/subr.l")
+yoke (1196 . "@src64/subr.l")
zap (1063 . "@src64/sym.l")
zero (1631 . "@src64/sym.l")
| (2831 . "@src64/big.l")
diff --git a/src/subr.c b/src/subr.c
@@ -1,4 +1,4 @@
-/* 25nov10abu
+/* 13dec10abu
* (c) Software Lab. Alexander Burger
*/
@@ -319,6 +319,7 @@ any doList(any x) {
}
// (need 'cnt ['lst ['any]]) -> lst
+// (need 'cnt ['num|sym]) -> lst
any doNeed(any ex) {
int n;
any x;
@@ -326,7 +327,12 @@ any doNeed(any ex) {
n = (int)evCnt(ex, x = cdr(ex));
x = cdr(x), Push(c1, EVAL(car(x)));
- Push(c2, EVAL(cadr(x)));
+ if (isCell(data(c1)) || isNil(data(c1)))
+ Push(c2, EVAL(cadr(x)));
+ else {
+ Push(c2, data(c1));
+ data(c1) = Nil;
+ }
x = data(c1);
if (n > 0)
for (n -= length(x); n > 0; --n)
diff --git a/src64/subr.l b/src64/subr.l
@@ -1,4 +1,4 @@
-# 25nov10abu
+# 13dec10abu
# (c) Software Lab. Alexander Burger
# (car 'var) -> any
@@ -915,6 +915,7 @@
ret
# (need 'cnt ['lst ['any]]) -> lst
+# (need 'cnt ['num|sym]) -> lst
(code 'doNeed 2)
push X
push Y
@@ -926,11 +927,19 @@
ld E (Y) # Eval next
eval
link
- push E # <L II> 'lst'
- ld Y (Y CDR)
- ld E (Y) # Eval 'any'
- eval+
- push E # <L I> 'any'
+ atom E # First form?
+ jz 10 # Yes
+ cmp E Nil
+ if eq # Yes
+10 push E # <L II> 'lst'
+ ld Y (Y CDR)
+ ld E (Y) # Eval 'any'
+ eval+
+ push E # <L I> 'any'
+ else
+ push Nil # <L II> 'lst'
+ push E # <L I> 'num|sym'
+ end
link
ld E (L II) # Get 'lst'
or X X # 'cnt'?
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 07dec10abu
+# 13dec10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 4 17)
+(de *Version 3 0 4 18)
# vi:et:ts=3:sw=3
diff --git a/test/src/subr.l b/test/src/subr.l
@@ -1,4 +1,4 @@
-# 25nov10abu
+# 13dec10abu
# (c) Software Lab. Alexander Burger
### c[ad]*r ###
@@ -69,6 +69,7 @@
(test '(NIL NIL a b c) (need 5 '(a b c)))
(test '(a b c NIL NIL) (need -5 '(a b c)))
(test '(" " " " a b c) (need 5 '(a b c) " "))
+(test (0 0 0) (need 3 0))
### range ###
