clisp-cvs Digest, Vol 27, Issue 41

View: New views

1 Messages — Rating Filter: Alert me

clisp-cvs Digest, Vol 27, Issue 41

by clisp-cvs-request :: Rate this Message:

Reply to Author | View Threaded | Show Only this Message

Send clisp-cvs mailing list submissions to
clisp-cvs@...

To subscribe or unsubscribe via the World Wide Web, visit
https://lists.sourceforge.net/lists/listinfo/clisp-cvs
or, via email, send a message with subject or body 'help' to
clisp-cvs-request@...

You can reach the person managing the list at
clisp-cvs-owner@...

When replying, please edit your Subject line so it is more specific
than "Re: Contents of clisp-cvs digest..."

CLISP CVS commits for today

Today's Topics:

1. clisp/src ChangeLog,1.6421,1.6422 stream.d,1.614,1.615
(Sam Steingold)
2. clisp/src debug.d,1.120,1.121 (Sam Steingold)
3. clisp/src ChangeLog,1.6422,1.6423 makemake.in,1.765,1.766
(Sam Steingold)
4. clisp/modules/pcre cpcre.c,1.42,1.43 pcre.xml,1.13,1.14
(Sam Steingold)
5. clisp/src ChangeLog,1.6423,1.6424 (Sam Steingold)
6. clisp/src ChangeLog,1.6424,1.6425 lispbibl.d,1.805,1.806
(Sam Steingold)
7. clisp/doc impbody.xml,1.526,1.527 (Sam Steingold)
8. clisp/src makemake.in,1.766,1.767 (Sam Steingold)
9. clisp/tests ChangeLog,1.573,1.574 eval20.tst,1.16,1.17
(Sam Steingold)
10. clisp/src ChangeLog,1.6425,1.6426 compiler.lisp,1.332,1.333
(Sam Steingold)

----------------------------------------------------------------------

Message: 1
Date: Tue, 22 Jul 2008 19:36:31 +0000
From: Sam Steingold <sds@...>
Subject: clisp/src ChangeLog,1.6421,1.6422 stream.d,1.614,1.615
To: clisp-cvs@...
Message-ID: <E1KLNf0-00042K-24@...>

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv20709/src

Modified Files:
ChangeLog stream.d
Log Message:
(error_value_stream): print the caller

Index: stream.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/stream.d,v
retrieving revision 1.614
retrieving revision 1.615
diff -u -d -r1.614 -r1.615
--- stream.d 22 Jul 2008 17:03:07 -0000 1.614
+++ stream.d 22 Jul 2008 19:36:28 -0000 1.615
@@ -14994,10 +14994,11 @@
pushSTACK(S(stream)); /* TYPE-ERROR slot EXPECTED-TYPE */
pushSTACK(Symbol_value(sym)); /* variable value */
pushSTACK(sym); /* variable */
+ pushSTACK(TheSubr(subr_self)->name);
if (!streamp(Symbol_value(sym))) {
- error(type_error,GETTEXT("The value of ~S is not a stream: ~S"));
+ error(type_error,GETTEXT("~S: The value of ~S is not a stream: ~S"));
} else {
- error(type_error,GETTEXT("The value of ~S is not an appropriate stream: ~S"));
+ error(type_error,GETTEXT("~S: The value of ~S is not an appropriate stream: ~S"));
}
}
sym = popSTACK();
@@ -15009,7 +15010,8 @@
pushSTACK(stream); /* new variable value */
pushSTACK(oldvalue); /* old variable value */
pushSTACK(sym); /* Variable */
- error(type_error,GETTEXT("The value of ~S was not an appropriate stream: ~S. It has been changed to ~S."));
+ pushSTACK(TheSubr(subr_self)->name);
+ error(type_error,GETTEXT("~S: The value of ~S was not an appropriate stream: ~S. It has been changed to ~S."));
}

#ifdef GNU_READLINE

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.6421
retrieving revision 1.6422
diff -u -d -r1.6421 -r1.6422
--- ChangeLog 22 Jul 2008 17:32:43 -0000 1.6421
+++ ChangeLog 22 Jul 2008 19:36:27 -0000 1.6422
@@ -1,5 +1,9 @@
2008-07-22 Sam Steingold <sds@...>

