[comp.lang.lisp] Amusing Code

alex@soi.UUCP (Alex Zatsman) (08/24/88)

It took me and few of my friends a while to figure out
seemingly strange effect of TEST-STACK below. I thought
other people will find it amusing too:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar *Stack*)

(defun Push-Object (Object) (push Object (car *Stack*)))

(defun Init-Stack () (setf *Stack* '((:Bottom-Frame))))

(defun Test-Stack ()
  (Init-Stack)     (print *Stack*)
  (Push-Object 11) (print *Stack*)
  (Init-Stack)     (print *Stack*)  (values))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

klapper@oravax.UUCP (Carl Klapper) (08/24/88)

In article <389@soi.UUCP>, alex@soi.UUCP (Alex Zatsman) writes:
> It took me and few of my friends a while to figure out
> seemingly strange effect of TEST-STACK below. I thought
> other people will find it amusing too:
> 
> (defvar *Stack*)
> 
> (defun Push-Object (Object) (push Object (car *Stack*)))
> 
> (defun Init-Stack () (setf *Stack* '((:Bottom-Frame))))
> 
> (defun Test-Stack ()
>   (Init-Stack)     (print *Stack*)
>   (Push-Object 11) (print *Stack*)
>   (Init-Stack)     (print *Stack*)  (values))
> 

The fix is to set the variable to a copy of the list (tree, structure. etc.)
which you intend to initialize it to. The copy should be new to whatever
level you intend to alter the variable. In this example,

(defun init-stack () (setf *stack* (copy-list '((:bottom-frame)))))

should be sufficient. However, if the *stack* is "empty", then (car *stack*)
would still point to the list (:bottom-frame) in the definition of init-stack
and (setf (caar *stack*) ':the-pits) would change that definition to:

(lambda-block init-stack () (setf *stack* (copy-list '((:the-pits)))))

To avoid this, init-stack should be defined thus:

(defun init-stack () (setf *stack* (copy-tree '((:bottom-frame)))))


				Carl Klapper
				Odyssey Research Associates, Inc.
				301A Harris B. Dates Drive
				Ithaca, NY 14850
				klapper%oravax.uucp@cu-arpa.cs.cornell.edu

***
If you wish to make a signature, please hang up and dial again.
***

hoey@ai.etl.army.mil (Dan Hoey) (08/24/88)

In article <389@soi.UUCP> alex@soi.UUCP (Alex Zatsman) writes about modifying
quoted structure, as in

>(defun Init-Stack () (setf *Stack* '((:Bottom-Frame))))

>(defun Push-Object (Object) (push Object (car *Stack*)))

where calling PUSH-OBJECT can modify the quoted constant in INIT-STACK.

The current feeling of a lot of the Common Lisp developers is that such
behavior is an error.  In particular, if an implementation has the capability
of supporting read-only storage, then it may use that storage for quoted
structure, and calling PUSH-OBJECT may signal an error.

A better way of writing INIT-STACK is

	(defun Init-Stack () (setf *Stack* (list '(:Bottom-Frame))))

Dan

lbaum@bcsaic.UUCP (Larry Baum) (08/24/88)

In article <389@soi.UUCP> alex@soi.UUCP (Alex Zatsman) writes:
>
>(defvar *Stack*)
>
>(defun Push-Object (Object) (push Object (car *Stack*)))
>
>(defun Init-Stack () (setf *Stack* '((:Bottom-Frame))))
>
>(defun Test-Stack ()
>  (Init-Stack)     (print *Stack*)
>  (Push-Object 11) (print *Stack*)
>  (Init-Stack)     (print *Stack*)  (values))
>
This is another in a long series of examples that show the danger in
using quoted lists instead of the LIST function, and also using
"destructive" operations such as PUSH.

Of course the "correct" code should do:

(defun Init-Stack () (setf *Stack* (list '(:Bottom-Frame))))

LSB

eliot@phoenix.Princeton.EDU (Eliot Handelman) (08/25/88)

In article <389@soi.UUCP>, alex@soi.UUCP (Alex Zatsman) writes:
; It took me and few of my friends a while to figure out
; seemingly strange effect of TEST-STACK below. I thought
; other people will find it amusing too:
; 
; (defvar *Stack*)
; 
; (defun Push-Object (Object) (push Object (car *Stack*)))
; 
; (defun Init-Stack () (setf *Stack* '((:Bottom-Frame))))
; 
; (defun Test-Stack ()
;   (Init-Stack)     (print *Stack*)
;   (Push-Object 11) (print *Stack*)
;   (Init-Stack)     (print *Stack*)  (values))
; 

After having called test-stack, have a look at #'init-stack. Miracle of
miracles! Well, they all warned you about RPLACA, which is being called
by PUSH. Of course it's trivial to obviate this effect, but at least
it proves the existence of pointers. Thanks for an interesting example.

-Eliot

-- 
This message will cost the net hundreds if not thousands and perhaps millions
billions trillions maybe even zillions of dollars to send everywhere.