[comp.lang.lisp] Question about INTERN

murthy@magnus.ircc.ohio-state.edu (Murthy S Gandikota) (01/29/91)

consider the following lisp definitions:

(defstruct house
	rooms
	area)

(setf my-house (make-house :rooms 4 :area 100))

(setf any-house my-house)

(defun get-slot-value (obj slot)
;;this function returns the value of the slot in obj
(PROG (obj1 value)
	(setf obj1 obj)
	(if (equal (type-of obj) 'symbol) (setf obj1 (eval obj)))
	(setf value (eval `(,(intern (format nil "~a-~a" (type-of obj1) slot)) 
		,obj)))
	(RETURN value)))


(defun put-slot-value (obj slot value)
;;this function over writes the value of a slot
(PROG (obj1)
(setf obj1 obj)
(if (equal (type-of obj) 'symbol) (setf obj1 (eval obj)))
(eval `(setf (,(intern (format nil "~a-~a" (type-of obj1)) slot)) ,obj) 
	',value))))

(get-slot-value any-house 'rooms) returns 4

whereas

(get-slot-value my-house 'rooms) causes error

put-slot-value also behaves similarly

These functions used to work all right on Symbolics lisp. The errors
 only happen on Vax lisp 3.x!

Can anyone point out the reason? Or, point out other efficient ways to 
implement such functions? 


Thanks

Murthy Gandikota

eliot@phoenix.Princeton.EDU (Eliot Handelman) (01/30/91)

In article <1991Jan29.055536.1523@magnus.ircc.ohio-state.edu> murthy@magnus.ircc.ohio-state.edu (Murthy S Gandikota) writes:
;
;
;(setf my-house (make-house :rooms 4 :area 100))
;
;(setf any-house my-house)
;
;(defun get-slot-value (obj slot)
;;;this function returns the value of the slot in obj
;(PROG (obj1 value)
;	(setf obj1 obj)
;	(if (equal (type-of obj) 'symbol) (setf obj1 (eval obj)))
;	(setf value (eval `(,(intern (format nil "~a-~a" (type-of obj1) slot)) 
;		,obj)))
;	(RETURN value)))
;
;(get-slot-value my-house 'rooms) returns error


The problem is that TYPE-OF doesn't guarantee returning the most specific
type of an object, so if this used to work and now doesn't it's almost
certainly because your two TYPE-OF's aren't behaving consistently.
Common Lisp says that (TYPE-OF any-house) might return T.

There's no portable way to find out what the type of an object is.
But if you know the name of the slot then you might also know
the name of the object, which could reduce your overhead.

There's also no portable way to get the name of the structure slot-accessor,
given the structure and the slot. If I know that the structure is HOUSE
and the slot I'm looking for is ROOM, it would be nice to be able to 
get a handle on the accessor without having to build its name yourself,
but it can't be done. If you do go the way of concatenation and interning,
it's better to do this:

(defun build-room-slot-accessor (slot)
   (intern (concatenate 'string "HOUSE-" (symbol-name slot))))

Then rewrite your function as a macro:

(defmacro get-slot-value (obj slot)
  ;;this function returns the value of the slot in obj
  `(,(build-room-slot-accessor slot) ,obj)))

I don't understand what this is supposed to do:
;(if (equal (type-of obj) 'symbol) (setf obj1 (eval obj)))

If (setq a <a room>) and (setq b a) and (setq c b) then

A ==> <a room>
B ==> <a room> 
C ==> <a room> ;; that is, the same room.

jeff@aiai.ed.ac.uk (Jeff Dalton) (01/30/91)

In article <5783@idunno.Princeton.EDU> eliot@phoenix.Princeton.EDU (Eliot Handelman) writes:

>The problem is that TYPE-OF doesn't guarantee returning the most specific
>type of an object, so if this used to work and now doesn't it's almost
>certainly because your two TYPE-OF's aren't behaving consistently.

I agree that this is likely to be the right explanation.  However...

>Common Lisp says that (TYPE-OF any-house) might return T.

Actually, according to CLtL II, page 66, TYPE-OF never returns T.
Moreover (page 67), "for any object created by a DEFSTRUCT constructor
function, where the defstruct has the name _name_ and no :TYPE option,
TYPE-OF will return _name_.

This relationship between TYPE-OF and defstruct was also true in
CLtL I.

-- jd

barmar@think.com (Barry Margolin) (01/31/91)

In article <4037@skye.ed.ac.uk> jeff@aiai.UUCP (Jeff Dalton) writes:
>In article <5783@idunno.Princeton.EDU> eliot@phoenix.Princeton.EDU (Eliot Handelman) writes:
>>The problem is that TYPE-OF doesn't guarantee returning the most specific
>>type of an object, so if this used to work and now doesn't it's almost
>>certainly because your two TYPE-OF's aren't behaving consistently.
>
>I agree that this is likely to be the right explanation.  However...

I disagree, although I don't have any good explanation.
After doing (setq my-house any-house), (type-of my-house) and (type-of
any-house) should return the same value.  TYPE-OF doesn't know what
variable was used in the original form, it just sees the object, and it's
the same object in both cases.

To the original poster: when you post a question about an error you've
gotten, it's always a good idea to specify what the error message said.
Also, it would be very helpful if you would indent your program properly so
that the rest of us don't have a hard time reading it.  Also, a few coding
style suggestions: it's usually more correct to use (typep <object> <type>)
than (eq (type-of <object>) <type>), for the reasons that have been
mentioned in previous responses (it's also more concise to use a
specialized type-checking predicate such as SYMBOLP when it's available);
use EQ or EQL when you know that you don't need the generality of EQUAL
(when I read (EQUAL ...) it forces me to think about why EQUAL was used,
whereas EQ is a very simple operation); use SETQ rather than SETF when
setting variables (again, seeing the more general operator forces the
reader to stop and think, although I suspect many people out there would
disagree with me on this particular point, and I sometimes wish the Common
Lisp designers had had the guts to get rid of SETQ); use SYMBOL-VALUE
rather than EVAL when you know that the argument is a symbol (it's usually
more (and never less) efficient, and states your intent more clearly -- in
general, EVAL should only be used as a last resort); don't use PROG unless
you're using the features of at least two of the special forms it combines
(LET, BLOCK, and TAGBODY).

With all this in mind, here's a suggested rewrite of your functions:

(defun get-slot-value (obj slot)
  "Return the value of the specified slot in obj.
Assumes it is a structure whose accessors use the default naming scheme."
  (when (symbolp obj)
    (setq obj (symbol-value obj)))
  (eval `(,(intern (format nil "~a-~a" (type-of obj) slot))
	  ',obj)))

(defun put-slot-value (obj slot value)
  "Fills in the value of the specified slot in obj.
Assumes it is a structure whose accessors use the default naming scheme."
  (when (symbolp obj)
    (setq obj (symbol-value obj)))
  (eval `(setf (,(intern (format nil "~a-~a" (type-of obj) slot))
		',obj)
	       ',value)))
--
Barry Margolin, Thinking Machines Corp.

barmar@think.com
{uunet,harvard}!think!barmar

eliot@phoenix.Princeton.EDU (Eliot Handelman) (01/31/91)

In article <4037@skye.ed.ac.uk> jeff@aiai.UUCP (Jeff Dalton) writes:
;In article <5783@idunno.Princeton.EDU> eliot@phoenix.Princeton.EDU (Eliot Handelman) writes:
;

;>Common Lisp says that (TYPE-OF any-house) might return T.
;
;Actually, according to CLtL II, page 66, TYPE-OF never returns T.

Yes, I'm wrong, but anyhow CLtL II isn't Common Lisp (or so I've
been led to believe from some recent discussion on the common lisp
mailing list, for as Steele says in the preface, "In no way  does this
book constitute a definitive description of the *forthcoming* ANSI
standards" (pg xii, my asterisks)).

;Moreover (page 67), "for any object created by a DEFSTRUCT constructor
;function, where the defstruct has the name _name_ and no :TYPE option,
;TYPE-OF will return _name_.
;
;This relationship between TYPE-OF and defstruct was also true in
;CLtL I.
;
;-- jd

Yes.

eliot@phoenix.Princeton.EDU (Eliot Handelman) (01/31/91)

In article <1991Jan30.225106.26561@Think.COM> barmar@think.com (Barry Margolin) writes:
;

;
;(defun get-slot-value (obj slot)
;  "Return the value of the specified slot in obj.
;Assumes it is a structure whose accessors use the default naming scheme."
;  (when (symbolp obj)
;    (setq obj (symbol-value obj)))
;  (eval `(,(intern (format nil "~a-~a" (type-of obj) slot))
;	  ',obj)))

Of course, the real error might be something like interning the
accessor in the wrong package.

stefan@asterix.fhg.de (Stefan Bernemann 7549-139) (01/31/91)

In article <1991Jan30.225106.26561@Think.COM>, barmar@think.com (Barry
Margolin) writes:
|> [...]
|> general, EVAL should only be used as a last resort); 
|> [...]
|> With all this in mind, here's a suggested rewrite of your functions:
|> 
|> (defun get-slot-value (obj slot)
|>   "Return the value of the specified slot in obj.
|> Assumes it is a structure whose accessors use the default naming
scheme."
|>   (when (symbolp obj)
|>     (setq obj (symbol-value obj)))
|>   (eval `(,(intern (format nil "~a-~a" (type-of obj) slot))
|> 	  ',obj)))
What's the use of eval here? Why don't you use
     (apply (intern (slot-accessor-fn-namestring obj slot)) obj nil) 
or something similar?

Stefan

--
Mail: Stefan Bernemann        ! Phone:  +49-231-7549233
      c/o FhG IML Dortmund    ! Fax:    +49-231-7549211
      Emil-Figge-Str. 75      ! Email:  berni@iml.fhg.de
      D-4600 Dortmund 50, FRG !        
...!{uunet|mcavx}!unido!itwdo!berni

SEB1525@mvs.draper.com (01/31/91)

On 30 Jan 91 22:51:06 GMT Barry Margolin <barmar@think.com> wrote:

>...and I sometimes wish the Common
>Lisp designers had had the guts to get rid of SETQ);...

Do you mean that you wish that SETQ had been flushed in favor of SETF,
or that side-effecting variables via assignment should have been
prohibited?

- Steve Bacher <seb1525@draper.com>

alms@cambridge.apple.com (Andrew L. M. Shalit) (02/01/91)

In article <1991Jan30.225106.26561@Think.COM> barmar@think.com (Barry Margolin) writes:

   Also, a few coding
   style suggestions: it's usually more correct to use (typep <object> <type>)
   than (eq (type-of <object>) <type>), for the reasons that have been
   mentioned in previous responses (it's also more concise to use a
   specialized type-checking predicate such as SYMBOLP when it's available);
   use EQ or EQL when you know that you don't need the generality of EQUAL
   (when I read (EQUAL ...) it forces me to think about why EQUAL was used,
   whereas EQ is a very simple operation); use SETQ rather than SETF when
   setting variables (again, seeing the more general operator forces the
   reader to stop and think, although I suspect many people out there would
   disagree with me on this particular point, and I sometimes wish the Common
   Lisp designers had had the guts to get rid of SETQ); use SYMBOL-VALUE
   rather than EVAL when you know that the argument is a symbol (it's usually
   more (and never less) efficient, and states your intent more clearly -- in
   general, EVAL should only be used as a last resort); don't use PROG unless
   you're using the features of at least two of the special forms it combines
   (LET, BLOCK, and TAGBODY).

All very good suggestions.

   With all this in mind, here's a suggested rewrite of your functions:

   (defun get-slot-value (obj slot)
     "Return the value of the specified slot in obj.
   Assumes it is a structure whose accessors use the default naming scheme."
     (when (symbolp obj)
       (setq obj (symbol-value obj)))
     (eval `(,(intern (format nil "~a-~a" (type-of obj) slot))
	     ',obj)))

Two more suggestions: replace FORMAT with CONCATENATE.  This will
ensure that you don't get screwed by *print-case*.  Also, you can
replace the EVAL with a FUNCALL (going by your "smaller hammer for a
smaller job" theory).  It might also be a good idea to pass a package
argument to INTERN.  All these together give us:


   (defun get-slot-value (obj slot)
     (when (symbolp obj)
       (setq obj (symbol-value obj)))
     (funcall (intern (concatenate 'string
                                   (string (type-of obj))
                                   "-"
                                   (string slot))
                      (symbol-package slot))       ;just a guess!
               obj))
--

barmar@think.com (Barry Margolin) (02/01/91)

In article <ALMS.91Jan31114032@ministry.cambridge.apple.com> alms@cambridge.apple.com (Andrew L. M. Shalit) writes:
>In article <1991Jan30.225106.26561@Think.COM> barmar@think.com (Barry Margolin) writes:
>Two more suggestions: replace FORMAT with CONCATENATE.  This will
>ensure that you don't get screwed by *print-case*.  

Good point.  I've never really liked Common Lisp's CONCATENATE (my guess is
that 95% of the sequences that are concatenated are lists (which already
have APPEND) and strings (in my Symbolics-specific code I prefer
STRING-APPEND)).  Also, in this case it is clumsy because of the need to
use SYMBOL-NAME to convert the symbol to a string.

>						     Also, you can
>replace the EVAL with a FUNCALL (going by your "smaller hammer for a
>smaller job" theory).  

You're right for the GET-SLOT-VALUE case, but unfortunately not
SET-SLOT-VALUE (I realize you weren't talking about this case, I'm just
amplifying).  In this case, there's some enhanced readability from
implementing both GET and SET in similar fashion.

>			It might also be a good idea to pass a package
>argument to INTERN.  All these together give us:
>
>
>   (defun get-slot-value (obj slot)
>     (when (symbolp obj)
>       (setq obj (symbol-value obj)))
>     (funcall (intern (concatenate 'string
>                                   (string (type-of obj))
>                                   "-"
>                                   (string slot))
>                      (symbol-package slot))       ;just a guess!
>               obj))

I actually considered supplying the package argument.  Unfortunately, there
really is no *right* way to do this, which is why it's usually wrong to try
to construct function names using INTERN at runtime.  The package of the
slot argument to {GET,SET}-SLOT-VALUE is not necessarily the package that
the structure was defined in, especially when inheritance is involved.
Consider:

(defstruct personal-inventory
  car
  house)

(setq my-inv (make-personal-inventory :car :oldsmobile :house :condo))

(get-slot-value my-inv 'car)
Error: Undefined function LISP::PERSONAL-INVENTORY-CAR

or on a Symbolics

Error: Attempt to intern BARMAR in locked package COMMON-LISP.

This is because CAR is inherited from the LISP package.  It would probably
be safer to use (symbol-package (type-of obj)), but that can also have
similar problems (although not involving the LISP package, if the program
obeys the rules against redefining built-in Common Lisp symbols, as
described on p.260 of CLtL2).

--
Barry Margolin, Thinking Machines Corp.

barmar@think.com
{uunet,harvard}!think!barmar

jeff@aiai.ed.ac.uk (Jeff Dalton) (02/12/91)

In article <5821@idunno.Princeton.EDU> eliot@phoenix.Princeton.EDU (Eliot Handelman) writes:
>In article <4037@skye.ed.ac.uk> jeff@aiai.UUCP (Jeff Dalton) writes:
>;In article <5783@idunno.Princeton.EDU> eliot@phoenix.Princeton.EDU (Eliot Handelman) writes:
>;>Common Lisp says that (TYPE-OF any-house) might return T.
>;
>;Actually, according to CLtL II, page 66, TYPE-OF never returns T.
>
>Yes, I'm wrong, but anyhow CLtL II isn't Common Lisp (or so I've
>been led to believe from some recent discussion on the common lisp
>mailing list, for as Steele says in the preface, "In no way  does this
>book constitute a definitive description of the *forthcoming* ANSI
>standards" (pg xii, my asterisks)).

You're right that CLtL II isn't Common Lisp, as the preface says.  But
CLtL I is as close to definitive as we can get at present, and it also
says TYPE-OF returns the appropriate type for a defstruct.  Moreover,
CLtL II is the best source we have for what X3J13 intends as well as
to what implementations that have tried to follow X3J13 may have done.
I don't think the X3J13 draft is yet sufficiently solid to take over
as the main definition of CL, and so when we have to cite some source
CLtL II is about as good as it gets at present.

The main cases where it's best not to follow CLtL II too closely are
when something appears to be an artifact of the language used in CLtL
II and so not necessarily a reliable account of the language.

However, you are certainly right is steering programmers away from
TYPE-OF.  Barmar has a good suggestion, namely to use (TYPEP x type)
rather than (EQ (TYPE-OF x) type).

-- jeff

srt@aero.org (Scott "TCB" Turner) (02/13/91)

In article <4093@skye.ed.ac.uk> jeff@aiai.UUCP (Jeff Dalton) writes:
>(defun concat-symbol (&rest parts)
>  (intern (apply #'concatenate 'string (mapcar #'string parts))))

If you are going to do this frequently - as in a system where you
generate numerous identifiers by concatenating a number to a prefix,
i.e., "gen.12" - you should implement this using a general vector 
and fill-pointers.  Eliminating all the temporary strings can be 
a big savings in terms of time and garbage.  

Here's an example function that generates prefix+id symbols.  In AKCL,
this function generates no garbage at all.  Exactly how this function
works I leave as an exercise to the reader.  :-)

;;;
;;;  Make-Inst-Id
;;;
;;;  Take a prefix ("gen"), the length of the prefix (3), and an id
;;;  number to append (12) and return the appropriate symbol (gen.12).
;;;  Note that prefix is a variable-length character array, is
;;;  modified by this function, and must be long enough for
;;;  construction of the symbol's print name.  This function assumes
;;;  prefix is length 50 - to generalize, use array-dimension.
;;;
(proclaim '(function make-inst-id (vector fixnum fixnum) symbol))
(defun make-inst-id (prefix prefix-len num)
  (declare (fixnum prefix-len) (fixnum num))
  (setf (fill-pointer prefix) 49)
  (do* ((n num (the fixnum (do ((n1 n (the fixnum (- n1 10)))
				(i 0 (1+ i)))
			       ((< n1 10) i)
			       (declare (fixnum n1) (fixnum i)))))
	(start (the fixnum (do ((n1 10 (the fixnum (* n1 10)))
				(i 1 (1+ i)))
			       ((> n1 num)
				(the fixnum (+ i prefix-len)))
			       (declare (fixnum n1) (fixnum i)))))
        (j (1- start) (1- j)))
       ((< j prefix-len)
	(setf (fill-pointer prefix) start)
	(intern prefix))

       (declare (fixnum n) (fixnum start) (fixnum j))

       (setf (char prefix j)
	     (code-char (the fixnum (+ 48 (the fixnum (mod n 10))))))))

riesbeck@ils.nwu.edu (Chris Riesbeck) (02/15/91)

In article <1991Feb12.184355.11142@aero.org>, srt@aero.org (Scott "TCB"
Turner) writes:
> In article <4093@skye.ed.ac.uk> jeff@aiai.UUCP (Jeff Dalton) writes:
> >(defun concat-symbol (&rest parts)
> >  (intern (apply #'concatenate 'string (mapcar #'string parts))))
> 
> If you are going to do this frequently - as in a system where you
> generate numerous identifiers by concatenating a number to a prefix,
> i.e., "gen.12" - you should implement this using a general vector 
> and fill-pointers.  Eliminating all the temporary strings can be 
> a big savings in terms of time and garbage.  

Well, if you're going to be that way about it, you might appreciate 
the following string slicing functions, very handy for getting 
substrings without building new strings.  MAKE-SLICE creates the
container and SET-SLICE can be used to move it around like a window
on strings.  Note that with this sharing comes the fact that you can't
just store the slice and expect to stay unchanged if you call SET-SLICE
again later.  However, there are lots of applications where you want
a temporary substring that then gets copied into the final output. A
string substitution function is given below as an example.

;;; (make-slice) => a slice object
;;; (set-slice slice string &key start end) => slice object, adjusted
;;;  so that it looks and prints like the obvious substring of string.
;;;
;;;   (set-slice (make-slice) "abcde" :start 1 :end 3) => "bc"

(defun make-slice ()
  (make-array 0 :adjustable t :element-type 'string-char :fill-pointer t))

(defun set-slice (slice strng &key (start 0) (end (length strng)))
  (adjust-array slice (- end start)
		:displaced-to strng
		:displaced-index-offset start
		:fill-pointer (- end start)))

;;; Example application...
;;; (substring-subst new old string) substitutes every nonoverlapping
;;; occurrence of old with new in string.

(defun substring-subst (new old string)
  (when (> (length old) 0)
    (with-output-to-string (out)
      (do* ((slice (make-slice))
	    (len (length old))
	    (start 0 (+ pos len))
	    (pos (search old string)
		 (search old string :start2 start)))
	   ((null pos) (format out (set-slice slice string :start start)))
	(format out (slice-string slice string :start start :end pos))
	(format out new)))))

Chris
-----