+ * stream.d (error_value_stream): print the caller
+
+2008-07-22 Sam Steingold <sds@...>
+
* spvw_sigsegv.d (print_mem_stats): also print a timescore_t

2008-07-22 Sam Steingold <sds@...>

------------------------------

Message: 2
Date: Tue, 22 Jul 2008 22:22:08 +0000
From: Sam Steingold <sds@...>
Subject: clisp/src debug.d,1.120,1.121
To: clisp-cvs@...
Message-ID: <E1KLQFE-0000Mj-Jr@...>

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv18385/src

Modified Files:
debug.d
Log Message:
(%ROOM) [!intQsize]: fix last patch
Reported by Michael Kappert <michael.kappert@...>

Index: debug.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/debug.d,v
retrieving revision 1.120
retrieving revision 1.121
diff -u -d -r1.120 -r1.121
--- debug.d 22 Jul 2008 17:10:24 -0000 1.120
+++ debug.d 22 Jul 2008 22:22:05 -0000 1.121
@@ -1568,7 +1568,7 @@
#ifdef intQsize
pushSTACK(UQ_to_I(gc_space));
#else
- pushSTACK(UL2_to_I(gc_space));
+ pushSTACK(UL2_to_I(gc_space.hi,gc_space.lo));
#endif
pushSTACK(internal_time_to_I(&gc_time));
STACK_to_mv(6);

------------------------------

Message: 3
Date: Tue, 22 Jul 2008 22:24:24 +0000
From: Sam Steingold <sds@...>
Subject: clisp/src ChangeLog,1.6422,1.6423 makemake.in,1.765,1.766
To: clisp-cvs@...
Message-ID: <E1KLQHR-0001vb-Cy@...>

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv19230/src

Modified Files:
ChangeLog makemake.in
Log Message:
(check-script): many more tests

Index: makemake.in
===================================================================
RCS file: /cvsroot/clisp/clisp/src/makemake.in,v
retrieving revision 1.765
retrieving revision 1.766
diff -u -d -r1.765 -r1.766
--- makemake.in 21 Jul 2008 23:26:26 -0000 1.765
+++ makemake.in 22 Jul 2008 22:24:22 -0000 1.766
@@ -3096,10 +3096,28 @@
echotab "\$(RM) fresh-line.out"
echol

- # check that scripting works
+ # check that the scripting works
echol "check-script : lisp${LEXE} lispinit.mem"
echotab "test \`echo '(print (+ 11 99))' | \$(RUN) -q -M lispinit.mem -\` = 110 || exit 1"
echotab "test \"\`echo '(+ foo bar)' | \$(RUN) -q -M lispinit.mem -x '(setq foo 11 bar 99)' -repl | tr '\n' '_'\`\" = '99_[1]> _110_' || exit 1"
+ echotab "echo '(progn (setf (stream-element-type *standard-input*) (quote (unsigned-byte 8))) (exit 42))' | \$(RUN) -q -M lispinit.mem -; test \$\$? = 42 || exit 1"
+ echotab "test \`echo '(setf (stream-element-type *standard-output*) (quote (unsigned-byte 8))) (write-sequence (convert-string-to-bytes \"42\" charset:ascii) *standard-output*) (setf (stream-element-type *standard-output*) (quote character)) (terpri)' | ./lisp.run -B . -N locale -E UTF-8 -Epathname 1:1 -Emisc 1:1 -norc -q -M lispinit.mem - | cat\` = 42 || exit 1"
+ echotab "\$(RM) script.lisp; echo '(+ 11 99)' > script.lisp"
+ echotab "test \`\$(RUN) -q -M lispinit.mem < script.lisp\` = 110 || exit 1"
+ echotab "\$(RM) script.lisp; echo '(print (+ 11 99))' > script.lisp"
+ echotab "test \`\$(RUN) -q -M lispinit.mem script.lisp\` = 110 || exit 1"
+ echotab "\$(RM) script.lisp; echo '(+ foo bar)' > script.lisp"
+ echotab "test \`\$(RUN) -q -M lispinit.mem -x '(setq foo 11 bar 99)' -repl < script.lisp | tr '\n' '_'\` = 99_110_ || exit 1"
+ # "-x with lisp-file is invalid"
+ # echotab "\$(RM) script.lisp; echo '(print (+ foo bar))' > script.lisp"
+ # echotab "test \`\$(RUN) -q -M lispinit.mem -x '(setq foo 11 bar 99)' -repl script.lisp | tr '\n' '_'\` = 99_110_ || exit 1"
+ echotab "\$(RM) script.lisp; echo '(progn (setf (stream-element-type *standard-input*) (quote (unsigned-byte 8))) (exit 42))' > script.lisp"
+ echotab "\$(RUN) -q -M lispinit.mem < script.lisp; test \$\$? = 42 || exit 1"
+ echotab "\$(RUN) -q -M lispinit.mem script.lisp; test \$\$? = 42 || exit 1"
+ echotab "\$(RM) script.lisp; echo '(setf (stream-element-type *standard-output*) (quote (unsigned-byte 8))) (write-sequence (convert-string-to-bytes \"42\" charset:ascii) *standard-output*) (setf (stream-element-type *standard-output*) (quote character)) (terpri)' > script.lisp"
+ # ??? echotab "test \`\$(RUN) -q -M lispinit.mem < script.lisp | cat\` = 42 || exit 1"
+ echotab "test \`\$(RUN) -q -M lispinit.mem script.lisp | cat\` = 42 || exit 1"
+ echotab "\$(RM) script.lisp"
echol

