commit 2cc9676b2d14a54aef8bd2ee39db4b5e7b989967
parent 3882001fa83c9828c764b6260634e43e15ebe096
Author: Alexander Burger <abu@software-lab.de>
Date: Wed, 31 Jul 2013 13:07:26 +0200
'casq' flow function
Diffstat:
21 files changed, 462 insertions(+), 346 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* DDsep13 picoLisp-3.1.4
+ 'casq' flow function
Pilog Lisp call syntax with '^'
'read' preserves trailing white space
diff --git a/doc/ref.html b/doc/ref.html
@@ -1368,6 +1368,7 @@ NIL
<p>Functions with controlling expressions are
<a href="refC.html#case">case</a>,
+ <a href="refC.html#casq">casq</a>,
<a href="refP.html#prog1">prog1</a>,
<a href="refP.html#prog2">prog2</a>,
and the bodies of <code><a href="refR.html#*Run">*Run</a></code> tasks.
@@ -2208,6 +2209,7 @@ abbreviations:
<a href="refC.html#cond">cond</a>
<a href="refN.html#nond">nond</a>
<a href="refC.html#case">case</a>
+ <a href="refC.html#casq">casq</a>
<a href="refS.html#state">state</a>
<a href="refW.html#while">while</a>
<a href="refU.html#until">until</a>
diff --git a/doc/refC.html b/doc/refC.html
@@ -150,11 +150,32 @@ elements <code>anyN</code> of each clause. If one of them is a list,
<code>T</code> is a catch-all for any value. If a comparison succeeds,
<code>prgN</code> is executed, and the result returned. Otherwise
<code>NIL</code> is returned. See also <code><a
-href="refS.html#state">state</a></code>.
+href="refC.html#casq">casq</a></code> and <code><a
+href="refS.html#state">state</a></code> .
<pre><code>
: (case (char 66) ("A" (+ 1 2 3)) (("B" "C") "Bambi") ("D" (* 1 2 3)))
-> "Bambi"
+: (case 'b (a 1) ("b" 2) (b 3) (c 4))
+-> 2
+</code></pre>
+
+<dt><a name="casq"><code>(casq 'any (any1 . prg1) (any2 . prg2) ..) -> any</code></a>
+<dd>Multi-way branch: <code>any</code> is evaluated and compared to the CAR
+elements <code>anyN</code> of each clause. <code><a
+href="ref_.html#==">==</a></code> is used for comparison (pointer equality). If
+one of them is a list, <code>any</code> is in turn compared to all elements of
+that list. <code>T</code> is a catch-all for any value. If a comparison
+succeeds, <code>prgN</code> is executed, and the result returned. Otherwise
+<code>NIL</code> is returned. See also <code><a
+href="refC.html#case">case</a></code> and <code><a
+href="refS.html#state">state</a></code>.
+
+<pre><code>
+: (casq 'b (a 1) ("b" 2) (b 3) (c 4))
+-> 3
+: (casq 'b (a 1) ("b" 2) ((a b c) 3) (c 4))
+-> 3
</code></pre>
<dt><a name="catch"><code>(catch 'any . prg) -> any</code></a>
diff --git a/ersatz/fun.src b/ersatz/fun.src
@@ -1,4 +1,4 @@
-# 22jul13abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
# Ersatz PicoLisp Functions
@@ -1340,6 +1340,22 @@ case (x y)
}
return Nil;
+# (casq 'any (any1 . prg1) (any2 . prg2) ..) -> any
+casq (x y)
+ At.Car = (ex = ex.Cdr).Car.eval();
+ while ((ex = ex.Cdr) instanceof Cell) {
+ x = ex.Car; y = x.Car;
+ if (y == T || y == At.Car)
+ return x.Cdr.prog();
+ if (y instanceof Cell) {
+ do
+ if (y.Car == At.Car)
+ return x.Cdr.prog();
+ while ((y = y.Cdr) instanceof Cell);
+ }
+ }
+ return Nil;
+
# (state 'var (sym|lst exe [. prg]) ..) -> any
state (w x y z)
z = (x = ex.Cdr).Car.eval();
diff --git a/ersatz/lib.l b/ersatz/lib.l
@@ -1,4 +1,4 @@
-# 19jul13abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
(setq *OS (java (java "java.lang.System" "getProperty" "os.name")))
@@ -274,7 +274,7 @@
### Pretty Printing ###
(de *PP
- T NIL if ifn when unless while until do case state for
+ T NIL if ifn when unless while until do case casq state for
with catch finally ! setq default push bind job use let let?
prog1 recur redef =: in out tab new )
(de *PP1 let let? for redef)
@@ -1294,7 +1294,7 @@
(de xmlrpcValue (Lst)
(let X (caddr Lst)
- (case (car Lst)
+ (casq (car Lst)
(string X)
((i4 int) (format X))
(boolean (= "1" X))
@@ -1519,8 +1519,8 @@
(de dbg (Lst)
(when (pair Lst)
- (case (pop 'Lst)
- ((case state)
+ (casq (pop 'Lst)
+ ((case casq state)
(_dbg Lst)
(for L (cdr Lst)
(map _dbg (cdr L)) ) )
@@ -1711,7 +1711,7 @@
(push '"*Bnd" "X") ) ) ) ) )
((num? (car "X")))
(T
- (case (car "X")
+ (casq (car "X")
((: ::))
(; (lint1 (cadr "X")))
(quote
@@ -1781,7 +1781,7 @@
(lintVar (cdar "Y"))
(mapc lint1 (cddr "Y"))
(lintLoop (cddr "X")) ) ) ) ) )
- ((case state)
+ ((case casq state)
(lint1 (cadr "X"))
(for "X" (cddr "X")
(mapc lint1 (cdr "X")) ) )
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib.l b/lib.l
@@ -1,4 +1,4 @@
-# 20nov12abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
(de task (Key . Prg)
@@ -313,7 +313,7 @@
### Pretty Printing ###
(de *PP
- T NIL if ifn when unless while until do case state for
+ T NIL if ifn when unless while until do case casq state for
with catch finally co ! setq default push bind job use let let?
prog1 later recur redef =: in out ctl tab new )
(de *PP1 let let? for redef)
diff --git a/lib/debug.l b/lib/debug.l
@@ -1,4 +1,4 @@
-# 02jul13abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
# Prompt
@@ -263,8 +263,8 @@
(de dbg (Lst)
(when (pair Lst)
- (case (pop 'Lst)
- ((case state)
+ (casq (pop 'Lst)
+ ((case casq state)
(_dbg Lst)
(for L (cdr Lst)
(map _dbg (cdr L)) ) )
diff --git a/lib/lint.l b/lib/lint.l
@@ -1,4 +1,4 @@
-# 21may10abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
# *NoLint
@@ -40,7 +40,7 @@
(push '"*Bnd" "X") ) ) ) ) )
((num? (car "X")))
(T
- (case (car "X")
+ (casq (car "X")
((: ::))
(; (lint1 (cadr "X")))
(quote
@@ -110,7 +110,7 @@
(lintVar (cdar "Y"))
(mapc lint1 (cddr "Y"))
(lintLoop (cddr "X")) ) ) ) ) )
- ((case state)
+ ((case casq state)
(lint1 (cadr "X"))
(for "X" (cddr "X")
(mapc lint1 (cdr "X")) ) )
diff --git a/lib/map b/lib/map
@@ -1,5 +1,5 @@
-! (2921 . "@src64/flow.l")
-$ (3023 . "@src64/flow.l")
+! (2961 . "@src64/flow.l")
+$ (3063 . "@src64/flow.l")
% (2572 . "@src64/big.l")
& (2807 . "@src64/big.l")
* (2389 . "@src64/big.l")
@@ -38,7 +38,7 @@ argv (3251 . "@src64/main.l")
as (139 . "@src64/flow.l")
asoq (3021 . "@src64/subr.l")
assoc (2986 . "@src64/subr.l")
-at (2109 . "@src64/flow.l")
+at (2149 . "@src64/flow.l")
atom (2386 . "@src64/subr.l")
bind (1362 . "@src64/flow.l")
bit? (2748 . "@src64/big.l")
@@ -46,7 +46,7 @@ bool (1724 . "@src64/flow.l")
box (828 . "@src64/flow.l")
box? (1131 . "@src64/sym.l")
by (1669 . "@src64/apply.l")
-bye (3471 . "@src64/flow.l")
+bye (3511 . "@src64/flow.l")
bytes (2973 . "@src64/subr.l")
caaaar (271 . "@src64/subr.l")
caaadr (288 . "@src64/subr.l")
@@ -62,10 +62,11 @@ caddar (409 . "@src64/subr.l")
cadddr (435 . "@src64/subr.l")
caddr (156 . "@src64/subr.l")
cadr (45 . "@src64/subr.l")
-call (3123 . "@src64/flow.l")
+call (3163 . "@src64/flow.l")
car (5 . "@src64/subr.l")
case (1965 . "@src64/flow.l")
-catch (2467 . "@src64/flow.l")
+casq (2009 . "@src64/flow.l")
+catch (2507 . "@src64/flow.l")
cd (2994 . "@src64/main.l")
cdaaar (464 . "@src64/subr.l")
cdaadr (487 . "@src64/subr.l")
@@ -91,7 +92,7 @@ clip (1800 . "@src64/subr.l")
close (4422 . "@src64/io.l")
cmd (3233 . "@src64/main.l")
cnt (1413 . "@src64/apply.l")
-co (2548 . "@src64/flow.l")
+co (2588 . "@src64/flow.l")
commit (1403 . "@src64/db.l")
con (725 . "@src64/subr.l")
conc (781 . "@src64/subr.l")
@@ -114,8 +115,8 @@ delq (1453 . "@src64/subr.l")
diff (2590 . "@src64/subr.l")
dir (3163 . "@src64/main.l")
dm (545 . "@src64/flow.l")
-do (2141 . "@src64/flow.l")
-e (2984 . "@src64/flow.l")
+do (2181 . "@src64/flow.l")
+e (3024 . "@src64/flow.l")
echo (4453 . "@src64/io.l")
env (609 . "@src64/main.l")
eof (3554 . "@src64/io.l")
@@ -133,15 +134,15 @@ file (3110 . "@src64/main.l")
fill (3256 . "@src64/subr.l")
filter (1161 . "@src64/apply.l")
fin (2034 . "@src64/subr.l")
-finally (2524 . "@src64/flow.l")
+finally (2564 . "@src64/flow.l")
find (1322 . "@src64/apply.l")
fish (1613 . "@src64/apply.l")
flg? (2446 . "@src64/subr.l")
flip (1700 . "@src64/subr.l")
flush (5162 . "@src64/io.l")
fold (3521 . "@src64/sym.l")
-for (2230 . "@src64/flow.l")
-fork (3297 . "@src64/flow.l")
+for (2270 . "@src64/flow.l")
+fork (3337 . "@src64/flow.l")
format (2089 . "@src64/big.l")
free (1960 . "@src64/db.l")
from (3573 . "@src64/io.l")
@@ -169,12 +170,12 @@ inc (2256 . "@src64/big.l")
index (2638 . "@src64/subr.l")
info (3056 . "@src64/main.l")
intern (1007 . "@src64/sym.l")
-ipid (3242 . "@src64/flow.l")
+ipid (3282 . "@src64/flow.l")
isa (967 . "@src64/flow.l")
job (1429 . "@src64/flow.l")
journal (971 . "@src64/db.l")
key (3406 . "@src64/io.l")
-kill (3274 . "@src64/flow.l")
+kill (3314 . "@src64/flow.l")
last (2045 . "@src64/subr.l")
le0 (2693 . "@src64/big.l")
length (2742 . "@src64/subr.l")
@@ -190,7 +191,7 @@ listen (160 . "@src64/net.l")
lit (150 . "@src64/flow.l")
load (4212 . "@src64/io.l")
lock (1185 . "@src64/db.l")
-loop (2173 . "@src64/flow.l")
+loop (2213 . "@src64/flow.l")
low? (3387 . "@src64/sym.l")
lowc (3417 . "@src64/sym.l")
lst? (2416 . "@src64/subr.l")
@@ -239,7 +240,7 @@ on (1717 . "@src64/sym.l")
onOff (1747 . "@src64/sym.l")
one (1780 . "@src64/sym.l")
open (4379 . "@src64/io.l")
-opid (3258 . "@src64/flow.l")
+opid (3298 . "@src64/flow.l")
opt (3354 . "@src64/main.l")
or (1640 . "@src64/flow.l")
out (4255 . "@src64/io.l")
@@ -305,7 +306,7 @@ sp? (727 . "@src64/sym.l")
space (5104 . "@src64/io.l")
split (1593 . "@src64/subr.l")
stack (552 . "@src64/main.l")
-state (2009 . "@src64/flow.l")
+state (2049 . "@src64/flow.l")
stem (1990 . "@src64/subr.l")
str (4049 . "@src64/io.l")
str? (1145 . "@src64/sym.l")
@@ -323,8 +324,8 @@ t (1751 . "@src64/flow.l")
tail (1912 . "@src64/subr.l")
tell (3290 . "@src64/io.l")
text (1407 . "@src64/sym.l")
-throw (2493 . "@src64/flow.l")
-tick (3210 . "@src64/flow.l")
+throw (2533 . "@src64/flow.l")
+tick (3250 . "@src64/flow.l")
till (3640 . "@src64/io.l")
time (2861 . "@src64/main.l")
touch (1181 . "@src64/sym.l")
@@ -335,7 +336,7 @@ type (920 . "@src64/flow.l")
udp (304 . "@src64/net.l")
unify (3931 . "@src64/subr.l")
unless (1901 . "@src64/flow.l")
-until (2085 . "@src64/flow.l")
+until (2125 . "@src64/flow.l")
up (776 . "@src64/main.l")
upp? (3402 . "@src64/sym.l")
uppc (3469 . "@src64/sym.l")
@@ -345,14 +346,14 @@ val (1597 . "@src64/sym.l")
version (3368 . "@src64/main.l")
wait (3180 . "@src64/io.l")
when (1884 . "@src64/flow.l")
-while (2061 . "@src64/flow.l")
+while (2101 . "@src64/flow.l")
wipe (3262 . "@src64/sym.l")
with (1332 . "@src64/flow.l")
wr (5287 . "@src64/io.l")
xchg (1672 . "@src64/sym.l")
xor (1701 . "@src64/flow.l")
x| (2887 . "@src64/big.l")
-yield (2753 . "@src64/flow.l")
+yield (2793 . "@src64/flow.l")
yoke (1197 . "@src64/subr.l")
zap (1195 . "@src64/sym.l")
zero (1765 . "@src64/sym.l")
diff --git a/lib/scrape.l b/lib/scrape.l
@@ -1,4 +1,4 @@
-# 28feb11abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
# *ScrHost *ScrPort *ScrGate *Title *Expect *Found
@@ -25,7 +25,7 @@
"<span id=\""
"<div class=\"error\">"
*Expect )
- (case @
+ (casq @
("303 See Other"
(when (from "Location: http://")
(let L (split (line) ':)
diff --git a/lib/xmlrpc.l b/lib/xmlrpc.l
@@ -1,4 +1,4 @@
-# 13apr11abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
# (xmlrpc "localhost" 8080 "foo.bar" 'int 41 'string "abc" ..)
@@ -40,7 +40,7 @@
(de xmlrpcValue (Lst)
(let X (caddr Lst)
- (case (car Lst)
+ (casq (car Lst)
(string X)
((i4 int) (format X))
(boolean (= "1" X))
diff --git a/src/flow.c b/src/flow.c
@@ -1,4 +1,4 @@
-/* 06may13abu
+/* 31jul13abu
* (c) Software Lab. Alexander Burger
*/
@@ -1032,6 +1032,25 @@ any doCase(any x) {
return Nil;
}
+// (casq 'any (any1 . prg1) (any2 . prg2) ..) -> any
+any doCasq(any x) {
+ any y, z;
+
+ x = cdr(x), val(At) = EVAL(car(x));
+ while (isCell(x = cdr(x))) {
+ y = car(x), z = car(y);
+ if (z == T || z == val(At))
+ return prog(cdr(y));
+ if (isCell(z)) {
+ do
+ if (car(z) == val(At))
+ return prog(cdr(y));
+ while (isCell(z = cdr(z)));
+ }
+ }
+ return Nil;
+}
+
// (state 'var (sym|lst exe [. prg]) ..) -> any
any doState(any ex) {
any x, y, a;
diff --git a/src/pico.h b/src/pico.h
@@ -1,4 +1,4 @@
-/* 28dec12abu
+/* 31jul13abu
* (c) Software Lab. Alexander Burger
*/
@@ -453,6 +453,7 @@ any doCadr(any);
any doCall(any);
any doCar(any);
any doCase(any);
+any doCasq(any);
any doCatch(any);
any doCdaaar(any);
any doCdaadr(any);
diff --git a/src/tab.c b/src/tab.c
@@ -1,4 +1,4 @@
-/* 28dec12abu
+/* 31jul13abu
* (c) Software Lab. Alexander Burger
*/
@@ -55,6 +55,7 @@ static symInit Symbols[] = {
{doCall, "call"},
{doCar, "car"},
{doCase, "case"},
+ {doCasq, "casq"},
{doCatch, "catch"},
{doCdaaar, "cdaaar"},
{doCdaadr, "cdaadr"},
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,1,3,5};
+static byte Version[4] = {3,1,3,6};
diff --git a/src64/flow.l b/src64/flow.l
@@ -1,4 +1,4 @@
-# 05jul13abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
(code 'redefMsgEC)
@@ -2005,6 +2005,46 @@
pop X
ret
+# (casq 'any (any1 . prg1) (any2 . prg2) ..) -> any
+(code 'doCasq 2)
+ push X
+ ld X (E CDR) # Arguments in X
+ ld E (X) # Eval argument item
+ eval
+ ld (At) E
+ do
+ ld X (X CDR) # Next clause
+ atom X # Any?
+ while z # Yes
+ ld C ((X)) # Item(s) in C
+ cmp C TSym # Catch-all?
+ jeq 10 # Yes
+ cmp C E # Equal to argument item?
+ if eq # Yes
+10 ld X ((X) CDR) # Run body
+ prog X
+ pop X
+ ret
+ end
+ atom C # List of items?
+ if z # Yes
+ do
+ cmp (C) E # Argument item member?
+ if eq # Yes
+ ld X ((X) CDR) # Run body
+ prog X
+ pop X
+ ret
+ end
+ ld C (C CDR) # End of list?
+ atom C
+ until nz # Yes
+ end
+ loop
+ ld E Nil # Return NIL
+ pop X
+ ret
+
# (state 'var (sym|lst exe [. prg]) ..) -> any
(code 'doState 2)
push X
diff --git a/src64/glob.l b/src64/glob.l
@@ -1,4 +1,4 @@
-# 28may13abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
(data 'Data)
@@ -284,6 +284,7 @@
initFun NIL "cond" doCond
initFun NIL "nond" doNond
initFun NIL "case" doCase
+ initFun NIL "casq" doCasq
initFun NIL "state" doState
initFun NIL "while" doWhile
initFun NIL "until" doUntil
diff --git a/src64/tags b/src64/tags
@@ -48,119 +48,122 @@
CHAR_LETTER63,1516
CHAR_DIGIT64,1537
-sys/x86-64.linux.defs.l,1959
-ENOENT5,59
-EINTR6,108
-EBADF7,155
-EAGAIN8,194
-EACCES9,227
-EPIPE10,268
-ECONNRESET11,303
-O_RDONLY14,365
-O_WRONLY15,382
-O_RDWR16,399
-O_CREAT17,414
-O_EXCL18,431
-O_TRUNC19,448
-O_APPEND20,466
-F_GETFD21,486
-F_SETFD22,502
-FD_CLOEXEC23,518
-BUFSIZ26,546
-PIPE_BUF27,564
-MAXPATHLEN29,585
-RTLD_LAZY32,613
-RTLD_GLOBAL33,631
-FLOCK36,662
-L_TYPE37,702
-L_WHENCE38,722
-L_START39,744
-L_LEN40,760
-L_PID41,775
-SEEK_SET42,790
-SEEK_CUR43,807
-F_RDLCK44,824
-F_WRLCK45,840
-F_UNLCK46,856
-F_GETFL47,872
-F_SETFL48,888
-F_GETLK49,904
-F_SETLK50,920
-F_SETLKW51,936
-F_SETOWN52,953
-O_NONBLOCK53,970
-O_ASYNC54,992
-STAT57,1019
-ST_MODE58,1061
-ST_SIZE59,1083
-ST_MTIME60,1100
-S_IFMT61,1118
-S_IFDIR62,1144
-TMS65,1180
-TMS_UTIME66,1214
-TMS_STIME67,1232
-TERMIOS70,1261
-C_IFLAG71,1304
-C_LFLAG72,1320
-C_CC73,1337
-ISIG74,1351
-VMIN75,1364
-VTIME76,1377
-TCSADRAIN77,1391
-SIGACTION80,1419
-SIGSET_T81,1462
-SA_HANDLER82,1481
-SA_MASK83,1500
-SA_FLAGS84,1516
-SIG_DFL86,1536
-SIG_IGN87,1552
-SIG_UNBLOCK88,1568
-SIGHUP90,1589
-SIGINT91,1615
-SIGUSR192,1630
-SIGUSR293,1647
-SIGPIPE94,1664
-SIGALRM95,1681
-SIGTERM96,1698
-SIGCHLD97,1715
-SIGCONT98,1732
-SIGSTOP99,1749
-SIGTSTP100,1766
-SIGTTIN101,1783
-SIGTTOU102,1800
-SIGIO103,1817
-SIGNALS104,1832
-WNOHANG107,1894
-WUNTRACED108,1910
-FD_SET111,1938
-TM_SEC114,1975
-TM_MIN115,1990
-TM_HOUR116,2005
-TM_MDAY117,2021
-TM_MON118,2038
-TM_YEAR119,2054
-D_NAME122,2078
-SOCK_STREAM125,2105
-SOCK_DGRAM126,2125
-AF_UNSPEC127,2144
-AF_INET6128,2162
-SOL_SOCKET129,2180
-SO_REUSEADDR130,2199
-IPPROTO_IPV6131,2220
-IPV6_V6ONLY132,2242
-INET6_ADDRSTRLEN133,2263
-NI_MAXHOST135,2290
-NI_NAMEREQD136,2312
-SOCKADDR_IN6138,2333
-SIN6_FAMILY139,2355
-SIN6_PORT140,2375
-SIN6_ADDR141,2393
-ADDRINFO143,2412
-AI_FAMILY144,2430
-AI_SOCKTYPE145,2448
-AI_ADDRLEN146,2468
-AI_ADDR147,2488
-AI_NEXT148,2505
+sys/x86-64.freeBsd.defs.l,1994
+ENOENT5,56
+EINTR6,71
+EBADF7,85
+EAGAIN8,99
+EACCES9,115
+EPIPE10,131
+ECONNRESET11,146
+O_RDONLY14,180
+O_WRONLY15,197
+O_RDWR16,214
+O_CREAT17,229
+O_EXCL18,247
+O_TRUNC19,265
+O_APPEND20,284
+F_GETFD21,301
+F_SETFD22,317
+FD_CLOEXEC23,333
+BUFSIZ26,361
+PIPE_BUF27,379
+MAXPATHLEN28,398
+stdin29,417
+stdout30,442
+stderr31,468
+RTLD_LAZY35,504
+RTLD_GLOBAL36,522
+FLOCK39,553
+L_TYPE40,568
+L_WHENCE41,584
+L_START42,602
+L_LEN43,618
+L_PID44,632
+SEEK_SET45,647
+SEEK_CUR46,664
+F_RDLCK47,681
+F_WRLCK48,697
+F_UNLCK49,713
+F_GETFL50,729
+F_SETFL51,745
+F_GETLK52,761
+F_SETLK53,778
+F_SETLKW54,795
+F_SETOWN55,813
+O_NONBLOCK56,830
+O_ASYNC57,849
+STAT60,874
+ST_MODE61,889
+ST_SIZE62,905
+ST_MTIME63,922
+S_IFMT64,940
+S_IFDIR65,959
+TMS68,988
+TMS_UTIME69,1001
+TMS_STIME70,1019
+TERMIOS73,1048
+C_IFLAG74,1065
+C_LFLAG75,1081
+C_CC76,1098
+ISIG77,1112
+VMIN78,1127
+VTIME79,1141
+TCSADRAIN80,1156
+SIGACTION83,1184
+SIGSET_T84,1203
+SA_HANDLER85,1221
+SA_MASK86,1240
+SA_FLAGS87,1257
+SIG_DFL88,1274
+SIG_IGN89,1290
+SIG_UNBLOCK90,1306
+SIGHUP91,1326
+SIGINT92,1341
+SIGUSR193,1356
+SIGUSR294,1373
+SIGPIPE95,1390
+SIGALRM96,1407
+SIGTERM97,1424
+SIGCHLD98,1441
+SIGCONT99,1458
+SIGSTOP100,1475
+SIGTSTP101,1492
+SIGTTIN102,1509
+SIGTTOU103,1526
+SIGIO104,1543
+SIGNALS105,1558
+WNOHANG108,1583
+WUNTRACED109,1599
+FD_SET112,1627
+TM_SEC115,1652
+TM_MIN116,1667
+TM_HOUR117,1682
+TM_MDAY118,1698
+TM_MON119,1715
+TM_YEAR120,1731
+D_NAME123,1755
+SOCK_STREAM126,1781
+SOCK_DGRAM127,1801
+AF_UNSPEC128,1820
+AF_INET6129,1838
+SOL_SOCKET130,1856
+SO_REUSEADDR131,1879
+IPPROTO_IPV6132,1900
+IPV6_V6ONLY133,1922
+INET6_ADDRSTRLEN134,1943
+NI_MAXHOST135,1969
+NI_NAMEREQD136,1991
+SOCKADDR_IN6137,2011
+SIN6_FAMILY138,2033
+SIN6_PORT139,2053
+SIN6_ADDR140,2071
+ADDRINFO141,2089
+AI_FAMILY142,2107
+AI_SOCKTYPE143,2125
+AI_ADDRLEN144,2145
+AI_ADDR145,2165
+AI_NEXT146,2182
./glob.l,4331
Data4,51
@@ -270,147 +273,147 @@ sys/x86-64.linux.defs.l,1959
Adr180,6608
Fork181,6645
Bye182,6682
-SymTabEnd561,21244
-TgCPU564,21277
-TgOS565,21319
-Db1569,21410
-Extern571,21437
-GcSymEnd575,21508
-Version578,21537
-EnvCo589,21744
-Chr590,21777
-PutB591,21831
-Get_A592,21892
-InFile593,21952
-OutFile594,21998
-Catch595,22045
-Env596,22093
-EnvBind597,22126
-EnvInFrames598,22199
-EnvOutFrames599,22247
-EnvErrFrames600,22296
-EnvCtlFrames601,22344
-EnvIntern602,22394
-EnvArgs603,22467
-EnvNext604,22516
-EnvCls605,22563
-EnvKey606,22611
-EnvApply607,22657
-EnvMake608,22705
-EnvYoke609,22751
-CLink610,22774
-EnvParseX611,22831
-EnvParseC612,22880
-EnvParseEOF613,22903
-EnvMid614,22927
-EnvCo7615,22955
-EnvTask616,23001
-EnvProtect617,23046
-EnvTrace618,23099
-EnvEnd619,23146
-OrgTermio621,23175
-Flock622,23236
-Tms623,23291
-Addr624,23344
-TBuf626,23404
-CaseBlocks631,23541
-CaseData761,38924
-CaseUpper1098,78805
-CaseLower1122,80631
-Tio1147,82337
-Repl1149,82386
-PRepl1150,82431
-Jam1151,82478
-InBye1152,82523
-Sync1153,82570
-Month1154,82632
-_r_1157,82698
-_w_1158,82715
-_a_1159,82732
-_ap_1160,82749
-_dot_1161,82768
-Giveup1165,82821
-ExecErr1166,82847
-AllocErr1167,82883
-PidSigMsg1168,82912
-QuitMsg1169,82945
-CbErr1170,82966
-HashBlank1172,83010
-Redefined1173,83033
-SuperErr1174,83067
-ExtraErr1175,83096
-ThrowErr1176,83125
-Trc11177,83158
-Trc21178,83176
-SetFD1180,83202
-Delim1181,83227
-DelimEnd1182,83268
-Arrow1183,83279
-RolbLog1185,83306
-IgnLog1186,83367
-CircFree1187,83421
-BadChain1188,83459
-BadCount1189,83488
-ErrTok1191,83525
-Dashes1192,83546
-ProtErr1193,83568
-SymNsErr1194,83603
-StkErr1195,83643
-ArgErr1196,83675
-NumErr1197,83705
-CntErr1198,83738
-SymErr1199,83777
-ExtErr1200,83810
-PairErr1201,83852
-AtomErr1202,83889
-LstErr1203,83921
-VarErr1204,83952
-DivErr1205,83987
-RenErr1206,84010
-MakeErr1207,84040
-ReentErr1208,84069
-YieldErr1209,84108
-MsgErr1210,84140
-BrkErr1211,84169
-OpenErr1212,84195
-CloseErr1213,84228
-PipeErr1214,84263
-ForkErr1215,84296
-WaitPidErr1216,84325
-BadFdErr1217,84355
-NoFdErr1218,84381
-EofErr1219,84413
-SuparErr1220,84442
-BadInput1221,84488
-BadDot1222,84522
-SelectErr1223,84555
-WrBytesErr1224,84592
-WrChildErr1225,84629
-WrSyncErr1226,84666
-WrJnlErr1227,84701
-WrLogErr1228,84738
-TruncErr1229,84771
-DbSyncErr1230,84813
-TrSyncErr1231,84852
-LockErr1232,84900
-DbfErr1233,84932
-JnlErr1234,84961
-IdErr1235,84990
-DbRdErr1236,85013
-DbWrErr1237,85043
-DbSizErr1238,85074
-TellErr1239,85105
-IpSocketErr1240,85137
-IpGetsocknameErr1241,85179
-IpV6onlyErr1242,85231
-IpReuseaddrErr1243,85278
-IpBindErr1244,85329
-IpListenErr1245,85367
-UdpOvflErr1246,85409
-UndefErr1247,85443
-DlErr1248,85472
+SymTabEnd562,21284
+TgCPU565,21317
+TgOS566,21359
+Db1570,21450
+Extern572,21477
+GcSymEnd576,21548
+Version579,21577
+EnvCo590,21784
+Chr591,21817
+PutB592,21871
+Get_A593,21932
+InFile594,21992
+OutFile595,22038
+Catch596,22085
+Env597,22133
+EnvBind598,22166
+EnvInFrames599,22239
+EnvOutFrames600,22287
+EnvErrFrames601,22336
+EnvCtlFrames602,22384
+EnvIntern603,22434
+EnvArgs604,22507
+EnvNext605,22556
+EnvCls606,22603
+EnvKey607,22651
+EnvApply608,22697
+EnvMake609,22745
+EnvYoke610,22791
+CLink611,22814
+EnvParseX612,22871
+EnvParseC613,22920
+EnvParseEOF614,22943
+EnvMid615,22967
+EnvCo7616,22995
+EnvTask617,23041
+EnvProtect618,23086
+EnvTrace619,23139
+EnvEnd620,23186
+OrgTermio622,23215
+Flock623,23276
+Tms624,23331
+Addr625,23384
+TBuf627,23444
+CaseBlocks632,23581
+CaseData762,38964
+CaseUpper1099,78845
+CaseLower1123,80671
+Tio1148,82377
+Repl1150,82426
+PRepl1151,82471
+Jam1152,82518
+InBye1153,82563
+Sync1154,82610
+Month1155,82672
+_r_1158,82738
+_w_1159,82755
+_a_1160,82772
+_ap_1161,82789
+_dot_1162,82808
+Giveup1166,82861
+ExecErr1167,82887
+AllocErr1168,82923
+PidSigMsg1169,82952
+QuitMsg1170,82985
+CbErr1171,83006
+HashBlank1173,83050
+Redefined1174,83073
+SuperErr1175,83107
+ExtraErr1176,83136
+ThrowErr1177,83165
+Trc11178,83198
+Trc21179,83216
+SetFD1181,83242
+Delim1182,83267
+DelimEnd1183,83308
+Arrow1184,83319
+RolbLog1186,83346
+IgnLog1187,83407
+CircFree1188,83461
+BadChain1189,83499
+BadCount1190,83528
+ErrTok1192,83565
+Dashes1193,83586
+ProtErr1194,83608
+SymNsErr1195,83643
+StkErr1196,83683
+ArgErr1197,83715
+NumErr1198,83745
+CntErr1199,83778
+SymErr1200,83817
+ExtErr1201,83850
+PairErr1202,83892
+AtomErr1203,83929
+LstErr1204,83961
+VarErr1205,83992
+DivErr1206,84027
+RenErr1207,84050
+MakeErr1208,84080
+ReentErr1209,84109
+YieldErr1210,84148
+MsgErr1211,84180
+BrkErr1212,84209
+OpenErr1213,84235
+CloseErr1214,84268
+PipeErr1215,84303
+ForkErr1216,84336
+WaitPidErr1217,84365
+BadFdErr1218,84395
+NoFdErr1219,84421
+EofErr1220,84453
+SuparErr1221,84482
+BadInput1222,84528
+BadDot1223,84562
+SelectErr1224,84595
+WrBytesErr1225,84632
+WrChildErr1226,84669
+WrSyncErr1227,84706
+WrJnlErr1228,84741
+WrLogErr1229,84778
+TruncErr1230,84811
+DbSyncErr1231,84853
+TrSyncErr1232,84892
+LockErr1233,84940
+DbfErr1234,84972
+JnlErr1235,85001
+IdErr1236,85030
+DbRdErr1237,85053
+DbWrErr1238,85083
+DbSizErr1239,85114
+TellErr1240,85145
+IpSocketErr1241,85177
+IpGetsocknameErr1242,85219
+IpV6onlyErr1243,85271
+IpReuseaddrErr1244,85318
+IpBindErr1245,85369
+IpListenErr1246,85407
+UdpOvflErr1247,85449
+UndefErr1248,85483
+DlErr1249,85512
-./main.l,2242
+./main.l,2261
Code4,51
Ret8,106
Retc10,127
@@ -509,6 +512,7 @@ sys/x86-64.linux.defs.l,1959
putStringB2538,62459
begString2550,62673
endString_E2561,62899
+msec_A2576,63247
doArgs2590,63556
doNext2597,63670
doArg2614,63986
@@ -1042,7 +1046,7 @@ sys/x86-64.linux.defs.l,1959
consNumEA_E1037,24008
consNumEC_E1055,24384
-./flow.l,1611
+./flow.l,1630
redefMsgEC4,51
putSrcEC_E25,589
redefineCE109,3406
@@ -1094,39 +1098,40 @@ sys/x86-64.linux.defs.l,1959
doCond1919,44291
doNond1942,44711
doCase1965,45127
-doState2009,46086
-doWhile2061,47126
-doUntil2085,47518
-doAt2109,47914
-doDo2141,48516
-doLoop2173,49174
-loopX2178,49245
-doFor2230,50819
-loopY_FE2417,56073
-doCatch2467,57446
-caught2483,57782
-doThrow2493,57939
-throwErrZX2518,58492
-doFinally2524,58583
-doCo2548,59123
-resumeCoroutine2577,60035
-doYield2753,66110
-closeCoFilesC2907,70453
-doBreak2921,70716
-brkLoadE_E2929,70868
-doE2984,72468
-doTrace3023,73234
-traceCY3095,75149
-doCall3123,75637
-doTick3210,77829
-doIpid3242,78826
-doOpid3258,79114
-doKill3274,79409
-doFork3297,79844
-forkLispX_FE3310,80065
-doBye3471,84625
-byeE3483,84797
-finishE3495,85108
+doCasq2009,46091
+doState2049,46966
+doWhile2101,48006
+doUntil2125,48398
+doAt2149,48794
+doDo2181,49396
+doLoop2213,50054
+loopX2218,50125
+doFor2270,51699
+loopY_FE2457,56953
+doCatch2507,58326
+caught2523,58662
+doThrow2533,58819
+throwErrZX2558,59372
+doFinally2564,59463
+doCo2588,60003
+resumeCoroutine2617,60915
+doYield2793,66990
+closeCoFilesC2947,71333
+doBreak2961,71596
+brkLoadE_E2969,71748
+doE3024,73348
+doTrace3063,74114
+traceCY3135,76029
+doCall3163,76517
+doTick3250,78709
+doIpid3282,79706
+doOpid3298,79994
+doKill3314,80289
+doFork3337,80724
+forkLispX_FE3350,80945
+doBye3511,85505
+byeE3523,85677
+finishE3535,85988
./subr.l,2147
doCar5,71
@@ -1255,9 +1260,9 @@ sys/x86-64.linux.defs.l,1959
getUdpZ_FB373,9872
putUdpBZ380,10017
-sys/x86-64.linux.code.l,94
-errno_A5,67
-errnoC10,169
-wifstoppedS_F16,287
-wifsignaledS_F21,413
-wtermsigS_A28,568
+sys/x86-64.freeBsd.code.l,94
+errno_A5,64
+errnoC10,158
+wifstoppedS_F21,537
+wifsignaledS_F27,688
+wtermsigS_A36,897
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 19jul13abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 1 3 5)
+(de *Version 3 1 3 6)
# vi:et:ts=3:sw=3
diff --git a/test/src/flow.l b/test/src/flow.l
@@ -1,4 +1,4 @@
-# 06may13abu
+# 31jul13abu
# (c) Software Lab. Alexander Burger
### quote ###
@@ -274,9 +274,17 @@
### case ###
(test 1 (case 'a (a 1) ((b c) 2) (T 3)))
(test 2 (case 'b (a 1) ((b c) 2) (T 3)))
+(test 2 (case '"b" (a 1) ((b c) 2) (T 3)))
(test 2 (case 'c (a 1) ((b c) 2) (T 3)))
+(test 2 (case "c" (a 1) ((b c) 2) (T 3)))
(test 3 (case 'd (a 1) ((b c) 2) (T 3)))
+(test 3 (casq 'a ("a" 1) (("b" "c") 2) (T 3)))
+(test 3 (casq 'b ("a" 1) (("b" "c") 2) (T 3)))
+(test 2 (casq '"b" ("a" 1) (("b" "c") 2) (T 3)))
+(test 2 (casq '"c" ("a" 1) (("b" "c") 2) (T 3)))
+(test 3 (casq 'b (a 1) ("b" 2) ((a b c) 3) (c 4)))
+
### state ###
(off "tst")
@@ -396,7 +404,7 @@
(catch '("No such file")
(in "doesntExist" (foo)) ) )
(test 6
- (case
+ (casq
(catch '("No such file" "Undefined" "expected")
(+ 1 2 3) )
("No such file" (shouldNotComeHere))
