Subject: [clisp-list] a bug or my error?

From: "Jacques B. Siboni" <[email-masked]>
Date: Mon Jul 19 06:45:08 2004

Hi clisp developers,

can you please try this code:

(defun symbolize-preserving-case (str-rspc)
  "\"abc def ghi\" ---> (|abc| |def| ghi|)"
  (check-type str-rspc string)
  (let ((list (coerce str-rspc 'list))(char)(result nil))
    (setq result '(#\( #\|))
    (while list
      (setq char (pop list))
      (if (eql char #\Space)
	  (progn
	    (push-right #\| result)
	    (push-right #\Space result)
	    (push-right #\| result)
	    (while (eql (car list) #\Space)
	      (pop list)
	      )
	    )
	(push-right char result)
	)
      )
    (push-right #\| result)
    (push-right #\) result)
    (read-from-string (coerce result 'string))
    )
  )

(defmacro push-right (item place)
  `(setq ,place (nconc ,place (list ,item))) )

look at what i get:

> (symbolize-preserving-case "aaa x y  zzzz")
(|aaa| |x| |y| |zzzz|) ;
22

so far so good

BUT:

> (symbolize-preserving-case "abc def ghi")
(|aaa| |x| |y| |zzzz|) ;
22

!!! it keeps the result of the previous run!!!
although I use "let" form

when i run with step variable result start with nil as it should

BUT the second parameter of the setq
(setq result '(#\( #\|))
has the value of the result of the previous run!!!

When i change the (setq result '(#\( #\|))

by 
    (setq result nil)
    (push #\| result)
    (push #\( result)

it works perfectly.

Weird isn't it?

clisp version is clisp-2.33.2-10.rh7.3.at.i386.rpm

Thanks for  your help

Jacques

-- 
Dr. Jacques B. Siboni mailto:[email-masked]
8 pass. Charles Albert, F75018 Paris, France
Tel. & Fax: 33 (0) 1 42 28 76 78
Home Page: http://www.lutecium.org/jacsib/

---

From: Sam Steingold <[email-masked]>
Date: Mon Jul 19 07:56:18 2004

> * Jacques B. Siboni <[email-masked]> [2004-07-19 13:43:29 +0000]:
>
>     (setq result '(#\( #\|))
> 	    (push-right #\| result)

you are destructively modifying a quoted list.
try

        (setq result (list #\( #\|)))

instead

> Weird isn't it?

nope. quoted literals are not re-created each time you run your
function.  try disassembling it.

note:

[1]> (setf (readtable-case *readtable*) :preserve)

:PRESERVE
[2]> (READ-FROM-STRING "(foo bar baz)")

(foo bar baz) ;
13
[3]> (SETF (READTABLE-CASE *READTABLE*) :UPCASE)

:UPCASE
[4]> **

(|foo| |bar| |baz|)
[5]> 

alternatively,

(let ((*readtable* (copy-readtable nil)))
  (setf (readtable-case *readtable*) :preserve)
  (read-from-string "(foo bar baz)"))
==>

(|foo| |bar| |baz|) ;
13

-- 
Sam Steingold (http://www.podval.org/~sds) running w2k
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.honestreporting.com>
The early bird may get the worm, but the second mouse gets the cheese.

---

From: "Jacques B. Siboni" <[email-masked]>
Date: Mon Jul 19 10:23:03 2004

Sam, thanks for the explanation, i was not aware of this side effect.

and thanks for the elegant solution you have suggested

All the best

Jacques

---

From: Pascal J.Bourguignon <[email-masked]>
Date: Mon Jul 19 16:49:00 2004

(defun symbolize-preserving-case (str-rspc)
  "\"abc def ghi\" ---> (|abc| |def| ghi|)"
  (check-type str-rspc string)
  (do* ((start  (skip-spaces str-rspc 0)  (skip-spaces str-rspc start))
        (result '()))
      ((>= start (length str-rspc)) (nreverse result))
    (let ((end (do ((end start (1+ end)))
                              ((or (>= end (length str-rspc))
                                   (char= #\space (aref str-rspc end)))
                               end))))
      (push (intern (subseq str-rspc start end)) result)
      (setf start end))))

(symbolize-preserving-case "abc def ghi")   ==> (|abc| |def| |ghi|)
(symbolize-preserving-case "aaa x y  zzzz") ==> (|aaa| |x| |y| |zzzz|)

Or even:

(defun symbolize-preserving-case (str)
  "\"abc def ghi\" ---> (|abc| |def| ghi|)"
  (check-type str string)
  (mapcar (function intern)
          (delete "" (split-string str " ") :test (function string=))))

Or you could use the community standard split-sequence instead of my
split-string. The point is that you can abstract and simplify your
functions with higher level constructs. 

> although I use "let" form

LET has nothing to do with it!

> has the value of the result of the previous run!!!

Obviously!  With this setq, you're making result reference to THE literal
list: ( #\( #\| )
 
Then you modify this literal list with the nconc of your push-right macro!

If you fetched the function lambda expression, you'd see that what
you've done is modify your program!

CL-USER> (function-lambda-expression (function symbolize-preserving-case))
(LAMBDA (STR-RSPC) (DECLARE (SYSTEM::IN-DEFUN SYMBOLIZE-PRESERVING-CASE))
 (BLOCK SYMBOLIZE-PRESERVING-CASE (CHECK-TYPE STR-RSPC STRING)
  (LET ((LIST (COERCE STR-RSPC 'LIST)) (CHAR) (RESULT NIL))
   (SETQ RESULT '(#\( #\|))
   (WHILE LIST (SETQ CHAR (POP LIST))
    (IF (EQL CHAR #\Space)
     (PROGN (PUSH-RIGHT #\| RESULT) (PUSH-RIGHT #\Space RESULT)
      (PUSH-RIGHT #\| RESULT) (WHILE (EQL (CAR LIST) #\Space) (POP LIST)))
     (PUSH-RIGHT CHAR RESULT)))
   (PUSH-RIGHT #\| RESULT) (PUSH-RIGHT #\) RESULT)
   (READ-FROM-STRING (COERCE RESULT 'STRING)))))
#(NIL NIL NIL NIL ((DECLARATION VALUES OPTIMIZE DECLARATION)))
SYMBOLIZE-PRESERVING-CASE
CL-USER> (symbolize-preserving-case "aaa x y  zzzz")
(|aaa| |x| |y| |zzzz|)
22
CL-USER> (function-lambda-expression (function symbolize-preserving-case))
(LAMBDA (STR-RSPC) (DECLARE (SYSTEM::IN-DEFUN SYMBOLIZE-PRESERVING-CASE))
 (BLOCK SYMBOLIZE-PRESERVING-CASE (CHECK-TYPE STR-RSPC STRING)
  (LET ((LIST (COERCE STR-RSPC 'LIST)) (CHAR) (RESULT NIL))
   (SETQ RESULT
    '(#\( #\| #\a #\a #\a #\| #\Space #\| #\x #\| #\Space #\| #\y #\| #\Space
      #\| #\z #\z #\z #\z #\| #\)))
   (WHILE LIST (SETQ CHAR (POP LIST))
    (IF (EQL CHAR #\Space)
     (PROGN (PUSH-RIGHT #\| RESULT) (PUSH-RIGHT #\Space RESULT)
      (PUSH-RIGHT #\| RESULT) (WHILE (EQL (CAR LIST) #\Space) (POP LIST)))
     (PUSH-RIGHT CHAR RESULT)))
   (PUSH-RIGHT #\| RESULT) (PUSH-RIGHT #\) RESULT)
   (READ-FROM-STRING (COERCE RESULT 'STRING)))))
#(NIL NIL NIL NIL ((DECLARATION VALUES OPTIMIZE DECLARATION)))
SYMBOLIZE-PRESERVING-CASE

> When i change the (setq result '(#\( #\|))

Not at all. 

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

There is no worse tyranny than to force a man to pay for what he does not
want merely because you think it would be good for him. -- Robert Heinlein