# check that the executable images work

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.6422
retrieving revision 1.6423
diff -u -d -r1.6422 -r1.6423
--- ChangeLog 22 Jul 2008 19:36:27 -0000 1.6422
+++ ChangeLog 22 Jul 2008 22:24:22 -0000 1.6423
@@ -1,5 +1,9 @@
2008-07-22 Sam Steingold <sds@...>

+ * makemake.in (check-script): many more tests
+
+2008-07-22 Sam Steingold <sds@...>
+
* stream.d (error_value_stream): print the caller

2008-07-22 Sam Steingold <sds@...>

------------------------------

Message: 4
Date: Tue, 22 Jul 2008 22:26:41 +0000
From: Sam Steingold <sds@...>
Subject: clisp/modules/pcre cpcre.c,1.42,1.43 pcre.xml,1.13,1.14
To: clisp-cvs@...
Message-ID: <E1KLQJe-0002v3-Nu@...>

Update of /cvsroot/clisp/clisp/modules/pcre
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv19963/modules/pcre

Modified Files:
cpcre.c pcre.xml
Log Message:
(PCRE-COMPILE): fix a typo: UNGREADY->UNGREEDY
Reported by Todd Kirby <ffmpeg.php@...>

Index: pcre.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/pcre/pcre.xml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- pcre.xml 16 Oct 2006 04:31:29 -0000 1.13
+++ pcre.xml 22 Jul 2008 22:26:39 -0000 1.14
@@ -26,7 +26,7 @@
<varlistentry id="pcre-compile">
<term><code>(PCRE:PCRE-COMPILE &string-r; &key-amp; :STUDY
:IGNORE-CASE :MULTILINE :DOTALL :EXTENDED :ANCHORED :DOLLAR-ENDONLY
- :EXTRA :NOTBOL :NOTEOL :UNGREADY :NOTEMPTY :NO-AUTO-CAPTURE)</code></term>
+ :EXTRA :NOTBOL :NOTEOL :UNGREEDY :NOTEMPTY :NO-AUTO-CAPTURE)</code></term>
<listitem><simpara>Compile a pattern, optionally study it.
</simpara></listitem></varlistentry>
<varlistentry id="pattern-info"><term>

