clisp-cvs Digest, Vol 32, Issue 34

[<cli...@li...>]

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

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
	cli...@li...

You can reach the person managing the list at
	cli...@li...

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/tests ChangeLog,1.610,1.611 ext-clisp.tst,1.14,1.15
      (Sam Steingold)
   2. clisp/src ChangeLog,1.6746,1.6747 compiler.lisp,1.341,1.342
      (Sam Steingold)


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

Message: 1
Date: Sun, 28 Dec 2008 06:43:03 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests ChangeLog,1.610,1.611 ext-clisp.tst,1.14,1.15
To: cli...@li...
Message-ID: <E1L...@dd...>

Update of /cvsroot/clisp/clisp/tests
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv31723/tests

Modified Files:
	ChangeLog ext-clisp.tst 
Log Message:
(c-form-table): handle CONCATENATE with c-CONCATENATE
(c-CONCATENATE): (concatenate 'string ...) ==> (string-concat ...)
if all the arguments are certain to be strings


Index: ext-clisp.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ext-clisp.tst,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- ext-clisp.tst	22 Dec 2008 04:54:48 -0000	1.14
+++ ext-clisp.tst	28 Dec 2008 06:43:01 -0000	1.15
@@ -365,6 +365,18 @@
     (close in) (close out) (close err))))
 (T T T T "(quit)" NIL "[1]> ")
 
+;; c-CONCATENATE
+(let ((args (list (code-char (random char-code-limit))
+                  (user-homedir-pathname)
+                  'args)))
+  (loop :for l :in
+    '((lambda (a b c) (concatenate 'string "[" (symbol-name c) " "
+                                   (namestring b) " " (char-name a) "]")))
+    :for c = (compile nil l) :do (disassemble c)
+    :always (string= (apply (coerce l 'function) args)
+                     (show (apply c args)))))
+T
+
 (progn (symbol-cleanup 'check-load)
        (symbol-cleanup '*s1*) (symbol-cleanup '*s2*)
        (symbol-cleanup '*s3*) (symbol-cleanup '*s4*))

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v
retrieving revision 1.610
retrieving revision 1.611
diff -u -d -r1.610 -r1.611
--- ChangeLog	22 Dec 2008 04:54:47 -0000	1.610
+++ ChangeLog	28 Dec 2008 06:43:01 -0000	1.611
@@ -1,3 +1,7 @@
+2008-12-28  Sam Steingold  <sd...@gn...>
+
+	* ext-clisp.tst: add a test for c-CONCATENATE
+
 2008-12-21  Sam Steingold  <sd...@gn...>
 
 	* ext-clisp.tst: add tests for MAKE-PIPE-INPUT-STREAM,




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

Message: 2
Date: Sun, 28 Dec 2008 06:43:03 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.6746,1.6747 compiler.lisp,1.341,1.342
To: cli...@li...
Message-ID: <E1L...@dd...>

Update of /cvsroot/clisp/clisp/src
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv31723/src

Modified Files:
	ChangeLog compiler.lisp 
Log Message:
(c-form-table): handle CONCATENATE with c-CONCATENATE
(c-CONCATENATE): (concatenate 'string ...) ==> (string-concat ...)
if all the arguments are certain to be strings


Index: compiler.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/compiler.lisp,v
retrieving revision 1.341
retrieving revision 1.342
diff -u -d -r1.341 -r1.342
--- compiler.lisp	6 Nov 2008 17:08:51 -0000	1.341
+++ compiler.lisp	28 Dec 2008 06:43:01 -0000	1.342
@@ -2262,6 +2262,7 @@
        (NINTERSECTION . c-TEST/TEST-NOT)
        (REMOVE-DUPLICATES . c-TEST/TEST-NOT)
        ;;
+       (CONCATENATE . c-CONCATENATE)
        (LDB . c-LDB)
        (LDB-TEST . c-LDB-TEST)
        (MASK-FIELD . c-MASK-FIELD)
@@ -7732,6 +7733,22 @@
                                               (nthcdr (+ pos 2) *form*)))))))))
         (c-GLOBAL-FUNCTION-CALL fun)))))
 
+;; (concatenate 'string ...) ==> (string-concat ...)
+(defconstant functions-returning-string
+  '(string symbol-name char-name namestring enough-namestring
+    princ-to-string prin1-to-string write-to-string with-output-to-string
+    get-output-stream-string))
+(defun c-CONCATENATE ()
+  (if (and (equal (second *form*) '(QUOTE STRING))
+           (every (lambda (f)
+                    (or (and (c-constantp f)
+                             (stringp (c-constant-value f)))
+                        (and (consp f)
+                             (memq (car f) functions-returning-string))))
+                  (cddr *form*)))
+      (c-GLOBAL-FUNCTION-CALL-form (cons 'EXT:STRING-CONCAT (cddr *form*)))
+      (c-GLOBAL-FUNCTION-CALL-form *form*)))
+
 ;; Recognizes a constant byte specifier and returns it, or NIL.
 (defun c-constant-byte-p (form)
   (cond ((c-constantp form)

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.6746
retrieving revision 1.6747
diff -u -d -r1.6746 -r1.6747
--- ChangeLog	25 Dec 2008 21:00:56 -0000	1.6746
+++ ChangeLog	28 Dec 2008 06:43:00 -0000	1.6747
@@ -1,3 +1,9 @@
+2008-12-28  Sam Steingold  <sd...@gn...>
+
+	* compiler.lisp (c-form-table): handle CONCATENATE with c-CONCATENATE
+	(c-CONCATENATE): (concatenate 'string ...) ==> (string-concat ...)
+	if all the arguments are certain to be strings
+
 2008-12-25  Vladimir Tzankov  <vtz...@gm...>
 
 	* threads.lisp (*DEFAULT-SPECIAL-BINDINGS*): add more default




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

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


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

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


End of clisp-cvs Digest, Vol 32, Issue 34
*****************************************