commit 33ee8d0433864d5a0533976fb7637805448a3c0f
parent 7f13c47034e877e2aeeda9a87605eab7bc92e598
Author: Commit-Bot <unknown>
Date: Tue, 7 Dec 2010 11:16:24 +0000
Automatic commit from picoLisp.tgz, From: Tue, 07 Dec 2010 11:16:24 GMT
Diffstat:
9 files changed, 59 insertions(+), 53 deletions(-)
diff --git a/doc/refC.html b/doc/refC.html
@@ -641,11 +641,12 @@ serving the PicoLisp process with the process ID <code>pid</code>. See also
</code></pre>
<dt><a name="curry"><code>(curry lst . fun) -> fun</code></a>
-<dd>Builds a new function from the list of symbols <code>lst</code> and the
-functional expression <code>fun</code>. Each member in <code>lst</code> that is
-a <code><a href="refP.html#pat?">pat?</a></code> symbol is substituted inside
-<code>fun</code> by its value. All other symbols in <code>lst</code> are
-collected into a <code><a href="refJ.html#job">job</a></code> environment.
+<dd>Builds a new function from the list of symbols or symbol-value pairs
+<code>lst</code> and the functional expression <code>fun</code>. Each member in
+<code>lst</code> that is a <code><a href="refP.html#pat?">pat?</a></code> symbol
+is substituted inside <code>fun</code> by its value. All other symbols in
+<code>lst</code> are collected into a <code><a
+href="refJ.html#job">job</a></code> environment.
<pre><code>
: (de multiplier (@X)
@@ -656,14 +657,13 @@ collected into a <code><a href="refJ.html#job">job</a></code> environment.
: ((multiplier 7) 3))
-> 21
-: (let (N1 0 N2 1)
- (def 'fiboCounter
- (curry (N1 N2) (Cnt)
- (do Cnt
- (println
- (prog1
- (+ N1 N2)
- (setq N1 N2 N2 @) ) ) ) ) ) )
+: (def 'fiboCounter
+ (curry ((N1 . 0) (N2 . 1)) (Cnt)
+ (do Cnt
+ (println
+ (prog1
+ (+ N1 N2)
+ (setq N1 N2 N2 @) ) ) ) ) )
-> fiboCounter
: (pp 'fiboCounter)
(de fiboCounter (Cnt)
diff --git a/doc/refE.html b/doc/refE.html
@@ -207,9 +207,9 @@ href="refS.html#show">show</a></code>.
<dt><a name="env"><code>(env ['lst] | ['sym 'val] ..) -> lst</code></a>
<dd>Return a list of symbol-value pairs of all dynamically bound symbols if
-called without arguments, or of the symbols in <code>lst</code>, or the
-explicitly given <code>sym</code>-<code>val</code> arguments. See also <code><a
-href="refB.html#bind">bind</a></code> and <code><a
+called without arguments, or of the symbols or symbol-value pairs in
+<code>lst</code>, or the explicitly given <code>sym</code>-<code>val</code>
+arguments. See also <code><a href="refB.html#bind">bind</a></code> and <code><a
href="refJ.html#job">job</a></code>.
<pre><code>
@@ -219,8 +219,8 @@ href="refJ.html#job">job</a></code>.
-> ((A . 1) (B . 2))
: (let (A 1 B 2) (env '(A B)))
-> ((B . 2) (A . 1))
-: (let (A 1 B 2) (env 'X 7 '(A B) 'Y 8))
--> ((Y . 8) (B . 2) (A . 1) (X . 7))
+: (let (A 1 B 2) (env 'X 7 '(A B (C . 3)) 'Y 8))
+-> ((Y . 8) (C . 3) (B . 2) (A . 1) (X . 7))
</code></pre>
<dt><a name="eof"><code>(eof ['flg]) -> flg</code></a>
diff --git a/ersatz/fun.src b/ersatz/fun.src
@@ -1,4 +1,4 @@
-# 29nov10abu
+# 07dec10abu
# (c) Software Lab. Alexander Burger
# Ersatz PicoLisp Functions
@@ -27,7 +27,7 @@ env (i x y)
do {
if ((x = ex.Car.eval()) instanceof Cell) {
do
- y = new Cell(new Cell(x.Car, x.Car.Car), y);
+ y = new Cell(x.Car instanceof Cell? x.Car : new Cell(x.Car, x.Car.Car), y);
while ((x = x.Cdr) instanceof Cell);
}
else if (x != Nil) {
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/tags b/lib/tags
@@ -32,9 +32,9 @@ and (1621 . "@src64/flow.l")
any (3870 . "@src64/io.l")
append (1329 . "@src64/subr.l")
apply (591 . "@src64/apply.l")
-arg (2266 . "@src64/main.l")
-args (2242 . "@src64/main.l")
-argv (2887 . "@src64/main.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")
@@ -65,7 +65,7 @@ call (3074 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1962 . "@src64/flow.l")
catch (2462 . "@src64/flow.l")
-cd (2642 . "@src64/main.l")
+cd (2646 . "@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? (2389 . "@src64/subr.l")
clip (1786 . "@src64/subr.l")
close (4258 . "@src64/io.l")
-cmd (2869 . "@src64/main.l")
+cmd (2873 . "@src64/main.l")
cnt (1291 . "@src64/apply.l")
co (2544 . "@src64/flow.l")
commit (1496 . "@src64/db.l")
@@ -99,9 +99,9 @@ connect (201 . "@src64/net.l")
cons (747 . "@src64/subr.l")
copy (1216 . "@src64/subr.l")
ctl (4198 . "@src64/io.l")
-ctty (2667 . "@src64/main.l")
+ctty (2671 . "@src64/main.l")
cut (1797 . "@src64/sym.l")
-date (2381 . "@src64/main.l")
+date (2385 . "@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 (1392 . "@src64/subr.l")
delq (1443 . "@src64/subr.l")
diff (2576 . "@src64/subr.l")
-dir (2800 . "@src64/main.l")
+dir (2804 . "@src64/main.l")
dm (543 . "@src64/flow.l")
do (2136 . "@src64/flow.l")
e (2904 . "@src64/flow.l")
@@ -119,7 +119,7 @@ echo (4289 . "@src64/io.l")
env (625 . "@src64/main.l")
eof (3429 . "@src64/io.l")
eol (3420 . "@src64/io.l")
-errno (1381 . "@src64/main.l")
+errno (1385 . "@src64/main.l")
eval (182 . "@src64/flow.l")
ext (5019 . "@src64/io.l")
ext? (1034 . "@src64/sym.l")
@@ -127,7 +127,7 @@ extern (900 . "@src64/sym.l")
extra (1263 . "@src64/flow.l")
extract (1096 . "@src64/apply.l")
fifo (1963 . "@src64/sym.l")
-file (2747 . "@src64/main.l")
+file (2751 . "@src64/main.l")
fill (3227 . "@src64/subr.l")
filter (1039 . "@src64/apply.l")
fin (2020 . "@src64/subr.l")
@@ -164,7 +164,7 @@ ifn (1862 . "@src64/flow.l")
in (4094 . "@src64/io.l")
inc (2256 . "@src64/big.l")
index (2624 . "@src64/subr.l")
-info (2704 . "@src64/main.l")
+info (2708 . "@src64/main.l")
intern (875 . "@src64/sym.l")
ipid (3193 . "@src64/flow.l")
isa (959 . "@src64/flow.l")
@@ -180,7 +180,7 @@ lieu (1156 . "@src64/db.l")
line (3604 . "@src64/io.l")
lines (3757 . "@src64/io.l")
link (1163 . "@src64/subr.l")
-lisp (1944 . "@src64/main.l")
+lisp (1948 . "@src64/main.l")
list (887 . "@src64/subr.l")
listen (151 . "@src64/net.l")
lit (157 . "@src64/flow.l")
@@ -219,10 +219,10 @@ n== (2074 . "@src64/subr.l")
nT (2185 . "@src64/subr.l")
name (499 . "@src64/sym.l")
nand (1656 . "@src64/flow.l")
-native (1389 . "@src64/main.l")
+native (1393 . "@src64/main.l")
need (918 . "@src64/subr.l")
new (833 . "@src64/flow.l")
-next (2249 . "@src64/main.l")
+next (2253 . "@src64/main.l")
nil (1739 . "@src64/flow.l")
nond (1939 . "@src64/flow.l")
nor (1677 . "@src64/flow.l")
@@ -236,7 +236,7 @@ onOff (1613 . "@src64/sym.l")
one (1646 . "@src64/sym.l")
open (4220 . "@src64/io.l")
opid (3209 . "@src64/flow.l")
-opt (2990 . "@src64/main.l")
+opt (2994 . "@src64/main.l")
or (1637 . "@src64/flow.l")
out (4114 . "@src64/io.l")
pack (1144 . "@src64/sym.l")
@@ -269,9 +269,9 @@ push (1688 . "@src64/sym.l")
push1 (1724 . "@src64/sym.l")
put (2698 . "@src64/sym.l")
putl (2950 . "@src64/sym.l")
-pwd (2631 . "@src64/main.l")
+pwd (2635 . "@src64/main.l")
queue (1920 . "@src64/sym.l")
-quit (1098 . "@src64/main.l")
+quit (1102 . "@src64/main.l")
quote (141 . "@src64/flow.l")
rand (2959 . "@src64/big.l")
range (988 . "@src64/subr.l")
@@ -280,7 +280,7 @@ raw (465 . "@src64/main.l")
rd (5036 . "@src64/io.l")
read (2562 . "@src64/io.l")
replace (1490 . "@src64/subr.l")
-rest (2295 . "@src64/main.l")
+rest (2299 . "@src64/main.l")
reverse (1665 . "@src64/subr.l")
rewind (5002 . "@src64/io.l")
rollback (1890 . "@src64/db.l")
@@ -321,7 +321,7 @@ text (1272 . "@src64/sym.l")
throw (2488 . "@src64/flow.l")
tick (3161 . "@src64/flow.l")
till (3515 . "@src64/io.l")
-time (2514 . "@src64/main.l")
+time (2518 . "@src64/main.l")
touch (1049 . "@src64/sym.l")
trim (1746 . "@src64/subr.l")
try (1172 . "@src64/flow.l")
@@ -330,13 +330,13 @@ udp (268 . "@src64/net.l")
unify (3892 . "@src64/subr.l")
unless (1898 . "@src64/flow.l")
until (2082 . "@src64/flow.l")
-up (712 . "@src64/main.l")
+up (716 . "@src64/main.l")
upp? (3230 . "@src64/sym.l")
uppc (3294 . "@src64/sym.l")
use (1570 . "@src64/flow.l")
-usec (2619 . "@src64/main.l")
+usec (2623 . "@src64/main.l")
val (1463 . "@src64/sym.l")
-version (3004 . "@src64/main.l")
+version (3008 . "@src64/main.l")
wait (3053 . "@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 @@
-/* 16nov10abu
+/* 07dec10abu
* (c) Software Lab. Alexander Burger
*/
@@ -300,7 +300,9 @@ any doEnv(any x) {
Push(c2, EVAL(car(x)));
if (isCell(data(c2))) {
do
- data(c1) = cons(cons(car(data(c2)), val(car(data(c2)))), data(c1));
+ data(c1) = cons(
+ isCell(car(data(c2)))? car(data(c2)) : cons(car(data(c2)), val(car(data(c2)))),
+ data(c1) );
while (isCell(data(c2) = cdr(data(c2))));
}
else if (!isNil(data(c2))) {
diff --git a/src64/main.l b/src64/main.l
@@ -1,4 +1,4 @@
-# 16nov10abu
+# 07dec10abu
# (c) Software Lab. Alexander Burger
### Global return labels ###
@@ -674,9 +674,13 @@
atom E # 'lst'?
if z # Yes
do
- call cons_A # Cons symbol and its value
- ld (A) (E)
- ld (A CDR) ((E))
+ ld A (E) # Already a pair?
+ atom A
+ if nz # No
+ call cons_A # Cons symbol and its value
+ ld (A) (E)
+ ld (A CDR) ((E))
+ end
call consA_C # Cons to result
ld (C) A
ld (C CDR) (L I)
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 01dec10abu
+# 07dec10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 4 16)
+(de *Version 3 0 4 17)
# vi:et:ts=3:sw=3
diff --git a/test/src/main.l b/test/src/main.l
@@ -1,4 +1,4 @@
-# 31may10abu
+# 07dec10abu
# (c) Software Lab. Alexander Burger
### alarm ###
@@ -44,9 +44,9 @@
(test '((B . 2) (A . 1))
(let (A 1 B 2)
(env '(A B)) ) )
-(test '((Y . 8) (B . 2) (A . 1) (X . 7))
+(test '((Y . 8) (C . 3) (B . 2) (A . 1) (X . 7))
(let (A 1 B 2)
- (env 'X 7 '(A B) 'Y 8) ) )
+ (env 'X 7 '(A B (C . 3)) 'Y 8) ) )
### up ###