Index: cpcre.c
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/pcre/cpcre.c,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -d -r1.42 -r1.43
--- cpcre.c 31 May 2008 11:35:47 -0000 1.42
+++ cpcre.c 22 Jul 2008 22:26:39 -0000 1.43
@@ -79,7 +79,7 @@
NOTBOL NOTEOL UNGREEDY NOTEMPTY UTF8 NO-AUTO-CAPTURE NO-UTF8-CHECK \
AUTO-CALLOUT PARTIAL)
DEFUN(PCRE:PCRE-COMPILE,string &key STUDY IGNORE-CASE MULTILINE DOTALL \
- EXTENDED ANCHORED DOLLAR-ENDONLY EXTRA NOTBOL NOTEOL UNGREADY \
+ EXTENDED ANCHORED DOLLAR-ENDONLY EXTRA NOTBOL NOTEOL UNGREEDY \
NOTEMPTY NO-AUTO-CAPTURE AUTO-CALLOUT PARTIAL)
{ /* compile the pattern, return PATTERN struct */
int options = PCRE_UTF8 | pcre_compile_flags();

------------------------------

Message: 5
Date: Tue, 22 Jul 2008 22:26:41 +0000
From: Sam Steingold <sds@...>
Subject: clisp/src ChangeLog,1.6423,1.6424
To: clisp-cvs@...
Message-ID: <E1KLQJe-0002v6-P9@...>

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv19963/src

Modified Files:
ChangeLog
Log Message:
(PCRE-COMPILE): fix a typo: UNGREADY->UNGREEDY
Reported by Todd Kirby <ffmpeg.php@...>

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.6423
retrieving revision 1.6424
diff -u -d -r1.6423 -r1.6424
--- ChangeLog 22 Jul 2008 22:24:22 -0000 1.6423
+++ ChangeLog 22 Jul 2008 22:26:39 -0000 1.6424
@@ -1,5 +1,10 @@
2008-07-22 Sam Steingold <sds@...>

+ * modules/pcre/cpcre.c (PCRE-COMPILE): fix a typo: UNGREADY->UNGREEDY
+ Reported by Todd Kirby <ffmpeg.php@...>
+
+2008-07-22 Sam Steingold <sds@...>
+
* makemake.in (check-script): many more tests

2008-07-22 Sam Steingold <sds@...>

------------------------------

Message: 6
Date: Tue, 22 Jul 2008 22:36:20 +0000
From: Sam Steingold <sds@...>
Subject: clisp/src ChangeLog,1.6424,1.6425 lispbibl.d,1.805,1.806
To: clisp-cvs@...
Message-ID: <E1KLQSz-0007mL-17@...>

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv23684/src

Modified Files:
ChangeLog lispbibl.d
Log Message:
(OBJECT_OUT, NOBJECT_OUT): fflush stdout

Index: lispbibl.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v
retrieving revision 1.805
retrieving revision 1.806
diff -u -d -r1.805 -r1.806
--- lispbibl.d 22 Jul 2008 17:10:24 -0000 1.805
+++ lispbibl.d 22 Jul 2008 22:36:17 -0000 1.806
@@ -9566,13 +9566,13 @@
this can trigger GC, but will save and restore OBJ */
#define OBJECT_OUT(obj,label) \
(printf("[%s:%d] %s: %s:\n",__FILE__,__LINE__,STRING(obj),label), \
- obj=object_out(obj))
+ fflush(stdout), obj=object_out(obj))
/* print the object to a C stream - not all objects can be handled yet!
non-consing, STACK non-modifying */
extern maygc object nobject_out (FILE* out, object obj);
#define NOBJECT_OUT(obj,label) \
(printf("[%s:%d] %s: %s: ",__FILE__,__LINE__,STRING(obj),label), \
- nobject_out(stdout,obj), printf("\n"))
+ nobject_out(stdout,obj), printf("\n"), fflush(stdout))
/* used for debugging purposes */
%% puts("extern object object_out (object obj);");
%% puts("#define OBJECT_OUT(obj,label) (printf(\"[%s:%d] %s: %s:\\n\",__FILE__,__LINE__,STRING(obj),label),obj=object_out(obj))");

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.6424
retrieving revision 1.6425
diff -u -d -r1.6424 -r1.6425
--- ChangeLog 22 Jul 2008 22:26:39 -0000 1.6424
+++ ChangeLog 22 Jul 2008 22:36:17 -0000 1.6425
@@ -1,5 +1,9 @@
2008-07-22 Sam Steingold <sds@...>

+ * lispbibl.d (OBJECT_OUT, NOBJECT_OUT): fflush stdout
+
+2008-07-22 Sam Steingold <sds@...>
+
* modules/pcre/cpcre.c (PCRE-COMPILE): fix a typo: UNGREADY->UNGREEDY
Reported by Todd Kirby <ffmpeg.php@...>

------------------------------

Message: 7
Date: Wed, 23 Jul 2008 14:17:15 +0000
From: Sam Steingold <sds@...>
Subject: clisp/doc impbody.xml,1.526,1.527
To: clisp-cvs@...
Message-ID: <E1KLf9X-0007Ve-FA@...>

