commit 7887c58cd08a6ab3bacb7b7d69336b4034e78083
parent 8d0c34b4d1e00a5a07724209039471ab44525425
Author: Commit-Bot <unknown>
Date: Fri, 30 Apr 2010 12:19:16 +0000
Automatic commit from picoLisp.tgz, From: Fri, 30 Apr 2010 09:19:16 GMT
Diffstat:
14 files changed, 108 insertions(+), 69 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* XXjun10 picoLisp-3.0.3
+ 'format' also accepts 'lst' argument
'adr' function
'dir' can also return '.'-files
diff --git a/ReleaseNotes b/ReleaseNotes
@@ -1,4 +1,4 @@
-19apr10abu
+30apr10abu
(c) Software Lab. Alexander Burger
@@ -16,3 +16,14 @@ B. The function 'not' is included in the group of flow- and logic-functions
C. The line editor "lib/led.l" cycles with TAB also through path names (in
addition to internal symbols).
+
+D. The 'format' number <-> string conversion function now also accepts a list
+ argument. This is like as if 'pack' were built-in. Where
+
+ (format (pack Lst))
+
+ had to be written, now
+
+ (format Lst)
+
+ will also do.
diff --git a/doc/refF.html b/doc/refF.html
@@ -396,12 +396,13 @@ only be called immediately after <code><a href="refT.html#task">task</a></code>.
</code></pre>
<dt><a name="format"><code>(format 'num ['cnt ['sym1 ['sym2]]]) -> sym</code></a>
-<dt><code>(format 'sym ['cnt ['sym1 ['sym2]]]) -> num</code>
-<dd>Converts a number <code>num</code> to a string, or a string <code>sym</code>
-to a number. In both cases, optionally a precision <code>cnt</code>, a
-decimal-separator <code>sym1</code> and a thousands-separator <code>sym2</code>
-can be supplied. Returns <code>NIL</code> if the conversion is unsuccessful. See
-also <code><a href="ref.html#num-io">Numbers</a></code>.
+<dt><code>(format 'sym|lst ['cnt ['sym1 ['sym2]]]) -> num</code>
+<dd>Converts a number <code>num</code> to a string, or a string
+<code>sym|lst</code> to a number. In both cases, optionally a precision
+<code>cnt</code>, a decimal-separator <code>sym1</code> and a
+thousands-separator <code>sym2</code> can be supplied. Returns <code>NIL</code>
+if the conversion is unsuccessful. See also <code><a
+href="ref.html#num-io">Numbers</a></code>.
<pre><code>
: (format 123456789) # Integer conversion
@@ -415,6 +416,8 @@ also <code><a href="ref.html#num-io">Numbers</a></code>.
: (format "123456789") # String to number
-> 123456789
+: (format (1 "23" (4 5 6)))
+-> 123456
: (format "1234567.89" 4) # scaled to four digits
-> 12345678900
: (format "1.234.567,89") # separators not recognized
diff --git a/lib/http.l b/lib/http.l
@@ -1,4 +1,4 @@
-# 21apr10abu
+# 30apr10abu
# (c) Software Lab. Alexander Burger
# *Home *Gate *Host *Port *Port1 *Http1 *Chunked
@@ -249,7 +249,7 @@
((match '(~(chop "User-Agent: ") . @X) L)
(setq *Agent @X) )
((match '(~(chop "Content-@ength: ") . @X) L)
- (setq *ContLen (format (pack @X))) )
+ (setq *ContLen (format @X)) )
((match '(~(chop "Content-@ype: multipart/form-data; boundary=") . @X) L)
(setq
*MPartLim (append '(- -) @X)
@@ -295,7 +295,7 @@
(ht:Pack
(ifn (match '(@V ":" @N ":" @Z) "Var")
"Var"
- (setq @N (format (pack @N)))
+ (setq @N (format @N))
@V ) ) ) )
(when @Z
(setq Val
@@ -330,7 +330,7 @@
(de htArg (Lst)
(case (car Lst)
("$" (intern (ht:Pack (cdr Lst))))
- ("+" (format (pack (cdr Lst))))
+ ("+" (format (cdr Lst)))
("-" (extern (ht:Pack (cdr Lst))))
("_" (mapcar htArg (split (cdr Lst) "_")))
(T (ht:Pack Lst)) ) )
diff --git a/lib/misc.l b/lib/misc.l
@@ -1,4 +1,4 @@
-# 27feb10abu
+# 30apr10abu
# (c) Software Lab. Alexander Burger
# *Allow *Tmp
@@ -261,9 +261,9 @@
(= 3
(length (setq S (split (chop S) C))) )
(date
- (format (pack (car S))) # Year
- (or (format (pack (cadr S))) 0) # Month
- (or (format (pack (caddr S))) 0) ) ) # Day
+ (format (car S)) # Year
+ (or (format (cadr S)) 0) # Month
+ (or (format (caddr S)) 0) ) ) # Day
(and
(format S)
(date
@@ -292,9 +292,9 @@
(and
(match *DateFmt (chop S))
(date
- (format (pack @Y))
- (or (format (pack @M)) 0)
- (or (format (pack @D)) 0) ) ) ) )
+ (format @Y)
+ (or (format @M) 0)
+ (or (format @D) 0) ) ) ) )
(de expDat (S)
(use (@Y @M @D X)
@@ -312,18 +312,18 @@
@M (head 2 (nth (car S) 3))
@Y (nth (car S) 5) ) ) )
(and
- (setq @D (format (pack @D)))
+ (setq @D (format @D))
(date
(nond
(@Y (car (date (date))))
- ((setq X (format (pack @Y))))
+ ((setq X (format @Y)))
((>= X 100)
(+ X
(* 100 (/ (car (date (date))) 100)) ) )
(NIL X) )
(nond
(@M (cadr (date (date))))
- ((setq X (format (pack @M))) 0)
+ ((setq X (format @M)) 0)
((n0 X) (cadr (date (date))))
(NIL X) )
@D ) ) ) )
@@ -369,10 +369,10 @@
(head 2 (car S))
(head 2 (nth (car S) 3))
(nth (car S) 5) ) ) )
- (when (format (pack (car S)))
+ (when (format (car S))
(time @
- (or (format (pack (cadr S))) 0)
- (or (format (pack (caddr S))) 0) ) ) )
+ (or (format (cadr S)) 0)
+ (or (format (caddr S)) 0) ) ) )
(de stamp (Dat Tim)
(default Dat (date) Tim (time T))
diff --git a/lib/scrape.l b/lib/scrape.l
@@ -1,4 +1,4 @@
-# 08apr09abu
+# 30apr10abu
# (c) Software Lab. Alexander Burger
# *ScrHost *ScrPort *Title *Expect *Found
@@ -30,7 +30,7 @@
("<base href=\"http://"
(setq
*ScrHost (rot (cdr (rot (split (till "\"") '/ ':))))
- *ScrPort (format (pack (pop '*ScrHost)))
+ *ScrPort (format (pop '*ScrHost))
*ScrHost (pack *ScrHost) ) )
("<a href=\""
(let Url (till "\"" T)
@@ -96,7 +96,7 @@
(setq
L (split (nth (chop L) 8) '/ ':)
*ScrHost (pack (pop 'L))
- *ScrPort (ifn (format (pack (car L))) 80 (pop 'L) @)
+ *ScrPort (ifn (format (car L)) 80 (pop 'L) @)
L (glue '/ L) ) )
(scrape *ScrHost *ScrPort L) ) )
diff --git a/lib/tags b/lib/tags
@@ -1,13 +1,13 @@
! (2560 . "@src64/flow.l")
$ (2662 . "@src64/flow.l")
-% (2238 . "@src64/big.l")
-& (2459 . "@src64/big.l")
-* (2057 . "@src64/big.l")
-*/ (2114 . "@src64/big.l")
-+ (1839 . "@src64/big.l")
-- (1877 . "@src64/big.l")
+% (2250 . "@src64/big.l")
+& (2471 . "@src64/big.l")
+* (2069 . "@src64/big.l")
+*/ (2126 . "@src64/big.l")
++ (1851 . "@src64/big.l")
+- (1889 . "@src64/big.l")
-> (3788 . "@src64/subr.l")
-/ (2179 . "@src64/big.l")
+/ (2191 . "@src64/big.l")
: (2896 . "@src64/sym.l")
:: (2920 . "@src64/sym.l")
; (2822 . "@src64/sym.l")
@@ -22,8 +22,8 @@ $ (2662 . "@src64/flow.l")
=T (2166 . "@src64/subr.l")
> (2252 . "@src64/subr.l")
>= (2282 . "@src64/subr.l")
->> (2293 . "@src64/big.l")
-abs (2383 . "@src64/big.l")
+>> (2305 . "@src64/big.l")
+abs (2395 . "@src64/big.l")
accept (140 . "@src64/net.l")
adr (511 . "@src64/main.l")
alarm (455 . "@src64/main.l")
@@ -41,7 +41,7 @@ assoc (2903 . "@src64/subr.l")
at (2122 . "@src64/flow.l")
atom (2370 . "@src64/subr.l")
bind (1375 . "@src64/flow.l")
-bit? (2400 . "@src64/big.l")
+bit? (2412 . "@src64/big.l")
bool (1737 . "@src64/flow.l")
box (839 . "@src64/flow.l")
box? (999 . "@src64/sym.l")
@@ -102,7 +102,7 @@ cut (1795 . "@src64/sym.l")
date (1986 . "@src64/main.l")
dbck (2092 . "@src64/db.l")
de (551 . "@src64/flow.l")
-dec (1991 . "@src64/big.l")
+dec (2003 . "@src64/big.l")
def (475 . "@src64/flow.l")
default (1659 . "@src64/sym.l")
del (1850 . "@src64/sym.l")
@@ -144,12 +144,12 @@ from (3333 . "@src64/io.l")
full (1066 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
gc (378 . "@src64/gc.l")
-ge0 (2359 . "@src64/big.l")
+ge0 (2371 . "@src64/big.l")
get (2748 . "@src64/sym.l")
getd (742 . "@src64/sym.l")
getl (3030 . "@src64/sym.l")
glue (1232 . "@src64/sym.l")
-gt0 (2370 . "@src64/big.l")
+gt0 (2382 . "@src64/big.l")
head (1805 . "@src64/subr.l")
heap (481 . "@src64/main.l")
hear (3055 . "@src64/io.l")
@@ -160,7 +160,7 @@ if (1818 . "@src64/flow.l")
if2 (1837 . "@src64/flow.l")
ifn (1878 . "@src64/flow.l")
in (3980 . "@src64/io.l")
-inc (1924 . "@src64/big.l")
+inc (1936 . "@src64/big.l")
index (2609 . "@src64/subr.l")
info (2309 . "@src64/main.l")
intern (875 . "@src64/sym.l")
@@ -187,7 +187,7 @@ loop (2184 . "@src64/flow.l")
low? (3213 . "@src64/sym.l")
lowc (3243 . "@src64/sym.l")
lst? (2387 . "@src64/subr.l")
-lt0 (2348 . "@src64/big.l")
+lt0 (2360 . "@src64/big.l")
lup (2224 . "@src64/sym.l")
made (1098 . "@src64/subr.l")
make (1079 . "@src64/subr.l")
@@ -270,7 +270,7 @@ pwd (2236 . "@src64/main.l")
queue (1918 . "@src64/sym.l")
quit (927 . "@src64/main.l")
quote (141 . "@src64/flow.l")
-rand (2627 . "@src64/big.l")
+rand (2639 . "@src64/big.l")
range (988 . "@src64/subr.l")
rank (2966 . "@src64/subr.l")
raw (433 . "@src64/main.l")
@@ -285,7 +285,7 @@ rot (848 . "@src64/subr.l")
rpc (4981 . "@src64/io.l")
run (332 . "@src64/flow.l")
sect (2513 . "@src64/subr.l")
-seed (2612 . "@src64/big.l")
+seed (2624 . "@src64/big.l")
seek (1141 . "@src64/apply.l")
send (1146 . "@src64/flow.l")
seq (1090 . "@src64/db.l")
@@ -340,8 +340,8 @@ with (1343 . "@src64/flow.l")
wr (4965 . "@src64/io.l")
xchg (1536 . "@src64/sym.l")
xor (1714 . "@src64/flow.l")
-x| (2539 . "@src64/big.l")
+x| (2551 . "@src64/big.l")
yoke (1187 . "@src64/subr.l")
zap (1063 . "@src64/sym.l")
zero (1629 . "@src64/sym.l")
-| (2499 . "@src64/big.l")
+| (2511 . "@src64/big.l")
diff --git a/lib/xm.l b/lib/xm.l
@@ -1,4 +1,4 @@
-# 02jan09abu
+# 30apr10abu
# (c) Software Lab. Alexander Burger
# Check or write header
@@ -88,7 +88,7 @@
(char
(if (= "x" (cadr @X))
(hex (cddr @X))
- (format (pack (cdr @X))) ) ) )
+ (format (cdr @X)) ) ) )
(T @X) ) )
(setq L @Z) ) ) ) ) )
diff --git a/lib/xml.l b/lib/xml.l
@@ -1,4 +1,4 @@
-# 03jan09abu
+# 30apr10abu
# 21jan09 Tomas Hlavaty <kvietaag@seznam.cz>
# Check or write header
@@ -147,7 +147,7 @@
(char
(if (= "x" (cadr @X))
(hex (cddr @X))
- (format (pack (cdr @X))) ) ) )
+ (format (cdr @X)) ) ) )
(T @X) ) )
(setq L @Z) ) ) ) ) )
diff --git a/src/big.c b/src/big.c
@@ -1,4 +1,4 @@
-/* 01mar10abu
+/* 30apr10abu
* (c) Software Lab. Alexander Burger
*/
@@ -562,14 +562,13 @@ double numToDouble(any x) {
}
// (format 'num ['cnt ['sym1 ['sym2]]]) -> sym
-// (format 'sym ['cnt ['sym1 ['sym2]]]) -> num
+// (format 'sym|lst ['cnt ['sym1 ['sym2]]]) -> num
any doFormat(any ex) {
int scl, sep, ign;
any x, y;
cell c1;
x = cdr(ex), Push(c1, EVAL(car(x)));
- NeedAtom(ex,data(c1));
x = cdr(x), y = EVAL(car(x));
scl = isNil(y)? 0 : xCnt(ex, y);
sep = '.';
@@ -584,9 +583,21 @@ any doFormat(any ex) {
ign = symChar(name(y));
}
}
- data(c1) = isNum(data(c1))?
- numToSym(data(c1), scl, sep, ign) :
- symToNum(name(data(c1)), scl, sep, ign) ?: Nil;
+ if (isNum(data(c1)))
+ data(c1) = numToSym(data(c1), scl, sep, ign);
+ else {
+ int i;
+ any nm;
+ cell c2;
+
+ if (isSym(data(c1)))
+ nm = name(data(c1));
+ else {
+ nm = NULL, pack(data(c1), &i, &nm, &c2);
+ nm = nm? data(c2) : Nil;
+ }
+ data(c1) = symToNum(nm, scl, sep, ign) ?: Nil;
+ }
return Pop(c1);
}
diff --git a/src64/arch/x86-64.l b/src64/arch/x86-64.l
@@ -1,4 +1,4 @@
-# 07mar10abu
+# 30apr10abu
# (c) Software Lab. Alexander Burger
# Byte order
@@ -56,7 +56,7 @@
(setq Src (chop Src))
(when (= "$" (pop 'Src))
(and (= "~" (car Src)) (pop 'Src))
- (format (pack Src)) ) )
+ (format Src) ) )
(de target (Adr F)
(if
@@ -67,7 +67,7 @@
(and
(match '(@L "_" @N) (chop Adr)) # Local jump "foo_22"
(= @L (chop *Label))
- (format (pack @N)) ) ) )
+ (format @N) ) ) )
Adr
(ifn F
(pack Adr "@plt")
diff --git a/src64/big.l b/src64/big.l
@@ -1,4 +1,4 @@
-# 02mar10abu
+# 30apr10abu
# (c) Software Lab. Alexander Burger
### Destructive primitives ###
@@ -1765,7 +1765,7 @@
ret
# (format 'num ['cnt ['sym1 ['sym2]]]) -> sym
-# (format 'sym ['cnt ['sym1 ['sym2]]]) -> num
+# (format 'sym|lst ['cnt ['sym1 ['sym2]]]) -> num
(code 'doFormat 2)
push X
push Y
@@ -1776,8 +1776,6 @@
link
push E # <L I> 'num' | 'sym'
link
- atom E # Need atom
- jz atomErrEX
ld Y (Y CDR) # Second arg
ld E (Y)
eval # Eval 'cnt'
@@ -1816,14 +1814,28 @@
end
pop (Sep3) # Get Sep3
pop (Sep0) # and Sep0
- pop A # Get scale
ld E (L I) # Get 'num' | 'sym'
num E # Number?
if nz # Yes
+ pop A # Get scale
call fmtNumAE_E # Convert to string
else
- ld X (E TAIL)
- call nameX_X # Get name
+ sym E # Symbol?
+ if nz # Yes
+ ld X (E TAIL)
+ call nameX_X # Get name
+ else
+ link
+ push ZERO # <L II> Number safe
+ push ZERO # <L I> Result
+ ld C 4 # Build name
+ ld X S
+ link
+ call packECX_CX
+ ld X (L I) # Get result
+ drop
+ end
+ pop A # Get scale
call symToNumXA_FE # Convert to number
if nc # Failed
ld E Nil
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 29apr10abu
+# 30apr10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 2 16)
+(de *Version 3 0 2 17)
# vi:et:ts=3:sw=3
diff --git a/test/src/big.l b/test/src/big.l
@@ -1,4 +1,4 @@
-# 09sep09abu
+# 30apr10abu
# (c) Software Lab. Alexander Burger
### format ###
@@ -13,6 +13,7 @@
(test 12345678900 (format "1234567,89" 4 ","))
(test NIL (format "1.234.567,89" 4 ","))
(test 12345678900 (format "1.234.567,89" 4 "," "."))
+(test 123456 (format (1 "23" (4 5 6))))
### + ###