Update of /cvsroot/clisp/clisp/doc
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv19302

Modified Files:
impbody.xml
Log Message:
(stream-eltype-stdio): add a warning to stream-eltype

Index: impbody.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v
retrieving revision 1.526
retrieving revision 1.527
diff -u -d -r1.526 -r1.527
--- impbody.xml 22 Jul 2008 17:10:22 -0000 1.526
+++ impbody.xml 23 Jul 2008 14:17:12 -0000 1.527
@@ -4343,6 +4343,13 @@
&stream-element-type;)</code> are &generic-function-t;s, see
<xref linkend="gray"/>.</para>

+<warning id="stream-eltype-stdio"><simpara>&clisp; expects to be able to
+ do &character-t; i/o on standard streams like &terminal-io-var;,
+ &standard-output-var;, &standard-input-var;, &error-output-var;,
+ &query-io-var; et al, thus is is a <emphasis>very</emphasis> bad idea
+ to change their &stream-element-type; even when you can. Use
+ &make-stream; instead, see <xref linkend="bin-stdio"/>.</simpara></warning>
+
<section id="bin-stdio"><title>Binary input from &standard-input-var;</title>

<para>Note that you cannot change &stream-element-type; for some

------------------------------

Message: 8
Date: Wed, 23 Jul 2008 14:29:48 +0000
From: Sam Steingold <sds@...>
Subject: clisp/src makemake.in,1.766,1.767
To: clisp-cvs@...
Message-ID: <E1KLfLg-0003tw-FC@...>

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv23729/src

Modified Files:
makemake.in
Log Message:
(check-script): two more tests

Index: makemake.in
===================================================================
RCS file: /cvsroot/clisp/clisp/src/makemake.in,v
retrieving revision 1.766
retrieving revision 1.767
diff -u -d -r1.766 -r1.767
--- makemake.in 22 Jul 2008 22:24:22 -0000 1.766
+++ makemake.in 23 Jul 2008 14:29:45 -0000 1.767
@@ -3117,6 +3117,9 @@
echotab "\$(RM) script.lisp; echo '(setf (stream-element-type *standard-output*) (quote (unsigned-byte 8))) (write-sequence (convert-string-to-bytes \"42\" charset:ascii) *standard-output*) (setf (stream-element-type *standard-output*) (quote character)) (terpri)' > script.lisp"
# ??? echotab "test \`\$(RUN) -q -M lispinit.mem < script.lisp | cat\` = 42 || exit 1"
echotab "test \`\$(RUN) -q -M lispinit.mem script.lisp | cat\` = 42 || exit 1"
+ echotab "\$(RM) script.lisp; echo '(with-open-stream (s (make-stream :output :element-type (quote (unsigned-byte 8)))) (write-sequence (convert-string-to-bytes \"42\" charset:ascii) s) (values))' > script.lisp"
+ echotab "test \`\$(RUN) -q -M lispinit.mem < script.lisp\` = 42 || exit 1"
+ echotab "test \`\$(RUN) -q -M lispinit.mem script.lisp\` = 42 || exit 1"
echotab "\$(RM) script.lisp"
echol

------------------------------

Message: 9
Date: Wed, 23 Jul 2008 15:30:52 +0000
From: Sam Steingold <sds@...>
Subject: clisp/tests ChangeLog,1.573,1.574 eval20.tst,1.16,1.17
To: clisp-cvs@...
Message-ID: <E1KLgIo-0001u2-4D@...>

Update of /cvsroot/clisp/clisp/tests
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv13066/tests

Modified Files:
ChangeLog eval20.tst
Log Message:
add examples from http://www.lisp.org/HyperSpec/Body/speope_fletcm_scm_macrolet.html

Index: eval20.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/eval20.tst,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- eval20.tst 9 Jul 2008 14:30:54 -0000 1.16
+++ eval20.tst 23 Jul 2008 15:30:50 -0000 1.17
@@ -194,6 +194,80 @@
(list (let ((y 25)) (makunbound 'y) (list (symbol-value 'y) y)) y)))
((251 25) 1)

+;;; http://www.lisp.org/HyperSpec/Body/speope_fletcm_scm_macrolet.html
+(flet ((flet1 (n) (+ n n)))
+ (flet ((flet1 (n) (+ 2 (flet1 n))))
+ (flet1 2)))
+6
+
+(progn
+ (defun dummy-function () 'top-level)
+ (list
+ (funcall #'dummy-function)
+ (flet ((dummy-function () 'shadow))
+ (funcall #'dummy-function))
+ (eq (funcall #'dummy-function) (funcall 'dummy-function))
+ (flet ((dummy-function () 'shadow))
+ (eq (funcall #'dummy-function)
+ (funcall 'dummy-function)))))
+(TOP-LEVEL SHADOW T NIL)
+
+(progn (defun recursive-times (k n)
+ (labels ((temp (n)
+ (if (zerop n) 0 (+ k (temp (1- n))))))
+ (temp n)))
+ (recursive-times 2 3))
+6
+
+(progn
+ (defmacro mlets (x &environment env)
+ (let ((form `(babbit ,x)))
+ (macroexpand form env)))
+ (macrolet ((babbit (z) `(+ ,z ,z))) (mlets 5)))
+10
+
+(flet ((safesqrt (x) (sqrt (abs x))))
+ ;; The safesqrt function is used in two places.
+ (safesqrt (apply #'+ (map 'list #'safesqrt '(1 2 3 4 5 6)))))
+3.2911735
+
+(progn
+ (defun integer-power (n k)
+ (declare (integer n))
+ (declare (type (integer 0 *) k))
+ (labels ((expt0 (x k a)
+ (declare (integer x a) (type (integer 0 *) k))
+ (cond ((zerop k) a)
+ ((evenp k) (expt1 (* x x) (floor k 2) a))
+ (t (expt0 (* x x) (floor k 2) (* x a)))))
+ (expt1 (x k a)
+ (declare (integer x a) (type (integer 0 *) k))
+ (cond ((evenp k) (expt1 (* x x) (floor k 2) a))
+ (t (expt0 (* x x) (floor k 2) (* x a))))))
+ (expt0 n k 1)))
+ (integer-power 3 5))
+243
+
+(progn
+ (defun example (y l)
+ (flet ((attach (x)
+ (setq l (append l (list x)))))
+ (declare (inline attach))
+ (dolist (x y)
+ (unless (null (cdr x))
+ (attach x)))
+ l))
+ (example '((a apple apricot) (b banana) (c cherry) (d) (e))
+ '((1) (2) (3) (4 2) (5) (6 3 2))))
+((1) (2) (3) (4 2) (5) (6 3 2) (A APPLE APRICOT) (B BANANA) (C CHERRY))

;; Clean up.
-(progn (symbol-cleanup 'setf-foo) (symbol-cleanup 'bar) (symbol-cleanup 'x)) T
+(progn (symbol-cleanup 'setf-foo)
+ (symbol-cleanup 'bar)
+ (symbol-cleanup 'x)
+ (symbol-cleanup 'dummy-function)
+ (symbol-cleanup 'recursive-times)
+ (symbol-cleanup 'mlets)
+ (symbol-cleanup 'integer-power)
+ (symbol-cleanup 'example))
+T

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v
retrieving revision 1.573
retrieving revision 1.574
diff -u -d -r1.573 -r1.574
--- ChangeLog 22 Jul 2008 03:02:20 -0000 1.573
+++ ChangeLog 23 Jul 2008 15:30:50 -0000 1.574
@@ -1,3 +1,8 @@
+2008-07-23 Sam Steingold <sds@...>
+
+ * eval20.tst: add examples from
+ http://www.lisp.org/HyperSpec/Body/speope_fletcm_scm_macrolet.html
+
2008-07-21 Sam Steingold <sds@...>

* type.tst: check that the sets of declaration and type names are

------------------------------

Message: 10
Date: Wed, 23 Jul 2008 16:05:51 +0000
From: Sam Steingold <sds@...>
Subject: clisp/src ChangeLog,1.6425,1.6426 compiler.lisp,1.332,1.333
To: clisp-cvs@...
Message-ID: <E1KLgqe-0003Xw-Ka@...>

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv25893/src

Modified Files:
ChangeLog compiler.lisp
Log Message:
(cons-*fenv*): add
(add-fenv, c-FLET, c-FUNCTION-MACRO-LET, c-GENERIC-FLET, c-MACROLET): use it

Index: compiler.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/compiler.lisp,v
retrieving revision 1.332
retrieving revision 1.333
diff -u -d -r1.332 -r1.333
--- compiler.lisp 22 Jul 2008 03:02:20 -0000 1.332
+++ compiler.lisp 23 Jul 2008 16:05:49 -0000 1.333
@@ -1571,6 +1571,8 @@
(defun push-*denv* (declspecs)
(setq *denv* (nreconc declspecs *denv*)))

+;; cons specs on top of *fenv*
+(defun cons-*fenv* (specs) (apply #'vector (nreverse (cons *fenv* specs))))

;;;;**** FUNCTION MANAGEMENT

@@ -5354,7 +5356,7 @@
(fenvconslistr ,fenvconslist (cdr fenvconslistr))
(L nil))
((null namelistr)
- (apply #'vector (nreverse (cons *fenv* L))))
+ (cons-*fenv* L))
(push (car namelistr) L)
(push (car fenvconslistr) L)))
(get-anode (type)
@@ -5415,7 +5417,7 @@
((null namelistr)
(values (nreverse vfnodelist) (nreverse varlist)
(nreverse anodelist)
- (apply #'vector (nreverse (cons *fenv* fenv)))))
+ (cons-*fenv* fenv)))
(push (car namelistr) fenv)
(let ((fnode (car fnodelistr)))
(if (zerop (fnode-keyword-offset fnode))
@@ -5598,7 +5600,7 @@
((null namelistr)
(values (nreverse vfnodelist) (nreverse varlist)
(nreverse anodelist)
- (apply #'vector (nreverse (cons *fenv* fenv)))))
+ (cons-*fenv* fenv)))
(push (car namelistr) fenv)
(let ((fnode (car fnodelistr))
(macro (car macrolistr)))
@@ -5668,7 +5670,7 @@
(fenv '()))
((null namelistr)
(values (nreverse varlist) (nreverse anodelist)
- (apply #'vector (nreverse (cons *fenv* fenv)))))
+ (cons-*fenv* fenv)))
(push (car namelistr) fenv)
(push (c-form (car formlistr) 'ONE) anodelist)
(push 1 *stackz*)
@@ -5750,7 +5752,7 @@
(do ((L1 (second *form*) (cdr L1))
(L2 '()))
((null L1)
- (let ((*fenv* (apply #'vector (nreverse (cons *fenv* L2)))))
+ (let ((*fenv* (cons-*fenv* L2)))
;; compile the remaining forms:
(funcall c `(PROGN ,@(skip-declarations (cddr *form*))))))
(let* ((macrodef (car L1))

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.6425
retrieving revision 1.6426
diff -u -d -r1.6425 -r1.6426
--- ChangeLog 22 Jul 2008 22:36:17 -0000 1.6425
+++ ChangeLog 23 Jul 2008 16:05:48 -0000 1.6426
@@ -1,3 +1,9 @@
+2008-07-23 Sam Steingold <sds@...>
+
+ * compiler.lisp (cons-*fenv*): add
+ (add-fenv, c-FLET, c-FUNCTION-MACRO-LET, c-GENERIC-FLET)
+ (c-MACROLET): use it
+
2008-07-22 Sam Steingold <sds@...>

* lispbibl.d (OBJECT_OUT, NOBJECT_OUT): fflush stdout

------------------------------

-------------------------------------------------------------------------
This SF.Net email is sponsored by the Moblin Your Move Developer's challenge
Build the coolest Linux based applications with Moblin SDK & win great prizes
Grand prize is a trip for two to an Open Source event anywhere in the world
http://moblin-contest.org/redirect.php?banner_id=100&url=/

------------------------------

_______________________________________________
clisp-cvs mailing list
clisp-cvs@...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs

End of clisp-cvs Digest, Vol 27, Issue 41
*****************************************

-------------------------------------------------------------------------
This SF.Net email is sponsored by the Moblin Your Move Developer's challenge
Build the coolest Linux based applications with Moblin SDK & win great prizes
Grand prize is a trip for two to an Open Source event anywhere in the world
http://moblin-contest.org/redirect.php?banner_id=100&url=/
_______________________________________________
clisp-devel mailing list
clisp-devel@...
https://lists.sourceforge.net/lists/listinfo/clisp-devel